diff --git a/.gitignore b/.gitignore
index f98ca394432eeae4f2ff564c0ebbdef858d0835c..30618d0f35e5395a784e85895e7f983d6e0036e2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -39,7 +39,14 @@ MY_RUN/KTEST/9??_*
pub/ncl-?.?.?
pub/ncl_ncarg*/
src/dir_obj-*
+src/LIB/eccodes*
+!src/LIB/eccodes*.tar.gz
src/LIB/grib_api*
+!src/LIB/grib_api*.tar.gz
src/LIB/hdf5*
+!src/LIB/hdf5*.tar.gz
src/LIB/libaec*
+!src/LIB/libaec*.tar.gz
src/LIB/netcdf*
+!src/LIB/netcdf*.tar.gz
+
diff --git a/A-INSTALL b/A-INSTALL
index 5e3c3bdc708cb7f598aaaa149e2a54ade7cc3002..dfd287b9a87e33c34a06dcb9dfc6b01f8058a26a 100644
--- a/A-INSTALL
+++ b/A-INSTALL
@@ -988,9 +988,43 @@ git clone -b 2014.01 https://github.com/forefireAPI/firefront.git
# because it needs a licence agrement.
#
# ----------------------------------
-# OPTION 1: Use version 11.3 of RTTOV
+# OPTION 1: Use version 13.0 of RTTOV
# -----------------------------------
-# Download the RTTOV package rttov113.tar.gz by following the instructions given on http://nwpsaf.eu/site/software/rttov/
+#
+# Run the 'configure' script preceded with the setting of the MNH_RTTOV variable:
+#
+cd MNH.../src/
+export MNH_RTTOV=1
+export VER_RTTOV=13.0
+#
+# Download the RTTOV package rttov130.tar.xz by following the instructions given on https://nwpsaf.eu/site/software/rttov/
+#
+# Install the RTTOV package rttov130.tar.xz
+cd MNH.../src/LIB
+mkdir RTTOV-13.0
+cd RTTOV-13.0
+tar xJf rttov130.tar.xz
+cd build
+edit Makefile.local
+"
+HDF5_PREFIX = $(SRC_MESONH)/src/LIB/netcdf-LX${ARCH}-R${MNH_REAL}I${MNH_INT}
+uncomment FFLAGS_HDF5 = -D_RTTOV_HDF $(FFLAG_MOD)$(HDF5_PREFIX)/include
+uncomment LDFLAGS_HDF5 = -L$(HDF5_PREFIX)/lib -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -lz
+LDFLAGS_HDF5 = -L$(HDF5_PREFIX)/lib64 -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -lsz -laec -lz -ldl
+"
+cd src
+../build/Makefile.PL RTTOV_HDF=1
+make ARCH=ifort # Use Intel "ifort" compiler; other options: gfortran, NAG, pgf90, IBM
+#
+# And then for the Meso-NH compilation, do
+#
+cd MNH.../src/
+make
+
+# ----------------------------------
+# OPTION 2: Use version 11.3 of RTTOV
+# -----------------------------------
+# Download the RTTOV package rttov113.tar.gz by following the instructions given on https://nwpsaf.eu/site/software/rttov/
#
# Install the RTTOV package rttov113.tar.gz
cd MNH.../src/LIB
@@ -1011,7 +1045,7 @@ export VER_RTTOV=11.3
etc ...
# ----------------------------------
-# OPTION 2: Use version 8.7 of RTTOV
+# OPTION 3: Use version 8.7 of RTTOV
# ----------------------------------
# For already(old) licencied MesoNH users (MNH-4-X version with research licence see here: http://mesonh.aero.obs-mip.fr/mesonh410/UserInformation)
#
diff --git a/MY_RUN/KTEST/005_ARM/001_prep_ideal/PRE_IDEA1.nam b/MY_RUN/KTEST/005_ARM/001_prep_ideal/PRE_IDEA1.nam
index ae229db2b8483e0c292a6f5c5404e9ff6a37edcd..137f6f427a274c2d3649f7304bd6d70da720082f 100644
--- a/MY_RUN/KTEST/005_ARM/001_prep_ideal/PRE_IDEA1.nam
+++ b/MY_RUN/KTEST/005_ARM/001_prep_ideal/PRE_IDEA1.nam
@@ -19,7 +19,7 @@
&NAM_VPROF_PRE /
&NAM_GRn_PRE CSURF='EXTE'/
&NAM_CH_MNHCn_PRE /
-&NAM_BLANK /
+&NAM_BLANKn /
&NAM_PGD_SCHEMES CSEA='FLUX ' /
&NAM_COVER XUNIF_COVER(1)=1. /
RSOU
diff --git a/MY_RUN/KTEST/005_ARM/002_mesonh/EXSEG1.nam b/MY_RUN/KTEST/005_ARM/002_mesonh/EXSEG1.nam
index 5633d913d78826fd8bd637c25654f417dda54b87..320ba51b9439996141cf66f32517a86eae2f7f27 100644
--- a/MY_RUN/KTEST/005_ARM/002_mesonh/EXSEG1.nam
+++ b/MY_RUN/KTEST/005_ARM/002_mesonh/EXSEG1.nam
@@ -49,7 +49,7 @@
LLES_NEB_MASK = .TRUE.,
XLES_TEMP_MEAN_STEP=3600.,
XLES_TEMP_MEAN_START=3600., XLES_TEMP_MEAN_END=32400. /
-&NAM_BLANK /
+&NAM_BLANKn /
&NAM_FRC LGEOST_UV_FRC=.TRUE., LTEND_THRV_FRC=.TRUE. /
&NAM_CH_SOLVER /
&NAM_PARAM_ICE /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src
index 7040ceed94b9baf614d5e6b49c932a05112ed433..befbed1c8f72eb4b53c22467882f095a2d1b885c 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src
@@ -36,5 +36,5 @@
&NAM_SSOn CROUGH='Z01D' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH
index 32ba240a9ce78e73f3d472332d3db39a6bffe055..634a86cf824e2f4a81befbdbc3220a3bec7d3122 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH
@@ -33,5 +33,5 @@
&NAM_SSOn CROUGH='Z01D' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
index e662f00c317a49d983669ee5dff5717f2a7def49..949a1143b46c78205a0381314b7b8eaff82e99fc 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
@@ -35,5 +35,5 @@
&NAM_SSOn CROUGH='Z01D' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src
index d081e1bd102731717b9f7491536ababe39aa3dc3..ef7c5c6733dd8a6a6b2b8a3e5d31eb6f36598d30 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src
@@ -23,5 +23,5 @@
CC1DRY = 'DEF', CSOILFRZ = 'DEF', CDIFSFCOND = 'DEF', CSNOWRES = 'DEF' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH
index 46d89895e125636a926cef831095aaa8c728039e..23163d477033c7d8ac8d73ab75be5d5bf93bf05a 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH
@@ -20,5 +20,5 @@
CC1DRY = 'DEF', CSOILFRZ = 'DEF', CDIFSFCOND = 'DEF', CSNOWRES = 'DEF' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
index 005f9db707414508b8a3dd2e887337bd0ec56ec1..af85881f172360325e667c77930619a1b33e0c21 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
@@ -23,5 +23,5 @@
CC1DRY = 'DEF', CSOILFRZ = 'DEF', CDIFSFCOND = 'DEF', CSNOWRES = 'DEF' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/README.namelist b/MY_RUN/KTEST/007_16janvier/008_run2/README.namelist
index 0104c64442e897a78c45da4a8bbaef02c49db166..6fcdd4c80863d297a49c0627d24a6c5b86ae5ae8 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/README.namelist
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/README.namelist
@@ -173,5 +173,5 @@ CSEA_ALB ="UNIF" ; type of albedo formula
'TA96' Taylor et al (1996) formula for water direct albedo )
-&NAM_BLANK
+&NAM_BLANKn
diff --git a/MY_RUN/KTEST/009_ICARTT/002_arp2lfi/PRE_REAL1.nam b/MY_RUN/KTEST/009_ICARTT/002_arp2lfi/PRE_REAL1.nam
index 6c9c0b5a071611299d2c4ae023fbd8312006acb6..7f59fcd294ede8f637425b79c6d8b19e03aee0b3 100644
--- a/MY_RUN/KTEST/009_ICARTT/002_arp2lfi/PRE_REAL1.nam
+++ b/MY_RUN/KTEST/009_ICARTT/002_arp2lfi/PRE_REAL1.nam
@@ -11,7 +11,7 @@
&NAM_VER_GRID NKMAX=60, YZGRID_TYPE='FUNCTN',
ZDZGRD=60., ZDZTOP=650.,
ZZMAX_STRGRD=2000., ZSTRGRD=4., ZSTRTOP=6. /
-&NAM_BLANK /
+&NAM_BLANKn /
MOC2MESONH
transfer mocage/ReLACS variables (default values)
36 # NUMBER OF OPTIONAL GRIB VARIABLES
diff --git a/MY_RUN/KTEST/009_ICARTT/003_mesonh/EXSEG1.nam.src b/MY_RUN/KTEST/009_ICARTT/003_mesonh/EXSEG1.nam.src
index 5d534b528ae7824896f77625a77fe66e12249607..de7ea31f5d7954009e75618b1767e42a4953be3d 100644
--- a/MY_RUN/KTEST/009_ICARTT/003_mesonh/EXSEG1.nam.src
+++ b/MY_RUN/KTEST/009_ICARTT/003_mesonh/EXSEG1.nam.src
@@ -66,4 +66,4 @@
&NAM_DIAG_SURFn /
&NAM_DIAG_ISBAn /
&NAM_DIAG_SURF_ATMn /
-&NAM_BLANK /
+&NAM_BLANKn /
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 be5585a8942d90a752b1241023742d6f9da5f74f..7448f10d0b38061642aacbb934f40796745cc745 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
@@ -30,7 +30,6 @@ Dvar_input = {
# Read the variables in the files
Dvar = {}
Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
-Dvar['f1']['date'] = convert_date(Dvar['f1']['date'], Dvar['f1']['time'])
################################################################
######### PANEL 1
###############################################################
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 12ff241726cb4b00c005051e28ee8e69516e2b35..b64203496df724da0109d0798a84d4b66302de4e 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,29 +20,25 @@ os.system('rm -f tempgraph*')
path=""
LnameFiles = ['XPREF.1.SEG01.000.nc' ]
-Dvar_input = {'f1':['RI', 'CICE', 'RS','RG', 'CIFNFREE01','CIFNNUCL01' ]}
+Dvar_input = {'f1':[('RI','AVEF'), ('CICE','AVEF'), ('RS','AVEF'),('RG','AVEF'), ('CIFNFREE01','AVEF'),('CIFNNUCL01','AVEF') ]}
Dvar_input_coord_budget = {'f1':['cart_level', 'cart_ni']}
Dvar_input_coord = {'f1':['ZS','ZTOP']}
-# Add ___AVED to all variables
-for i,var in enumerate(Dvar_input['f1']):
- Dvar_input['f1'][i] = var + '___AVEF'
-#
# 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_coord = read_netcdf(LnameFiles, Dvar_input_coord, path=path, removeHALO=True)
-Dvar['f1']['altitude'], Dvar['f1']['ni_2D'] = comp_altitude1DVar(Dvar['f1']['CIFNFREE01'], 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'][('CIFNFREE01','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'],Dvar['f1']['CICE'], Dvar['f1']['RS'],
- Dvar['f1']['RG'],Dvar['f1']['CIFNFREE01'], Dvar['f1']['CIFNNUCL01']]
+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')]]
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/conf/profile_mesonh.ihm b/conf/profile_mesonh.ihm
index 7a9aa3618dc70b0056b463ac73f2742d1c3cf7b1..15b72a3c69916cd2e9d2c2a76affe343cf13be17 100755
--- a/conf/profile_mesonh.ihm
+++ b/conf/profile_mesonh.ihm
@@ -1,7 +1,7 @@
#!/bin/bash
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -81,6 +81,11 @@ export MNH_IOCDF4=${MNH_IOCDF4}
export VER_GRIBAPI=${VER_GRIBAPI}
export VERSION_GRIBAPI=${VERSION_GRIBAPI}
#
+# Version of ecCodes
+#
+export VERSION_ECCODES=${VERSION_ECCODES}
+export ECCODES_DEFINITION_PATH=${ECCODES_DEFINITION_PATH}
+#
# Version of Def integer
#
export MNH_INT=${MNH_INT}
diff --git a/src/LIB/Python/Panel_Plot.py b/src/LIB/Python/Panel_Plot.py
index 7fb3147dd9a0c45724dbcf80627b318c43bf9a73..24134085e04ad816580a545bfb65de987ec3db8b 100644
--- a/src/LIB/Python/Panel_Plot.py
+++ b/src/LIB/Python/Panel_Plot.py
@@ -294,10 +294,11 @@ class PanelPlot():
except:
pass
- # Color label on contour-ligne
+ # Color label on contour-line
if Lpltype[i]=='c': # Contour
- self.ax[iax].clabel(cf, levels=np.arange(Lminval[i],Lmaxval[i],step=Lstep[i]))
-
+ self.ax[iax].clabel(cf)
+ #self.ax[iax].clabel(cf, levels=np.arange(Lminval[i],Lmaxval[i],step=Lstep[i])) #TODO bug, levels not recognized
+
#Filling area under topography
if not orog==[]:
self.ax[iax].fill_between(Lxx[i][0,:], orog, color='black')
@@ -401,7 +402,7 @@ class PanelPlot():
def psectionH(self, lon=[],lat=[], Lvar=[], Lcarte=[], Llevel=[], Lxlab=[], Lylab=[], Ltitle=[], Lminval=[], Lmaxval=[],
Lstep=[], Lstepticks=[], Lcolormap=[], LcolorLine=[], Lcbarlabel=[], Lproj=[], Lfacconv=[], coastLines=True, ax=[],
- Lid_overlap=[], colorbar=True, Ltime=[], LaddWhite_cm=[], Lpltype=[]):
+ Lid_overlap=[], colorbar=True, Ltime=[], LaddWhite_cm=[], Lpltype=[], Lcbformatlabel=[]):
"""
Horizontal cross section plot
Arguments :
@@ -429,6 +430,7 @@ class PanelPlot():
- colorbar : show colorbar or not
- Lpltype : List of types of plot 'cf' or 'c'. cf=contourf, c=contour (lines only)
- LaddWhite_cm : List of boolean to add white color to a colormap at the first (low value) tick colorbar
+ - Lcbformatlabel: List of boolean to reduce the format to exponential 1.1E+02 format colorbar label
"""
self.ax = ax
firstCall = (len(self.ax) == 0)
@@ -447,6 +449,7 @@ class PanelPlot():
if not Lcolormap: LcolorLine=['black']*len(Lvar)
if not Lpltype: Lpltype=['cf']*len(Lvar)
if not LaddWhite_cm: LaddWhite_cm=[False]*len(Lvar)
+ if not Lcbformatlabel: Lcbformatlabel=[False]*len(Lvar)
# Add an extra percentage of the top max value for forcing the colorbar show the true user maximum value (correct a bug)
if Lstep: Lmaxval = list(map(lambda x, y: x + 1E-6*y, Lmaxval, Lstep) ) #The extra value is 1E-6 times the step ticks of the colorbar
@@ -501,22 +504,22 @@ class PanelPlot():
# Add White to colormap
if LaddWhite_cm[i] and Lcolormap: Lcolormap[i]=self.addWhitecm(LaddWhite_cm[i], Lcolormap[i], len(levels_contour))
-
+
# Plot
if Lproj:
if Lpltype[i]=='c': # Contour
if LcolorLine:
- cf = self.ax[iax].contourf(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,transform=Lproj[i],
+ cf = self.ax[iax].contour(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,transform=Lproj[i],
norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], colors=LcolorLine[i])
else:
- cf = self.ax[iax].contourf(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,transform=Lproj[i],
+ cf = self.ax[iax].contour(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,transform=Lproj[i],
norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], cmap=Lcolormap[i])
else:
cf = self.ax[iax].contourf(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,transform=Lproj[i],
norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], cmap=Lcolormap[i])
else: # Cartesian coordinates
if Lpltype[i]=='c': # Contour
- cf = self.ax[iax].contourf(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,
+ cf = self.ax[iax].contour(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,
norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], colors=LcolorLine[i])
else:
cf = self.ax[iax].contourf(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,
@@ -530,18 +533,21 @@ class PanelPlot():
# X/Y Axis
self.set_XYaxislab(self.ax, iax, Lxlab[i], Lylab[i])
- # Color label on contour-ligne
+ # Color label on contour-line
if Lpltype[i]=='c': # Contour
- self.ax[iax].clabel(cf, levels=np.arange(Lminval[i],Lmaxval[i],step=Lstep[i]))
+ if 'GeoAxes' in str(type(self.ax[self.i])): # cartopy does not like the levels arguments in clabel, known issue
+ self.ax[iax].clabel(cf)
+ else:
+ self.ax[iax].clabel(cf, levels=np.arange(Lminval[i],Lmaxval[i],step=Lstep[i]))
# Colorbar
if colorbar:
- cb=plt.colorbar(cf, ax=self.ax[iax], fraction=0.031, pad=self.colorbarpad, ticks=np.arange(Lminval[i],Lmaxval[i],Lstepticks[i]), aspect=self.colorbaraspect)
+ cb=plt.colorbar(cf, ax=self.ax[iax], fraction=0.031, pad=self.colorbarpad, ticks=np.arange(Lminval[i],Lmaxval[i],Lstepticks[i]), aspect=self.colorbaraspect)
cb.ax.set_title(Lcbarlabel[i], pad = self.labelcolorbarpad, loc='left') #This creates a new AxesSubplot only for the colorbar y=0 ==> location at the bottom
+ if Lcbformatlabel[i]: cb.ax.set_yticklabels(["{:.1E}".format(i) for i in cb.get_ticks()])
return self.fig
-
def pvector(self, Lxx=[], Lyy=[], Lvar1=[], Lvar2=[], Lcarte=[], Llevel=[], Lxlab=[], Lylab=[],
Ltitle=[], Lwidth=[], Larrowstep=[], Lcolor=[], Llegendval=[], Lcbarlabel=[],
Lproj=[], Lfacconv=[], ax=[], coastLines=True, Lid_overlap=[], Ltime=[], Lscale=[],
@@ -656,6 +662,107 @@ class PanelPlot():
return self.fig
+ def pstreamline(self, Lxx=[], Lyy=[], Lvar1=[], Lvar2=[], Lcarte=[], Llevel=[], Lxlab=[], Lylab=[], Llinewidth=[], Ldensity=[],
+ Ltitle=[], Lcolor=[], Lproj=[], Lfacconv=[], ax=[], coastLines=True, Lid_overlap=[], Ltime=[],
+ Lylim=[], Lxlim=[]):
+ """
+ Wind stream lines
+ Arguments :
+ - 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)
+ - Lvar2 : List of wind-component along y-axis : v-component for horizontal section / w-component for vertical section
+ - Lcarte : Zooming [lonmin, lonmax, latmin, latmax]
+ - Llevel : List of k-level value for the horizontal section plot (ignored if variable is already 2D)
+ - Lxlab : List of x-axis label
+ - Lylab : List of y-axis label
+ - Lxlim : List of x (min, max) value plotted
+ - Lylim : List of y (min, max) value plotted
+ - Ltitle : List of sub-titles
+ - Ltime : List of time (validity)
+ - Llinewidth : List of lines thickness
+ - Ldensity : List of density that control the closeness of streamlines
+ - Lcolor : List of colors for the streamline (default: black)
+ - Lproj : List of ccrs cartopy projection
+ - Lfacconv : List of factors for unit conversion of each variables
+ - coastLines : Boolean to plot coast lines and grid lines
+ - ax : List of fig.axes for ploting multiple different types of plots in a subplot panel
+ - Lid_overlap : List of number index of plot to overlap current variables
+ """
+ self.ax = ax
+ firstCall = (len(self.ax) == 0)
+ # If all plots are not using conversion factor, convert it to List
+ if not Lfacconv: Lfacconv = [1.0]*len(Lvar1)
+ if not Lcolor: Lcolor = ['black']*len(Lvar1)
+ if not Lylab: Lylab = ['']*len(Lvar1)
+ if not Lxlab: Lxlab = ['']*len(Lvar1)
+ if not Llinewidth: Llinewidth = [1.0]*len(Lvar1)
+ if not Ldensity: Ldensity = [1.0]*len(Lvar1)
+
+ # On all variables to plot
+ for i,var1 in enumerate(Lvar1):
+ if firstCall: #1st call
+ iax = i
+ if Lproj:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,i+1, projection = Lproj[i]))
+ else:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,i+1))
+ self.nb_graph+=1
+ elif Lid_overlap != []: #overlapping plot
+ iax = Lid_overlap[i]
+ else: #existing ax with no overlapping (graphd appended to existing panel)
+ if Lproj:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph+1, projection = Lproj[i]))
+ else:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph+1))
+ self.nb_graph+=1
+ iax = len(self.ax)-1 # The ax index of the new coming plot is the length of the existant ax -1 for indices matter
+
+ # Zooming
+ if len(Lcarte) == 4: #zoom
+ self.ax[iax].set_xlim(Lcarte[0], Lcarte[1])
+ self.ax[iax].set_ylim(Lcarte[2], Lcarte[3])
+
+ # Variable to plot w.r.t dimensions
+ if var1.ndim==2:
+ vartoPlot1 = var1[:,:]
+ vartoPlot2 = Lvar2[i][:,:]
+ else: # Variable is 3D : only for horizontal section
+ vartoPlot1 = var1[Llevel[i],:,:]
+ vartoPlot2 = Lvar2[i][Llevel[i],:,:]
+
+ # Print min/max val to help choose steps
+ self.set_minmaxText(self.ax, iax, np.sqrt(vartoPlot1**2 + vartoPlot2**2), Ltitle[i], Lid_overlap, Lfacconv[i])
+
+ # Print time validity
+ if Ltime: self.showTimeText(self.ax, iax, str(Ltime[i]))
+
+ # Plot
+ cf = self.ax[iax].streamplot(Lxx[i], Lyy[i], vartoPlot1, vartoPlot2, density=Ldensity[i], linewidth=Llinewidth[i], color=Lcolor[i])
+
+ # Title
+ self.set_Title(self.ax, iax, Ltitle[i], Lid_overlap,Lxlab[i], Lylab[i])
+
+ # X/Y Axis Label
+ self.set_XYaxislab(self.ax, iax, Lxlab[i], Lylab[i])
+
+ # X/Y Axis limits value
+ if Lxlim:
+ try:
+ self.set_xlim(self.ax, iax, Lxlim[i])
+ except:
+ pass
+ if Lylim:
+ try:
+ self.set_ylim(self.ax, iax, Lylim[i])
+ except:
+ pass
+
+ # Coastlines:
+ if Lproj: self.draw_Backmap(coastLines, self.ax[iax], Lproj[i])
+
+ return self.fig
+
def pXY_bar(self, Lbins=[], Lvar=[], Lxlab=[], Lylab=[], Ltitle=[], Lcolor=[], Lwidth=[],
Llinecolor=[], Llinewidth=[], Lfacconv=[], ax=[], id_overlap=None, Lxlim=[],
Lylim=[], Ltime=[], LaxisColor=[]):
diff --git a/src/LIB/Python/misc_functions.py b/src/LIB/Python/misc_functions.py
index e1e467a767691b327d4030445820299d6f77a3ca..6b2c0932742f0d47e6607275a890f990a50226ce 100644
--- a/src/LIB/Python/misc_functions.py
+++ b/src/LIB/Python/misc_functions.py
@@ -130,6 +130,10 @@ def comp_altitude2DVar(oneVar3D, orography, ztop, level, n_y, n_x):
n_x3D[i,:] = n_x
for i in range(oneVar3D.shape[2]):
for j in range(oneVar3D.shape[1]):
- for k in range(len(level)):
- altitude[k,j,i] = orography[j,i] + level[k]*((ztop-orography[j,i])/ztop)
+ 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
diff --git a/src/LIB/Python/read_MNHfile.py b/src/LIB/Python/read_MNHfile.py
index 375d5effe088b07bbf7331c92c53967154f5685c..7ad0bd539810b5413023b7339b11e479f3a7d548 100644
--- a/src/LIB/Python/read_MNHfile.py
+++ b/src/LIB/Python/read_MNHfile.py
@@ -31,8 +31,8 @@ def read_BACKUPfile(nameF, ifile, Dvar_input, Dvar_output, path='.', removeHALO=
Dvar_output[ifile] = {} #initialize dic for each files
# Reading date since beginning of the model run
- Dvar_output[ifile]['date'] = theFile.variables['time'].units
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)
for var in Dvar_input[ifile]: #For each files
# Read variables
@@ -186,11 +186,25 @@ def read_TIMESfiles_55(theFile, ifile, Dvar_input, Dvar_output, removeHALO=False
return Dvar_output
def read_from_group(theFile, Dvar_output, group_name, var):
- suffix, var_name = remove_PROC(var)
- if group_name == 'TSERIES': #always 1D
- Dvar_output[(group_name,var)] = theFile.groups['TSERIES'].variables[var][:]
- elif group_name == 'ZTSERIES': #always 2D
- Dvar_output[(group_name,var)] = theFile.groups['ZTSERIES'].variables[var][:,:].T
+ """
+ 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
@@ -213,7 +227,21 @@ def read_TIMESfiles_55(theFile, ifile, Dvar_input, Dvar_output, removeHALO=False
if shapeVar[2]==1: Ltosqueeze.append(2)
if shapeVar[3]==1: Ltosqueeze.append(3)
Ltosqueeze=tuple(Ltosqueeze)
- Dvar_output[group_name] = np.squeeze(theFile.groups[group_name].variables[suffix][:,:,:,:], axis=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
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index 041c3a85b1f926af62708756566e192c72a596ff..363f282eb9f96565a7d59f6bfad5c0cb492cae2b 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -14,6 +14,7 @@
! P. Wautelet 06/06/2019: bug correction in FIELDLIST_GOTO_MODEL (XLSTHM was overwritten if LUSERV=.FALSE. due to wrong IF block)
! P. Wautelet 19/06/2019: add Fieldlist_nmodel_resize subroutine + provide KMODEL to INI_FIELD_LIST when known
! P. Wautelet 23/01/2020: split in modd_field.f90 and mode_field.f90
+! JL Redelsperger 03/2021: add variables for Ocean LES and auto-coupled version
!-----------------------------------------------------------------
module mode_field
@@ -1047,6 +1048,32 @@ TFIELDLIST(IDX)%LTIMEDEP = .FALSE.
IDX = IDX+1
!
IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'LOCEAN'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'LOCEAN'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'Logical for Ocean MesoNH'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPELOG
+TFIELDLIST(IDX)%NDIMS = 0
+TFIELDLIST(IDX)%LTIMEDEP = .FALSE.
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'LCOUPLES'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'LCOUPLES'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'Logical for coupling O-A LES'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPELOG
+TFIELDLIST(IDX)%NDIMS = 0
+TFIELDLIST(IDX)%LTIMEDEP = .FALSE.
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
TFIELDLIST(IDX)%CMNHNAME = 'SURF'
TFIELDLIST(IDX)%CSTDNAME = ''
TFIELDLIST(IDX)%CLONGNAME = 'SURF'
@@ -1269,6 +1296,20 @@ ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
IDX = IDX+1
!
IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'PHIT'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'PHIT'
+TFIELDLIST(IDX)%CUNITS = 'Pa'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_Z_Reduced Pressure Oce/Shallow conv'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
TFIELDLIST(IDX)%CMNHNAME = 'RT'
TFIELDLIST(IDX)%CSTDNAME = ''
TFIELDLIST(IDX)%CLONGNAME = 'RT'
@@ -3449,6 +3490,31 @@ IDX = IDX+1
!END IF !LFILTERING
END IF !CPROGRAM==REAL .OR. LFICDF
!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'NFRCLT'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'NFRCLT'
+TFIELDLIST(IDX)%CUNITS = '1'
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'number of sea surface forcings + 1'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPEINT
+TFIELDLIST(IDX)%NDIMS = 0
+TFIELDLIST(IDX)%LTIMEDEP = .FALSE.
+IDX = IDX+1
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'NINFRT'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'NINFRT'
+TFIELDLIST(IDX)%CUNITS = 's'
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'Interval in seconds between forcings'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPEINT
+TFIELDLIST(IDX)%NDIMS = 0
+TFIELDLIST(IDX)%LTIMEDEP = .FALSE.
+IDX = IDX+1
+!
!
WRITE(YMSG,'("number of used fields=",I4," out of ",I4)') IDX-1,MAXFIELDS
CALL PRINT_MSG(NVERB_INFO,'GEN','INI_FIELD_LIST',TRIM(YMSG))
@@ -3724,6 +3790,7 @@ USE MODD_GRID_n
USE MODD_HURR_FIELD_n
USE MODD_LIMA_PRECIP_SCAVENGING_n
USE MODD_LSFIELD_n
+USE MODD_OCEANH
USE MODD_PARAM_n
USE MODD_PAST_FIELD_n
USE MODD_CH_PH_n
@@ -3792,6 +3859,7 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('WT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(K
CALL FIND_FIELD_ID_FROM_MNHNAME('THT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XTHT
CALL FIND_FIELD_ID_FROM_MNHNAME('TKET', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XTKET
CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XPABST
+CALL FIND_FIELD_ID_FROM_MNHNAME('PHIT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XPHIT
CALL FIND_FIELD_ID_FROM_MNHNAME('RT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X4D(KFROM)%DATA => XRT
!
IF (ASSOCIATED(XRT)) THEN
@@ -3926,7 +3994,7 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('LSUM', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(K
CALL FIND_FIELD_ID_FROM_MNHNAME('LSVM', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XLSVM
CALL FIND_FIELD_ID_FROM_MNHNAME('LSWM', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XLSWM
CALL FIND_FIELD_ID_FROM_MNHNAME('LSTHM',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XLSTHM
-IF ( LUSERV ) THEN
+IF (LUSERV) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('LSRVM',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XLSRVM
END IF
CALL FIND_FIELD_ID_FROM_MNHNAME('LBXUM', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XLBXUM
@@ -4107,6 +4175,7 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('WT', IID,IRESP); XWT => TFIELDLIST(IID)%TF
CALL FIND_FIELD_ID_FROM_MNHNAME('THT', IID,IRESP); XTHT => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('TKET', IID,IRESP); XTKET => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP); XPABST => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('PHIT', IID,IRESP); XPHIT => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('RT', IID,IRESP); XRT => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA
!
IF (ASSOCIATED(XRT)) THEN
@@ -4253,7 +4322,7 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('LSUM', IID,IRESP); XLSUM => TFIELDLIST(IID)%TF
CALL FIND_FIELD_ID_FROM_MNHNAME('LSVM', IID,IRESP); XLSVM => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('LSWM', IID,IRESP); XLSWM => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('LSTHM',IID,IRESP); XLSTHM => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
-IF ( LUSERV ) THEN
+IF (LUSERV) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('LSRVM',IID,IRESP); XLSRVM => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
END IF
CALL FIND_FIELD_ID_FROM_MNHNAME('LBXUM', IID,IRESP); XLBXUM => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index 24c12e9975d2d6381b4a61a53498f0e98760f3d3..b48a37b2649d4d8ae06964e24a736db43439cbaf 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -4240,7 +4240,7 @@ SUBROUTINE IO_Field_user_write(TPOUTPUT)
!
#if 0
USE MODD_DYN_n, ONLY: XTSTEP
-USE MODD_FIELD_n, ONLY: XUT, XVT, XRT, XTHT
+USE MODD_FIELD_n, ONLY: XUT, XVT, XRT, XTHT, XSVT
USE MODD_PARAMETERS, ONLY: JPVEXT
USE MODD_PRECIP_n, ONLY: XINPRR
#endif
@@ -4317,6 +4317,19 @@ TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
!XACPRR is multiplied by 1000. to convert from m to kg m-2 (water density is assumed to be 1000 kg m-3)
CALL IO_Field_write(TPOUTPUT%TFILE,TZFIELD,XINPRR*XTSTEP*1.0E3)
+!
+TZFIELD%CMNHNAME = 'SVT001'
+TZFIELD%CSTDNAME = 'concentration in scalar variable'
+TZFIELD%CLONGNAME = ''
+TZFIELD%CUNITS = 'kg kg-1'
+TZFIELD%CDIR = 'XY'
+TZFIELD%CCOMMENT = 'X_Y_Z_concentration in scalar variable'
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPEREAL
+TZFIELD%NDIMS = 3
+TZFIELD%LTIMEDEP = .TRUE.
+CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,XSVT(:,:,:,1))
+!
#endif
!
END SUBROUTINE IO_Field_user_write
diff --git a/src/LIB/eccodes-2.18.0-Source.tar.gz b/src/LIB/eccodes-2.18.0-Source.tar.gz
new file mode 100644
index 0000000000000000000000000000000000000000..f212b62eb2df59168e02d8377b4fd4a225c02db6
--- /dev/null
+++ b/src/LIB/eccodes-2.18.0-Source.tar.gz
@@ -0,0 +1,3 @@
+version https://git-lfs.github.com/spec/v1
+oid sha256:d88943df0f246843a1a062796edbf709ef911de7269648eef864be259e9704e3
+size 11525701
diff --git a/src/LIB/minpack/LICENCE b/src/LIB/minpack/LICENCE
new file mode 100644
index 0000000000000000000000000000000000000000..132cc3f33fa7fd4169a92b05241db59c8428a7ab
--- /dev/null
+++ b/src/LIB/minpack/LICENCE
@@ -0,0 +1,51 @@
+Minpack Copyright Notice (1999) University of Chicago. All rights reserved
+
+Redistribution and use in source and binary forms, with or
+without modification, are permitted provided that the
+following conditions are met:
+
+1. Redistributions of source code must retain the above
+copyright notice, this list of conditions and the following
+disclaimer.
+
+2. Redistributions in binary form must reproduce the above
+copyright notice, this list of conditions and the following
+disclaimer in the documentation and/or other materials
+provided with the distribution.
+
+3. The end-user documentation included with the
+redistribution, if any, must include the following
+acknowledgment:
+
+ "This product includes software developed by the
+ University of Chicago, as Operator of Argonne National
+ Laboratory.
+
+Alternately, this acknowledgment may appear in the software
+itself, if and wherever such third-party acknowledgments
+normally appear.
+
+4. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS"
+WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER, THE
+UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND
+THEIR EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE
+OR NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY
+OR RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR
+USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF
+THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4)
+DO NOT WARRANT THAT THE SOFTWARE WILL FUNCTION
+UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL
+BE CORRECTED.
+
+5. LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT
+HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF
+ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT,
+INCIDENTAL, CONSEQUENTIAL, SPECIAL OR PUNITIVE DAMAGES OF
+ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF
+PROFITS OR LOSS OF DATA, FOR ANY REASON WHATSOEVER, WHETHER
+SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT
+(INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE,
+EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED OF THE
+POSSIBILITY OF SUCH LOSS OR DAMAGES.
diff --git a/src/LIB/minpack/minpack.f90 b/src/LIB/minpack/minpack.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c927712e40538d3f25197984d88e40d459f953e7
--- /dev/null
+++ b/src/LIB/minpack/minpack.f90
@@ -0,0 +1,5780 @@
+!!$ Minpack Copyright Notice (1999) University of Chicago. All rights reserved
+!!$
+!!$ Redistribution and use in source and binary forms, with or
+!!$ without modification, are permitted provided that the
+!!$ following conditions are met:
+!!$
+!!$ 1. Redistributions of source code must retain the above
+!!$ copyright notice, this list of conditions and the following
+!!$ disclaimer.
+!!$
+!!$ 2. Redistributions in binary form must reproduce the above
+!!$ copyright notice, this list of conditions and the following
+!!$ disclaimer in the documentation and/or other materials
+!!$ provided with the distribution.
+!!$
+!!$ 3. The end-user documentation included with the
+!!$ redistribution, if any, must include the following
+!!$ acknowledgment:
+!!$
+!!$ "This product includes software developed by the
+!!$ University of Chicago, as Operator of Argonne National
+!!$ Laboratory."
+!!$
+!!$ Alternately, this acknowledgment may appear in the software
+!!$ itself, if and wherever such third-party acknowledgments
+!!$ normally appear.
+!!$
+!!$ 4. WARRANTY DISCLAIMER. THE SOFTWARE IS SUPPLIED "AS IS"
+!!$ WITHOUT WARRANTY OF ANY KIND. THE COPYRIGHT HOLDER, THE
+!!$ UNITED STATES, THE UNITED STATES DEPARTMENT OF ENERGY, AND
+!!$ THEIR EMPLOYEES: (1) DISCLAIM ANY WARRANTIES, EXPRESS OR
+!!$ IMPLIED, INCLUDING BUT NOT LIMITED TO ANY IMPLIED WARRANTIES
+!!$ OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, TITLE
+!!$ OR NON-INFRINGEMENT, (2) DO NOT ASSUME ANY LEGAL LIABILITY
+!!$ OR RESPONSIBILITY FOR THE ACCURACY, COMPLETENESS, OR
+!!$ USEFULNESS OF THE SOFTWARE, (3) DO NOT REPRESENT THAT USE OF
+!!$ THE SOFTWARE WOULD NOT INFRINGE PRIVATELY OWNED RIGHTS, (4)
+!!$ DO NOT WARRANT THAT THE SOFTWARE WILL FUNCTION
+!!$ UNINTERRUPTED, THAT IT IS ERROR-FREE OR THAT ANY ERRORS WILL
+!!$ BE CORRECTED.
+!!$
+!!$ 5. LIMITATION OF LIABILITY. IN NO EVENT WILL THE COPYRIGHT
+!!$ HOLDER, THE UNITED STATES, THE UNITED STATES DEPARTMENT OF
+!!$ ENERGY, OR THEIR EMPLOYEES: BE LIABLE FOR ANY INDIRECT,
+!!$ INCIDENTAL, CONSEQUENTIAL, SPECIAL OR PUNITIVE DAMAGES OF
+!!$ ANY KIND OR NATURE, INCLUDING BUT NOT LIMITED TO LOSS OF
+!!$ PROFITS OR LOSS OF DATA, FOR ANY REASON WHATSOEVER, WHETHER
+!!$ SUCH LIABILITY IS ASSERTED ON THE BASIS OF CONTRACT, TORT
+!!$ (INCLUDING NEGLIGENCE OR STRICT LIABILITY), OR OTHERWISE,
+!!$ EVEN IF ANY OF SAID PARTIES HAS BEEN WARNED OF THE
+!!$ POSSIBILITY OF SUCH LOSS OR DAMAGES.
+
+subroutine chkder ( m, n, x, fvec, fjac, ldfjac, xp, fvecp, mode, err )
+
+!*****************************************************************************80
+!
+!! CHKDER checks the gradients of M functions of N variables.
+!
+! Discussion:
+!
+! CHKDER checks the gradients of M nonlinear functions in N variables,
+! evaluated at a point X, for consistency with the functions themselves.
+!
+! The user calls CHKDER twice, first with MODE = 1 and then with MODE = 2.
+!
+! MODE = 1.
+! On input,
+! X contains the point of evaluation.
+! On output,
+! XP is set to a neighboring point.
+!
+! Now the user must evaluate the function and gradients at X, and the
+! function at XP. Then the subroutine is called again:
+!
+! MODE = 2.
+! On input,
+! FVEC contains the function values at X,
+! FJAC contains the function gradients at X.
+! FVECP contains the functions evaluated at XP.
+! On output,
+! ERR contains measures of correctness of the respective gradients.
+!
+! The subroutine does not perform reliably if cancellation or
+! rounding errors cause a severe loss of significance in the
+! evaluation of a function. Therefore, none of the components
+! of X should be unusually small (in particular, zero) or any
+! other value which may cause loss of significance.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, is the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+!
+! Input, real ( kind = 8 ) X(N), the point at which the jacobian is to be
+! evaluated.
+!
+! Input, real ( kind = 8 ) FVEC(M), is used only when MODE = 2.
+! In that case, it should contain the function values at X.
+!
+! Input, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. When MODE = 2,
+! FJAC(I,J) should contain the value of dF(I)/dX(J).
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least M.
+!
+! Output, real ( kind = 8 ) XP(N), on output with MODE = 1, is a neighboring
+! point of X, at which the function is to be evaluated.
+!
+! Input, real ( kind = 8 ) FVECP(M), on input with MODE = 2, is the function
+! value at XP.
+!
+! Input, integer ( kind = 4 ) MODE, should be set to 1 on the first call, and
+! 2 on the second.
+!
+! Output, real ( kind = 8 ) ERR(M). On output when MODE = 2, ERR contains
+! measures of correctness of the respective gradients. If there is no
+! severe loss of significance, then if ERR(I):
+! = 1.0D+00, the I-th gradient is correct,
+! = 0.0D+00, the I-th gradient is incorrect.
+! > 0.5D+00, the I-th gradient is probably correct.
+! < 0.5D+00, the I-th gradient is probably incorrect.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) eps
+ real ( kind = 8 ) epsf
+ real ( kind = 8 ) epslog
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) err(m)
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) fvecp(m)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) mode
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xp(n)
+
+ epsmch = epsilon ( epsmch )
+ eps = sqrt ( epsmch )
+!
+! MODE = 1.
+!
+ if ( mode == 1 ) then
+
+ do j = 1, n
+ temp = eps * abs ( x(j) )
+ if ( temp == 0.0D+00 ) then
+ temp = eps
+ end if
+ xp(j) = x(j) + temp
+ end do
+!
+! MODE = 2.
+!
+ else if ( mode == 2 ) then
+
+ epsf = 100.0D+00 * epsmch
+ epslog = log10 ( eps )
+
+ err = 0.0D+00
+
+ do j = 1, n
+ temp = abs ( x(j) )
+ if ( temp == 0.0D+00 ) then
+ temp = 1.0D+00
+ end if
+ err(1:m) = err(1:m) + temp * fjac(1:m,j)
+ end do
+
+ do i = 1, m
+
+ temp = 1.0D+00
+
+ if ( fvec(i) /= 0.0D+00 .and. fvecp(i) /= 0.0D+00 .and. &
+ abs ( fvecp(i)-fvec(i)) >= epsf * abs ( fvec(i) ) ) then
+ temp = eps * abs ( (fvecp(i)-fvec(i)) / eps - err(i) ) &
+ / ( abs ( fvec(i) ) + abs ( fvecp(i) ) )
+ end if
+
+ err(i) = 1.0D+00
+
+ if ( epsmch < temp .and. temp < eps ) then
+ err(i) = ( log10 ( temp ) - epslog ) / epslog
+ end if
+
+ if ( eps <= temp ) then
+ err(i) = 0.0D+00
+ end if
+
+ end do
+
+ end if
+
+ return
+end
+subroutine dogleg ( n, r, lr, diag, qtb, delta, x )
+
+!*****************************************************************************80
+!
+!! DOGLEG finds the minimizing combination of Gauss-Newton and gradient steps.
+!
+! Discussion:
+!
+! Given an M by N matrix A, an N by N nonsingular diagonal
+! matrix D, an M-vector B, and a positive number DELTA, the
+! problem is to determine the convex combination X of the
+! Gauss-Newton and scaled gradient directions that minimizes
+! (A*X - B) in the least squares sense, subject to the
+! restriction that the euclidean norm of D*X be at most DELTA.
+!
+! This subroutine completes the solution of the problem
+! if it is provided with the necessary information from the
+! QR factorization of A. That is, if A = Q*R, where Q has
+! orthogonal columns and R is an upper triangular matrix,
+! then DOGLEG expects the full upper triangle of R and
+! the first N components of Q'*B.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of the matrix R.
+!
+! Input, real ( kind = 8 ) R(LR), the upper triangular matrix R stored
+! by rows.
+!
+! Input, integer ( kind = 4 ) LR, the size of the R array, which must be
+! no less than (N*(N+1))/2.
+!
+! Input, real ( kind = 8 ) DIAG(N), the diagonal elements of the matrix D.
+!
+! Input, real ( kind = 8 ) QTB(N), the first N elements of the vector Q'* B.
+!
+! Input, real ( kind = 8 ) DELTA, is a positive upper bound on the
+! euclidean norm of D*X(1:N).
+!
+! Output, real ( kind = 8 ) X(N), the desired convex combination of the
+! Gauss-Newton direction and the scaled gradient direction.
+!
+ implicit none
+
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) alpha
+ real ( kind = 8 ) bnorm
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) gnorm
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) jj
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ real ( kind = 8 ) qnorm
+ real ( kind = 8 ) qtb(n)
+ real ( kind = 8 ) r(lr)
+ real ( kind = 8 ) sgnorm
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) x(n)
+
+ epsmch = epsilon ( epsmch )
+!
+! Calculate the Gauss-Newton direction.
+!
+ jj = ( n * ( n + 1 ) ) / 2 + 1
+
+ do k = 1, n
+
+ j = n - k + 1
+ jj = jj - k
+ l = jj + 1
+ sum2 = 0.0D+00
+
+ do i = j + 1, n
+ sum2 = sum2 + r(l) * x(i)
+ l = l + 1
+ end do
+
+ temp = r(jj)
+
+ if ( temp == 0.0D+00 ) then
+
+ l = j
+ do i = 1, j
+ temp = max ( temp, abs ( r(l)) )
+ l = l + n - i
+ end do
+
+ if ( temp == 0.0D+00 ) then
+ temp = epsmch
+ else
+ temp = epsmch * temp
+ end if
+
+ end if
+
+ x(j) = ( qtb(j) - sum2 ) / temp
+
+ end do
+!
+! Test whether the Gauss-Newton direction is acceptable.
+!
+ wa1(1:n) = 0.0D+00
+ wa2(1:n) = diag(1:n) * x(1:n)
+ qnorm = enorm ( n, wa2 )
+
+ if ( qnorm <= delta ) then
+ return
+ end if
+!
+! The Gauss-Newton direction is not acceptable.
+! Calculate the scaled gradient direction.
+!
+ l = 1
+ do j = 1, n
+ temp = qtb(j)
+ do i = j, n
+ wa1(i) = wa1(i) + r(l) * temp
+ l = l + 1
+ end do
+ wa1(j) = wa1(j) / diag(j)
+ end do
+!
+! Calculate the norm of the scaled gradient.
+! Test for the special case in which the scaled gradient is zero.
+!
+ gnorm = enorm ( n, wa1 )
+ sgnorm = 0.0D+00
+ alpha = delta / qnorm
+
+ if ( gnorm /= 0.0D+00 ) then
+!
+! Calculate the point along the scaled gradient which minimizes the quadratic.
+!
+ wa1(1:n) = ( wa1(1:n) / gnorm ) / diag(1:n)
+
+ l = 1
+ do j = 1, n
+ sum2 = 0.0D+00
+ do i = j, n
+ sum2 = sum2 + r(l) * wa1(i)
+ l = l + 1
+ end do
+ wa2(j) = sum2
+ end do
+
+ temp = enorm ( n, wa2 )
+ sgnorm = ( gnorm / temp ) / temp
+!
+! Test whether the scaled gradient direction is acceptable.
+!
+ alpha = 0.0D+00
+!
+! The scaled gradient direction is not acceptable.
+! Calculate the point along the dogleg at which the quadratic is minimized.
+!
+ if ( sgnorm < delta ) then
+
+ bnorm = enorm ( n, qtb )
+ temp = ( bnorm / gnorm ) * ( bnorm / qnorm ) * ( sgnorm / delta )
+ temp = temp - ( delta / qnorm ) * ( sgnorm / delta) ** 2 &
+ + sqrt ( ( temp - ( delta / qnorm ) ) ** 2 &
+ + ( 1.0D+00 - ( delta / qnorm ) ** 2 ) &
+ * ( 1.0D+00 - ( sgnorm / delta ) ** 2 ) )
+
+ alpha = ( ( delta / qnorm ) * ( 1.0D+00 - ( sgnorm / delta ) ** 2 ) ) &
+ / temp
+
+ end if
+
+ end if
+!
+! Form appropriate convex combination of the Gauss-Newton
+! direction and the scaled gradient direction.
+!
+ temp = ( 1.0D+00 - alpha ) * min ( sgnorm, delta )
+
+ x(1:n) = temp * wa1(1:n) + alpha * x(1:n)
+
+ return
+end
+function enorm ( n, x )
+
+!*****************************************************************************80
+!
+!! ENORM computes the Euclidean norm of a vector.
+!
+! Discussion:
+!
+! This is an extremely simplified version of the original ENORM
+! routine, which has been renamed to "ENORM2".
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, is the length of the vector.
+!
+! Input, real ( kind = 8 ) X(N), the vector whose norm is desired.
+!
+! Output, real ( kind = 8 ) ENORM, the Euclidean norm of the vector.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) enorm
+
+ enorm = sqrt ( sum ( x(1:n) ** 2 ))
+
+ return
+end
+function enorm2 ( n, x )
+
+!*****************************************************************************80
+!
+!! ENORM2 computes the Euclidean norm of a vector.
+!
+! Discussion:
+!
+! This routine was named ENORM. It has been renamed "ENORM2",
+! and a simplified routine has been substituted.
+!
+! The Euclidean norm is computed by accumulating the sum of
+! squares in three different sums. The sums of squares for the
+! small and large components are scaled so that no overflows
+! occur. Non-destructive underflows are permitted. Underflows
+! and overflows do not occur in the computation of the unscaled
+! sum of squares for the intermediate components.
+!
+! The definitions of small, intermediate and large components
+! depend on two constants, RDWARF and RGIANT. The main
+! restrictions on these constants are that RDWARF^2 not
+! underflow and RGIANT^2 not overflow.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1
+! Argonne National Laboratory,
+! Argonne, Illinois.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, is the length of the vector.
+!
+! Input, real ( kind = 8 ) X(N), the vector whose norm is desired.
+!
+! Output, real ( kind = 8 ) ENORM2, the Euclidean norm of the vector.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) agiant
+ real ( kind = 8 ) enorm2
+ integer ( kind = 4 ) i
+ real ( kind = 8 ) rdwarf
+ real ( kind = 8 ) rgiant
+ real ( kind = 8 ) s1
+ real ( kind = 8 ) s2
+ real ( kind = 8 ) s3
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xabs
+ real ( kind = 8 ) x1max
+ real ( kind = 8 ) x3max
+
+ rdwarf = sqrt ( tiny ( rdwarf ) )
+ rgiant = sqrt ( huge ( rgiant ) )
+
+ s1 = 0.0D+00
+ s2 = 0.0D+00
+ s3 = 0.0D+00
+ x1max = 0.0D+00
+ x3max = 0.0D+00
+ agiant = rgiant / real ( n, kind = 8 )
+
+ do i = 1, n
+
+ xabs = abs ( x(i) )
+
+ if ( xabs <= rdwarf ) then
+
+ if ( x3max < xabs ) then
+ s3 = 1.0D+00 + s3 * ( x3max / xabs ) ** 2
+ x3max = xabs
+ else if ( xabs /= 0.0D+00 ) then
+ s3 = s3 + ( xabs / x3max ) ** 2
+ end if
+
+ else if ( agiant <= xabs ) then
+
+ if ( x1max < xabs ) then
+ s1 = 1.0D+00 + s1 * ( x1max / xabs ) ** 2
+ x1max = xabs
+ else
+ s1 = s1 + ( xabs / x1max ) ** 2
+ end if
+
+ else
+
+ s2 = s2 + xabs ** 2
+
+ end if
+
+ end do
+!
+! Calculation of norm.
+!
+ if ( s1 /= 0.0D+00 ) then
+
+ enorm2 = x1max * sqrt ( s1 + ( s2 / x1max ) / x1max )
+
+ else if ( s2 /= 0.0D+00 ) then
+
+ if ( x3max <= s2 ) then
+ enorm2 = sqrt ( s2 * ( 1.0D+00 + ( x3max / s2 ) * ( x3max * s3 ) ) )
+ else
+ enorm2 = sqrt ( x3max * ( ( s2 / x3max ) + ( x3max * s3 ) ) )
+ end if
+
+ else
+
+ enorm2 = x3max * sqrt ( s3 )
+
+ end if
+
+ return
+end
+subroutine fdjac1 ( fcn, n, x, fvec, fjac, ldfjac, iflag, ml, mu, epsfcn )
+
+!*****************************************************************************80
+!
+!! FDJAC1 estimates an N by N jacobian matrix using forward differences.
+!
+! Discussion:
+!
+! This subroutine computes a forward-difference approximation
+! to the N by N jacobian matrix associated with a specified
+! problem of N functions in N variables. If the jacobian has
+! a banded form, then function evaluations are saved by only
+! approximating the nonzero terms.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input, real ( kind = 8 ) X(N), the point where the jacobian is evaluated.
+!
+! Input, real ( kind = 8 ) FVEC(N), the functions evaluated at X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), the N by N approximate
+! jacobian matrix.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC, which
+! must not be less than N.
+!
+! Output, integer ( kind = 4 ) IFLAG, is an error flag returned by FCN.
+! If FCN returns a nonzero value of IFLAG, then this routine returns
+! immediately to the calling program, with the value of IFLAG.
+!
+! Input, integer ( kind = 4 ) ML, MU, specify the number of subdiagonals and
+! superdiagonals within the band of the jacobian matrix. If the
+! jacobian is not banded, set ML and MU to N-1.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable step
+! length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) eps
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(n)
+ real ( kind = 8 ) h
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) ml
+ integer ( kind = 4 ) msum
+ integer ( kind = 4 ) mu
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) x(n)
+
+ epsmch = epsilon ( epsmch )
+
+ eps = sqrt ( max ( epsfcn, epsmch ) )
+ msum = ml + mu + 1
+!
+! Computation of dense approximate jacobian.
+!
+ if ( n <= msum ) then
+
+ do j = 1, n
+
+ temp = x(j)
+ h = eps * abs ( temp )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+
+ iflag = 1
+ x(j) = temp + h
+ call fcn ( n, x, wa1, iflag )
+
+ if ( iflag < 0 ) then
+ exit
+ end if
+
+ x(j) = temp
+ fjac(1:n,j) = ( wa1(1:n) - fvec(1:n) ) / h
+
+ end do
+
+ else
+!
+! Computation of banded approximate jacobian.
+!
+ do k = 1, msum
+
+ do j = k, n, msum
+ wa2(j) = x(j)
+ h = eps * abs ( wa2(j) )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+ x(j) = wa2(j) + h
+ end do
+
+ iflag = 1
+ call fcn ( n, x, wa1, iflag )
+
+ if ( iflag < 0 ) then
+ exit
+ end if
+
+ do j = k, n, msum
+
+ x(j) = wa2(j)
+
+ h = eps * abs ( wa2(j) )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+
+ fjac(1:n,j) = 0.0D+00
+
+ do i = 1, n
+ if ( j - mu <= i .and. i <= j + ml ) then
+ fjac(i,j) = ( wa1(i) - fvec(i) ) / h
+ end if
+ end do
+
+ end do
+
+ end do
+
+ end if
+
+ return
+end
+subroutine fdjac2 ( fcn, m, n, x, fvec, fjac, ldfjac, iflag, epsfcn )
+
+!*****************************************************************************80
+!
+!! FDJAC2 estimates an M by N jacobian matrix using forward differences.
+!
+! Discussion:
+!
+! This subroutine computes a forward-difference approximation
+! to the M by N jacobian matrix associated with a specified
+! problem of M functions in N variables.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( m, n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, is the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+! N must not exceed M.
+!
+! Input, real ( kind = 8 ) X(N), the point where the jacobian is evaluated.
+!
+! Input, real ( kind = 8 ) FVEC(M), the functions evaluated at X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), the M by N approximate
+! jacobian matrix.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC,
+! which must not be less than M.
+!
+! Output, integer ( kind = 4 ) IFLAG, is an error flag returned by FCN.
+! If FCN returns a nonzero value of IFLAG, then this routine returns
+! immediately to the calling program, with the value of IFLAG.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable
+! step length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) eps
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) h
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) j
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(m)
+ real ( kind = 8 ) x(n)
+
+ epsmch = epsilon ( epsmch )
+
+ eps = sqrt ( max ( epsfcn, epsmch ) )
+
+ do j = 1, n
+
+ temp = x(j)
+ h = eps * abs ( temp )
+ if ( h == 0.0D+00 ) then
+ h = eps
+ end if
+
+ iflag = 1
+ x(j) = temp + h
+ call fcn ( m, n, x, wa, iflag )
+
+ if ( iflag < 0 ) then
+ exit
+ end if
+
+ x(j) = temp
+ fjac(1:m,j) = ( wa(1:m) - fvec(1:m) ) / h
+
+ end do
+
+ return
+end
+subroutine hybrd ( fcn, n, x, fvec, xtol, maxfev, ml, mu, epsfcn, diag, mode, &
+ factor, nprint, info, nfev, fjac, ldfjac, r, lr, qtf )
+
+!*****************************************************************************80
+!
+!! HYBRD seeks a zero of N nonlinear equations in N variables.
+!
+! Discussion:
+!
+! HYBRD finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. The user must provide a
+! subroutine which calculates the functions. The jacobian is
+! then calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN is at least MAXFEV by the end of an iteration.
+!
+! Input, integer ( kind = 4 ) ML, MU, specify the number of subdiagonals and
+! superdiagonals within the band of the jacobian matrix. If the jacobian
+! is not banded, set ML and MU to at least n - 1.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable step
+! length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of
+! iterates if it is positive. In this case, FCN is called with IFLAG = 0 at
+! the beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG.
+! See the description of FCN.
+! Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, relative error between two consecutive iterates is at most XTOL.
+! 2, number of calls to FCN has reached or exceeded MAXFEV.
+! 3, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 4, iteration is not making good progress, as measured by the improvement
+! from the last five jacobian evaluations.
+! 5, iteration is not making good progress, as measured by the improvement
+! from the last ten iterations.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array which contains
+! the orthogonal matrix Q produced by the QR factorization of the final
+! approximate jacobian.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Output, real ( kind = 8 ) R(LR), the upper triangular matrix produced by
+! the QR factorization of the final approximate jacobian, stored rowwise.
+!
+! Input, integer ( kind = 4 ) LR, the size of the R array, which must be no
+! less than (N*(N+1))/2.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the vector Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) iwa(1)
+ integer ( kind = 4 ) j
+ logical jeval
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) ml
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) msum
+ integer ( kind = 4 ) mu
+ integer ( kind = 4 ) ncfail
+ integer ( kind = 4 ) nslow1
+ integer ( kind = 4 ) nslow2
+ integer ( kind = 4 ) ncsuc
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r(lr)
+ real ( kind = 8 ) ratio
+ logical sing
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(n)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ return
+ else if ( xtol < 0.0D+00 ) then
+ return
+ else if ( maxfev <= 0 ) then
+ return
+ else if ( ml < 0 ) then
+ return
+ else if ( mu < 0 ) then
+ return
+ else if ( factor <= 0.0D+00 ) then
+ return
+ else if ( ldfjac < n ) then
+ return
+ else if ( lr < ( n * ( n + 1 ) ) / 2 ) then
+ return
+ end if
+
+ if ( mode == 2 ) then
+
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 300
+ end if
+ end do
+
+ end if
+!
+! Evaluate the function at the starting point
+! and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, x, fvec, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm = enorm ( n, fvec )
+!
+! Determine the number of calls to FCN needed to compute the jacobian matrix.
+!
+ msum = min ( ml + mu + 1, n )
+!
+! Initialize iteration counter and monitors.
+!
+ iter = 1
+ ncsuc = 0
+ ncfail = 0
+ nslow1 = 0
+ nslow2 = 0
+!
+! Beginning of the outer loop.
+!
+30 continue
+
+ jeval = .true.
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fdjac1 ( fcn, n, x, fvec, fjac, ldfjac, iflag, ml, mu, epsfcn )
+
+ nfev = nfev + msum
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .false.
+ call qrfac ( n, n, fjac, ldfjac, pivot, iwa, 1, wa1, wa2 )
+!
+! On the first iteration, if MODE is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Form Q' * FVEC and store in QTF.
+!
+ qtf(1:n) = fvec(1:n)
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ temp = - dot_product ( qtf(j:n), fjac(j:n,j) ) / fjac(j,j)
+ qtf(j:n) = qtf(j:n) + fjac(j:n,j) * temp
+ end if
+
+ end do
+!
+! Copy the triangular factor of the QR factorization into R.
+!
+ sing = .false.
+
+ do j = 1, n
+ l = j
+ do i = 1, j - 1
+ r(l) = fjac(i,j)
+ l = l + n - i
+ end do
+ r(l) = wa1(j)
+ if ( wa1(j) == 0.0D+00 ) then
+ sing = .true.
+ end if
+ end do
+!
+! Accumulate the orthogonal factor in FJAC.
+!
+ call qform ( n, n, fjac, ldfjac )
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+180 continue
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( n, x, fvec, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ end if
+!
+! Determine the direction P.
+!
+ call dogleg ( n, r, lr, diag, qtf, delta, wa1 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = - wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, wa2, wa4, iflag )
+ nfev = nfev + 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm1 = enorm ( n, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ actred = -1.0D+00
+ if ( fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ endif
+!
+! Compute the scaled predicted reduction.
+!
+ l = 1
+ do i = 1, n
+ sum2 = 0.0D+00
+ do j = i, n
+ sum2 = sum2 + r(l) * wa1(j)
+ l = l + 1
+ end do
+ wa3(i) = qtf(i) + sum2
+ end do
+
+ temp = enorm ( n, wa3 )
+ prered = 0.0D+00
+ if ( temp < fnorm ) then
+ prered = 1.0D+00 - ( temp / fnorm ) ** 2
+ end if
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ ratio = 0.0D+00
+ if ( 0.0D+00 < prered ) then
+ ratio = actred / prered
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio < 0.1D+00 ) then
+
+ ncsuc = 0
+ ncfail = ncfail + 1
+ delta = 0.5D+00 * delta
+
+ else
+
+ ncfail = 0
+ ncsuc = ncsuc + 1
+
+ if ( 0.5D+00 <= ratio .or. 1 < ncsuc ) then
+ delta = max ( delta, pnorm / 0.5D+00 )
+ end if
+
+ if ( abs ( ratio - 1.0D+00 ) <= 0.1D+00 ) then
+ delta = pnorm / 0.5D+00
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+! Successful iteration.
+! Update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:n) = wa4(1:n)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Determine the progress of the iteration.
+!
+ nslow1 = nslow1 + 1
+ if ( 0.001D+00 <= actred ) then
+ nslow1 = 0
+ end if
+
+ if ( jeval ) then
+ nslow2 = nslow2 + 1
+ end if
+
+ if ( 0.1D+00 <= actred ) then
+ nslow2 = 0
+ end if
+!
+! Test for convergence.
+!
+ if ( delta <= xtol * xnorm .or. fnorm == 0.0D+00 ) then
+ info = 1
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( maxfev <= nfev ) then
+ info = 2
+ end if
+
+ if ( 0.1D+00 * max ( 0.1D+00 * delta, pnorm ) <= epsmch * xnorm ) then
+ info = 3
+ end if
+
+ if ( nslow2 == 5 ) then
+ info = 4
+ end if
+
+ if ( nslow1 == 10 ) then
+ info = 5
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Criterion for recalculating jacobian approximation
+! by forward differences.
+!
+ if ( ncfail == 2 ) then
+ go to 290
+ end if
+!
+! Calculate the rank one modification to the jacobian
+! and update QTF if necessary.
+!
+ do j = 1, n
+ sum2 = dot_product ( wa4(1:n), fjac(1:n,j) )
+ wa2(j) = ( sum2 - wa3(j) ) / pnorm
+ wa1(j) = diag(j) * ( ( diag(j) * wa1(j) ) / pnorm )
+ if ( 0.0001D+00 <= ratio ) then
+ qtf(j) = sum2
+ end if
+ end do
+!
+! Compute the QR factorization of the updated jacobian.
+!
+ call r1updt ( n, n, r, lr, wa1, wa2, wa3, sing )
+ call r1mpyq ( n, n, fjac, ldfjac, wa2, wa3 )
+ call r1mpyq ( 1, n, qtf, 1, wa2, wa3 )
+!
+! End of the inner loop.
+!
+ jeval = .false.
+ go to 180
+
+ 290 continue
+!
+! End of the outer loop.
+!
+ go to 30
+
+ 300 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, iflag )
+ end if
+
+ return
+end
+subroutine hybrd1 ( fcn, n, x, fvec, tol, info )
+
+!*****************************************************************************80
+!
+!! HYBRD1 seeks a zero of N nonlinear equations in N variables.
+!
+! Discussion:
+!
+! HYBRD1 finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. This is done by using the
+! more general nonlinear equation solver HYBRD. The user must provide a
+! subroutine which calculates the functions. The jacobian is then
+! calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 19 August 2016
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates that the relative error between X and the solution is at
+! most TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See the
+! description of FCN.
+! Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 2, number of calls to FCN has reached or exceeded 200*(N+1).
+! 3, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 4, the iteration is not making good progress.
+!
+ implicit none
+
+ integer ( kind = 4 ) lwa
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(n,n)
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) ml
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) mu
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r((n*(n+1))/2)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ if ( n <= 0 ) then
+ info = 0
+ return
+ end if
+
+ if ( tol < 0.0D+00 ) then
+ info = 0
+ return
+ end if
+
+ xtol = tol
+ maxfev = 200 * ( n + 1 )
+ ml = n - 1
+ mu = n - 1
+ epsfcn = 0.0D+00
+ diag(1:n) = 1.0D+00
+ mode = 2
+ factor = 100.0D+00
+ nprint = 0
+ info = 0
+ nfev = 0
+ fjac(1:n,1:n) = 0.0D+00
+ ldfjac = n
+ r(1:(n*(n+1))/2) = 0.0D+00
+ lr = ( n * ( n + 1 ) ) / 2
+ qtf(1:n) = 0.0D+00
+
+ call hybrd ( fcn, n, x, fvec, xtol, maxfev, ml, mu, epsfcn, diag, mode, &
+ factor, nprint, info, nfev, fjac, ldfjac, r, lr, qtf )
+
+ if ( info == 5 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine hybrj ( fcn, n, x, fvec, fjac, ldfjac, xtol, maxfev, diag, mode, &
+ factor, nprint, info, nfev, njev, r, lr, qtf )
+
+!*****************************************************************************80
+!
+!! HYBRJ seeks a zero of N nonlinear equations in N variables.
+!
+! Discussion:
+!
+! HYBRJ finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. The user must provide a
+! subroutine which calculates the functions and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+!
+! subroutine fcn ( n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N matrix, containing
+! the orthogonal matrix Q produced by the QR factorization
+! of the final approximate jacobian.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of the
+! array FJAC. LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN is at least MAXFEV by the end of an iteration.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG.
+! See the description of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, relative error between two consecutive iterates is at most XTOL.
+! 2, number of calls to FCN with IFLAG = 1 has reached MAXFEV.
+! 3, XTOL is too small. No further improvement in
+! the approximate solution X is possible.
+! 4, iteration is not making good progress, as measured by the
+! improvement from the last five jacobian evaluations.
+! 5, iteration is not making good progress, as measured by the
+! improvement from the last ten iterations.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN
+! with IFLAG = 1.
+!
+! Output, integer ( kind = 4 ) NJEV, the number of calls to FCN
+! with IFLAG = 2.
+!
+! Output, real ( kind = 8 ) R(LR), the upper triangular matrix produced
+! by the QR factorization of the final approximate jacobian, stored rowwise.
+!
+! Input, integer ( kind = 4 ) LR, the size of the R array, which must
+! be no less than (N*(N+1))/2.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the vector Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) iwa(1)
+ integer ( kind = 4 ) j
+ logical jeval
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) ncfail
+ integer ( kind = 4 ) nslow1
+ integer ( kind = 4 ) nslow2
+ integer ( kind = 4 ) ncsuc
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r(lr)
+ real ( kind = 8 ) ratio
+ logical sing
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(n)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+ njev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ if ( ldfjac < n .or. &
+ xtol < 0.0D+00 .or. &
+ maxfev <= 0 .or. &
+ factor <= 0.0D+00 .or. &
+ lr < ( n * ( n + 1 ) ) / 2 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ fnorm = enorm ( n, fvec )
+!
+! Initialize iteration counter and monitors.
+!
+ iter = 1
+ ncsuc = 0
+ ncfail = 0
+ nslow1 = 0
+ nslow2 = 0
+!
+! Beginning of the outer loop.
+!
+ do
+
+ jeval = .true.
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ njev = njev + 1
+
+ if ( iflag < 0 ) then
+ info = iflag
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .false.
+ call qrfac ( n, n, fjac, ldfjac, pivot, iwa, 1, wa1, wa2 )
+!
+! On the first iteration, if MODE is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Form Q'*FVEC and store in QTF.
+!
+ qtf(1:n) = fvec(1:n)
+
+ do j = 1, n
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ sum2 = 0.0D+00
+ do i = j, n
+ sum2 = sum2 + fjac(i,j) * qtf(i)
+ end do
+ temp = - sum2 / fjac(j,j)
+ do i = j, n
+ qtf(i) = qtf(i) + fjac(i,j) * temp
+ end do
+ end if
+ end do
+!
+! Copy the triangular factor of the QR factorization into R.
+!
+ sing = .false.
+
+ do j = 1, n
+ l = j
+ do i = 1, j - 1
+ r(l) = fjac(i,j)
+ l = l + n - i
+ end do
+ r(l) = wa1(j)
+ if ( wa1(j) == 0.0D+00 ) then
+ sing = .true.
+ end if
+ end do
+!
+! Accumulate the orthogonal factor in FJAC.
+!
+ call qform ( n, n, fjac, ldfjac )
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+ do
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+
+ if ( iflag < 0 ) then
+ info = iflag
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ end if
+!
+! Determine the direction P.
+!
+ call dogleg ( n, r, lr, diag, qtf, delta, wa1 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = - wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( n, wa2, wa4, fjac, ldfjac, iflag )
+ nfev = nfev + 1
+
+ if ( iflag < 0 ) then
+ info = iflag
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+
+ fnorm1 = enorm ( n, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ actred = -1.0D+00
+ if ( fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ end if
+!
+! Compute the scaled predicted reduction.
+!
+ l = 1
+ do i = 1, n
+ sum2 = 0.0D+00
+ do j = i, n
+ sum2 = sum2 + r(l) * wa1(j)
+ l = l + 1
+ end do
+ wa3(i) = qtf(i) + sum2
+ end do
+
+ temp = enorm ( n, wa3 )
+ prered = 0.0D+00
+ if ( temp < fnorm ) then
+ prered = 1.0D+00 - ( temp / fnorm ) ** 2
+ end if
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ if ( 0.0D+00 < prered ) then
+ ratio = actred / prered
+ else
+ ratio = 0.0D+00
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio < 0.1D+00 ) then
+
+ ncsuc = 0
+ ncfail = ncfail + 1
+ delta = 0.5D+00 * delta
+
+ else
+
+ ncfail = 0
+ ncsuc = ncsuc + 1
+
+ if ( 0.5D+00 <= ratio .or. 1 < ncsuc ) then
+ delta = max ( delta, pnorm / 0.5D+00 )
+ end if
+
+ if ( abs ( ratio - 1.0D+00 ) <= 0.1D+00 ) then
+ delta = pnorm / 0.5D+00
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+
+!
+! Successful iteration.
+! Update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:n) = wa4(1:n)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Determine the progress of the iteration.
+!
+ nslow1 = nslow1 + 1
+ if ( 0.001D+00 <= actred ) then
+ nslow1 = 0
+ end if
+
+ if ( jeval ) then
+ nslow2 = nslow2 + 1
+ end if
+
+ if ( 0.1D+00 <= actred ) then
+ nslow2 = 0
+ end if
+!
+! Test for convergence.
+!
+ if ( delta <= xtol * xnorm .or. fnorm == 0.0D+00 ) then
+ info = 1
+ end if
+
+ if ( info /= 0 ) then
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( maxfev <= nfev ) then
+ info = 2
+ end if
+
+ if ( 0.1D+00 * max ( 0.1D+00 * delta, pnorm ) <= epsmch * xnorm ) then
+ info = 3
+ end if
+
+ if ( nslow2 == 5 ) then
+ info = 4
+ end if
+
+ if ( nslow1 == 10 ) then
+ info = 5
+ end if
+
+ if ( info /= 0 ) then
+ iflag = 0
+ if ( 0 < nprint ) then
+ call fcn ( n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ return
+ end if
+!
+! Criterion for recalculating jacobian.
+!
+ if ( ncfail == 2 ) then
+ exit
+ end if
+!
+! Calculate the rank one modification to the jacobian
+! and update QTF if necessary.
+!
+ do j = 1, n
+ sum2 = dot_product ( wa4(1:n), fjac(1:n,j) )
+ wa2(j) = ( sum2 - wa3(j) ) / pnorm
+ wa1(j) = diag(j) * ( ( diag(j) * wa1(j) ) / pnorm )
+ if ( 0.0001D+00 <= ratio ) then
+ qtf(j) = sum2
+ end if
+ end do
+!
+! Compute the QR factorization of the updated jacobian.
+!
+ call r1updt ( n, n, r, lr, wa1, wa2, wa3, sing )
+ call r1mpyq ( n, n, fjac, ldfjac, wa2, wa3 )
+ call r1mpyq ( 1, n, qtf, 1, wa2, wa3 )
+!
+! End of the inner loop.
+!
+ jeval = .false.
+
+ end do
+!
+! End of the outer loop.
+!
+ end do
+
+end
+subroutine hybrj1 ( fcn, n, x, fvec, fjac, ldfjac, tol, info )
+
+!*****************************************************************************80
+!
+!! HYBRJ1 seeks a zero of N equations in N variables by Powell's method.
+!
+! Discussion:
+!
+! HYBRJ1 finds a zero of a system of N nonlinear functions in N variables
+! by a modification of the Powell hybrid method. This is done by using the
+! more general nonlinear equation solver HYBRJ. The user
+! must provide a subroutine which calculates the functions
+! and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+! subroutine fcn ( n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(n)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) N, the number of functions and variables.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(N), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array which contains
+! the orthogonal matrix Q produced by the QR factorization of the final
+! approximate jacobian.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates that the relative error between X and the solution is at most
+! TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 2, number of calls to FCN with IFLAG = 1 has reached 100*(N+1).
+! 3, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 4, iteration is not making good progress.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fvec(n)
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) lr
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) r((n*(n+1))/2)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ info = 0
+
+ if ( n <= 0 ) then
+ return
+ else if ( ldfjac < n ) then
+ return
+ else if ( tol < 0.0D+00 ) then
+ return
+ end if
+
+ maxfev = 100 * ( n + 1 )
+ xtol = tol
+ mode = 2
+ diag(1:n) = 1.0D+00
+ factor = 100.0D+00
+ nprint = 0
+ lr = ( n * ( n + 1 ) ) / 2
+
+ call hybrj ( fcn, n, x, fvec, fjac, ldfjac, xtol, maxfev, diag, mode, &
+ factor, nprint, info, nfev, njev, r, lr, qtf )
+
+ if ( info == 5 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine lmder ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+!*****************************************************************************80
+!
+!! LMDER minimizes M functions in N variables by the Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDER minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! The user must provide a subroutine which calculates the functions
+! and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, is the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. The upper
+! N by N submatrix of FJAC contains an upper triangular matrix R with
+! diagonal elements of nonincreasing magnitude such that
+! P' * ( JAC' * JAC ) * P = R' * R,
+! where P is a permutation matrix and JAC is the final calculated jacobian.
+! Column J of P is column IPVT(J) of the identity matrix. The lower
+! trapezoidal part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least M.
+!
+! Input, real ( kind = 8 ) FTOL. Termination occurs when both the actual
+! and predicted relative reductions in the sum of squares are at most FTOL.
+! Therefore, FTOL measures the relative error desired in the sum of
+! squares. FTOL should be nonnegative.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, real ( kind = 8 ) GTOL. Termination occurs when the cosine of the
+! angle between FVEC and any column of the jacobian is at most GTOL in
+! absolute value. Therefore, GTOL measures the orthogonality desired
+! between the function vector and the columns of the jacobian. GTOL should
+! be nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN with IFLAG = 1 is at least MAXFEV by the end of an iteration.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, both actual and predicted relative reductions in the sum of
+! squares are at most FTOL.
+! 2, relative error between two consecutive iterates is at most XTOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, the cosine of the angle between FVEC and any column of the jacobian
+! is at most GTOL in absolute value.
+! 5, number of calls to FCN with IFLAG = 1 has reached MAXFEV.
+! 6, FTOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 8, GTOL is too small. FVEC is orthogonal to the columns of the
+! jacobian to machine precision.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN with
+! IFLAG = 1.
+!
+! Output, integer ( kind = 4 ) NJEV, the number of calls to FCN with
+! IFLAG = 2.
+!
+! Output, integer ( kind = 4 ) IPVT(N), defines a permutation matrix P
+! such that JAC*P = Q*R, where JAC is the final calculated jacobian, Q is
+! orthogonal (not stored), and R is upper triangular with diagonal
+! elements of nonincreasing magnitude. Column J of P is column
+! IPVT(J) of the identity matrix.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the first N elements of Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dirder
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) par
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) ratio
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) temp1
+ real ( kind = 8 ) temp2
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(m)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+ njev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ go to 300
+ end if
+
+ if ( m < n ) then
+ go to 300
+ end if
+
+ if ( ldfjac < m &
+ .or. ftol < 0.0D+00 .or. xtol < 0.0D+00 .or. gtol < 0.0D+00 &
+ .or. maxfev <= 0 .or. factor <= 0.0D+00 ) then
+ go to 300
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 300
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+ nfev = 1
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm = enorm ( m, fvec )
+!
+! Initialize Levenberg-Marquardt parameter and iteration counter.
+!
+ par = 0.0D+00
+ iter = 1
+!
+! Beginning of the outer loop.
+!
+30 continue
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+
+ njev = njev + 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .true.
+ call qrfac ( m, n, fjac, ldfjac, pivot, ipvt, n, wa1, wa2 )
+!
+! On the first iteration and if mode is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Form Q'*FVEC and store the first N components in QTF.
+!
+ wa4(1:m) = fvec(1:m)
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ sum2 = dot_product ( wa4(j:m), fjac(j:m,j) )
+ temp = - sum2 / fjac(j,j)
+ wa4(j:m) = wa4(j:m) + fjac(j:m,j) * temp
+ end if
+
+ fjac(j,j) = wa1(j)
+ qtf(j) = wa4(j)
+
+ end do
+!
+! Compute the norm of the scaled gradient.
+!
+ gnorm = 0.0D+00
+
+ if ( fnorm /= 0.0D+00 ) then
+
+ do j = 1, n
+ l = ipvt(j)
+ if ( wa2(l) /= 0.0D+00 ) then
+ sum2 = dot_product ( qtf(1:j), fjac(1:j,j) ) / fnorm
+ gnorm = max ( gnorm, abs ( sum2 / wa2(l) ) )
+ end if
+ end do
+
+ end if
+!
+! Test for convergence of the gradient norm.
+!
+ if ( gnorm <= gtol ) then
+ info = 4
+ go to 300
+ end if
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+200 continue
+!
+! Determine the Levenberg-Marquardt parameter.
+!
+ call lmpar ( n, fjac, ldfjac, ipvt, diag, qtf, delta, par, wa1, wa2 )
+!
+! Store the direction p and x + p. calculate the norm of p.
+!
+ wa1(1:n) = - wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at x + p and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, wa2, wa4, fjac, ldfjac, iflag )
+
+ nfev = nfev + 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm1 = enorm ( m, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ actred = -1.0D+00
+ if ( 0.1D+00 * fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ end if
+!
+! Compute the scaled predicted reduction and
+! the scaled directional derivative.
+!
+ do j = 1, n
+ wa3(j) = 0.0D+00
+ l = ipvt(j)
+ temp = wa1(l)
+ wa3(1:j) = wa3(1:j) + fjac(1:j,j) * temp
+ end do
+
+ temp1 = enorm ( n, wa3 ) / fnorm
+ temp2 = ( sqrt ( par ) * pnorm ) / fnorm
+ prered = temp1 ** 2 + temp2 ** 2 / 0.5D+00
+ dirder = - ( temp1 ** 2 + temp2 ** 2 )
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ if ( prered /= 0.0D+00 ) then
+ ratio = actred / prered
+ else
+ ratio = 0.0D+00
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio <= 0.25D+00 ) then
+
+ if ( 0.0D+00 <= actred ) then
+ temp = 0.5D+00
+ end if
+
+ if ( actred < 0.0D+00 ) then
+ temp = 0.5D+00 * dirder / ( dirder + 0.5D+00 * actred )
+ end if
+
+ if ( 0.1D+00 * fnorm1 >= fnorm .or. temp < 0.1D+00 ) then
+ temp = 0.1D+00
+ end if
+
+ delta = temp * min ( delta, pnorm / 0.1D+00 )
+ par = par / temp
+
+ else
+
+ if ( par == 0.0D+00 .or. ratio >= 0.75D+00 ) then
+ delta = 2.0D+00 * pnorm
+ par = 0.5D+00 * par
+ end if
+
+ end if
+!
+! Successful iteration.
+!
+! Update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:m) = wa4(1:m)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Tests for convergence.
+!
+ if ( abs ( actred) <= ftol .and. &
+ prered <= ftol .and. &
+ 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 1
+ end if
+
+ if ( delta <= xtol * xnorm ) then
+ info = 2
+ end if
+
+ if ( abs ( actred) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 .and. info == 2 ) then
+ info = 3
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( nfev >= maxfev ) then
+ info = 5
+ end if
+
+ if ( abs ( actred ) <= epsmch .and. prered <= epsmch &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 6
+ end if
+
+ if ( delta <= epsmch * xnorm ) then
+ info = 7
+ end if
+
+ if ( gnorm <= epsmch ) then
+ info = 8
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! End of the inner loop. repeat if iteration unsuccessful.
+!
+ if ( ratio < 0.0001D+00 ) then
+ go to 200
+ end if
+!
+! End of the outer loop.
+!
+ go to 30
+
+ 300 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+ end if
+
+ return
+end
+subroutine lmder1 ( fcn, m, n, x, fvec, fjac, ldfjac, tol, info )
+
+!*****************************************************************************80
+!
+!! LMDER1 minimizes M functions in N variables by Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDER1 minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! This is done by using the more general least-squares solver LMDER.
+! The user must provide a subroutine which calculates the functions
+! and the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the jacobian. FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjac, ldfjac, iflag )
+! integer ( kind = 4 ) ldfjac
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjac(ldfjac,n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If IFLAG = 2 on input, FCN should calculate the jacobian at X and
+! return this matrix in FJAC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, is the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. The upper
+! N by N submatrix contains an upper triangular matrix R with
+! diagonal elements of nonincreasing magnitude such that
+! P' * ( JAC' * JAC ) * P = R' * R,
+! where P is a permutation matrix and JAC is the final calculated
+! jacobian. Column J of P is column IPVT(J) of the identity matrix.
+! The lower trapezoidal part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, is the leading dimension of FJAC,
+! which must be no less than M.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates either that the relative error in the sum of squares is at
+! most TOL or that the relative error between X and the solution is at
+! most TOL.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error in the sum of squares
+! is at most TOL.
+! 2, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, FVEC is orthogonal to the columns of the jacobian to machine precision.
+! 5, number of calls to FCN with IFLAG = 1 has reached 100*(N+1).
+! 6, TOL is too small. No further reduction in the sum of squares is
+! possible.
+! 7, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ info = 0
+
+ if ( n <= 0 ) then
+ return
+ else if ( m < n ) then
+ return
+ else if ( ldfjac < m ) then
+ return
+ else if ( tol < 0.0D+00 ) then
+ return
+ end if
+
+ factor = 100.0D+00
+ maxfev = 100 * ( n + 1 )
+ ftol = tol
+ xtol = tol
+ gtol = 0.0D+00
+ mode = 1
+ nprint = 0
+
+ call lmder ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+ if ( info == 8 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine lmdif ( fcn, m, n, x, fvec, ftol, xtol, gtol, maxfev, epsfcn, &
+ diag, mode, factor, nprint, info, nfev, fjac, ldfjac, ipvt, qtf )
+
+!*****************************************************************************80
+!
+!! LMDIF minimizes M functions in N variables by the Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDIF minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! The user must provide a subroutine which calculates the functions.
+! The jacobian is then calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( m, n, x, fvec, iflag )
+! integer ( kind = 4 ) m
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) FTOL. Termination occurs when both the actual
+! and predicted relative reductions in the sum of squares are at most FTOL.
+! Therefore, FTOL measures the relative error desired in the sum of
+! squares. FTOL should be nonnegative.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. Therefore, XTOL
+! measures the relative error desired in the approximate solution. XTOL
+! should be nonnegative.
+!
+! Input, real ( kind = 8 ) GTOL. termination occurs when the cosine of the
+! angle between FVEC and any column of the jacobian is at most GTOL in
+! absolute value. Therefore, GTOL measures the orthogonality desired
+! between the function vector and the columns of the jacobian. GTOL should
+! be nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number of
+! calls to FCN is at least MAXFEV by the end of an iteration.
+!
+! Input, real ( kind = 8 ) EPSFCN, is used in determining a suitable step
+! length for the forward-difference approximation. This approximation
+! assumes that the relative errors in the functions are of the order of
+! EPSFCN. If EPSFCN is less than the machine precision, it is assumed that
+! the relative errors in the functions are of the order of the machine
+! precision.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound.
+! This bound is set to the product of FACTOR and the euclidean norm of
+! DIAG*X if nonzero, or else to FACTOR itself. In most cases, FACTOR should
+! lie in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, both actual and predicted relative reductions in the sum of squares
+! are at most FTOL.
+! 2, relative error between two consecutive iterates is at most XTOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, the cosine of the angle between FVEC and any column of the jacobian
+! is at most GTOL in absolute value.
+! 5, number of calls to FCN has reached or exceeded MAXFEV.
+! 6, FTOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 8, GTOL is too small. FVEC is orthogonal to the columns of the
+! jacobian to machine precision.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an M by N array. The upper
+! N by N submatrix of FJAC contains an upper triangular matrix R with
+! diagonal elements of nonincreasing magnitude such that
+!
+! P' * ( JAC' * JAC ) * P = R' * R,
+!
+! where P is a permutation matrix and JAC is the final calculated jacobian.
+! Column J of P is column IPVT(J) of the identity matrix. The lower
+! trapezoidal part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least M.
+!
+! Output, integer ( kind = 4 ) IPVT(N), defines a permutation matrix P such
+! that JAC * P = Q * R, where JAC is the final calculated jacobian, Q is
+! orthogonal (not stored), and R is upper triangular with diagonal
+! elements of nonincreasing magnitude. Column J of P is column IPVT(J)
+! of the identity matrix.
+!
+! Output, real ( kind = 8 ) QTF(N), the first N elements of Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dirder
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) par
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) ratio
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) temp1
+ real ( kind = 8 ) temp2
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(m)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+
+ if ( n <= 0 ) then
+ go to 300
+ else if ( m < n ) then
+ go to 300
+ else if ( ldfjac < m ) then
+ go to 300
+ else if ( ftol < 0.0D+00 ) then
+ go to 300
+ else if ( xtol < 0.0D+00 ) then
+ go to 300
+ else if ( gtol < 0.0D+00 ) then
+ go to 300
+ else if ( maxfev <= 0 ) then
+ go to 300
+ else if ( factor <= 0.0D+00 ) then
+ go to 300
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 300
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, x, fvec, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+
+ fnorm = enorm ( m, fvec )
+!
+! Initialize Levenberg-Marquardt parameter and iteration counter.
+!
+ par = 0.0D+00
+ iter = 1
+!
+! Beginning of the outer loop.
+!
+30 continue
+!
+! Calculate the jacobian matrix.
+!
+ iflag = 2
+ call fdjac2 ( fcn, m, n, x, fvec, fjac, ldfjac, iflag, epsfcn )
+ nfev = nfev + n
+
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter - 1, nprint ) == 0 ) then
+ call fcn ( m, n, x, fvec, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ end if
+!
+! Compute the QR factorization of the jacobian.
+!
+ pivot = .true.
+ call qrfac ( m, n, fjac, ldfjac, pivot, ipvt, n, wa1, wa2 )
+!
+! On the first iteration and if MODE is 1, scale according
+! to the norms of the columns of the initial jacobian.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+ end if
+!
+! On the first iteration, calculate the norm of the scaled X
+! and initialize the step bound DELTA.
+!
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+ end if
+!
+! Form Q' * FVEC and store the first N components in QTF.
+!
+ wa4(1:m) = fvec(1:m)
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+ sum2 = dot_product ( wa4(j:m), fjac(j:m,j) )
+ temp = - sum2 / fjac(j,j)
+ wa4(j:m) = wa4(j:m) + fjac(j:m,j) * temp
+ end if
+
+ fjac(j,j) = wa1(j)
+ qtf(j) = wa4(j)
+
+ end do
+!
+! Compute the norm of the scaled gradient.
+!
+ gnorm = 0.0D+00
+
+ if ( fnorm /= 0.0D+00 ) then
+
+ do j = 1, n
+
+ l = ipvt(j)
+
+ if ( wa2(l) /= 0.0D+00 ) then
+ sum2 = 0.0D+00
+ do i = 1, j
+ sum2 = sum2 + fjac(i,j) * ( qtf(i) / fnorm )
+ end do
+ gnorm = max ( gnorm, abs ( sum2 / wa2(l) ) )
+ end if
+
+ end do
+
+ end if
+!
+! Test for convergence of the gradient norm.
+!
+ if ( gnorm <= gtol ) then
+ info = 4
+ go to 300
+ end if
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+200 continue
+!
+! Determine the Levenberg-Marquardt parameter.
+!
+ call lmpar ( n, fjac, ldfjac, ipvt, diag, qtf, delta, par, wa1, wa2 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = -wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, wa2, wa4, iflag )
+ nfev = nfev + 1
+ if ( iflag < 0 ) then
+ go to 300
+ end if
+ fnorm1 = enorm ( m, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ if ( 0.1D+00 * fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ else
+ actred = -1.0D+00
+ end if
+!
+! Compute the scaled predicted reduction and the scaled directional derivative.
+!
+ do j = 1, n
+ wa3(j) = 0.0D+00
+ l = ipvt(j)
+ temp = wa1(l)
+ wa3(1:j) = wa3(1:j) + fjac(1:j,j) * temp
+ end do
+
+ temp1 = enorm ( n, wa3 ) / fnorm
+ temp2 = ( sqrt ( par ) * pnorm ) / fnorm
+ prered = temp1 ** 2 + temp2 ** 2 / 0.5D+00
+ dirder = - ( temp1 ** 2 + temp2 ** 2 )
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ ratio = 0.0D+00
+ if ( prered /= 0.0D+00 ) then
+ ratio = actred / prered
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio <= 0.25D+00 ) then
+
+ if ( actred >= 0.0D+00 ) then
+ temp = 0.5D+00
+ endif
+
+ if ( actred < 0.0D+00 ) then
+ temp = 0.5D+00 * dirder / ( dirder + 0.5D+00 * actred )
+ end if
+
+ if ( 0.1D+00 * fnorm1 >= fnorm .or. temp < 0.1D+00 ) then
+ temp = 0.1D+00
+ end if
+
+ delta = temp * min ( delta, pnorm / 0.1D+00 )
+ par = par / temp
+
+ else
+
+ if ( par == 0.0D+00 .or. ratio >= 0.75D+00 ) then
+ delta = 2.0D+00 * pnorm
+ par = 0.5D+00 * par
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+
+!
+! Successful iteration. update X, FVEC, and their norms.
+!
+ if ( 0.0001D+00 <= ratio ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:m) = wa4(1:m)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Tests for convergence.
+!
+ if ( abs ( actred) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 1
+ end if
+
+ if ( delta <= xtol * xnorm ) then
+ info = 2
+ end if
+
+ if ( abs ( actred) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 .and. info == 2 ) info = 3
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! Tests for termination and stringent tolerances.
+!
+ if ( maxfev <= nfev ) then
+ info = 5
+ end if
+
+ if ( abs ( actred) <= epsmch .and. prered <= epsmch &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 6
+ end if
+
+ if ( delta <= epsmch * xnorm ) then
+ info = 7
+ end if
+
+ if ( gnorm <= epsmch ) then
+ info = 8
+ end if
+
+ if ( info /= 0 ) then
+ go to 300
+ end if
+!
+! End of the inner loop. Repeat if iteration unsuccessful.
+!
+ if ( ratio < 0.0001D+00 ) then
+ go to 200
+ end if
+!
+! End of the outer loop.
+!
+ go to 30
+
+300 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( m, n, x, fvec, iflag )
+ end if
+
+ return
+end
+subroutine lmdif1 ( fcn, m, n, x, fvec, tol, info )
+
+!*****************************************************************************80
+!
+!! LMDIF1 minimizes M functions in N variables using Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMDIF1 minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm.
+! This is done by using the more general least-squares solver LMDIF.
+! The user must provide a subroutine which calculates the functions.
+! The jacobian is then calculated by a forward-difference approximation.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions. The routine should have the form:
+! subroutine fcn ( m, n, x, fvec, iflag )
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+!
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! To terminate the algorithm, FCN may set IFLAG negative on return.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates either that the relative error in the sum of squares is at
+! most TOL or that the relative error between X and the solution is at
+! most TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error in the sum of squares
+! is at most TOL.
+! 2, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, FVEC is orthogonal to the columns of the jacobian to machine precision.
+! 5, number of calls to FCN has reached or exceeded 200*(N+1).
+! 6, TOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+!
+ implicit none
+
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) epsfcn
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(m,n)
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ info = 0
+
+ if ( n <= 0 ) then
+ return
+ else if ( m < n ) then
+ return
+ else if ( tol < 0.0D+00 ) then
+ return
+ end if
+
+ ! *** BVIE BEGIN ***
+ !factor = 100.0D+00
+ factor = 0.1D+00
+ ! *** BVIE END ***
+ maxfev = 200 * ( n + 1 )
+ ftol = tol
+ xtol = tol
+ gtol = 0.0D+00
+ epsfcn = 0.0D+00
+ mode = 1
+ nprint = 0
+ ldfjac = m
+
+ call lmdif ( fcn, m, n, x, fvec, ftol, xtol, gtol, maxfev, epsfcn, &
+ diag, mode, factor, nprint, info, nfev, fjac, ldfjac, ipvt, qtf )
+
+ if ( info == 8 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine lmpar ( n, r, ldr, ipvt, diag, qtb, delta, par, x, sdiag )
+
+!*****************************************************************************80
+!
+!! LMPAR computes a parameter for the Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! Given an M by N matrix A, an N by N nonsingular diagonal
+! matrix D, an M-vector B, and a positive number DELTA,
+! the problem is to determine a value for the parameter
+! PAR such that if X solves the system
+!
+! A*X = B,
+! sqrt ( PAR ) * D * X = 0,
+!
+! in the least squares sense, and DXNORM is the euclidean
+! norm of D*X, then either PAR is zero and
+!
+! ( DXNORM - DELTA ) <= 0.1 * DELTA,
+!
+! or PAR is positive and
+!
+! abs ( DXNORM - DELTA) <= 0.1 * DELTA.
+!
+! This subroutine completes the solution of the problem
+! if it is provided with the necessary information from the
+! QR factorization, with column pivoting, of A. That is, if
+! A*P = Q*R, where P is a permutation matrix, Q has orthogonal
+! columns, and R is an upper triangular matrix with diagonal
+! elements of nonincreasing magnitude, then LMPAR expects
+! the full upper triangle of R, the permutation matrix P,
+! and the first N components of Q'*B. On output
+! LMPAR also provides an upper triangular matrix S such that
+!
+! P' * ( A' * A + PAR * D * D ) * P = S'* S.
+!
+! S is employed within LMPAR and may be of separate interest.
+!
+! Only a few iterations are generally needed for convergence
+! of the algorithm. If, however, the limit of 10 iterations
+! is reached, then the output PAR will contain the best
+! value obtained so far.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 24 January 2014
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of R.
+!
+! Input/output, real ( kind = 8 ) R(LDR,N),the N by N matrix. The full
+! upper triangle must contain the full upper triangle of the matrix R.
+! On output the full upper triangle is unaltered, and the strict lower
+! triangle contains the strict upper triangle (transposed) of the upper
+! triangular matrix S.
+!
+! Input, integer ( kind = 4 ) LDR, the leading dimension of R. LDR must be
+! no less than N.
+!
+! Input, integer ( kind = 4 ) IPVT(N), defines the permutation matrix P
+! such that A*P = Q*R. Column J of P is column IPVT(J) of the
+! identity matrix.
+!
+! Input, real ( kind = 8 ) DIAG(N), the diagonal elements of the matrix D.
+!
+! Input, real ( kind = 8 ) QTB(N), the first N elements of the vector Q'*B.
+!
+! Input, real ( kind = 8 ) DELTA, an upper bound on the euclidean norm
+! of D*X. DELTA should be positive.
+!
+! Input/output, real ( kind = 8 ) PAR. On input an initial estimate of the
+! Levenberg-Marquardt parameter. On output the final estimate.
+! PAR should be nonnegative.
+!
+! Output, real ( kind = 8 ) X(N), the least squares solution of the system
+! A*X = B, sqrt(PAR)*D*X = 0, for the output value of PAR.
+!
+! Output, real ( kind = 8 ) SDIAG(N), the diagonal elements of the upper
+! triangular matrix S.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dwarf
+ real ( kind = 8 ) dxnorm
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) fp
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) nsing
+ real ( kind = 8 ) par
+ real ( kind = 8 ) parc
+ real ( kind = 8 ) parl
+ real ( kind = 8 ) paru
+ real ( kind = 8 ) qnorm
+ real ( kind = 8 ) qtb(n)
+ real ( kind = 8 ) r(ldr,n)
+ real ( kind = 8 ) sdiag(n)
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) x(n)
+!
+! DWARF is the smallest positive magnitude.
+!
+ dwarf = tiny ( dwarf )
+!
+! Compute and store in X the Gauss-Newton direction.
+!
+! If the jacobian is rank-deficient, obtain a least squares solution.
+!
+ nsing = n
+
+ do j = 1, n
+ wa1(j) = qtb(j)
+ if ( r(j,j) == 0.0D+00 .and. nsing == n ) then
+ nsing = j - 1
+ end if
+ if ( nsing < n ) then
+ wa1(j) = 0.0D+00
+ end if
+ end do
+
+ do k = 1, nsing
+ j = nsing - k + 1
+ wa1(j) = wa1(j) / r(j,j)
+ temp = wa1(j)
+ wa1(1:j-1) = wa1(1:j-1) - r(1:j-1,j) * temp
+ end do
+
+ do j = 1, n
+ l = ipvt(j)
+ x(l) = wa1(j)
+ end do
+!
+! Initialize the iteration counter.
+! Evaluate the function at the origin, and test
+! for acceptance of the Gauss-Newton direction.
+!
+ iter = 0
+ wa2(1:n) = diag(1:n) * x(1:n)
+ dxnorm = enorm ( n, wa2 )
+ fp = dxnorm - delta
+
+ if ( fp <= 0.1D+00 * delta ) then
+ if ( iter == 0 ) then
+ par = 0.0D+00
+ end if
+ return
+ end if
+!
+! If the jacobian is not rank deficient, the Newton
+! step provides a lower bound, PARL, for the zero of
+! the function.
+!
+! Otherwise set this bound to zero.
+!
+ parl = 0.0D+00
+
+ if ( n <= nsing ) then
+
+ do j = 1, n
+ l = ipvt(j)
+ wa1(j) = diag(l) * ( wa2(l) / dxnorm )
+ end do
+
+ do j = 1, n
+ sum2 = dot_product ( wa1(1:j-1), r(1:j-1,j) )
+ wa1(j) = ( wa1(j) - sum2 ) / r(j,j)
+ end do
+
+ temp = enorm ( n, wa1 )
+ parl = ( ( fp / delta ) / temp ) / temp
+
+ end if
+!
+! Calculate an upper bound, PARU, for the zero of the function.
+!
+ do j = 1, n
+ sum2 = dot_product ( qtb(1:j), r(1:j,j) )
+ l = ipvt(j)
+ wa1(j) = sum2 / diag(l)
+ end do
+
+ gnorm = enorm ( n, wa1 )
+ paru = gnorm / delta
+
+ if ( paru == 0.0D+00 ) then
+ paru = dwarf / min ( delta, 0.1D+00 )
+ end if
+!
+! If the input PAR lies outside of the interval (PARL, PARU),
+! set PAR to the closer endpoint.
+!
+ par = max ( par, parl )
+ par = min ( par, paru )
+ if ( par == 0.0D+00 ) then
+ par = gnorm / dxnorm
+ end if
+!
+! Beginning of an iteration.
+!
+ do
+
+ iter = iter + 1
+!
+! Evaluate the function at the current value of PAR.
+!
+ if ( par == 0.0D+00 ) then
+ par = max ( dwarf, 0.001D+00 * paru )
+ end if
+
+ wa1(1:n) = sqrt ( par ) * diag(1:n)
+
+ call qrsolv ( n, r, ldr, ipvt, wa1, qtb, x, sdiag )
+
+ wa2(1:n) = diag(1:n) * x(1:n)
+ dxnorm = enorm ( n, wa2 )
+ temp = fp
+ fp = dxnorm - delta
+!
+! If the function is small enough, accept the current value of PAR.
+!
+ if ( abs ( fp ) <= 0.1D+00 * delta ) then
+ exit
+ end if
+!
+! Test for the exceptional cases where PARL
+! is zero or the number of iterations has reached 10.
+!
+ if ( parl == 0.0D+00 .and. fp <= temp .and. temp < 0.0D+00 ) then
+ exit
+ else if ( iter == 10 ) then
+ exit
+ end if
+!
+! Compute the Newton correction.
+!
+ do j = 1, n
+ l = ipvt(j)
+ wa1(j) = diag(l) * ( wa2(l) / dxnorm )
+ end do
+
+ do j = 1, n
+ wa1(j) = wa1(j) / sdiag(j)
+ temp = wa1(j)
+ wa1(j+1:n) = wa1(j+1:n) - r(j+1:n,j) * temp
+ end do
+
+ temp = enorm ( n, wa1 )
+ parc = ( ( fp / delta ) / temp ) / temp
+!
+! Depending on the sign of the function, update PARL or PARU.
+!
+ if ( 0.0D+00 < fp ) then
+ parl = max ( parl, par )
+ else if ( fp < 0.0D+00 ) then
+ paru = min ( paru, par )
+ end if
+!
+! Compute an improved estimate for PAR.
+!
+ par = max ( parl, par + parc )
+!
+! End of an iteration.
+!
+ end do
+!
+! Termination.
+!
+ if ( iter == 0 ) then
+ par = 0.0D+00
+ end if
+
+ return
+end
+subroutine lmstr ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+!*****************************************************************************80
+!
+!! LMSTR minimizes M functions in N variables using Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMSTR minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm
+! which uses minimal storage.
+!
+! The user must provide a subroutine which calculates the functions and
+! the rows of the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the rows of the jacobian.
+! FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjrow, iflag )
+! integer ( kind = 4 ) m
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjrow(n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If the input value of IFLAG is I > 1, calculate the (I-1)-st row of
+! the jacobian at X, and return this vector in FJROW.
+! To terminate the algorithm, set the output value of IFLAG negative.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array. The upper
+! triangle of FJAC contains an upper triangular matrix R such that
+!
+! P' * ( JAC' * JAC ) * P = R' * R,
+!
+! where P is a permutation matrix and JAC is the final calculated jacobian.
+! Column J of P is column IPVT(J) of the identity matrix. The lower
+! triangular part of FJAC contains information generated during
+! the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) FTOL. Termination occurs when both the actual and
+! predicted relative reductions in the sum of squares are at most FTOL.
+! Therefore, FTOL measures the relative error desired in the sum of
+! squares. FTOL should be nonnegative.
+!
+! Input, real ( kind = 8 ) XTOL. Termination occurs when the relative error
+! between two consecutive iterates is at most XTOL. XTOL should be
+! nonnegative.
+!
+! Input, real ( kind = 8 ) GTOL. termination occurs when the cosine of the
+! angle between FVEC and any column of the jacobian is at most GTOL in
+! absolute value. Therefore, GTOL measures the orthogonality desired
+! between the function vector and the columns of the jacobian. GTOL should
+! be nonnegative.
+!
+! Input, integer ( kind = 4 ) MAXFEV. Termination occurs when the number
+! of calls to FCN with IFLAG = 1 is at least MAXFEV by the end of
+! an iteration.
+!
+! Input/output, real ( kind = 8 ) DIAG(N). If MODE = 1, then DIAG is set
+! internally. If MODE = 2, then DIAG must contain positive entries that
+! serve as multiplicative scale factors for the variables.
+!
+! Input, integer ( kind = 4 ) MODE, scaling option.
+! 1, variables will be scaled internally.
+! 2, scaling is specified by the input DIAG vector.
+!
+! Input, real ( kind = 8 ) FACTOR, determines the initial step bound. This
+! bound is set to the product of FACTOR and the euclidean norm of DIAG*X if
+! nonzero, or else to FACTOR itself. In most cases, FACTOR should lie
+! in the interval (0.1, 100) with 100 the recommended value.
+!
+! Input, integer ( kind = 4 ) NPRINT, enables controlled printing of iterates
+! if it is positive. In this case, FCN is called with IFLAG = 0 at the
+! beginning of the first iteration and every NPRINT iterations thereafter
+! and immediately prior to return, with X and FVEC available
+! for printing. If NPRINT is not positive, no special calls
+! of FCN with IFLAG = 0 are made.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See the
+! description of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, both actual and predicted relative reductions in the sum of squares
+! are at most FTOL.
+! 2, relative error between two consecutive iterates is at most XTOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, the cosine of the angle between FVEC and any column of the jacobian
+! is at most GTOL in absolute value.
+! 5, number of calls to FCN with IFLAG = 1 has reached MAXFEV.
+! 6, FTOL is too small. No further reduction in the sum of squares is
+! possible.
+! 7, XTOL is too small. No further improvement in the approximate
+! solution X is possible.
+! 8, GTOL is too small. FVEC is orthogonal to the columns of the
+! jacobian to machine precision.
+!
+! Output, integer ( kind = 4 ) NFEV, the number of calls to FCN
+! with IFLAG = 1.
+!
+! Output, integer ( kind = 4 ) NJEV, the number of calls to FCN
+! with IFLAG = 2.
+!
+! Output, integer ( kind = 4 ) IPVT(N), defines a permutation matrix P such
+! that JAC * P = Q * R, where JAC is the final calculated jacobian, Q is
+! orthogonal (not stored), and R is upper triangular.
+! Column J of P is column IPVT(J) of the identity matrix.
+!
+! Output, real ( kind = 8 ) QTF(N), contains the first N elements of Q'*FVEC.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) actred
+ real ( kind = 8 ) delta
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) dirder
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) fnorm
+ real ( kind = 8 ) fnorm1
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gnorm
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) iflag
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) iter
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) par
+ logical pivot
+ real ( kind = 8 ) pnorm
+ real ( kind = 8 ) prered
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) ratio
+ logical sing
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) temp1
+ real ( kind = 8 ) temp2
+ real ( kind = 8 ) wa1(n)
+ real ( kind = 8 ) wa2(n)
+ real ( kind = 8 ) wa3(n)
+ real ( kind = 8 ) wa4(m)
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xnorm
+ real ( kind = 8 ) xtol
+
+ epsmch = epsilon ( epsmch )
+
+ info = 0
+ iflag = 0
+ nfev = 0
+ njev = 0
+!
+! Check the input parameters for errors.
+!
+ if ( n <= 0 ) then
+ go to 340
+ else if ( m < n ) then
+ go to 340
+ else if ( ldfjac < n ) then
+ go to 340
+ else if ( ftol < 0.0D+00 ) then
+ go to 340
+ else if ( xtol < 0.0D+00 ) then
+ go to 340
+ else if ( gtol < 0.0D+00 ) then
+ go to 340
+ else if ( maxfev <= 0 ) then
+ go to 340
+ else if ( factor <= 0.0D+00 ) then
+ go to 340
+ end if
+
+ if ( mode == 2 ) then
+ do j = 1, n
+ if ( diag(j) <= 0.0D+00 ) then
+ go to 340
+ end if
+ end do
+ end if
+!
+! Evaluate the function at the starting point and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ nfev = 1
+
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+
+ fnorm = enorm ( m, fvec )
+!
+! Initialize Levenberg-Marquardt parameter and iteration counter.
+!
+ par = 0.0D+00
+ iter = 1
+!
+! Beginning of the outer loop.
+!
+ 30 continue
+!
+! If requested, call FCN to enable printing of iterates.
+!
+ if ( 0 < nprint ) then
+ iflag = 0
+ if ( mod ( iter-1, nprint ) == 0 ) then
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ end if
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+ end if
+!
+! Compute the QR factorization of the jacobian matrix calculated one row
+! at a time, while simultaneously forming Q'* FVEC and storing
+! the first N components in QTF.
+!
+ qtf(1:n) = 0.0D+00
+ fjac(1:n,1:n) = 0.0D+00
+ iflag = 2
+
+ do i = 1, m
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+ temp = fvec(i)
+ call rwupdt ( n, fjac, ldfjac, wa3, qtf, temp, wa1, wa2 )
+ iflag = iflag + 1
+ end do
+
+ njev = njev + 1
+!
+! If the jacobian is rank deficient, call QRFAC to
+! reorder its columns and update the components of QTF.
+!
+ sing = .false.
+ do j = 1, n
+ if ( fjac(j,j) == 0.0D+00 ) then
+ sing = .true.
+ end if
+ ipvt(j) = j
+ wa2(j) = enorm ( j, fjac(1,j) )
+ end do
+
+ if ( sing ) then
+
+ pivot = .true.
+ call qrfac ( n, n, fjac, ldfjac, pivot, ipvt, n, wa1, wa2 )
+
+ do j = 1, n
+
+ if ( fjac(j,j) /= 0.0D+00 ) then
+
+ sum2 = dot_product ( qtf(j:n), fjac(j:n,j) )
+ temp = - sum2 / fjac(j,j)
+ qtf(j:n) = qtf(j:n) + fjac(j:n,j) * temp
+
+ end if
+
+ fjac(j,j) = wa1(j)
+
+ end do
+
+ end if
+!
+! On the first iteration
+! if mode is 1,
+! scale according to the norms of the columns of the initial jacobian.
+! calculate the norm of the scaled X,
+! initialize the step bound delta.
+!
+ if ( iter == 1 ) then
+
+ if ( mode /= 2 ) then
+
+ diag(1:n) = wa2(1:n)
+ do j = 1, n
+ if ( wa2(j) == 0.0D+00 ) then
+ diag(j) = 1.0D+00
+ end if
+ end do
+
+ end if
+
+ wa3(1:n) = diag(1:n) * x(1:n)
+ xnorm = enorm ( n, wa3 )
+ delta = factor * xnorm
+ if ( delta == 0.0D+00 ) then
+ delta = factor
+ end if
+
+ end if
+!
+! Compute the norm of the scaled gradient.
+!
+ gnorm = 0.0D+00
+
+ if ( fnorm /= 0.0D+00 ) then
+
+ do j = 1, n
+ l = ipvt(j)
+ if ( wa2(l) /= 0.0D+00 ) then
+ sum2 = dot_product ( qtf(1:j), fjac(1:j,j) ) / fnorm
+ gnorm = max ( gnorm, abs ( sum2 / wa2(l) ) )
+ end if
+ end do
+
+ end if
+!
+! Test for convergence of the gradient norm.
+!
+ if ( gnorm <= gtol ) then
+ info = 4
+ go to 340
+ end if
+!
+! Rescale if necessary.
+!
+ if ( mode /= 2 ) then
+ do j = 1, n
+ diag(j) = max ( diag(j), wa2(j) )
+ end do
+ end if
+!
+! Beginning of the inner loop.
+!
+240 continue
+!
+! Determine the Levenberg-Marquardt parameter.
+!
+ call lmpar ( n, fjac, ldfjac, ipvt, diag, qtf, delta, par, wa1, wa2 )
+!
+! Store the direction P and X + P.
+! Calculate the norm of P.
+!
+ wa1(1:n) = -wa1(1:n)
+ wa2(1:n) = x(1:n) + wa1(1:n)
+ wa3(1:n) = diag(1:n) * wa1(1:n)
+ pnorm = enorm ( n, wa3 )
+!
+! On the first iteration, adjust the initial step bound.
+!
+ if ( iter == 1 ) then
+ delta = min ( delta, pnorm )
+ end if
+!
+! Evaluate the function at X + P and calculate its norm.
+!
+ iflag = 1
+ call fcn ( m, n, wa2, wa4, wa3, iflag )
+ nfev = nfev + 1
+ if ( iflag < 0 ) then
+ go to 340
+ end if
+ fnorm1 = enorm ( m, wa4 )
+!
+! Compute the scaled actual reduction.
+!
+ if ( 0.1D+00 * fnorm1 < fnorm ) then
+ actred = 1.0D+00 - ( fnorm1 / fnorm ) ** 2
+ else
+ actred = -1.0D+00
+ end if
+!
+! Compute the scaled predicted reduction and
+! the scaled directional derivative.
+!
+ do j = 1, n
+ wa3(j) = 0.0D+00
+ l = ipvt(j)
+ temp = wa1(l)
+ wa3(1:j) = wa3(1:j) + fjac(1:j,j) * temp
+ end do
+
+ temp1 = enorm ( n, wa3 ) / fnorm
+ temp2 = ( sqrt(par) * pnorm ) / fnorm
+ prered = temp1 ** 2 + temp2 ** 2 / 0.5D+00
+ dirder = - ( temp1 ** 2 + temp2 ** 2 )
+!
+! Compute the ratio of the actual to the predicted reduction.
+!
+ if ( prered /= 0.0D+00 ) then
+ ratio = actred / prered
+ else
+ ratio = 0.0D+00
+ end if
+!
+! Update the step bound.
+!
+ if ( ratio <= 0.25D+00 ) then
+
+ if ( actred >= 0.0D+00 ) then
+ temp = 0.5D+00
+ else
+ temp = 0.5D+00 * dirder / ( dirder + 0.5D+00 * actred )
+ end if
+
+ if ( 0.1D+00 * fnorm1 >= fnorm .or. temp < 0.1D+00 ) then
+ temp = 0.1D+00
+ end if
+
+ delta = temp * min ( delta, pnorm / 0.1D+00 )
+ par = par / temp
+
+ else
+
+ if ( par == 0.0D+00 .or. ratio >= 0.75D+00 ) then
+ delta = pnorm / 0.5D+00
+ par = 0.5D+00 * par
+ end if
+
+ end if
+!
+! Test for successful iteration.
+!
+ if ( ratio >= 0.0001D+00 ) then
+ x(1:n) = wa2(1:n)
+ wa2(1:n) = diag(1:n) * x(1:n)
+ fvec(1:m) = wa4(1:m)
+ xnorm = enorm ( n, wa2 )
+ fnorm = fnorm1
+ iter = iter + 1
+ end if
+!
+! Tests for convergence, termination and stringent tolerances.
+!
+ if ( abs ( actred ) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 1
+ end if
+
+ if ( delta <= xtol * xnorm ) then
+ info = 2
+ end if
+
+ if ( abs ( actred ) <= ftol .and. prered <= ftol &
+ .and. 0.5D+00 * ratio <= 1.0D+00 .and. info == 2 ) then
+ info = 3
+ end if
+
+ if ( info /= 0 ) then
+ go to 340
+ end if
+
+ if ( nfev >= maxfev) then
+ info = 5
+ end if
+
+ if ( abs ( actred ) <= epsmch .and. prered <= epsmch &
+ .and. 0.5D+00 * ratio <= 1.0D+00 ) then
+ info = 6
+ end if
+
+ if ( delta <= epsmch * xnorm ) then
+ info = 7
+ end if
+
+ if ( gnorm <= epsmch ) then
+ info = 8
+ end if
+
+ if ( info /= 0 ) then
+ go to 340
+ end if
+!
+! End of the inner loop. Repeat if iteration unsuccessful.
+!
+ if ( ratio < 0.0001D+00 ) then
+ go to 240
+ end if
+!
+! End of the outer loop.
+!
+ go to 30
+
+ 340 continue
+!
+! Termination, either normal or user imposed.
+!
+ if ( iflag < 0 ) then
+ info = iflag
+ end if
+
+ iflag = 0
+
+ if ( 0 < nprint ) then
+ call fcn ( m, n, x, fvec, wa3, iflag )
+ end if
+
+ return
+end
+subroutine lmstr1 ( fcn, m, n, x, fvec, fjac, ldfjac, tol, info )
+
+!*****************************************************************************80
+!
+!! LMSTR1 minimizes M functions in N variables using Levenberg-Marquardt method.
+!
+! Discussion:
+!
+! LMSTR1 minimizes the sum of the squares of M nonlinear functions in
+! N variables by a modification of the Levenberg-Marquardt algorithm
+! which uses minimal storage.
+!
+! This is done by using the more general least-squares solver
+! LMSTR. The user must provide a subroutine which calculates
+! the functions and the rows of the jacobian.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 19 August 2016
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, external FCN, the name of the user-supplied subroutine which
+! calculates the functions and the rows of the jacobian.
+! FCN should have the form:
+! subroutine fcn ( m, n, x, fvec, fjrow, iflag )
+! integer ( kind = 4 ) m
+! integer ( kind = 4 ) n
+! real ( kind = 8 ) fjrow(n)
+! real ( kind = 8 ) fvec(m)
+! integer ( kind = 4 ) iflag
+! real ( kind = 8 ) x(n)
+! If IFLAG = 0 on input, then FCN is only being called to allow the user
+! to print out the current iterate.
+! If IFLAG = 1 on input, FCN should calculate the functions at X and
+! return this vector in FVEC.
+! If the input value of IFLAG is I > 1, calculate the (I-1)-st row of
+! the jacobian at X, and return this vector in FJROW.
+! To terminate the algorithm, set the output value of IFLAG negative.
+!
+! Input, integer ( kind = 4 ) M, the number of functions.
+!
+! Input, integer ( kind = 4 ) N, the number of variables.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) X(N). On input, X must contain an initial
+! estimate of the solution vector. On output X contains the final
+! estimate of the solution vector.
+!
+! Output, real ( kind = 8 ) FVEC(M), the functions evaluated at the output X.
+!
+! Output, real ( kind = 8 ) FJAC(LDFJAC,N), an N by N array. The upper
+! triangle contains an upper triangular matrix R such that
+!
+! P' * ( JAC' * JAC ) * P = R' * R,
+!
+! where P is a permutation matrix and JAC is the final calculated
+! jacobian. Column J of P is column IPVT(J) of the identity matrix.
+! The lower triangular part of FJAC contains information generated
+! during the computation of R.
+!
+! Input, integer ( kind = 4 ) LDFJAC, the leading dimension of FJAC.
+! LDFJAC must be at least N.
+!
+! Input, real ( kind = 8 ) TOL. Termination occurs when the algorithm
+! estimates either that the relative error in the sum of squares is at
+! most TOL or that the relative error between X and the solution is at
+! most TOL. TOL should be nonnegative.
+!
+! Output, integer ( kind = 4 ) INFO, error flag. If the user has terminated
+! execution, INFO is set to the (negative) value of IFLAG. See description
+! of FCN. Otherwise, INFO is set as follows:
+! 0, improper input parameters.
+! 1, algorithm estimates that the relative error in the sum of squares
+! is at most TOL.
+! 2, algorithm estimates that the relative error between X and the
+! solution is at most TOL.
+! 3, conditions for INFO = 1 and INFO = 2 both hold.
+! 4, FVEC is orthogonal to the columns of the jacobian to machine precision.
+! 5, number of calls to FCN with IFLAG = 1 has reached 100*(N+1).
+! 6, TOL is too small. No further reduction in the sum of squares
+! is possible.
+! 7, TOL is too small. No further improvement in the approximate
+! solution X is possible.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldfjac
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) diag(n)
+ real ( kind = 8 ) factor
+ external fcn
+ real ( kind = 8 ) fjac(ldfjac,n)
+ real ( kind = 8 ) ftol
+ real ( kind = 8 ) fvec(m)
+ real ( kind = 8 ) gtol
+ integer ( kind = 4 ) info
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) maxfev
+ integer ( kind = 4 ) mode
+ integer ( kind = 4 ) nfev
+ integer ( kind = 4 ) njev
+ integer ( kind = 4 ) nprint
+ real ( kind = 8 ) qtf(n)
+ real ( kind = 8 ) tol
+ real ( kind = 8 ) x(n)
+ real ( kind = 8 ) xtol
+
+ if ( n <= 0 ) then
+ info = 0
+ return
+ end if
+
+ if ( m < n ) then
+ info = 0
+ return
+ end if
+
+ if ( ldfjac < n ) then
+ info = 0
+ return
+ end if
+
+ if ( tol < 0.0D+00 ) then
+ info = 0
+ return
+ end if
+
+ fvec(1:n) = 0.0D+00
+ fjac(1:ldfjac,1:n) = 0.0D+00
+ ftol = tol
+ xtol = tol
+ gtol = 0.0D+00
+ maxfev = 100 * ( n + 1 )
+ diag(1:n) = 0.0D+00
+ mode = 1
+ factor = 100.0D+00
+ nprint = 0
+ info = 0
+ nfev = 0
+ njev = 0
+ ipvt(1:n) = 0
+ qtf(1:n) = 0.0D+00
+
+ call lmstr ( fcn, m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, &
+ diag, mode, factor, nprint, info, nfev, njev, ipvt, qtf )
+
+ if ( info == 8 ) then
+ info = 4
+ end if
+
+ return
+end
+subroutine qform ( m, n, q, ldq )
+
+!*****************************************************************************80
+!
+!! QFORM produces the explicit QR factorization of a matrix.
+!
+! Discussion:
+!
+! The QR factorization of a matrix is usually accumulated in implicit
+! form, that is, as a series of orthogonal transformations of the
+! original matrix. This routine carries out those transformations,
+! to explicitly exhibit the factorization constructed by QRFAC.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, is a positive integer input variable set
+! to the number of rows of A and the order of Q.
+!
+! Input, integer ( kind = 4 ) N, is a positive integer input variable set
+! to the number of columns of A.
+!
+! Input/output, real ( kind = 8 ) Q(LDQ,M). Q is an M by M array.
+! On input the full lower trapezoid in the first min(M,N) columns of Q
+! contains the factored form.
+! On output, Q has been accumulated into a square matrix.
+!
+! Input, integer ( kind = 4 ) LDQ, is a positive integer input variable
+! not less than M which specifies the leading dimension of the array Q.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldq
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) minmn
+ real ( kind = 8 ) q(ldq,m)
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(m)
+
+ minmn = min ( m, n )
+
+ do j = 2, minmn
+ q(1:j-1,j) = 0.0D+00
+ end do
+!
+! Initialize remaining columns to those of the identity matrix.
+!
+ q(1:m,n+1:m) = 0.0D+00
+
+ do j = n+1, m
+ q(j,j) = 1.0D+00
+ end do
+!
+! Accumulate Q from its factored form.
+!
+ do l = 1, minmn
+
+ k = minmn - l + 1
+
+ wa(k:m) = q(k:m,k)
+
+ q(k:m,k) = 0.0D+00
+ q(k,k) = 1.0D+00
+
+ if ( wa(k) /= 0.0D+00 ) then
+
+ do j = k, m
+ temp = dot_product ( wa(k:m), q(k:m,j) ) / wa(k)
+ q(k:m,j) = q(k:m,j) - temp * wa(k:m)
+ end do
+
+ end if
+
+ end do
+
+ return
+end
+subroutine qrfac ( m, n, a, lda, pivot, ipvt, lipvt, rdiag, acnorm )
+
+!*****************************************************************************80
+!
+!! QRFAC computes a QR factorization using Householder transformations.
+!
+! Discussion:
+!
+! This subroutine uses Householder transformations with column
+! pivoting (optional) to compute a QR factorization of the
+! M by N matrix A. That is, QRFAC determines an orthogonal
+! matrix Q, a permutation matrix P, and an upper trapezoidal
+! matrix R with diagonal elements of nonincreasing magnitude,
+! such that A*P = Q*R. The Householder transformation for
+! column K, K = 1,2,...,min(M,N), is of the form
+!
+! I - ( 1 / U(K) ) * U * U'
+!
+! where U has zeros in the first K-1 positions. The form of
+! this transformation and the method of pivoting first
+! appeared in the corresponding LINPACK subroutine.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, the number of rows of A.
+!
+! Input, integer ( kind = 4 ) N, the number of columns of A.
+!
+! Input/output, real ( kind = 8 ) A(LDA,N), the M by N array.
+! On input, A contains the matrix for which the QR factorization is to
+! be computed. On output, the strict upper trapezoidal part of A contains
+! the strict upper trapezoidal part of R, and the lower trapezoidal
+! part of A contains a factored form of Q (the non-trivial elements of
+! the U vectors described above).
+!
+! Input, integer ( kind = 4 ) LDA, the leading dimension of A, which must
+! be no less than M.
+!
+! Input, logical PIVOT, is TRUE if column pivoting is to be carried out.
+!
+! Output, integer ( kind = 4 ) IPVT(LIPVT), defines the permutation matrix P
+! such that A*P = Q*R. Column J of P is column IPVT(J) of the identity
+! matrix. If PIVOT is false, IPVT is not referenced.
+!
+! Input, integer ( kind = 4 ) LIPVT, the dimension of IPVT, which should
+! be N if pivoting is used.
+!
+! Output, real ( kind = 8 ) RDIAG(N), contains the diagonal elements of R.
+!
+! Output, real ( kind = 8 ) ACNORM(N), the norms of the corresponding
+! columns of the input matrix A. If this information is not needed,
+! then ACNORM can coincide with RDIAG.
+!
+ implicit none
+
+ integer ( kind = 4 ) lda
+ integer ( kind = 4 ) lipvt
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) a(lda,n)
+ real ( kind = 8 ) acnorm(n)
+ real ( kind = 8 ) ajnorm
+ real ( kind = 8 ) enorm
+ real ( kind = 8 ) epsmch
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) i4_temp
+ integer ( kind = 4 ) ipvt(lipvt)
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) kmax
+ integer ( kind = 4 ) minmn
+ logical pivot
+ real ( kind = 8 ) r8_temp(m)
+ real ( kind = 8 ) rdiag(n)
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(n)
+
+ epsmch = epsilon ( epsmch )
+!
+! Compute the initial column norms and initialize several arrays.
+!
+ do j = 1, n
+ acnorm(j) = enorm ( m, a(1:m,j) )
+ end do
+
+ rdiag(1:n) = acnorm(1:n)
+ wa(1:n) = acnorm(1:n)
+
+ if ( pivot ) then
+ do j = 1, n
+ ipvt(j) = j
+ end do
+ end if
+!
+! Reduce A to R with Householder transformations.
+!
+ minmn = min ( m, n )
+
+ do j = 1, minmn
+!
+! Bring the column of largest norm into the pivot position.
+!
+ if ( pivot ) then
+
+ kmax = j
+
+ do k = j, n
+ if ( rdiag(kmax) < rdiag(k) ) then
+ kmax = k
+ end if
+ end do
+
+ if ( kmax /= j ) then
+
+ r8_temp(1:m) = a(1:m,j)
+ a(1:m,j) = a(1:m,kmax)
+ a(1:m,kmax) = r8_temp(1:m)
+
+ rdiag(kmax) = rdiag(j)
+ wa(kmax) = wa(j)
+
+ i4_temp = ipvt(j)
+ ipvt(j) = ipvt(kmax)
+ ipvt(kmax) = i4_temp
+
+ end if
+
+ end if
+!
+! Compute the Householder transformation to reduce the
+! J-th column of A to a multiple of the J-th unit vector.
+!
+ ajnorm = enorm ( m-j+1, a(j,j) )
+
+ if ( ajnorm /= 0.0D+00 ) then
+
+ if ( a(j,j) < 0.0D+00 ) then
+ ajnorm = -ajnorm
+ end if
+
+ a(j:m,j) = a(j:m,j) / ajnorm
+ a(j,j) = a(j,j) + 1.0D+00
+!
+! Apply the transformation to the remaining columns and update the norms.
+!
+ do k = j + 1, n
+
+ temp = dot_product ( a(j:m,j), a(j:m,k) ) / a(j,j)
+
+ a(j:m,k) = a(j:m,k) - temp * a(j:m,j)
+
+ if ( pivot .and. rdiag(k) /= 0.0D+00 ) then
+
+ temp = a(j,k) / rdiag(k)
+ rdiag(k) = rdiag(k) * sqrt ( max ( 0.0D+00, 1.0D+00-temp ** 2 ) )
+
+ if ( 0.05D+00 * ( rdiag(k) / wa(k) ) ** 2 <= epsmch ) then
+ rdiag(k) = enorm ( m-j, a(j+1,k) )
+ wa(k) = rdiag(k)
+ end if
+
+ end if
+
+ end do
+
+ end if
+
+ rdiag(j) = - ajnorm
+
+ end do
+
+ return
+end
+subroutine qrsolv ( n, r, ldr, ipvt, diag, qtb, x, sdiag )
+
+!*****************************************************************************80
+!
+!! QRSOLV solves a rectangular linear system A*x=b in the least squares sense.
+!
+! Discussion:
+!
+! Given an M by N matrix A, an N by N diagonal matrix D,
+! and an M-vector B, the problem is to determine an X which
+! solves the system
+!
+! A*X = B
+! D*X = 0
+!
+! in the least squares sense.
+!
+! This subroutine completes the solution of the problem
+! if it is provided with the necessary information from the
+! QR factorization, with column pivoting, of A. That is, if
+! Q*P = Q*R, where P is a permutation matrix, Q has orthogonal
+! columns, and R is an upper triangular matrix with diagonal
+! elements of nonincreasing magnitude, then QRSOLV expects
+! the full upper triangle of R, the permutation matrix p,
+! and the first N components of Q'*B.
+!
+! The system is then equivalent to
+!
+! R*Z = Q'*B
+! P'*D*P*Z = 0
+!
+! where X = P*Z. If this system does not have full rank,
+! then a least squares solution is obtained. On output QRSOLV
+! also provides an upper triangular matrix S such that
+!
+! P'*(A'*A + D*D)*P = S'*S.
+!
+! S is computed within QRSOLV and may be of separate interest.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of R.
+!
+! Input/output, real ( kind = 8 ) R(LDR,N), the N by N matrix.
+! On input the full upper triangle must contain the full upper triangle
+! of the matrix R. On output the full upper triangle is unaltered, and
+! the strict lower triangle contains the strict upper triangle
+! (transposed) of the upper triangular matrix S.
+!
+! Input, integer ( kind = 4 ) LDR, the leading dimension of R, which must be
+! at least N.
+!
+! Input, integer ( kind = 4 ) IPVT(N), defines the permutation matrix P such
+! that A*P = Q*R. Column J of P is column IPVT(J) of the identity matrix.
+!
+! Input, real ( kind = 8 ) DIAG(N), the diagonal elements of the matrix D.
+!
+! Input, real ( kind = 8 ) QTB(N), the first N elements of the vector Q'*B.
+!
+! Output, real ( kind = 8 ) X(N), the least squares solution.
+!
+! Output, real ( kind = 8 ) SDIAG(N), the diagonal elements of the upper
+! triangular matrix S.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) c
+ real ( kind = 8 ) cotan
+ real ( kind = 8 ) diag(n)
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) ipvt(n)
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) k
+ integer ( kind = 4 ) l
+ integer ( kind = 4 ) nsing
+ real ( kind = 8 ) qtb(n)
+ real ( kind = 8 ) qtbpj
+ real ( kind = 8 ) r(ldr,n)
+ real ( kind = 8 ) s
+ real ( kind = 8 ) sdiag(n)
+ real ( kind = 8 ) sum2
+ real ( kind = 8 ) t
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) wa(n)
+ real ( kind = 8 ) x(n)
+!
+! Copy R and Q'*B to preserve input and initialize S.
+!
+! In particular, save the diagonal elements of R in X.
+!
+ do j = 1, n
+ r(j:n,j) = r(j,j:n)
+ x(j) = r(j,j)
+ end do
+
+ wa(1:n) = qtb(1:n)
+!
+! Eliminate the diagonal matrix D using a Givens rotation.
+!
+ do j = 1, n
+!
+! Prepare the row of D to be eliminated, locating the
+! diagonal element using P from the QR factorization.
+!
+ l = ipvt(j)
+
+ if ( diag(l) /= 0.0D+00 ) then
+
+ sdiag(j:n) = 0.0D+00
+ sdiag(j) = diag(l)
+!
+! The transformations to eliminate the row of D
+! modify only a single element of Q'*B
+! beyond the first N, which is initially zero.
+!
+ qtbpj = 0.0D+00
+
+ do k = j, n
+!
+! Determine a Givens rotation which eliminates the
+! appropriate element in the current row of D.
+!
+ if ( sdiag(k) /= 0.0D+00 ) then
+
+ if ( abs ( r(k,k) ) < abs ( sdiag(k) ) ) then
+ cotan = r(k,k) / sdiag(k)
+ s = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ c = s * cotan
+ else
+ t = sdiag(k) / r(k,k)
+ c = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * t ** 2 )
+ s = c * t
+ end if
+!
+! Compute the modified diagonal element of R and
+! the modified element of (Q'*B,0).
+!
+ r(k,k) = c * r(k,k) + s * sdiag(k)
+ temp = c * wa(k) + s * qtbpj
+ qtbpj = - s * wa(k) + c * qtbpj
+ wa(k) = temp
+!
+! Accumulate the tranformation in the row of S.
+!
+ do i = k+1, n
+ temp = c * r(i,k) + s * sdiag(i)
+ sdiag(i) = - s * r(i,k) + c * sdiag(i)
+ r(i,k) = temp
+ end do
+
+ end if
+
+ end do
+
+ end if
+!
+! Store the diagonal element of S and restore
+! the corresponding diagonal element of R.
+!
+ sdiag(j) = r(j,j)
+ r(j,j) = x(j)
+
+ end do
+!
+! Solve the triangular system for Z. If the system is
+! singular, then obtain a least squares solution.
+!
+ nsing = n
+
+ do j = 1, n
+
+ if ( sdiag(j) == 0.0D+00 .and. nsing == n ) then
+ nsing = j - 1
+ end if
+
+ if ( nsing < n ) then
+ wa(j) = 0.0D+00
+ end if
+
+ end do
+
+ do j = nsing, 1, -1
+ sum2 = dot_product ( wa(j+1:nsing), r(j+1:nsing,j) )
+ wa(j) = ( wa(j) - sum2 ) / sdiag(j)
+ end do
+!
+! Permute the components of Z back to components of X.
+!
+ do j = 1, n
+ l = ipvt(j)
+ x(l) = wa(j)
+ end do
+
+ return
+end
+subroutine r1mpyq ( m, n, a, lda, v, w )
+
+!*****************************************************************************80
+!
+!! R1MPYQ computes A*Q, where Q is the product of Householder transformations.
+!
+! Discussion:
+!
+! Given an M by N matrix A, this subroutine computes A*Q where
+! Q is the product of 2*(N - 1) transformations
+!
+! GV(N-1)*...*GV(1)*GW(1)*...*GW(N-1)
+!
+! and GV(I), GW(I) are Givens rotations in the (I,N) plane which
+! eliminate elements in the I-th and N-th planes, respectively.
+! Q itself is not given, rather the information to recover the
+! GV, GW rotations is supplied.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, the number of rows of A.
+!
+! Input, integer ( kind = 4 ) N, the number of columns of A.
+!
+! Input/output, real ( kind = 8 ) A(LDA,N), the M by N array.
+! On input, the matrix A to be postmultiplied by the orthogonal matrix Q.
+! On output, the value of A*Q.
+!
+! Input, integer ( kind = 4 ) LDA, the leading dimension of A, which must not
+! be less than M.
+!
+! Input, real ( kind = 8 ) V(N), W(N), contain the information necessary
+! to recover the Givens rotations GV and GW.
+!
+ implicit none
+
+ integer ( kind = 4 ) lda
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) a(lda,n)
+ real ( kind = 8 ) c
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ real ( kind = 8 ) s
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) v(n)
+ real ( kind = 8 ) w(n)
+!
+! Apply the first set of Givens rotations to A.
+!
+ do j = n - 1, 1, -1
+
+ if ( 1.0D+00 < abs ( v(j) ) ) then
+ c = 1.0D+00 / v(j)
+ s = sqrt ( 1.0D+00 - c ** 2 )
+ else
+ s = v(j)
+ c = sqrt ( 1.0D+00 - s ** 2 )
+ end if
+
+ do i = 1, m
+ temp = c * a(i,j) - s * a(i,n)
+ a(i,n) = s * a(i,j) + c * a(i,n)
+ a(i,j) = temp
+ end do
+
+ end do
+!
+! Apply the second set of Givens rotations to A.
+!
+ do j = 1, n - 1
+
+ if ( abs ( w(j) ) > 1.0D+00 ) then
+ c = 1.0D+00 / w(j)
+ s = sqrt ( 1.0D+00 - c ** 2 )
+ else
+ s = w(j)
+ c = sqrt ( 1.0D+00 - s ** 2 )
+ end if
+
+ do i = 1, m
+ temp = c * a(i,j) + s * a(i,n)
+ a(i,n) = - s * a(i,j) + c * a(i,n)
+ a(i,j) = temp
+ end do
+
+ end do
+
+ return
+end
+subroutine r1updt ( m, n, s, ls, u, v, w, sing )
+
+!*****************************************************************************80
+!
+!! R1UPDT re-triangularizes a matrix after a rank one update.
+!
+! Discussion:
+!
+! Given an M by N lower trapezoidal matrix S, an M-vector U, and an
+! N-vector V, the problem is to determine an orthogonal matrix Q such that
+!
+! (S + U * V' ) * Q
+!
+! is again lower trapezoidal.
+!
+! This subroutine determines Q as the product of 2 * (N - 1)
+! transformations
+!
+! GV(N-1)*...*GV(1)*GW(1)*...*GW(N-1)
+!
+! where GV(I), GW(I) are Givens rotations in the (I,N) plane
+! which eliminate elements in the I-th and N-th planes,
+! respectively. Q itself is not accumulated, rather the
+! information to recover the GV and GW rotations is returned.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) M, the number of rows of S.
+!
+! Input, integer ( kind = 4 ) N, the number of columns of S.
+! N must not exceed M.
+!
+! Input/output, real ( kind = 8 ) S(LS). On input, the lower trapezoidal
+! matrix S stored by columns. On output S contains the lower trapezoidal
+! matrix produced as described above.
+!
+! Input, integer ( kind = 4 ) LS, the length of the S array. LS must be at
+! least (N*(2*M-N+1))/2.
+!
+! Input, real ( kind = 8 ) U(M), the U vector.
+!
+! Input/output, real ( kind = 8 ) V(N). On input, V must contain the
+! vector V. On output V contains the information necessary to recover the
+! Givens rotations GV described above.
+!
+! Output, real ( kind = 8 ) W(M), contains information necessary to
+! recover the Givens rotations GW described above.
+!
+! Output, logical SING, is set to TRUE if any of the diagonal elements
+! of the output S are zero. Otherwise SING is set FALSE.
+!
+ implicit none
+
+ integer ( kind = 4 ) ls
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) cos
+ real ( kind = 8 ) cotan
+ real ( kind = 8 ) giant
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ integer ( kind = 4 ) jj
+ integer ( kind = 4 ) l
+ real ( kind = 8 ) s(ls)
+ real ( kind = 8 ) sin
+ logical sing
+ real ( kind = 8 ) tan
+ real ( kind = 8 ) tau
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) u(m)
+ real ( kind = 8 ) v(n)
+ real ( kind = 8 ) w(m)
+!
+! GIANT is the largest magnitude.
+!
+ giant = huge ( giant )
+!
+! Initialize the diagonal element pointer.
+!
+ jj = ( n * ( 2 * m - n + 1 ) ) / 2 - ( m - n )
+!
+! Move the nontrivial part of the last column of S into W.
+!
+ l = jj
+ do i = n, m
+ w(i) = s(l)
+ l = l + 1
+ end do
+!
+! Rotate the vector V into a multiple of the N-th unit vector
+! in such a way that a spike is introduced into W.
+!
+ do j = n - 1, 1, -1
+
+ jj = jj - ( m - j + 1 )
+ w(j) = 0.0D+00
+
+ if ( v(j) /= 0.0D+00 ) then
+!
+! Determine a Givens rotation which eliminates the
+! J-th element of V.
+!
+ if ( abs ( v(n) ) < abs ( v(j) ) ) then
+ cotan = v(n) / v(j)
+ sin = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ cos = sin * cotan
+ tau = 1.0D+00
+ if ( abs ( cos ) * giant > 1.0D+00 ) then
+ tau = 1.0D+00 / cos
+ end if
+ else
+ tan = v(j) / v(n)
+ cos = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * tan ** 2 )
+ sin = cos * tan
+ tau = sin
+ end if
+!
+! Apply the transformation to V and store the information
+! necessary to recover the Givens rotation.
+!
+ v(n) = sin * v(j) + cos * v(n)
+ v(j) = tau
+!
+! Apply the transformation to S and extend the spike in W.
+!
+ l = jj
+ do i = j, m
+ temp = cos * s(l) - sin * w(i)
+ w(i) = sin * s(l) + cos * w(i)
+ s(l) = temp
+ l = l + 1
+ end do
+
+ end if
+
+ end do
+!
+! Add the spike from the rank 1 update to W.
+!
+ w(1:m) = w(1:m) + v(n) * u(1:m)
+!
+! Eliminate the spike.
+!
+ sing = .false.
+
+ do j = 1, n-1
+
+ if ( w(j) /= 0.0D+00 ) then
+!
+! Determine a Givens rotation which eliminates the
+! J-th element of the spike.
+!
+ if ( abs ( s(jj) ) < abs ( w(j) ) ) then
+
+ cotan = s(jj) / w(j)
+ sin = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ cos = sin * cotan
+
+ if ( 1.0D+00 < abs ( cos ) * giant ) then
+ tau = 1.0D+00 / cos
+ else
+ tau = 1.0D+00
+ end if
+
+ else
+
+ tan = w(j) / s(jj)
+ cos = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * tan ** 2 )
+ sin = cos * tan
+ tau = sin
+
+ end if
+!
+! Apply the transformation to S and reduce the spike in W.
+!
+ l = jj
+ do i = j, m
+ temp = cos * s(l) + sin * w(i)
+ w(i) = - sin * s(l) + cos * w(i)
+ s(l) = temp
+ l = l + 1
+ end do
+!
+! Store the information necessary to recover the Givens rotation.
+!
+ w(j) = tau
+
+ end if
+!
+! Test for zero diagonal elements in the output S.
+!
+ if ( s(jj) == 0.0D+00 ) then
+ sing = .true.
+ end if
+
+ jj = jj + ( m - j + 1 )
+
+ end do
+!
+! Move W back into the last column of the output S.
+!
+ l = jj
+ do i = n, m
+ s(l) = w(i)
+ l = l + 1
+ end do
+
+ if ( s(jj) == 0.0D+00 ) then
+ sing = .true.
+ end if
+
+ return
+end
+subroutine r8vec_print ( n, a, title )
+
+!*****************************************************************************80
+!
+!! R8VEC_PRINT prints an R8VEC.
+!
+! Discussion:
+!
+! An R8VEC is a vector of R8's.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 22 August 2000
+!
+! Author:
+!
+! John Burkardt
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the number of components of the vector.
+!
+! Input, real ( kind = 8 ) A(N), the vector to be printed.
+!
+! Input, character ( len = * ) TITLE, a title.
+!
+ implicit none
+
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) a(n)
+ integer ( kind = 4 ) i
+ character ( len = * ) title
+
+ write ( *, '(a)' ) ' '
+ write ( *, '(a)' ) trim ( title )
+ write ( *, '(a)' ) ' '
+ do i = 1, n
+ write ( *, '(2x,i8,2x,g16.8)' ) i, a(i)
+ end do
+
+ return
+end
+subroutine rwupdt ( n, r, ldr, w, b, alpha, c, s )
+
+!*****************************************************************************80
+!
+!! RWUPDT computes the decomposition of triangular matrix augmented by one row.
+!
+! Discussion:
+!
+! Given an N by N upper triangular matrix R, this subroutine
+! computes the QR decomposition of the matrix formed when a row
+! is added to R. If the row is specified by the vector W, then
+! RWUPDT determines an orthogonal matrix Q such that when the
+! N+1 by N matrix composed of R augmented by W is premultiplied
+! by Q', the resulting matrix is upper trapezoidal.
+! The matrix Q' is the product of N transformations
+!
+! G(N)*G(N-1)* ... *G(1)
+!
+! where G(I) is a Givens rotation in the (I,N+1) plane which eliminates
+! elements in the (N+1)-st plane. RWUPDT also computes the product
+! Q'*C where C is the (N+1)-vector (B,ALPHA). Q itself is not
+! accumulated, rather the information to recover the G rotations is
+! supplied.
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 06 April 2010
+!
+! Author:
+!
+! Original FORTRAN77 version by Jorge More, Burton Garbow, Kenneth Hillstrom.
+! FORTRAN90 version by John Burkardt.
+!
+! Reference:
+!
+! Jorge More, Burton Garbow, Kenneth Hillstrom,
+! User Guide for MINPACK-1,
+! Technical Report ANL-80-74,
+! Argonne National Laboratory, 1980.
+!
+! Parameters:
+!
+! Input, integer ( kind = 4 ) N, the order of R.
+!
+! Input/output, real ( kind = 8 ) R(LDR,N). On input the upper triangular
+! part of R must contain the matrix to be updated. On output R contains the
+! updated triangular matrix.
+!
+! Input, integer ( kind = 4 ) LDR, the leading dimension of the array R.
+! LDR must not be less than N.
+!
+! Input, real ( kind = 8 ) W(N), the row vector to be added to R.
+!
+! Input/output, real ( kind = 8 ) B(N). On input, the first N elements
+! of the vector C. On output the first N elements of the vector Q'*C.
+!
+! Input/output, real ( kind = 8 ) ALPHA. On input, the (N+1)-st element
+! of the vector C. On output the (N+1)-st element of the vector Q'*C.
+!
+! Output, real ( kind = 8 ) C(N), S(N), the cosines and sines of the
+! transforming Givens rotations.
+!
+ implicit none
+
+ integer ( kind = 4 ) ldr
+ integer ( kind = 4 ) n
+
+ real ( kind = 8 ) alpha
+ real ( kind = 8 ) b(n)
+ real ( kind = 8 ) c(n)
+ real ( kind = 8 ) cotan
+ integer ( kind = 4 ) i
+ integer ( kind = 4 ) j
+ real ( kind = 8 ) r(ldr,n)
+ real ( kind = 8 ) rowj
+ real ( kind = 8 ) s(n)
+ real ( kind = 8 ) tan
+ real ( kind = 8 ) temp
+ real ( kind = 8 ) w(n)
+
+ do j = 1, n
+
+ rowj = w(j)
+!
+! Apply the previous transformations to R(I,J), I=1,2,...,J-1, and to W(J).
+!
+ do i = 1, j - 1
+ temp = c(i) * r(i,j) + s(i) * rowj
+ rowj = - s(i) * r(i,j) + c(i) * rowj
+ r(i,j) = temp
+ end do
+!
+! Determine a Givens rotation which eliminates W(J).
+!
+ c(j) = 1.0D+00
+ s(j) = 0.0D+00
+
+ if ( rowj /= 0.0D+00 ) then
+
+ if ( abs ( r(j,j) ) < abs ( rowj ) ) then
+ cotan = r(j,j) / rowj
+ s(j) = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * cotan ** 2 )
+ c(j) = s(j) * cotan
+ else
+ tan = rowj / r(j,j)
+ c(j) = 0.5D+00 / sqrt ( 0.25D+00 + 0.25D+00 * tan ** 2 )
+ s(j) = c(j) * tan
+ end if
+!
+! Apply the current transformation to R(J,J), B(J), and ALPHA.
+!
+ r(j,j) = c(j) * r(j,j) + s(j) * rowj
+ temp = c(j) * b(j) + s(j) * alpha
+ alpha = - s(j) * b(j) + c(j) * alpha
+ b(j) = temp
+
+ end if
+
+ end do
+
+ return
+end
+subroutine timestamp ( )
+
+!*****************************************************************************80
+!
+!! TIMESTAMP prints the current YMDHMS date as a time stamp.
+!
+! Example:
+!
+! 31 May 2001 9:45:54.872 AM
+!
+! Licensing:
+!
+! This code is distributed under the GNU LGPL license.
+!
+! Modified:
+!
+! 18 May 2013
+!
+! Author:
+!
+! John Burkardt
+!
+! Parameters:
+!
+! None
+!
+ implicit none
+
+ character ( len = 8 ) ampm
+ integer ( kind = 4 ) d
+ integer ( kind = 4 ) h
+ integer ( kind = 4 ) m
+ integer ( kind = 4 ) mm
+ character ( len = 9 ), parameter, dimension(12) :: month = (/ &
+ 'January ', 'February ', 'March ', 'April ', &
+ 'May ', 'June ', 'July ', 'August ', &
+ 'September', 'October ', 'November ', 'December ' /)
+ integer ( kind = 4 ) n
+ integer ( kind = 4 ) s
+ integer ( kind = 4 ) values(8)
+ integer ( kind = 4 ) y
+
+ call date_and_time ( values = values )
+
+ y = values(1)
+ m = values(2)
+ d = values(3)
+ h = values(5)
+ n = values(6)
+ s = values(7)
+ mm = values(8)
+
+ if ( h < 12 ) then
+ ampm = 'AM'
+ else if ( h == 12 ) then
+ if ( n == 0 .and. s == 0 ) then
+ ampm = 'Noon'
+ else
+ ampm = 'PM'
+ end if
+ else
+ h = h - 12
+ if ( h < 12 ) then
+ ampm = 'PM'
+ else if ( h == 12 ) then
+ if ( n == 0 .and. s == 0 ) then
+ ampm = 'Midnight'
+ else
+ ampm = 'AM'
+ end if
+ end if
+ end if
+
+ write ( *, '(i2.2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) &
+ d, trim ( month(m) ), y, h, ':', n, ':', s, '.', mm, trim ( ampm )
+
+ return
+end
diff --git a/src/MNH/addfluctuations.f90 b/src/MNH/addfluctuations.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0d7ae1ab637917c6745e8806f07b65a619e2eb98
--- /dev/null
+++ b/src/MNH/addfluctuations.f90
@@ -0,0 +1,177 @@
+!MNH_LIC Copyright 2021-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.
+!-----------------------------------------------------------------
+!#####################
+MODULE MODI_ADDFLUCTUATIONS
+!#####################
+!
+INTERFACE
+!
+ SUBROUTINE ADDFLUCTUATIONS ( &
+ HLBCX,HLBCY, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT, &
+ PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE, &
+ PFLUCTWTW,PFLUCTWTN,PFLUCTWTS,PFLUCTWTE )
+
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE ! tengential velocity fluctuations
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTWTN,PFLUCTWTW,PFLUCTWTS,PFLUCTWTE ! vertical tengential velocity fluctuations
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+END SUBROUTINE ADDFLUCTUATIONS
+!
+END INTERFACE
+!
+END MODULE MODI_ADDFLUCTUATIONS
+!
+!
+! ####################################################################
+SUBROUTINE ADDFLUCTUATIONS ( &
+ HLBCX,HLBCY, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT, &
+ PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE, &
+ PFLUCTWTW,PFLUCTWTN,PFLUCTWTS,PFLUCTWTE )
+! ####################################################################
+!
+!!**** *ADDFLUCTUATIONS* - routine adding the velocity fluctuations to the
+!! Lateral Boundary Conditions for turbulence
+!! recycling purpose.
+!!
+!! PURPOSE
+!! -------
+!! EXTERNAL
+!! --------
+!! GET_INDICE_ll : get physical sub-domain bounds
+!! LWEAST_ll,LEAST_ll,LNORTH_ll,LSOUTH_ll : position functions
+!!
+!! AUTHORS
+!! ------
+!! T.Nagel, V.Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/2021
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS
+USE MODD_LBC_n, ONLY : XPOND
+USE MODD_RECYCL_PARAM_n
+USE MODE_MODELN_HANDLER
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE ! tengential velocity fluctuations
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTWTN,PFLUCTWTW,PFLUCTWTS,PFLUCTWTE ! vertical tengential velocity fluctuations
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IIB ! indice I Beginning in x direction
+INTEGER :: IJB ! indice J Beginning in y direction
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IIE ! indice I End in x direction
+INTEGER :: IJE ! indice J End in y direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: JI,JJ
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
+! ----------------------------------------------
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PUT,3) - JPVEXT
+!
+!* 2. ADD FLUCTUATIONS THE X DIRECTION (LEFT WEST SIDE):
+! ------------------------------------------------
+IF (LRECYCLW) THEN
+ IF (LWEST_ll( )) THEN
+ SELECT CASE ( HLBCX(1) )
+ CASE ('OPEN')
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ PUT(JI,:,:)=0.
+ WHERE ( PUT(IIB,:,:) > 0. ) !INFLOW condition
+ PVT (JI,:,:) = PVT (JI,:,:)+XRCOEFF*PFLUCTVTW
+ PWT (JI,:,:) = PWT (JI,:,:)+XRCOEFF*PFLUCTWTW
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!* 3. ADD FLUCTUATIONS THE X DIRECTION (RIGHT EAST SIDE):
+! ------------------------------------------------
+IF (LRECYCLE) THEN
+ IF (LEAST_ll( )) THEN
+ SELECT CASE ( HLBCX(2) )
+ CASE ('OPEN')
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) < 0. ) !INFLOW condition
+ PVT (IIE+JI,:,:) = PVT (IIE+JI,:,:)+XRCOEFF*PFLUCTVTE
+ PWT (IIE+JI,:,:) = PWT (IIE+JI,:,:)+XRCOEFF*PFLUCTWTE
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!* 4. ADD FLUCTUATIONS THE Y DIRECTION (BOTTOM SOUTH SIDE):
+! ------------------------------------------------
+IF (LRECYCLS) THEN
+ IF (LSOUTH_ll( )) THEN
+ SELECT CASE ( HLBCY(1) )
+ CASE ('OPEN')
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ PVT(:,JJ,:)=0.
+ WHERE ( PVT(:,IJB,:) > 0. ) !INFLOW condition
+ PUT (:,JJ,:) = PUT (:,JJ,:)+XRCOEFF*PFLUCTUTS
+ PWT (:,JJ,:) = PWT (:,JJ,:)+XRCOEFF*PFLUCTWTS
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!* 5. ADD FLUCTUATIONS THE Y DIRECTION (TOP NORTH SIDE):
+! ------------------------------------------------
+IF (LRECYCLN) THEN
+ IF (LNORTH_ll( )) THEN
+ SELECT CASE ( HLBCY(2) )
+ CASE ('OPEN')
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) < 0. ) !INFLOW condition
+ PUT (:,IJE+JJ,:) = PUT (:,IJE+JJ,:)+XRCOEFF*PFLUCTUTN
+ PWT (:,IJE+JJ,:) = PWT (:,IJE+JJ,:)+XRCOEFF*PFLUCTWTN
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADDFLUCTUATIONS
+
diff --git a/src/MNH/adv_forcingn.f90 b/src/MNH/adv_forcingn.f90
index b98a9cbe9c7b5ce512a8472cbae43b6c15a05656..7b7605f1f27b7cdc786227e2128c79806f04c004 100644
--- a/src/MNH/adv_forcingn.f90
+++ b/src/MNH/adv_forcingn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-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.
diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90
index 5426d3bde08b4c0c23229519ee6b0f46814cc259..cd93fe4fa34499fe46eb5fc4ca5ce4ab810cf196 100644
--- a/src/MNH/advection_metsv.f90
+++ b/src/MNH/advection_metsv.f90
@@ -153,6 +153,7 @@ USE MODD_CST
USE MODD_CTURB, ONLY: XTKEMIN
USE MODD_CONF, ONLY: LNEUTRAL,NHALO,L1D, L2D
use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IBM_PARAM_n, ONLY: LIBM,XIBM_LS,XIBM_EPSI
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV
@@ -162,6 +163,7 @@ USE MODD_TYPE_DATE, ONLY: DATE_TIME
USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
USE MODD_PARAMETERS
+USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
!
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
@@ -176,6 +178,7 @@ USE MODI_PPM_RHODJ
USE MODI_PPM_MET
USE MODI_PPM_SCALAR
!
+!
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
@@ -338,6 +341,17 @@ IF (.NOT. L1D) THEN
ZCFLU(IIB:IIE,IJB:IJE,:) = ABS(ZRUCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
ZCFLV(IIB:IIE,IJB:IJE,:) = ABS(ZRVCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
ZCFLW(IIB:IIE,IJB:IJE,:) = ABS(ZRWCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
+ IF (LIBM) THEN
+ ZCFLU(IIB:IIE,IJB:IJE,:) = ZCFLU(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,2)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+ ZCFLV(IIB:IIE,IJB:IJE,:) = ZCFLV(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,3)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+ ZCFLW(IIB:IIE,IJB:IJE,:) = ZCFLW(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,4)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,2).GT.(-XIBM_EPSI)) ZCFLU(IIB:IIE,IJB:IJE,:)=0.
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,3).GT.(-XIBM_EPSI)) ZCFLV(IIB:IIE,IJB:IJE,:)=0.
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,4).GT.(-XIBM_EPSI)) ZCFLW(IIB:IIE,IJB:IJE,:)=0.
+ ENDIF
IF (.NOT. L2D) THEN
ZCFL = SQRT(ZCFLU**2+ZCFLV**2+ZCFLW**2)
ELSE
diff --git a/src/MNH/advecuvw_rk.f90 b/src/MNH/advecuvw_rk.f90
index 79168aa8d613162a8211d62b1440c4ab4db5f35c..c9f6bda99fcf356b580674276ba5d6becaa307e7 100644
--- a/src/MNH/advecuvw_rk.f90
+++ b/src/MNH/advecuvw_rk.f90
@@ -105,6 +105,7 @@ END MODULE MODI_ADVECUVW_RK
!! C.Lac 10/16 : Correction on RK loop
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! T. Nagel,F.Auguste : 06/2021 : add IBM
!!
!-------------------------------------------------------------------------------
!
@@ -113,16 +114,21 @@ END MODULE MODI_ADVECUVW_RK
!
USE MODD_ARGSLIST_ll, ONLY: LIST_ll, HALO2LIST_ll
USE MODD_CONF, ONLY: NHALO
+USE MODD_IBM_PARAM_n, ONLY: LIBM, CIBM_ADV, XIBM_LS, XIBM_EPSI
USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_SUB_MODEL_n, ONLY: XT_IBM_FORC
!
USE MODE_ll
USE MODE_MPPDB
use mode_msg
!
USE MODI_ADV_BOUNDARIES
+USE MODI_ADVECUVW_2ND
USE MODI_ADVECUVW_4TH
USE MODI_ADVECUVW_WENO_K
USE MODI_GET_HALO
+USE MODI_IBM_FORCING_ADV
+USE MODI_SECOND_MNH
USE MODI_SHUMAN
!
!
@@ -169,7 +175,7 @@ INTEGER :: IKE ! indice K End in z direction
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZUT, ZVT, ZWT
! Intermediate Guesses inside the RK loop
!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRUS,ZRVS,ZRWS
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRUS,ZRVS,ZRWS,ZIBM
! Momentum tendencies due to advection
REAL, DIMENSION(:,:), ALLOCATABLE :: ZBUT ! Butcher array coefficients
! at the RK sub time step
@@ -194,10 +200,11 @@ TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS4_ll ! list of fields to exchange
!
!
+REAL :: ZTIME1,ZTIME2
!-------------------------------------------------------------------------------
!
-!* 0. INITIALIZATION
-! --------------
+!* 0. INITIALIZATION
+! ---------------------
!
IKE = SIZE(PWT,3) - JPVEXT
IIU=SIZE(PUT,1)
@@ -320,6 +327,18 @@ END SELECT
ALLOCATE(ZRUS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
ALLOCATE(ZRVS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
ALLOCATE(ZRWS(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3),ISPL))
+IF ( LIBM ) THEN
+ ALLOCATE( ZIBM(SIZE(PUT,1), SIZE(PUT,2), SIZE(PWT,3), 3) )
+ ZIBM(:,:,:,:) = 1.
+END IF
+!
+IF (LIBM .AND. CIBM_ADV=='FREEZE') THEN
+
+ WHERE (XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZIBM(:,:,:,1) = 0.
+ WHERE (XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZIBM(:,:,:,2) = 0.
+ WHERE (XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZIBM(:,:,:,3) = 0.
+
+ENDIF
!
PRUS_ADV = 0.
PRVS_ADV = 0.
@@ -328,7 +347,7 @@ PRWS_ADV = 0.
!-------------------------------------------------------------------------------
!
!* 2. Wind guess before RK loop
-! -------------------------
+! --------------------------------
!
ZUT = PU
ZVT = PV
@@ -351,21 +370,26 @@ ZRWS = 0.
!-------------------------------------------------------------------------------
!
!* 3. BEGINNING of Runge-Kutta loop
-! -----------------------------
+! ------------------------------------
+!
+RKLOOP: DO JS = 1, ISPL
+!
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZUT, PUT, 'U' )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZVT, PVT, 'V' )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZWT, PWT, 'W' )
!
- DO JS = 1, ISPL
-!
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZUT, PUT, 'U' )
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZVT, PVT, 'V' )
- CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZWT, PWT, 'W' )
-!
- CALL UPDATE_HALO_ll(TZFIELDMT_ll,IINFO_ll)
- CALL UPDATE_HALO2_ll(TZFIELDMT_ll, TZHALO2MT_ll, IINFO_ll)
+ CALL UPDATE_HALO_ll(TZFIELDMT_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELDMT_ll, TZHALO2MT_ll, IINFO_ll)
!
!* 4. Advection with WENO
-! -------------------
+! --------------------------
+!
+ IF (LIBM .AND. CIBM_ADV=='LOWORD') THEN
+ ZIBM(:,:,:,1)=ZRUS(:,:,:,JS)
+ ZIBM(:,:,:,2)=ZRVS(:,:,:,JS)
+ ZIBM(:,:,:,3)=ZRWS(:,:,:,JS)
+ ENDIF
!
-
IF (HUVW_ADV_SCHEME=='WENO_K') THEN
CALL ADVECUVW_WENO_K (HLBCX, HLBCY, KWENO_ORDER, ZUT, ZVT, ZWT, &
PRUCT, PRVCT, PRWCT, &
@@ -378,51 +402,99 @@ ZRWS = 0.
TZHALO2MT_ll )
ENDIF
!
- NULLIFY(TZFIELDS4_ll)
+ IF (LIBM .AND. CIBM_ADV=='LOWORD') THEN
+ IF (HUVW_ADV_SCHEME=='WENO_K') THEN
+ CALL ADVECUVW_WENO_K (HLBCX, HLBCY, 3, ZUT, ZVT, ZWT, &
+ PRUCT, PRVCT, PRWCT, &
+ ZIBM(:,:,:,1), ZIBM(:,:,:,2), ZIBM(:,:,:,3) ,&
+ TZHALO2MT_ll )
+ ENDIF
+ IF (HUVW_ADV_SCHEME=='CEN4TH') THEN
+ CALL ADVECUVW_2ND (ZUT, ZVT, ZWT, PRUCT, PRVCT, PRWCT, &
+ ZIBM(:,:,:,1), ZIBM(:,:,:,2), ZIBM(:,:,:,3))
+ ENDIF
+ WHERE(XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZRUS(:,:,:,JS)=ZIBM(:,:,:,1)
+ WHERE(XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZRVS(:,:,:,JS)=ZIBM(:,:,:,2)
+ WHERE(XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZRWS(:,:,:,JS)=ZIBM(:,:,:,3)
+ ZIBM(:,:,:,:)=1.
+ ENDIF
+!
+ NULLIFY(TZFIELDS4_ll)
!
- write ( ynum, '( I3 )' ) js
- CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZRUS(:,:,:,JS), 'ADVECUVW_RK::ZRUS(:,:,:,'//trim( adjustl( ynum ) )//')' )
- CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZRVS(:,:,:,JS), 'ADVECUVW_RK::ZRVS(:,:,:,'//trim( adjustl( ynum ) )//')' )
- CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZRWS(:,:,:,JS), 'ADVECUVW_RK::ZRWS(:,:,:,'//trim( adjustl( ynum ) )//')' )
- CALL UPDATE_HALO_ll(TZFIELDS4_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS4_ll)
-!
- IF ( JS /= ISPL ) THEN
+ write ( ynum, '( I3 )' ) js
+ CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZRUS(:,:,:,JS), 'ADVECUVW_RK::ZRUS(:,:,:,'//trim( adjustl( ynum ) )//')' )
+ CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZRVS(:,:,:,JS), 'ADVECUVW_RK::ZRVS(:,:,:,'//trim( adjustl( ynum ) )//')' )
+ CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZRWS(:,:,:,JS), 'ADVECUVW_RK::ZRWS(:,:,:,'//trim( adjustl( ynum ) )//')' )
+ CALL UPDATE_HALO_ll(TZFIELDS4_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS4_ll)
!
- ZUT = PU
- ZVT = PV
- ZWT = PW
+ IF (LIBM .AND. CIBM_ADV=='FREEZE') THEN
+ WHERE(XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZRUS(:,:,:,JS)=ZUT(:,:,:)*PMXM_RHODJ(:,:,:)/PTSTEP
+ WHERE(XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZRVS(:,:,:,JS)=ZVT(:,:,:)*PMYM_RHODJ(:,:,:)/PTSTEP
+ WHERE(XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZRWS(:,:,:,JS)=ZWT(:,:,:)*PMZM_RHODJ(:,:,:)/PTSTEP
+ ENDIF
+
+ IF (LIBM .AND. CIBM_ADV=='FORCIN') THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL IBM_FORCING_ADV(ZRUS(:,:,:,JS),ZRVS(:,:,:,JS),ZRWS(:,:,:,JS))
+ CALL SECOND_MNH(ZTIME2)
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ ENDIF
!
- DO JI = 1, JS
+ IF ( JS /= ISPL ) THEN
!
-! Intermediate guesses inside the RK loop
+ ZUT = PU
+ ZVT = PV
+ ZWT = PW
!
- ZUT(:,:,:) = ZUT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
- ( ZRUS(:,:,:,JI) + PRUS_OTHER(:,:,:) ) / PMXM_RHODJ
- ZVT(:,:,:) = ZVT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
- ( ZRVS(:,:,:,JI) + PRVS_OTHER(:,:,:) ) / PMYM_RHODJ
- ZWT(:,:,:) = ZWT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
- ( ZRWS(:,:,:,JI) + PRWS_OTHER(:,:,:) ) / PMZM_RHODJ
!
- END DO
+! Intermediate guesses inside the RK loop
!
- ELSE
+ IF ( .NOT. LIBM ) THEN
+ DO JI = 1, JS
+ ZUT(:,:,:) = ZUT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
+ ( ZRUS(:,:,:,JI) + PRUS_OTHER(:,:,:) ) / PMXM_RHODJ(:,:,:)
+ ZVT(:,:,:) = ZVT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
+ ( ZRVS(:,:,:,JI) + PRVS_OTHER(:,:,:) ) / PMYM_RHODJ(:,:,:)
+ ZWT(:,:,:) = ZWT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
+ ( ZRWS(:,:,:,JI) + PRWS_OTHER(:,:,:) ) / PMZM_RHODJ(:,:,:)
+ END DO
+ ELSE
+ DO JI = 1, JS
+ ZUT(:,:,:) = ZUT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
+ ( ZRUS(:,:,:,JI) + PRUS_OTHER(:,:,:) ) / PMXM_RHODJ(:,:,:) * ZIBM(:,:,:,1)
+ ZVT(:,:,:) = ZVT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
+ ( ZRVS(:,:,:,JI) + PRVS_OTHER(:,:,:) ) / PMYM_RHODJ(:,:,:) * ZIBM(:,:,:,2)
+ ZWT(:,:,:) = ZWT(:,:,:) + ZBUT(JS,JI) * PTSTEP * &
+ ( ZRWS(:,:,:,JI) + PRWS_OTHER(:,:,:) ) / PMZM_RHODJ(:,:,:) * ZIBM(:,:,:,3)
+ END DO
+ END IF
+!
+!
+ ELSE
!
! Guesses at the end of the RK loop
!
- DO JI = 1, ISPL
- PRUS_ADV(:,:,:) = PRUS_ADV(:,:,:) + ZBUTS(JI) * ZRUS(:,:,:,JI)
- PRVS_ADV(:,:,:) = PRVS_ADV(:,:,:) + ZBUTS(JI) * ZRVS(:,:,:,JI)
- PRWS_ADV(:,:,:) = PRWS_ADV(:,:,:) + ZBUTS(JI) * ZRWS(:,:,:,JI)
- END DO
+ IF ( .NOT. LIBM ) THEN
+ DO JI = 1, ISPL
+ PRUS_ADV(:,:,:) = PRUS_ADV(:,:,:) + ZBUTS(JI) * ZRUS(:,:,:,JI)
+ PRVS_ADV(:,:,:) = PRVS_ADV(:,:,:) + ZBUTS(JI) * ZRVS(:,:,:,JI)
+ PRWS_ADV(:,:,:) = PRWS_ADV(:,:,:) + ZBUTS(JI) * ZRWS(:,:,:,JI)
+ END DO
+ ELSE
+ DO JI = 1, ISPL
+ PRUS_ADV(:,:,:) = PRUS_ADV(:,:,:) + ZBUTS(JI) * ZRUS(:,:,:,JI) * ZIBM(:,:,:,1)
+ PRVS_ADV(:,:,:) = PRVS_ADV(:,:,:) + ZBUTS(JI) * ZRVS(:,:,:,JI) * ZIBM(:,:,:,2)
+ PRWS_ADV(:,:,:) = PRWS_ADV(:,:,:) + ZBUTS(JI) * ZRWS(:,:,:,JI) * ZIBM(:,:,:,3)
+ END DO
+ END IF
!
END IF
!
! End of the RK loop
- END DO
+ END DO RKLOOP
!
!
-DEALLOCATE(ZBUT, ZBUTS, ZRUS, ZRVS, ZRWS)
CALL CLEANLIST_ll(TZFIELDMT_ll)
CALL DEL_HALO2_ll(TZHALO2MT_ll)
!-------------------------------------------------------------------------------
diff --git a/src/MNH/bl89.f90 b/src/MNH/bl89.f90
index 860afcf7985344f55f85f9b8efc2314ceb658774..8d9fe3e369828bca9115ce04c6ea4b01cfb18570 100644
--- a/src/MNH/bl89.f90
+++ b/src/MNH/bl89.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-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 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/bl89.f90,v $ $Revision: 1.1.8.1.2.2.16.1.2.1 $ $Date: 2014/01/09 13:25:02 $
-!-----------------------------------------------------------------
! ################
MODULE MODI_BL89
! ################
@@ -72,14 +68,17 @@ END MODULE MODI_BL89
!! reversed vertical levels
!! Philippe 13/02/2018: use ifdef MNH_REAL to prevent problems with intrinsics on Blue Gene/Q
!! 01/2019 (Q. Rodier) support for RM17 mixing length
+!! 03/2021 (JL Redelsperger) Ocean model case
+!! 06/2021 (P. Marquet) correction of exponent on final length according to Lemarié et al. 2021
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CONF, ONLY: CPROGRAM
+USE MODD_CONF, ONLY: CPROGRAM
USE MODD_CST
USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_PARAMETERS
use modd_precision, only: MNHREAL
!
@@ -136,7 +135,7 @@ INTEGER :: JRR ! moist loop counter
REAL :: ZRVORD ! Rv/Rd
REAL :: ZPOTE,ZLWORK1,ZLWORK2
REAL :: ZTEST,ZTEST0,ZTESTM ! test for vectorization
-REAL :: Z2SQRT2
+REAL :: Z2SQRT2,ZUSRBL89,ZBL89EXP
!-------------------------------------------------------------------------------
!
Z2SQRT2=2.*SQRT(2.)
@@ -177,6 +176,7 @@ ELSE
ZSHEAR (:,JK) = RESHAPE(PSHEAR (:,:,JK),(/ IIU*IJU /) )
ZTKEM (:,JK) = RESHAPE(PTKEM (:,:,JK),(/ IIU*IJU /) )
ZG_O_THVREF(:,JK) = RESHAPE(XG/PTHVREF(:,:,JK),(/ IIU*IJU /) )
+ IF (LOCEAN) ZG_O_THVREF(:,JK) = XG * XALPHAOC
DO JRR=1,KRR
ZRM (:,JK,JRR) = RESHAPE(PRM (:,:,JK,JRR),(/ IIU*IJU /) )
END DO
@@ -184,6 +184,10 @@ ELSE
END IF
!
ZSQRT_TKE = SQRT(ZTKEM)
+!
+!ZBL89EXP is defined here because (and not in ini_cturb) because XCED is defined in read_exseg (depending on BL89/RM17)
+ZBL89EXP = LOG(16.)/(4.*LOG(XKARMAN)+LOG(XCED)-3.*LOG(XCMFS))
+ZUSRBL89 = 1./ZBL89EXP
!-------------------------------------------------------------------------------
!
!* 2. Virtual potential temperature on the model grid
@@ -351,8 +355,8 @@ DO JK=IKTB,IKTE
ZLWORK1=MAX(ZLMDN(J1D,JK),1.E-10_MNHREAL)
ZLWORK2=MAX(ZLWORK(J1D),1.E-10_MNHREAL)
ZPOTE = ZLWORK1 / ZLWORK2
- ZLWORK2=1.d0 + ZPOTE**(2./3.)
- ZLM(J1D,JK) = Z2SQRT2*ZLWORK1/(ZLWORK2*SQRT(ZLWORK2))
+ ZLWORK2=1.d0 + ZPOTE**ZBL89EXP
+ ZLM(J1D,JK) = ZLWORK1*(2./ZLWORK2)**ZUSRBL89
END DO
ZLM(:,JK)=MAX(ZLM(:,JK),XLINI)
diff --git a/src/MNH/boundaries.f90 b/src/MNH/boundaries.f90
index 3ab2cf047ca338a8a6a0c4360328154d2f6da13f..046a28af303cc6401540b799ad74289b7794fb3d 100644
--- a/src/MNH/boundaries.f90
+++ b/src/MNH/boundaries.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -990,7 +990,7 @@ IF (CCLOUD == 'LIMA' .AND. IMI == 1 .AND. CPROGRAM=='MESONH') THEN
ENDIF
CALL INIT_AEROSOL_CONCENTRATION(PRHODREF,ZSVT,XZZ)
DO JSV=NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 ! LBC for CCN
- IF (GLIMABOUNDARY(JSV-NSV_LIMA_CCN_FREE+1)) THEN
+ IF (GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1)) THEN
PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
@@ -998,7 +998,7 @@ IF (CCLOUD == 'LIMA' .AND. IMI == 1 .AND. CPROGRAM=='MESONH') THEN
ENDIF
END DO
DO JSV=NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 ! LBC for IFN
- IF (GLIMABOUNDARY(JSV-NSV_LIMA_IFN_FREE+1)) THEN
+ IF (GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1)) THEN
PSVT(IIB-1,:,:,JSV)=ZSVT(IIB-1,:,:,JSV)
PSVT(IIE+1,:,:,JSV)=ZSVT(IIE+1,:,:,JSV)
PSVT(:,IJB-1,:,JSV)=ZSVT(:,IJB-1,:,JSV)
@@ -1008,7 +1008,7 @@ IF (CCLOUD == 'LIMA' .AND. IMI == 1 .AND. CPROGRAM=='MESONH') THEN
CALL SET_CONC_LIMA( IMI, 'NONE', PRHODREF, ZRT(:, :, :, :), ZSVT(:, :, :, NSV_LIMA_BEG:NSV_LIMA_END) )
IF (NSV_LIMA_NC.GE.1) THEN
- IF (GLIMABOUNDARY(NSV_LIMA_NC)) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NC-NSV_LIMA_BEG+1)) THEN
PSVT(IIB-1,:,:,NSV_LIMA_NC)=ZSVT(IIB-1,:,:,NSV_LIMA_NC) ! cloud
PSVT(IIE+1,:,:,NSV_LIMA_NC)=ZSVT(IIE+1,:,:,NSV_LIMA_NC)
PSVT(:,IJB-1,:,NSV_LIMA_NC)=ZSVT(:,IJB-1,:,NSV_LIMA_NC)
@@ -1016,7 +1016,7 @@ IF (CCLOUD == 'LIMA' .AND. IMI == 1 .AND. CPROGRAM=='MESONH') THEN
ENDIF
ENDIF
IF (NSV_LIMA_NR.GE.1) THEN
- IF (GLIMABOUNDARY(NSV_LIMA_NR)) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NR-NSV_LIMA_BEG+1)) THEN
PSVT(IIB-1,:,:,NSV_LIMA_NR)=ZSVT(IIB-1,:,:,NSV_LIMA_NR) ! rain
PSVT(IIE+1,:,:,NSV_LIMA_NR)=ZSVT(IIE+1,:,:,NSV_LIMA_NR)
PSVT(:,IJB-1,:,NSV_LIMA_NR)=ZSVT(:,IJB-1,:,NSV_LIMA_NR)
@@ -1024,14 +1024,13 @@ IF (CCLOUD == 'LIMA' .AND. IMI == 1 .AND. CPROGRAM=='MESONH') THEN
ENDIF
ENDIF
IF (NSV_LIMA_NI.GE.1) THEN
- IF (GLIMABOUNDARY(NSV_LIMA_NI)) THEN
+ IF (GLIMABOUNDARY(NSV_LIMA_NI-NSV_LIMA_BEG+1)) THEN
PSVT(IIB-1,:,:,NSV_LIMA_NI)=ZSVT(IIB-1,:,:,NSV_LIMA_NI) ! ice
PSVT(IIE+1,:,:,NSV_LIMA_NI)=ZSVT(IIE+1,:,:,NSV_LIMA_NI)
PSVT(:,IJB-1,:,NSV_LIMA_NI)=ZSVT(:,IJB-1,:,NSV_LIMA_NI)
PSVT(:,IJE+1,:,NSV_LIMA_NI)=ZSVT(:,IJE+1,:,NSV_LIMA_NI)
ENDIF
END IF
-
END IF
!
!
diff --git a/src/MNH/call_rttov11.f90 b/src/MNH/call_rttov11.f90
index 68864a5cef7e02c1312f67678ce31f45449c2344..8e69111883567834631b7ccbce85d926a4e8d862 100644
--- a/src/MNH/call_rttov11.f90
+++ b/src/MNH/call_rttov11.f90
@@ -93,6 +93,7 @@ USE MODD_CST
USE MODD_PARAMETERS
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODD_LUNIT_n
USE MODD_DEEP_CONVECTION_n
USE MODD_REF_n
@@ -542,6 +543,12 @@ DO JSAT=1,IJSAT ! loop over sensors
END DO
END DO
END DO
+! -----------------------------------------------------------------------------
+! LATERAL BOUNDARY FILLING
+ IF (LWEST_ll() .AND.CLBCX(1)/='CYCL') ZOUT(IIB-1,:,:) = ZOUT(IIB,:,:)
+ IF (LEAST_ll() .AND.CLBCX(1)/='CYCL') ZOUT(IIE+1,:,:) = ZOUT(IIE,:,:)
+ IF (LSOUTH_ll().AND.CLBCY(1)/='CYCL') ZOUT(:,IJB-1,:) = ZOUT(:,IJB,:)
+ IF (LNORTH_ll().AND.CLBCY(1)/='CYCL') ZOUT(:,IJE+1,:) = ZOUT(:,IJE,:)
! -----------------------------------------------------------------------------
YBEG=' '
IF (KRTTOVINFO(1,JSAT) <= 2 .OR. KRTTOVINFO(1,JSAT) == 4) THEN ! NOAA
diff --git a/src/MNH/call_rttov13.f90 b/src/MNH/call_rttov13.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1ea5ca251092611145952dec6254defff741af6e
--- /dev/null
+++ b/src/MNH/call_rttov13.f90
@@ -0,0 +1,731 @@
+!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.
+!-----------------------------------------------------------------
+! ########################
+ MODULE MODI_CALL_RTTOV13
+! ########################
+INTERFACE
+!
+ SUBROUTINE CALL_RTTOV13(KDLON, KFLEV, PEMIS, PTSRAD, &
+ PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
+ OUSERI, KRTTOVINFO, TPFILE )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KDLON !number of columns where the
+ !radiation calculations are performed
+INTEGER, INTENT(IN) :: KFLEV !number of vertical levels where the
+ !radiation calculations are performed
+!
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
+REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD !RADiative Surface Temperature
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !THeta at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !moist variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST !pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !Model level heights
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
+REAL, DIMENSION(:,:), INTENT(IN) :: PULVLKB ! U-wind at KB level
+REAL, DIMENSION(:,:), INTENT(IN) :: PVLVLKB ! V-wind at KB level
+!
+LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
+ ! liquid and solid condensate (OUSERI=.TRUE.)
+ ! or only liquid condensate (OUSERI=.FALSE.)
+!
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KRTTOVINFO ! platform, satellite, sensor,
+ ! and selection calculations
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
+!
+END SUBROUTINE CALL_RTTOV13
+END INTERFACE
+END MODULE MODI_CALL_RTTOV13
+! #####################################################################
+SUBROUTINE CALL_RTTOV13(KDLON, KFLEV, PEMIS, PTSRAD, &
+ PTHT, PRT, PPABST, PZZ, PMFCONV, PCLDFR, PULVLKB, PVLVLKB, &
+ OUSERI, KRTTOVINFO, TPFILE )
+! #####################################################################
+!!
+!!**** *CALL_RTTOV* -
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! See Chaboureau and Pinty, 2006
+!! Validation of a cirrus parameterization with Meteosat Second Generation
+!! observations. Geophys. Res. Let., doi:10.1029/2005GL024725
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Chaboureau *L.A.*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 11/12/03
+!! JP Chaboureau 27/03/2008 Vectorization
+!! JP Chaboureau 02/11/2009 move GANGL deallocation outside the sensor loop
+!! J.Escobar 15/09/2015 WENO5 & JPHEXT <> 1
+!! JP Chaboureau 09/04/2021 adapt to call RTTOV13
+!!----------------------------------------------------------------------------
+!!
+!!* 0. DECLARATIONS
+!! ------------
+!!
+USE MODD_CST
+USE MODD_PARAMETERS
+USE MODD_GRID_n
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODD_LUNIT_n
+USE MODD_LBC_n
+USE MODD_DEEP_CONVECTION_n
+USE MODD_REF_n
+USE MODD_RADIATIONS_n, ONLY : XSEA, XZENITH
+USE MODD_TIME_n, ONLY: TDTCUR ! Current Time and Date
+!
+USE MODN_CONF
+!
+USE MODI_SUNPOS_n
+USE MODI_DETER_ANGLE
+USE MODI_PINTER
+!
+USE MODE_IO_FIELD_WRITE, ONLY: IO_Field_write
+USE MODE_ll
+USE MODE_TOOLS_ll
+USE MODE_MSG
+USE MODE_POS
+!
+#ifdef MNH_RTTOV_13
+USE rttov_const, ONLY : errorstatus_success, &
+ & sensor_id, sensor_id_ir, sensor_id_hi, sensor_id_mw, inst_name, &
+ & platform_name, gas_unit_specconc, tmin, tmax, qmin, qmax, pmin, pmax, &
+ & rad2deg, zenmaxv9
+USE rttov_types
+USE mod_rttov_brdf_atlas, ONLY : rttov_brdf_atlas_data
+USE parkind1, ONLY: jpim, jprb, jplm
+!
+IMPLICIT NONE
+!
+! -----------------------------------------------------------------------------
+#include "rttov_direct.interface"
+#include "rttov_read_coefs.interface"
+#include "rttov_alloc_transmission.interface"
+#include "rttov_dealloc_coefs.interface"
+#include "rttov_alloc_direct.interface"
+#include "rttov_read_scattcoeffs.interface"
+#include "rttov_dealloc_scattcoeffs.interface"
+#include "rttov_scatt_setupindex.interface"
+#include "rttov_scatt.interface"
+#include "rttov_scatt_ad.interface"
+#include "rttov_alloc_rad.interface"
+#include "rttov_init_rad.interface"
+#include "rttov_alloc_prof.interface"
+#include "rttov_alloc_scatt_prof.interface"
+! Use BRDF atlas
+#include "rttov_setup_brdf_atlas.interface"
+#include "rttov_get_brdf.interface"
+#include "rttov_deallocate_brdf_atlas.interface"
+#endif
+!!!
+!!!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
+!!!
+INTEGER, INTENT(IN) :: KDLON !number of columns where the
+! radiation calculations are performed
+INTEGER, INTENT(IN) :: KFLEV !number of vertical levels where the
+! radiation calculations are performed
+!!!
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
+REAL, DIMENSION(:,:), INTENT(IN) :: PTSRAD !RADiative Surface Temperature
+ !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT !THeta at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT !moist variables at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST !pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !Model level heights
+!!!
+!!!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux (kg /s m^2)
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
+REAL, DIMENSION(:,:), INTENT(IN) :: PULVLKB ! U-wind at KB level
+REAL, DIMENSION(:,:), INTENT(IN) :: PVLVLKB ! V-wind at KB level
+!!!
+LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
+! liquid and solid condensate (OUSERI=.TRUE.)
+! or only liquid condensate (OUSERI=.FALSE.)
+!!!
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KRTTOVINFO ! platform, satellite, sensor,
+ ! and selection calculations
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File characteristics
+!
+#ifdef MNH_RTTOV_13
+!!!
+!!!* 0.2 DECLARATIONS OF LOCAL VARIABLES
+!!!
+!!!
+LOGICAL(KIND=jplm) :: thermal, solar
+
+INTEGER(KIND=jpim), PARAMETER :: nhydro_frac = 1
+!
+INTEGER :: JI,JJ,JK,JK1,JK2,JKRAD,JKF,JSAT,JC ! loop indexes
+!
+INTEGER :: IJSAT ! number of columns/=NUNDEF which
+ ! have to be treated in the table KRTTOVINFO(:,:)
+INTEGER :: IIB,IIE ! I index value of the first/last inner mass point
+INTEGER :: IJB,IJE ! J index value of the first/last inner mass point
+INTEGER :: IKB,IKE ! K index value of the first/last inner mass point
+INTEGER :: IIU ! array size for the first index
+INTEGER :: IJU ! array size for the second index
+INTEGER :: IKU ! array size for the third index
+INTEGER :: IKR ! real array size for the third index
+INTEGER (Kind=jpim) :: iwp_levels ! equal to IKR (call to rttov_scatt)
+INTEGER :: IIJ ! reformatted array index
+INTEGER :: IKSTAE ! level number of the STAndard atmosphere array
+INTEGER :: IKUP ! vertical level above which STAndard atmosphere data
+
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOUT
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZANTMP, ZUTH
+REAL :: ZZH, zdeg_to_rad, zrad_to_deg, zbeta, zalpha
+
+! Other arrays for zenithal solar angle
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOSZEN, ZSINZEN, ZAZIMSOL
+
+! -----------------------------------------------------------------------------
+REAL, DIMENSION(1) :: ZANGL, ZLON, ZLAT !Satellite zenith angle, longitude, latitude (deg)
+! -----------------------------------------------------------------------------
+! Realistic maximum values for hydrometeor content in kg/kg
+REAL :: ZRCMAX = 5.0E-03, ZRRMAX = 5.0E-03, ZRIMAX = 2.0E-03, ZRSMAX = 5.0E-03
+! -----------------------------------------------------------------------------
+INTEGER, DIMENSION(:), ALLOCATABLE :: IMSURF !Surface type index
+
+INTEGER :: IKFBOT, IKFTOP, INDEX, ISUM, JLEV, JCH, IWATER, ICAN
+! at the open of the file LFI routines
+CHARACTER(LEN=8) :: YINST
+CHARACTER(LEN=4) :: YBEG, YEND
+CHARACTER(LEN=2) :: YCHAN, YTWO
+CHARACTER(LEN=1) :: YONE
+
+INTEGER, PARAMETER :: JPPLAT=16
+
+CHARACTER(LEN=3), DIMENSION(JPPLAT) :: YPLAT= (/ &
+ 'N ','D ','MET','GO ','GMS','FY2','TRM','ERS', &
+ 'EOS','MTP','ENV','MSG','FY1','ADS','MTS','CRL' /)
+CHARACTER(LEN=2), DIMENSION(2) :: YLBL_MVIRI = (/ 'WV', 'IR'/)
+CHARACTER(LEN=3), DIMENSION(7) :: YLBL_SSMI = (/ &
+ '19V','19H','22V','37V','37H','85V','85H'/)
+CHARACTER(LEN=3), DIMENSION(9) :: YLBL_TMI = (/ &
+ '10V','10H','19V','19H','22V','37V','37H','85V','85H'/)
+CHARACTER(LEN=3), DIMENSION(12) :: YLBL_SEVIRI = (/ &
+ 'V06', 'V08', 'N16', '039', '062','073','087','097','108','120','134', 'HRV'/)
+CHARACTER(LEN=3), DIMENSION(4) :: YLBL_GOESI = (/ &
+ '039', '067','107','120'/)
+
+! -----------------------------------------------------------------------------
+LOGICAL (kind=jplm) , ALLOCATABLE :: calcemis (:)
+LOGICAL(KIND=jplm) , ALLOCATABLE :: use_chan (:,:) ! Flags to specify channels to simulate
+INTEGER (kind=jpim) , ALLOCATABLE :: frequencies (:)
+TYPE (rttov_chanprof) , ALLOCATABLE :: chanprof (:) ! Channel and profile indices
+TYPE (rttov_profile) , ALLOCATABLE :: profiles (:)
+TYPE (rttov_profile_cloud), ALLOCATABLE :: cld_profiles(:)
+TYPE(rttov_emissivity) , ALLOCATABLE :: emissivity (:) ! Input/output surface emissivity
+LOGICAL(KIND=jplm) , ALLOCATABLE :: calcrefl (:) ! Flag to indicate calculation of BRDF within RTTOV
+TYPE(rttov_reflectance) , ALLOCATABLE :: reflectance (:) ! Input/output surface BRDF
+TYPE(rttov_transmission) :: transmission ! Output transmittances
+INTEGER(KIND=jpim) :: asw
+INTEGER(jpim) :: run_gas_units = gas_unit_specconc ! mass mixing ratio [kg/kg]
+
+integer (kind=jpim) :: errorstatus
+type (rttov_radiance) :: radiance, radiance_k
+type (rttov_options) :: opts ! Defaults to everything optional switched off
+type (rttov_options_scatt) :: opts_scatt
+type (rttov_coefs ) :: coefs
+type (rttov_scatt_coef) :: coef_scatt
+
+TYPE(rttov_brdf_atlas_data) :: brdf_atlas ! Data structure for BRDF atlas
+
+integer (kind=jpim) :: instrument (3)
+integer (kind=jpim) :: ilev, iprof, ichan, nprof, nchannels, nlevels, nchanprof
+real (kind=jprb) :: zenangle
+integer (kind=jpim), parameter :: fin = 10
+character (len=256) :: outstring
+! -----------------------------------------------------------------------------
+REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZTEMP
+TYPE(TFIELDDATA) :: TZFIELD
+!-------------------------------------------------------------------------------
+!
+!* 0. ARRAYS BOUNDS INITIALIZATION
+!
+IIU=SIZE(PTHT,1)
+IJU=SIZE(PTHT,2)
+IKU=SIZE(PTHT,3)
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=IKU-JPVEXT
+
+errorstatus = 0
+nlevels=IKE-IKB+1
+nprof=1
+ZTEMP = PTHT * ( PPABST/XP00 ) ** (XRD/XCPD)
+DO JSAT=1,SIZE(KRTTOVINFO,2)
+ IF (KRTTOVINFO(1,JSAT) /= NUNDEF) THEN
+ IJSAT = JSAT
+ END IF
+END DO
+
+opts % interpolation % addinterp = .TRUE. ! Allow interpolation of input profile
+opts % interpolation % interp_mode = 1 ! Set interpolation method
+opts % config % do_checkinput = .TRUE.
+opts % config % verbose = .TRUE. ! Enable printing of warnings
+opts_scatt % config % verbose = .FALSE. ! Disable printing of warnings
+opts_scatt % lusercfrac = .TRUE.
+
+ALLOCATE(ZCOSZEN(IIU,IJU))
+ALLOCATE(ZSINZEN(IIU,IJU))
+ALLOCATE(ZAZIMSOL(IIU,IJU))
+CALL SUNPOS_n ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL )
+
+! -----------------------------------------------------------------------------
+! *** LOOP OVER SENSORS ***
+! -----------------------------------------------------------------------------
+DO JSAT=1,IJSAT ! loop over sensors
+
+ instrument(1)=KRTTOVINFO(1,JSAT)
+ instrument(2)=KRTTOVINFO(2,JSAT)
+ instrument(3)=KRTTOVINFO(3,JSAT)
+
+ IF( sensor_id( instrument(3) ) /= sensor_id_mw) THEN
+ opts % rt_ir % addsolar = .FALSE. ! Do not include solar radiation
+ IF (KRTTOVINFO(4,JSAT).EQ.1) THEN
+ opts % rt_ir % addsolar = .TRUE. ! Include solar radiation
+ END IF
+ opts % rt_ir % addaerosl = .FALSE. ! Do not include aerosol effects
+ opts % rt_ir % addclouds = .TRUE. ! Include cloud effects
+ opts % rt_ir % ir_scatt_model = 2 ! Scattering model for emission source term:
+ ! 1 => DOM; 2 => Chou-scaling
+ opts % rt_ir % vis_scatt_model = 1 ! Scattering model for solar source term:
+ ! 1 => DOM; 2 => single-scattering; 3 => MFASIS
+ opts % rt_ir % dom_nstreams = 8 ! Number of streams for Discrete Ordinates (DOM)
+ opts % rt_all % addrefrac = .TRUE. ! Include refraction in path calc
+ opts % rt_all % ozone_data = .FALSE. ! Set the relevant flag to .TRUE.
+ opts % rt_all % co2_data = .FALSE. ! when supplying a profile of the
+ opts % rt_all % n2o_data = .FALSE. ! given trace gas (ensure the
+ opts % rt_all % ch4_data = .FALSE. ! coef file supports the gas)
+ opts % rt_all % co_data = .FALSE. !
+ opts % rt_all % so2_data = .FALSE. !
+
+ opts % rt_ir % user_cld_opt_param = .FALSE.
+! opts % rt_mw % clw_data = .FALSE. !
+ ELSE
+ opts % rt_all % addrefrac = .FALSE. ! Do not include refraction in path calc
+ opts % rt_ir % addsolar = .FALSE. ! Do not include solar radiation
+ opts % rt_ir % addclouds = .FALSE. ! Include cloud effects
+ END IF
+
+! Read and initialise coefficients
+! -----------------------------------------------------------------------------
+ CALL rttov_read_coefs (errorstatus, coefs, opts, instrument=instrument)
+ IF (errorstatus /= errorstatus_success) THEN
+ WRITE(*,*) 'error rttov_readcoeffs :',errorstatus
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV13','error rttov_readcoeffs')
+ END IF
+
+ IF (coefs%coef%id_sensor == sensor_id_mw) THEN
+ CALL rttov_read_scattcoeffs (errorstatus, opts_scatt, coefs, coef_scatt, &
+ file_coef='hydrotable_'// &
+ TRIM(platform_name(instrument(1)))//'_'// &
+ TRIM(inst_name(instrument(3)))//'.dat')
+ IF (errorstatus /= errorstatus_success) THEN
+ WRITE(*,*) 'error rttov_readcoeffs :',errorstatus
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV13','error rttov_read_scattcoeffs')
+ END IF
+ END IF
+
+ IF (opts % rt_ir % addsolar) THEN
+ ! Initialise the RTTOV BRDF atlas
+ CALL rttov_setup_brdf_atlas( &
+ errorstatus, &
+ opts, &
+ TDTCUR%nmonth, &
+ brdf_atlas, &
+ path='brdf_data', &
+ coefs = coefs) ! If supplied the BRDF atlas is initialised for this sensor and
+ ! this makes the atlas much faster to access
+ IF (errorstatus /= errorstatus_success) THEN
+ WRITE(*,*) 'error initialising BRDF atlas'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV13','error rttov_setup_brdf_atlas')
+ END IF
+ END IF
+
+ nchannels = coefs%coef%fmv_chn ! number of channels on instrument
+ nchanprof = nprof * nchannels ! total channels to simulate
+
+ ALLOCATE(ZOUT(IIU,IJU,nchanprof))
+ ZOUT(:,:,:)=XUNDEF
+
+ ! Allocate structures for RTTOV direct model
+! CALL rttov_alloc_direct( &
+! errorstatus, &
+! 1_jpim, & ! 1 => allocate
+! nprof, &
+! nchanprof, &
+!! nlevels, &
+! chanprof, &
+! opts, &
+! profiles, &
+! coefs, &
+! radiance = radiance, &
+! calcemis = calcemis, &
+! emissivity = emissivity, &
+! frequencies = frequencies, &
+! coef_scatt = coef_scatt, &
+! nhydro_frac = nhydro_frac, &
+! cld_profiles = cld_profiles, &
+! init = .TRUE._jplm)
+! IF (errorstatus /= errorstatus_success) THEN
+! WRITE(*,*) 'allocation error for rttov_direct structures :',errorstatus
+! CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV13','error rttov_alloc_direct')
+! ENDIF
+
+ ALLOCATE (chanprof (nchanprof))
+ ALLOCATE (frequencies (nchanprof))
+ ALLOCATE (emissivity (nchanprof))
+ ALLOCATE (calcemis (nchanprof))
+ ALLOCATE (profiles (nprof))
+ IF (coefs%coef% id_sensor == sensor_id_mw) THEN
+ ALLOCATE (cld_profiles (nprof))
+ END IF
+
+ IF (coefs%coef% id_sensor /= sensor_id_mw) THEN
+ calcemis = .FALSE.
+ ! Allocate arrays for surface reflectance
+ ALLOCATE(calcrefl(nchanprof))
+ ALLOCATE(reflectance(nchanprof))
+ calcrefl = .TRUE.
+ reflectance % refl_in = 0.0_JPRB
+ ! Use default cloud top BRDF for simple cloud in VIS/NIR channels
+ reflectance % refl_cloud_top = 0._jprb
+ ! Let RTTOV provide diffuse surface reflectances
+ reflectance % diffuse_refl_in = 0._jprb
+ ELSE
+ ! Request RTTOV / FASTEM to calculate surface emissivity
+ calcemis = .TRUE.
+ emissivity % emis_in = 0.0_JPRB
+ END IF
+
+
+ ! --------------------------------------------------------------------------
+ ! 4. Build the list of profile/channel indices in chanprof
+ ! --------------------------------------------------------------------------
+
+ IF (coefs%coef% id_sensor /= sensor_id_mw) THEN
+ DO JCH=1,nchanprof
+ chanprof(JCH)%prof = 1
+ chanprof(JCH)%chan = JCH
+ END DO
+ ELSE
+ ALLOCATE(use_chan(nprof,coefs%coef%fmv_chn))
+ use_chan(:,:) = .TRUE._jplm
+ CALL rttov_scatt_setupindex ( &
+ errorstatus, &
+ nprof, &
+ coefs%coef%fmv_chn, &
+ coefs, &
+ coef_scatt, &
+ nchanprof, &
+ chanprof, &
+ frequencies, &
+ use_chan)
+ IF (errorstatus /= errorstatus_success) THEN
+ WRITE(*,*) 'error finding channels, frequencies and polarisations'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV13','error rttov_scatt_setupindex')
+ END IF
+ END IF
+
+ asw = 1_jpim ! Switch for allocation passed into RTTOV subroutines
+
+! Allocate profiles (input) and radiance (output) structures
+ CALL rttov_alloc_prof(errorstatus, nprof, profiles, nlevels, opts, asw, coefs, init = .TRUE._jplm)
+ IF (coefs%coef% id_sensor == sensor_id_mw) THEN
+ cld_profiles(1)%nhydro = 5
+ CALL rttov_alloc_scatt_prof(errorstatus, nprof, cld_profiles, nlevels, &
+ cld_profiles(1)%nhydro, nhydro_frac, 1_jpim, init = .TRUE._jplm)
+ END IF
+
+ CALL rttov_alloc_rad (errorstatus, nchannels, radiance, nlevels-1_jpim,asw)
+! WRITE(*,*) 'error rttov_alloc_rad :',errorstatus
+ ! Allocate transmittance structure
+ CALL rttov_alloc_transmission( &
+ & errorstatus, &
+ & transmission, &
+ & nlevels-1_jpim, &
+ & nchannels, &
+ & asw, &
+ & init=.TRUE.)
+
+ profiles(1) % zenangle = 0. ! zenith
+ profiles(1) % skin % fastem(:) = &
+! RTTOV 8.5 example
+! (/ 3.0_JPRB, 5.0_JPRB, 15.0_JPRB, 0.1_JPRB, 0.3_JPRB /)
+! Bare soil see Table 3 svr rttov7)
+ (/ 2.3_JPRB, 1.9_JPRB, 21.8_JPRB, 0.0_JPRB, 0.5_JPRB /)
+
+ profiles(1) % nlevels = nlevels
+ profiles(1) % nlayers = nlevels-1
+
+ ! Ensure the options and coefficients are consistent
+ CALL rttov_user_options_checkinput(errorstatus, opts, coefs)
+ IF (errorstatus /= 0) THEN
+ WRITE(*,*) 'error in rttov options'
+ STOP
+ ENDIF
+
+ profiles(1) % date(1) = TDTCUR%nyear
+ profiles(1) % date(2) = TDTCUR%nmonth
+ profiles(1) % date(3) = TDTCUR%nday
+! profiles(1) % ctp = 500.0_JPRB ! Not used but still required by RTTOV
+! profiles(1) % cfraction = 0.0_JPRB
+ profiles(1) % clwde = 0.0_JPRB
+
+ DO JI=IIB,IIE
+ DO JJ=IJB,IJE
+! DO JI=1,IIU
+! DO JJ=1,IJU
+
+ ZANGL = XUNDEF
+ ZLON = XLON(JI,JJ)
+ ZLAT = XLAT(JI,JJ)
+ IF (KRTTOVINFO(1,JSAT) == 2) THEN ! DMSP PLATFORM
+ ZANGL=53.1 ! see Saunders, 2002, RTTOV7 - science/validation rep, page 8
+ ELSEIF (KRTTOVINFO(1,JSAT) == 3) THEN ! METEOSAT PLATFORM
+ CALL DETER_ANGLE(5, 1, ZLAT, ZLON, ZANGL)
+ WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*rad2deg
+ ELSEIF (KRTTOVINFO(1,JSAT) == 12) THEN ! MSG PLATFORM
+ CALL DETER_ANGLE(6, 1, ZLAT, ZLON, ZANGL)
+ WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*rad2deg
+ ELSEIF (KRTTOVINFO(1,JSAT) == 4) THEN ! GOES-E PLATFORM
+ CALL DETER_ANGLE(1, 1, ZLAT, ZLON, ZANGL)
+ WHERE (ZANGL /= XUNDEF .AND. ZANGL /=0.) ZANGL=ACOS(1./ZANGL)*rad2deg
+ ELSEIF (KRTTOVINFO(1,JSAT) == 7) THEN ! TRMM PLATFORM
+ ZANGL=52.3
+ ELSE
+ ZANGL=0.
+ ENDIF
+
+ profiles(1) % zenangle = MIN(ZANGL(1),zenmaxv9)
+ profiles(1) % azangle = 0.
+ profiles(1) % sunzenangle = XZENITH(JI,JJ) *rad2deg
+ profiles(1) % sunazangle = ZAZIMSOL(JI,JJ)*rad2deg
+
+ DO JK=IKB,IKE ! nlevels
+ JKRAD = nlevels-JK+2 !INVERSION OF VERTICAL LEVELS!
+ profiles(1) % p(JKRAD) = PPABST(JI,JJ,JK)*0.01
+ profiles(1) % t(JKRAD) = MIN(tmax,MAX(tmin,ZTEMP(JI,JJ,JK)))
+ profiles(1) % q(JKRAD) = MIN(qmax,MAX(qmin,PRT(JI,JJ,JK,1)))
+ END DO
+ profiles(1) % elevation = 0.5*( PZZ(JI,JJ,1)+PZZ(JI,JJ,IKB) )*0.001
+ profiles(1) % skin % t = MIN(tmax,MAX(tmin,PTSRAD(JI,JJ)))
+ profiles(1) % s2m % t = MIN(tmax,MAX(tmin,ZTEMP(JI,JJ,IKB)))
+ profiles(1) % s2m % q = MIN(qmax,MAX(qmin,PRT(JI,JJ,1,IKB)))
+ profiles(1) % s2m % u = PULVLKB(JI,JJ) ! 2m wind speed u (m/s)
+ profiles(1) % s2m % v = PVLVLKB(JI,JJ) ! 2m wind speed v (m/s)
+ profiles(1) % s2m % p = PPABST(JI,JJ,IKB)*0.01
+ profiles(1) % s2m % wfetc = 100000. ! typical value for open ocean (m)
+ IF (NINT(XSEA(JI,JJ)).EQ.0.) THEN
+ profiles(1) % skin % surftype = 0 ! Surface Mask 0=land, 1=sea, 2=sea-ice
+ ELSE
+ profiles(1) % skin % surftype = 1
+ profiles(1) % skin % watertype = 1 ! Ocean water
+ END IF
+ IF( coefs%coef% id_sensor /= sensor_id_mw) THEN
+! profiles(1) % clw_scheme = 1 ! OPAC CLW properties
+ profiles(1) % clw_scheme = 2 ! “Deff†CLW properties
+ profiles(1) % clwde_param = 1
+ profiles(1) % ice_scheme = 1 ! Baum/SSEC ice properties
+! profiles(1) % ice_scheme = 2 ! Baran2014 ice properties
+ profiles(1) % icede_param = 4 ! McFarquar et al (2003)
+
+! profiles(1) % clw_scheme = coefs % coef_mfasis_cld % clw_scheme
+! profiles(1) % ice_scheme = coefs % coef_mfasis_cld % ice_scheme
+
+ DO JK=IKB+1,IKE-1 ! nlayers
+ JKRAD = nlevels-JK+1 !INVERSION OF VERTICAL LEVELS!
+ profiles(1) %cfrac(JKRAD) = PCLDFR(JI,JJ,JK)
+ profiles(1) %cloud(1,JKRAD) = PRT(JI,JJ,JK,2)
+ IF (OUSERI) THEN
+ profiles(1) %cloud(6,JKRAD) = (PRT(JI,JJ,JK,4)+PRT(JI,JJ,JK,5))
+ END IF
+ END DO
+ ELSE
+ DO JK=IKB,IKE
+ JKRAD = nlevels-JK+2 !INVERSION OF VERTICAL LEVELS!
+ cld_profiles(1) % ph (JKRAD) = 0.5*( PPABST(JI,JJ,JK) + PPABST(JI,JJ,JK+1) )*0.01
+ cld_profiles(1) %hydro_frac(JKRAD,1) = PCLDFR(JI,JJ,JK)
+ cld_profiles(1) %hydro(JKRAD,4) = MIN(ZRCMAX,PRT(JI,JJ,JK,2))
+ cld_profiles(1) %hydro(JKRAD,1) = MIN(ZRRMAX,PRT(JI,JJ,JK,3))
+ IF (OUSERI) THEN
+ cld_profiles(1) %hydro(JKRAD,5) = MIN(ZRIMAX,PRT(JI,JJ,JK,4))
+ cld_profiles(1) %hydro(JKRAD,2) = MIN(ZRSMAX,PRT(JI,JJ,JK,5))
+ cld_profiles(1) %hydro(JKRAD,3) = MIN(ZRSMAX,PRT(JI,JJ,JK,6))
+ END IF
+ END DO
+ cld_profiles (1) % ph (nlevels+1) = profiles (1) % s2m % p
+ END IF
+
+ DO JCH=1,nchanprof
+ IF (.NOT.calcemis(JCH)) emissivity(JCH)%emis_in = PEMIS(JI,JJ)
+ END DO
+ IF (opts % rt_ir % addsolar) THEN
+ ! Use BRDF atlas
+ CALL rttov_get_brdf( &
+ errorstatus, &
+ opts, &
+ chanprof, &
+ profiles, &
+ coefs, &
+ brdf_atlas, &
+ reflectance(:) % refl_in)
+ IF (errorstatus /= errorstatus_success) THEN
+ WRITE(*,*) 'error reading BRDF atlas'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','CALL_RTTOV13','error rttov_get_brdf')
+ END IF
+ ! Calculate BRDF within RTTOV where the atlas BRDF value is zero or less
+ calcrefl(:) = (reflectance(:) % refl_in <= 0._jprb)
+ END IF
+
+
+ IF (coefs%coef% id_sensor /= sensor_id_mw) THEN
+ CALL rttov_direct( &
+ & errorstatus, &! out error flag
+ & chanprof, &! in channel and profile index structure
+ & opts, &! in options structure
+ & profiles, &! in profile array
+ & coefs, &! in coefficients strucutre
+ & transmission, &! inout computed transmittances
+ & radiance, &! inout computed radiances
+ & calcemis = calcemis, &! in flag for internal emissivity calcs
+ & emissivity = emissivity, &! inout input/output emissivities per channel
+ & calcrefl = calcrefl, &! in flag for internal BRDF calcs
+ & reflectance = reflectance) ! inout input/output BRDFs per channel
+ ELSE
+ CALL rttov_scatt ( &
+ & errorstatus, &! out
+ & opts_scatt, &! in
+ & nlevels, &! in
+ & chanprof, &! in
+ & frequencies, &! in
+ & profiles, &! in
+ & cld_profiles, &! in
+ & coefs, &! in
+ & coef_scatt, &! in
+ & calcemis, &! in
+ & emissivity, &! in
+ & radiance) ! out
+ END IF
+ DO JCH=1,nchanprof
+ ichan = chanprof(JCH)%chan
+ thermal = coefs%coef%ss_val_chn(ichan) < 2
+! solar = coefs%coef%ss_val_chn(ichan) > 0
+ IF (thermal) THEN
+ ZOUT(JI,JJ,JCH)= radiance % bt(JCH)
+ ELSE
+ ZOUT(JI,JJ,JCH)= radiance % refl(JCH)
+ END IF
+ END DO
+ END DO
+ END DO
+! -----------------------------------------------------------------------------
+! LATERAL BOUNDARY FILLING
+ IF (LWEST_ll() .AND.CLBCX(1)/='CYCL') ZOUT(IIB-1,:,:) = ZOUT(IIB,:,:)
+ IF (LEAST_ll() .AND.CLBCX(1)/='CYCL') ZOUT(IIE+1,:,:) = ZOUT(IIE,:,:)
+ IF (LSOUTH_ll().AND.CLBCY(1)/='CYCL') ZOUT(:,IJB-1,:) = ZOUT(:,IJB,:)
+ IF (LNORTH_ll().AND.CLBCY(1)/='CYCL') ZOUT(:,IJE+1,:) = ZOUT(:,IJE,:)
+! -----------------------------------------------------------------------------
+ YBEG=' '
+ IF (KRTTOVINFO(1,JSAT) <= 2 .OR. KRTTOVINFO(1,JSAT) == 4) THEN ! NOAA
+ WRITE(YTWO,'(I2.2)') KRTTOVINFO(2,JSAT)
+ YBEG=TRIM(YPLAT(KRTTOVINFO(1,JSAT)))//YTWO
+ ELSEIF (KRTTOVINFO(1,JSAT) <= JPPLAT) THEN
+ WRITE(YONE,'(I1.1)') KRTTOVINFO(2,JSAT)
+ YBEG=TRIM(YPLAT(KRTTOVINFO(1,JSAT)))//YONE
+ ELSE
+ YBEG='XXXX'
+ END IF
+ WRITE(YTWO,'(I2.2)') KRTTOVINFO(3,JSAT)
+
+ DO JCH=1,nchanprof
+ YEND=' '
+ WRITE(YCHAN,'(I2.2)') JCH
+ IF (KRTTOVINFO(3,JSAT) == 0) THEN ! HIRS
+ YEND='H'//YCHAN
+ ELSEIF (KRTTOVINFO(3,JSAT) == 3) THEN ! AMSU-A
+ YEND='A'//YCHAN
+ ELSEIF (KRTTOVINFO(3,JSAT) == 4) THEN ! AMSU-B
+ YEND='B'//YCHAN
+ ELSEIF (KRTTOVINFO(3,JSAT) == 6) THEN ! SSMI
+ YEND=YLBL_SSMI(JCH)
+ ELSEIF (KRTTOVINFO(3,JSAT) == 9) THEN ! TMI
+ YEND=YLBL_TMI(JCH)
+ ELSEIF (KRTTOVINFO(3,JSAT) == 20) THEN ! MVIRI
+ YEND=YLBL_MVIRI(JCH)
+ ELSEIF (KRTTOVINFO(3,JSAT) == 21) THEN ! SEVIRI
+ IF (opts % rt_ir % addsolar) THEN
+ YEND=YLBL_SEVIRI(JCH)
+ ELSE
+ YEND=YLBL_SEVIRI(JCH+3)
+ END IF
+ ELSEIF (KRTTOVINFO(3,JSAT) == 22) THEN ! GOES-I
+ YEND=YLBL_GOESI(JCH)
+ ELSE
+ YEND=YTWO//YCHAN
+ END IF
+
+ ichan = chanprof(JCH)%chan
+ thermal = coefs%coef%ss_val_chn(ichan) < 2
+! solar = coefs%coef%ss_val_chn(ichan) > 0
+ IF (thermal) THEN
+ TZFIELD%CMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'BT'
+ TZFIELD%CUNITS = 'K'
+ TZFIELD%CCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' brightness temperature'
+ ELSE
+ TZFIELD%CMNHNAME = TRIM(YBEG)//'_'//TRIM(YEND)//'refl'
+ TZFIELD%CUNITS = '-'
+ TZFIELD%CCOMMENT = TRIM(YBEG)//'_'//TRIM(YEND)//' bidirectional reflectance factor'
+ END IF
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'MesoNH: '//TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 2
+ TZFIELD%LTIMEDEP = .TRUE.
+! ZOUT(:,:,JCH) = ZOUT(:,:,JCH) *ZCOSZEN(:,:)
+ CALL IO_Field_write(TPFILE,TZFIELD,ZOUT(:,:,JCH))
+ END DO
+ DEALLOCATE(chanprof,frequencies,emissivity,calcemis,profiles)
+ DEALLOCATE(ZOUT)
+ IF( coefs%coef% id_sensor == sensor_id_mw) THEN
+ CALL rttov_alloc_scatt_prof(errorstatus, nprof, cld_profiles, nlevels, &
+ cld_profiles(1)%nhydro, nhydro_frac, 0_jpim)
+ CALL rttov_dealloc_scattcoeffs(coef_scatt)
+ END IF
+ CALL rttov_dealloc_coefs(errorstatus, coefs)
+END DO
+
+#else
+PRINT *, "RTTOV 13.0 LIBRARY NOT AVAILABLE = ###CALL_RTTOV13####"
+#endif
+!
+END SUBROUTINE CALL_RTTOV13
diff --git a/src/MNH/ch_aer_eqm_initn.f90 b/src/MNH/ch_aer_eqm_initn.f90
index f08e48cff7b63f9b292d177d60e25dacbe914e74..59447b81236c921d80262a9251c899e68d17b5a8 100644
--- a/src/MNH/ch_aer_eqm_initn.f90
+++ b/src/MNH/ch_aer_eqm_initn.f90
@@ -1,4 +1,4 @@
-!ORILAM_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!ORILAM_LIC for details.
diff --git a/src/MNH/change_gribex_var.f90 b/src/MNH/change_gribex_var.f90
index a24b85dc832b2beaec76afa82d636023fbc7dabe..984ef465e974f64a6c2694d6dbb66d4c4b3e6bd8 100644
--- a/src/MNH/change_gribex_var.f90
+++ b/src/MNH/change_gribex_var.f90
@@ -304,6 +304,7 @@ END IF
!
DO JRR=2,SIZE(PR_LS,4)
PR_LS(:,:,:,JRR) = 1. / (1./MAX(PQ_LS(:,:,:,JRR),1.E-12) - 1.)
+ WHERE(PR_LS(:,:,:,JRR).LE.2.E-12) PR_LS(:,:,:,JRR)=0.
END DO
!
PR_LS(:,:,:,1)=SM_PMR_HU(PPMASS_LS(:,:,:), &
diff --git a/src/MNH/compute_mf_cloud.f90 b/src/MNH/compute_mf_cloud.f90
index 28ce08a6cd318ccd58bf8cf8460a1ae1fe0eff3c..23f94bce58fd8595d043f8050b86189873745c78 100644
--- a/src/MNH/compute_mf_cloud.f90
+++ b/src/MNH/compute_mf_cloud.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2009-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-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.
@@ -180,7 +180,7 @@ ELSEIF (HMF_CLOUD == 'STAT') THEN
ELSEIF (HMF_CLOUD == 'BIGA') THEN
!Statistical scheme using the bi-gaussian PDF proposed by E. Perraud.
CALL COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
- &PRC_UP, PRI_UP, PEMF, PDEPTH,&
+ &PEMF, PDEPTH,&
&PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
&PRTM, PTHM, PTHVM,&
&PDZZ, PZZ, PRHODREF,&
diff --git a/src/MNH/compute_mf_cloud_bigaus.f90 b/src/MNH/compute_mf_cloud_bigaus.f90
index 8d158567b1cd1203644c0c27d2763aa05a0b8959..b080f9923a6aff7ef04af89ddcaba2d4a6ca6405 100644
--- a/src/MNH/compute_mf_cloud_bigaus.f90
+++ b/src/MNH/compute_mf_cloud_bigaus.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
! ###################################
@@ -9,7 +10,7 @@
INTERFACE
! #################################################################
SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
- PRC_UP, PRI_UP, PEMF, PDEPTH,&
+ PEMF, PDEPTH,&
PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
PRTM, PTHM, PTHVM,&
PDZZ, PZZ, PRHODREF,&
@@ -24,7 +25,7 @@ INTEGER, INTENT(IN) :: KKB ! near ground physical inde
INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
@@ -40,8 +41,8 @@ END INTERFACE
!
END MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
! ######spl
- SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU,KKL,&
- PRC_UP, PRI_UP, PEMF, PDEPTH,&
+ SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
+ PEMF, PDEPTH,&
PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
PRTM, PTHM, PTHVM,&
PDZZ, PZZ, PRHODREF,&
@@ -83,6 +84,7 @@ END MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
!! -------------
!! Original 25 Aug 2011
!! S. Riette Jan 2012: support for both order of vertical levels
+!! S. Riette Jun 2019: remove unused PRC_UP and PRI_UP, use SIGN in ERFC computation
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -105,7 +107,7 @@ INTEGER, INTENT(IN) :: KKB ! near ground physical inde
INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
@@ -125,8 +127,7 @@ REAL, DIMENSION(SIZE(PTHM,1)) :: ZOMEGA_UP_M !
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW1 ! working array
INTEGER :: JK ! vertical loop control
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZEMF_M, ZTHV_UP_M, & !
- & ZRSAT_UP_M, ZRC_UP_M,& ! Interpolation on mass points
- & ZRI_UP_M, ZRT_UP_M,& !
+ & ZRSAT_UP_M, ZRT_UP_M,& ! Interpolation on mass points
& ZFRAC_ICE_UP_M !
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOND ! condensate
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZA, ZGAM ! used for integration
@@ -146,8 +147,6 @@ ZGRAD_Z_RT(:,:)=MZF_MF(KKA,KKU,KKL, ZW1(:,:))
!Interpolation on mass points
ZTHV_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PTHV_UP(:,:))
ZRSAT_UP_M(:,:)= MZF_MF(KKA,KKU,KKL, PRSAT_UP(:,:))
-ZRC_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRC_UP(:,:))
-ZRI_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRI_UP(:,:))
ZRT_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRT_UP(:,:))
ZEMF_M(:,:) = MZF_MF(KKA,KKU,KKL, PEMF(:,:))
ZFRAC_ICE_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PFRAC_ICE_UP(:,:))
@@ -194,25 +193,8 @@ ZSIGMF(:,:)=SQRT(MAX(ABS(ZSIGMF(:,:)), 1.E-40))
!Computation of ZA and ZGAM (=efrc(ZA)) coefficient
ZA(:,:)=(ZRSAT_UP_M(:,:)-ZRT_UP_M(:,:))/(sqrt(2.)*ZSIGMF(:,:))
-!erf computed by an incomplete gamma function approximation
-!DO JK=KKA,KKU,KKL
-! DO JI=1, SIZE(PCF_MF,1)
-! IF(ZA(JI,JK)>1E-20) THEN
-! ZGAM(JI,JK)=1-GAMMA_INC(0.5,ZA(JI,JK)**2)
-! ELSEIF(ZA(JI,JK)<-1E-20) THEN
-! ZGAM(JI,JK)=1+GAMMA_INC(0.5,ZA(JI,JK)**2)
-! ELSE
-! ZGAM(JI,JK)=1
-! ENDIF
-! ENDDO
-!ENDDO
-
-!alternative approximation of erf function (better for vectorisation)
-WHERE(ZA(:,:)>0)
- ZGAM(:,:)=1-SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
-ELSEWHERE
- ZGAM(:,:)=1+SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
-ENDWHERE
+!Approximation of erf function
+ZGAM(:,:)=1-SIGN(1., ZA(:,:))*SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
!computation of cloud fraction
PCF_MF(:,:)=MAX( 0., MIN(1.,0.5*ZGAM(:,:) * ZALPHA_UP_M(:,:)))
diff --git a/src/MNH/compute_press_from_oceanbot.f90 b/src/MNH/compute_press_from_oceanbot.f90
new file mode 100644
index 0000000000000000000000000000000000000000..56c8f6b6e48442061e3278906a0641f7f935b942
--- /dev/null
+++ b/src/MNH/compute_press_from_oceanbot.f90
@@ -0,0 +1,225 @@
+!MNH_LIC Copyright 2021-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.
+!-----------------------------------------------------------------
+! #####################################
+ MODULE MODI_COMPUTE_PRESS_FROM_OCEANBOT
+! #####################################
+INTERFACE COMPUTE_PRESS_FROM_OCEANBOT
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D(PRHO,PZFLUX,PSURF2D, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:), INTENT(IN) :: PSURF2D ! bottom pressure
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! press at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! press at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D
+!
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT1D(PRHO,PZFLUX,PSURF, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHO ! virtual potential temperature
+REAL, DIMENSION(:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, INTENT(IN) :: PSURF ! botttom press function
+REAL, DIMENSION(:), INTENT(OUT) :: PFLUX ! press at flux points
+REAL, DIMENSION(:), INTENT(OUT) :: PMASS ! press at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT1D
+!
+END INTERFACE
+END MODULE MODI_COMPUTE_PRESS_FROM_OCEANBOT
+! ######################################
+ MODULE MODI_COMPUTE_PRESS_FROM_OCEANBOT3D
+! ######################################
+INTERFACE
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D(PRHO,PZFLUX,PSURF2D, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:), INTENT(IN) :: PSURF2D! bot press function
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! bot press at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! bot press at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D
+!
+END INTERFACE
+END MODULE MODI_COMPUTE_PRESS_FROM_OCEANBOT3D
+! ########################################################################
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D(PRHO,PZFLUX,PSURF2D,PFLUX,PMASS)
+! ########################################################################
+!
+!!**** *COMPUTE_EXNER_FROM_OCEANBOT3D* - computation of hydrostatic
+!! pressure from ocean bottom
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! 1 The local pressure is computed at flux points by integration of the hydrostatic
+!! relation from ground (PSURF2D) to top.
+!!
+!! dP= -g rho dz
+!!
+!! 2 The pressure at mass level is computed as follows and linearly
+!! extrapolated for the uppest non-physical level:
+!!
+!! ~ P(k+1)-P(k)
+!! P(k) = -----------------------
+!! lnP(k+1)-lnP(k)
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CST : contains physical constants
+!! XG : gravity constant
+!! Module MODD_PARAMETERS
+!! JPVEXT
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! JLR
+!! MODIFICATIONS
+!! -------------
+!! Original Fev2021
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XG
+USE MODD_PARAMETERS, ONLY : JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:) , INTENT(IN) :: PSURF2D! bottom pressuren
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! pres at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! pres at mass points
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+INTEGER :: IKB,IKU,JK
+!-------------------------------------------------------------------------------
+!* 1. INITIALIZATIONS
+! ---------------
+IKB=JPVEXT+1
+IKU=SIZE(PZFLUX,3)
+!-------------------------------------------------------------------------------
+!* 2. COMPUTATION OF PRESSURE AT FLUX POINTS
+! ------------------------------------------------
+PFLUX(:,:,IKB)=PSURF2D(:,:)
+!
+ DO JK=IKB+1,IKU
+ PFLUX(:,:,JK)=PFLUX(:,:,JK-1) + XG*PRHO(:,:,JK-1)*(PZFLUX(:,:,JK-1)-PZFLUX(:,:,JK))
+ END DO
+ DO JK=IKB-1,1,-1
+ PFLUX(:,:,JK)=PFLUX(:,:,JK+1) + XG*PRHO(:,:,JK) *(PZFLUX(:,:,JK+1)-PZFLUX(:,:,JK))
+ END DO
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTATION OF Pressure AT MASS POINTS
+! --------------------------------------------
+ PMASS(:,:,1:IKU-1)=(PFLUX(:,:,1:IKU-1)+PFLUX(:,:,2:IKU))*.5
+! (PFLUX(:,:,1:IKU-1)-PFLUX(:,:,2:IKU)) &
+! /(LOG(PFLUX(:,:,1:IKU-1))-LOG(PFLUX(:,:,2:IKU)))
+!
+!accute extrapolation not possible as level IKU is in atmosphere. Assume rho_air=1.2
+ PMASS(:,:,IKU)= PMASS(:,:,IKU-1) - XG*1.2 * ( PZFLUX(:,:,IKU)-PZFLUX(:,:,IKU-1) )
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D
+! ######################################################################
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT1D(PRHO,PZFLUX,PSURF,PFLUX,PMASS)
+! ######################################################################
+!
+!!**** *COMPUTE_PRESS_FROM_OCEANBOT1D* - computation of hydrostatic press eq
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! V.Masson Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/03/96
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_COMPUTE_PRESS_FROM_OCEANBOT3D
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHO ! virtual potential temperature
+REAL, DIMENSION(:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, INTENT(IN) :: PSURF ! ground Exner function
+REAL, DIMENSION(:), INTENT(OUT) :: PFLUX ! Exner function at flux points
+REAL, DIMENSION(:), INTENT(OUT) :: PMASS ! Exner function at mass points
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+REAL, DIMENSION(1,1,SIZE(PZFLUX)) :: ZRHO ! virtual potential temperature
+REAL, DIMENSION(1,1,SIZE(PZFLUX)) :: ZZFLUX ! altitude of flux points
+REAL, DIMENSION(1,1) :: ZPSURF ! ground Exner function
+REAL, DIMENSION(1,1,SIZE(PZFLUX)) :: ZPFLUX ! Exner function at flux points
+REAL, DIMENSION(1,1,SIZE(PZFLUX)) :: ZPMASS ! Exner function at mass points
+!
+!-------------------------------------------------------------------------------
+!
+ZRHO(1,1,:)=PRHO(:)
+ZZFLUX(1,1,:)=PZFLUX(:)
+ZPSURF(1,1)=PSURF
+!
+CALL COMPUTE_PRESS_FROM_OCEANBOT3D(ZRHO,ZZFLUX,ZPSURF,ZPFLUX,ZPMASS)
+!
+PFLUX(:)=ZPFLUX(1,1,:)
+PMASS(:)=ZPMASS(1,1,:)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT1D
+
diff --git a/src/MNH/compute_press_from_oceansfc.f90 b/src/MNH/compute_press_from_oceansfc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d9ec184431ff06f994644c61d5acd7203bac6eaf
--- /dev/null
+++ b/src/MNH/compute_press_from_oceansfc.f90
@@ -0,0 +1,238 @@
+!MNH_LIC Copyright 2021-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.
+!-----------------------------------------------------------------
+! ##################################
+ MODULE MODI_COMPUTE_PRESS_FROM_OCEANSFC
+! ##################################
+INTERFACE COMPUTE_PRESS_FROM_OCEANSFC
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D(PRHO,PZFLUX,PTOP2D, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:) , INTENT(IN) :: PTOP2D ! 2D Pressure at domain top
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! Pressure at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! Pressure at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D
+!
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC1D(PRHO,PZFLUX,PTOP, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, INTENT(IN) :: PTOP ! Pressure at domain top
+REAL, DIMENSION(:), INTENT(OUT) :: PFLUX ! Pressure at flux points
+REAL, DIMENSION(:), INTENT(OUT) :: PMASS ! Pressure at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC1D
+END INTERFACE
+END MODULE MODI_COMPUTE_PRESS_FROM_OCEANSFC
+! ####################################
+ MODULE MODI_COMPUTE_PRESS_FROM_OCEANSFC3D
+! ####################################
+INTERFACE
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D(PRHO,PZFLUX,PTOP2D, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:) , INTENT(IN) :: PTOP2D ! Pressure at top domain
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! Pressure at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! Pressure at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D
+END INTERFACE
+END MODULE MODI_COMPUTE_PRESS_FROM_OCEANSFC3D
+! ####################################################################
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D(PRHO,PZFLUX,PTOP2D,PFLUX,PMASS)
+! ####################################################################
+!
+!!**** *COMPUTE_PRESS_FROM_OCEANSFC3D* - computation of hydrostatic
+!! from model top
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! 1 The local Exner function in computed by integration of the hydrostatic
+!! relation from top (PEXNTOP2D) to bottom.
+!!
+!! dPI= -g/(Cpd thetav) dz
+!!
+!! 2 The Exner function at mass level is computed as follows and linearly
+!! extrapolated for the uppest non-physical level:
+!!
+!! ~ PI(k+1)-PI(k)
+!! PI(k) = -----------------------
+!! lnPI(k+1)-lnPI(k)
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF : contains configuration variables for all models.
+!! NVERB : verbosity level for output-listing
+!! LTHINSHELL : logical for thinshell approximation
+!! Module MODD_LUNIT : contains logical unit names for all models
+!! CLUOUT0 : name of output-listing
+!! Module MODD_CST : contains physical constants
+!! XG : gravity constant
+!! XCPD: specific heat for dry air at constant pressure
+!! XRD : gas constant for dry air
+!! Module MODD_PARAMETERS
+!! JPVEXT,JPHEXT
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!! JLR
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/01/21
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XG
+USE MODD_PARAMETERS, ONLY : JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:) , INTENT(IN) :: PTOP2D ! Pressure at domain
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! Pressure at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! Pressure at mass points
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: IKB,IKE,IKU,JK
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZATIONS
+! ---------------
+!
+IKB=JPVEXT+1
+IKE=SIZE(PZFLUX,3)-JPVEXT
+IKU=SIZE(PZFLUX,3)
+!-------------------------------------------------------------------------------
+!* 2. COMPUTATION OF PRESSURE AT FLUX POINTS
+! ------------------------------------------------
+PFLUX(:,:,IKE+1)=PTOP2D(:,:)
+!
+ DO JK=IKE,1,-1
+ PFLUX(:,:,JK) = PFLUX(:,:,JK+1) + XG*PRHO(:,:,JK)*(PZFLUX(:,:,JK+1)-PZFLUX(:,:,JK))
+ END DO
+ DO JK=IKE+2,SIZE(PFLUX,3)
+ PFLUX(:,:,JK) = PFLUX(:,:,JK-1) + XG*PRHO(:,:,JK-1)*(PZFLUX(:,:,JK-1)-PZFLUX(:,:,JK))
+ END DO
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTATION OF PRESSURE AT MASS POINTS
+! --------------------------------------------
+ PMASS(:,:,1:IKU-1)=(PFLUX(:,:,1:IKU-1)-PFLUX(:,:,2:IKU)) &
+ /(LOG(PFLUX(:,:,1:IKU-1))-LOG(PFLUX(:,:,2:IKU)))
+!accute extrapolation not possible as level IKU is in atmosphere. Assume rho_air=1.2
+ PMASS(:,:,IKU)= PMASS(:,:,IKU-1) - XG*1.2 * ( PZFLUX(:,:,IKU)-PZFLUX(:,:,IKU-1) )
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D
+! ##################################################################
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC1D(PRHOD,PZFLUX,PTOP,PFLUX,PMASS)
+! ##################################################################
+!
+!!**** *COMPUTE_PRESS_FROM_OCEANSFC1D* - computation of hydrostatic
+!! Pressure from model top
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! JLR
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/01/21
+!-----------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_COMPUTE_PRESS_FROM_OCEANSFC3D
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHOD ! virtual potential temperature
+REAL, DIMENSION(:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, INTENT(IN) :: PTOP ! top pressure
+REAL, DIMENSION(:), INTENT(OUT) :: PFLUX ! Pressure at flux points
+REAL, DIMENSION(:), INTENT(OUT) :: PMASS ! Pressure at mass points
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+!JUAN
+REAL, DIMENSION(3,1,SIZE(PZFLUX)) :: ZRHOD ! virtual potential temperature
+REAL, DIMENSION(3,1,SIZE(PZFLUX)) :: ZZFLUX ! altitude of flux points
+REAL, DIMENSION(3,1) :: ZPTOP ! top pressure
+REAL, DIMENSION(3,1,SIZE(PZFLUX)) :: ZPFLUX ! Pressure at flux points
+REAL, DIMENSION(3,1,SIZE(PZFLUX)) :: ZPMASS ! Pressure at mass points
+INTEGER :: JI ! loop index in I
+!JUAN
+!
+!-------------------------------------------------------------------------------
+!
+!JUAN
+DO JI=1,3
+ZRHOD(JI,1,:)=PRHOD(:)
+ZZFLUX(JI,1,:)=PZFLUX(:)
+ZPTOP(JI,1)=PTOP
+END DO
+!JUAN
+
+!
+CALL COMPUTE_PRESS_FROM_OCEANSFC3D(ZRHOD,ZZFLUX,ZPTOP,ZPFLUX,ZPMASS)
+!
+PFLUX(:)=ZPFLUX(2,1,:)
+PMASS(:)=ZPMASS(2,1,:)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC1D
diff --git a/src/MNH/condensation.f90 b/src/MNH/condensation.f90
index 7056f6e84efbbf40664b3a292e2945d0af4a8aa9..ec60d40671691d994a02f4b1f4981f4cc70c06aa 100644
--- a/src/MNH/condensation.f90
+++ b/src/MNH/condensation.f90
@@ -1,17 +1,18 @@
-!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-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.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_CONDENSATION
! ########################
!
INTERFACE
!
- SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
- HFRAC_ICE, &
- PPABS, PZZ, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
- OSIGMAS, PSIGQSAT, PLV, PLS, PCPH)
+ SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL,&
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABS, PZZ, PRHODREF, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
+ OSIGMAS, PSIGQSAT, PLV, PLS, PCPH, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF)
!
INTEGER, INTENT(IN) :: KIU ! horizontal dimension in x
INTEGER, INTENT(IN) :: KJU ! horizontal dimension in y
@@ -24,17 +25,13 @@ INTEGER, INTENT(IN) :: KKB ! value of the first point
INTEGER, INTENT(IN) :: KKE ! value of the last point in z
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=4), INTENT(IN) :: HCONDENS
+CHARACTER(len=*), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PPABS ! pressure (Pa)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PZZ ! height of model levels (m)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRHODREF
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PT ! grid scale T (K)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRV ! grid scale water vapor mixing ratio (kg/kg)
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
- ! liquid and solid condensate (OUSERI=.TRUE.)
- ! or only solid condensate (OUSERI=.FALSE.)
-LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
- ! or that from turbulence scheme
-REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
- ! multiplied by PSIGQSAT
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRC ! grid scale r_c mixing ratio (kg/kg)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRI ! grid scale r_i (kg/kg)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
@@ -43,9 +40,20 @@ REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PSIGS ! Sigma_s from turbulence
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PCLDFR ! cloud fraction
REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
+LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
+ ! liquid and solid condensate (OUSERI=.TRUE.)
+ ! or only solid condensate (OUSERI=.FALSE.)
+LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV
REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS
REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HRC !cloud water content in precipitating part
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HCF !precipitating part
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HRI !
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HCF !
+
END SUBROUTINE CONDENSATION
!
END INTERFACE
@@ -53,9 +61,9 @@ END INTERFACE
END MODULE MODI_CONDENSATION
! ######spl
SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
- HFRAC_ICE, &
- PPABS, PZZ, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
- OSIGMAS, PSIGQSAT, PLV, PLS, PCPH )
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABS, PZZ, PRHODREF, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
+ OSIGMAS, PSIGQSAT, PLV, PLS, PCPH, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
! ################################################################################
!
!!
@@ -126,8 +134,13 @@ END MODULE MODI_CONDENSATION
!
USE MODD_CST
USE MODD_PARAMETERS
+USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
+!
+use mode_msg
+!
USE MODI_COMPUTE_FRAC_ICE
!
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -144,17 +157,13 @@ INTEGER, INTENT(IN) :: KKB ! value of the first point
INTEGER, INTENT(IN) :: KKE ! value of the last point in z
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=4), INTENT(IN) :: HCONDENS
+CHARACTER(len=*), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PPABS ! pressure (Pa)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PZZ ! height of model levels (m)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRHODREF
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PT ! grid scale T (K)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRV ! grid scale water vapor mixing ratio (kg/kg)
-LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
- ! liquid and solid condensate (OUSERI=.TRUE.)
- ! or only solid condensate (OUSERI=.FALSE.)
-LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
- ! or that from turbulence scheme
-REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
- ! multiplied by PSIGQSAT
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRC ! grid scale r_c mixing ratio (kg/kg)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(INOUT) :: PRI ! grid scale r_i (kg/kg)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
@@ -163,9 +172,21 @@ REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PSIGS ! Sigma_s from turbulence
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PCLDFR ! cloud fraction
REAL, DIMENSION(KIU,KJU,KKU), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS
-REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH
+
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV ! Latent heat L_v
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS ! Latent heat L_s
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH ! Specific heat C_ph
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HCF ! cloud fraction
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HCF
+LOGICAL, INTENT(IN) :: OUSERI ! logical switch to compute both
+ ! liquid and solid condensate (OUSERI=.TRUE.)
+ ! or only solid condensate (OUSERI=.FALSE.)
+LOGICAL, INTENT(IN) :: OSIGMAS! use present global Sigma_s values
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PSIGQSAT ! use an extra "qsat" variance contribution (OSIGMAS case)
+
!
!
!* 0.2 Declarations of local variables :
@@ -174,13 +195,17 @@ INTEGER :: JI, JJ, JK, JKP, JKM, IKTB, IKTE ! loop index
REAL, DIMENSION(KIU,KJU,KKU) :: ZTLK, ZRT ! work arrays for T_l and total water mixing ratio
REAL, DIMENSION(KIU,KJU,KKU) :: ZL ! length scale
REAL, DIMENSION(KIU,KJU,KKU) :: ZFRAC ! Ice fraction
-INTEGER, DIMENSION(KIU,KJU) :: ITPL ! top levels of troposphere
+REAL, DIMENSION(KIU,KJU,KKU) :: ZCRIAUTI !
+INTEGER, DIMENSION(KIU,KJU) :: ITPL ! top levels of troposphere
REAL, DIMENSION(KIU,KJU) :: ZTMIN ! minimum Temp. related to ITPL
!
REAL, DIMENSION(KIU,KJU,KKU) :: ZLV, ZLS, ZCPD
-REAL :: ZTEMP, ZPV, ZQSL, ZPIV, ZQSI, ZCOND, ZLVS ! thermodynamics
-REAL :: ZLL, DZZ, ZZZ ! used for length scales
-REAL :: ZAH, ZA, ZB, ZSBAR, ZQ1, ZSIGMA, ZDRW, ZDTL, ZSIG_CONV ! related to computation of Sig_s
+REAL, DIMENSION(KIU,KJU,KKU) :: ZCOND
+REAL :: ZGCOND, ZSBAR, ZSBARC, ZQ1, ZAUTC, ZAUTI, ZGAUV, ZGAUC, ZGAUI, ZGAUTC, ZGAUTI ! Used for integration in Gaussian Probability Density Function
+REAL :: ZTEMP, ZPV, ZQSL, ZPIV, ZQSI, ZLVS ! thermodynamics
+REAL :: ZLL, DZZ, ZZZ ! used for length scales
+REAL :: ZAH, ZA, ZB, ZSIGMA, ZDRW, ZDTL, ZSIG_CONV ! related to computation of Sig_s
+REAL :: ZRCOLD, ZRIOLD
INTEGER :: INQ1
REAL :: ZINC
!
@@ -367,35 +392,105 @@ DO JK=IKTB,IKTE
! normalized saturation deficit
ZQ1 = ZSBAR/ZSIGMA
- ! cloud fraction
- PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5+0.36*ATAN(1.55*ZQ1)) )
+ IF(HCONDENS == 'GAUS')THEN
+ ! Gaussian Probability Density Function around ZQ1
+ ! Computation of ZG and ZGAM(=erf(ZG))
+ ZGCOND = -ZQ1/SQRT(2.)
- ! total condensate
- IF (ZQ1 > 0. .AND. ZQ1 <= 2 ) THEN
- ZCOND = MIN(EXP(-1.)+.66*ZQ1+.086*ZQ1**2, 2.) ! We use the MIN function for continuity
- ELSE IF (ZQ1 > 2.) THEN
- ZCOND = ZQ1
- ELSE
- ZCOND = EXP( 1.2*ZQ1-1. )
+ !Approximation of erf function for Gaussian distribution
+ ZGAUV = 1 - SIGN(1., ZGCOND) * SQRT(1-EXP(-4*ZGCOND**2/XPI))
+
+ !Computation Cloud Fraction
+ PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUV))
+
+ !Computation of condensate
+ ZCOND(JI,JJ,JK) = (EXP(-ZGCOND**2)-ZGCOND*SQRT(XPI)*ZGAUV)*ZSIGMA/SQRT(2.*XPI)
+ ZCOND(JI,JJ,JK) = MAX(ZCOND(JI,JJ,JK), 0.)
+
+ PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK)
+
+ !Computation warm/cold Cloud Fraction and content in high water content part
+ IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
+ IF(1-ZFRAC(JI,JJ,JK) > 1.E-20)THEN
+ ZAUTC = (ZSBAR - XCRIAUTC/(PRHODREF(JI,JJ,JK)*(1-ZFRAC(JI,JJ,JK))))/ZSIGMA
+ ZGAUTC = -ZAUTC/SQRT(2.)
+ !Approximation of erf function for Gaussian distribution
+ ZGAUC = 1 - SIGN(1., ZGAUTC) * SQRT(1-EXP(-4*ZGAUTC**2/XPI))
+ PHLC_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUC))
+ PHLC_HRC(JI,JJ,JK) = (1-ZFRAC(JI,JJ,JK))*(EXP(-ZGAUTC**2)-ZGAUTC*SQRT(XPI)*ZGAUC)*ZSIGMA/SQRT(2.*XPI)
+ PHLC_HRC(JI,JJ,JK) = PHLC_HRC(JI,JJ,JK) + XCRIAUTC/PRHODREF(JI,JJ,JK) * PHLC_HCF(JI,JJ,JK)
+ PHLC_HRC(JI,JJ,JK) = MAX(PHLC_HRC(JI,JJ,JK), 0.)
+ ELSE
+ PHLC_HCF(JI,JJ,JK)=0.
+ PHLC_HRC(JI,JJ,JK)=0.
+ ENDIF
+ ENDIF
+
+ IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
+ IF(ZFRAC(JI,JJ,JK) > 1.E-20)THEN
+ ZCRIAUTI(JI,JJ,JK)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(JI,JJ,JK)-XTT)+XBCRIAUTI))
+ ZAUTI = (ZSBAR - ZCRIAUTI(JI,JJ,JK)/ZFRAC(JI,JJ,JK))/ZSIGMA
+ ZGAUTI = -ZAUTI/SQRT(2.)
+ !Approximation of erf function for Gaussian distribution
+ ZGAUI = 1 - SIGN(1., ZGAUTI) * SQRT(1-EXP(-4*ZGAUTI**2/XPI))
+ PHLI_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUI))
+ PHLI_HRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK)*(EXP(-ZGAUTI**2)-ZGAUTI*SQRT(XPI)*ZGAUI)*ZSIGMA/SQRT(2.*XPI)
+ PHLI_HRI(JI,JJ,JK) = PHLI_HRI(JI,JJ,JK) + ZCRIAUTI(JI,JJ,JK)*PHLI_HCF(JI,JJ,JK)
+ PHLI_HRI(JI,JJ,JK) = MAX(PHLI_HRI(JI,JJ,JK), 0.)
+ ELSE
+ PHLI_HCF(JI,JJ,JK)=0.
+ PHLI_HRI(JI,JJ,JK)=0.
+ ENDIF
+ ENDIF
+
+ ELSEIF(HCONDENS == 'CB02')THEN
+ !Cloud fraction
+ PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5+0.36*ATAN(1.55*ZQ1)) )
+
+ !Total condensate
+ IF (ZQ1 > 0. .AND. ZQ1 <= 2) THEN
+ ZCOND(JI,JJ,JK) = MIN(EXP(-1.)+.66*ZQ1+.086*ZQ1**2, 2.) ! We use the MIN function for continuity
+ ELSE IF (ZQ1 > 2.) THEN
+ ZCOND(JI,JJ,JK) = ZQ1
+ ELSE
+ ZCOND(JI,JJ,JK) = EXP( 1.2*ZQ1-1. )
+ ENDIF
+ ZCOND(JI,JJ,JK) = ZCOND(JI,JJ,JK) * ZSIGMA
+
+ INQ1 = MIN( MAX(-22,FLOOR(MIN(100., MAX(-100., 2*ZQ1))) ), 10) !inner min/max prevents sigfpe when 2*zq1 does not fit into an int
+ ZINC = 2.*ZQ1 - INQ1
+
+ PSIGRC(JI,JJ,JK) = MIN(1.,(1.-ZINC)*ZSRC_1D(INQ1)+ZINC*ZSRC_1D(INQ1+1))
+
+ IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
+ PHLC_HCF(JI,JJ,JK)=0.
+ PHLC_HRC(JI,JJ,JK)=0.
+ ENDIF
+ IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
+ PHLI_HCF(JI,JJ,JK)=0.
+ PHLI_HRI(JI,JJ,JK)=0.
+ ENDIF
ENDIF
- ZCOND = ZCOND * ZSIGMA
- IF ( ZCOND < 1.E-12 ) THEN
- ZCOND = 0.
+ IF ( ZCOND(JI,JJ,JK) < 1.E-12 ) THEN
+ ZCOND(JI,JJ,JK) = 0.
PCLDFR(JI,JJ,JK) = 0.
ENDIF
IF (PCLDFR(JI,JJ,JK)==0.) THEN
- ZCOND=0.
+ ZCOND(JI,JJ,JK)=0.
ENDIF
- PT(JI,JJ,JK) = PT(JI,JJ,JK) + (((1.-ZFRAC(JI,JJ,JK))*ZCOND-PRC(JI,JJ,JK))*ZLV(JI,JJ,JK) + &
- &(ZFRAC(JI,JJ,JK) *ZCOND-PRI(JI,JJ,JK))*ZLS(JI,JJ,JK) ) &
+ ZRCOLD=PRC(JI,JJ,JK)
+ ZRIOLD=PRI(JI,JJ,JK)
+
+ PRC(JI,JJ,JK) = (1.-ZFRAC(JI,JJ,JK)) * ZCOND(JI,JJ,JK) ! liquid condensate
+ PRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK) * ZCOND(JI,JJ,JK) ! solid condensate
+
+ PT(JI,JJ,JK) = PT(JI,JJ,JK) + ((PRC(JI,JJ,JK)-ZRCOLD)*ZLV(JI,JJ,JK) + &
+ &(PRI(JI,JJ,JK)-ZRIOLD)*ZLS(JI,JJ,JK) ) &
& /ZCPD(JI,JJ,JK)
- PRC(JI,JJ,JK) = (1.-ZFRAC(JI,JJ,JK)) * ZCOND ! liquid condensate
- PRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK) * ZCOND ! solid condensate
PRV(JI,JJ,JK) = ZRT(JI,JJ,JK) - PRC(JI,JJ,JK) - PRI(JI,JJ,JK)
-
! s r_c/ sig_s^2
! PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK) ! use simple Gaussian relation
!
@@ -403,14 +498,13 @@ DO JK=IKTB,IKTE
!
! PSIGRC(JI,JJ,JK) = 2.*PCLDFR(JI,JJ,JK) * MIN( 3. , MAX(1.,1.-ZQ1) )
! in the 3D case lambda_3 = 1.
-! INQ1 = MIN( MAX(-22,FLOOR(2*ZQ1) ), 10)
- INQ1 = MIN( MAX(-22,FLOOR(MIN(100.,MAX(-100.,2*ZQ1))) ), 10)
- !inner min/max prevent sigfpe when 2*zq1 does not fit into an int
- ZINC = 2.*ZQ1 - INQ1
- PSIGRC(JI,JJ,JK) = MIN(1.,(1.-ZINC)*ZSRC_1D(INQ1)+ZINC*ZSRC_1D(INQ1+1))
-
- PSIGRC(JI,JJ,JK) = PSIGRC(JI,JJ,JK)* MIN( 3. , MAX(1.,1.-ZQ1) )
+ IF(HLAMBDA3=='CB')THEN
+ PSIGRC(JI,JJ,JK) = PSIGRC(JI,JJ,JK)* MIN( 3. , MAX(1.,1.-ZQ1) )
+ ELSEIF(HLAMBDA3=='NONE') THEN
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'CONDENSATION', 'invalid value for HLAMBDA3: ' // TRIM( HLAMBDA3 ) )
+ ENDIF
END DO
END DO
diff --git a/src/MNH/deallocate_model1.f90 b/src/MNH/deallocate_model1.f90
index 113521daf887dcd7e673028de0a58f81dc1aa64b..3b0b4673893c19604b474aa94d5979f9d97c7b50 100644
--- a/src/MNH/deallocate_model1.f90
+++ b/src/MNH/deallocate_model1.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!############################
@@ -65,9 +65,10 @@ END MODULE MODI_DEALLOCATE_MODEL1
!! 01/2004 V. Masson surface externalization
!! 06/2012 M.Tomasini add 2D nesting ADVFRC
!! 10/2016 M.Mazoyer New KHKO output fields
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! 02/2019 C.Lac add rain fraction as an output field
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! C. Lac 02/2019: add rain fraction as an output field
! P. Wautelet 07/06/2019: bugfix: deallocate XLSRVM only if allocated
+! S. Riette 04/2020: XHL* fields
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -105,6 +106,7 @@ USE MODD_ADV_n
USE MODD_PAST_FIELD_n
USE MODD_TURB_n
USE MODD_PARAM_C2R2, ONLY :LSUPSAT
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -185,6 +187,13 @@ IF ( ASSOCIATED(XSRCT) .AND. KCALL==3 ) THEN
DEALLOCATE(XSIGS)
END IF
!
+IF ( ASSOCIATED(XHLC_HRC) .AND. KCALL==3 ) THEN
+ DEALLOCATE(XHLC_HRC)
+ DEALLOCATE(XHLC_HCF)
+ DEALLOCATE(XHLI_HRI)
+ DEALLOCATE(XHLI_HCF)
+END IF
+!
IF ( ASSOCIATED(XCLDFR) .AND. KCALL==2 ) THEN
DEALLOCATE(XCLDFR)
END IF
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index e460a683600a397cb7a0eec78a68182a9c6f07a6..a5d28030d88c7706332d98de04f7db63a7659678 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -88,7 +88,7 @@ END MODULE MODI_DEFAULT_DESFM_n
!! Module MODD_BUDGET : CBUTYPE,NBUMOD,XBULEN,NBUKL, NBUKH,LBU_KCP,XBUWRI
!! NBUIL, NBUIH,NBUJL, NBUJH,LBU_ICP,LBU_JCP,NBUMASK
!!
-!! Module MODD_BLANK_n :
+!! Module MODD_BLANK_n:
!!
!! XDUMMYi, NDUMMYi, LDUMMYi, CDUMMYi
!!
@@ -208,7 +208,14 @@ END MODULE MODI_DEFAULT_DESFM_n
!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
! P. Wautelet 17/04/2020: move budgets switch values into modd_budget
! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
-!
+! F. Auguste, T. Nagel 02/2021: add IBM defaults parameters
+! T. Nagel 02/2021: add turbulence recycling defaults parameters
+! P-A Joulin 21/05/2021: add Wind turbines
+! S. Riette 21/05/2021: add options to PDF subgrid scheme
+! D. Ricard 05/2021: add the contribution of Leonard terms in the turbulence scheme
+! 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)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -253,23 +260,29 @@ USE MODD_CONDSAMP
USE MODD_MEAN_FIELD
USE MODD_DRAGTREE_n
USE MODD_DRAGBLDG_n
-!
-!
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS,&
- NMOD_IFN, XIFN_CONC, LIFN_HOM, CIFN_SPECIES, &
- CINT_MIXING, NMOD_IMM, NIND_SPECIE, &
- CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
- XFACTNUC_DEP, XFACTNUC_CON, &
- OWARM=>LWARM, LACTI, ORAIN=>LRAIN, OSEDC=>LSEDC, &
- OACTIT=>LACTIT, LBOUND, NMOD_CCN, XCCN_CONC, &
- LCCN_HOM, CCCN_MODES, &
- YALPHAR=>XALPHAR, YNUR=>XNUR, &
- YALPHAC=>XALPHAC, YNUC=>XNUC, CINI_CCN=>HINI_CCN, &
- CTYPE_CCN=>HTYPE_CCN, YFSOLUB_CCN=>XFSOLUB_CCN, &
- YACTEMP_CCN=>XACTEMP_CCN, YAERDIFF=>XAERDIFF, &
- YAERHEIGHT=>XAERHEIGHT, &
- LSCAV, LAERO_MASS, NPHILLIPS, &
- ODEPOC=>LDEPOC, OVDEPOC=>XVDEPOC, OACTTKE=>LACTTKE,&
+USE MODD_EOL_MAIN
+USE MODD_EOL_ADNR
+USE MODD_EOL_ALM
+USE MODD_EOL_SHARED_IO
+USE MODD_ALLSTATION_n
+!
+!
+USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS, &
+ NMOD_IFN, XIFN_CONC, LIFN_HOM, CIFN_SPECIES, &
+ CINT_MIXING, NMOD_IMM, NIND_SPECIE, &
+ CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
+ XFACTNUC_DEP, XFACTNUC_CON, &
+ OWARM=>LWARM, LACTI, ORAIN=>LRAIN, OSEDC=>LSEDC, &
+ OACTIT=>LACTIT, LBOUND, LSPRO, LADJ, &
+ NMOD_CCN, XCCN_CONC, &
+ LCCN_HOM, CCCN_MODES, &
+ YALPHAR=>XALPHAR, YNUR=>XNUR, &
+ YALPHAC=>XALPHAC, YNUC=>XNUC, CINI_CCN=>HINI_CCN, &
+ CTYPE_CCN=>HTYPE_CCN, YFSOLUB_CCN=>XFSOLUB_CCN, &
+ YACTEMP_CCN=>XACTEMP_CCN, YAERDIFF=>XAERDIFF, &
+ YAERHEIGHT=>XAERHEIGHT, &
+ LSCAV, LAERO_MASS, NPHILLIPS, &
+ ODEPOC=>LDEPOC, OVDEPOC=>XVDEPOC, OACTTKE=>LACTTKE, &
LPTSPLIT, L_LFEEDBACKT=>LFEEDBACKT, L_NMAXITER=>NMAXITER, &
L_XMRSTEP=>XMRSTEP, L_XTSTEP_TS=>XTSTEP_TS
!
@@ -279,6 +292,9 @@ USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
USE MODD_DRAG_n
USE MODD_VISCOSITY
+USE MODD_RECYCL_PARAM_n
+USE MODD_IBM_PARAM_n
+USE MODD_IBM_LSF
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
#endif
@@ -348,6 +364,7 @@ LUSERI = .FALSE.
LUSERS = .FALSE.
LUSERG = .FALSE.
LUSERH = .FALSE.
+LOCEAN = .FALSE.
!NSV = 0
!NSV_USER = 0
LUSECI = .FALSE.
@@ -505,17 +522,28 @@ XTNUDGING = 21600.
XIMPL = 1.
XKEMIN = 0.01
XCEDIS = 0.84
+XCADAP = 0.5
CTURBLEN = 'BL89'
CTURBDIM = '1DIM'
LTURB_FLX =.FALSE.
LTURB_DIAG=.FALSE.
LSUBG_COND=.FALSE.
CSUBG_AUCV='NONE'
+CSUBG_AUCV_RI='NONE'
LSIGMAS =.TRUE.
LSIG_CONV =.FALSE.
LRMC01 =.FALSE.
CTOM ='NONE'
VSIGQSAT = 0.02
+CCONDENS='CB02'
+CLAMBDA3='CB'
+CSUBG_MF_PDF='TRIANGLE'
+LHGRAD =.FALSE.
+XCOEFHGRADTHL = 1.0
+XCOEFHGRADRM = 1.0
+XALTHGRAD = 2000.0
+XCLDTHOLD = -1.0
+
!-------------------------------------------------------------------------------
!
!* 10b. SET DEFAULT VALUES FOR MODD_DRAGTREE :
@@ -531,6 +559,48 @@ XVDEPOTREE = 0.02 ! 2 cm/s
!
LDRAGBLDG = .FALSE.
!
+!* 10d. SET DEFAULT VALUES FOR MODD_EOL* :
+! ----------------------------------
+!
+! 10d.i) MODD_EOL_MAIN
+!
+LMAIN_EOL = .FALSE.
+CMETH_EOL = 'ADNR'
+CSMEAR = '3LIN'
+NMODEL_EOL = 1
+!
+! 10d.ii) MODD_EOL_SHARED_IO
+!
+CFARM_CSVDATA = 'data_farm.csv'
+CTURBINE_CSVDATA = 'data_turbine.csv'
+CBLADE_CSVDATA = 'data_blade.csv'
+CAIRFOIL_CSVDATA = 'data_airfoil.csv'
+!
+CINTERP = 'CLS'
+!
+! 10d.iii) MODD_EOL_ALM
+!
+NNB_BLAELT = 42
+LTIMESPLIT = .FALSE.
+LTIPLOSSG = .TRUE.
+LTECOUTPTS = .FALSE.
+!
+!------------------------------------------------------------------------------
+!* 10.e SET DEFAULT VALUES FOR MODD_ALLSTATION_n :
+! ----------------------------------
+!
+NNUMB_STAT = 0
+XSTEP_STAT = 1.0
+XX_STAT(:) = XUNDEF
+XY_STAT(:) = XUNDEF
+XZ_STAT(:) = XUNDEF
+XLAT_STAT(:) = XUNDEF
+XLON_STAT(:) = XUNDEF
+CNAME_STAT(:) = ''
+CTYPE_STAT(:) = ''
+CFILE_STAT = 'NO_INPUT_CSV'
+LDIAG_RESULTS = .FALSE.
+!
!-------------------------------------------------------------------------------
!
!* 11. SET DEFAULT VALUES FOR MODD_BUDGET :
@@ -733,6 +803,11 @@ IF (KMI == 1) THEN
XUTRANS = 0.0
XVTRANS = 0.0
LPGROUND_FRC = .FALSE.
+ LDEEPOC = .FALSE.
+ XCENTX_OC = 16000.
+ XCENTY_OC = 16000.
+ XRADX_OC = 8000.
+ XRADY_OC = 8000.
END IF
!
!-------------------------------------------------------------------------------
@@ -826,7 +901,7 @@ XC = 0.012
XBETA1 = 0.9
XR = 2.
XLAMBDA_MF= 0.
-LGZ = .TRUE.
+LGZ = .FALSE.
XGZ = 1.83 ! between 1.83 and 1.33
!
!-------------------------------------------------------------------------------
@@ -886,8 +961,10 @@ IF (KMI == 1) THEN
OWARM = .TRUE.
LACTI = .TRUE.
ORAIN = .TRUE.
- OSEDC = .FALSE.
+ OSEDC = .TRUE.
OACTIT = .FALSE.
+ LADJ = .TRUE.
+ LSPRO = .FALSE.
ODEPOC = .FALSE.
LBOUND = .FALSE.
OACTTKE = .TRUE.
@@ -920,7 +997,7 @@ IF (KMI == 1) THEN
LHHONI = .FALSE.
LCOLD = .TRUE.
LNUCL = .TRUE.
- LSEDI = .FALSE.
+ LSEDI = .TRUE.
LSNOW = .TRUE.
LHAIL = .FALSE.
CPRISTINE_ICE_LIMA = 'PLAT'
@@ -1173,5 +1250,129 @@ IF (KMI == 1) THEN
XHSTART = 0.
ENDIF
!
+!-------------------------------------------------------------------------------
+!
+!* 31. SET DEFAULT VALUES FOR MODD_IBM_PARAMn
+! --------------------------------------
+!
+ LIBM = .FALSE.
+ LIBM_TROUBLE = .FALSE.
+ CIBM_ADV = 'NOTHIN'
+ XIBM_EPSI = 1.E-9
+ XIBM_IEPS = 1.E+9
+ NIBM_ITR = 8
+ XIBM_RUG = 0.01 ! (m^1.s^-0)
+ XIBM_VISC = 1.56e-5 ! (m^2.s^-1)
+ XIBM_CNU = 0.06 ! (m^0.s^-0)
+
+ NIBM_LAYER_P = 2
+ NIBM_LAYER_Q = 2
+ NIBM_LAYER_R = 2
+ NIBM_LAYER_S = 2
+ NIBM_LAYER_T = 2
+ NIBM_LAYER_E = 2
+ NIBM_LAYER_V = 2
+
+ XIBM_RADIUS_P = 2.
+ XIBM_RADIUS_Q = 2.
+ XIBM_RADIUS_R = 2.
+ XIBM_RADIUS_S = 2.
+ XIBM_RADIUS_T = 2.
+ XIBM_RADIUS_E = 2.
+ XIBM_RADIUS_V = 2.
+
+ XIBM_POWERS_P = 1.
+ XIBM_POWERS_Q = 1.
+ XIBM_POWERS_R = 1.
+ XIBM_POWERS_S = 1.
+ XIBM_POWERS_T = 1.
+ XIBM_POWERS_E = 1.
+ XIBM_POWERS_V = 1.
+
+ CIBM_MODE_INTE3_P = 'LAI'
+ CIBM_MODE_INTE3_Q = 'LAI'
+ CIBM_MODE_INTE3_R = 'LAI'
+ CIBM_MODE_INTE3_S = 'LAI'
+ CIBM_MODE_INTE3_T = 'LAI'
+ CIBM_MODE_INTE3_E = 'LAI'
+ CIBM_MODE_INTE3_V = 'LAI'
+
+ CIBM_MODE_INTE1_P = 'CL2'
+ CIBM_MODE_INTE1_Q = 'CL2'
+ CIBM_MODE_INTE1_R = 'CL2'
+ CIBM_MODE_INTE1_S = 'CL2'
+ CIBM_MODE_INTE1_T = 'CL2'
+ CIBM_MODE_INTE1_E = 'CL2'
+ CIBM_MODE_INTE1NV = 'CL2'
+ CIBM_MODE_INTE1TV = 'CL2'
+ CIBM_MODE_INTE1CV = 'CL2'
+
+ CIBM_MODE_BOUND_P = 'SYM'
+ CIBM_MODE_BOUND_Q = 'SYM'
+ CIBM_MODE_BOUND_R = 'SYM'
+ CIBM_MODE_BOUND_S = 'SYM'
+ CIBM_MODE_BOUND_T = 'SYM'
+ CIBM_MODE_BOUND_E = 'SYM'
+ CIBM_MODE_BOUNT_V = 'ASY'
+ CIBM_MODE_BOUNN_V = 'ASY'
+ CIBM_MODE_BOUNC_V = 'ASY'
+
+ XIBM_FORC_BOUND_P = 0.
+ XIBM_FORC_BOUND_Q = 0.
+ XIBM_FORC_BOUND_R = 0.
+ XIBM_FORC_BOUND_S = 0.
+ XIBM_FORC_BOUND_T = 0.
+ XIBM_FORC_BOUND_E = 0.
+ XIBM_FORC_BOUNN_V = 0.
+ XIBM_FORC_BOUNT_V = 0.
+ XIBM_FORC_BOUNC_V = 0.
+
+ CIBM_TYPE_BOUND_P = 'NEU'
+ CIBM_TYPE_BOUND_Q = 'NEU'
+ CIBM_TYPE_BOUND_R = 'NEU'
+ CIBM_TYPE_BOUND_S = 'NEU'
+ CIBM_TYPE_BOUND_T = 'NEU'
+ CIBM_TYPE_BOUND_E = 'NEU'
+ CIBM_TYPE_BOUNT_V = 'DIR'
+ CIBM_TYPE_BOUNN_V = 'DIR'
+ CIBM_TYPE_BOUNC_V = 'DIR'
+
+ CIBM_FORC_BOUND_P = 'CST'
+ CIBM_FORC_BOUND_Q = 'CST'
+ CIBM_FORC_BOUND_R = 'CST'
+ CIBM_FORC_BOUND_S = 'CST'
+ CIBM_FORC_BOUND_T = 'CST'
+ CIBM_FORC_BOUND_E = 'CST'
+ CIBM_FORC_BOUNN_V = 'CST'
+ CIBM_FORC_BOUNT_V = 'CST'
+ CIBM_FORC_BOUNC_V = 'CST'
+ CIBM_FORC_BOUNR_V = 'CST'
+
+!
+!-------------------------------------------------------------------------------
+!
+!* 32. SET DEFAULT VALUES FOR MODD_RECYCL_PARAMn
+! --------------------------------------
+!
+ LRECYCL = .FALSE.
+ LRECYCLN = .FALSE.
+ LRECYCLW = .FALSE.
+ LRECYCLE = .FALSE.
+ LRECYCLS = .FALSE.
+ XDRECYCLN = 0.
+ XARECYCLN = 0.
+ XDRECYCLW = 0.
+ XARECYCLW = 0.
+ XDRECYCLS = 0.
+ XARECYCLS = 0.
+ XDRECYCLE = 0.
+ XARECYCLE = 0.
+ XTMOY = 0.
+ XTMOYCOUNT = 0.
+ XNUMBELT = 28.
+ XRCOEFF = 0.2
+ XTBVTOP = 500.
+ XTBVBOT = 300.
+!
!
END SUBROUTINE DEFAULT_DESFM_n
diff --git a/src/MNH/default_expre.f90 b/src/MNH/default_expre.f90
index 6c158a6c4e3d218dbae5664a8d1b8ebc00f8a0bf..b3c6d1d1a1f44232c5dd5047bca3b918f4eea2aa 100644
--- a/src/MNH/default_expre.f90
+++ b/src/MNH/default_expre.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$ $Revision$
-! MASDEV4_7 prep_ideal 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #########################
MODULE MODI_DEFAULT_EXPRE
! #########################
@@ -95,6 +90,7 @@ END MODULE MODI_DEFAULT_EXPRE
!! add the uniform soil values 05/02/96 (J.Stein)
!! removes default values for ground variables 26/11/96 (V.Masson)
!! add default value for LBOUSS 11/07/13 (C.Lac)
+!! add default value LOCEAN LCOUPLES /03/21 (JL Redelsperger)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -103,6 +99,7 @@ USE MODD_CONF ! declarative modules
USE MODD_DIM_n
USE MODD_GRID
USE MODD_REF
+USE MODD_DYN_n, ONLY : LOCEAN
!
IMPLICIT NONE
!
@@ -140,7 +137,9 @@ XLATORI = 37.
!* 4. SET DEFAULT VALUES FOR MODD_REF :
! --------------------------------
!
-LBOUSS = .FALSE.
+LBOUSS = .FALSE.
+LOCEAN = .FALSE.
+LCOUPLES= .FALSE.
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/diag.f90 b/src/MNH/diag.f90
index 24d921c97a8ed136ccbfe6acd0e29110e9b8b4a0..27d3244abd5f99a5aa06b83c1d033693ec57403b 100644
--- a/src/MNH/diag.f90
+++ b/src/MNH/diag.f90
@@ -190,7 +190,7 @@ CHARACTER (LEN=4) :: YTURB ! initial flag to call to turbulence schemes
! CHARACTER (LEN=40) :: YFMT,YFMT2! format for cpu analysis printing
INTEGER :: ILUOUT0 ! Logical unit number for the output listing
REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME0, ZTIME1, ZTIME2, ZRAD, ZDCONV, ZSHADOWS, ZGROUND, &
- ZTRACER, ZDRAG, ZTURB, ZMAFL, ZCHEM, ZTIME_BU ! CPU times
+ ZTRACER, ZDRAG, ZTURB, ZMAFL, ZCHEM, ZTIME_BU, ZEOL ! CPU times
REAL(kind=MNHTIME), DIMENSION(2) :: ZSTART, ZINIT, ZWRIT, ZBALL, ZPHYS, ZSURF, ZWRITS, ZTRAJ ! storing variables
INTEGER(KIND=LFIINT) :: INPRAR ! number of articles predicted in the LFIFM file
INTEGER :: ISTEPBAL ! loop indice for balloons and aircraft
@@ -691,11 +691,12 @@ ZTURB = 0.0_MNHTIME
ZDRAG = 0.0_MNHTIME
ZMAFL = 0.0_MNHTIME
ZCHEM = 0.0_MNHTIME
+ZEOL = 0.0_MNHTIME
XTIME_LES = 0.0_MNHTIME
XTIME_LES_BU_PROCESS = 0.0_MNHTIME
XTIME_BU_PROCESS = 0.0_MNHTIME
CALL PHYS_PARAM_n( 1, TOUTDATAFILE, &
- ZRAD, ZSHADOWS, ZDCONV, ZGROUND, ZMAFL, ZDRAG, &
+ ZRAD, ZSHADOWS, ZDCONV, ZGROUND, ZMAFL, ZDRAG,ZEOL, &
ZTURB, ZTRACER, ZTIME_BU, ZWETDEPAER, GMASKkids, GCLOUD_ONLY )
WRITE(ILUOUT0,*) 'DIAG AFTER PHYS_PARAM1'
IF (LCHEMDIAG) THEN
diff --git a/src/MNH/dyn_sources.f90 b/src/MNH/dyn_sources.f90
index efc0e518999897364ba4ef04a6a3461289d00189..482158cb39c28ec2da8e31e2d9ecb753a9f199a3 100644
--- a/src/MNH/dyn_sources.f90
+++ b/src/MNH/dyn_sources.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -158,7 +158,8 @@ use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, &
USE MODD_CONF
USE MODD_CST
USE MODD_DYN
-
+USE MODD_DYN_n, ONLY: LOCEAN
+!
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_MPPDB
@@ -319,6 +320,7 @@ ELSE
ENDIF
!
IF( .NOT.L1D ) THEN
+ IF (.NOT. LOCEAN) THEN
!
IF (KRR > 0) THEN
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'PREF', prths(:, :, :) )
@@ -346,6 +348,7 @@ IF( .NOT.L1D ) THEN
if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'PREF', prths(:, :, :) )
END IF
+ END IF
!
END IF
!
diff --git a/src/MNH/emoist.f90 b/src/MNH/emoist.f90
index f58a1b32d2f6d7901b6c25f61edad0a0ddde339f..7703fb388efc28be14bffeb7d070dcdc0167af19 100644
--- a/src/MNH/emoist.f90
+++ b/src/MNH/emoist.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-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 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$ $Revision$
-! MASDEV4_7 turb 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!#################
MODULE MODI_EMOIST
!#################
@@ -80,12 +75,14 @@ FUNCTION EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM) RESULT(PEMOIST)
!! J. Stein Feb 28, 1996 optimization + Doctorization
!! J. Stein Spet 15, 1996 Amoist previously computed
!! J.-P. Pinty May 20, 2003 Improve EMOIST expression
+!! 03/2021 (JL Redelsperger) Ocean model case
!!
!! ----------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODD_CST
+USE MODD_DYN_n, ONLY : LOCEAN
!
IMPLICIT NONE
!
@@ -118,14 +115,21 @@ INTEGER :: JRR ! moist loop counter
!
!* 1. COMPUTE EMOIST
! --------------
-!
-!
-IF ( KRR == 0 ) THEN ! dry case
- PEMOIST(:,:,:) = 0.
-ELSE IF ( KRR == 1 ) THEN ! only vapor
+IF (LOCEAN) THEN
+ IF ( KRR == 0 ) THEN ! Unsalted
+ PEMOIST(:,:,:) = 0.
+ ELSE
+ PEMOIST(:,:,:) = 1. ! Salted case
+ END IF
+!
+ELSE
+!
+ IF ( KRR == 0 ) THEN ! dry case
+ PEMOIST(:,:,:) = 0.
+ ELSE IF ( KRR == 1 ) THEN ! only vapor
ZDELTA = (XRV/XRD) - 1.
PEMOIST(:,:,:) = ZDELTA*PTHLM(:,:,:)
-ELSE ! liquid water & ice present
+ ELSE ! liquid water & ice present
ZDELTA = (XRV/XRD) - 1.
ZRW(:,:,:) = PRM(:,:,:,1)
!
@@ -173,8 +177,9 @@ ELSE ! liquid water & ice present
/ (1. + ZRW(:,:,:)) &
) * PAMOIST(:,:,:) * 2. * PSRCM(:,:,:)
END IF
-END IF
+ END IF
!
+END IF
!---------------------------------------------------------------------------
!
END FUNCTION EMOIST
diff --git a/src/MNH/eol_adnr.f90 b/src/MNH/eol_adnr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b47d14fa35958b0c86f7a2337f566a928cfae078
--- /dev/null
+++ b/src/MNH/eol_adnr.f90
@@ -0,0 +1,250 @@
+!MNH_LIC Copyright 2017-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.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_ADNR
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE EOL_ADNR(PDXX, PDYY, PDZZ, &
+ PRHO_M, PUT_M, &
+ PFX_RG )
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! mesh size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO_M ! dry Density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT_M ! Wind speed at mass point
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFX_RG ! Aerodynamic force (cartesian mesh..
+ ! .. x axis, global
+ ! ..frame)
+!
+!
+END SUBROUTINE EOL_ADNR
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_ADNR
+!
+! ###################################################################
+ SUBROUTINE EOL_ADNR(PDXX, PDYY, PDZZ, &
+ PRHO_M, PUT_M, &
+ PFX_RG )
+! ###################################################################
+!
+!!**** *MODI_EOL_ADNR* -
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several methods are available. One of the models is the Non-
+!! Rotating Actuator Disk Non-Rotating model (ADNR). It allows to
+!! compute aerodynamic forces according the wind speed and the
+!! caracteristics of the wind turbine.
+!!
+!!** METHOD
+!! ------
+!! The actuator disc flow model, in this routine, is computed without
+!! rotation. It consists in applying a thrust force over the disc drawn
+!! by the blades. This aerodynamic force acts against the wind to disturb
+!! the flow.
+!!
+!! REFERENCE
+!! ---------
+!! PA. Joulin PhD Thesis. 2020.
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2017
+!! Modification 19/10/20 (PA. Joulin) Updated for a main version
+!!
+!!---------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+! To work with ADNR
+USE MODD_EOL_ADNR
+!
+USE MODD_EOL_SHARED_IO, ONLY: CINTERP
+USE MODD_EOL_SHARED_IO, ONLY: XTHRUT
+USE MODI_EOL_MATHS, ONLY: INTERP_LIN8NB
+! To know the grid
+USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZS,XZZ
+USE MODE_ll, ONLY: GET_INDICE_ll
+USE MODD_PARAMETERS, ONLY: JPVEXT
+! To play with MPI
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD, IP
+use MODD_PRECISION, only: MNHREAL_MPI
+USE MODD_MPIF, ONLY: MPI_SUM
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+! Meso-NH
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! Mesh size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO_M ! Dry Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT_M ! Wind speed at mass point
+! Wind turbine aerodynamic
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFX_RG ! Aerodynamic force (cartesian mesh, x axis, RG frame) [N]
+!
+!* 0.2 Declarations of local variables :
+!
+! Indicies
+INTEGER :: IIB,IJB,IKB ! Begin of a CPU domain
+INTEGER :: IIE,IJE,IKE ! End of a CPU domain
+INTEGER :: IKU ! Vertical size of the domain
+INTEGER :: JI, JJ, JK ! Loop index
+INTEGER :: JROT ! Wind turbine index
+!
+! Wind
+REAL :: ZRHO_I ! Interpolated density [kg/m3]
+REAL :: ZUT_I ! Interpolated wind speed U (RG) [m/s]
+REAL, DIMENSION(SIZE(PUT_M,1),SIZE(PUT_M,2),SIZE(PUT_M,3)) :: ZZH ! True heigth to interpolate 8N
+!
+! Wind turbine
+REAL, DIMENSION(TFARM%NNB_TURBINES) :: ZTHRUT ! Thrust [N]
+! Geometry
+REAL :: ZY_DIST ! Distance Hub - Cell on Y [m]
+REAL :: ZZ_DIST ! Distance Hub - Cell on Z [m]
+REAL :: ZR_DIST ! Radial distance Hub - Cell [m]
+REAL, DIMENSION(3) :: ZPOS ! Element position [m]
+!
+!Numerical
+INTEGER :: IINFO ! code info return
+!
+!* 0.3 Implicit arguments
+!
+! A. From MODD_EOL_ADNR:
+!TYPE(FARM) :: TFARM
+!TYPE(TURBINE) :: TTURBINE
+!REAL, DIMENSION(:), ALLOCATABLE :: XA_INDU ! Induction factor [-]
+!REAL, DIMENSION(:), ALLOCATABLE :: XCT_D ! Adapted thrust coef (for U_d) [-]
+!
+!
+! B. From MODD_EOL_SHARED_IO:
+! for NAM_EOL_ADNR:
+!CHARACTER(LEN=100) :: CFARM_CSVDATA ! File to read, with farm data
+!CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! File to read, turbine data
+!CHARACTER(LEN=3) :: CINTERP ! Interpolation method for wind speed
+! for outputs
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZATIONS
+! ---------------
+!
+!* 1.1 Subdomain (CPU) indices
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) ! Get begin and end domain index (CPU)
+IKU = SIZE(PUT_M,3) ! Top of the domain end index
+IKB=1+JPVEXT ! Vertical begin index
+IKE=IKU-JPVEXT ! Vertical end index
+!
+!* 1.2 Induction factor and adapted thrust coef (that will use U_disc)
+!
+DO JROT=1,TFARM%NNB_TURBINES
+ XA_INDU(JROT) = 0.5*(1-(1-TFARM%XCT_INF(JROT))**0.5)
+ XCT_D(JROT) = 4*XA_INDU(JROT)/(1-XA_INDU(JROT))
+END DO
+!
+CALL PRINTMER_CPU1('ADNR : At ', 1.3)
+!* 1.3 Inits
+!
+ZTHRUT(:) = 0.
+XTHRUT(:) = 0.
+!
+CALL PRINTMER_CPU1('ADNR : At ', 1.4)
+!* 1.4 Vertical coordinate in case of interpolation
+!
+IF (CINTERP=='8NB') THEN
+ DO JK=1,IKU-1
+ ZZH(:,:,JK) = (0.5*(XZZ(:,:,JK)+XZZ(:,:,JK+1))-XZS(:,:))
+ END DO
+ ZZH(:,:,IKU) = 2*ZZH(:,:,IKU-1) - ZZH(:,:,IKU-2)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTES THRUST FORCE THAT ACTS ON THE ROTOR DUE TO THE WIND
+! ------------------------------------------------------------
+!
+!* 2.1 Finding the position of wind turbines
+!
+! Loop over domain
+DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ! Loop over wind turbines
+ DO JROT=1,TFARM%NNB_TURBINES
+ ! X axis position test :
+ IF (TFARM%XPOS_X(JROT) >= XXHAT(JI) .AND. &
+ TFARM%XPOS_X(JROT) < XXHAT(JI) + PDXX(JI,JJ,JK)) THEN
+ ! YZ plane distances calculations
+ ZY_DIST = TFARM%XPOS_Y(JROT)-XYHAT(JJ)
+ ZZ_DIST = TTURBINE%XH_HEIGHT-(XZZ(JI,JJ,JK)-XZS(JI,JJ))
+ ZR_DIST = (ZY_DIST**2 + ZZ_DIST**2 )**(1./2.)
+ !
+ ! Disc position test
+ IF (ZR_DIST <= TTURBINE%XR_MAX) THEN
+!
+!* 2.2 Interpolating the wind
+!
+ ZPOS(1) = XXHAT(JI)
+ ZPOS(2) = XYHAT(JJ)
+ ZPOS(3) = XZZ(JI,JJ,JK)-XZS(JI,JJ)
+ SELECT CASE(CINTERP)
+ CASE('CLS')
+ ZUT_I = PUT_M(JI,JJ,JK)
+ ZRHO_I = PRHO_M(JI,JJ,JK)
+ CASE('8NB')
+ ZUT_I = INTERP_LIN8NB(ZPOS(:),JI,JJ,JK,PUT_M,ZZH)
+ ZRHO_I = INTERP_LIN8NB(ZPOS(:),JI,JJ,JK,PRHO_M,ZZH)
+ END SELECT
+!
+!* 2.3 Calculating the thrust of a cell wind->rotor
+!
+ PFX_RG(JI,JJ,JK) = PFX_RG(JI,JJ,JK) &
+ + 0.5*ZRHO_I*XCT_D(JROT) &
+ *PDYY(JI,JJ,JK)*PDZZ(JI,JJ,JK) &
+ *ZUT_I**2
+!
+!* 2.4 Calculating the thrust of the rotor wind->rotor
+! in a pseudo hub coordinate system (-)
+!
+ ZTHRUT(JROT) = ZTHRUT(JROT) &
+ - 0.5*ZRHO_I*XCT_D(JROT) &
+ *PDYY(JI,JJ,JK)*PDZZ(JI,JJ,JK) &
+ *ZUT_I**2
+!
+ END IF ! Disc position test
+ END IF ! X axis position test
+ END DO ! WT loop
+ END DO ! X domain loop
+ END DO ! Y domain loop
+END DO ! Z domain loop
+!
+!* 2.4 Bottom and top boundaries
+!
+PFX_RG(:,:,IKB-1) = PFX_RG(:,:,IKB)
+PFX_RG(:,:,IKE+1) = PFX_RG(:,:,IKE)
+!
+!* 3. SHARING THE DATAS OVER THE CPUS
+! -------------------------------
+!
+CALL MPI_ALLREDUCE(ZTHRUT, XTHRUT, SIZE(XTHRUT), &
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+!
+!
+!
+END SUBROUTINE EOL_ADNR
diff --git a/src/MNH/eol_alm.f90 b/src/MNH/eol_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6dc910246b490c4ad23ad58b3233bb75e4fe07f9
--- /dev/null
+++ b/src/MNH/eol_alm.f90
@@ -0,0 +1,504 @@
+!MNH_LIC Copyright 2017-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.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_ALM
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE EOL_ALM(KTCOUNT, PTSTEP, &
+ PDXX, PDYY, PDZZ, &
+ PRHO_M, &
+ PUT_M, PVT_M, PWT_M, &
+ PFX_RG, PFY_RG, PFZ_RG )
+
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! timestep except
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! mesh size
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO_M ! dry Density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT_M,PVT_M,PWT_M ! Wind speed at mass point
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFX_RG ! Aerodynamic force ..
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFY_RG ! .. cartesian mesh ..
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFZ_RG ! .. global frame)
+!
+!
+END SUBROUTINE EOL_ALM
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_ALM
+!
+! ###################################################################
+ SUBROUTINE EOL_ALM(KTCOUNT, PTSTEP, &
+ PDXX, PDYY, PDZZ, &
+ PRHO_M, &
+ PUT_M, PVT_M, PWT_M, &
+ PFX_RG, PFY_RG, PFZ_RG )
+! ###################################################################
+!
+!!**** *MODI_EOL_ALM* -
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several methods are available. One of the models is the Actuator
+!! Line Method (ALM). It allows to compute aerodynamic forces according
+!! the wind speed and the caracteristics of the wind turbine.
+!!
+!!** METHOD
+!! ------
+!! The ALM consists in modeling each blade by one line divided into blade
+!! element points (Sørensen and Shen, 2002). These points are applying
+!! aerodynamic forces into the flow.
+!! Each point carries a two-dimensional (2D) airfoil, and its characteris-
+!! tics, as lift and drag coefficients. Knowing these coefficients, and
+!! the angle of attack, the lift and drag forces can be evaluated.
+!!
+!! REFERENCE
+!! ---------
+!! PA. Joulin PhD Thesis. 2020.
+!!
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/01/17
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!!---------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+! To work with wind turbines
+USE MODD_EOL_ALM
+USE MODD_EOL_KINE_ALM
+!
+USE MODD_EOL_SHARED_IO, ONLY: CINTERP
+USE MODD_EOL_SHARED_IO, ONLY: XTHRUT, XTORQT, XPOWT
+!
+USE MODI_EOL_MATHS
+USE MODI_EOL_READER, ONLY: GET_AIRFOIL_ID
+USE MODI_EOL_PRINTER, ONLY: PRINT_TSPLIT
+USE MODI_EOL_ERROR, ONLY: EOL_WTCFL_ERROR
+! Math
+USE MODD_CST, ONLY: XPI
+! To know the grid
+USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZS,XZZ
+USE MODE_ll, ONLY: GET_INDICE_ll
+USE MODD_PARAMETERS, ONLY: JPVEXT
+! MPI stuffs
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
+USE MODD_PRECISION, ONLY: MNHREAL_MPI
+USE MODD_MPIF, ONLY: MPI_SUM
+USE MODE_SUM_ll, ONLY: MIN_ll
+USE MODD_VAR_ll, ONLY: IP
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! timestep except
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! mesh size
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO_M ! dry Density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT_M,PVT_M,PWT_M ! Wind speed at mass point
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFX_RG ! Aerodynamic force ..
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFY_RG ! .. cartesian mesh ..
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFZ_RG ! .. global frame)
+!
+!
+!* 0.2 Declarations of local variables :
+!
+! Indicies Compteurs
+INTEGER :: IIB,IJB,IKB ! Begin of a CPU domain
+INTEGER :: IIE,IJE,IKE ! End of a CPU domain
+INTEGER :: IKU ! Vertical size of the domain
+INTEGER :: JI, JJ, JK ! Loop index
+INTEGER :: JROT, JBLA, JBELT ! Rotor, blade, and blade element indicies
+!
+! Averages variables over all sub-timestep (if Time splitting)
+REAL, DIMENSION(TFARM%NNB_TURBINES,TTURBINE%NNB_BLADES,TBLADE%NNB_BLAELT) :: ZAOA_ATS ! Angle of attack of an element, hub frame [rad]
+REAL, DIMENSION(TFARM%NNB_TURBINES,TTURBINE%NNB_BLADES,TBLADE%NNB_BLAELT) :: ZFLIFT_ATS ! Aerodynamic lift force, parallel to Urel [N]
+REAL, DIMENSION(TFARM%NNB_TURBINES,TTURBINE%NNB_BLADES,TBLADE%NNB_BLAELT) :: ZFDRAG_ATS ! Aerodynamic drag force, perpendicular to Urel [N]
+REAL, DIMENSION(TFARM%NNB_TURBINES,TTURBINE%NNB_BLADES,TBLADE%NNB_BLAELT,3) :: ZFAERO_RE_ATS ! Aerodynamic force (lift+drag) in RE [N]
+REAL, DIMENSION(TFARM%NNB_TURBINES,TTURBINE%NNB_BLADES,TBLADE%NNB_BLAELT,3) :: ZFAERO_RG_ATS ! Aerodynamic force (lift+drag) in RG [N]
+
+
+! -- Wind --
+REAL :: ZRHO_I ! Interpolated density [kg/m3]
+REAL :: ZUT_I ! Interpolated wind speed U (RG) [m/s]
+REAL :: ZVT_I ! Interpolated wind speed V (RG) [m/s]
+REAL :: ZWT_I ! Interpolated wind speed W (RG) [m/s]
+REAL, DIMENSION(3) :: ZWIND_VEL_RG ! Wind velocity in RG frame [m/s]
+REAL, DIMENSION(3) :: ZWIND_VEL_RE ! Wind velocity in RE frame [m/s]
+REAL, DIMENSION(3) :: ZWINDREL_VEL_RE ! Relative wind velocity in RE frame [m/s]
+REAL :: ZWINDREL_VEL ! Norm of the relative wind velocity [m/s]
+REAL, DIMENSION(SIZE(PUT_M,1),SIZE(PUT_M,2),SIZE(PUT_M,3)) :: ZZH ! True heigth to interpolate 8NB
+!
+! -- Wind turbine --
+INTEGER :: INB_WT, INB_B, INB_BELT ! Total numbers
+REAL :: ZRAD ! Blade radius [m]
+INTEGER :: IAID ! Airfoil index [-]
+!
+! -- Aero --
+REAL :: ZAOA ! Attack angle of an element [rad]
+REAL :: ZCDRAG ! Drag coefficient of an element []
+REAL :: ZCLIFT ! Lift coefficient of an element []
+REAL :: ZFDRAG ! Drag force of an element, parallel to Urel [N]
+REAL :: ZFLIFT ! Lift force of an element, perpendicular to Urel [N]
+REAL, DIMENSION(3) :: ZFAERO_RE ! Aerodynamic force (lift+drag) in RE [N]
+REAL, DIMENSION(3) :: ZFAERO_RG ! Aerodynamic force (lift+drag) in RG [N]
+! Tip loss
+REAL :: ZFTIPL ! tip loss function
+REAL :: ZPHI ! angle twist+pitch+aa
+!
+! Thrust, Torque and Power
+REAL, DIMENSION(3) :: ZFAERO_RH ! Aerodynamic force (lift+drag) in RH [N] (thrust/torque)
+REAL, DIMENSION(3) :: ZDIST_HBELT_RH ! Distance between blade element and hub, in RH [m]
+REAL, DIMENSION(3) :: ZDIST_HBELT_RG ! Distances between blade element and hub, in RG [m]
+REAL, DIMENSION(3) :: Z3D_TORQT ! Full torque force (3D) of the wind turbine [N]
+!
+! -- Time spliting --
+INTEGER :: KTSUBCOUNT, INBSUBCOUNT ! sub iteration count
+REAL :: ZTSUBSTEP ! sub timestep
+REAL :: ZMAXTSTEP ! Max value for timestep to respect WTCFL criteria
+!
+! -- Numerical --
+INTEGER :: IINFO ! code info return
+!
+!
+!* 0.3 Implicit arguments
+!
+! A. From MODD_EOL_ALM
+!TYPE(FARM) :: TFARM
+!TYPE(TURBINE) :: TTURBINE
+!TYPE(BLADE) :: TBLADE
+!TYPE(AIRFOIL), DIMENSION(:), ALLOCATABLE :: TAIRFOIL
+!
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XELT_RAD ! Blade elements radius [m]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XAOA_GLB ! Angle of attack of an element [rad]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFLIFT_GLB ! Lift force, parallel to Urel [N]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFDRAG_GLB ! Drag force, perpendicular to Urel [N]
+!REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RE_GLB ! Aerodyn. force (lift+drag) in RE [N]
+!REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RG_GLB ! Aerodyn. force (lift+drag) in RG [N]
+!
+!INTEGER :: NNB_BLAELT ! Number of blade elements
+!LOGICAL :: LTIMESPLIT ! Flag to apply Time splitting method
+!LOGICAL :: LTIPLOSSG ! Flag to apply Glauert's tip loss correction
+!LOGICAL :: LTECOUTPTS ! Flag to get Tecplot file output of element points
+!
+! B. From MODD_EOL_SHARED_IO:
+! for namelist NAM_EOL_ALM
+!CHARACTER(LEN=100) :: CFARM_CSVDATA ! Farm file to read
+!CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! Turbine file to read
+!CHARACTER(LEN=100) :: CBLADE_CSVDATA ! Blade file to read
+!CHARACTER(LEN=100) :: CAIRFOIL_CSVDATA ! Airfoil file to read
+!CHARACTER(LEN=3) :: CINTERP ! Interpolation method for wind speed
+! for output
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!REAL, DIMENSION(:), ALLOCATABLE :: XTORQT ! Torque [Nm]
+!REAL, DIMENSION(:), ALLOCATABLE :: XPOWT ! Power [W]
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. INITIALIZATIONS
+! ---------------
+!
+!* 1.1 Subdomain (CPU) indices
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) ! Get begin and end domain index (CPU)
+IKU = SIZE(PUT_M,3) ! Top of the domain end index
+IKB=1+JPVEXT ! Vertical begin index
+IKE=IKU-JPVEXT ! Vertical end index
+!
+!* 1.2 Some usefull integers
+!
+INB_WT = TFARM%NNB_TURBINES
+INB_B = TTURBINE%NNB_BLADES
+INB_BELT = TBLADE%NNB_BLAELT
+!
+!* 1.3 Vertical coordinate in case of interpolation
+!
+IF (CINTERP=='8NB') THEN
+ DO JK=1,IKU-1
+ ZZH(:,:,JK) = (0.5*(XZZ(:,:,JK)+XZZ(:,:,JK+1))-XZS(:,:))
+ END DO
+ ZZH(:,:,IKU) = 2*ZZH(:,:,IKU-1) - ZZH(:,:,IKU-2)
+END IF
+!
+!* 1.4 Set to zeros at each MNH time steps
+!
+! Averaged variables (over time splitting)
+ZAOA_ATS(:,:,:) = 0.
+ZFLIFT_ATS(:,:,:) = 0.
+ZFDRAG_ATS(:,:,:) = 0.
+ZFAERO_RE_ATS(:,:,:,:) = 0.
+ZFAERO_RG_ATS(:,:,:,:) = 0.
+!
+! Global variables (seen by all CPU)
+XAOA_GLB(:,:,:) = 0.
+XFLIFT_GLB(:,:,:) = 0.
+XFDRAG_GLB(:,:,:) = 0.
+XFAERO_RE_GLB(:,:,:,:) = 0.
+XFAERO_RG_GLB(:,:,:,:) = 0.
+!
+XTHRUT(:) = 0.
+XTORQT(:) = 0.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTES WTCFL CRITERIA
+! -----------------------
+!
+!* 2.1 Computing the highest timestep acceptable
+ZMAXTSTEP = ABS( MIN(MIN_ll(PDXX(:,:,:),IINFO),&
+ MIN_ll(PDYY(:,:,:),IINFO),&
+ MIN_ll(PDZZ(:,:,:),IINFO))&
+ /(MAXVAL(TFARM%XOMEGA(:))*TTURBINE%XR_MAX))
+!
+IF (.NOT.LTIMESPLIT) THEN
+!* 2.2 Checking conditions
+! If time step too high : abort
+ IF (PTSTEP > ZMAXTSTEP) THEN
+ CALL EOL_WTCFL_ERROR(ZMAXTSTEP)
+! If time step ok, continue
+ ELSE
+ INBSUBCOUNT = 1
+ ZTSUBSTEP = PTSTEP/INBSUBCOUNT
+ END IF
+ELSE
+!* 2.3 Timesplitting : new sub-timestep
+ INBSUBCOUNT = INT(PTSTEP/ZMAXTSTEP) + 1
+ ZTSUBSTEP = PTSTEP/INBSUBCOUNT
+ CALL PRINT_TSPLIT(INBSUBCOUNT, ZTSUBSTEP)
+END IF
+!
+!* 2.4 Start looping over sub-timesteps
+DO KTSUBCOUNT=1,INBSUBCOUNT
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. KINEMATICS COMPUTATIONS
+! -----------------------
+!
+ CALL EOL_KINE_ALM(KTCOUNT, KTSUBCOUNT, ZTSUBSTEP, PTSTEP)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. COMPUTES AERODYNAMIC FORCES THAT ACTS ON THE BLADES DUE TO THE WIND
+! --------------------------------------------------------------
+!
+!* 4.1 Finding the position of wind turbines
+!
+! Loop over domain
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ! Loop over wind turbines
+ DO JROT=1, INB_WT
+ DO JBLA=1, INB_B
+ DO JBELT=1, INB_BELT
+ ! Position test
+ IF (XPOS_ELT_RG(JROT,JBLA,JBELT,1) >= XXHAT(JI) .AND. &
+ XPOS_ELT_RG(JROT,JBLA,JBELT,1) < XXHAT(JI) + PDXX(JI,JJ,JK)) THEN
+!
+ IF (XPOS_ELT_RG(JROT,JBLA,JBELT,2) >= XYHAT(JJ) .AND. &
+ XPOS_ELT_RG(JROT,JBLA,JBELT,2) < XYHAT(JJ) + PDYY(JI,JJ,JK)) THEN
+!
+ IF (XPOS_ELT_RG(JROT,JBLA,JBELT,3) >= XZZ(JI,JJ,JK) .AND. &
+ XPOS_ELT_RG(JROT,JBLA,JBELT,3) < XZZ(JI,JJ,JK) + PDZZ(JI,JJ,JK)) THEN
+!
+!* 4.2 Extracting the wind
+!
+ SELECT CASE(CINTERP)
+ CASE('CLS')
+ ZUT_I = PUT_M(JI,JJ,JK)
+ ZVT_I = PVT_M(JI,JJ,JK)
+ ZWT_I = PWT_M(JI,JJ,JK)
+ ZRHO_I = PRHO_M(JI,JJ,JK)
+ CASE('8NB')
+ ZUT_I = INTERP_LIN8NB(XPOS_ELT_RG(JROT,JBLA,JBELT,:),&
+ JI,JJ,JK,PUT_M,ZZH)
+ ZVT_I = INTERP_LIN8NB(XPOS_ELT_RG(JROT,JBLA,JBELT,:),&
+ JI,JJ,JK,PVT_M,ZZH)
+ ZWT_I = INTERP_LIN8NB(XPOS_ELT_RG(JROT,JBLA,JBELT,:),&
+ JI,JJ,JK,PWT_M,ZZH)
+ ZRHO_I = INTERP_LIN8NB(XPOS_ELT_RG(JROT,JBLA,JBELT,:),&
+ JI,JJ,JK,PRHO_M,ZZH)
+ END SELECT
+ ZWIND_VEL_RG(1) = ZUT_I
+ ZWIND_VEL_RG(2) = ZVT_I
+ ZWIND_VEL_RG(3) = ZWT_I
+!
+!* 4.3 Calculating the wind in RE frame
+!
+ ZWIND_VEL_RE(:) = MATMUL(XMAT_RE_RG(JROT,JBLA,JBELT,:,:), ZWIND_VEL_RG(:))
+!
+!* 4.4 Calculating the relative wind speed in RE frame + norm
+!
+ ZWINDREL_VEL_RE(:) = ZWIND_VEL_RE(:) - XTVEL_ELT_RE(JROT,JBLA,JBELT,:)
+ ZWINDREL_VEL = NORM(ZWINDREL_VEL_RE)
+!
+!* 4.5 Calculating the angle of attack
+!
+ ZAOA = ATAN2(ZWINDREL_VEL_RE(1), ZWINDREL_VEL_RE(2))
+!
+!* 4.6 Getting aerodynamic coefficients from tabulated data
+!
+ ZRAD = XELT_RAD(JROT,JBLA,JBELT) ! Radius of the element
+ IAID = GET_AIRFOIL_ID(TTURBINE,TBLADE,TAIRFOIL,ZRAD) ! ID of the airfoil
+ ZCLIFT = INTERP_SPLCUB(ZAOA*180/XPI, &
+ TAIRFOIL(IAID)%XAA,&
+ TAIRFOIL(IAID)%XCL)
+ ZCDRAG = INTERP_SPLCUB(ZAOA*180/XPI, &
+ TAIRFOIL(IAID)%XAA,&
+ TAIRFOIL(IAID)%XCD)
+!
+!* 4.7 Tip loss correction (Glauert)
+!
+ IF (LTIPLOSSG) THEN
+ ZPHI = + ZAOA &
+ + TFARM%XBLA_PITCH(JROT) &
+ + XTWIST_ELT(JROT,JBLA,JBELT)
+ IF (ZPHI > 0.0) THEN
+ ZFTIPL = (2.0/XPI)*ACOS(MIN( &
+ 1.0, EXP(-(TTURBINE%NNB_BLADES/2.0) &
+ *(TTURBINE%XR_MAX-ZRAD)/(ZRAD*SIN(ZPHI)))))
+ ELSE
+ ZFTIPL = 1.0
+ END IF
+ ZCLIFT = ZFTIPL*ZCLIFT
+ ZCDRAG = ZFTIPL*ZCDRAG
+ END IF
+!
+!* 4.8 Computing aerodynamic forces in relative frame
+! that act on blades (wind->blade)
+ ZFLIFT = 0.5*ZRHO_I*XSURF_ELT(JROT,JBLA,JBELT)*ZCLIFT*ZWINDREL_VEL**2
+ ZFDRAG = 0.5*ZRHO_I*XSURF_ELT(JROT,JBLA,JBELT)*ZCDRAG*ZWINDREL_VEL**2
+!
+!* 4.9 Evaluating the aerodynamiques forces in RE frame
+! that act on blades (wind->blade)
+ ZFAERO_RE(1) = SIN(ZAOA)*ZFDRAG + COS(ZAOA)*ZFLIFT
+ ZFAERO_RE(2) = COS(ZAOA)*ZFDRAG - SIN(ZAOA)*ZFLIFT
+ ZFAERO_RE(3) = .0 ! 2D flow around arifoil assumption
+!
+!* 4.10 Evaluating the aerodynamiques forces in RG frame
+! that act on blades (wind->blade)
+ ZFAERO_RG(:) = MATMUL(XMAT_RG_RE(JROT,JBLA,JBELT,:,:), ZFAERO_RE(:))
+!
+!* 4.11 Adding it to the cell of Meso-NH
+ PFX_RG(JI,JJ,JK) = PFX_RG(JI,JJ,JK) + ZFAERO_RG(1) / FLOAT(INBSUBCOUNT)
+ PFY_RG(JI,JJ,JK) = PFY_RG(JI,JJ,JK) + ZFAERO_RG(2) / FLOAT(INBSUBCOUNT)
+ PFZ_RG(JI,JJ,JK) = PFZ_RG(JI,JJ,JK) + ZFAERO_RG(3) / FLOAT(INBSUBCOUNT)
+!
+!* 4.12 Storing mean values over one full MNH timestep
+! (all the sub-timesteps values are averaged)
+ ZAOA_ATS(JROT,JBLA,JBELT) = ZAOA_ATS(JROT,JBLA,JBELT) &
+ + ZAOA / FLOAT(INBSUBCOUNT)
+ ZFLIFT_ATS(JROT,JBLA,JBELT) = ZFLIFT_ATS(JROT,JBLA,JBELT) &
+ + ZFLIFT / FLOAT(INBSUBCOUNT)
+ ZFDRAG_ATS(JROT,JBLA,JBELT) = ZFDRAG_ATS(JROT,JBLA,JBELT) &
+ + ZFDRAG / FLOAT(INBSUBCOUNT)
+ ZFAERO_RE_ATS(JROT,JBLA,JBELT,:)= ZFAERO_RE_ATS(JROT,JBLA,JBELT,:) &
+ + ZFAERO_RE(:) / FLOAT(INBSUBCOUNT)
+ ZFAERO_RG_ATS(JROT,JBLA,JBELT,:)= ZFAERO_RG_ATS(JROT,JBLA,JBELT,:) &
+ + ZFAERO_RG(:) / FLOAT(INBSUBCOUNT)
+!
+ ! End of position tests
+ END IF
+ END IF
+ END IF
+ ! End of wind turbine loops
+ END DO
+ END DO
+ END DO
+ ! End of domain loops
+ END DO
+ END DO
+ END DO
+! End of sub-time loop
+END DO
+!
+!
+!* 4.13 Top and bottom conditions
+PFX_RG(:,:,IKB-1) = PFX_RG(:,:,IKB)
+PFX_RG(:,:,IKE+1) = PFX_RG(:,:,IKE)
+!
+PFY_RG(:,:,IKB-1) = PFY_RG(:,:,IKB)
+PFY_RG(:,:,IKE+1) = PFY_RG(:,:,IKE)
+!
+PFZ_RG(:,:,IKB-1) = PFZ_RG(:,:,IKB)
+PFZ_RG(:,:,IKE+1) = PFZ_RG(:,:,IKE)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. SHARING THE DATAS OVER THE CPUS
+! -------------------------------
+CALL MPI_ALLREDUCE(ZAOA_ATS, XAOA_GLB, SIZE(XAOA_GLB), &
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+CALL MPI_ALLREDUCE(ZFLIFT_ATS, XFLIFT_GLB, SIZE(XFLIFT_GLB), &
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+CALL MPI_ALLREDUCE(ZFDRAG_ATS, XFDRAG_GLB, SIZE(XFDRAG_GLB), &
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+CALL MPI_ALLREDUCE(ZFAERO_RE_ATS, XFAERO_RE_GLB, SIZE(XFAERO_RE_GLB),&
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+CALL MPI_ALLREDUCE(ZFAERO_RG_ATS, XFAERO_RG_GLB, SIZE(XFAERO_RG_GLB),&
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. COMPUTING THRUST, TORQUE AND POWER
+! ---------------------------------
+!
+IF(IP == 1) THEN
+ DO JROT=1,TFARM%NNB_TURBINES
+ DO JBLA=1, TTURBINE%NNB_BLADES
+ DO JBELT=1, TBLADE%NNB_BLAELT
+!
+!* 6.1 Preliminaries
+! Aerodynamic load (wind->blade) in RH
+ ZFAERO_RH(:) = MATMUL(XMAT_RH_RG(JROT,:,:), &
+ XFAERO_RG_GLB(JROT,JBLA,JBELT,:))
+! Distance between element and hub in RG
+ ZDIST_HBELT_RG(:) = XPOS_ELT_RG(JROT,JBLA,JBELT,:) - XPOS_HUB_RG(JROT,:)
+! Distance between element and hub in RH
+ ZDIST_HBELT_RH(:) = MATMUL(XMAT_RH_RG(JROT,:,:),ZDIST_HBELT_RG(:))
+!
+!* 6.2 Thrust (wind->rotor): in RH
+ XTHRUT(JROT) = XTHRUT(JROT) + ZFAERO_RH(3) ! Only Z component
+!* 6.3 Torque (wind->rotor) in RH
+ Z3D_TORQT = CROSS(ZDIST_HBELT_RH(:),ZFAERO_RH(:))
+ XTORQT(JROT) = XTORQT(JROT) + Z3D_TORQT(3) ! Only Z component
+ END DO
+ END DO
+!
+!* 6.4 Power (wind->rotor)
+ XPOWT(JROT) = XTORQT(JROT) * TFARM%XOMEGA(JROT)
+ END DO
+END IF
+!
+!
+END SUBROUTINE EOL_ALM
diff --git a/src/MNH/eol_debugger.f90 b/src/MNH/eol_debugger.f90
new file mode 100644
index 0000000000000000000000000000000000000000..86e38b3e19fca5ad7f6094707ac7d3b1f15531f8
--- /dev/null
+++ b/src/MNH/eol_debugger.f90
@@ -0,0 +1,240 @@
+!MNH_LIC Copyright 2020-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.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_DEBUGGER
+! #######################
+!
+INTERFACE
+!
+!
+SUBROUTINE PRINTMER_ll(HNAME,PVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ REAL, INTENT(IN) :: PVAR ! Variable,
+END SUBROUTINE PRINTMER_ll
+!
+SUBROUTINE PRINTMEI_ll(HNAME,KVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ INTEGER, INTENT(IN) :: KVAR ! Variable,
+END SUBROUTINE PRINTMEI_ll
+!
+SUBROUTINE PRINTMEC_ll(HNAME,CVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ CHARACTER(LEN=*), INTENT(IN) :: CVAR ! Variable,
+END SUBROUTINE PRINTMEC_ll
+!
+SUBROUTINE PRINTMER_CPU1(HNAME,PVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ REAL, INTENT(IN) :: PVAR ! Variable,
+END SUBROUTINE PRINTMER_CPU1
+!
+SUBROUTINE PRINTMEI_CPU1(HNAME,KVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ INTEGER, INTENT(IN) :: KVAR ! Variable,
+END SUBROUTINE PRINTMEI_CPU1
+!
+SUBROUTINE PRINTMEC_CPU1(HNAME,CVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ CHARACTER(LEN=*), INTENT(IN) :: CVAR ! Variable,
+END SUBROUTINE PRINTMEC_CPU1
+!
+SUBROUTINE PRINTMER_ELT1(KROT,KBLA,KELT,HNAME,PVAR)
+ INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ REAL, INTENT(IN) :: PVAR ! Variable,
+END SUBROUTINE PRINTMER_ELT1
+!
+SUBROUTINE PRINTMER_ELT42(KROT,KBLA,KELT,HNAME,PVAR)
+ INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ REAL, INTENT(IN) :: PVAR ! Variable,
+END SUBROUTINE PRINTMER_ELT42
+!
+SUBROUTINE PRINTMER_3BELT42(KROT,KBLA,KELT,HNAME,PVAR)
+ INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ REAL, INTENT(IN) :: PVAR ! Variable,
+END SUBROUTINE PRINTMER_3BELT42
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_DEBUGGER
+!-------------------------------------------------------------------
+!
+!!**** *EOL_PRINTER* -
+!!
+!! PURPOSE
+!! -------
+!! Some usefull toold to debbug my code
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/10/2020
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE PRINTMER_ll(HNAME,PVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+REAL, INTENT(IN) :: PVAR ! Variable,
+!
+!
+PRINT*, 'CPU n. ', IP, ' : ', HNAME, ' = ', PVAR
+!
+END SUBROUTINE PRINTMER_ll
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMEI_ll(HNAME,KVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+INTEGER, INTENT(IN) :: KVAR ! Variable,
+!
+!
+PRINT*, 'CPU n. ', IP, ' : ', HNAME, ' = ', KVAR
+!
+END SUBROUTINE PRINTMEI_ll
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMEC_ll(HNAME,CVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+CHARACTER(LEN=*), INTENT(IN) :: CVAR ! Variable,
+!
+!
+PRINT*, 'CPU n. ', IP, ' : ', HNAME, ' = ', CVAR
+!
+END SUBROUTINE PRINTMEC_ll
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMER_CPU1(HNAME, PVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+REAL, INTENT(IN) :: PVAR ! Variable,
+!
+IF (IP==1) THEN
+ PRINT*, HNAME, ' = ', PVAR
+END IF
+!
+END SUBROUTINE PRINTMER_CPU1
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMEI_CPU1(HNAME, KVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+INTEGER, INTENT(IN) :: KVAR ! Variable,
+!
+IF (IP==1) THEN
+ PRINT*, HNAME, ' = ', KVAR
+END IF
+!
+END SUBROUTINE PRINTMEI_CPU1
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMEC_CPU1(HNAME, CVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+CHARACTER(LEN=*), INTENT(IN) :: CVAR ! Variable,
+!
+IF (IP==1) THEN
+ PRINT*, HNAME, ' = ', CVAR
+END IF
+!
+END SUBROUTINE PRINTMEC_CPU1
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMER_ELT1(KROT, KBLA, KELT, HNAME, PVAR)
+!
+USE MODD_CST, ONLY: XPI
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+REAL, INTENT(IN) :: PVAR ! Variable,
+!
+IF ((KROT==1).AND.(KBLA==1).AND.(KELT==1)) THEN
+ PRINT*, HNAME, PVAR
+END IF
+!
+END SUBROUTINE PRINTMER_ELT1
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMER_ELT42(KROT, KBLA, KELT, HNAME, PVAR)
+!
+USE MODD_CST, ONLY: XPI
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+REAL, INTENT(IN) :: PVAR ! Variable,
+!
+IF ((KROT==1).AND.(KBLA==1).AND.(KELT==42)) THEN
+ PRINT*, HNAME, PVAR
+END IF
+!
+END SUBROUTINE PRINTMER_ELT42
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMER_3BELT42(KROT, KBLA, KELT, HNAME, PVAR)
+!
+USE MODD_CST, ONLY: XPI
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+REAL, INTENT(IN) :: PVAR ! Variable,
+!
+IF ((KROT==1).AND.(KBLA==1).AND.(KELT==42)) THEN
+ PRINT*, HNAME, 'B1 = ', PVAR*180/XPI
+END IF
+IF ((KROT==1).AND.(KBLA==2).AND.(KELT==42)) THEN
+ PRINT*, HNAME, 'B2 = ', PVAR*180/XPI
+END IF
+IF ((KROT==1).AND.(KBLA==3).AND.(KELT==42)) THEN
+ PRINT*, HNAME, 'B3 = ', PVAR*180/XPI
+END IF
+!
+END SUBROUTINE PRINTMER_3BELT42
+!#########################################################
+!
diff --git a/src/MNH/eol_error.f90 b/src/MNH/eol_error.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c6c221f9f4a5ba6818a6a8242084a253b3ba518d
--- /dev/null
+++ b/src/MNH/eol_error.f90
@@ -0,0 +1,166 @@
+!MNH_LIC Copyright 2020-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.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_ERROR
+! #######################
+!
+INTERFACE
+!
+! **********
+! EOL_READER
+! **********
+!
+SUBROUTINE EOL_CSVNOTFOUND_ERROR(HFILE)
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+END SUBROUTINE EOL_CSVNOTFOUND_ERROR
+!
+SUBROUTINE EOL_CSVEMPTY_ERROR(HFILE,KNBLINE)
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+ INTEGER, INTENT(IN) :: KNBLINE ! number of lines
+END SUBROUTINE EOL_CSVEMPTY_ERROR
+!
+!
+! ***
+! ALM
+! ***
+!
+SUBROUTINE EOL_AIRFOILNOTFOUND_ERROR(HFILE,HVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+ CHARACTER(LEN=*), INTENT(IN) :: HVAR ! missing data
+END SUBROUTINE EOL_AIRFOILNOTFOUND_ERROR
+!
+SUBROUTINE EOL_WTCFL_ERROR(PMAXTSTEP)
+ REAL, INTENT(IN) :: PMAXTSTEP ! maximum acceptable time-step
+END SUBROUTINE EOL_WTCFL_ERROR
+!
+SUBROUTINE EOL_BLADEDATA_ERROR(PDELTARAD)
+ REAL, INTENT(IN) :: PDELTARAD ! Span lenght of an element
+END SUBROUTINE EOL_BLADEDATA_ERROR
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_ERROR
+!-------------------------------------------------------------------
+!
+!!**** *EOL_ERROR* -
+!!
+!! PURPOSE
+!! -------
+!! Some usefull subs to manage errors linked to wind turbines
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/12/2020
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE EOL_CSVNOTFOUND_ERROR(HFILE)
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_MSG
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+!
+CMNHMSG(1) = 'EOL Initialization error: CSV file for wind turbine missing'
+CMNHMSG(2) = 'File: ' // TRIM( HFILE ) // ' not found'
+CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_CSVNOTFOUND_ERROR' )
+!
+END SUBROUTINE EOL_CSVNOTFOUND_ERROR
+!#########################################################
+
+!
+!#########################################################
+SUBROUTINE EOL_CSVEMPTY_ERROR(HFILE,KNBLINE)
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_MSG
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+INTEGER, INTENT(IN) :: KNBLINE ! number of lines
+!
+CHARACTER(LEN=8) :: YLINES
+!
+WRITE( YLINES, '( I8 )' ) KNBLINE
+!
+CMNHMSG(1) = 'EOL Initialization error: missing data in CSV file for wind turbine'
+CMNHMSG(2) = TRIM( YLINES ) // ' line(s) have been read in file ' // TRIM( HFILE )
+CMNHMSG(3) = 'At least 2 should be there: header + data'
+CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_CSVEMPTY_ERROR' )
+!
+END SUBROUTINE EOL_CSVEMPTY_ERROR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE EOL_AIRFOILNOTFOUND_ERROR(HFILE,HVAR)
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_MSG
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+CHARACTER(LEN=*), INTENT(IN) :: HVAR ! missing data
+!
+CMNHMSG(1) = 'EOL Initialization error: missing data for airfoil'
+CMNHMSG(2) = 'Characteristics for ' // TRIM( HVAR )
+CMNHMSG(3) = 'not found in file ' // TRIM( HFILE )
+CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_AIRFOILNOTFOUND_ERROR' )
+!
+END SUBROUTINE EOL_AIRFOILNOTFOUND_ERROR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE EOL_WTCFL_ERROR(PMAXTSTEP)
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_MSG
+!
+REAL, INTENT(IN) :: PMAXTSTEP ! maximum acceptable time-step
+!
+CHARACTER(LEN=10) :: YMAXTSTEP
+!
+WRITE( YMAXTSTEP, '( F10.8 )' ) PMAXTSTEP
+!
+CMNHMSG(1) = 'EOL Initialization error: wrong time-step with wind turbine'
+CMNHMSG(2) = 'Time-step XTSTEP too large: blades can jump over one or several cells'
+CMNHMSG(3) = 'Turn on the time-splitting method (LTIMESPLIT=.TRUE.)'
+CMNHMSG(4) = 'or decrease XTSTEP to a value lower than ' // TRIM(YMAXTSTEP) // ' s'
+CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_WTCFL_ERROR' )
+!
+END SUBROUTINE EOL_WTCFL_ERROR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE EOL_BLADEDATA_ERROR(PDELTARAD)
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_MSG
+USE MODD_EOL_SHARED_IO, ONLY: CBLADE_CSVDATA
+!
+REAL, INTENT(IN) :: PDELTARAD ! hals section width
+!
+CHARACTER(LEN=4) :: YDELTARAD
+!
+WRITE( YDELTARAD, '( F4.2 )' ) PDELTARAD
+!
+CMNHMSG(1) = 'EOL Initialization error: error in blade data'
+CMNHMSG(2) = 'A blade element center position is set to ' // TRIM( YDELTARAD )
+CMNHMSG(3) = 'As a blade element center, it has to be set in ]0%;100%['
+CMNHMSG(4) = 'Please, check your blade data in ' // TRIM(CBLADE_CSVDATA)
+CMNHMSG(5) = 'and make sure it is element centers (not nodes) along the blade'
+CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_BLADEDATA_ERROR' )
+!
+END SUBROUTINE EOL_BLADEDATA_ERROR
+!#########################################################
+!
diff --git a/src/MNH/eol_kine_alm.f90 b/src/MNH/eol_kine_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e3232fac5db801dfafbd5ba8e5b4168660d4327a
--- /dev/null
+++ b/src/MNH/eol_kine_alm.f90
@@ -0,0 +1,336 @@
+!MNH_LIC Copyright 2017-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.
+!-----------------------------------------------------------------
+!
+!#######################
+MODULE MODI_EOL_KINE_ALM
+!
+INTERFACE !----------------------------------------
+!
+SUBROUTINE EOL_KINE_ALM(KTCOUNT,KTSUBCOUNT,PTSUBSTEP,PTSTEP)
+!
+ INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+ INTEGER, INTENT(IN) :: KTSUBCOUNT ! sub iteration count
+ REAL, INTENT(IN) :: PTSUBSTEP ! sub timestep
+ REAL, INTENT(IN) :: PTSTEP ! timestep
+!
+END SUBROUTINE EOL_KINE_ALM
+!
+END INTERFACE !------------------------------------
+!
+END MODULE MODI_EOL_KINE_ALM
+!#######################
+!
+!
+!
+!
+!###################################################################
+SUBROUTINE EOL_KINE_ALM(KTCOUNT,KTSUBCOUNT,PTSUBSTEP,PTSTEP)
+!
+!!**** *EOL_KINEMATICS * -
+!!
+!! PURPOSE
+!! -------
+!! Compute positions, oritentations and velocities of all the
+!! elements of the wind turbine
+!!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/2017
+!! Modification 10/11/20 (PA. Joulin) Updated for a main version
+!!
+!!---------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 Modules
+USE MODD_EOL_KINE_ALM
+USE MODD_EOL_ALM
+USE MODI_EOL_MATHS
+USE MODD_TIME_n, ONLY : TDTCUR
+USE MODD_CST, ONLY : XPI
+!
+IMPLICIT NONE
+!
+!* 0.2 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+INTEGER, INTENT(IN) :: KTSUBCOUNT ! sub iteration count
+REAL, INTENT(IN) :: PTSUBSTEP ! sub timestep
+REAL, INTENT(IN) :: PTSTEP ! timestep
+!
+!* 0.3 Local variables
+DOUBLE PRECISION, DIMENSION(3,3) :: ZORI_MAT_X, ZORI_MAT_Y, ZORI_MAT_Z
+DOUBLE PRECISION, DIMENSION(3) :: ZADD_TO_POS
+!
+DOUBLE PRECISION, DIMENSION(3) :: ZDIST_TOWO_TELT_RG ! Distance between tower elmt and tower base
+DOUBLE PRECISION, DIMENSION(3) :: ZDIST_TOWO_NELT_RG ! Distance between nacelle and base of tower
+DOUBLE PRECISION, DIMENSION(3) :: ZDIST_NAC_HUB_RG ! Distance between hub and base of nacelle
+DOUBLE PRECISION, DIMENSION(3) :: ZDIST_HUB_BLA_RG ! Distance between blade and base of hub
+DOUBLE PRECISION, DIMENSION(3) :: ZDIST_BLA_ELT_RG ! Distance between blade and elements
+!
+DOUBLE PRECISION, DIMENSION(3) :: ZPOS_ELTLE_RE ! Leading Edge (LE) position, in RE
+DOUBLE PRECISION, DIMENSION(3) :: ZPOS_ELTLE_RG ! Leading Edge (LE) position, in RG
+DOUBLE PRECISION, DIMENSION(3) :: ZPOS_ELTTE_RE ! Trailing Edge (TE) position, in RE
+DOUBLE PRECISION, DIMENSION(3) :: ZPOS_ELTTE_RG ! Trailing Edge (TE) position, in RG
+!
+REAL :: ZTIME ! TIME
+INTEGER :: JROT, JBLA, JTELT, JNELT, JBELT ! Loop control
+INTEGER :: INB_WT, INB_B, INB_BELT ! Total numbers
+INTEGER :: INB_TELT, INB_NELT ! Total numbers
+INTEGER :: ITECOUT ! Unit number for Tecplot file
+!
+!
+!---------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+!* 1.1 Some useful integers
+INB_WT = TFARM%NNB_TURBINES
+INB_B = TTURBINE%NNB_BLADES
+INB_TELT = 2
+INB_NELT = 2
+INB_BELT = TBLADE%NNB_BLAELT
+!
+!* 1.2 Sub-time computation
+ZTIME = TDTCUR%xtime+(KTSUBCOUNT)*PTSUBSTEP
+!
+!* 1.3 Tecplotfile : opening + headers
+IF (LTECOUTPTS) THEN
+ CALL OPEN_TECOUT(ITECOUT, KTCOUNT, KTSUBCOUNT)
+END IF
+!
+!
+!---------------------------------------------------------------
+!
+!* 2. COMPUTATIONS
+! ------------
+!
+DO JROT=1, INB_WT
+!
+! ---- TOWER ----
+!
+!* T.0 Update origin positions in RG (Base position + floating)
+ XPOS_TOWO_RG(JROT,:) = XPOS_REF(:) + XPOSINI_TOWO_RG(JROT,:) &
+ + XTVEL_TOWO_RG(JROT,:)*ZTIME
+!
+!* T.1 Update orientation
+ CALL GET_ORI_MAT_X(XANGINI_TOW_RG(JROT,1) + XRVEL_RT_RG(JROT,1)*ZTIME, ZORI_MAT_X)
+ CALL GET_ORI_MAT_Y(XANGINI_TOW_RG(JROT,2) + XRVEL_RT_RG(JROT,2)*ZTIME, ZORI_MAT_Y)
+ CALL GET_ORI_MAT_Z(XANGINI_TOW_RG(JROT,3) + XRVEL_RT_RG(JROT,3)*ZTIME, ZORI_MAT_Z)
+! Compute orientation matrix
+ XMAT_RG_RT(JROT,:,:) = MATMUL(ZORI_MAT_X, MATMUL(ZORI_MAT_Y, ZORI_MAT_Z))
+!
+!* T.2 Update positions in RG
+ DO JTELT=1, INB_TELT
+ XPOS_TELT_RG(JROT,JTELT,:) = XPOS_TOWO_RG(JROT,:) &
+ + MATMUL(XMAT_RG_RT(JROT,:,:),XPOS_TELT_RT(JROT,JTELT,:))
+ END DO
+!
+!* T.3 Update structural velocities
+ DO JTELT=1, INB_TELT
+ ! Rotation of tower already in RG
+ ! Translation of elements
+ ZDIST_TOWO_TELT_RG(:) = XPOS_TELT_RG(JROT,JTELT,:) - XPOS_TOWO_RG(JROT,:)
+ XTVEL_TELT_RG(JROT,JTELT,:) = XTVEL_TOWO_RG(JROT,:) &
+ + CROSS(XRVEL_RT_RG(JROT,:),ZDIST_TOWO_TELT_RG(:))
+ ENDDO
+!
+!* T.4 Print in tecplot file
+ IF (LTECOUTPTS) THEN
+ DO JTELT=1, INB_TELT
+ CALL PRINT_TECOUT(ITECOUT, XPOS_TELT_RG(JROT,JTELT,:))
+ END DO
+ END IF
+!
+!
+! ---- NACELLE ----
+!
+!* N.0 Update origin positions in RG
+ XPOS_NACO_RG(JROT,:) = XPOS_TELT_RG(JROT,INB_TELT,:) &
+ + MATMUL(XMAT_RG_RT(JROT,:,:),XPOSINI_NACO_RT(JROT,:))
+!
+!* N.1 Update orientation
+ CALL GET_ORI_MAT_X(XANGINI_NAC_RT(JROT,1) + XRVEL_RN_RT(JROT,1)*ZTIME, ZORI_MAT_X)
+ CALL GET_ORI_MAT_Y(XANGINI_NAC_RT(JROT,2) + XRVEL_RN_RT(JROT,2)*ZTIME, ZORI_MAT_Y)
+ CALL GET_ORI_MAT_Z(XANGINI_NAC_RT(JROT,3) + XRVEL_RN_RT(JROT,3)*ZTIME, ZORI_MAT_Z)
+!
+! Orientation matrix
+ XMAT_RT_RN(JROT,:,:) = MATMUL(ZORI_MAT_X, MATMUL(ZORI_MAT_Y, ZORI_MAT_Z))
+ XMAT_RG_RN(JROT,:,:) = MATMUL(XMAT_RG_RT(JROT,:,:), XMAT_RT_RN(JROT,:,:))
+!
+!* N.2 Update positions in RG
+ DO JNELT=1, INB_NELT
+ XPOS_NELT_RG(JROT,JNELT,:) = XPOS_NACO_RG(JROT,:) &
+ + MATMUL(XMAT_RG_RN(JROT,:,:),XPOS_NELT_RN(JROT,JNELT,:))
+ END DO
+!
+!* N.3 Update structural velocities
+ ! Rotation of nacelle in RG
+ XRVEL_RN_RG(JROT,:) = MATMUL(XMAT_RG_RT(JROT,:,:),XRVEL_RN_RT(JROT,:)) &
+ + XRVEL_RT_RG(JROT,:)
+ DO JNELT=1, INB_NELT
+ ! Translation of elements in RG
+ ZDIST_TOWO_NELT_RG(:) = XPOS_NELT_RG(JROT,JNELT,:) - XPOS_TOWO_RG(JROT,:)
+ XTVEL_NELT_RG(JROT,JNELT,:) = XTVEL_TOWO_RG(JROT,:) &
+ + CROSS(XRVEL_RN_RG(JROT,:),ZDIST_TOWO_NELT_RG(:))
+ END DO
+!
+!* N.4 Print in tecplot file
+ IF (LTECOUTPTS) THEN
+ DO JNELT=1, INB_NELT
+ CALL PRINT_TECOUT(ITECOUT, XPOS_NELT_RG(JROT,JNELT,:))
+ END DO
+ END IF
+!
+!
+! ---- HUB ----
+!
+!* H.1 Update positions
+ XPOS_HUB_RG(JROT,:) = XPOS_NELT_RG(JROT,INB_NELT,:) &
+ + MATMUL(XMAT_RG_RN(JROT,:,:),XPOSINI_HUB_RN(JROT,:))
+!
+!* H.2 Update orientation
+ CALL GET_ORI_MAT_X(XANGINI_HUB_RN(JROT,1) + XRVEL_RH_RN(JROT,1)*ZTIME, ZORI_MAT_X)
+ CALL GET_ORI_MAT_Y(XANGINI_HUB_RN(JROT,2) + XRVEL_RH_RN(JROT,2)*ZTIME, ZORI_MAT_Y)
+ CALL GET_ORI_MAT_Z(XANGINI_HUB_RN(JROT,3) + XRVEL_RH_RN(JROT,3)*ZTIME, ZORI_MAT_Z)
+! Orientation matrix
+ XMAT_RN_RH(JROT,:,:) = MATMUL(ZORI_MAT_X, MATMUL(ZORI_MAT_Y, ZORI_MAT_Z))
+ XMAT_RG_RH(JROT,:,:) = MATMUL(XMAT_RG_RN(JROT,:,:), XMAT_RN_RH(JROT,:,:))
+ XMAT_RH_RG(JROT,:,:) = TRANSPOSE(XMAT_RG_RH(JROT,:,:))
+!
+!* H.3 Update structural velocities
+! Rotation of hub in RG
+ XRVEL_RH_RG(JROT,:) = MATMUL(XMAT_RG_RH(JROT,:,:),XRVEL_RH_RN(JROT,:)) &
+ + XRVEL_RN_RG(JROT,:)
+! Translation of hub in RG
+ ZDIST_NAC_HUB_RG(:) = XPOS_HUB_RG(JROT,:) - XPOS_NELT_RG(JROT,INB_NELT,:)
+ XTVEL_HUB_RG(JROT,:) = XTVEL_NELT_RG(JROT,INB_NELT,:) + CROSS(XRVEL_RH_RG(JROT,:),ZDIST_NAC_HUB_RG(:))
+!
+!* H.4 Print in tecplot file
+ IF (LTECOUTPTS) THEN
+ CALL PRINT_TECOUT(ITECOUT, XPOS_HUB_RG(JROT,:))
+ END IF
+!
+!
+! ---- BLADES ----
+!
+ DO JBLA=1, INB_B
+!* B.1 Update positions
+ XPOS_BLA_RG(JROT,JBLA,:) = XPOS_HUB_RG(JROT,:) &
+ + MATMUL(XMAT_RG_RH(JROT,:,:),XPOSINI_BLA_RH(JROT,JBLA,:))
+!
+!* B.2 Update orientation
+ CALL GET_ORI_MAT_X(XANGINI_BLA_RH(JROT,JBLA,1) + XRVEL_RB_RH(JROT,JBLA,1)*ZTIME, ZORI_MAT_X)
+ CALL GET_ORI_MAT_Y(XANGINI_BLA_RH(JROT,JBLA,2) + XRVEL_RB_RH(JROT,JBLA,2)*ZTIME, ZORI_MAT_Y)
+ CALL GET_ORI_MAT_Z(XANGINI_BLA_RH(JROT,JBLA,3) + XRVEL_RB_RH(JROT,JBLA,3)*ZTIME, ZORI_MAT_Z)
+! Orientation matrix
+ XMAT_RH_RB(JROT,JBLA,:,:) = MATMUL(ZORI_MAT_X, MATMUL(ZORI_MAT_Y, ZORI_MAT_Z))
+ XMAT_RG_RB(JROT,JBLA,:,:) = MATMUL(XMAT_RG_RH(JROT,:,:), XMAT_RH_RB(JROT,JBLA,:,:))
+!
+!* B.3 Update structural velocities
+! Rotation of blade in RG
+ XRVEL_RB_RG(JROT,JBLA,:) = XRVEL_RH_RG(JROT,:) &
+ + MATMUL(XMAT_RG_RB(JROT,JBLA,:,:),XRVEL_RB_RH(JROT,JBLA,:))
+! Translation of blade in RG
+ ZDIST_HUB_BLA_RG(:) = XPOS_BLA_RG(JROT,JBLA,:) - XPOS_HUB_RG(JROT,:)
+ XTVEL_BLA_RG(JROT,JBLA,:) = XTVEL_HUB_RG(JROT,:) &
+ + CROSS(XRVEL_RB_RG(JROT,JBLA,:),ZDIST_HUB_BLA_RG(:))
+!
+!* B.4 Print in tecplot file
+ IF (LTECOUTPTS) THEN
+ CALL PRINT_TECOUT(ITECOUT, XPOS_BLA_RG(JROT,JBLA,:))
+ END IF
+!
+!
+! ---- ELEMENTS ----
+!* E.0 Positioning sections (cuts) in RG
+ DO JBELT=1, INB_BELT+1
+ XPOS_SEC_RG(JROT,JBLA,JBELT,:) = XPOS_BLA_RG(JROT,JBLA,:) &
+ + MATMUL(XMAT_RG_RB(JROT,JBLA,:,:),XPOS_SEC_RB(JROT,JBLA,JBELT,:))
+ ENDDO
+!
+!
+ DO JBELT=1, INB_BELT
+!* E.1 Positioning sections centers (application points) in RG
+ XPOS_ELT_RG(JROT,JBLA,JBELT,:) = XPOS_BLA_RG(JROT,JBLA,:) &
+ + MATMUL(XMAT_RG_RB(JROT,JBLA,:,:),XPOS_ELT_RB(JROT,JBLA,JBELT,:))
+!* E.2 Update orientation
+ CALL GET_ORI_MAT_X(XANGINI_ELT_RB(JROT,JBLA,JBELT,1) &
+ + XRVEL_RE_RB(JROT,JBLA,JBELT,1)*ZTIME, ZORI_MAT_X)
+ CALL GET_ORI_MAT_Y(XANGINI_ELT_RB(JROT,JBLA,JBELT,2) &
+ + XRVEL_RE_RB(JROT,JBLA,JBELT,2)*ZTIME, ZORI_MAT_Y)
+ CALL GET_ORI_MAT_Z(XANGINI_ELT_RB(JROT,JBLA,JBELT,3) &
+ + XRVEL_RE_RB(JROT,JBLA,JBELT,3)*ZTIME, ZORI_MAT_Z)
+! Orientation matrix
+ XMAT_RB_RE(JROT,JBLA,JBELT,:,:) = MATMUL(ZORI_MAT_X, MATMUL(ZORI_MAT_Y,ZORI_MAT_Z))
+ XMAT_RG_RE(JROT,JBLA,JBELT,:,:) = MATMUL(XMAT_RG_RB(JROT,JBLA,:,:), XMAT_RB_RE(JROT,JBLA,JBELT,:,:))
+ XMAT_RE_RG(JROT,JBLA,JBELT,:,:) = TRANSPOSE(XMAT_RG_RE(JROT,JBLA,JBELT,:,:))
+!
+!* E.3 Update structural velocities
+! Rotation of elements in RG
+ XRVEL_RE_RG(JROT,JBLA,JBELT,:) = XRVEL_RB_RG(JROT,JBLA,:) &
+ + MATMUL(XMAT_RG_RE(JROT,JBLA,JBELT,:,:),&
+ XRVEL_RE_RB(JROT,JBLA,JBELT,:))
+! Translation of elements in RG
+ ZDIST_BLA_ELT_RG(:) = XPOS_ELT_RG(JROT,JBLA,JBELT,:) - XPOS_BLA_RG(JROT,JBLA,:)
+ XTVEL_ELT_RG(JROT,JBLA,JBELT,:) = XTVEL_BLA_RG(JROT,JBLA,:) &
+ + CROSS(XRVEL_RE_RG(JROT,JBLA,JBELT,:),ZDIST_BLA_ELT_RG(:))
+ XTVEL_ELT_RE(JROT,JBLA,JBELT,:) = MATMUL(XMAT_RE_RG(JROT,JBLA,JBELT,:,:),&
+ XTVEL_ELT_RG(JROT,JBLA,JBELT,:))
+!
+!* E.4 Print in tecplot file
+ IF (LTECOUTPTS) THEN
+ CALL PRINT_TECOUT(ITECOUT, XPOS_ELT_RG(JROT,JBLA,JBELT,:))
+ END IF
+!
+! ---- Leading Edge and Trailing Edge ----
+! It is just to have a tecplot more beautiful
+! For the moment, they are useless for computations
+ IF (LTECOUTPTS) THEN
+! LE.1 Update Positions
+ ZPOS_ELTLE_RE(1) = 0d0
+ ZPOS_ELTLE_RE(2) = - 1d0/4d0 * XCHORD_ELT(JROT,JBLA,JBELT)
+ ZPOS_ELTLE_RE(3) = 0d0
+ ZPOS_ELTTE_RE(1) = 0d0
+ ZPOS_ELTTE_RE(2) = + 3d0/4d0 * XCHORD_ELT(JROT,JBLA,JBELT)
+ ZPOS_ELTTE_RE(3) = 0d0
+!
+ ZPOS_ELTLE_RG(:) = XPOS_ELT_RG(JROT,JBLA,JBELT,:) &
+ + MATMUL(XMAT_RG_RE(JROT,JBLA,JBELT,:,:), &
+ ZPOS_ELTLE_RE(:))
+ ZPOS_ELTTE_RG(:) = XPOS_ELT_RG(JROT,JBLA,JBELT,:) &
+ + MATMUL(XMAT_RG_RE(JROT,JBLA,JBELT,:,:), &
+ ZPOS_ELTTE_RE(:))
+
+!* LE.2 Print in tecplot file
+ CALL PRINT_TECOUT(ITECOUT, ZPOS_ELTLE_RG(:))
+ CALL PRINT_TECOUT(ITECOUT, ZPOS_ELTTE_RG(:))
+ END IF
+!
+!
+ END DO ! Blade element loop
+ END DO ! Blade loop
+END DO ! Rotor loop
+!
+! Closing tec file
+IF (LTECOUTPTS) THEN
+ CLOSE(ITECOUT)
+END IF
+!
+END SUBROUTINE EOL_KINE_ALM
diff --git a/src/MNH/eol_main.f90 b/src/MNH/eol_main.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6b0633c1dec3746119312794abaa4b75c4a16fed
--- /dev/null
+++ b/src/MNH/eol_main.f90
@@ -0,0 +1,284 @@
+!MNH_LIC Copyright 2020-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.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_MAIN
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE EOL_MAIN(KTCOUNT, PTSTEP, &
+ PDXX, PDYY, PDZZ, &
+ PRHODJ, PUT, PVT, PWT, &
+ PRUS, PRVS, PRWS )
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! timestep except
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! mesh size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! wind speed variables
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Sources of Momentum
+!
+END SUBROUTINE EOL_MAIN
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_MAIN
+!
+! ###################################################################
+ SUBROUTINE EOL_MAIN(KTCOUNT, PTSTEP, &
+ PDXX, PDYY, PDZZ, &
+ PRHODJ, PUT, PVT, PWT, &
+ PRUS, PRVS, PRWS )
+! ###################################################################
+!
+!!**** *EOL_MAIN * -
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several models are available. EOL_MAIN is the main subroutine
+!! to compute the aerodynamics of the wind turbine, according to the
+!! model chosen.
+!!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! 21/10/20 Original
+!!
+!!---------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+! To work with wind turbines
+USE MODD_EOL_MAIN
+USE MODI_EOL_ADNR
+USE MODI_EOL_ALM
+USE MODI_EOL_SMEAR
+! To play with MPI
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODE_ll , ONLY: ADD3DFIELD_ll
+USE MODE_ll , ONLY: UPDATE_HALO_ll
+USE MODE_ll , ONLY: CLEANLIST_ll
+! To use some toolkit
+USE MODI_SHUMAN , ONLY: MXF, MYF, MZF
+USE MODI_SHUMAN , ONLY: MXM, MYM, MZM
+!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, NBUDGET_U, NBUDGET_V, NBUDGET_W, tbudgets
+use mode_budget, only: budget_store_init, budget_store_end
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! timestep except
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! mesh size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Wind speed
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Sources of Momentum
+!
+!
+!* 0.2 Declarations of local variables :
+!
+! Pointeurs and exchanges
+TYPE(LIST_ll), POINTER :: TZFIELDS_W_ll ! Field list of Wind for exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS_F_ll ! Field list of aero Forces for exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS_S_ll ! Field list of Smeared aero forces for exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS_R_ll ! Field list of mnh foRces for exchange
+INTEGER :: IINFO ! Info integer
+INTEGER :: IKU ! Vertical size of the domain
+!
+! ABL
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZUT_M, ZVT_M, ZWT_M ! Wind speed at mass point
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHO_M ! Air density at mass point
+!
+!
+!* 0.3 Implicit arguments
+!* From MODD_EOL_MAIN
+! Aerodynamic forces in cartesian mesh
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFX_RG ! Along X in RG frame [F]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFY_RG ! Along Y in RG frame [F]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFZ_RG ! Along Z in RG frame [F]
+! Smeared forces
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFX_SMR_RG ! Along X in RG frame [F]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFY_SMR_RG ! Along Y in RG frame [F]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFZ_SMR_RG ! ALong Z in RG frame [F]
+!
+!* From NAM_EOL namelist
+!CHARACTER(LEN=4) :: CMETH_EOL ! Aerodynamic method
+!CHARACTER(LEN=4) :: CSMEAR ! Type of smearing
+!
+!
+!--------------------------------------------------------
+!
+!* 1. INITIALIZATIONS
+! ---------------
+!
+!* 1.1 Indices
+!
+IKU = SIZE(PUT,3)
+!
+!* 1.2 Pointers
+!
+NULLIFY(TZFIELDS_W_ll)
+NULLIFY(TZFIELDS_F_ll)
+NULLIFY(TZFIELDS_S_ll)
+NULLIFY(TZFIELDS_R_ll)
+!
+!* 1.3 Forces
+!
+XFX_RG(:,:,:) = 0.
+XFY_RG(:,:,:) = 0.
+XFZ_RG(:,:,:) = 0.
+XFX_SMR_RG(:,:,:) = 0.
+XFY_SMR_RG(:,:,:) = 0.
+XFZ_SMR_RG(:,:,:) = 0.
+!
+!
+!-----------------------------------------------------------------------
+!
+!* 2. COMPUTES VELOCITY COMPONENTS AND DENSITY AT MASS POINT
+! ------------------------------------------------------
+!
+!* 2.1 Sharing the input
+!
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,PUT, 'EOL_MAIN::PUT')
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,PWT, 'EOL_MAIN::PWT')
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,PVT, 'EOL_MAIN::PVT')
+CALL UPDATE_HALO_ll(TZFIELDS_W_ll,IINFO)
+CALL CLEANLIST_ll( TZFIELDS_W_ll)
+!
+!* 2.2 Masss point evaluation
+!
+ZUT_M(:,:,:) = MXF( PUT(:,:,:) )
+ZVT_M(:,:,:) = MYF( PVT(:,:,:) )
+ZWT_M(:,:,:) = MZF( PWT(:,:,:) )
+ZRHO_M(:,:,:) = PRHODJ(:,:,:)/(PDXX(:,:,:)*PDYY(:,:,:)*PDZZ(:,:,:))
+!
+!* 2.3 Sharing the new wind
+!
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,ZUT_M, 'EOL_MAIN::ZUT_M')
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,ZWT_M, 'EOL_MAIN::ZWT_M')
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,ZVT_M, 'EOL_MAIN::ZVT_M')
+CALL UPDATE_HALO_ll(TZFIELDS_W_ll,IINFO)
+CALL CLEANLIST_ll( TZFIELDS_W_ll)
+!
+!
+!--------------------------------------------------------
+!
+!* 3. COMPUTES AERODYNAMICS FORCES
+! ----------------------------
+!
+!* 3.1 Model selection
+!
+!
+SELECT CASE(CMETH_EOL)
+!
+ CASE('ADNR') ! Actuator Disc Non-Rotating
+ CALL EOL_ADNR(PDXX, PDYY, PDZZ, &
+ ZRHO_M, &
+ ZUT_M, &
+ XFX_RG )
+!
+ CASE('ALM') ! Actuator Line Method
+ CALL EOL_ALM(KTCOUNT, PTSTEP, &
+ PDXX, PDYY, PDZZ, &
+ ZRHO_M, &
+ ZUT_M, ZVT_M, ZWT_M, &
+ XFX_RG, XFY_RG, XFZ_RG )
+!
+END SELECT
+!
+!* 3.2 Sharing 3D field
+!
+CALL ADD3DFIELD_ll( TZFIELDS_F_ll,XFX_RG, 'EOL_MAIN::XFX_RG' )
+CALL ADD3DFIELD_ll( TZFIELDS_F_ll,XFY_RG, 'EOL_MAIN::XFY_RG' )
+CALL ADD3DFIELD_ll( TZFIELDS_F_ll,XFZ_RG, 'EOL_MAIN::XFZ_RG' )
+CALL UPDATE_HALO_ll(TZFIELDS_F_ll,IINFO)
+CALL CLEANLIST_ll( TZFIELDS_F_ll)
+!
+!
+!--------------------------------------------------------
+!
+!* 4. SMEARING THE FORCES
+! -------------------
+!
+!* 4.1 Smearing technique selection
+!
+SELECT CASE (CSMEAR)
+!
+ CASE( 'NULL' ) ! No smearing
+ XFX_SMR_RG(:,:,:) = XFX_RG(:,:,:)
+ XFY_SMR_RG(:,:,:) = XFY_RG(:,:,:)
+ XFZ_SMR_RG(:,:,:) = XFZ_RG(:,:,:)
+!
+ CASE( '1LIN' ) ! Linear smearing
+ CALL SMEAR_1LIN(XFX_RG, &
+ XFX_SMR_RG)
+!
+ CASE( '3LIN' ) ! Linear smearing
+ CALL SMEAR_3LIN(XFX_RG, &
+ XFY_RG, &
+ XFZ_RG, &
+ XFX_SMR_RG,&
+ XFY_SMR_RG,&
+ XFZ_SMR_RG)
+!
+END SELECT
+!
+!* 4.2 Sharing 3D field
+!
+CALL ADD3DFIELD_ll( TZFIELDS_S_ll,XFX_SMR_RG, 'EOL_MAIN::XFX_SMR_RG' )
+CALL ADD3DFIELD_ll( TZFIELDS_S_ll,XFY_SMR_RG, 'EOL_MAIN::XFY_SMR_RG' )
+CALL ADD3DFIELD_ll( TZFIELDS_S_ll,XFZ_SMR_RG, 'EOL_MAIN::XFZ_SMR_RG' )
+CALL UPDATE_HALO_ll(TZFIELDS_S_ll,IINFO)
+CALL CLEANLIST_ll( TZFIELDS_S_ll)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. ADDING THE FORCES TO THE FIELD
+! ------------------------------
+!
+!* 5.1 Adding them to flux points, rotor->wind
+!
+if (lbudget_u) call Budget_store_init( tbudgets(NBUDGET_U), 'DRAGEOL', prus(:,:,:) )
+if (lbudget_v) call Budget_store_init( tbudgets(NBUDGET_V), 'DRAGEOL', prvs(:,:,:) )
+if (lbudget_w) call Budget_store_init( tbudgets(NBUDGET_W), 'DRAGEOL', prws(:,:,:) )
+!
+PRUS(:,:,:)=PRUS(:,:,:)-MXM(XFX_SMR_RG(:,:,:))
+PRVS(:,:,:)=PRVS(:,:,:)-MYM(XFY_SMR_RG(:,:,:))
+PRWS(:,:,:)=PRWS(:,:,:)-MZM(XFZ_SMR_RG(:,:,:))
+!
+if (lbudget_u) call Budget_store_end( tbudgets(NBUDGET_U), 'DRAGEOL', prus(:,:,:) )
+if (lbudget_v) call Budget_store_end( tbudgets(NBUDGET_V), 'DRAGEOL', prvs(:,:,:) )
+if (lbudget_w) call Budget_store_end( tbudgets(NBUDGET_W), 'DRAGEOL', prws(:,:,:) )
+!
+!
+!* 5.2 Sharing the field
+!
+CALL ADD3DFIELD_ll( TZFIELDS_R_ll,PRUS,'EOL_MAIN::PRUS' )
+CALL ADD3DFIELD_ll( TZFIELDS_R_ll,PRVS,'EOL_MAIN::PRVS' )
+CALL ADD3DFIELD_ll( TZFIELDS_R_ll,PRWS,'EOL_MAIN::PRWS' )
+CALL UPDATE_HALO_ll(TZFIELDS_R_ll,IINFO)
+CALL CLEANLIST_ll( TZFIELDS_R_ll)
+!
+END SUBROUTINE EOL_MAIN
diff --git a/src/MNH/eol_maths.f90 b/src/MNH/eol_maths.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4ef3b31c8df42edddad34759060fe62503c7b4e1
--- /dev/null
+++ b/src/MNH/eol_maths.f90
@@ -0,0 +1,376 @@
+!MNH_LIC Copyright 2018-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.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_MATHS
+! #######################
+!
+INTERFACE
+!
+FUNCTION CROSS(PA, PB)
+ DOUBLE PRECISION, DIMENSION(3) :: CROSS
+ DOUBLE PRECISION, DIMENSION(3), INTENT(IN) :: PA, PB
+END FUNCTION CROSS
+!
+FUNCTION NORM(PA)
+ DOUBLE PRECISION :: NORM
+ DOUBLE PRECISION, DIMENSION(3), INTENT(IN) :: PA
+END FUNCTION NORM
+!
+SUBROUTINE GET_ORI_MAT_X(PTHETA, PORI_MAT_X)
+ DOUBLE PRECISION, INTENT(IN) :: PTHETA ! Angle
+ DOUBLE PRECISION, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_X ! Matrix
+END SUBROUTINE GET_ORI_MAT_X
+!
+SUBROUTINE GET_ORI_MAT_Y(PTHETA, PORI_MAT_Y)
+ DOUBLE PRECISION, INTENT(IN) :: PTHETA ! Angle
+ DOUBLE PRECISION, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_Y ! Matrix
+END SUBROUTINE GET_ORI_MAT_Y
+!
+SUBROUTINE GET_ORI_MAT_Z(PTHETA, PORI_MAT_Z)
+ DOUBLE PRECISION, INTENT(IN) :: PTHETA ! Angle
+ DOUBLE PRECISION, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_Z ! Matrix
+END SUBROUTINE GET_ORI_MAT_Z
+!
+FUNCTION INTERP_SPLCUB(PAV, PX, PY)
+ REAL :: INTERP_SPLCUB ! interface
+ REAL, INTENT(IN) :: PAV ! Abscissa where spline is to be evaluate
+ REAL, DIMENSION(:), INTENT(IN) :: PX, PY
+END FUNCTION INTERP_SPLCUB
+!
+FUNCTION INTERP_LIN8NB(PPOS, KI, KJ, KK, PVAR, PZH)
+ REAL :: INTERP_LIN8NB ! interface
+ REAL, DIMENSION(3), INTENT(IN) :: PPOS ! Position where we want to evaluate
+ INTEGER, INTENT(IN) :: KI, KJ, KK ! Meso-NH cell index
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR,PZH ! Variable to interpolate
+END FUNCTION INTERP_LIN8NB
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_MATHS
+!-------------------------------------------------------------------
+!
+!!**** *EOL_MATHS* -
+!!
+!! PURPOSE
+!! -------
+!! Some usefull tools for wind turbine study
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! 04/2018 Original
+!!
+!!---------------------------------------------------------------
+!#########################################################
+FUNCTION CROSS(PA, PB)
+! Vectorial product 3D : PA * PB
+!
+ DOUBLE PRECISION, DIMENSION(3) :: CROSS
+ DOUBLE PRECISION, DIMENSION(3), INTENT(IN) :: PA, PB
+!
+ CROSS(1) = PA(2) * PB(3) - PA(3) * PB(2)
+ CROSS(2) = PA(3) * PB(1) - PA(1) * PB(3)
+ CROSS(3) = PA(1) * PB(2) - PA(2) * PB(1)
+!
+END FUNCTION CROSS
+!#########################################################
+!
+!#########################################################
+FUNCTION NORM(PA)
+! Eulerian norm of 3D vector :
+!
+ DOUBLE PRECISION :: NORM
+ DOUBLE PRECISION, DIMENSION(3), INTENT(IN) :: PA
+!
+ NORM = SQRT( PA(1)**2 + PA(2)**2 + PA(3)**2 )
+!
+END FUNCTION NORM
+!
+!
+!#########################################################
+SUBROUTINE GET_ORI_MAT_X(PTHETA, PORI_MAT_X)
+! Rotation matrix of PTHETA angle around X
+!
+ DOUBLE PRECISION, INTENT(IN) :: PTHETA ! Angle
+ DOUBLE PRECISION, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_X ! Matrix
+!
+ PORI_MAT_X (1,1) = 1d0
+ PORI_MAT_X (1,2) = 0d0
+ PORI_MAT_X (1,3) = 0d0
+ PORI_MAT_X (2,1) = 0d0
+ PORI_MAT_X (2,2) = +COS(PTHETA)
+ PORI_MAT_X (2,3) = -SIN(PTHETA)
+ PORI_MAT_X (3,1) = 0d0
+ PORI_MAT_X (3,2) = +SIN(PTHETA)
+ PORI_MAT_X (3,3) = +COS(PTHETA)
+!
+END SUBROUTINE GET_ORI_MAT_X
+!#########################################################
+!
+!#########################################################
+SUBROUTINE GET_ORI_MAT_Y(PTHETA, PORI_MAT_Y)
+! Rotation matrix of PTHETA angle around Y
+!
+ DOUBLE PRECISION, INTENT(IN) :: PTHETA ! Angle
+ DOUBLE PRECISION, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_Y ! Matrix
+!
+ PORI_MAT_Y (1,1) = +COS(PTHETA)
+ PORI_MAT_Y (1,2) = 0d0
+ PORI_MAT_Y (1,3) = +SIN(PTHETA)
+ PORI_MAT_Y (2,1) = 0d0
+ PORI_MAT_Y (2,2) = 1d0
+ PORI_MAT_Y (2,3) = 0d0
+ PORI_MAT_Y (3,1) = -SIN(PTHETA)
+ PORI_MAT_Y (3,2) = 0d0
+ PORI_MAT_Y (3,3) = +COS(PTHETA)
+!
+END SUBROUTINE GET_ORI_MAT_Y
+!#########################################################
+!
+!#########################################################
+SUBROUTINE GET_ORI_MAT_Z(PTHETA, PORI_MAT_Z)
+! Rotation matrix of PTHETA angle around Z
+!
+ DOUBLE PRECISION, INTENT(IN) :: PTHETA ! Angle
+ DOUBLE PRECISION, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_Z ! Matrix
+!
+ PORI_MAT_Z (1,1) = +COS(PTHETA)
+ PORI_MAT_Z (1,2) = -SIN(PTHETA)
+ PORI_MAT_Z (1,3) = 0d0
+ PORI_MAT_Z (2,1) = +SIN(PTHETA)
+ PORI_MAT_Z (2,2) = +COS(PTHETA)
+ PORI_MAT_Z (2,3) = 0d0
+ PORI_MAT_Z (3,1) = 0d0
+ PORI_MAT_Z (3,2) = 0d0
+ PORI_MAT_Z (3,3) = 1d0
+!
+END SUBROUTINE GET_ORI_MAT_Z
+!#########################################################
+!
+!#########################################################
+FUNCTION INTERP_SPLCUB(PAV, PX, PY)
+! adapted from https://ww2.odu.edu/~agodunov/computing/programs/book2/Ch01/spline.f90
+!
+IMPLICIT NONE
+REAL, INTENT(IN) :: PAV ! Abscissa where spline is to be evaluate
+REAL, DIMENSION(:), INTENT(IN) :: PX, PY
+!
+INTEGER :: INBVAL ! Nb points of data
+REAL, ALLOCATABLE :: ZCOEF1(:),ZCOEF2(:),ZCOEF3(:) ! Coefficients
+!
+INTEGER :: II, IJ, IBOT, ITOP, IMID
+REAL :: ZH
+REAL :: PDX
+REAL :: INTERP_SPLCUB ! function
+!
+! --------- Intialisations ---------
+INBVAL = SIZE(PX)
+ALLOCATE(ZCOEF1(INBVAL))
+ALLOCATE(ZCOEF2(INBVAL))
+ALLOCATE(ZCOEF3(INBVAL))
+!
+! --------- Calculs des coefficients ---------
+!
+! - Check size of input data
+IF (INBVAL < 2 ) THEN
+ RETURN
+END IF
+IF (INBVAL < 3 ) THEN
+ ZCOEF1(1) = (PY(2)-PY(1))/(PX(2)-PX(1))
+ ZCOEF2(1) = 0.
+ ZCOEF3(1) = 0.
+ ZCOEF1(2) = ZCOEF1(1)
+ ZCOEF2(2) = 0.
+ ZCOEF3(2) = 0.
+ RETURN
+END IF
+!
+! - Preliminaries
+ZCOEF3(1) = PX(2) - PX(1)
+ZCOEF2(2) = (PY(2) - PY(1))/ZCOEF3(1)
+DO II = 2, INBVAL-1
+ ZCOEF3(II) = PX(II+1) - PX(II)
+ ZCOEF1(II) = 2.0 * (ZCOEF3(II-1) + ZCOEF3(II))
+ ZCOEF2(II+1) = (PY(II+1) - PY(II))/ZCOEF3(II)
+ ZCOEF2(II) = ZCOEF2(II+1) - ZCOEF2(II)
+END DO
+!
+! - Boundaries
+ZCOEF1(1) = - ZCOEF3(1)
+ZCOEF1(INBVAL) = - ZCOEF3(INBVAL-1)
+ZCOEF2(1) = 0.0
+ZCOEF2(INBVAL) = 0.0
+IF (INBVAL /= 3) THEN
+ ZCOEF2(1) = ZCOEF2(3)/(PX(4)-PX(2)) - ZCOEF2(2)/(PX(3)-PX(1))
+ ZCOEF2(INBVAL) = ZCOEF2(INBVAL-1)/(PX(INBVAL)-PX(INBVAL-2)) &
+ -ZCOEF2(INBVAL-2)/(PX(INBVAL-1)-PX(INBVAL-3))
+ ZCOEF2(1) = ZCOEF2(1)*ZCOEF3(1)**2 / (PX(4)-PX(1))
+ ZCOEF2(INBVAL) =-ZCOEF2(INBVAL)*ZCOEF3(INBVAL-1)**2/(PX(INBVAL)-PX(INBVAL-3))
+END IF
+!
+! - Forward elemination
+DO II = 2, INBVAL
+ ZH = ZCOEF3(II-1)/ZCOEF1(II-1)
+ ZCOEF1(II) = ZCOEF1(II) - ZH*ZCOEF3(II-1)
+ ZCOEF2(II) = ZCOEF2(II) - ZH*ZCOEF2(II-1)
+END DO
+!
+! - Back substitution
+ZCOEF2(INBVAL) = ZCOEF2(INBVAL)/ZCOEF1(INBVAL)
+DO IJ = 1, INBVAL-1
+ II = INBVAL-IJ
+ ZCOEF2(II) = (ZCOEF2(II) - ZCOEF3(II)*ZCOEF2(II+1))/ZCOEF1(II)
+END DO
+!
+! - Spline coefficient calculations
+ZCOEF1(INBVAL) = (PY(INBVAL) - PY(INBVAL-1))/ZCOEF3(INBVAL-1) &
+ + ZCOEF3(INBVAL-1)*(ZCOEF2(INBVAL-1) + 2.0*ZCOEF2(INBVAL))
+DO II = 1, INBVAL-1
+ ZCOEF1(II) = (PY(II+1) - PY(II))/ZCOEF3(II) &
+ - ZCOEF3(II)*(ZCOEF2(II+1) + 2.0*ZCOEF2(II))
+ ZCOEF3(II) = (ZCOEF2(II+1) - ZCOEF2(II))/ZCOEF3(II)
+ ZCOEF2(II) = 3.0*ZCOEF2(II)
+END DO
+ZCOEF2(INBVAL) = 3.0*ZCOEF2(INBVAL)
+ZCOEF3(INBVAL) = ZCOEF3(INBVAL-1)
+
+! --------- Spline cubic interpolation ---------
+
+! If the absciss PAV is out of range
+! The ordinate will be the limit value (left or right)
+IF (PAV <= PX(1)) THEN
+ INTERP_SPLCUB = PY(1)
+ RETURN
+END IF
+IF (PAV >= PX(INBVAL)) THEN
+ INTERP_SPLCUB = PY(INBVAL)
+ RETURN
+END IF
+
+! Dichotomie research for IBOT, tq : PX(IBOT) <= PAV <= PX(IBOT+1)
+IBOT = 1
+ITOP = INBVAL +1
+DO WHILE (ITOP > IBOT+1)
+ IMID = (IBOT + ITOP)/2
+ IF (PAV < PX(IMID)) THEN
+ ITOP = IMID
+ ELSE
+ IBOT = IMID
+ END IF
+END DO
+
+! Evaluation of spline interpolation
+PDX = PAV - PX(IBOT)
+INTERP_SPLCUB = PY(IBOT)+PDX*(ZCOEF1(IBOT)+PDX*(ZCOEF2(IBOT)+PDX*ZCOEF3(IBOT)))
+
+! Endings
+DEALLOCATE(ZCOEF1)
+DEALLOCATE(ZCOEF2)
+DEALLOCATE(ZCOEF3)
+
+END FUNCTION INTERP_SPLCUB
+!#########################################################
+!
+!#########################################################
+FUNCTION INTERP_LIN8NB(PPOS, KI, KJ, KK, PVAR, PZH)
+!
+USE MODD_GRID_n, ONLY: XXHAT,XYHAT
+!
+REAL :: INTERP_LIN8NB ! Return
+REAL, DIMENSION(3), INTENT(IN) :: PPOS ! Position where we want to evaluate
+INTEGER, INTENT(IN) :: KI, KJ, KK ! Meso-NH cell index
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR ! Variable to interpolate
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZH ! Vertical height to interpolate
+!
+INTEGER :: IIP, IJP, IKP ! Previous cell index : P = i + 1
+INTEGER :: IIN, IJN, IKN ! Next cell index : N = i - 1
+!
+REAL :: ZUXNN, ZUXNP, ZUXPP, ZUXPN ! Interpolated variables (VAR) in X plane (VAR = A*POS + B)
+!
+REAL :: ZHXNN, ZHXNP, ZHXPP, ZHXPN ! Interpotaled variables (VAR) in X plane (VAR = A*POS + B)
+!
+REAL :: ZUXN, ZUXP ! Interpolated variables (VAR) in Y plance (VAR = A*POS + B)
+!
+!
+REAL :: ZALPHAX, ZALPHAY, ZALPHAZ ! Interpolated variables (VAR) in Z plane (VAR = A*POS + B)
+
+REAL :: ZUX ! Interpolated variable (VAR) in Z plane (VAR = A*POS + B)
+!
+! -----------------------------------------------
+!
+! FINDING 8 NEIGHBOORS
+! -- X axis
+IF (PPOS(1) <= 0.5*(XXHAT(KI)+XXHAT(KI+1))) THEN
+ IIP = KI - 1
+ IIN = KI
+ELSE
+ IIP = KI
+ IIN = KI + 1
+END IF
+! -- Y axis
+IF (PPOS(2) <= 0.5*((XYHAT(KJ)+XYHAT(KJ+1)))) THEN
+ IJP = KJ - 1
+ IJN = KJ
+ELSE
+ IJP = KJ
+ IJN = KJ + 1
+END IF
+! -- Z axis
+IF (PPOS(3) <= PZH(KI,KJ,KK)) THEN
+ IKP = KK - 1
+ IKN = KK
+ELSE
+ IKP = KK
+ IKN = KK + 1
+END IF
+!
+! INTERPOLATION
+! -- Along X
+! -- -- Alpha
+ZALPHAX = (PPOS(1) - 0.5*(XXHAT(IIP)+XXHAT(IIN))) / (XXHAT(IIN) - XXHAT(IIP))
+!!PRINT*, "ZALPHAX = ", ZALPHAX
+! -- -- -- Wind
+! -- -- Interpolated variable in temporary plane X
+ZUXNN = (1-ZALPHAX)*PVAR(IIP,IJN,IKN) + ZALPHAX*PVAR(IIN,IJN,IKN)
+ZUXNP = (1-ZALPHAX)*PVAR(IIP,IJN,IKP) + ZALPHAX*PVAR(IIN,IJN,IKP)
+ZUXPP = (1-ZALPHAX)*PVAR(IIP,IJP,IKP) + ZALPHAX*PVAR(IIN,IJP,IKP)
+ZUXPN = (1-ZALPHAX)*PVAR(IIP,IJP,IKN) + ZALPHAX*PVAR(IIN,IJP,IKN)
+! -- -- -- Height
+ZHXNN = (1-ZALPHAX)*PZH(IIP,IJN,IKN) + ZALPHAX*PZH(IIN,IJN,IKN)
+ZHXNP = (1-ZALPHAX)*PZH(IIP,IJN,IKP) + ZALPHAX*PZH(IIN,IJN,IKP)
+ZHXPP = (1-ZALPHAX)*PZH(IIP,IJP,IKP) + ZALPHAX*PZH(IIN,IJP,IKP)
+ZHXPN = (1-ZALPHAX)*PZH(IIP,IJP,IKN) + ZALPHAX*PZH(IIN,IJP,IKN)
+!
+!
+! -- Along Y
+! -- -- Alpha
+ZALPHAY = (PPOS(2) - 0.5*(XYHAT(IJP)+XYHAT(IJN))) / (XYHAT(IJN) - XYHAT(IJP))
+!PRINT*, "ZALPHAY = ", ZALPHAY
+! -- -- Interpolated variable in temporary plane Y
+! -- -- -- Wind
+ZUXN = (1-ZALPHAY)*ZUXPN + ZALPHAY*ZUXNN
+ZUXP = (1-ZALPHAY)*ZUXPP + ZALPHAY*ZUXNP
+! -- -- -- Height
+ZHXN = (1-ZALPHAY)*ZHXPN + ZALPHAY*ZHXNN
+ZHXP = (1-ZALPHAY)*ZHXPP + ZALPHAY*ZHXNP
+!
+!
+! -- Along Z
+! -- -- Alpha Z
+ZALPHAZ = (PPOS(3) - ZHXP) / (ZHXN - ZHXP)
+!PRINT*, "ZALPHAZ = ", ZALPHAZ
+ZUX = (1 - ZALPHAZ)*ZUXP + ZALPHAZ*ZUXN
+!
+!
+INTERP_LIN8NB = ZUX
+!
+!
+!
+END FUNCTION INTERP_LIN8NB
+!#########################################################
diff --git a/src/MNH/eol_printer.f90 b/src/MNH/eol_printer.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b4fe7281673df7ba6b9000ed4353c7430db48423
--- /dev/null
+++ b/src/MNH/eol_printer.f90
@@ -0,0 +1,357 @@
+!MNH_LIC Copyright 2020-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.
+!-----------------------------------------------------------------
+! #########################
+ MODULE MODI_EOL_PRINTER
+! #########################
+!
+INTERFACE
+!
+! ****
+! ADNR
+! ****
+!
+SUBROUTINE PRINT_DATA_FARM_ADNR(KFILE,TPFARM)
+ USE MODD_EOL_ADNR, ONLY: FARM
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(FARM), INTENT(IN) :: TPFARM ! stored farm data
+END SUBROUTINE PRINT_DATA_FARM_ADNR
+!
+SUBROUTINE PRINT_DATA_TURBINE_ADNR(KFILE,TPTURBINE)
+ USE MODD_EOL_ADNR, ONLY : TURBINE
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+END SUBROUTINE PRINT_DATA_TURBINE_ADNR
+!
+! ***
+! ALM
+! ***
+!
+SUBROUTINE PRINT_DATA_FARM_ALM(KFILE,TPFARM)
+ USE MODD_EOL_ALM, ONLY: FARM
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(FARM), INTENT(IN) :: TPFARM ! stored farm data
+END SUBROUTINE PRINT_DATA_FARM_ALM
+!
+SUBROUTINE PRINT_DATA_TURBINE_ALM(KFILE,TPTURBINE)
+ USE MODD_EOL_ALM, ONLY : TURBINE
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+END SUBROUTINE PRINT_DATA_TURBINE_ALM
+!
+SUBROUTINE PRINT_DATA_BLADE_ALM(KFILE,TPBLADE)
+ USE MODD_EOL_ALM, ONLY : BLADE
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(BLADE), INTENT(IN) :: TPBLADE ! stored blade data
+END SUBROUTINE PRINT_DATA_BLADE_ALM
+!
+SUBROUTINE PRINT_DATA_AIRFOIL_ALM(KFILE,TPAIRFOIL)
+ USE MODD_EOL_ALM, ONLY : AIRFOIL
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(AIRFOIL), DIMENSION(:), INTENT(IN) :: TPAIRFOIL ! stored airfoil data
+END SUBROUTINE PRINT_DATA_AIRFOIL_ALM
+!
+SUBROUTINE OPEN_TECOUT(KFILE, KTCOUNT, KTSUBCOUNT)
+ INTEGER, INTENT(IN) :: KFILE ! File index
+ INTEGER, INTENT(IN) :: KTCOUNT ! Time step index
+ INTEGER, INTENT(IN) :: KTSUBCOUNT ! Subtime step index
+END SUBROUTINE OPEN_TECOUT
+!
+SUBROUTINE PRINT_TECOUT(KFILE,PVAR)
+ INTEGER, INTENT(IN) :: KFILE ! File index
+ REAL, DIMENSION(3), INTENT(IN) :: PVAR ! Vector to plot
+END SUBROUTINE PRINT_TECOUT
+!
+SUBROUTINE PRINT_TSPLIT(KNBSUBCOUNT,PTSUBSTEP)
+ INTEGER, INTENT(IN) :: KNBSUBCOUNT ! splitting value
+ REAL, INTENT(IN) :: PTSUBSTEP ! sub timestep
+END SUBROUTINE PRINT_TSPLIT
+!
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_PRINTER
+!-------------------------------------------------------------------
+!
+!!**** *EOL_PRINT* -
+!!
+!! PURPOSE
+!! -------
+!! Some usefull subs to print wind turbine's datas
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/10/2020
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_FARM_ADNR(KFILE,TPFARM)
+!
+USE MODD_EOL_ADNR, ONLY : FARM
+USE MODD_EOL_SHARED_IO, ONLY : CFARM_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(FARM), INTENT(IN) :: TPFARM ! dummy stored farm data
+!
+INTEGER :: JROT ! Loop index
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '======================== WIND TURBINE DATA ========================'
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '---- Farm ----'
+ WRITE(KFILE,*) 'Data from file : ', TRIM(CFARM_CSVDATA)
+ WRITE(KFILE,*) 'Number of turbines : ', TPFARM%NNB_TURBINES
+ WRITE(KFILE,*) 'Positions [m] and thrust coef [-] : '
+ DO JROT=1, TPFARM%NNB_TURBINES
+ WRITE(KFILE,'(1X,A,I3,A,F10.1,A,F10.1,A,F10.3)') 'n.', JROT,&
+ ' : X = ', TPFARM%XPOS_X(JROT),&
+ ' ; Y = ', TPFARM%XPOS_Y(JROT),&
+ ' ; CT_inf = ', TPFARM%XCT_INF(JROT)
+ END DO
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_FARM_ADNR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_TURBINE_ADNR(KFILE,TPTURBINE)
+!
+USE MODD_EOL_ADNR, ONLY : TURBINE
+USE MODD_EOL_SHARED_IO, ONLY : CTURBINE_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! dummy stored turbine data
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) '---- Turbine ----'
+ WRITE(KFILE,* ) 'Data from file : ', TRIM(CTURBINE_CSVDATA)
+ WRITE(KFILE,'(1X,A,A10)' ) 'Wind turbine : ', TPTURBINE%CNAME
+ WRITE(KFILE,'(1X,A,F10.1)') 'Hub height [m] : ', TPTURBINE%XH_HEIGHT
+ WRITE(KFILE,'(1X,A,F10.3)') 'Blade radius [m] : ', TPTURBINE%XR_MAX
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '==================================================================='
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_TURBINE_ADNR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_FARM_ALM(KFILE,TPFARM)
+!
+USE MODD_EOL_ALM, ONLY : FARM
+USE MODD_EOL_SHARED_IO, ONLY : CFARM_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(FARM), INTENT(IN) :: TPFARM ! dummy stored farm data
+!
+INTEGER :: JROT ! Loop index
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '======================== WIND TURBINE DATA ========================'
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '---- Farm ----'
+ WRITE(KFILE,*) 'Data from file : ', TRIM(CFARM_CSVDATA)
+ WRITE(KFILE,*) 'Number of turbines : ', TPFARM%NNB_TURBINES
+ WRITE(KFILE,*) 'Tower base positions (X,Y) [m] : '
+ DO JROT=1, TPFARM%NNB_TURBINES
+ WRITE(KFILE, '(1X,A,I3,A,F10.1,A,F10.1,A)') 'n.', JROT,&
+ ': (', TPFARM%XPOS_X(JROT),',',TPFARM%XPOS_Y(JROT),')'
+ END DO
+ WRITE(KFILE,*) 'Working state (rad/s,rad,rad) : '
+ DO JROT=1, TPFARM%NNB_TURBINES
+ WRITE(KFILE, '(1X,A,I3,A,F10.5,A,F10.5,A,F10.5)') 'n.', JROT,&
+ ': Omega = ', TPFARM%XOMEGA(JROT), &
+ ' ; Yaw = ', TPFARM%XNAC_YAW(JROT),&
+ ' ; Pitch = ', TPFARM%XBLA_PITCH(JROT)
+ END DO
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_FARM_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_TURBINE_ALM(KFILE,TPTURBINE)
+!
+USE MODD_EOL_ALM, ONLY : TURBINE
+USE MODD_EOL_SHARED_IO, ONLY : CTURBINE_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! dummy stored turbine data
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) '---- Turbine ----'
+ WRITE(KFILE,* ) 'Data from file : ', TRIM(CTURBINE_CSVDATA)
+ WRITE(KFILE,'(1X,A,A10)' ) 'Wind turbine : ', TPTURBINE%CNAME
+ WRITE(KFILE,'(1X,A,I10)' ) 'Number of blades : ', TPTURBINE%NNB_BLADES
+ WRITE(KFILE,'(1X,A,F10.1)') 'Hub height [m] : ', TPTURBINE%XH_HEIGHT
+ WRITE(KFILE,'(1X,A,F10.3)') 'Blade min radius [m] : ', TPTURBINE%XR_MIN
+ WRITE(KFILE,'(1X,A,F10.3)') 'Blade max radius [m] : ', TPTURBINE%XR_MAX
+ WRITE(KFILE,'(1X,A,F10.3)') 'Nacelle tilt [rad] : ', TPTURBINE%XNAC_TILT
+ WRITE(KFILE,'(1X,A,F10.3)') 'Hub deport [m] : ', TPTURBINE%XH_DEPORT
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_TURBINE_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_BLADE_ALM(KFILE,TPBLADE)
+!
+USE MODD_EOL_ALM, ONLY : BLADE
+USE MODD_EOL_SHARED_IO, ONLY : CBLADE_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(BLADE), INTENT(IN) :: TPBLADE ! dummy stored blade data
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) '---- Blade ----'
+ WRITE(KFILE,* ) 'Data from file : ', TRIM(CBLADE_CSVDATA)
+ WRITE(KFILE,'(1X,A,I10)' ) 'Nb of data (from data file) : ', TPBLADE%NNB_BLADAT
+ WRITE(KFILE,'(1X,A,F10.1)') 'First node radius [m] : ', TPBLADE%XRAD(1)
+ WRITE(KFILE,'(1X,A,F10.1)') 'Last node radius [m] : ', TPBLADE%XRAD(TPBLADE%NNB_BLADAT)
+ WRITE(KFILE,'(1X,A,F10.1)') 'Chord max. [m] : ', MAXVAL(TPBLADE%XCHORD(:))
+ WRITE(KFILE,'(1X,A,I10)' ) 'Nb of blade element (from nam) : ', TPBLADE%NNB_BLAELT
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_BLADE_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_AIRFOIL_ALM(KFILE,TPAIRFOIL)
+!
+USE MODD_EOL_ALM, ONLY : AIRFOIL
+USE MODD_EOL_SHARED_IO, ONLY : CAIRFOIL_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(AIRFOIL), DIMENSION(:), INTENT(IN) :: TPAIRFOIL ! dummy stored airfoil data
+!
+INTEGER :: JA
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) '---- Airfoils ----'
+ WRITE(KFILE,* ) 'Data from file : ', TRIM(CAIRFOIL_CSVDATA)
+ WRITE(KFILE,'(1X,A,I10)' ) 'Nb of airfoils (from data file) : ', SIZE(TPAIRFOIL)
+ WRITE(KFILE,'(1X,A)' ) 'Different airfoils : '
+ DO JA=1,SIZE(TPAIRFOIL)
+ WRITE(KFILE,'(1X,A,I3,A,A)') 'Airfoil n.', JA,&
+ ': ', TPAIRFOIL(JA)%CNAME
+ END DO
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '==================================================================='
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_AIRFOIL_ALM
+!#########################################################
+!
+!
+!#########################################################
+SUBROUTINE OPEN_TECOUT(KFILE, KTCOUNT, KTSUBCOUNT)
+!
+USE MODD_EOL_ALM, ONLY:TFARM,TTURBINE,TBLADE
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(OUT) :: KFILE ! File index
+INTEGER, INTENT(IN) :: KTCOUNT ! Time step index
+INTEGER, INTENT(IN) :: KTSUBCOUNT ! Subtime step index
+!
+INTEGER :: INB_WT, INB_B, INB_BELT ! Total numbers of wind turbines, blades, and blade elt
+INTEGER :: INB_TELT, INB_NELT ! Total numbers of tower elt, and nacelle elt
+INTEGER :: ITOTELT ! Total number of points
+!
+CHARACTER(LEN=1024) :: HFILE ! File name
+!
+INB_WT = TFARM%NNB_TURBINES
+INB_B = TTURBINE%NNB_BLADES
+INB_BELT = TBLADE%NNB_BLAELT
+! Hard coded variables, but they will be useful in next updates
+INB_TELT = 2
+INB_NELT = 2
+!
+ITOTELT = INB_WT*(INB_TELT+INB_NELT+INB_B*(1+INB_BELT*3))
+!
+! File name and opening
+WRITE(HFILE, "(A18,I4.4,I2.2,A3)") "Tecplot2.0_Output_", KTCOUNT, KTSUBCOUNT,".tp"
+OPEN( NEWUNIT=KFILE, file=HFILE, form="FORMATTED")
+!
+! Tecplot Header
+WRITE(KFILE,*) 'TITLE="Wind Turbines Points"'
+WRITE(KFILE,*) 'VARIABLES="X" "Y" "Z"'
+WRITE(KFILE,*) 'ZONE I=',ITOTELT,' J=3 K=1 DATAPACKING=POINT'
+!
+END SUBROUTINE OPEN_TECOUT
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_TECOUT(KFILE,PVAR)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KFILE ! File index
+REAL, DIMENSION(3), INTENT(IN) :: PVAR ! Vector to plot
+!
+! It plots two points, slightly different, to get a thickness
+!
+WRITE(KFILE,*) PVAR(1), &
+ PVAR(2), &
+ PVAR(3)
+!
+END SUBROUTINE PRINT_TECOUT
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_TSPLIT(KNBSUBCOUNT,PTSUBSTEP)
+USE MODD_LUNIT_n , ONLY: TLUOUT
+!
+INTEGER, INTENT(IN) :: KNBSUBCOUNT ! splitting value
+REAL, INTENT(IN) :: PTSUBSTEP ! sub-time step
+!
+WRITE(TLUOUT%NLU,'(A)') 'From EOL - Actuator Line Model. Time-splitting is activated:'
+WRITE(TLUOUT%NLU,'(1X,A,I2)') 'Number of splitting: ', KNBSUBCOUNT
+WRITE(TLUOUT%NLU,'(1X,A,F6.4)') 'Sub-time step value: ', PTSUBSTEP
+!
+END SUBROUTINE PRINT_TSPLIT
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_ERROR_WTCFL(KFILE,PMAXTSTEP)
+INTEGER, INTENT(IN) :: KFILE ! output file
+REAL, INTENT(IN) :: PMAXTSTEP ! maximum acceptable time-step
+WRITE(KFILE,'(A,A,A,A,A,F10.8,A)') &
+ 'Sorry but I had to stop the simulation. ' ,&
+ 'The time step XTSTEP is too high: ' ,&
+ 'the blades can jump over one or several cells. ' ,&
+ 'Please, turn on the time-splitting method (LTIMESPLIT=.TRUE.), ',&
+ 'or decrease XTSTEP to a value lower than ', PMAXTSTEP, ' sec.'
+END SUBROUTINE PRINT_ERROR_WTCFL
+!
diff --git a/src/MNH/eol_reader.f90 b/src/MNH/eol_reader.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8d5ecc6cfea05ea462138d0f8472d23083e0d7ce
--- /dev/null
+++ b/src/MNH/eol_reader.f90
@@ -0,0 +1,670 @@
+!MNH_LIC Copyright 2018-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.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_READER
+! #######################
+!
+INTERFACE
+!
+! ADNR
+!
+SUBROUTINE READ_CSVDATA_FARM_ADNR(HFILE,TPFARM)
+ USE MODD_EOL_ADNR, ONLY: FARM
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(FARM), INTENT(OUT) :: TPFARM ! stored farm data
+END SUBROUTINE READ_CSVDATA_FARM_ADNR
+!
+SUBROUTINE READ_CSVDATA_TURBINE_ADNR(HFILE,TPTURBINE)
+ USE MODD_EOL_ADNR, ONLY : TURBINE
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(TURBINE), INTENT(OUT) :: TPTURBINE ! stored turbine data
+END SUBROUTINE READ_CSVDATA_TURBINE_ADNR
+!
+! ALM
+!
+SUBROUTINE READ_CSVDATA_FARM_ALM(HFILE,TPFARM)
+ USE MODD_EOL_ALM, ONLY: FARM
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(FARM), INTENT(OUT) :: TPFARM ! stored farm data
+END SUBROUTINE READ_CSVDATA_FARM_ALM
+!
+SUBROUTINE READ_CSVDATA_TURBINE_ALM(HFILE,TPTURBINE)
+ USE MODD_EOL_ALM, ONLY : TURBINE
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(TURBINE), INTENT(OUT) :: TPTURBINE ! stored turbine data
+END SUBROUTINE READ_CSVDATA_TURBINE_ALM
+
+SUBROUTINE READ_CSVDATA_BLADE_ALM(HFILE,TPTURBINE,TPBLADE)
+ USE MODD_EOL_ALM, ONLY : TURBINE, BLADE
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+ TYPE(BLADE), INTENT(OUT) :: TPBLADE ! stored blade data
+END SUBROUTINE READ_CSVDATA_BLADE_ALM
+!
+SUBROUTINE READ_CSVDATA_AIRFOIL_ALM(HFILE,TPBLADE,TPAIRFOIL)
+ USE MODD_EOL_ALM, ONLY : BLADE, AIRFOIL
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(BLADE), INTENT(IN) :: TPBLADE ! stored blade data (to select airfoils)
+ TYPE(AIRFOIL), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: TPAIRFOIL ! stored airfoil data
+END SUBROUTINE READ_CSVDATA_AIRFOIL_ALM
+!
+SUBROUTINE HOW_MANY_LINES_OF(KLUNAM,HFILE,HNAME,KLINE)
+ INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! turbine's name
+ INTEGER, INTENT(OUT) :: KLINE
+END SUBROUTINE HOW_MANY_LINES_OF
+!
+FUNCTION GET_AIRFOIL_ID(TPTURBINE,TPBLADE,TPAIRFOIL,PRADIUS)
+ USE MODD_EOL_ALM, ONLY : TURBINE, BLADE, AIRFOIL
+ IMPLICIT NONE
+ INTEGER :: GET_AIRFOIL_ID
+ TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+ TYPE(BLADE), INTENT(IN) :: TPBLADE ! stored blade data
+ TYPE(AIRFOIL), DIMENSION(:), INTENT(IN) :: TPAIRFOIL ! stored airfoil data
+ REAL, INTENT(IN) :: PRADIUS ! Radius position studied
+END FUNCTION GET_AIRFOIL_ID
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_READER
+!-------------------------------------------------------------------
+!
+!!**** *EOL_READER* -
+!!
+!! PURPOSE
+!! -------
+!! Some usefull subs to read wind turbine's datas
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/2018
+!! Modification 21/10/20 (PA. Joulin) Updated for a main version
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_FARM_ADNR(HFILE,TPFARM)
+!
+USE MODD_EOL_ADNR, ONLY: FARM
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(FARM), INTENT(OUT) :: TPFARM ! dummy stored data blade
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBLINE ! Nb of line in csv file
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+! Read data
+REAL :: ZPOS_X
+REAL :: ZPOS_Y
+REAL :: ZCT_INF
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Opening the file
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+! Counting number of line
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+IF (INBLINE < 2) THEN
+ CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
+ELSE
+ ! Saving number of wind turbine
+ TPFARM%NNB_TURBINES = INBLINE - 1
+ ! Allocations
+ ALLOCATE(TPFARM%XPOS_X(TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XPOS_Y(TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XCT_INF(TPFARM%NNB_TURBINES))
+ !
+ ! New read
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
+ !
+ ! Saving data
+ DO INBLINE=1, TPFARM%NNB_TURBINES
+ READ(ILU,FMT='(A400)') YSTRING
+ READ(YSTRING,*) ZPOS_X, ZPOS_Y, ZCT_INF
+ TPFARM%XPOS_X(INBLINE) = ZPOS_X
+ TPFARM%XPOS_Y(INBLINE) = ZPOS_Y
+ TPFARM%XCT_INF(INBLINE) = ZCT_INF
+ END DO
+ CLOSE(ILU)
+ RETURN
+END IF
+!
+END SUBROUTINE READ_CSVDATA_FARM_ADNR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_TURBINE_ADNR(HFILE,TPTURBINE)
+!
+USE MODD_EOL_ADNR, ONLY: TURBINE
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(TURBINE), INTENT(OUT) :: TPTURBINE ! dummy stored data turbine
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBLINE ! Nb of line in csv file
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+CHARACTER(LEN=80) :: YWT_NAME
+REAL :: ZH_HEIGHT
+REAL :: ZR_MAX
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Opening
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+!
+! Counting number of line
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+IF (INBLINE /= 2) THEN
+ CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
+ELSE
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
+ READ(ILU,FMT='(A400)') YSTRING ! Reading next line
+ ! Read data
+ READ(YSTRING,*) YWT_NAME, ZH_HEIGHT, ZR_MAX ! reading data
+ TPTURBINE%CNAME = YWT_NAME ! Saving them
+ TPTURBINE%XH_HEIGHT = ZH_HEIGHT
+ TPTURBINE%XR_MAX = ZR_MAX
+ REWIND(ILU) ! Rembobinage, plutôt 2 fois qu'1 !
+ RETURN
+ CLOSE(ILU)
+END IF
+!
+END SUBROUTINE READ_CSVDATA_TURBINE_ADNR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_FARM_ALM(HFILE,TPFARM)
+!
+USE MODD_EOL_ALM, ONLY: FARM
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(FARM), INTENT(OUT) :: TPFARM ! dummy stored data blade
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBLINE ! Nb of line in csv file
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+! Read data
+REAL :: ZPOS_X
+REAL :: ZPOS_Y
+REAL :: ZOMEGA
+REAL :: ZYAW
+REAL :: ZPITCH
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Opening the file
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+! Counting number of line
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+IF (INBLINE < 2) THEN
+ CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
+ELSE
+ ! Saving number of wind turbine
+ TPFARM%NNB_TURBINES = INBLINE - 1
+ ! Allocations
+ ALLOCATE(TPFARM%XPOS_X (TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XPOS_Y (TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XOMEGA (TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XNAC_YAW (TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XBLA_PITCH(TPFARM%NNB_TURBINES))
+ !
+ ! New read
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
+ !
+ ! Saving data
+ DO INBLINE=1, TPFARM%NNB_TURBINES
+ READ(ILU,FMT='(A400)') YSTRING
+ READ(YSTRING,*) ZPOS_X, ZPOS_Y, ZOMEGA, ZYAW, ZPITCH
+ TPFARM%XPOS_X(INBLINE) = ZPOS_X
+ TPFARM%XPOS_Y(INBLINE) = ZPOS_Y
+ TPFARM%XOMEGA(INBLINE) = ZOMEGA
+ TPFARM%XNAC_YAW(INBLINE) = ZYAW
+ TPFARM%XBLA_PITCH(INBLINE) = ZPITCH
+ END DO
+ CLOSE(ILU)
+ RETURN
+END IF
+!
+END SUBROUTINE READ_CSVDATA_FARM_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_TURBINE_ALM(HFILE,TPTURBINE)
+!
+USE MODD_EOL_ALM, ONLY: TURBINE
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(TURBINE), INTENT(OUT) :: TPTURBINE ! dummy stored data turbine
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBLINE ! Nb of line in csv file
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+CHARACTER(LEN=80) :: YWT_NAME
+INTEGER :: INB_BLADE
+REAL :: ZH_HEIGHT
+REAL :: ZR_MIN
+REAL :: ZR_MAX
+REAL :: ZNAC_TILT
+REAL :: ZHUB_DEPORT
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Opening
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+!
+! Counting number of line
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+IF (INBLINE /= 2) THEN
+ CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
+ELSE
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
+ READ(ILU,FMT='(A400)') YSTRING ! Reading next line
+ ! Read data
+ READ(YSTRING,*) YWT_NAME, INB_BLADE, ZH_HEIGHT,& ! reading data
+ ZR_MIN, ZR_MAX, ZNAC_TILT, &
+ ZHUB_DEPORT
+ TPTURBINE%CNAME = YWT_NAME ! Saving them
+ TPTURBINE%NNB_BLADES = INB_BLADE
+ TPTURBINE%XH_HEIGHT = ZH_HEIGHT
+ TPTURBINE%XR_MIN = ZR_MIN
+ TPTURBINE%XR_MAX = ZR_MAX
+ TPTURBINE%XNAC_TILT = ZNAC_TILT
+ TPTURBINE%XH_DEPORT = ZHUB_DEPORT
+ REWIND(ILU)
+ RETURN
+ CLOSE(ILU)
+END IF
+!
+END SUBROUTINE READ_CSVDATA_TURBINE_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_BLADE_ALM(HFILE,TPTURBINE,TPBLADE)
+!
+USE MODD_EOL_ALM, ONLY: TURBINE, BLADE, NNB_BLAELT
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+USE MODI_EOL_ERROR, ONLY: EOL_BLADEDATA_ERROR
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+TYPE(BLADE), INTENT(OUT) :: TPBLADE ! dummy stored data blade
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBLINE ! Nb of line in csv file
+INTEGER :: INBDATA ! Nb of data (line/section) of blade
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+REAL :: ZCENTER ! Center pos. of elmt [m]
+REAL :: ZCHORD ! Blade chord of elmt [m]
+REAL :: ZTWIST ! Twist of elmt [rad]
+CHARACTER(LEN=20) :: YAIRFOIL ! Airfoil name [-]
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Ouverture
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+! Counting number of line
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+IF (INBLINE < 2) THEN
+ CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
+ELSE
+ TPBLADE%NNB_BLAELT = NNB_BLAELT
+ ! Saving number of data
+ TPBLADE%NNB_BLADAT = INBLINE - 1
+ ALLOCATE(TPBLADE%XRAD(TPBLADE%NNB_BLADAT))
+ ALLOCATE(TPBLADE%XCHORD(TPBLADE%NNB_BLADAT))
+ ALLOCATE(TPBLADE%XTWIST(TPBLADE%NNB_BLADAT))
+ ALLOCATE(TPBLADE%CAIRFOIL(TPBLADE%NNB_BLADAT))
+ !
+ ! New read
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
+ !
+ ! Saving data
+ DO INBLINE=1, TPBLADE%NNB_BLADAT
+ READ(ILU,FMT='(A400)') YSTRING
+ READ(YSTRING,*) ZCENTER, ZCHORD, ZTWIST, YAIRFOIL ! Reading data
+ IF ((ZCENTER<=0.0) .OR. (ZCENTER>= 1.0)) THEN
+ ! Checking data
+ CALL EOL_BLADEDATA_ERROR(ZCENTER)
+ ELSE
+ ! Storing them
+ TPBLADE%XRAD(INBLINE) = ZCENTER*(TPTURBINE%XR_MAX-TPTURBINE%XR_MIN) & ! Data in %
+ + TPTURBINE%XR_MIN
+ TPBLADE%XCHORD(INBLINE) = ZCHORD
+ TPBLADE%XTWIST(INBLINE) = ZTWIST
+ TPBLADE%CAIRFOIL(INBLINE) = YAIRFOIL
+ END IF
+ END DO
+ CLOSE(ILU)
+ RETURN
+END IF
+!
+END SUBROUTINE READ_CSVDATA_BLADE_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_AIRFOIL_ALM(HFILE,TPBLADE,TPAIRFOIL)
+!
+USE MODD_EOL_ALM, ONLY: BLADE, AIRFOIL
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+USE MODI_EOL_ERROR, ONLY: EOL_AIRFOILNOTFOUND_ERROR
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(BLADE), INTENT(IN) :: TPBLADE ! stored blade data (to select airfoils)
+TYPE(AIRFOIL), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: TPAIRFOIL ! dummy stored data blade
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBDATA ! Nb of data (line/section) per airfoil
+INTEGER :: INBLINE ! Nb of line in csv file
+LOGICAL :: GAIRFLAG ! Flag for airfoil counting
+!
+INTEGER :: JI, JJ, IA ! loop control
+INTEGER :: INBAIRFOIL ! Nb of differents airfoils on one blade
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+CHARACTER(LEN=15), DIMENSION(:), ALLOCATABLE :: YAIRFOIL
+!
+CHARACTER(LEN=15) :: YREAD_NAME
+REAL :: ZAA ! Attack Angle [rad]
+REAL :: ZRE ! Reynolds Number [-]
+REAL :: ZCL ! Lift Coef [-]
+REAL :: ZCD ! Drag Coef [-]
+REAL :: ZCM ! Moment Coef [-]
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Ouverture
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+!
+! 1. Counting number of differents airfoils along the blade and selection :
+!
+! Allcation of local airfoil array
+ALLOCATE(YAIRFOIL(SIZE(TPBLADE%CAIRFOIL)))
+!
+YAIRFOIL(:) = ''
+INBAIRFOIL = 1
+YAIRFOIL(1) = TRIM(TPBLADE%CAIRFOIL(1))
+!
+DO JI=1, SIZE(TPBLADE%CAIRFOIL)
+ GAIRFLAG = .FALSE.
+ DO JJ=1, INBAIRFOIL
+ IF (TRIM(TPBLADE%CAIRFOIL(JI)) == TRIM(YAIRFOIL(JJ))) THEN
+ GAIRFLAG = .TRUE.
+ END IF
+ END DO
+ IF (GAIRFLAG .EQV. .FALSE.) THEN
+ INBAIRFOIL = INBAIRFOIL + 1
+ YAIRFOIL(INBAIRFOIL) = TRIM(TPBLADE%CAIRFOIL(JI))
+ END IF
+END DO
+ALLOCATE(TPAIRFOIL(INBAIRFOIL))
+!
+! 2. Reading and storing data :
+!
+DO IA = 1, INBAIRFOIL
+ ! Array allocation
+ CALL HOW_MANY_LINES_OF(ILU,HFILE,YAIRFOIL(IA),INBDATA)
+ ALLOCATE(TPAIRFOIL(IA)%XAA(INBDATA))
+ ALLOCATE(TPAIRFOIL(IA)%XRE(INBDATA))
+ ALLOCATE(TPAIRFOIL(IA)%XCL(INBDATA))
+ ALLOCATE(TPAIRFOIL(IA)%XCD(INBDATA))
+ ALLOCATE(TPAIRFOIL(IA)%XCM(INBDATA))
+ !
+ REWIND(ILU)
+ INBLINE = 0
+ DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING ! Header
+ !* reads the string
+ IF (LEN_TRIM(YSTRING)>0) THEN
+ READ(YSTRING,FMT=*) YREAD_NAME
+ IF (TRIM(YREAD_NAME)==TRIM(YAIRFOIL(IA))) THEN ! Read data
+ INBLINE = INBLINE + 1
+ READ(YSTRING,*) YREAD_NAME, ZAA, ZRE, &
+ ZCL, ZCD, ZCM
+ ! Storing data
+ TPAIRFOIL(IA)%CNAME = YREAD_NAME
+ TPAIRFOIL(IA)%XAA(INBLINE) = ZAA
+ TPAIRFOIL(IA)%XRE(INBLINE) = ZRE
+ TPAIRFOIL(IA)%XCL(INBLINE) = ZCL
+ TPAIRFOIL(IA)%XCD(INBLINE) = ZCD
+ TPAIRFOIL(IA)%XCM(INBLINE) = ZCM
+ ELSE ! The name doesnt appear during a new read..
+ IF (INBLINE > 0) THEN ! .. but it has already been found, ..
+ REWIND(ILU) ! .. so it is the end of the data ..
+ EXIT ! .. and we can exit :)
+ END IF
+ END IF
+ END IF
+ END DO
+END DO
+!
+CLOSE(ILU)
+101 CONTINUE
+ IF (INBLINE == 0) THEN
+ CALL EOL_AIRFOILNOTFOUND_ERROR(HFILE,YAIRFOIL(IA))
+ END IF
+END SUBROUTINE READ_CSVDATA_AIRFOIL_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE HOW_MANY_LINES_OF(KLUNAM,HFILE,HNAME,KLINE)
+!
+USE MODI_EOL_ERROR, ONLY: EOL_AIRFOILNOTFOUND_ERROR
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! turbine's name
+INTEGER, INTENT(OUT) :: KLINE
+!
+!
+CHARACTER(LEN=400) :: YSTRING
+CHARACTER(LEN=80) :: HREAD_NAME
+!
+REWIND(KLUNAM)
+KLINE=0
+DO
+ READ(KLUNAM,END=101,FMT='(A400)') YSTRING
+!* reads the string
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ READ(YSTRING,FMT=*) HREAD_NAME
+ IF (TRIM(HREAD_NAME)==TRIM(HNAME)) THEN
+ KLINE = KLINE + 1
+ ELSE ! The name doesnt appear during a new read..
+ IF (KLINE > 0) THEN ! .. but it has already been found, ..
+ REWIND(KLUNAM) ! .. so it is the end of the data ..
+ RETURN ! .. and we can return :)
+ END IF
+ END IF
+ END IF
+END DO
+101 CONTINUE
+ IF (KLINE == 0) THEN
+ CALL EOL_AIRFOILNOTFOUND_ERROR(HFILE,HNAME)
+ END IF
+END SUBROUTINE HOW_MANY_LINES_OF
+!#########################################################
+!
+!#########################################################
+FUNCTION GET_AIRFOIL_ID(TPTURBINE,TPBLADE,TPAIRFOIL,PRADIUS)
+! Allows to link an airfoil from a TPBLADE, at a specific radius (PRADIUS)
+! to the airfoils characteristics (TPAIRFOIL).
+! The result is an integer (IAID) that should be used like that :
+! IAID = GET_GET_AIRFOIL_ID(TPTURBINE,TPBLADE,TPAIRFOIL,PRADIUS)
+! TPAIRFOIL(IAID)%MEMBER_OF_TPAIRFOIL
+!
+USE MODD_EOL_ALM, ONLY : TURBINE, BLADE, AIRFOIL
+!
+USE MODE_MSG
+!
+IMPLICIT NONE
+!
+TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+TYPE(BLADE), INTENT(IN) :: TPBLADE ! stored blade data
+TYPE(AIRFOIL), DIMENSION(:), INTENT(IN) :: TPAIRFOIL ! stored arifoil data
+REAL, INTENT(IN) :: PRADIUS ! Radius position studied
+INTEGER :: GET_AIRFOIL_ID
+!
+CHARACTER(LEN=:), ALLOCATABLE :: YMSG
+CHARACTER(LEN=10) :: YRADIUS, YRMIN, YRMAX
+INTEGER :: INB_BDATA ! Total number of blade data
+INTEGER :: JBDATA ! Index over blade's data
+INTEGER :: JA ! Index over diffetents airfoils
+REAL, DIMENSION(SIZE(TPBLADE%XRAD)) :: ZDELTARAD ! 2*ZDELTARAD = section lenght
+!
+! Checking data
+IF ((PRADIUS < TPTURBINE%XR_MIN) .OR. (PRADIUS > TPTURBINE%XR_MAX)) THEN
+ WRITE( YRADIUS, '( F10.2 )' ) PRADIUS
+ WRITE( YRMIN, '( F10.2 )' ) TPTURBINE%XR_MIN
+ WRITE( YRMAX, '( F10.2 )' ) TPTURBINE%XR_MAX
+ YMSG = 'The studied radius R=' // TRIM( YRADIUS ) // ' is out of blade range : [' // TRIM( YRMIN ) // ';' // TRIM( YRMAX ) // ']'
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'GET_AIRFOIL_ID', YMSG )
+END IF
+!
+! Preliminaires
+INB_BDATA = SIZE(TPBLADE%XRAD)
+!
+! Computes half length of sections
+ZDELTARAD(1) = TPBLADE%XRAD(1) - TPTURBINE%XR_MIN
+DO JBDATA=2,INB_BDATA-1
+ ZDELTARAD(JBDATA) = TPBLADE%XRAD(JBDATA) &
+ - TPBLADE%XRAD(JBDATA-1) &
+ - ZDELTARAD(JBDATA-1)
+END DO
+ZDELTARAD(INB_BDATA) = TPTURBINE%XR_MAX - TPBLADE%XRAD(INB_BDATA)
+!
+! Looking for the section at r=PRADIUS
+DO JBDATA=1,INB_BDATA
+ IF ((PRADIUS >= TPBLADE%XRAD(JBDATA)-ZDELTARAD(JBDATA)) .AND. &
+ (PRADIUS < TPBLADE%XRAD(JBDATA)+ZDELTARAD(JBDATA))) THEN
+! Looking for the ID of the airfoil of this section
+ DO JA=1,SIZE(TPAIRFOIL)
+ IF (TRIM(TPBLADE%CAIRFOIL(JBDATA)) == TRIM(TPAIRFOIL(JA)%CNAME)) THEN
+ GET_AIRFOIL_ID = JA
+ EXIT
+ END IF
+ END DO
+!
+ EXIT
+ END IF
+END DO
+!
+END FUNCTION GET_AIRFOIL_ID
+!#########################################################
diff --git a/src/MNH/eol_smear.f90 b/src/MNH/eol_smear.f90
new file mode 100644
index 0000000000000000000000000000000000000000..95f12caecbf6b51173890922a0ed08f0f1db25a9
--- /dev/null
+++ b/src/MNH/eol_smear.f90
@@ -0,0 +1,121 @@
+!MNH_LIC Copyright 2018-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.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_SMEAR
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE SMEAR_1LIN(PFX, PFX_SMR)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFX ! Force to smear
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX_SMR ! Smeared force
+END SUBROUTINE SMEAR_1LIN
+!
+SUBROUTINE SMEAR_3LIN(PFX, PFY, PFZ, PFX_SMR, PFY_SMR, PFZ_SMR)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFX, PFY, PFZ ! Force to smear
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX_SMR, PFY_SMR, PFZ_SMR ! Smeared force
+END SUBROUTINE SMEAR_3LIN
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_SMEAR
+!-------------------------------------------------------------------
+!
+!!**** *MODI_EOL_SMEAR* -
+!!
+!! PURPOSE
+!! -------
+!! Smear the forces of wind turbine to avoid numerical instabilities
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/2018
+!! Modification 21/10/20 (PA. Joulin) Updated for a main version
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE SMEAR_1LIN(PFX, PFX_SMR)
+!!
+!! METHOD
+!! ------
+!! A linear smearing is done is this subroutine.
+!!
+!---------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODI_SHUMAN, ONLY: MXF, MXM
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFX ! Force to smear
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX_SMR ! Smeared force
+!
+!* 1. SMEARING
+!
+ PFX_SMR(:,:,:) = MXF(MXM(PFX(:,:,:)))
+!
+END SUBROUTINE SMEAR_1LIN
+!#########################################################
+!
+!#########################################################
+SUBROUTINE SMEAR_3LIN(PFX, PFY, PFZ, PFX_SMR, PFY_SMR, PFZ_SMR)
+!!
+!! METHOD
+!! ------
+!! A linear smearing is done is this subroutine.
+!!
+!---------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODI_SHUMAN, ONLY: MXF, MYF, MZF
+USE MODI_SHUMAN, ONLY: MXM, MYM, MZM
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFX, PFY, PFZ ! Force to smear
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX_SMR, PFY_SMR, PFZ_SMR ! Smeared force
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: IKU,IKB,IKE ! Vertical indices
+!
+!* 1. INITIALIZATIONS
+!
+ IKU = SIZE(PFX,3) ! Top of the domain end index
+ IKB=1+JPVEXT ! Vertical begin index
+ IKE=IKU-JPVEXT ! Vertical end index
+!
+!* 2. SMEARING
+!
+ PFX_SMR(:,:,:) = MXF(MXM(MYF(MYM(PFX(:,:,:)))))
+ PFY_SMR(:,:,:) = MXF(MXM(MYF(MYM(PFY(:,:,:)))))
+ PFZ_SMR(:,:,:) = MXF(MXM(MYF(MYM(PFZ(:,:,:)))))
+!
+ PFX_SMR(:,:,:) = MZF(MZM(PFX_SMR(:,:,:)))
+ PFY_SMR(:,:,:) = MZF(MZM(PFY_SMR(:,:,:)))
+ PFZ_SMR(:,:,:) = MZF(MZM(PFZ_SMR(:,:,:)))
+!
+!* 3. BOUNDARY VALUES
+!
+ PFX_SMR(:,:,IKB-1) = PFX_SMR(:,:,IKB)
+ PFX_SMR(:,:,IKE+1) = PFX_SMR(:,:,IKE)
+!
+ PFY_SMR(:,:,IKB-1) = PFY_SMR(:,:,IKB)
+ PFY_SMR(:,:,IKE+1) = PFY_SMR(:,:,IKE)
+!
+ PFZ_SMR(:,:,IKB-1) = PFZ_SMR(:,:,IKB)
+ PFZ_SMR(:,:,IKE+1) = PFZ_SMR(:,:,IKE)
+!
+END SUBROUTINE SMEAR_3LIN
+!#########################################################
diff --git a/src/MNH/etheta.f90 b/src/MNH/etheta.f90
index 6c673cb978262ffe9cdb70251f4943f8b828cb0b..3ef29178b721660ec33639f4199166e0f6d1a9d0 100644
--- a/src/MNH/etheta.f90
+++ b/src/MNH/etheta.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-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 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$ $Revision$
-! MASDEV4_7 turb 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!#################
MODULE MODI_ETHETA
!#################
@@ -82,12 +77,13 @@ FUNCTION ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM) RESULT(PETHETA)
!! J. Stein Feb 28, 1996 optimization + Doctorization
!! J. Stein Sept 15, 1996 Atheta previously computed
!! J.-P. Pinty May 20, 2003 Improve ETHETA expression
-!!
+!! J.L Redelsperger 03, 2021 Ocean Model Case
!! ----------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODD_CST
+USE MODD_DYN_n, ONLY : LOCEAN
!
IMPLICIT NONE
!
@@ -125,12 +121,15 @@ INTEGER :: JRR ! moist loop counter
! --------------
!
!
-IF ( KRR == 0 ) THEN ! dry case
+IF (LOCEAN) THEN ! ocean case
+ PETHETA(:,:,:) = 1.
+ELSE
+ IF ( KRR == 0.) THEN ! dry case
PETHETA(:,:,:) = 1.
-ELSE IF ( KRR == 1 ) THEN ! only vapor
+ ELSE IF ( KRR == 1 ) THEN ! only vapor
ZDELTA = (XRV/XRD) - 1.
PETHETA(:,:,:) = 1. + ZDELTA*PRM(:,:,:,1)
-ELSE ! liquid water & ice present
+ ELSE ! liquid water & ice present
ZDELTA = (XRV/XRD) - 1.
ZRW(:,:,:) = PRM(:,:,:,1)
!
@@ -173,8 +172,9 @@ ELSE ! liquid water & ice present
/ (1. + ZRW(:,:,:)) &
) * PATHETA(:,:,:) * 2. * PSRCM(:,:,:)
END IF
-END IF
+ END IF
!
+END IF
!---------------------------------------------------------------------------
!
END FUNCTION ETHETA
diff --git a/src/MNH/forc_squall_line.f90 b/src/MNH/forc_squall_line.f90
index 511522866b3f0ebbd2389e9742c3389d6fdd64ed..c7abcd09c38e0915ba2b5b281ce2c08f96e63900 100644
--- a/src/MNH/forc_squall_line.f90
+++ b/src/MNH/forc_squall_line.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2008-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2008-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.
@@ -55,11 +55,11 @@ END MODULE MODI_FORC_SQUALL_LINE
! ------------
!
USE MODD_PARAMETERS
-USE MODD_BLANK_n, ONLY : XDUMMY1, & ! cooling rate (K/s)
- XDUMMY2, & ! vertical size of the disturbance
- XDUMMY3, & ! horizontal size of the disturbance
- XDUMMY4, & ! left border of the disturbance
- XDUMMY5 ! duration (s) of the disturbance
+USE MODD_BLANK_n, ONLY: XDUMMY1, & ! cooling rate (K/s)
+ XDUMMY2, & ! vertical size of the disturbance
+ XDUMMY3, & ! horizontal size of the disturbance
+ XDUMMY4, & ! left border of the disturbance
+ XDUMMY5 ! duration (s) of the disturbance
!
IMPLICIT NONE
!
diff --git a/src/MNH/goto_model_wrapper.f90 b/src/MNH/goto_model_wrapper.f90
index eb943082f866b2a7049e9c7e71327e8667d44719..831cb2028c3c0ea54da0090bb1329b014437bb4c 100644
--- a/src/MNH/goto_model_wrapper.f90
+++ b/src/MNH/goto_model_wrapper.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!! MODIFICATIONS
@@ -16,6 +16,8 @@
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! 2017 V.Vionnet blow snow
! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+! F. Auguste 02/21: add IBM
+! T. Nagel 02/21: add turbulence recycling
!-----------------------------------------------------------------
MODULE MODI_GOTO_MODEL_WRAPPER
@@ -30,37 +32,44 @@ END MODULE MODI_GOTO_MODEL_WRAPPER
SUBROUTINE GOTO_MODEL_WRAPPER(KFROM, KTO, ONOFIELDLIST)
! all USE modd*_n modules
+USE MODD_ADVFRC_n
USE MODD_ADV_n
+USE MODD_ALLSTATION_n
USE MODD_BIKHARDT_n
USE MODD_BLANK_n
+USE MODD_BLOWSNOW_n
USE MODD_CH_AERO_n
+USE MODD_CH_BUDGET_n
USE MODD_CH_FLX_n
+USE MODD_CH_ICE_n
USE MODD_CH_JVALUES_n
+USE MODD_CH_M9_n
USE MODD_CH_MNHC_n
+USE MODD_CH_PH_n
+USE MODD_CH_PRODLOSSTOT_n
+USE MODD_CH_ROSENBROCK_n
USE MODD_CH_SOLVER_n
USE MODD_CLOUDPAR_n
USE MODD_CLOUD_MF_n
USE MODD_CONF_n
USE MODD_CURVCOR_n
-!USE MODD_DEEP_CONVECTION_n
USE MODD_DIM_n
+USE MODD_DRAG_n
USE MODD_DRAGTREE_n
USE MODD_DRAGBLDG_n
USE MODD_DUMMY_GR_FIELD_n
USE MODD_DYN_n
USE MODD_DYNZD_n
USE MODD_FIELD_n
-USE MODD_PAST_FIELD_n
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE_n
+#endif
+USE MODD_FRC_n
USE MODD_GET_n
USE MODD_GR_FIELD_n
-!USE MODD_GRID_n
-!$20140403
-!USE MODD_GRID_CONF_PROJ
-!$
-!USE MODD_HURR_FIELD_n
-!$20140403 add modd_io_surf_mnh
-USE MODD_IO_SURF_MNH
-!$
+USE MODD_IBM_LSF
+USE MODD_IBM_PARAM_n
+USE MODD_IO_SURF_MNH
USE MODD_LBC_n
USE MODD_LES_n
USE MODD_LSFIELD_n
@@ -77,54 +86,37 @@ USE MODD_PARAM_n
USE MODD_PARAM_RAD_n
USE MODD_PARAM_ECRAD_n
USE MODD_PASPOL_n
-#ifdef MNH_FOREFIRE
-USE MODD_FOREFIRE_n
-#endif
+USE MODD_PAST_FIELD_n
USE MODD_PRECIP_n
USE MODD_ELEC_n
USE MODD_PROFILER_n
USE MODD_RADIATIONS_n
-USE MODD_SHADOWS_n
+USE MODD_RBK90_Global_n
+USE MODD_RBK90_JacobianSP_n
+USE MODD_RBK90_Parameters_n
+USE MODD_RECYCL_PARAM_n
USE MODD_REF_n
-USE MODD_FRC_n
+USE MODD_RELFRC_n
USE MODD_SECPGD_FIELD_n
USE MODD_SERIES_n
+USE MODD_SHADOWS_n
USE MODD_STATION_n
-!USE MODD_TIME_n
-USE MODD_TURB_n
-USE MODD_DRAG_n
-USE MODD_BLOWSNOW_n
-!
USE MODD_SUB_CH_FIELD_VALUE_n
USE MODD_SUB_CH_MONITOR_n
+USE MODD_SUB_ELEC_n
USE MODD_SUB_MODEL_n
-USE MODD_SUB_PHYS_PARAM_n
+USE MODD_SUB_PASPOL_n
+USE MODD_SUB_PHYS_PARAM_n
USE MODD_SUB_PROFILER_n
USE MODD_SUB_STATION_n
USE MODD_TIMEZ
-USE MODD_SUB_PASPOL_n
-USE MODD_SUB_ELEC_n
-USE MODD_CH_PH_n
-USE MODD_CH_ICE_n
-USE MODD_CH_M9_n
-USE MODD_CH_ROSENBROCK_n
-USE MODD_RBK90_Global_n
-USE MODD_RBK90_JacobianSP_n
-USE MODD_RBK90_Parameters_n
-!
-!USE MODD_LIMA_PRECIP_SCAVENGING_n
-!
-!USE MODD_DEF_EDDY_FLUX_n
-!USE MODD_DEF_EDDYUV_FLUX_n
-USE MODD_RELFRC_n
-USE MODD_ADVFRC_n
+USE MODD_TURB_n
!
-USE MODD_CH_PRODLOSSTOT_n
-USE MODD_CH_BUDGET_n
!
use mode_field, only: Fieldlist_goto_model
use mode_msg
!
+!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KFROM, KTO
@@ -206,6 +198,7 @@ CALL FRC_GOTO_MODEL(KFROM, KTO)
CALL SECPGD_FIELD_GOTO_MODEL(KFROM, KTO)
CALL SERIES_GOTO_MODEL(KFROM, KTO)
CALL STATION_GOTO_MODEL(KFROM, KTO)
+CALL ALLSTATION_GOTO_MODEL(KFROM, KTO)
CALL SUB_CH_FIELD_VALUE_GOTO_MODEL(KFROM, KTO)
CALL SUB_CH_MONITOR_GOTO_MODEL(KFROM, KTO)
CALL SUB_MODEL_GOTO_MODEL(KFROM, KTO)
@@ -235,6 +228,9 @@ CALL RELFRC_GOTO_MODEL(KFROM, KTO)
CALL CH_PRODLOSSTOT_GOTO_MODEL(KFROM,KTO)
CALL CH_BUDGET_GOTO_MODEL(KFROM,KTO)
CALL BLOWSNOW_GOTO_MODEL(KFROM, KTO)
+CALL IBM_GOTO_MODEL(KFROM, KTO)
+CALL RECYCL_GOTO_MODEL(KFROM, KTO)
+CALL LSF_GOTO_MODEL(KFROM, KTO)
!
IF (.NOT.GNOFIELDLIST) CALL FIELDLIST_GOTO_MODEL(KFROM, KTO)
!
diff --git a/src/MNH/gravity.f90 b/src/MNH/gravity.f90
index 72d0c1649e522a6b44541baa3b2ace50d7147061..c775ae96f511b40e33a5e39d60d2305874a2637b 100644
--- a/src/MNH/gravity.f90
+++ b/src/MNH/gravity.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -100,7 +100,7 @@ END MODULE MODI_GRAVITY
!! C.Lac - March 2011 - Splitted from dyn_sources
!! Q.Rodier 06/15 correction on budget
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
+!! J.L. Redelsperger 03/2021 : Ocean model case
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -108,10 +108,12 @@ END MODULE MODI_GRAVITY
!
USE MODD_CONF
USE MODD_CST
+USE MODD_DYN_n, ONLY : LOCEAN
+USE MODD_REF
!
-USE MODI_SHUMAN
USE MODI_GET_HALO
-!
+USE MODI_SHUMAN
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -144,33 +146,42 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
!
IF( .NOT.L1D ) THEN ! no buoyancy for 1D case
!
- IF(KRR > 0) THEN
+ IF (LOCEAN) THEN !ocean case
+ CALL GET_HALO(PTHT)
+ IF(KRR > 0) THEN
+ CALL GET_HALO(PRT(:,:,:,1))
+ PRWS(:,:,:) = PRWS + XG * (XALPHAOC*MZM((PTHT - PTHVREF )*PRHODJ) &
+ - XBETAOC*MZM((PRT(:,:,:,1) - XSA00OCEAN)*PRHODJ) )
+ ELSE ! unsalted case
+ PRWS(:,:,:) = PRWS + XG * XALPHAOC*MZM((PTHT - PTHVREF )*PRHODJ )
+ END IF
+ ELSE ! Atmospheric case
+ IF(KRR > 0) THEN
!
! compute the ratio : 1 + total water mass / dry air mass
!
- ZRV_OV_RD = XRV / XRD
- ZWORK1(:,:,:) = 1.
- DO JWATER = 1 , 1+KRRL+KRRI
- CALL GET_HALO(PRT(:,:,:,JWATER))
- ZWORK1(:,:,:) = ZWORK1(:,:,:) + PRT(:,:,:,JWATER)
- END DO
+ ZRV_OV_RD = XRV / XRD
+ ZWORK1(:,:,:) = 1.
+ DO JWATER = 1 , 1+KRRL+KRRI
+ CALL GET_HALO(PRT(:,:,:,JWATER))
+ ZWORK1(:,:,:) = ZWORK1(:,:,:) + PRT(:,:,:,JWATER)
+ END DO
!
! compute the virtual potential temperature when water is present in any form
+ CALL GET_HALO(PTHT)
!
- CALL GET_HALO(PTHT)
-!
-
- ZWORK2(:,:,:) = PTHT(:,:,:) * (1. + PRT(:,:,:,1)*ZRV_OV_RD) / ZWORK1(:,:,:)
- ELSE
+ ZWORK2(:,:,:) = PTHT(:,:,:) * (1. + PRT(:,:,:,1)*ZRV_OV_RD) / ZWORK1(:,:,:)
+ ELSE
!
! compute the virtual potential temperature when water is absent
!
- ZWORK2(:,:,:) = PTHT(:,:,:)
- END IF
+ ZWORK2(:,:,:) = PTHT(:,:,:)
+ END IF
!
! compute the gravity term
!
- PRWS(:,:,:) = PRWS + XG * MZM( ( (ZWORK2/PTHVREF) - 1. ) * PRHODJ )
+ PRWS(:,:,:) = PRWS + XG * MZM( ( (ZWORK2/PTHVREF) - 1. ) * PRHODJ )
+ END IF
!
! the extrapolation for the PTHT and the THVREF must be the same at the
! ground
diff --git a/src/MNH/hypgeo.f90 b/src/MNH/hypgeo.f90
index fa64d778da5ee68c7483f3a2ce969f7dda5269fe..0d3697f71e6843ee6e0ea044a9965de7762cd36b 100644
--- a/src/MNH/hypgeo.f90
+++ b/src/MNH/hypgeo.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-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 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$ $Revision$
-! MASDEV4_7 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!####################
MODULE MODI_HYPGEO
!####################
@@ -97,7 +92,7 @@ REAL :: ZX0,ZX1,ZZA,ZZB,ZZC,ZZD,Y(2)
!------------------------------------------------------------------------------
!
!
-ZEPS = 2.E-2
+ZEPS = 4.E-2
ZXH = PF * PX**2.0
IF (ZXH.LT.(1-ZEPS)) THEN
CALL HYPSER(PA,PB,PC,-ZXH,PHYPGEO)
diff --git a/src/MNH/ibm_0Dint.f90 b/src/MNH/ibm_0Dint.f90
new file mode 100644
index 0000000000000000000000000000000000000000..67fa85cf88f7c1861cdcc33b10ff35f7766bbe11
--- /dev/null
+++ b/src/MNH/ibm_0Dint.f90
@@ -0,0 +1,219 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #####################
+MODULE MODI_IBM_0DINT
+ ! #####################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_0DINT(PDELTAI,PVALUEI,HBOUND1,HBOUND2,PBOUNDI,PIBM_VISC,PIBM_DIVK) RESULT(PVALUEB)
+ !
+ REAL , INTENT(IN) :: PDELTAI
+ REAL , INTENT(IN) :: PBOUNDI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND1
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND2
+ REAL , INTENT(IN) :: PIBM_VISC
+ REAL , INTENT(IN) :: PIBM_DIVK
+ REAL :: PVALUEB
+ !
+ END FUNCTION IBM_0DINT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_0DINT
+!
+! ###########################################################################
+FUNCTION IBM_0DINT(PDELTAI,PVALUEI,HBOUND1,HBOUND2,PBOUNDI,PIBM_VISC,PIBM_DIVK) RESULT(PVALUEB)
+ ! ###########################################################################
+ !
+ !**** *IBM_INTER_0DINT* - Computation of the variable value at the interface
+ !
+ ! PURPOSE
+ ! -------
+ ! Depending on the boundary condition type (Dirichlet, Neumann, Robin)
+ ! the variable value PVALUEB is affected using the values at images point
+ ! PVALUEI.
+ !
+ !
+ ! METHOD
+ ! ------
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_CST
+ USE MODD_CTURB
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL , INTENT(IN) :: PDELTAI
+ REAL , INTENT(IN) :: PBOUNDI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND1
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND2
+ REAL , INTENT(IN) :: PIBM_VISC
+ REAL , INTENT(IN) :: PIBM_DIVK
+ REAL :: PVALUEB
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ REAL :: Z_ROB, Z_PVAL0, Z_DVAL0
+ REAL :: Z_VD, Z_RD, Z_RE, Z_RD1, Z_RD2
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ ! Switch for Neuman,Dirichlet or Robin conditions
+ !
+ Z_ROB = 0.
+ !
+ IF (HBOUND1=='DIR') THEN
+ Z_ROB = 1.0
+ ENDIF
+ IF (HBOUND1=='NEU') THEN
+ Z_ROB = 0.0
+ ENDIF
+ IF (HBOUND1=='ROB') THEN
+ Z_ROB = 0.5
+ ENDIF
+ !
+ ! Computation of value at the interface
+ !
+ Z_PVAL0 = 0.
+ Z_DVAL0 = 0.
+ !
+ IF (HBOUND2=='CST') THEN
+ Z_PVAL0 = PBOUNDI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CN3'.OR.HBOUND2=='CK3') THEN
+ Z_PVAL0 = PVALUEI(3)
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CN1'.OR.HBOUND2=='CK1') THEN
+ Z_PVAL0 = PVALUEI(1)
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CN2'.OR.HBOUND2=='CK2') THEN
+ Z_PVAL0 = PVALUEI(2)
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='LN3'.OR.HBOUND2=='LK3') THEN
+ Z_PVAL0 = (2.*PVALUEI(3)-1.*PVALUEI(1))
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='LN1'.OR.HBOUND2=='LK1') THEN
+ Z_PVAL0 = (2.*PVALUEI(1)-1.*PVALUEI(2))
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='LN2'.OR.HBOUND2=='LK2') THEN
+ Z_PVAL0 = (1./4.)*(9.*PVALUEI(3)-6.*PVALUEI(1)+1.*PVALUEI(2))
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='WN3'.OR.HBOUND2=='WK3') THEN
+ Z_VD = PVALUEI(3)
+ Z_RE = XIBM_EPSI
+ IF (ABS(Z_VD).GT.XIBM_EPSI) Z_RE = Z_VD/ABS(Z_VD)
+ Z_RD1 = 1./XIBM_RUG/9.8
+ Z_RD2 = PIBM_VISC/XIBM_VISC
+ Z_RD = MIN(Z_RD1,Z_RD2)
+ Z_RD = MAX(XIBM_EPSI,Z_RD)
+ Z_PVAL0 = Z_RE/XKARMAN*PIBM_VISC*log(1.+9.8*PDELTAI*XKARMAN*Z_RD*(1.-exp(-PDELTAI*XKARMAN*Z_RD/20.)))
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ IF (Z_PVAL0*Z_VD.LT.XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='WN1'.OR.HBOUND2=='WK1') THEN
+ Z_VD = PVALUEI(1)
+ Z_RE = XIBM_EPSI
+ IF (ABS(Z_VD).GT.XIBM_EPSI) Z_RE = Z_VD/ABS(Z_VD)
+ Z_RD1 = 1./XIBM_RUG/9.8
+ Z_RD2 = PIBM_VISC/XIBM_VISC
+ Z_RD = MIN(Z_RD1,Z_RD2)
+ Z_RD = MAX(XIBM_EPSI,Z_RD)
+ Z_PVAL0 = Z_RE/XKARMAN*PIBM_VISC*log(1.+9.8*PDELTAI*XKARMAN*Z_RD*(1.-exp(-PDELTAI*XKARMAN*Z_RD/20.)))
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ IF (Z_PVAL0*Z_VD.LT.XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='WN2'.OR.HBOUND2=='WK2') THEN
+ Z_VD = PVALUEI(2)
+ Z_RE = XIBM_EPSI
+ IF (ABS(Z_VD).GT.XIBM_EPSI) Z_RE = Z_VD/ABS(Z_VD)
+ Z_RD1 = 1./XIBM_RUG/9.8
+ Z_RD2 = PIBM_VISC/XIBM_VISC
+ Z_RD = MIN(Z_RD1,Z_RD2)
+ Z_RD = MAX(XIBM_EPSI,Z_RD)
+ Z_PVAL0 = Z_RE/XKARMAN*PIBM_VISC*log(1.+9.8*PDELTAI*XKARMAN*Z_RD*(1.-exp(-PDELTAI*XKARMAN*Z_RD/20.)))
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ IF (Z_PVAL0*Z_VD.LT.XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CK3'.OR.HBOUND2=='CK1'.OR.HBOUND2=='CK2'.OR.&
+ HBOUND2=='LK3'.OR.HBOUND2=='LK1'.OR.HBOUND2=='LK2'.OR.&
+ HBOUND2=='WK3'.OR.HBOUND2=='WK1'.OR.HBOUND2=='WK2') THEN
+ Z_VD = Z_PVAL0
+ Z_PVAL0 = Z_PVAL0*(1.-PIBM_DIVK)
+ IF (Z_PVAL0*Z_VD.LT.-XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ ENDIF
+ !
+ PVALUEB = Z_ROB*Z_PVAL0+(1.-Z_ROB)*(-PDELTAI*Z_DVAL0/2.+PVALUEI(3))
+ !
+ RETURN
+ !
+END FUNCTION IBM_0DINT
diff --git a/src/MNH/ibm_1Dint.f90 b/src/MNH/ibm_1Dint.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7c986e9ef375612292014cc9c3083b91f314972a
--- /dev/null
+++ b/src/MNH/ibm_1Dint.f90
@@ -0,0 +1,193 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #####################
+MODULE MODI_IBM_1DINT
+ ! #####################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_1DINT(PLOCATI,PVALUEI,HINTERP) RESULT(PVALUEG)
+ !
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL :: PVALUEG
+ !
+ END FUNCTION IBM_1DINT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_1DINT
+!
+! ###########################################################
+FUNCTION IBM_1DINT(PLOCATI,PVALUEI,HINTERP) RESULT(PVALUEG)
+ ! ###########################################################
+ !
+ !!**** *IBM_INTER_1DINT* - Classical Lagrange interpolation 1D
+ !!
+ !! PURPOSE
+ !! -------
+ ! This function interpolates the 1D fields from the image(s) point
+ ! to the mirror point associated to each ghost nodes. The interpolation
+ ! weighting is based on the Lagrange polynomials between the image point
+ ! F(X,Y,Z) and each N selected nearest nodes F(Xi,Yi,Zi). The number of
+ ! nodes is depending on the interpolation order. The direction of the
+ ! interpolation is normal to the interface.
+ !
+ !!
+ !! METHOD
+ !! ------
+ !!
+ ! F(X,Y,Z)= sum(i=1toN)sum(j=1toN)sum(k=1toN)[[[Li(x)Lj(y)Lz(k)F(Xi,Yi,Zi)]]]
+ ! where La(B)=prod(l=1toN,l/=a) (B-Bl)/(Bb-Bl)
+ !
+ ! Three interpolations type is implemented. Each type uses respectively
+ ! MIRROR : computation of the mirror of the ghost
+ ! IMAGE1 : one image point with an imposed distance to the interface (1.V_cell**1/3)
+ ! IMAGE2 : a secund image with an imposed distance to the interface (2.V_cell**1/3)
+ !
+ !! INDEX
+ !! -----
+ !!
+ ! PLOCATI(1) (resp. PVALUEI(1)) is the image 1 location (resp. value) === CL0 ===
+ ! PLOCATI(2) (resp. PVALUEI(2)) is the image 2 location (resp. value) === CL1 ===
+ ! PLOCATI(3) (resp. PVALUEI(3)) is the mirror location (resp. value) === CL2 ===
+ ! PVALUEI(4) is the bound value
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !!
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL :: PVALUEG
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ REAL :: Z_PLAG_G0,Z_PLAG_I1,Z_PLAG_I2
+ REAL :: Z_CINT_G0,Z_CINT_I1,Z_CINT_I2
+ REAL :: Z_CINT_GG,Z_CINT_II
+ REAL :: Z_PLAG_GG,Z_PLAG_II
+ REAL :: ZVALUEMIN,ZVALUEMAX
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ IF (HINTERP=='CL3') THEN
+ !
+ ! Lagrange polynomials
+ Z_PLAG_G0 = (-PLOCATI(3)-PLOCATI(1))/(0. -PLOCATI(1))*&
+ (-PLOCATI(3)-PLOCATI(2))/(0. -PLOCATI(2))
+ Z_PLAG_I1 = (-PLOCATI(3)-0. )/(+PLOCATI(1)- 0.)*&
+ (-PLOCATI(3)-PLOCATI(2))/(+PLOCATI(1)-PLOCATI(2))
+ Z_PLAG_I2 = (-PLOCATI(3)-0. )/(+PLOCATI(2)- 0.)*&
+ (-PLOCATI(3)-PLOCATI(1))/(+PLOCATI(2)-PLOCATI(1))
+ !
+ ! Interpolation coeffs
+ Z_CINT_G0 = Z_PLAG_G0
+ Z_CINT_I1 = Z_PLAG_I1
+ Z_CINT_I2 = Z_PLAG_I2
+ !
+ ! Mirror value computation
+ PVALUEG = Z_CINT_G0*PVALUEI(4)+Z_CINT_I1*PVALUEI(1)+Z_CINT_I2*PVALUEI(2)
+ !
+ ENDIF
+ !
+ IF (HINTERP=='CL2') THEN
+ !
+ ! Lagrange polynomials
+ Z_PLAG_G0 = (PLOCATI(3)-PLOCATI(1))/(-PLOCATI(3)-PLOCATI(1))*&
+ (PLOCATI(3)-PLOCATI(2))/(-PLOCATI(3)-PLOCATI(2))
+ Z_PLAG_I1 = (PLOCATI(3)+PLOCATI(3))/(+PLOCATI(1)+PLOCATI(3))*&
+ (PLOCATI(3)-PLOCATI(2))/(+PLOCATI(1)-PLOCATI(2))
+ Z_PLAG_I2 = (PLOCATI(3)+PLOCATI(3))/(+PLOCATI(2)+PLOCATI(3))*&
+ (PLOCATI(3)-PLOCATI(1))/(+PLOCATI(2)-PLOCATI(1))
+ !
+ ! Interpolation coeffs
+ Z_CINT_G0 = 1./(1.+Z_PLAG_G0)*(2.*Z_PLAG_G0)
+ Z_CINT_I1 = 1./(1.+Z_PLAG_G0)*(1.*Z_PLAG_I1)
+ Z_CINT_I2 = 1./(1.+Z_PLAG_G0)*(1.*Z_PLAG_I2)
+ !
+ ! Mirror value computation
+ PVALUEG = Z_CINT_G0*PVALUEI(4)+Z_CINT_I1*PVALUEI(1)+Z_CINT_I2*PVALUEI(2)
+ !
+ ! Value limitation
+ ZVALUEMIN = +XIBM_IEPS
+ ZVALUEMAX = -XIBM_IEPS
+ ZVALUEMIN = MIN(ZVALUEMIN,PVALUEI(1))
+ ZVALUEMIN = MIN(ZVALUEMIN,PVALUEI(2))
+ ZVALUEMIN = MIN(ZVALUEMIN,PVALUEI(4))
+ ZVALUEMAX = MAX(ZVALUEMAX,PVALUEI(1))
+ ZVALUEMAX = MAX(ZVALUEMAX,PVALUEI(2))
+ ZVALUEMAX = MAX(ZVALUEMAX,PVALUEI(4))
+ PVALUEG = MAX(PVALUEG,ZVALUEMIN)
+ PVALUEG = MIN(PVALUEG,ZVALUEMAX)
+ !
+ ENDIF
+ !
+ IF (HINTERP=='CL1') THEN
+ !
+ ! Lagrange polynomials
+ Z_PLAG_GG = (PLOCATI(3)-PLOCATI(1))/(-PLOCATI(3)-PLOCATI(1))
+ Z_PLAG_II = (PLOCATI(3)+PLOCATI(3))/(+PLOCATI(3)+PLOCATI(1))
+ !
+ ! Interpolation coeffs
+ Z_CINT_GG = 1./(1.+Z_PLAG_GG)*(2.*Z_PLAG_GG)
+ Z_CINT_II = 1./(1.+Z_PLAG_GG)*(1.*Z_PLAG_II)
+ !
+ ! Mirror value computation
+ PVALUEG = Z_CINT_GG*PVALUEI(4)+Z_CINT_II*PVALUEI(1)
+ !
+ ENDIF
+ !
+ IF (HINTERP=='CL0') THEN
+ !
+ PVALUEG = PVALUEI(3)
+ !
+ ENDIF
+ !
+ RETURN
+ !
+END FUNCTION IBM_1DINT
diff --git a/src/MNH/ibm_3Dint.f90 b/src/MNH/ibm_3Dint.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f055a64bae3cccff938f8ea009867a4f058b4ba2
--- /dev/null
+++ b/src/MNH/ibm_3Dint.f90
@@ -0,0 +1,322 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #####################
+MODULE MODI_IBM_3DINT
+ ! #####################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_3DINT(KTYPUVW,PVALUEI,PLOCATI,PTESTG0,PLOCAT1,PVALUE1,PLOCAT2,HINTERP,PRADIUS,PPOWERS) RESULT(PVALUE2)
+ !
+ INTEGER :: KTYPUVW
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PTESTG0
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PLOCAT1
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUE1
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCAT2
+ REAL :: PVALUE2
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL , INTENT(IN) :: PRADIUS
+ REAL , INTENT(IN) :: PPOWERS
+ !
+ END FUNCTION IBM_3DINT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_3DINT
+!
+! ###################################################################################################################
+FUNCTION IBM_3DINT(KTYPUVW,PVALUEI,PLOCATI,PTESTG0,PLOCAT1,PVALUE1,PLOCAT2,HINTERP,PRADIUS,PPOWERS) RESULT(PVALUE2)
+ ! ###################################################################################################################
+ !
+ !**** ===IBM_INTER_IDW=== inverse distance weighting interpolation
+ !
+ ! PURPOSE
+ ! -------
+ ! This function interpolates the 3D fields from the initial grid
+ ! to the image point associated to each ghost nodes. The interpolation
+ ! weighting is based on the inverse of the (square of) the interpolation distance
+ ! between the image point F(X,Y,Z) and each N selected nearest nodes F(Xi,Yi,Zi).
+ !
+ ! METHOD
+ ! ------
+ !
+ ! F(X,Y,Z)= sum(i=1toN)[|1/Di|F(Xi,Yi,Zi)] / sum(i=1toN)[|1/Di|]
+ ! Di as a power of the distance interpolation
+ !
+ !**** ===IBM_INTER_MDW=== modified inverse distance weighting interpolation
+ !
+ ! PURPOSE
+ ! -------
+ ! This function interpolates the 3D fields from the initial grid
+ ! to the image point associated to each ghost nodes. The interpolation
+ ! weighting is based on the Franke formulation (2004) between the image point
+ ! F(X,Y,Z) and each N selected nearest nodes F(Xi,Yi,Zi). The number of
+ ! nodes is depending on the interpolation order.
+ !
+ ! METHOD
+ ! ------
+ !
+ ! F(X,Y,Z)= sum(i=1toN)[|1/Di|F(Xi,Yi,Zi)] / sum(i=1toN)[|1/Di|]
+ ! Di according to :
+ ! "Scattered Data: tests of some methods."
+ ! Franke R., Mathematics of computation, 2004
+ !
+ !**** ===IBM_INTER_CLI=== classical Lagrange interpolation
+ !
+ ! PURPOSE
+ ! -------
+ ! This function interpolates the 3D fields from the initial grid
+ ! to the image point associated to each ghost nodes. The interpolation
+ ! weighting is based on the trilinear interpolation via Lagrange polynomials
+ !
+ ! METHOD
+ ! ------
+ !
+ ! F(X,Y,Z)= sum(i=1toN)[|Li|F(Xi,Yi,Zi)]
+ ! Li = prod[(x-xj)(xi-xj)] (xi/=xj)
+ !
+ ! INDEX DEFINITION
+ ! ----------------
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ INTEGER :: KTYPUVW
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PTESTG0
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PLOCAT1
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUE1
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCAT2
+ REAL :: PVALUE2
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL , INTENT(IN) :: PRADIUS
+ REAL , INTENT(IN) :: PPOWERS
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ INTEGER :: JM,JN,JMM ! loop index
+ REAL, DIMENSION(:), ALLOCATABLE :: Z_WEIGHT0 ! interpolation weighting array
+ REAL :: Z_WEIGHT1,Z_WEIGHT2,Z_WEIGHT3 ! interpolation weighting scalar
+ REAL :: Z_LENGHTX,Z_LENGHTY,Z_LENGHTZ ! interpolation distance
+ REAL :: Z_LENGHTM,Z_VOLUME,Z_VALUE3 ! interpolation module
+ REAL :: Z_ORDINT, Z_TESTSB,Z_VALUE2 ! interpolation radius
+ CHARACTER(LEN=3) :: Y_INTERP,Y_INTERP2
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ALLOCATE(Z_WEIGHT0(10))
+ Z_WEIGHT0(:) = 0.
+ Z_WEIGHT1 = 0.
+ Z_WEIGHT2 = 0.
+ Z_WEIGHT3 = 0.
+ Z_VOLUME = 0.
+ Z_VALUE2 = 0.
+ Z_VALUE3 = 0.
+ JN = 0
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ ! Switch interface distance dependence
+ !
+ Z_TESTSB = 1.
+ DO JN=1,8
+ Z_TESTSB = min(Z_TESTSB,PTESTG0(JN))
+ ENDDO
+ !
+ Y_INTERP = HINTERP
+ Y_INTERP2 = 'CLI'
+ IF (HINTERP=='LAI') THEN
+ IF (Z_TESTSB.lt.+XIBM_EPSI) THEN
+ Y_INTERP = 'IDW'
+ ELSE
+ Y_INTERP = 'CLI'
+ ENDIF
+ ENDIF
+ IF (HINTERP=='LAM') THEN
+ IF (Z_TESTSB.lt.+XIBM_EPSI) THEN
+ Y_INTERP = 'MDW'
+ ELSE
+ Y_INTERP = 'CLI'
+ ENDIF
+ ENDIF
+ !
+ ! === Trilinear Lagrange interpolation ===
+ !
+ IF (Y_INTERP=='CLI') THEN
+ !
+ DO JM=1,8
+ JN=8-JM+1
+ IF ((ABS((PLOCAT1(JM,1)-PLOCAT1(JN,1))).GT.XIBM_EPSI).AND.&
+ (ABS((PLOCAT1(JM,2)-PLOCAT1(JN,2))).GT.XIBM_EPSI).AND.&
+ (ABS((PLOCAT1(JM,3)-PLOCAT1(JN,3))).GT.XIBM_EPSI)) THEN
+ !
+ Z_WEIGHT0(JM)=(PLOCAT2(1)-PLOCAT1(JN,1))/(PLOCAT1(JM,1)-PLOCAT1(JN,1))*&
+ (PLOCAT2(2)-PLOCAT1(JN,2))/(PLOCAT1(JM,2)-PLOCAT1(JN,2))*&
+ (PLOCAT2(3)-PLOCAT1(JN,3))/(PLOCAT1(JM,3)-PLOCAT1(JN,3))
+ !
+ ELSE
+ !
+ Z_VALUE3 = 1.
+ Z_WEIGHT0(JM) = +XIBM_EPSI
+ !
+ ENDIF
+ ENDDO
+ !
+ IF (Z_VALUE3<XIBM_EPSI) THEN
+ !
+ DO JM=1,8
+ Z_VALUE2 = Z_VALUE2 + Z_WEIGHT0(JM)
+ ENDDO
+ IF (ABS(Z_VALUE2-1.)>0.1) THEN
+ Z_WEIGHT0(:) = 1./8.
+ ENDIF
+ !
+ PVALUE2 = 0.
+ DO JM=1,8
+ PVALUE2 = PVALUE2 + PVALUE1(JM)*Z_WEIGHT0(JM)
+ ENDDO
+ !
+ ELSE
+ !
+ Y_INTERP2 = 'IDW'
+ PVALUE2 = 0.
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ IF (Y_INTERP2 == 'IDW') Y_INTERP = 'IDW'
+ !
+ ! === Inverse distance weighting interpolation (Modified or classical) ===
+ !
+ IF (Y_INTERP=='IDW'.or.Y_INTERP=='MDW') THEN
+ !
+ Z_VOLUME = ABS(PLOCAT1(1,1)-PLOCAT1(8,1))*&
+ ABS(PLOCAT1(1,2)-PLOCAT1(8,2))*&
+ ABS(PLOCAT1(1,3)-PLOCAT1(8,3))
+ !
+ JMM = 8
+ DO JM=1,JMM
+ !
+ IF (JM<=8) THEN
+ Z_LENGHTX = (PLOCAT2(1)-PLOCAT1(JM,1))
+ Z_LENGHTY = (PLOCAT2(2)-PLOCAT1(JM,2))
+ Z_LENGHTZ = (PLOCAT2(3)-PLOCAT1(JM,3))
+ ELSE
+ Z_LENGHTX = (PLOCAT2(1)-PLOCATI(1))
+ Z_LENGHTY = (PLOCAT2(2)-PLOCATI(2))
+ Z_LENGHTZ = (PLOCAT2(3)-PLOCATI(3))
+ ENDIF
+ Z_LENGHTM = (Z_LENGHTX**2.+Z_LENGHTY**2.+Z_LENGHTZ**2.)**0.5
+ !
+ Z_LENGHTM = MAX(Z_LENGHTM,0.0001*Z_VOLUME**(1./3.))
+ IF ((Z_LENGHTM.lt.(0.01*Z_VOLUME**(1./3.))).AND.(PTESTG0(JM).GT.0.5)) THEN
+ Z_WEIGHT1 = 2.*XIBM_IEPS
+ Z_WEIGHT3 = 1.
+ JN=JM
+ ELSE
+ Z_WEIGHT1 = 0.
+ IF (Z_LENGHTM.lt.PRADIUS*Z_VOLUME**(1./3.)) THEN
+ !
+ IF (JM<=8.and.Y_INTERP=='IDW') Z_WEIGHT1 = PTESTG0(JM)*(1./Z_LENGHTM)**PPOWERS
+ IF (JM==9.and.Y_INTERP=='IDW') Z_WEIGHT1 = (1./Z_LENGHTM)**PPOWERS
+ IF (JM<=8.and.Y_INTERP=='MDW') Z_WEIGHT1 = PTESTG0(JM)*((PRADIUS*Z_VOLUME**(1./3.)-Z_LENGHTM)/&
+ (PRADIUS*Z_VOLUME**(1./3.)*Z_LENGHTM))**PPOWERS
+ IF (JM==9.and.Y_INTERP=='MDW') Z_WEIGHT1 = ((PRADIUS*Z_VOLUME**(1./3.)-Z_LENGHTM)/&
+ (PRADIUS*Z_VOLUME**(1./3.)*Z_LENGHTM))**PPOWERS
+ ENDIF
+ ENDIF
+ !
+ Z_WEIGHT2 = Z_WEIGHT2+Z_WEIGHT1
+ Z_WEIGHT0(JM)=Z_WEIGHT1
+ !
+ ENDDO
+ !
+ Z_WEIGHT0(10)=Z_WEIGHT2
+ !
+ IF (Z_WEIGHT3.gt.XIBM_EPSI) THEN
+ Z_WEIGHT0(:)=0.
+ Z_WEIGHT0(JN)=1.
+ Z_WEIGHT0(10)=1.
+ ENDIF
+ !
+ IF (ABS(Z_WEIGHT0(10)).GT.XIBM_EPSI) THEN
+ !
+ PVALUE2 = 0.
+ DO JM=1,8
+ PVALUE2 = PVALUE2 + PVALUE1(JM)*Z_WEIGHT0(JM)/Z_WEIGHT0(10)
+ ENDDO
+ !
+ ELSE
+ !
+ PVALUE2 = 0.
+ DO JM=1,8
+ PVALUE2 = PVALUE2 + PVALUE1(JM)*(1./8.)
+ ENDDO
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ DEALLOCATE(Z_WEIGHT0)
+ !
+ RETURN
+ !
+END FUNCTION IBM_3DINT
diff --git a/src/MNH/ibm_affectp.f90 b/src/MNH/ibm_affectp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b0c998744f7971f296e01b421b8f959ed890136d
--- /dev/null
+++ b/src/MNH/ibm_affectp.f90
@@ -0,0 +1,354 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_AFFECTP
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_AFFECTP(PVAR,KIBM_LAYER,PRADIUS,PPOWERS,&
+ HIBM_MODE_INTE1,HIBM_MODE_INTE3,&
+ HIBM_TYPE_BOUND,HIBM_MODE_BOUND,&
+ HIBM_FORC_BOUND,PIBM_FORC_BOUND,PXMU,PDIV)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PVAR
+ INTEGER , INTENT(IN) :: KIBM_LAYER
+ REAL , INTENT(IN) :: PRADIUS
+ REAL , INTENT(IN) :: PPOWERS
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE1
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE3
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_TYPE_BOUND
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_BOUND
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_FORC_BOUND
+ REAL , INTENT(IN) :: PIBM_FORC_BOUND
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PDIV
+ !
+ END SUBROUTINE IBM_AFFECTP
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_AFFECTP
+!
+! ########################################################
+SUBROUTINE IBM_AFFECTP(PVAR,KIBM_LAYER,PRADIUS,PPOWERS,&
+ HIBM_MODE_INTE1,HIBM_MODE_INTE3,&
+ HIBM_TYPE_BOUND,HIBM_MODE_BOUND,&
+ HIBM_FORC_BOUND,PIBM_FORC_BOUND,PXMU,PDIV)
+ ! ########################################################
+ !
+ !
+ !**** IBM_AFFECTP computes the variable PVAR on desired ghost points :
+ ! - the P type of the ghost/image
+ ! - the 3D interpolation mode (HIBM_MODE_INTE3)
+ ! - the 1D interpolation mode (HIBM_MODE_INTE1)
+ ! - the boundary condition (HIBM_TYPE_BOUND)
+ ! - the symmetry character (HIBM_MODE_BOUND)
+ !
+ !
+ ! PURPOSE
+ ! -------
+ !**** Ghosts (resp. Images) locations are stored in KIBM_STOR_GHOST (resp. KIBM_STOR_IMAGE).
+ ! Solutions are computed in regard of the symmetry character of the solution:
+ ! HIBM_MODE_BOUND='SYME' (Symmetrical)
+ ! HIBM_MODE_BOUND='ASYM' (Anti-symmetrical)
+ ! The ghost value is depending on the variable value at the interface:
+ ! HIBM_TYPE_BOUND="NULL" (00 value)
+ ! HIBM_TYPE_BOUND="FREE" (I1 value)
+ ! HIBM_TYPE_BOUND="LINE" (linear evolution, only IMAGE2 type)
+ ! HIBM_TYPE_BOUND="LOGA" (logarithmic evol, only IMAGE2 type)
+ ! Three 3D interpolations exists HIBM_MODE_INTE3 = "IDW" (Inverse Distance Weighting)
+ ! HIBM_MODE_INTE3 = "MDW" (Modified Distance Weighting)
+ ! HIBM_MODE_INTE3 = "CLI" (Trilinear Lagrange interp. )
+ ! Three 1D interpolations exists HIBM_MODE_INTE1 = "CL1" (Lagrange Polynomials - 1 points - MIRROR)
+ ! HIBM_MODE_INTE1 = "CL2" (Lagrange Polynomials - 2 points - IMAGE1)
+ ! HIBM_MODE_INTE1 = "CL3" (Lagrange Polynomials - 3 points - IMAGE2)
+
+ ! METHOD
+ ! ------
+ ! - loop on ghosts
+ ! - functions storage
+ ! - computations of the location of the corners cell containing MIRROR/IMAGE1/IMAGE2
+ ! - 3D interpolation (IDW, MDW, CLI) to obtain the MIRROR/IMAGE1/IMAGE2 values
+ ! - computation of the value at the interface
+ ! - 1D interpolation (CLI1,CLI2,CLI3) to obtain the GHOSTS values
+ ! - Affectation
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XEXNREF
+ USE MODI_IBM_VALUECORN
+ USE MODI_IBM_LOCATCORN
+ USE MODI_IBM_3DINT
+ USE MODI_IBM_1DINT
+ USE MODI_IBM_0DINT
+ USE MODD_CST
+ USE MODD_CTURB
+ USE MODD_RADIATIONS_n
+ USE MODD_DYN_n
+ USE MODD_FIELD_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PVAR ! interpolated variable
+ INTEGER , INTENT(IN) :: KIBM_LAYER ! layer number
+ REAL , INTENT(IN) :: PRADIUS ! Radius for MDW
+ REAL , INTENT(IN) :: PPOWERS ! Power for IDW/MDW
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE1 ! interpolation 1D (normal)
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE3 ! interpolation 3D (isotropic)
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_TYPE_BOUND ! imposed variable at the interface
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_BOUND ! symm.-antisymm. solution
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_FORC_BOUND ! Neu,Dir,Rob CL
+ REAL , INTENT(IN) :: PIBM_FORC_BOUND
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PDIV
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL,JM,JMM,JN,JNN,JI2,JJ2,JK2 ! loop index
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: I_INDEX_CORN ! reference corner index
+ INTEGER :: I_GHOST_NUMB ! ghost number per layer
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_LOCAT_CORN,Z_LOCAT_IMAG ! corners coordinates
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_TESTS_CORN ! interface distance dependence
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_VALUE_CORN ! value variables at corners
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_VALUE_IMAG ! value at mirror/image1/image2
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_LOCAT_BOUN,Z_LOCAT_GHOS ! location of bound and ghost
+ CHARACTER(LEN=3) :: Y_TYPE_BOUND ! imposed variable at the interface
+ CHARACTER(LEN=3) :: Y_MODE_BOUND ! symm.-antisymm. solution
+ REAL :: Z_VALUE_GHOS,Z_DELTA_IMAG
+ REAL :: Z_FORC_BOUND,ZIBM_VISC,ZIBM_DIVK,ZSURF
+ REAL :: ZIBM_HALO
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ ALLOCATE(I_INDEX_CORN(3))
+ ALLOCATE(Z_LOCAT_CORN(8,3))
+ ALLOCATE(Z_VALUE_CORN(8))
+ ALLOCATE(Z_TESTS_CORN(8))
+ ALLOCATE(Z_LOCAT_IMAG(3,3))
+ ALLOCATE(Z_VALUE_IMAG(4))
+ ALLOCATE(Z_LOCAT_BOUN(3))
+ ALLOCATE(Z_LOCAT_GHOS(3))
+ !
+ !----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ I_INDEX_CORN(:) = 0
+ Z_LOCAT_CORN(:,:)= 0.
+ Z_VALUE_CORN(:) = 0.
+ Z_TESTS_CORN(:) = 0.
+ Z_LOCAT_IMAG(:,:)= 0.
+ Z_VALUE_IMAG(:) = 0.
+ Z_LOCAT_GHOS(:) = 0.
+ Z_LOCAT_BOUN(:) = 0.
+ Y_TYPE_BOUND = HIBM_TYPE_BOUND
+ Y_MODE_BOUND = HIBM_MODE_BOUND
+ Z_FORC_BOUND = PIBM_FORC_BOUND
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ DO JMM=1,KIBM_LAYER
+ !
+ ! searching number of ghosts
+ JM = size(NIBM_GHOST_P,1)
+ JI = 0
+ JJ = 0
+ JK = 0
+ DO WHILE ((JI==0.and.JJ==0.and.JK==0).and.JM>0)
+ JI = NIBM_GHOST_P(JM,JMM,1,1)
+ JJ = NIBM_GHOST_P(JM,JMM,1,2)
+ JK = NIBM_GHOST_P(JM,JMM,1,3)
+ IF (JI==0.and.JJ==0.and.JK==0) JM = JM - 1
+ ENDDO
+ I_GHOST_NUMB = JM
+ !
+ ! Loop on each P Ghosts
+ IF (I_GHOST_NUMB<=0) GO TO 666
+ DO JM = 1,I_GHOST_NUMB
+ !
+ ! ghost index/ls
+ JI = NIBM_GHOST_P(JM,JMM,1,1)
+ JJ = NIBM_GHOST_P(JM,JMM,1,2)
+ JK = NIBM_GHOST_P(JM,JMM,1,3)
+ IF (JI==0.or.JJ==0.or.JK==0) GO TO 777
+ Z_LOCAT_GHOS(:) = XIBM_GHOST_P(JM,JMM,1,:)
+ Z_LOCAT_BOUN(:) = 2.0*XIBM_IMAGE_P(JM,JMM,1,1,:)-1.0*XIBM_IMAGE_P(JM,JMM,1,2,:)
+ ZIBM_HALO=1.
+ !
+ ! === IMAGE1/IMAGE2 computation ===
+ !
+ DO JN = 1,3
+ !
+ Z_LOCAT_IMAG(JN,:)= XIBM_IMAGE_P(JM,JMM,1 ,JN,:)
+ Z_DELTA_IMAG = ((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))**0.5
+ I_INDEX_CORN(:) = NIBM_IMAGE_P(JM,JMM,1,1,JN,:)
+ IF (I_INDEX_CORN(1)==0.AND.JN==2) ZIBM_HALO=0.
+ IF (I_INDEX_CORN(2)==0.AND.JN==2) ZIBM_HALO=0.
+ Z_LOCAT_CORN(:,:) = IBM_LOCATCORN(I_INDEX_CORN,1)
+ Z_TESTS_CORN(:) = XIBM_TESTI_P(JM,JMM,1,1,JN,:)
+ Z_VALUE_CORN(:) = IBM_VALUECORN(PVAR,I_INDEX_CORN)
+ Z_VALUE_IMAG(JN) = IBM_3DINT(JN,Z_VALUE_IMAG,Z_LOCAT_BOUN,Z_TESTS_CORN,&
+ Z_LOCAT_CORN,Z_VALUE_CORN,Z_LOCAT_IMAG(JN,:),&
+ HIBM_MODE_INTE3,PRADIUS,PPOWERS)
+ !
+ ENDDO
+ !
+ ZIBM_VISC = PXMU(JI,JJ,JK)
+ ZIBM_DIVK = PDIV(JI,JJ,JK)
+ !
+ JN = 4
+ Z_VALUE_IMAG(JN) = IBM_0DINT(Z_DELTA_IMAG,Z_VALUE_IMAG,HIBM_TYPE_BOUND,HIBM_FORC_BOUND,Z_FORC_BOUND,ZIBM_VISC,ZIBM_DIVK)
+ !
+ ! === GHOST computation ===
+ !
+ ! functions storage
+ Z_LOCAT_IMAG(1,3) = ((XIBM_GHOST_P(JM,JMM,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_GHOST_P(JM,JMM,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_GHOST_P(JM,JMM,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+
+ IF ((Z_LOCAT_IMAG(1,3)>Z_DELTA_IMAG).AND.ZIBM_HALO>0.5) THEN
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_P(JM,JMM,1,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_P(JM,JMM,1,2,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,2,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,2,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ ELSE
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_P(JM,JMM,1,3,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,3,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,3,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_P(JM,JMM,1,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_VALUE_IMAG(2) = Z_VALUE_IMAG(1)
+ Z_VALUE_IMAG(1) = Z_VALUE_IMAG(3)
+ ENDIF
+ !
+ Z_VALUE_GHOS = IBM_1DINT(Z_LOCAT_IMAG(1,:),Z_VALUE_IMAG,HIBM_MODE_INTE1)
+ !
+ JN = 3
+ I_INDEX_CORN(:) = NIBM_IMAGE_P(JM,JMM,1,1,JN,:)
+ Z_VALUE_CORN(:) = IBM_VALUECORN(XIBM_LS(:,:,:,1),I_INDEX_CORN)
+ Z_LOCAT_CORN(:,:) = IBM_LOCATCORN(I_INDEX_CORN,1)
+ DO JL=1,8
+ IF (JL==1) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==2) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==3) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==4) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==5) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ IF (JL==6) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ IF (JL==7) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ IF (JL==8) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ ZSURF = ((Z_LOCAT_CORN(JL,1)-Z_LOCAT_BOUN(1))**2.+ &
+ (Z_LOCAT_CORN(JL,2)-Z_LOCAT_BOUN(2))**2.+ &
+ (Z_LOCAT_CORN(JL,3)-Z_LOCAT_BOUN(3))**2.)**0.5/(Z_DELTA_IMAG/2.)
+ IF ((ZSURF<1.).AND.(Z_VALUE_CORN(JL).LT.(XIBM_EPSI)).AND.((PVAR(JI2,JJ2,JK2)-Z_VALUE_IMAG(3))*(PVAR(JI2,JJ2,JK2)- &
+ Z_VALUE_IMAG(4)).GT.XIBM_EPSI)) THEN
+ PVAR(JI2,JJ2,JK2) = 0.5*PVAR(JI2,JJ2,JK2)+0.5*(Z_VALUE_IMAG(4)-(Z_VALUE_IMAG(3)-Z_VALUE_IMAG(4))* &
+ Z_VALUE_CORN(JL)/(Z_DELTA_IMAG/2.))
+ ENDIF
+ ENDDO
+ !
+ IF (Y_MODE_BOUND=='SYM') PVAR(JI,JJ,JK) = +Z_VALUE_GHOS
+ IF (Y_MODE_BOUND=='ASY') PVAR(JI,JJ,JK) = -Z_VALUE_GHOS + 2.*Z_VALUE_IMAG(4)
+ IF (Y_MODE_BOUND=='CST') PVAR(JI,JJ,JK) = Z_VALUE_IMAG(4)
+ !
+777 CONTINUE
+ ENDDO
+
+ ENDDO
+ !
+666 CONTINUE
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(I_INDEX_CORN)
+ DEALLOCATE(Z_LOCAT_CORN)
+ DEALLOCATE(Z_VALUE_CORN)
+ DEALLOCATE(Z_LOCAT_IMAG)
+ DEALLOCATE(Z_VALUE_IMAG)
+ DEALLOCATE(Z_LOCAT_BOUN)
+ DEALLOCATE(Z_LOCAT_GHOS)
+ DEALLOCATE(Z_TESTS_CORN)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_AFFECTP
diff --git a/src/MNH/ibm_affectv.f90 b/src/MNH/ibm_affectv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1a5711e10bf7388cb89e7c965f4b657e51f52a1e
--- /dev/null
+++ b/src/MNH/ibm_affectv.f90
@@ -0,0 +1,403 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_AFFECTV
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_AFFECTV(PVAR,PVAR2,PVAR3,HVAR,KIBM_LAYER,HIBM_MODE_INTE3,&
+ HIBM_FORC_BOUNR,PRADIUS,PPOWERS,&
+ HIBM_MODE_INT1N,HIBM_TYPE_BOUNN,HIBM_MODE_BOUNN,HIBM_FORC_BOUNN,PIBM_FORC_BOUNN,&
+ HIBM_MODE_INT1T,HIBM_TYPE_BOUNT,HIBM_MODE_BOUNT,HIBM_FORC_BOUNT,PIBM_FORC_BOUNT,&
+ HIBM_MODE_INT1C,HIBM_TYPE_BOUNC,HIBM_MODE_BOUNC,HIBM_FORC_BOUNC,PIBM_FORC_BOUNC,PXMU,PDIV)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PVAR
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVAR2,PVAR3
+ CHARACTER(LEN=1) ,INTENT(IN) :: HVAR
+ INTEGER ,INTENT(IN) :: KIBM_LAYER
+ REAL ,INTENT(IN) :: PRADIUS
+ REAL ,INTENT(IN) :: PPOWERS
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNR
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INTE3
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1N
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNN
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1T
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNT
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1C
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNC
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNC
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PDIV
+ !
+ END SUBROUTINE IBM_AFFECTV
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_AFFECTV
+!
+! ########################################################
+SUBROUTINE IBM_AFFECTV(PVAR,PVAR2,PVAR3,HVAR,KIBM_LAYER,HIBM_MODE_INTE3,&
+ HIBM_FORC_BOUNR,PRADIUS,PPOWERS,&
+ HIBM_MODE_INT1N,HIBM_TYPE_BOUNN,HIBM_MODE_BOUNN,HIBM_FORC_BOUNN,PIBM_FORC_BOUNN,&
+ HIBM_MODE_INT1T,HIBM_TYPE_BOUNT,HIBM_MODE_BOUNT,HIBM_FORC_BOUNT,PIBM_FORC_BOUNT,&
+ HIBM_MODE_INT1C,HIBM_TYPE_BOUNC,HIBM_MODE_BOUNC,HIBM_FORC_BOUNC,PIBM_FORC_BOUNC,PXMU,PDIV)
+ ! ########################################################
+ !
+ !
+ !**** IBM_AFFECTV computes the variable PVAR on desired ghost points :
+ ! - the V type of the ghost/image
+ ! - the 3D interpolation mode (HIBM_MODE_INTE3)
+ ! - the 1D interpolation mode (HIBM_MODE_INTE1)
+ ! - the boundary condition (HIBM_TYPE_BOUND)
+ ! - the symmetry character (HIBM_MODE_BOUND)
+ ! - the forcing type (HIBM_FORC_BOUND)
+ ! - the forcing term (HIBM_FORC_BOUND)
+ ! Choice of forcing type is depending on
+ ! the normal, binormal, tangent vectors (N,C,T)
+ !
+ !
+ ! PURPOSE
+ ! -------
+ !**** Ghosts (resp. Images) locations are stored in KIBM_STOR_GHOST (resp. KIBM_STOR_IMAGE).
+ ! Solutions are computed in regard of the symmetry character of the solution:
+ ! HIBM_MODE_BOUND = 'SYM' (Symmetrical)
+ ! HIBM_MODE_BOUND = 'ASY' (Anti-symmetrical)
+ ! The ghost value is depending on the variable value at the interface:
+ ! HIBM_TYPE_BOUND = "CST" (constant value)
+ ! HIBM_TYPE_BOUND = "LAW" (wall models)
+ ! HIBM_TYPE_BOUND = "LIN" (linear evolution, only IMAGE2 type)
+ ! HIBM_TYPE_BOUND = "LOG" (logarithmic evol, only IMAGE2 type)
+ ! Three 3D interpolations exists HIBM_MODE_INTE3 = "IDW" (Inverse Distance Weighting)
+ ! HIBM_MODE_INTE3 = "MDW" (Modified Distance Weighting)
+ ! HIBM_MODE_INTE3 = "LAG" (Trilinear Lagrange interp. )
+ ! Three 1D interpolations exists HIBM_MODE_INTE1 = "CL0" (Lagrange Polynomials - 1 points - MIRROR)
+ ! HIBM_MODE_INTE1 = "CL1" (Lagrange Polynomials - 2 points - IMAGE1)
+ ! HIBM_MODE_INTE1 = "CL2" (Lagrange Polynomials - 3 points - IMAGE2)
+ ! METHOD
+ ! ------
+ ! - loop on ghosts
+ ! - functions storage
+ ! - computations of the location of the corners cell containing MIRROR/IMAGE1/IMAGE2
+ ! - 3D interpolation (IDW, MDW, CLI) to obtain the MIRROR/IMAGE1/IMAGE2 values
+ ! - computation of the value at the interface
+ ! - 1D interpolation (CLI1,CLI2,CLI3) to obtain the GHOSTS values
+ ! - Affectation
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_FIELD_n
+ USE MODD_PARAM_n, ONLY: CTURB
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_LBC_n
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+ !
+ ! interface
+ USE MODI_IBM_MIXINGLENGTH
+ USE MODI_IBM_VALUECORN
+ USE MODI_IBM_LOCATCORN
+ USE MODI_IBM_3DINT
+ USE MODI_IBM_1DINT
+ USE MODI_IBM_0DINT
+ USE MODI_IBM_VALUEMAT1
+ USE MODI_IBM_VALUEMAT2
+ USE MODI_SHUMAN
+ USE MODD_DYN_n
+ USE MODD_FIELD_n
+ USE MODD_CST
+ USE MODD_CTURB
+ USE MODD_RADIATIONS_n
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PVAR
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVAR2,PVAR3
+ CHARACTER(LEN=1) ,INTENT(IN) :: HVAR
+ INTEGER ,INTENT(IN) :: KIBM_LAYER
+ REAL ,INTENT(IN) :: PRADIUS
+ REAL ,INTENT(IN) :: PPOWERS
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNR
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INTE3
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1N
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNN
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1T
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNT
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1C
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNC
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNC
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PDIV
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL,JM,JMM,JN,JNN,JH,JLL ! loop index
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: I_INDEX_CORN ! reference corner index
+ INTEGER :: I_GHOST_NUMB ! ghost number per layer
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_LOCAT_CORN,Z_LOCAT_IMAG ! corners coordinates
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_TESTS_CORN ! interface distance dependence
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_VALUE_CORN ! value variables at corners
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_VALUE_IMAG,Z_VALUE_TEMP,Z_VALUE_ZLKE ! value at mirror/image1/image2
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_LOCAT_BOUN,Z_LOCAT_GHOS,Z_TEMP_ZLKE ! location of bound and ghost
+ REAL :: Z_DELTA_IMAG,ZIBM_VISC,ZIBM_DIVK
+ CHARACTER(LEN=3),DIMENSION(:), ALLOCATABLE :: Y_TYPE_BOUND,Y_FORC_BOUND,Y_MODE_BOUND,Y_MODE_INTE1
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_FORC_BOUND,Z_VALUE_GHOS
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_VALUE_MAT1,Z_VALUE_MAT2
+ REAL :: ZIBM_HALO
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ ALLOCATE(I_INDEX_CORN(3))
+ ALLOCATE(Z_LOCAT_CORN(8,3))
+ ALLOCATE(Z_VALUE_CORN(8))
+ ALLOCATE(Z_TESTS_CORN(8))
+ ALLOCATE(Z_LOCAT_IMAG(3,3))
+ ALLOCATE(Z_VALUE_IMAG(4,3))
+ ALLOCATE(Z_VALUE_TEMP(4,3))
+ ALLOCATE(Z_LOCAT_BOUN(3))
+ ALLOCATE(Z_LOCAT_GHOS(3))
+ ALLOCATE(Z_VALUE_GHOS(3))
+ ALLOCATE(Y_TYPE_BOUND(3),Y_FORC_BOUND(3))
+ ALLOCATE(Y_MODE_BOUND(3),Y_MODE_INTE1(3))
+ ALLOCATE(Z_FORC_BOUND(3))
+ ALLOCATE(Z_VALUE_MAT1(3,3))
+ ALLOCATE(Z_VALUE_MAT2(3,3))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ I_INDEX_CORN(:) = 0
+ Z_LOCAT_CORN(:,:) = 0.
+ Z_VALUE_CORN(:) = 0.
+ Z_TESTS_CORN(:) = 0.
+ Z_LOCAT_IMAG(:,:) = 0.
+ Z_VALUE_IMAG(:,:) = 0.
+ Z_VALUE_TEMP(:,:) = 0.
+ Z_LOCAT_GHOS(:) = 0.
+ Z_LOCAT_BOUN(:) = 0.
+ Z_VALUE_GHOS(:) = 0.
+ Z_VALUE_MAT1(:,:) = 0.
+ Z_VALUE_MAT2(:,:) = 0.
+ IF (HVAR=='U') JH = 1
+ IF (HVAR=='V') JH = 2
+ IF (HVAR=='W') JH = 3
+ Y_TYPE_BOUND(1) = HIBM_TYPE_BOUNN
+ Y_TYPE_BOUND(2) = HIBM_TYPE_BOUNT
+ Y_TYPE_BOUND(3) = HIBM_TYPE_BOUNC
+ Y_FORC_BOUND(1) = HIBM_FORC_BOUNN
+ Y_FORC_BOUND(2) = HIBM_FORC_BOUNT
+ Y_FORC_BOUND(3) = HIBM_FORC_BOUNC
+ Y_MODE_BOUND(1) = HIBM_MODE_BOUNN
+ Y_MODE_BOUND(2) = HIBM_MODE_BOUNT
+ Y_MODE_BOUND(3) = HIBM_MODE_BOUNC
+ Y_MODE_INTE1(1) = HIBM_MODE_INT1N
+ Y_MODE_INTE1(2) = HIBM_MODE_INT1T
+ Y_MODE_INTE1(3) = HIBM_MODE_INT1C
+ Z_FORC_BOUND(1) = PIBM_FORC_BOUNN
+ Z_FORC_BOUND(2) = PIBM_FORC_BOUNT
+ Z_FORC_BOUND(3) = PIBM_FORC_BOUNC
+ !
+ ALLOCATE(Z_VALUE_ZLKE(4,3))
+ ALLOCATE(Z_TEMP_ZLKE(3))
+ Z_VALUE_ZLKE(:,:) = 0.
+ Z_TEMP_ZLKE(:) = 0.
+ !
+ DO JMM=1,KIBM_LAYER
+ !
+ ! searching number of ghosts
+ JM = size(NIBM_GHOST_V,1)
+ JI = 0
+ JJ = 0
+ JK = 0
+ DO WHILE ((JI==0.and.JJ==0.and.JK==0).and.JM>0)
+ JI = NIBM_GHOST_V(JM,JMM,JH,1)
+ JJ = NIBM_GHOST_V(JM,JMM,JH,2)
+ JK = NIBM_GHOST_V(JM,JMM,JH,3)
+ IF (JI==0.and.JJ==0.and.JK==0) JM = JM - 1
+ ENDDO
+ I_GHOST_NUMB = JM
+ !
+ ! Loop on each P Ghosts
+ IF (I_GHOST_NUMB<=0) GO TO 666
+ DO JM = 1,I_GHOST_NUMB
+ !
+ ! ghost index/ls
+ JI = NIBM_GHOST_V(JM,JMM,JH,1)
+ JJ = NIBM_GHOST_V(JM,JMM,JH,2)
+ JK = NIBM_GHOST_V(JM,JMM,JH,3)
+ IF (JI==0.or.JJ==0.or.JK==0) GO TO 777
+ Z_LOCAT_GHOS(:) = XIBM_GHOST_V(JM,JMM,JH,:)
+ Z_LOCAT_BOUN(:) = 2.0*XIBM_IMAGE_V(JM,JMM,JH,1,:)-1.0*XIBM_IMAGE_V(JM,JMM,JH,2,:)
+ ZIBM_HALO = 1.
+ !
+ DO JN = 1,3
+ !
+ Z_LOCAT_IMAG(JN,:)= XIBM_IMAGE_V(JM,JMM,JH ,JN,:)
+ Z_DELTA_IMAG = ((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))**0.5
+ !
+ DO JLL=1,3
+ I_INDEX_CORN(:) = NIBM_IMAGE_V(JM,JMM,JH,JLL,JN,:)
+ IF (I_INDEX_CORN(1)==0.AND.JN==2) ZIBM_HALO=0.
+ IF (I_INDEX_CORN(2)==0.AND.JN==2) ZIBM_HALO=0.
+ Z_LOCAT_CORN(:,:) = IBM_LOCATCORN(I_INDEX_CORN,JLL+1)
+ Z_TESTS_CORN(:) = XIBM_TESTI_V(JM,JMM,JH,JLL,JN,:)
+ Z_VALUE_CORN(:) = IBM_VALUECORN(PVAR2(:,:,:,JLL),I_INDEX_CORN)
+ Z_VALUE_IMAG(JN,JLL) = IBM_3DINT(JN,Z_VALUE_IMAG(:,JLL),Z_LOCAT_BOUN,Z_TESTS_CORN,&
+ Z_LOCAT_CORN,Z_VALUE_CORN,Z_LOCAT_IMAG(JN,:),&
+ HIBM_MODE_INTE3,PRADIUS,PPOWERS)
+ ENDDO
+ !
+ ENDDO
+ ZIBM_VISC = PXMU(JI,JJ,JK)
+ ZIBM_DIVK = PDIV(JI,JJ,JK)
+ !
+ ! projection step
+ Z_VALUE_MAT1(:,:) = IBM_VALUEMAT1(Z_LOCAT_IMAG(1,:),Z_LOCAT_BOUN,Z_VALUE_IMAG,HIBM_FORC_BOUNR)
+ DO JN=1,3
+ Z_VALUE_TEMP(JN,:)= Z_VALUE_MAT1(:,1)*Z_VALUE_IMAG(JN,1) +&
+ Z_VALUE_MAT1(:,2)*Z_VALUE_IMAG(JN,2) +&
+ Z_VALUE_MAT1(:,3)*Z_VALUE_IMAG(JN,3)
+ ENDDO
+ !
+ ! === BOUND computation ===
+ !
+ JN=4
+ DO JLL=1,3
+ Z_VALUE_TEMP(JN,JLL) = IBM_0DINT(Z_DELTA_IMAG,Z_VALUE_TEMP(:,JLL),Y_TYPE_BOUND(JLL),Y_FORC_BOUND(JLL), &
+ Z_FORC_BOUND(JLL),ZIBM_VISC,ZIBM_DIVK)
+ ENDDO
+ !
+ ! inverse projection step
+ Z_VALUE_MAT2(:,:) = IBM_VALUEMAT2(Z_VALUE_MAT1)
+ Z_VALUE_IMAG(JN,:)= Z_VALUE_MAT2(:,1)*Z_VALUE_TEMP(JN,1) +&
+ Z_VALUE_MAT2(:,2)*Z_VALUE_TEMP(JN,2) +&
+ Z_VALUE_MAT2(:,3)*Z_VALUE_TEMP(JN,3)
+ !
+ ! === GHOST computation ===
+ !
+ ! functions storage
+ Z_LOCAT_IMAG(1,3) = ((XIBM_GHOST_V(JM,JMM,JH,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_GHOST_V(JM,JMM,JH,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_GHOST_V(JM,JMM,JH,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ IF (Z_LOCAT_IMAG(1,3)>Z_DELTA_IMAG.AND.ZIBM_HALO>0.5) THEN
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_V(JM,JMM,JH,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_V(JM,JMM,JH,2,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,2,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,2,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ ELSE
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_V(JM,JMM,JH,3,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,3,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,3,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_V(JM,JMM,JH,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_VALUE_TEMP(2,:) = Z_VALUE_TEMP(1,:)
+ Z_VALUE_TEMP(1,:) = Z_VALUE_TEMP(3,:)
+ ENDIF
+ !
+ DO JLL=1,3
+ Z_VALUE_GHOS(JLL) = IBM_1DINT(Z_LOCAT_IMAG(1,:),Z_VALUE_TEMP(:,JLL),Y_MODE_INTE1(JLL))
+ IF (Y_MODE_BOUND(JLL)=='SYM') Z_VALUE_GHOS(JLL) = +Z_VALUE_GHOS(JLL)
+ IF (Y_MODE_BOUND(JLL)=='ASY') Z_VALUE_GHOS(JLL) = -Z_VALUE_GHOS(JLL) + 2.*Z_VALUE_TEMP(4,JLL)
+ IF (Y_MODE_BOUND(JLL)=='CST') Z_VALUE_GHOS(JLL) = Z_VALUE_TEMP(4,JLL)
+ ENDDO
+ !
+ PVAR(JI,JJ,JK) = Z_VALUE_MAT2(JH,1)*Z_VALUE_GHOS(1) +&
+ Z_VALUE_MAT2(JH,2)*Z_VALUE_GHOS(2) +&
+ Z_VALUE_MAT2(JH,3)*Z_VALUE_GHOS(3)
+ !
+ IF ((JH==3).AND.(JK==2)) THEN
+ PVAR(JI,JJ,JK) = 0.
+ ENDIF
+ !
+777 CONTINUE
+ !
+ ENDDO
+ ENDDO
+ !
+666 CONTINUE
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(I_INDEX_CORN)
+ DEALLOCATE(Z_LOCAT_CORN)
+ DEALLOCATE(Z_VALUE_CORN)
+ DEALLOCATE(Z_LOCAT_IMAG)
+ DEALLOCATE(Z_VALUE_IMAG)
+ DEALLOCATE(Z_VALUE_TEMP)
+ DEALLOCATE(Z_LOCAT_BOUN)
+ DEALLOCATE(Z_LOCAT_GHOS)
+ DEALLOCATE(Z_VALUE_GHOS)
+ DEALLOCATE(Z_TESTS_CORN)
+ DEALLOCATE(Y_TYPE_BOUND,Y_FORC_BOUND)
+ DEALLOCATE(Y_MODE_BOUND,Y_MODE_INTE1)
+ DEALLOCATE(Z_FORC_BOUND)
+ DEALLOCATE(Z_VALUE_MAT1)
+ DEALLOCATE(Z_VALUE_MAT2)
+ DEALLOCATE(Z_VALUE_ZLKE)
+ DEALLOCATE(Z_TEMP_ZLKE)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_AFFECTV
diff --git a/src/MNH/ibm_balance.f90 b/src/MNH/ibm_balance.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2256cd097bc547fd789da11f5fc85507a808242d
--- /dev/null
+++ b/src/MNH/ibm_balance.f90
@@ -0,0 +1,553 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_BALANCE
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_BALANCE(PPHI,PVOL,PRUS,PRVS,PRWS,PBAL)
+ !
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PPHI
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVOL
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PBAL
+ !
+ END SUBROUTINE IBM_BALANCE
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_BALANCE
+!
+! #####################################################
+SUBROUTINE IBM_BALANCE(PPHI,PVOL,PRUS,PRVS,PRWS,PBAL)
+ ! #####################################################
+ !
+ !
+ !**** IBM_BALANCE computes the velocity divergence using a volumic approach
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to compute div(U)=1/V*int_S(u.n)dS
+ ! S is the modified surface and is estimated before MNH
+ ! U is approximated using adjacents points
+
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_CST, ONLY: XPI
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_LBC_n
+ USE MODD_REF_n
+ !
+ ! interface
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PPHI
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVOL
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PBAL
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIU,IJU,IKU
+ INTEGER :: IIE,IIB,IJE,IJB,IKE,IKB
+ INTEGER :: JI,JJ,JK,JL,JI2,JJ2,JK2,JM
+ REAL :: ZPH0,ZPH1,ZPH2,ZDEL,ZBAR,ZRAY,ZCOE,ZCO2
+ REAL :: ZVIT1,ZVIT2,ZVIT0,ZSIG0,ZSIG1,ZSIG2
+ REAL, DIMENSION(:,:,:,:) ,ALLOCATABLE :: ZIBM_FLUX
+ REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZFLU
+ REAL :: ZTOTO
+ REAL :: ZINVROOTPI
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ IKU = SIZE(PPHI,3)
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ ALLOCATE(ZIBM_FLUX(IIU,IJU,IKU,3))
+ ALLOCATE(ZFLU(IIU,IJU,IKU))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ZIBM_FLUX = 0.
+ ZFLU = 0.
+ ZTOTO = 1.0
+ ZINVROOTPI = 1.0/SQRT(XPI)
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ !
+ IF (PVOL(JI,JJ,JK,3).gt.XIBM_EPSI) THEN
+ !
+ ! Flux, west
+ JL = 2
+ JI2 = JI
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = 0.
+ ZDEL = SQRT((XYHAT(JJ+1)-XYHAT(JJ))*0.5*(XZZ(JI2,JJ,JK+1)-XZZ(JI2,JJ,JK)+XZZ(JI2-1,JJ,JK+1)-XZZ(JI2-1,JJ,JK)))
+ ZPH1 = PPHI(JI2 ,JJ ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRUS(JI2,JJ ,JK )
+ !
+ DO JM=1,8
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRUS(JI2,JJ2,JK2)
+ ZRAY = ZDEL*ZINVROOTPI*ZTOTO
+ ZBAR = 0.
+ !
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR=-ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ !
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = ZIBM_FLUX(JI2,JJ,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ ENDDO
+ !
+ ! Flux, East
+ JL = 2
+ JI2 = JI+1
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = 0.
+ ZDEL = SQRT((XYHAT(JJ+1)-XYHAT(JJ))*0.5*(XZZ(JI2,JJ,JK+1)-XZZ(JI2,JJ,JK)+XZZ(JI2-1,JJ,JK+1)-XZZ(JI2-1,JJ,JK)))
+ ZPH1 = PPHI(JI2 ,JJ ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRUS(JI2,JJ ,JK )
+ DO JM=1,8
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRUS(JI2,JJ2,JK2)
+ ZRAY = ZDEL*ZINVROOTPI*ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR=-ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = ZIBM_FLUX(JI2,JJ,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ! Flux, south
+ JL = 3
+ JJ2 = JJ
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*0.5*(XZZ(JI,JJ2,JK+1)-XZZ(JI,JJ2,JK)+XZZ(JI,JJ2-1,JK+1)-XZZ(JI,JJ2-1,JK)))
+ ZPH1 = PPHI(JI ,JJ2 ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRVS(JI ,JJ2,JK )
+ !
+ DO JM=1,8
+ !
+ IF (JM==1) THEN
+ JI2 = JI-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JI2 = JI-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JI2 = JI-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JI2 = JI+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JI2 = JI+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JI2 = JI+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JI2 = JI
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JI2 = JI
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRVS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = ZIBM_FLUX(JI,JJ2,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ ENDDO
+ !
+ ! Flux, north
+ JL = 3
+ JJ2 = JJ+1
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*0.5*(XZZ(JI,JJ2,JK+1)-XZZ(JI,JJ2,JK)+XZZ(JI,JJ2-1,JK+1)-XZZ(JI,JJ2-1,JK)))
+ ZPH1 = PPHI(JI ,JJ2 ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRVS(JI ,JJ2,JK )
+ !
+ DO JM=1,8
+ !
+ IF (JM==1) THEN
+ JI2 = JI-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JI2 = JI-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JI2 = JI-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JI2 = JI+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JI2 = JI+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JI2 = JI+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JI2 = JI
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JI2 = JI
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRVS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = ZIBM_FLUX(JI,JJ2,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ! Flux, bottom
+ JL = 4
+ JK2 = JK
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))
+ ZPH1 = PPHI(JI ,JJ ,JK2 ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRWS(JI ,JJ ,JK2)
+ !
+ DO JM=1,8
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JI2 = JI-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JI2 = JI+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRWS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ !
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = ZIBM_FLUX(JI,JJ,JK2,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ! Flux, top
+ JL = 4
+ JK2 = JK+1
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))
+ ZPH1 = PPHI(JI ,JJ ,JK2 ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRWS(JI ,JJ ,JK2)
+ !
+ DO JM=1,8
+ !
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JI2 = JI-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JI2 = JI+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRWS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = ZIBM_FLUX(JI,JJ,JK2,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ZFLU(IIB:IIE,IJB:IJE,IKB:IKE) = (ZIBM_FLUX(IIB+1:IIE+1,IJB :IJE ,IKB :IKE ,1)-ZIBM_FLUX(IIB:IIE,IJB:IJE,IKB:IKE,1) +&
+ ZIBM_FLUX(IIB :IIE ,IJB+1:IJE+1,IKB :IKE ,2)-ZIBM_FLUX(IIB:IIE,IJB:IJE,IKB:IKE,2) +&
+ ZIBM_FLUX(IIB :IIE ,IJB :IJE ,IKB+1:IKE+1,3)-ZIBM_FLUX(IIB:IIE,IJB:IJE,IKB:IKE,3))*&
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)/XRHODJ(IIB:IIE,IJB:IJE,IKB:IKE)
+ !
+ PBAL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1) = PBAL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1)* &
+ PVOL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1,2)+ZFLU(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1)* &
+ PVOL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1,3)
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ DEALLOCATE(ZIBM_FLUX,ZFLU)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_BALANCE
diff --git a/src/MNH/ibm_detect.f90 b/src/MNH/ibm_detect.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ca4530964ff6f617309a5df187c9c689cbf73d53
--- /dev/null
+++ b/src/MNH/ibm_detect.f90
@@ -0,0 +1,968 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! ######################
+MODULE MODI_IBM_DETECT
+ ! ######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_DETECT(PPHI)
+ !
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PPHI
+ !
+ END SUBROUTINE IBM_DETECT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_DETECT
+!
+! ###########################
+SUBROUTINE IBM_DETECT(PPHI)
+ ! ###########################
+ !
+ !
+ !**** IBM_DETECT is dedicated to the characterization of the ghost point and
+ ! associated image points
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to affect an specific index to cells where
+ ! ghost points are localized. Depending on order of numerical scheme the
+ ! thickness of ghost points layer varies as the index value. For each cell
+ ! marked as ghost the corresponding image point location is stored.
+
+ ! METHOD
+ ! ------
+ !**** Iterative procedure to characterize ghost point locations
+ ! - local test on the sign change of the levelset function (first layer)
+ ! - local detection of the first layer to define the neighboring second layer
+ ! - repeat of the previous step for high order numerical scheme
+ !
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_LBC_n
+ USE MODD_CONF, ONLY: NHALO
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_GRADIENT_M
+ USE MODI_GRADIENT_U
+ USE MODI_GRADIENT_V
+ USE MODI_GRADIENT_W
+ USE MODI_IBM_LOCATCORN
+ USE MODI_IBM_VALUECORN
+ USE MODI_IBM_INTERPOS
+ USE MODI_GRADIENT_UV
+ USE MODI_GRADIENT_VW
+ USE MODI_GRADIENT_UW
+ USE MODI_GDIV
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPHI ! LevelSet functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIB,IJB,IKB,IIE,IJE,IKE ! physical domain size
+ INTEGER :: IIU,IJU,IKU,IIUM,IJUM,IKUM,JN1,JN2 ! numerical domain size
+ INTEGER :: JI,JJ,JK,JI2,JJ2,JK2,JL,JM,JN,JMM,JNN,JP ! loop index
+ INTEGER :: JIM1,JIP1,JJM1,JJP1,JKM1,JKP1,JI3,JJ3,JK3 ! loop boundaries
+ INTEGER :: JIM2,JIP2,JJM2,JJP2,JKM2,JKP2
+ INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: I_INDE_GHOST ! ghosts index storage
+ INTEGER :: I_DIME_GHOST,I_INDE_LOCAT
+ INTEGER, DIMENSION(:,:) , ALLOCATABLE :: I_NUMB_GHOST
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: I_INDE_TEMPO,I_INDE_TEMPO2
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll,I_NUMB_LAYER
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: ZXPOS,ZYPOS,ZZPOS,Z_NORM_TEMP1 ! staggered grid arrays
+ REAL, DIMENSION(:,:,:) , ALLOCATABLE :: Z_NORM_TEMP2,Z_NORM_TEMP3
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: Z_NORM_GHOST ! vec(n)
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: Z_NORM_TEMPO,ZIBM_TESTING,ZPHI
+ REAL :: ZLGHO
+ REAL, DIMENSION(:) , ALLOCATABLE :: ZVECT,ZPROD,Z_PHI
+ REAL, DIMENSION(:,:) , ALLOCATABLE :: Z_IMG,Z_GHO
+ INTEGER :: I_NUMB_LAYERV,I_NUMB_LAYERP,I_DIME_GHOSTV,I_DIME_GHOSTP
+ REAL :: ZSEAR,ZISI,ZJSI,ZKSI,ZLIMG
+ REAL :: ZIBM_TESTI,PPHI_CORR,PPHI_TEST
+ INTEGER :: JHALO,IKM,JLL
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ IIU=SIZE(PPHI,1)
+ IJU=SIZE(PPHI,2)
+ IKU=SIZE(PPHI,3)
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ IKB=1 +JPVEXT
+ IKE=IKU-JPVEXT
+ IKM=INT(IKU/2.)
+ !
+ ALLOCATE(I_INDE_GHOST(IIB:IIE,IJB:IJE,IKB:IKE,4))
+ ALLOCATE(ZIBM_TESTING(IIU,IJU,IKU,4))
+ ALLOCATE(Z_PHI(8),ZPROD(6),ZVECT(3),Z_IMG(8,3),Z_GHO(8,3),I_INDE_TEMPO(3),I_INDE_TEMPO2(3))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ JHALO = 0
+ ZVECT(:) = 0.
+ ZPROD(:) = 0.
+ Z_PHI(:) = 0.
+ Z_IMG(:,:) = 0.
+ Z_GHO(:,:) = 0.
+ I_INDE_TEMPO(:) = 0
+ I_INDE_GHOST(:,:,:,:) = 0
+ Z_NORM_GHOST(:,:,:,:) = 0.
+ Z_NORM_TEMPO(:,:,:,:) = 0.
+ ZIBM_TESTING(:,:,:,:) = 0.
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !I_IBM_NUMB_GHOST stores the ghost number per layer and node type
+ I_NUMB_LAYERV = NIBM_LAYER_V
+ I_NUMB_LAYERP = max(NIBM_LAYER_P,NIBM_LAYER_T,NIBM_LAYER_E, &
+ NIBM_LAYER_R,NIBM_LAYER_Q,NIBM_LAYER_S)
+ I_NUMB_LAYER = max(I_NUMB_LAYERV,I_NUMB_LAYERP)
+ !
+ ALLOCATE(I_NUMB_GHOST(4,I_NUMB_LAYER))
+ I_NUMB_GHOST(:,:)=0
+ !
+ ! Ghost cells detection
+ DO JL = 1,4
+ !
+ ! Number of ghost layers per PUVW nodes
+ IF (JL==1) THEN
+ I_NUMB_LAYER = I_NUMB_LAYERP
+ ELSE
+ I_NUMB_LAYER = I_NUMB_LAYERV
+ ENDIF
+ !
+ ! arrays computation
+ IF (JL==1) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ IF (JL==2) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ IF (JL==3) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ IF (JL==4) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ !
+ DO JK = IKB,IKUM
+ !
+ JKM1 = JK-I_NUMB_LAYER
+ JKP1 = JK+I_NUMB_LAYER
+ !
+ IF (JK==IKB ) JKM1 = JK
+ IF (JK==IKUM) JKP1 = JK
+ IF (I_NUMB_LAYER>=2) THEN
+ IF (JK==IKB+1 ) JKM1 = JK-1
+ IF (JK==IKUM-1) JKP1 = JK+1
+ ENDIF
+ IF (I_NUMB_LAYER>=3) THEN
+ IF (JK==IKB+2 ) JKM1 = JK-2
+ IF (JK==IKUM-2) JKP1 = JK+2
+ ENDIF
+ JKM1 = max(2 ,JKM1)
+ JKP1 = min(IKU-1,JKP1)
+ !
+ DO JJ = IJB,IJUM
+ !
+ JJM1 = JJ-I_NUMB_LAYER
+ JJP1 = JJ+I_NUMB_LAYER
+ !
+ IF (LSOUTH_ll().and.JJ==IJB) JJM1=JJ
+ IF (LNORTH_ll().and.JJ==IJUM) JJP1=JJ
+ IF (I_NUMB_LAYER>=2) THEN
+ IF (LSOUTH_ll().and.JJ==IJB+1) JJM1=JJ-1
+ IF (LNORTH_ll().and.JJ==IJUM-1) JJP1=JJ+1
+ ENDIF
+ IF (I_NUMB_LAYER>=3) THEN
+ IF (LSOUTH_ll().and.JJ==IJB+2) JJM1=JJ-2
+ IF (LNORTH_ll().and.JJ==IJUM-2) JJP1=JJ+2
+ ENDIF
+ JJM1 = max(1 ,JJM1)
+ JJP1 = min(IJU,JJP1)
+ !
+ DO JI = IIB,IIUM
+ !
+ JIM1 = JI-I_NUMB_LAYER
+ JIP1 = JI+I_NUMB_LAYER
+ !
+ IF (LWEST_ll().and.JI==IIB) JIM1=JI
+ IF (LEAST_ll().and.JI==IIUM) JIP1=JI
+ IF (I_NUMB_LAYER>=2) THEN
+ IF (LWEST_ll().and.JI==IIB+1) JIM1=JI-1
+ IF (LEAST_ll().and.JI==IIUM-1) JIP1=JI+1
+ ENDIF
+ IF (I_NUMB_LAYER>=3) THEN
+ IF (LWEST_ll().and.JI==IIB+2) JIM1=JI-2
+ IF (LEAST_ll().and.JI==IIUM-2) JIP1=JI+2
+ ENDIF
+ JIM1 = max(1 ,JIM1)
+ JIP1 = min(IIU,JIP1)
+ !
+ ! test for embedded solid region
+ IF (PPHI(JI,JJ,JK,JL).gt.-XIBM_EPSI) THEN
+ !
+ DO JM=1,3
+
+ IF (JM==1) THEN
+ JIM2 = JI
+ JIP2 = JI
+ JJM2 = JJ
+ JJP2 = JJ
+ JKM2 = JKM1
+ JKP2 = JKP1
+ ENDIF
+ IF (JM==2) THEN
+ JIM2 = JIM1
+ JIP2 = JIP1
+ JJM2 = JJ
+ JJP2 = JJ
+ JKM2 = JK
+ JKP2 = JK
+ ENDIF
+ IF (JM==3) THEN
+ JIM2 = JI
+ JIP2 = JI
+ JJM2 = JJM1
+ JJP2 = JJP1
+ JKM2 = JK
+ JKP2 = JK
+ ENDIF
+ !
+ DO JK2= JKM2,JKP2
+ DO JJ2= JJM2,JJP2
+ DO JI2= JIM2,JIP2
+ !
+ ! interface presence test (multi layer)
+ IF ((PPHI(JI,JJ,JK,JL)*PPHI(JI2,JJ2,JK2,JL)).lt.-XIBM_EPSI) THEN
+ I_INDE_LOCAT = max(abs(JI-JI2),abs(JJ-JJ2),abs(JK-JK2))
+ IF (I_INDE_GHOST(JI,JJ,JK,JL)/=0) THEN
+ I_INDE_GHOST(JI,JJ,JK,JL) = min(I_INDE_GHOST(JI,JJ,JK,JL),I_INDE_LOCAT)
+ ZIBM_TESTING(JI,JJ,JK,JL)=I_INDE_GHOST(JI,JJ,JK,JL)*1.
+ ELSE
+ I_INDE_GHOST(JI,JJ,JK,JL) = I_INDE_LOCAT
+ ZIBM_TESTING(JI,JJ,JK,JL)=I_INDE_GHOST(JI,JJ,JK,JL)*1.
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ENDDO
+ !
+ ! ghosts counter
+ IF (I_INDE_GHOST(JI,JJ,JK,JL)>0) THEN
+ I_NUMB_GHOST(JL,I_INDE_GHOST(JI,JJ,JK,JL))=I_NUMB_GHOST(JL,I_INDE_GHOST(JI,JJ,JK,JL))+1
+ ENDIF
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ENDDO
+ !
+ I_DIME_GHOSTV = 0
+ DO JL=1,I_NUMB_LAYERV
+ I_DIME_GHOSTV = max(I_DIME_GHOSTV,I_NUMB_GHOST(2,JL),I_NUMB_GHOST(3,JL),I_NUMB_GHOST(4,JL))
+ ENDDO
+ I_DIME_GHOSTP = 0
+ DO JL=1,I_NUMB_LAYERP
+ I_DIME_GHOSTP = max(I_DIME_GHOSTP,I_NUMB_GHOST(1,JL))
+ ENDDO
+ !
+ ! === GHOSTS storage ===
+ ! NIBM_STOR_GHOSV(A,B,C)
+ ! A : number of ghosts for each type of nodes
+ ! B : type of ghosts layer
+ ! C : type of ghosts PUVW
+ ! D : index location IJK
+ ALLOCATE(NIBM_GHOST_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3))
+ NIBM_GHOST_V(:,:,:,:) = 0
+ !
+ ! NIBM_STOR_GHOSP(A,B,C)
+ ! A : number of ghosts for each type of nodes P
+ ! B : type of ghosts layer
+ ! C : ---
+ ! D : index location IJK
+ ALLOCATE(NIBM_GHOST_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,3))
+ NIBM_GHOST_P(:,:,:,:) = 0
+ !
+ ! XIBM_STOR_GHOSV(A,B,C,D)
+ ! A : number of ghosts in each type of nodes PUVW
+ ! B : layer number
+ ! C : type of nodes UVW for the image(s)
+ ! D : location of the ghost
+ ALLOCATE(XIBM_GHOST_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3))
+ XIBM_GHOST_V(:,:,:,:) = 0.
+ !
+ ! XIBM_STOR_GHOSP(A,B,C,D,E)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : location of the ghost
+ ALLOCATE(XIBM_GHOST_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,3))
+ XIBM_GHOST_P(:,:,:,:) = 0.
+ !
+ ! Reset ghost research
+ I_NUMB_GHOST(:,:) = 0
+ DO JL = 1,4
+ !
+ ! Number of ghost layers per PUVW nodes
+ IF (JL==1) THEN
+ I_NUMB_LAYER = I_NUMB_LAYERP
+ ELSE
+ I_NUMB_LAYER = I_NUMB_LAYERV
+ ENDIF
+ !
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ !
+ DO JM = 1,I_NUMB_LAYER
+ DO JK = IKB,IKUM
+ DO JJ = IJB,IJUM
+ DO JI = IIB,IIUM
+ IF (I_INDE_GHOST(JI,JJ,JK,JL)==JM) THEN
+ I_NUMB_GHOST(JL,JM) = I_NUMB_GHOST(JL,JM) + 1
+ IF (JL==1) THEN
+ NIBM_GHOST_P(I_NUMB_GHOST(JL,JM),JM,JL ,1) = JI
+ NIBM_GHOST_P(I_NUMB_GHOST(JL,JM),JM,JL ,2) = JJ
+ NIBM_GHOST_P(I_NUMB_GHOST(JL,JM),JM,JL ,3) = JK
+ ELSE
+ NIBM_GHOST_V(I_NUMB_GHOST(JL,JM),JM,JL-1,1) = JI
+ NIBM_GHOST_V(I_NUMB_GHOST(JL,JM),JM,JL-1,2) = JJ
+ NIBM_GHOST_V(I_NUMB_GHOST(JL,JM),JM,JL-1,3) = JK
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ENDDO
+ !
+ !=== IMAGES cells detection ===
+ !
+ ! NIBM_TEST_IMAGV(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes UVW
+ ! B : layer number
+ ! C : UVW node type for ghost
+ ! D : UVW node type for image
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : corner index
+ ALLOCATE(XIBM_TESTI_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3,3,8))
+ XIBM_TESTI_V = 1.
+ !
+ ! NIBM_TEST_IMAGP(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : ---
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : corner index
+ ALLOCATE(XIBM_TESTI_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,1,3,8))
+ XIBM_TESTI_P = 1.
+ !
+ ! NIBM_STOR_IMAGV(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes UVW
+ ! B : layer number
+ ! C : UVW node type for ghost
+ ! D : UVW node type for image
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : index of the image(s)
+ ALLOCATE(NIBM_IMAGE_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3,3,3))
+ NIBM_IMAGE_V(:,:,:,:,:,:) = 0
+ !
+ ! NIBM_STOR_IMAGP(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : ---
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : index of the image(s)
+ ALLOCATE(NIBM_IMAGE_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,1,3,3))
+ NIBM_IMAGE_P(:,:,:,:,:,:) = 0
+ !
+ ! XIBM_STOR_IMAGV(A,B,C,D,E)
+ ! A : number of ghosts in each type of nodes PUVW
+ ! B : layer number
+ ! C : type of nodes UVW for the image(s)
+ ! D : 1 for IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! E : location of the image(s)
+ ALLOCATE(XIBM_IMAGE_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3,3))
+ XIBM_IMAGE_V(:,:,:,:,:) = 0.
+ !
+ ! XIBM_STOR_IMAGP(A,B,C,D,E)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : 1 for IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! E : location of the image(s)
+ ALLOCATE(XIBM_IMAGE_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,3,3))
+ XIBM_IMAGE_P(:,:,:,:,:) = 0.
+ !
+ ALLOCATE(Z_NORM_GHOST(IIU,IJU,IKU,3),Z_NORM_TEMPO(IIU,IJU,IKU,3),Z_NORM_TEMP1(IIU,IJU,IKU,4),Z_NORM_TEMP2(IIU,IJU,IKU), &
+ Z_NORM_TEMP3(IIU,IJU,IKU))
+ ALLOCATE(ZPHI(IIU,IJU,IKU,4))
+ ZPHI = 0.
+ !
+ DO JL = 1,4
+ !
+ ! Number of ghost layers per PUVW nodes
+ IF (JL==1) THEN
+ I_NUMB_LAYER = I_NUMB_LAYERP
+ ELSE
+ I_NUMB_LAYER = I_NUMB_LAYERV
+ ENDIF
+ IF (I_NUMB_LAYER==0) GO TO 667
+ !
+ ! div(n) computation
+ IF (JL==1) THEN
+ Z_NORM_TEMPO(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMPO(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMPO(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMP1(:,:,:,1) = - GX_M_U(1,IKU,1,PPHI(:,:,:,1),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_M_V(1,IKU,1,PPHI(:,:,:,1),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_M_W(1,IKU,1,PPHI(:,:,:,1),XDZZ)
+ CALL GDIV(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ,Z_NORM_TEMP1(:,:,:,1),Z_NORM_TEMP1(:,:,:,2),Z_NORM_TEMP1(:,:,:,3), &
+ XIBM_CURV(:,:,:))
+ XIBM_CURV(:,:,:)=-XIBM_CURV(:,:,:)*(XRHODJ(:,:,:)/XRHODREF(:,:,:))**(2./3.)
+ IF (LWEST_ll ()) XIBM_CURV(1,:,:) = XIBM_CURV(2 ,:,:)
+ IF (LEAST_ll ()) XIBM_CURV(IIU,:,:) = XIBM_CURV(IIU-1,:,:)
+ IF (LSOUTH_ll()) XIBM_CURV(:,1,:) = XIBM_CURV(:,2 ,:)
+ IF (LNORTH_ll()) XIBM_CURV(:,IJU,:) = XIBM_CURV(:,IJU-1,:)
+ XIBM_CURV(:,:,1 ) = XIBM_CURV(:,:, 2)
+ XIBM_CURV(:,:,IKU) = XIBM_CURV(:,:,IKU-1)
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_CURV(:,:,:),'IBM_DETECT::XIBM_CURV')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ XIBM_SU(:,:,:,1)=MXM(XIBM_CURV(:,:,:))
+ XIBM_SU(:,:,:,2)=MYM(XIBM_CURV(:,:,:))
+ XIBM_SU(:,:,:,3)=MZM(XIBM_CURV(:,:,:))
+ IF (LWEST_ll ()) XIBM_SU(1,:,:,1) = XIBM_SU(2 ,:,:,1)
+ IF (LEAST_ll ()) XIBM_SU(IIU,:,:,1) = XIBM_SU(IIU-1,:,:,1)
+ IF (LSOUTH_ll()) XIBM_SU(:,1,:,1) = XIBM_SU(:,2 ,:,1)
+ IF (LNORTH_ll()) XIBM_SU(:,IJU,:,1) = XIBM_SU(:,IJU-1,:,1)
+ XIBM_SU(:,:,1 ,1) = XIBM_SU(:,:, 2,1)
+ XIBM_SU(:,:,IKU,1) = XIBM_SU(:,:,IKU-1,1)
+ IF (LWEST_ll ()) XIBM_SU(1,:,:,2) = XIBM_SU(2 ,:,:,2)
+ IF (LEAST_ll ()) XIBM_SU(IIU,:,:,2) = XIBM_SU(IIU-1,:,:,2)
+ IF (LSOUTH_ll()) XIBM_SU(:,1,:,2) = XIBM_SU(:,2 ,:,2)
+ IF (LNORTH_ll()) XIBM_SU(:,IJU,:,2) = XIBM_SU(:,IJU-1,:,2)
+ XIBM_SU(:,:,1 ,2) = XIBM_SU(:,:, 2,2)
+ XIBM_SU(:,:,IKU,2) = XIBM_SU(:,:,IKU-1,2)
+ IF (LWEST_ll ()) XIBM_SU(1,:,:,3) = XIBM_SU(2 ,:,:,3)
+ IF (LEAST_ll ()) XIBM_SU(IIU,:,:,3) = XIBM_SU(IIU-1,:,:,3)
+ IF (LSOUTH_ll()) XIBM_SU(:,1,:,3) = XIBM_SU(:,2 ,:,3)
+ IF (LNORTH_ll()) XIBM_SU(:,IJU,:,3) = XIBM_SU(:,IJU-1,:,3)
+ XIBM_SU(:,:,1 ,3) = XIBM_SU(:,:, 2,3)
+ XIBM_SU(:,:,IKU,3) = XIBM_SU(:,:,IKU-1,3)
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,1),'IBM_DETECT::XIBM_SU')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,2),'IBM_DETECT::XIBM_SU')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,3),'IBM_DETECT::XIBM_SU')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ XIBM_CURV(:,:,:)=0.5*XIBM_CURV(:,:,:)+0.5/3.*(MXF(XIBM_SU(:,:,:,1))+ &
+ MYF(XIBM_SU(:,:,:,2))+ &
+ MZF(XIBM_SU(:,:,:,3)))
+ !
+ IF (LWEST_ll ()) XIBM_CURV(1,:,:) = XIBM_CURV(2 ,:,:)
+ IF (LEAST_ll ()) XIBM_CURV(IIU,:,:) = XIBM_CURV(IIU-1,:,:)
+ IF (LSOUTH_ll()) XIBM_CURV(:,1,:) = XIBM_CURV(:,2 ,:)
+ IF (LNORTH_ll()) XIBM_CURV(:,IJU,:) = XIBM_CURV(:,IJU-1,:)
+ XIBM_CURV(:,:,1 ) = XIBM_CURV(:,:, 2)
+ XIBM_CURV(:,:,IKU) = XIBM_CURV(:,:,IKU-1)
+ !
+ XIBM_CURV(:,:,:)=1./(ABS(XIBM_CURV(:,:,:))+XIBM_EPSI)
+ XIBM_CURV(:,:,:)=MIN(1., XIBM_CURV(:,:,:))
+ XIBM_CURV(:,:,:)=MAX(0., XIBM_CURV(:,:,:))
+ XIBM_CURV(:,:,:)=1.-XIBM_CURV(:,:,:)
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_CURV(:,:,:),'IBM_DETECT::XIBM_CURV')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ ENDIF
+ !
+ IF (JL==2) THEN
+ Z_NORM_TEMP1(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMPO(:,:,:,1) = MXM(Z_NORM_TEMP1(:,:,:,1))
+ Z_NORM_TEMPO(:,:,:,2) = MXM(Z_NORM_TEMP1(:,:,:,2))
+ Z_NORM_TEMPO(:,:,:,3) = MXM(Z_NORM_TEMP1(:,:,:,3))
+ ENDIF
+ IF (JL==3) THEN
+ Z_NORM_TEMP1(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMPO(:,:,:,1) = MYM(Z_NORM_TEMP1(:,:,:,1))
+ Z_NORM_TEMPO(:,:,:,2) = MYM(Z_NORM_TEMP1(:,:,:,2))
+ Z_NORM_TEMPO(:,:,:,3) = MYM(Z_NORM_TEMP1(:,:,:,3))
+ ENDIF
+ IF (JL==4) THEN
+ Z_NORM_TEMP1(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMPO(:,:,:,1) = MZM(Z_NORM_TEMP1(:,:,:,1))
+ Z_NORM_TEMPO(:,:,:,2) = MZM(Z_NORM_TEMP1(:,:,:,2))
+ Z_NORM_TEMPO(:,:,:,3) = MZM(Z_NORM_TEMP1(:,:,:,3))
+ ENDIF
+ !
+ Z_NORM_TEMPO(:,:,1 ,1) = +Z_NORM_TEMPO(:,:, 2,1)
+ Z_NORM_TEMPO(:,:,IKU,1) = +Z_NORM_TEMPO(:,:,IKU-1,1)
+ Z_NORM_TEMPO(:,:,1 ,2) = +Z_NORM_TEMPO(:,:, 2,2)
+ Z_NORM_TEMPO(:,:,IKU,2) = +Z_NORM_TEMPO(:,:,IKU-1,2)
+ Z_NORM_TEMPO(:,:,1 ,3) = 2*Z_NORM_TEMPO(:,:, 2,3)-Z_NORM_TEMPO(:,:, 3,3)
+ Z_NORM_TEMPO(:,:,IKU,3) = 2*Z_NORM_TEMPO(:,:,IKU-1,3)-Z_NORM_TEMPO(:,:,IKU-2,3)
+ Z_NORM_TEMPO(:,:,1 ,3) = MAX(0.,Z_NORM_TEMPO(:,:,1 ,3))
+ Z_NORM_TEMPO(:,:,2 ,3) = MAX(0.,Z_NORM_TEMPO(:,:,2 ,3))
+ Z_NORM_TEMPO(:,:,3 ,3) = MAX(0.,Z_NORM_TEMPO(:,:,3 ,3))
+ Z_NORM_TEMPO(:,:,IKU ,3) = MIN(0.,Z_NORM_TEMPO(:,:,IKU ,3))
+ Z_NORM_TEMPO(:,:,IKU-1,3) = MIN(0.,Z_NORM_TEMPO(:,:,IKU-1,3))
+ Z_NORM_TEMPO(:,:,IKU-2,3) = MIN(0.,Z_NORM_TEMPO(:,:,IKU-2,3))
+ !
+ IF (LWEST_ll ()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(JLL ,:,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(JLL ,:,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(JLL ,:,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(JLL ,:,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(JLL ,:,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(JLL ,:,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ IF (LEAST_ll ()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(IIU-JLL+1,:,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(IIU-JLL+1,:,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(:,JLL,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(:,JLL,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(:,JLL,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(:,JLL,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(:,JLL,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(:,JLL,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(:,IJU-JLL+1,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(:,IJU-JLL+1,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMPO(:,:,:,1),'IBM_DETECT::Z_NORM_TEMPO')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMPO(:,:,:,2),'IBM_DETECT::Z_NORM_TEMPO')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMPO(:,:,:,3),'IBM_DETECT::Z_NORM_TEMPO')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ Z_NORM_TEMP2(:,:,:) = sqrt(Z_NORM_TEMPO(:,:,:,1)**2.+Z_NORM_TEMPO(:,:,:,2)**2.+Z_NORM_TEMPO(:,:,:,3)**2.)
+ !
+ WHERE (abs(Z_NORM_TEMP2(:,:,:)) .gt. XIBM_EPSI)
+ Z_NORM_GHOST(:,:,:,1) = Z_NORM_TEMPO(:,:,:,1)/Z_NORM_TEMP2(:,:,:)
+ Z_NORM_GHOST(:,:,:,2) = Z_NORM_TEMPO(:,:,:,2)/Z_NORM_TEMP2(:,:,:)
+ Z_NORM_GHOST(:,:,:,3) = Z_NORM_TEMPO(:,:,:,3)/Z_NORM_TEMP2(:,:,:)
+ ELSEWHERE
+ Z_NORM_GHOST(:,:,:,1) = 0.
+ Z_NORM_GHOST(:,:,:,2) = 0.
+ Z_NORM_GHOST(:,:,:,3) = 1.
+ ENDWHERE
+ !
+ WHERE (abs(Z_NORM_TEMP2(:,:,:)) .gt. XIBM_EPSI)
+ Z_NORM_TEMPO(:,:,:,1) = 1./Z_NORM_TEMP2(:,:,:)
+ Z_NORM_TEMPO(:,:,:,2) = 1./Z_NORM_TEMP2(:,:,:)
+ Z_NORM_TEMPO(:,:,:,3) = 1./Z_NORM_TEMP2(:,:,:)
+ ELSEWHERE
+ Z_NORM_TEMPO(:,:,:,1) = 1.
+ Z_NORM_TEMPO(:,:,:,2) = 1.
+ Z_NORM_TEMPO(:,:,:,3) = 1.
+ ENDWHERE
+ !
+ DO JMM = 1, I_NUMB_LAYER
+ !
+ DO JM = 1, I_NUMB_GHOST(JL,JMM)
+ !
+ ! ghost index
+ IF (JL==1) THEN
+ I_INDE_TEMPO(:) = NIBM_GHOST_P(JM,JMM,JL ,:)
+ ELSE
+ I_INDE_TEMPO(:) = NIBM_GHOST_V(JM,JMM,JL-1,:)
+ ENDIF
+ JI2 = I_INDE_TEMPO(1)
+ JJ2 = I_INDE_TEMPO(2)
+ JK2 = I_INDE_TEMPO(3)
+ !
+ ! ghost location
+ Z_GHO(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JL)
+ ZLGHO = (abs(Z_GHO(1,1)-Z_GHO(8,1))* &
+ abs(Z_GHO(1,2)-Z_GHO(8,2))* &
+ abs(Z_GHO(1,3)-Z_GHO(8,3)))**(1./3.)
+ ZVECT(1) = Z_GHO(1,1)
+ ZVECT(2) = Z_GHO(1,2)
+ ZVECT(3) = Z_GHO(1,3)
+ !
+ PPHI_TEST = ABS(Z_NORM_GHOST(JI2,JJ2,JK2,1))+ABS(Z_NORM_GHOST(JI2,JJ2,JK2,2))+ABS(Z_NORM_GHOST(JI2,JJ2,JK2,3))
+ PPHI_CORR = MAX(PPHI(JI2,JJ2,JK2,JL),(JMM*1.-1.)*ZLGHO*PPHI_TEST)
+ PPHI_CORR = MIN(PPHI_CORR ,(JMM*1.+0.)*ZLGHO*PPHI_TEST)
+ !
+ ! Storage of mirror/image1/image2/mirror locations
+ IF (JL==1) THEN
+ XIBM_IMAGE_P(JM,JMM,JL ,1,:) = (1.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_P(JM,JMM,JL ,2,:) = (2.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_P(JM,JMM,JL ,3,:) = (0.5*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_GHOST_P(JM,JMM,JL ,:) = ZVECT(:)
+ XIBM_IMAGE_P(JM,JMM,JL ,1,3) = MAX(XIBM_EPSI,XIBM_IMAGE_P(JM,JMM,JL ,1,3))
+ XIBM_IMAGE_P(JM,JMM,JL ,2,3) = MAX(XIBM_EPSI,XIBM_IMAGE_P(JM,JMM,JL ,2,3))
+ XIBM_IMAGE_P(JM,JMM,JL ,3,3) = MAX(XIBM_EPSI,XIBM_IMAGE_P(JM,JMM,JL ,3,3))
+ XIBM_GHOST_P(JM,JMM,JL ,3) = MAX(XIBM_EPSI,XIBM_GHOST_P(JM,JMM,JL ,3))
+ ELSE
+ XIBM_IMAGE_V(JM,JMM,JL-1,1,:) = (1.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_V(JM,JMM,JL-1,2,:) = (2.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_V(JM,JMM,JL-1,3,:) = (0.5*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_GHOST_V(JM,JMM,JL-1 ,:) = ZVECT(:)
+ XIBM_IMAGE_V(JM,JMM,JL-1,1,3) = MAX(XIBM_EPSI,XIBM_IMAGE_V(JM,JMM,JL-1,1,3))
+ XIBM_IMAGE_V(JM,JMM,JL-1,2,3) = MAX(XIBM_EPSI,XIBM_IMAGE_V(JM,JMM,JL-1,2,3))
+ XIBM_IMAGE_V(JM,JMM,JL-1,3,3) = MAX(XIBM_EPSI,XIBM_IMAGE_V(JM,JMM,JL-1,3,3))
+ XIBM_GHOST_V(JM,JMM,JL-1 ,3) = MAX(XIBM_EPSI,XIBM_GHOST_V(JM,JMM,JL-1 ,3))
+ ENDIF
+ !
+ ! iterative procedure to find image cell
+ ZISI = 0.
+ ZJSI = 0.
+ ZKSI = 0.
+ IF (abs(Z_NORM_GHOST(JI2,JJ2,JK2,1)).gt.XIBM_EPSI) THEN
+ ZISI =Z_NORM_GHOST(JI2,JJ2,JK2,1)/abs(Z_NORM_GHOST(JI2,JJ2,JK2,1))
+ ENDIF
+ IF (abs(Z_NORM_GHOST(JI2,JJ2,JK2,2)).gt.XIBM_EPSI) THEN
+ ZJSI =Z_NORM_GHOST(JI2,JJ2,JK2,2)/abs(Z_NORM_GHOST(JI2,JJ2,JK2,2))
+ ENDIF
+ IF (abs(Z_NORM_GHOST(JI2,JJ2,JK2,3)).gt.XIBM_EPSI) THEN
+ ZKSI =Z_NORM_GHOST(JI2,JJ2,JK2,3)/abs(Z_NORM_GHOST(JI2,JJ2,JK2,3))
+ ENDIF
+ JIM1 = 3-2*JMM*int(min(0.,ZISI))
+ JIP1 = 3+2*JMM*int(max(0.,ZISI))
+ JJM1 = 3-2*JMM*int(min(0.,ZJSI))
+ JJP1 = 3+2*JMM*int(max(0.,ZJSI))
+ JKM1 = 3-2*JMM*int(min(0.,ZKSI))
+ JKP1 = 3+2*JMM*int(max(0.,ZKSI))
+ JIM2=max(1 ,JI2-JIM1)
+ JIP2=min(IIU-1,JI2+JIP1)
+ JJM2=max(1 ,JJ2-JJM1)
+ JJP2=min(IJU-1,JJ2+JJP1)
+ JKM2=max(1 ,JK2-JKM1)
+ JKP2=min(IKU-1,JK2+JKP1)
+ !
+ JN1 = 1
+ JN2 = 1
+ IF (JL/=1) THEN
+ JN1 = 2
+ JN2 = 4
+ ENDIF
+ !
+ DO JNN=1,3
+ !
+ ! image1/image2/mirror location
+ IF (JL==1) THEN
+ ZVECT(:) = XIBM_IMAGE_P(JM,JMM,JL ,JNN,:)
+ ELSE
+ ZVECT(:) = XIBM_IMAGE_V(JM,JMM,JL-1,JNN,:)
+ ENDIF
+ !
+ DO JN =JN1,JN2
+ !
+ ! search image depending on location type
+ ZSEAR = 0.
+ DO JK= JKM2,JKP2
+ DO JJ= JJM2,JJP2
+ DO JI= JIM2,JIP2
+ !
+ ! nodes of the potential image cell
+ I_INDE_TEMPO(1) = JI
+ I_INDE_TEMPO(2) = JJ
+ I_INDE_TEMPO(3) = JK
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ !
+ ! location of the potential cell
+ ZPROD(1) = min(Z_IMG(1,1),Z_IMG(2,1),Z_IMG(3,1),Z_IMG(4,1),&
+ Z_IMG(5,1),Z_IMG(6,1),Z_IMG(7,1),Z_IMG(8,1))
+ ZPROD(2) = max(Z_IMG(1,1),Z_IMG(2,1),Z_IMG(3,1),Z_IMG(4,1),&
+ Z_IMG(5,1),Z_IMG(6,1),Z_IMG(7,1),Z_IMG(8,1))
+ ZPROD(3) = min(Z_IMG(1,2),Z_IMG(2,2),Z_IMG(3,2),Z_IMG(4,2),&
+ Z_IMG(5,2),Z_IMG(6,2),Z_IMG(7,2),Z_IMG(8,2))
+ ZPROD(4) = max(Z_IMG(1,2),Z_IMG(2,2),Z_IMG(3,2),Z_IMG(4,2),&
+ Z_IMG(5,2),Z_IMG(6,2),Z_IMG(7,2),Z_IMG(8,2))
+ ZPROD(5) = min(Z_IMG(1,3),Z_IMG(2,3),Z_IMG(3,3),Z_IMG(4,3),&
+ Z_IMG(5,3),Z_IMG(6,3),Z_IMG(7,3),Z_IMG(8,3))
+ ZPROD(6) = max(Z_IMG(1,3),Z_IMG(2,3),Z_IMG(3,3),Z_IMG(4,3),&
+ Z_IMG(5,3),Z_IMG(6,3),Z_IMG(7,3),Z_IMG(8,3))
+ !
+ IF (((ZVECT(1).gt.(ZPROD(1)-XIBM_EPSI)).and.(ZVECT(1).lt.(ZPROD(2)+XIBM_EPSI))).and.&
+ ((ZVECT(2).gt.(ZPROD(3)-XIBM_EPSI)).and.(ZVECT(2).lt.(ZPROD(4)+XIBM_EPSI))).and.&
+ ((ZVECT(3).gt.(ZPROD(5)-XIBM_EPSI)).and.(ZVECT(3).lt.(ZPROD(6)+XIBM_EPSI)))) THEN
+ !
+ JI3=JI
+ JJ3=JJ
+ JK3=JK
+ !
+ IF (JL==1) THEN
+ ZSEAR = 0.5
+ NIBM_IMAGE_P(JM,JMM,JL ,JN ,JNN,1) = JI3
+ NIBM_IMAGE_P(JM,JMM,JL ,JN ,JNN,2) = JJ3
+ NIBM_IMAGE_P(JM,JMM,JL ,JN ,JNN,3) = MAX(JK3,IKB)
+ I_INDE_TEMPO2(1)= JI3
+ I_INDE_TEMPO2(2)= JJ3
+ I_INDE_TEMPO2(3)= JK3
+ Z_PHI(:) = IBM_VALUECORN(PPHI(:,:,:,JN),I_INDE_TEMPO2)
+ IF (JMM==1) ZIBM_TESTI = 0.
+ IF (JMM/=1) ZIBM_TESTI = 1.
+ DO JP=1,8
+ IF (Z_PHI(JP).gt.-XIBM_EPSI) THEN
+ XIBM_TESTI_P(JM,JMM,JL ,JN ,JNN,JP)=0.
+ ELSE
+ XIBM_TESTI_P(JM,JMM,JL ,JN ,JNN,JP)=1.
+ ENDIF
+ ZIBM_TESTI = ZIBM_TESTI+XIBM_TESTI_P(JM,JMM,JL ,JN,JNN,JP)
+ ENDDO
+ IF (ZIBM_TESTI.gt.+XIBM_EPSI) THEN
+ IF (LIBM_TROUBLE) XIBM_SUTR(JI2,JJ2,JK2,JL)=0.
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3<=IIB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIB))
+ ENDIF
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3>=IIE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIE))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3<=IJB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJB))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3>=IJE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJE))
+ ENDIF
+ ZSEAR = 1.
+ ENDIF
+ GO TO 666
+ ELSE
+ ZSEAR = 0.5
+ NIBM_IMAGE_V(JM,JMM,JL-1,JN-1,JNN,1) = JI3
+ NIBM_IMAGE_V(JM,JMM,JL-1,JN-1,JNN,2) = JJ3
+ NIBM_IMAGE_V(JM,JMM,JL-1,JN-1,JNN,3) = MAX(JK3,IKB)
+ I_INDE_TEMPO2(1)= JI3
+ I_INDE_TEMPO2(2)= JJ3
+ I_INDE_TEMPO2(3)= JK3
+ Z_PHI(:) = IBM_VALUECORN(PPHI(:,:,:,JN),I_INDE_TEMPO2)
+ IF (JMM==1) ZIBM_TESTI = 0.
+ IF (JMM/=1) ZIBM_TESTI = 1.
+ DO JP=1,8
+ IF (Z_PHI(JP).gt.-XIBM_EPSI) THEN
+ XIBM_TESTI_V(JM,JMM,JL-1,JN-1,JNN,JP)=0.
+ ELSE
+ XIBM_TESTI_V(JM,JMM,JL-1,JN-1,JNN,JP)=1.
+ ENDIF
+ ZIBM_TESTI = ZIBM_TESTI+XIBM_TESTI_V(JM,JMM,JL-1,JN-1,JNN,JP)
+ ENDDO
+ IF (ZIBM_TESTI.gt.+XIBM_EPSI) THEN
+ IF (LIBM_TROUBLE) XIBM_SUTR(JI2,JJ2,JK2,JL)=0.
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3<=IIB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIB))
+ ENDIF
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3>=IIE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIE))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3<=IJB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJB))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3>=IJE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJE))
+ ENDIF
+ ZSEAR = 1.
+ ENDIF
+ GO TO 666
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+666 CONTINUE
+ !
+ IF ((ZSEAR.gt.0.25).AND.(ZSEAR.lt.0.75).AND.(JMM==1)) THEN
+ ZPHI(JI2,JJ2,JK2,JL)=1.
+ IF (JL==1) THEN
+ WRITE(*,*)'===== IBM WARNING NEW ======'
+ WRITE(*,*)'Non detected PPP images cell'
+ WRITE(*,*)'ghost',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_P(JM,JMM,JL,1),XIBM_GHOST_P(JM,JMM,JL,2),XIBM_GHOST_P(JM,JMM,JL,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_P(JM,JMM,JL,JNN,1),XIBM_IMAGE_P(JM,JMM,JL,JNN,2),XIBM_IMAGE_P(JM,JMM,JL,JNN,3)
+ ELSE
+ WRITE(*,*)'===== IBM WARNING NEW ======'
+ WRITE(*,*)'Non detected UVW images cell'
+ WRITE(*,*)'ghost:',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_V(JM,JMM,JL-1,1),XIBM_GHOST_V(JM,JMM,JL-1,2),XIBM_GHOST_V(JM,JMM,JL-1,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_V(JM,JMM,JL-1,JNN,1),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,2),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,3)
+ ENDIF
+ I_INDE_TEMPO(1) = JIM2
+ I_INDE_TEMPO(2) = JJM2
+ I_INDE_TEMPO(3) = JKM2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MIN',Z_IMG(1,1),Z_IMG(1,2),Z_IMG(1,3)
+ I_INDE_TEMPO(1) = JIP2
+ I_INDE_TEMPO(2) = JJP2
+ I_INDE_TEMPO(3) = JKP2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MAX',Z_IMG(8,1),Z_IMG(8,2),Z_IMG(8,3)
+ ENDIF
+ !
+ IF ((ZSEAR.lt.0.25).AND.(JMM==1)) THEN
+ ZPHI(JI2,JJ2,JK2,JL)=1.
+ IF (JL==1) THEN
+ WRITE(*,*)'===== IBM WARNING ======'
+ WRITE(*,*)'Non detected PPP images cell'
+ WRITE(*,*)'ghost',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_P(JM,JMM,JL,1),XIBM_GHOST_P(JM,JMM,JL,2),XIBM_GHOST_P(JM,JMM,JL,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_P(JM,JMM,JL,JNN,1),XIBM_IMAGE_P(JM,JMM,JL,JNN,2),XIBM_IMAGE_P(JM,JMM,JL,JNN,3)
+ ELSE
+ WRITE(*,*)'===== IBM WARNING ======'
+ WRITE(*,*)'Non detected UVW images cell'
+ WRITE(*,*)'ghost:',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_V(JM,JMM,JL-1,1),XIBM_GHOST_V(JM,JMM,JL-1,2),XIBM_GHOST_V(JM,JMM,JL-1,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_V(JM,JMM,JL-1,JNN,1),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,2),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,3)
+ ENDIF
+ I_INDE_TEMPO(1) = JIM2
+ I_INDE_TEMPO(2) = JJM2
+ I_INDE_TEMPO(3) = JKM2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MIN',Z_IMG(1,1),Z_IMG(1,2),Z_IMG(1,3)
+ I_INDE_TEMPO(1) = JIP2
+ I_INDE_TEMPO(2) = JJP2
+ I_INDE_TEMPO(3) = JKP2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MAX',Z_IMG(8,1),Z_IMG(8,2),Z_IMG(8,3)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+667 CONTINUE
+ !
+ IF ((NHALO<=JHALO).AND.(JMM==1)) WRITE(*,*)'### WARNING HALO ###',JHALO,IP
+ !
+ ENDDO
+ WRITE(*,*)'### HALO ###',NHALO,JHALO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(I_INDE_TEMPO,I_INDE_TEMPO2,I_NUMB_GHOST)
+ DEALLOCATE(Z_NORM_GHOST,Z_NORM_TEMPO,Z_NORM_TEMP1,Z_NORM_TEMP2,Z_NORM_TEMP3)
+ DEALLOCATE(ZVECT,ZPROD,ZPHI)
+ DEALLOCATE(Z_PHI,Z_IMG,Z_GHO)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_DETECT
diff --git a/src/MNH/ibm_forcing.f90 b/src/MNH/ibm_forcing.f90
new file mode 100644
index 0000000000000000000000000000000000000000..435df5ecf40d34496d93db727f57046ff656bd77
--- /dev/null
+++ b/src/MNH/ibm_forcing.f90
@@ -0,0 +1,314 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_FORCING
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_FORCING(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT), OPTIONAL :: PTKS
+ !
+ END SUBROUTINE IBM_FORCING
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_FORCING
+!
+! ##########################################################
+SUBROUTINE IBM_FORCING(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ ! ##########################################################
+ !
+ !!**** *IBM_FORCING* - routine to force all desired fields
+ !!
+ !! PURPOSE
+ !! -------
+ ! The purpose of this routine is to compute variables in the virtual
+ ! embedded solid region in regard of variables computed in the real
+ ! fluid region
+ !
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !! NONE
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_CST
+ USE MODD_FIELD_n
+ USE MODD_REF
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XEXNREF,XRVREF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_IBM_PARAM_n
+ USE MODD_LBC_n
+ USE MODD_CONF
+ USE MODD_CONF_n
+ USE MODD_NSV
+ USE MODD_CTURB
+ USE MODD_PARAM_n
+ USE MODD_DYN_n, ONLY: XTSTEP
+ !
+ ! interface
+ USE MODI_IBM_AFFECTV
+ USE MODI_IBM_AFFECTP
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT), OPTIONAL :: PTKS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ REAL, DIMENSION(:,:,:) , ALLOCATABLE :: ZTMP,ZXMU,ZDIV,ZTKE
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMU,ZTRY
+ INTEGER :: IIU,IJU,IKU,IKB,IKE
+ INTEGER :: JRR,JSV
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ !
+ IIU = SIZE(PRUS,1)
+ IJU = SIZE(PRVS,2)
+ IKU = SIZE(PRWS,3)
+ !
+ ALLOCATE(ZTMU(IIU,IJU,IKU,3),ZTMP(IIU,IJU,IKU),ZTRY(IIU,IJU,IKU,3), &
+ ZXMU(IIU,IJU,IKU),ZDIV(IIU,IJU,IKU),ZTKE(IIU,IJU,IKU))
+ !
+ ZTMU=0.
+ ZXMU=0.
+ ZDIV=0.
+ ZTMP=0.
+ ZTRY=0.
+ !
+ IKB = 1 + JPVEXT
+ IKE = IKU - JPVEXT
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ IF (NSV>=1) THEN
+ !
+ DO JSV=1,NSV
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PSVS(:,:,:,JSV) = XIBM_EPSI**1.5
+ ENDDO
+ !
+ ENDIF
+ !
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PTHS(:,:,:) = XTHVREF(:,:,:)
+ !
+ IF (NRR>=1) THEN
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI)
+ PRRS(:,:,:,1) = XRVREF(:,:,:)
+ PTHS(:,:,:) = XTHVREF(:,:,:)/(1.+XRD/XRV*XRVREF(:,:,:))
+ ENDWHERE
+ ENDIF
+ IF (NRR>=2) THEN
+ DO JRR=2,NRR
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PRRS(:,:,:,JRR) = XIBM_EPSI
+ ENDDO
+ ENDIF
+ !
+ WHERE (XIBM_LS(:,:,:,2).GT.XIBM_EPSI) PRUS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,3).GT.XIBM_EPSI) PRVS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,4).GT.XIBM_EPSI) PRWS(:,:,:) = XIBM_EPSI
+ IF (CTURB/='NONE') WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PTKS(:,:,:) = XTKEMIN
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! ======================
+ ! === SCALAR FORCING ===
+ ! ======================
+ !
+ IF (CTURB/='NONE') THEN
+ ZTMP(:,:,:) = PTKS(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ ZXMU(:,:,:) = XIBM_XMUT(:,:,:)
+ ZDIV(:,:,:) = XIBM_CURV(:,:,:)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_E,XIBM_RADIUS_E,XIBM_POWERS_E,&
+ CIBM_MODE_INTE1_E,CIBM_MODE_INTE3_E,&
+ CIBM_TYPE_BOUND_E,CIBM_MODE_BOUND_E,&
+ CIBM_FORC_BOUND_E,XIBM_FORC_BOUND_E,ZXMU,ZDIV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=XTKEMIN
+ PTKS(:,:,:)=MAX(XTKEMIN,ZTMP(:,:,:))
+ ENDIF
+ !
+ ZTMP(:,:,:) = PTHS(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_T,XIBM_RADIUS_T,XIBM_POWERS_T,&
+ CIBM_MODE_INTE1_T,CIBM_MODE_INTE3_T,&
+ CIBM_TYPE_BOUND_T,CIBM_MODE_BOUND_T,&
+ CIBM_FORC_BOUND_T,XIBM_FORC_BOUND_T,ZXMU,ZDIV)
+ ZTMP(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PTHS(:,:,:) = MAX(ZTMP(:,:,:),250.)
+ !
+ IF (NRR>=1) THEN
+ DO JRR=1,NRR
+ ZTMP(:,:,:) = PRRS(:,:,:,JRR)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_R,XIBM_RADIUS_R,XIBM_POWERS_R,&
+ CIBM_MODE_INTE1_R,CIBM_MODE_INTE3_R,&
+ CIBM_TYPE_BOUND_R,CIBM_MODE_BOUND_R,&
+ CIBM_FORC_BOUND_R,XIBM_FORC_BOUND_R,ZXMU,ZDIV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PRRS(:,:,:,JRR) = ZTMP(:,:,:)
+ ENDDO
+ ENDIF
+ !
+ IF (NSV>=1) THEN
+ DO JSV=1,NSV
+ ZTMP(:,:,:) = PSVS(:,:,:,JSV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_S,XIBM_RADIUS_S,XIBM_POWERS_S,&
+ CIBM_MODE_INTE1_S,CIBM_MODE_INTE3_S,&
+ CIBM_TYPE_BOUND_S,CIBM_MODE_BOUND_S,&
+ CIBM_FORC_BOUND_S,XIBM_FORC_BOUND_S,ZXMU,ZDIV)
+ ZTMP(:,:,:) = MAX(XIBM_EPSI**1.5,ZTMP(:,:,:))
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PSVS(:,:,:,JSV) = ZTMP(:,:,:)
+ ENDDO
+ ENDIF
+ !
+ !=======================
+ ! === VECTOR FORCING ===
+ ! ======================
+ !
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ ZTMU(:,:,:,1) = PRUS(:,:,:)
+ ZTMU(:,:,:,2) = PRVS(:,:,:)
+ ZTMU(:,:,:,3) = PRWS(:,:,:)
+ !
+ ZTMP(:,:,:) = PRUS(:,:,:)
+ ZXMU(:,:,:) = MXM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MXM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'U',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRUS(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,:) = PRVS(:,:,:)
+ ZXMU(:,:,:) = MYM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MYM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'V',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRVS(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,:) = PRWS(:,:,:)
+ ZXMU(:,:,:) = MZM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MZM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'W',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRWS(:,:,:) = ZTMP(:,:,:)
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ !**** 3. COMMUNICATIONS
+ ! -----------------
+ !
+ IF (.NOT. LIBM_TROUBLE) THEN
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PTHS(:,:,:),'IBM_FORCING::PTHS')
+ IF (CTURB/='NONE') CALL ADD3DFIELD_ll(TZFIELDS_ll,PTKS(:,:,:),'IBM_FORCING::PTKS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING::PRWS')
+ IF (NRR>=1) THEN
+ DO JRR=1,NRR
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRRS(:,:,:,JRR),'IBM_FORCING::PRRS')
+ ENDDO
+ ENDIF
+ IF (NSV>=1) THEN
+ DO JSV=1,NSV
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PSVS(:,:,:,JSV),'IBM_FORCING::PSVS')
+ ENDDO
+ ENDIF
+ !
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ ENDIF
+ !
+ !**** 4. DEALLOCATIONS
+ ! ----------------
+ !
+ DEALLOCATE(ZTMP,ZTMU,ZTRY,ZXMU,ZDIV,ZTKE)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_FORCING
diff --git a/src/MNH/ibm_forcing_adv.f90 b/src/MNH/ibm_forcing_adv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b7692031e773aa1fd7441264c9af62e8934fcffe
--- /dev/null
+++ b/src/MNH/ibm_forcing_adv.f90
@@ -0,0 +1,185 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! ###########################
+MODULE MODI_IBM_FORCING_ADV
+ ! ###########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_FORCING_ADV(PRUS,PRVS,PRWS)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PRUS,PRVS,PRWS
+ !
+ END SUBROUTINE IBM_FORCING_ADV
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_FORCING_ADV
+!
+!
+! ##########################################
+SUBROUTINE IBM_FORCING_ADV(PRUS,PRVS,PRWS)
+ ! ##########################################
+ !
+ !!**** *IBM_FORCING_ADV* - routine to force all desired fields in the RK
+ !!
+ !! PURPOSE
+ !! -------
+ ! The purpose of this routine is to compute variables in the virtual
+ ! embedded solid region in regard of variables computed in the real
+ ! fluid region
+ !
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !! NONE
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_CST
+ USE MODD_FIELD_n
+ USE MODD_REF
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XEXNREF,XRVREF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_IBM_PARAM_n
+ USE MODD_LBC_n
+ USE MODD_CONF
+ USE MODD_CONF_n
+ USE MODD_NSV
+ USE MODD_CTURB
+ USE MODD_PARAM_n
+ USE MODD_DYN_n, ONLY: XTSTEP
+ !
+ ! interface
+ USE MODI_IBM_AFFECTV
+ USE MODI_IBM_AFFECTP
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PRUS,PRVS,PRWS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ REAL, DIMENSION(:,:,:) , ALLOCATABLE :: ZTMP,ZXMU,ZDIV,ZTKE
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: ZTMU,ZTRY
+ INTEGER :: IIU,IJU,IKU,IKB,IKE
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ !
+ IIU = SIZE(PRUS,1)
+ IJU = SIZE(PRVS,2)
+ IKU = SIZE(PRWS,3)
+ ALLOCATE(ZTMU(IIU,IJU,IKU,3),ZTMP(IIU,IJU,IKU),ZTRY(IIU,IJU,IKU,3), &
+ ZXMU(IIU,IJU,IKU),ZDIV(IIU,IJU,IKU),ZTKE(IIU,IJU,IKU))
+ !
+ ZTMU=0.
+ ZXMU=0.
+ ZDIV=0.
+ ZTMP=0.
+ ZTRY=0.
+ !
+ IKB = 1 + JPVEXT
+ IKE = IKU - JPVEXT
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ WHERE (XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) PRUS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) PRVS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) PRWS(:,:,:) = XIBM_EPSI
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ ZTMU(:,:,:,1) = PRUS(:,:,:)/MXM(XRHODREF)
+ ZTMU(:,:,:,2) = PRVS(:,:,:)/MYM(XRHODREF)
+ ZTMU(:,:,:,3) = PRWS(:,:,:)/MZM(XRHODREF)
+ !
+ ZTMP(:,:,:) = PRUS(:,:,:)/MXM(XRHODREF)
+ ZXMU(:,:,:) = MXM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MXM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'U',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRUS(:,:,:) = ZTMP(:,:,:)*MXM(XRHODREF)
+ !
+ ZTMP(:,:,:) = PRVS(:,:,:)/MYM(XRHODREF)
+ ZXMU(:,:,:) = MYM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MYM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'V',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRVS(:,:,:) = ZTMP(:,:,:)*MYM(XRHODREF)
+ !
+ ZTMP(:,:,:) = PRWS(:,:,:)/MZM(XRHODREF)
+ ZXMU(:,:,:) = MZM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MZM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'W',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRWS(:,:,:) = ZTMP(:,:,:)*MZM(XRHODREF)
+ !
+ !**** 3. COMMUNICATIONS
+ ! -----------------
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_ADV::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_ADV::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_ADV::PRWS')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !**** 4. DEALLOCATIONS
+ ! ----------------
+ !
+ DEALLOCATE(ZTMP,ZTMU,ZTRY,ZXMU,ZDIV,ZTKE)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_FORCING_ADV
diff --git a/src/MNH/ibm_forcing_tr.f90 b/src/MNH/ibm_forcing_tr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..832217ea17adedd6c605b76ae372074927ad365e
--- /dev/null
+++ b/src/MNH/ibm_forcing_tr.f90
@@ -0,0 +1,410 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! ##########################
+MODULE MODI_IBM_FORCING_TR
+ ! ##########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_FORCING_TR(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT),OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT),OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT),OPTIONAL :: PTKS
+ !
+ END SUBROUTINE IBM_FORCING_TR
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_FORCING_TR
+!
+!
+! #############################################################
+SUBROUTINE IBM_FORCING_TR(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ ! #############################################################
+ !
+ !!**** *IBM_FORCING_TR* - routine to force all desired fields
+ !!
+ !! PURPOSE
+ !! -------
+ ! The purpose of this routine is to compute variables in the virtual
+ ! embedded solid region in regard of variables computed in the real
+ ! fluid region
+ !
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !! NONE
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+ !
+ ! declaration
+ USE MODD_CST, ONLY: XRD,XRV
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XRVREF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_IBM_PARAM_n
+ USE MODD_LBC_n
+ USE MODD_CONF
+ USE MODD_CONF_n
+ USE MODD_NSV
+ USE MODD_CTURB
+ USE MODD_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT),OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT),OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT),OPTIONAL :: PTKS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: JI,JJ,JK,JI2,JJ2,JK2,IIU,IJU,IKU,JL
+ INTEGER :: JIM1,JJM1,JKM1,JIP1,JJP1,JKP1
+ INTEGER :: IIE,IIB,IJE,IJB,IKB,IKE
+ REAL :: ZSUM1,ZSUM2,ZSUM4
+ REAL, DIMENSION(:), ALLOCATABLE :: ZSUM3,ZSUM5
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ IIU = SIZE(PRUS,1)
+ IJU = SIZE(PRUS,2)
+ IKU = SIZE(PRUS,3)
+ IKB = 1 + JPVEXT
+ IKE = SIZE(PRUS,3) - JPVEXT
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! Problems in GCT ? => imposition of the adjacent value
+ DO JI=IIB,IIE
+ DO JJ=IJB,IJE
+ DO JK=IKB,IKE
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,1).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ IF (NSV>=1) ALLOCATE(ZSUM3(NSV))
+ ZSUM3 = 0.
+ ZSUM4 = 0.
+ IF (NRR>=1) ALLOCATE(ZSUM5(NRR))
+ ZSUM5 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ !
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,1))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,1))*PTHS(JI2,JJ2,JK2)
+ IF (NRR>=1) THEN
+ DO JL = 1,NRR
+ ZSUM5(JL) = ZSUM5(JL) + (XIBM_SUTR(JI2,JJ2,JK2,1))*PRRS(JI2,JJ2,JK2,JL)
+ ENDDO
+ ENDIF
+ IF (NSV>=1) THEN
+ DO JL = 1,NSV
+ ZSUM3(JL) = ZSUM3(JL) + (XIBM_SUTR(JI2,JJ2,JK2,1))*PSVS(JI2,JJ2,JK2,JL)
+ ENDDO
+ ENDIF
+ IF (CTURB/='NONE') ZSUM4 = ZSUM4 + (XIBM_SUTR(JI2,JJ2,JK2,1))*PTKS(JI2,JJ2,JK2)
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PTHS(JI,JJ,JK) = XTHVREF(JI,JJ,JK)
+ IF (NRR>=1) PTHS(JI,JJ,JK) = XTHVREF(JI,JJ,JK)/(1.+XRD/XRV*XRVREF(JI,JJ,JK))
+ IF (ZSUM1.GT.XIBM_EPSI) PTHS(JI,JJ,JK) = ZSUM2/ZSUM1
+ IF (NRR>=1) THEN
+ PRRS(JI,JJ,JK,1) = XRVREF(JI,JJ,JK)
+ IF (ZSUM1.GT.XIBM_EPSI) PRRS(JI,JJ,JK,1) = ZSUM5(1)/ZSUM1
+ IF (NRR>=2) THEN
+ DO JL = 2,NRR
+ PRRS(JI,JJ,JK,JL) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRRS(JI,JJ,JK,JL) = ZSUM5(JL)/ZSUM1
+ ENDDO
+ ENDIF
+ ENDIF
+ !
+ IF (NSV>=1) THEN
+ DO JL = 1,NSV
+ PSVS(JI,JJ,JK,JL) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PSVS(JI,JJ,JK,JL) = ZSUM3(JL)/ZSUM1
+ ENDDO
+ ENDIF
+ !
+ IF (CTURB/='NONE') PTKS(JI,JJ,JK) = XTKEMIN
+ IF (ZSUM1.GT.XIBM_EPSI.AND.(CTURB/='NONE')) PTKS(JI,JJ,JK) = ZSUM4/ZSUM1
+ IF (NSV>=1) DEALLOCATE(ZSUM3)
+ IF (NRR>=1) DEALLOCATE(ZSUM5)
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,2).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,2))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,2))*PRUS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRUS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,3).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,3))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,3))*PRVS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRVS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRVS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,4).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,4))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,4))*PRWS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRWS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRWS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PTHS(:,:,IKB-1)=PTHS(:,:,IKB)
+ PTHS(:,:,IKE+1)=PTHS(:,:,IKE)
+ IF (CTURB/='NONE') PTKS(:,:,IKB-1)=PTKS(:,:,IKB)
+ IF (CTURB/='NONE') PTKS(:,:,IKE+1)=PTKS(:,:,IKE)
+ IF (NSV>=1) PSVS(:,:,IKB-1,:)=PSVS(:,:,IKB,:)
+ IF (NSV>=1) PSVS(:,:,IKE+1,:)=PSVS(:,:,IKE,:)
+ IF (NRR>=1) PRRS(:,:,IKB-1,:)=PRRS(:,:,IKB,:)
+ IF (NRR>=1) PRRS(:,:,IKE+1,:)=PRRS(:,:,IKE,:)
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PTHS(:,:,:),'IBM_FORCING_TR::PTHS')
+ IF (CTURB/='NONE') CALL ADD3DFIELD_ll(TZFIELDS_ll,PTKS(:,:,:),'IBM_FORCING_TR::PTKS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_TR::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_TR::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_TR::PRWS')
+ IF (NSV>=1) THEN
+ DO JL=1,NSV
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PSVS(:,:,:,JL),'IBM_FORCING_TR::PSVS')
+ ENDDO
+ ENDIF
+ IF (NRR>=1) THEN
+ DO JL=1,NRR
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRRS(:,:,:,JL),'IBM_FORCING_TR::PRRS')
+ ENDDO
+ ENDIF
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ ! Problems on corners ? => imposition of the adjacent value
+ !
+ DO JI=IIB,IIE
+ DO JJ=IJB,IJE
+ DO JK=IKB,IKE
+ !
+ IF (XIBM_LS(JI,JJ,JK,2).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI-1,JJ,JK))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRUS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(JI,JJ,JK) = (1.-ZSUM1)*PRUS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ !
+ IF (XIBM_LS(JI,JJ,JK,3).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI,JJ-1,JK))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRVS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRVS(JI,JJ,JK) = (1.-ZSUM1)*PRVS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ !
+ IF (XIBM_LS(JI,JJ,JK,4).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI,JJ,JK-1))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRWS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRWS(JI,JJ,JK) = (1.-ZSUM1)*PRWS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_TR::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_TR::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_TR::PRWS')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_FORCING_TR
diff --git a/src/MNH/ibm_generls.f90 b/src/MNH/ibm_generls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a129d210930de85d7ade5ed783ce6c57c7714ad7
--- /dev/null
+++ b/src/MNH/ibm_generls.f90
@@ -0,0 +1,543 @@
+!MNH_LIC Copyright 2021-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.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_GENERLS
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_GENERLS(PIBM_FACES,PNORM_FACES,PV1,PV2,PV3,PX_MIN,PY_MIN,PX_MAX,PY_MAX,PPHI)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PIBM_FACES
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PNORM_FACES,PV1,PV2,PV3
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ REAL ,INTENT(IN) :: PX_MIN,PY_MIN,PX_MAX,PY_MAX
+ !
+ END SUBROUTINE IBM_GENERLS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_GENERLS
+!
+! #####################################
+SUBROUTINE IBM_GENERLS(PIBM_FACES,PNORM_FACES,PV1,PV2,PV3,PX_MIN,PY_MIN,PX_MAX,PY_MAX,PPHI)
+ ! #####################################
+ !
+ !
+ !**** IBM_GENERLS computes the Level Set function for any surface
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to estimate the level set
+ ! containing XYZ minimalisation interface locations
+
+ ! METHOD
+ ! ------
+ !**** Iterative system and minimization of the interface distance
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ ! The method is based on '3D Distance from a Point to a Triangle'
+ ! a technical report from Mark W. Jones, University of Wales Swansea
+ !
+ ! AUTHORS
+ ! ------
+ ! Tim Nagel, Valéry Masson & Robert Schoetter
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/06/2021
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_IBM_LSF
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT,XUNDEF
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_CST, ONLY: XMNH_EPSILON
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_IBM_INTERPOS
+ USE MODI_IBM_DETECT
+ USE MODI_INI_CST
+ !
+ IMPLICIT NONE
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PIBM_FACES !faces coordinates
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PNORM_FACES !normal
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PV1,PV2,PV3
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions
+ REAL ,INTENT(IN) :: PX_MIN,PY_MIN,PX_MAX,PY_MAX
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JN,JM,JI2,JJ2,JK2 ! loop index
+ INTEGER :: JI_MIN,JI_MAX,JJ_MIN,JJ_MAX,JK_MIN,JK_MAX,IIU,IJU,IKU ! loop boundaries
+ REAL :: Z_DIST_TEST1,Z_DIST_TEST2 ! saving distances
+ REAL :: Z_DIST_TEST3,Z_DIST_TEST4,ZDIST_REF0
+ INTEGER :: INUMB_FACES ! number of faces
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATM,ZYHATM,ZZHATM,ZDP0PP0PAST
+ CHARACTER(LEN=1) :: YPOS
+ REAL, DIMENSION(3) :: ZP1P0,ZP1P2,ZP0PP0,ZP1PP0,ZP2PP0,ZP3PP0,ZPP0P1,ZPP0P2,ZPP0P3
+ REAL, DIMENSION(3) :: ZPP0PPP0,ZPPP0P1,ZPPP0P2,ZP2P1,ZP2P0,ZP2P3,ZP3P2,ZP3P1
+ REAL, DIMENSION(3) :: ZPP0,ZFT1,ZFT2,ZFT3,ZFT1B,ZFT2B,ZFT3B,ZR,ZPPP0,ZP3P0,ZP0P1
+ REAL, DIMENSION(3) :: ZPPP0P3,ZP1P3,ZPCP0,ZR0
+ REAL, DIMENSION(:), ALLOCATABLE :: ZSTEMP,ZRDIR,ZVECTDISTPLUS,ZVECTDISTMOINS,ZVECTDIST!,ZFACE
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZC
+ REAL :: ZF1,ZF2,ZF3,ZF1B,ZF2B,ZF3B,ZDPP0PPP0
+ REAL :: ZT,ZSIGN,ZS,ZDIST,ZDP0PP0,ZNNORM,ZRN,ZPHI_OLD
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll,IMI ! return code of parallel routine
+ INTEGER :: IIE,IIB,IJB,IJE,IKE,IKB,ZBPLUS
+ LOGICAL :: GABOVE_ROOF,LFACE,LDZ
+ LOGICAL, DIMENSION(:), ALLOCATABLE :: ZFACE
+ INTEGER :: ZCOUNT,ZIDX,ZII,ZCHANGE,ZCHANGE1
+ REAL :: ZDIFF,ZMIN_DIFF,ZDX
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 allocation
+ !
+ NULLIFY(TZFIELDS_ll)
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ IIB=1+JPHEXT
+ IIE=IIU-JPHEXT
+ IJB=1+JPHEXT
+ IJE=IJU-JPHEXT
+ IKB=1+JPVEXT
+ IKE=IKU-JPVEXT
+ !
+ JK_MIN = 1 + JPVEXT
+ JK_MAX = IKU - JPVEXT
+ !
+ CALL GET_INDICE_ll (JI_MIN,JJ_MIN,JI_MAX,JJ_MAX)
+ !
+ ALLOCATE(ZXHATM(IIU,IJU,IKU))
+ ALLOCATE(ZYHATM(IIU,IJU,IKU))
+ ALLOCATE(ZZHATM(IIU,IJU,IKU))
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ INUMB_FACES = SIZE(PIBM_FACES,1)
+ ALLOCATE(ZC(INUMB_FACES,3))
+ ALLOCATE(ZSTEMP(1))
+ ALLOCATE(ZRDIR(1))
+ PPHI = -XUNDEF
+ ALLOCATE(ZDP0PP0PAST(IIU,IJU,IKU))
+ ZDP0PP0PAST = 0.
+ ALLOCATE(ZVECTDIST(10000))
+ ALLOCATE(ZVECTDISTPLUS(10000))
+ ALLOCATE(ZVECTDISTMOINS(10000))
+ ALLOCATE(ZFACE(10000))
+ ZFACE=.FALSE.
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ JM=1
+ YPOS = 'P'
+ !
+ CALL IBM_INTERPOS(ZXHATM,ZYHATM,ZZHATM,YPOS)
+ ZDX = ZXHATM(JI_MIN+1,JJ_MIN,JK_MIN)-ZXHATM(JI_MIN,JJ_MIN,JK_MIN)
+ !
+ DO JK = JK_MIN,JK_MAX
+ DO JJ = JJ_MIN,JJ_MAX
+ DO JI = JI_MIN,JI_MAX
+ ZCOUNT = 1
+ ZVECTDIST = -999.
+ DO JN = 1,INUMB_FACES
+ LFACE=.FALSE.
+ !***Calcul of the face center
+ ZC(JN,1)=(PIBM_FACES(JN,1,1)+PIBM_FACES(JN,2,1)+PIBM_FACES(JN,3,1))/3.
+ ZC(JN,2)=(PIBM_FACES(JN,1,2)+PIBM_FACES(JN,2,2)+PIBM_FACES(JN,3,2))/3.
+ ZC(JN,3)=(PIBM_FACES(JN,1,3)+PIBM_FACES(JN,2,3)+PIBM_FACES(JN,3,3))/3.
+ !***Norm normalization
+ ZNNORM = SQRT(PNORM_FACES(JN,1)**2+PNORM_FACES(JN,2)**2+PNORM_FACES(JN,3)**2)
+ !***Vector between the face center and the current grid point
+ ZPCP0(1) = ZXHATM(JI,JJ,JK)-ZC(JN,1)
+ ZPCP0(2) = ZYHATM(JI,JJ,JK)-ZC(JN,2)
+ ZPCP0(3) = ZZHATM(JI,JJ,JK)-ZC(JN,3)
+ ZSIGN = ZPCP0(1)*PNORM_FACES(JN,1)+ &
+ ZPCP0(2)*PNORM_FACES(JN,2)+ &
+ ZPCP0(3)*PNORM_FACES(JN,3)
+ !***Various vectors
+ ZP1P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,1,1)
+ ZP1P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,1,2)
+ ZP1P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,1,3)
+ ZP3P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,3,1)
+ ZP3P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,3,2)
+ ZP3P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,3,3)
+ ZP0P1(1) = PIBM_FACES(JN,1,1)-ZXHATM(JI,JJ,JK)
+ ZP0P1(2) = PIBM_FACES(JN,1,2)-ZYHATM(JI,JJ,JK)
+ ZP0P1(3) = PIBM_FACES(JN,1,3)-ZZHATM(JI,JJ,JK)
+ ZP2P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,2,1)
+ ZP2P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,2,2)
+ ZP2P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,2,3)
+ !***Equation (3) of Jones (1995)
+ IF(ZP1P0(1)==0.AND.ZP1P0(2)==0.AND.ZP1P0(3)==0) THEN
+ WRITE(*,*) 'ZP1P0(1,2,3)',ZP1P0(1),ZP1P0(2),ZP1P0(3)
+ ZDP0PP0 = 0.
+ ELSE
+ ZDP0PP0 = SQRT(ZP0P1(1)**2+ZP0P1(2)**2+ZP0P1(3)**2)* &
+ ((ZP1P0(1)*PNORM_FACES(JN,1)+ZP1P0(2)*PNORM_FACES(JN,2)+&
+ ZP1P0(3)*PNORM_FACES(JN,3))/( &
+ SQRT((ZP1P0(1))**2+(ZP1P0(2))**2+(ZP1P0(3))**2)*ZNNORM))
+ END IF
+ !***Equation (4) of Jones (1995)
+ ZP0PP0(1) = -ZDP0PP0*(PNORM_FACES(JN,1)/ZNNORM)
+ ZP0PP0(2) = -ZDP0PP0*(PNORM_FACES(JN,2)/ZNNORM)
+ ZP0PP0(3) = -ZDP0PP0*(PNORM_FACES(JN,3)/ZNNORM)
+ !***Equation (5) of Jones (1995)
+ ZPP0(1) = ZXHATM(JI,JJ,JK)+ZP0PP0(1)
+ ZPP0(2) = ZYHATM(JI,JJ,JK)+ZP0PP0(2)
+ ZPP0(3) = ZZHATM(JI,JJ,JK)+ZP0PP0(3)
+ !
+ ZP1PP0(1)=ZPP0(1)-PIBM_FACES(JN,1,1)
+ ZP1PP0(2)=ZPP0(2)-PIBM_FACES(JN,1,2)
+ ZP1PP0(3)=ZPP0(3)-PIBM_FACES(JN,1,3)
+ !
+ ZP2PP0(1)=ZPP0(1)-PIBM_FACES(JN,2,1)
+ ZP2PP0(2)=ZPP0(2)-PIBM_FACES(JN,2,2)
+ ZP2PP0(3)=ZPP0(3)-PIBM_FACES(JN,2,3)
+ !
+ ZP3PP0(1)=ZPP0(1)-PIBM_FACES(JN,3,1)
+ ZP3PP0(2)=ZPP0(2)-PIBM_FACES(JN,3,2)
+ ZP3PP0(3)=ZPP0(3)-PIBM_FACES(JN,3,3)
+ !
+ ZPP0P1(1)=PIBM_FACES(JN,1,1)-ZPP0(1)
+ ZPP0P1(2)=PIBM_FACES(JN,1,2)-ZPP0(2)
+ ZPP0P1(3)=PIBM_FACES(JN,1,3)-ZPP0(3)
+ !
+ ZPP0P2(1)=PIBM_FACES(JN,2,1)-ZPP0(1)
+ ZPP0P2(2)=PIBM_FACES(JN,2,2)-ZPP0(2)
+ ZPP0P2(3)=PIBM_FACES(JN,2,3)-ZPP0(3)
+ !
+ ZPP0P3(1)=PIBM_FACES(JN,3,1)-ZPP0(1)
+ ZPP0P3(2)=PIBM_FACES(JN,3,2)-ZPP0(2)
+ ZPP0P3(3)=PIBM_FACES(JN,3,3)-ZPP0(3)
+ !
+ !***Calculation of f1,f2,f3 (Jones (1995))
+ ZFT1= CROSSPRODUCT(PV1(JN,:),ZP1PP0)
+ ZFT2= CROSSPRODUCT(PV2(JN,:),ZP2PP0)
+ ZFT3= CROSSPRODUCT(PV3(JN,:),ZP3PP0)
+
+ ZF1 =ZFT1(1)*PNORM_FACES(JN,1)+ &
+ ZFT1(2)*PNORM_FACES(JN,2)+ &
+ ZFT1(3)*PNORM_FACES(JN,3)
+
+ ZF2 =ZFT2(1)*PNORM_FACES(JN,1)+ &
+ ZFT2(2)*PNORM_FACES(JN,2)+ &
+ ZFT2(3)*PNORM_FACES(JN,3)
+
+ ZF3 =ZFT3(1)*PNORM_FACES(JN,1)+ &
+ ZFT3(2)*PNORM_FACES(JN,2)+ &
+ ZFT3(3)*PNORM_FACES(JN,3)
+ !***Point anticlockwise of V1 and clockwise of V2
+ IF (ZF1.GE.0.AND.ZF2.LE.0) THEN
+ ZFT1B = CROSSPRODUCT(ZPP0P1,ZPP0P2)
+ ZF1B = ZFT1B(1)*PNORM_FACES(JN,1)+ &
+ ZFT1B(2)*PNORM_FACES(JN,2)+ &
+ ZFT1B(3)*PNORM_FACES(JN,3)
+ IF (ZF1B<0) THEN
+ ZP1P2(:) = PIBM_FACES(JN,2,:)-PIBM_FACES(JN,1,:)
+ ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P2,ZPP0P1),ZP1P2)
+ ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
+ !***Eq. (10) of Jones(1995)
+ ZDPP0PPP0 = SQRT(ZPP0P1(1)**2+ZPP0P1(2)**2+ZPP0P1(3)**2)* &
+ ((ZPP0P1(1)*ZR(1)+ZPP0P1(2)*ZR(2)+ZPP0P1(3)*ZR(3))/( &
+ SQRT(ZPP0P1(1)**2+ZPP0P1(2)**2+ZPP0P1(3)**2)*ZRN))! &
+ ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
+ ZPPP0 = ZPP0+ZPP0PPP0
+ ZPPP0P1 = PIBM_FACES(JN,1,:)-ZPPP0
+ ZP2P1 = PIBM_FACES(JN,1,:)-PIBM_FACES(JN,2,:)
+ ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P1,ZP2P1))
+ ZT = SQRT(ZPPP0P1(1)**2+ZPPP0P1(2)**2+ZPPP0P1(3)**2)/ &
+ SQRT(ZP2P1(1)**2+ZP2P1(2)**2+ZP2P1(3)**2)*ZRDIR(1)
+ IF (ZT.GE.0.AND.ZT.LE.1) THEN
+ ZDIST =SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
+ ELSEIF (ZT<0.) THEN
+ ZDIST = SQRT(ZP1P0(1)**2+ZP1P0(2)**2+ZP1P0(3)**2)
+ ELSEIF (ZT>1.) THEN
+ ZDIST = SQRT(ZP2P0(1)**2+ZP2P0(2)**2+ZP2P0(3)**2)
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
+ ENDIF
+ ELSE
+ ZDIST = ZDP0PP0
+ LFACE = .TRUE.
+ ENDIF
+ !***Point anticlockwise of V2 and clockwise of V3
+ ELSEIF (ZF2.GE.0.AND.ZF3.LE.0) THEN
+ ZFT2B = CROSSPRODUCT(ZPP0P2,ZPP0P3)
+ ZF2B = ZFT2B(1)*PNORM_FACES(JN,1)+ &
+ ZFT2B(2)*PNORM_FACES(JN,2)+ &
+ ZFT2B(3)*PNORM_FACES(JN,3)
+ IF (ZF2B<0) THEN
+ ZP2P3(:) = PIBM_FACES(JN,3,:)-PIBM_FACES(JN,2,:)
+ ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P3,ZPP0P2),ZP2P3)
+ ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
+ ZDPP0PPP0 = SQRT(ZPP0P2(1)**2+ZPP0P2(2)**2+ZPP0P2(3)**2)* &
+ ((ZPP0P2(1)*ZR(1)+ZPP0P2(2)*ZR(2)+ZPP0P2(3)*ZR(3))/( &
+ SQRT(ZPP0P2(1)**2+ZPP0P2(2)**2+ZPP0P2(3)**2)*ZRN))! &
+ ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
+ ZPPP0 = ZPP0+ZPP0PPP0
+ ZPPP0P2 = PIBM_FACES(JN,2,:)-ZPPP0
+ ZP3P2 = PIBM_FACES(JN,2,:)-PIBM_FACES(JN,3,:)
+ ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P2,ZP3P2))
+ ZT = SQRT(ZPPP0P2(1)**2+ZPPP0P2(2)**2+ZPPP0P2(3)**2)/ &
+ SQRT(ZP3P2(1)**2+ZP3P2(2)**2+ZP3P2(3)**2)*ZRDIR(1)
+ IF (ZT.GE.0.AND.ZT.LE.1) THEN
+ ZDIST = SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
+ ELSEIF (ZT<0.) THEN
+ ZDIST = SQRT(ZP2P0(1)**2+ZP2P0(2)**2+ZP2P0(3)**2)
+ ELSEIF (ZT>1.) THEN
+ ZDIST = SQRT(ZP3P0(1)**2+ZP3P0(2)**2+ZP3P0(3)**2)
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
+ ENDIF
+ ELSE
+ ZDIST = ZDP0PP0
+ LFACE = .TRUE.
+ ENDIF
+ !***Point anticlockwise of V3 and clockwise of V1
+ ELSEIF (ZF3.GE.0.AND.ZF1.LE.0) THEN
+ ZFT3B = CROSSPRODUCT(ZPP0P3,ZPP0P1)
+ ZF3B = ZFT3B(1)*PNORM_FACES(JN,1)+ &
+ ZFT3B(2)*PNORM_FACES(JN,2)+ &
+ ZFT3B(3)*PNORM_FACES(JN,3)
+ IF (ZF3B<0) THEN
+ ZP3P1(:) = PIBM_FACES(JN,1,:)-PIBM_FACES(JN,3,:)
+ ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P1,ZPP0P3),ZP3P1)
+ ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
+ ZDPP0PPP0 = SQRT(ZPP0P3(1)**2+ZPP0P3(2)**2+ZPP0P3(3)**2)* &
+ ((ZPP0P3(1)*ZR(1)+ZPP0P3(2)*ZR(2)+ZPP0P3(3)*ZR(3))/( &
+ SQRT((ZPP0P3(1))**2+(ZPP0P3(2))**2+(ZPP0P3(3))**2)*ZRN))! &
+ ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
+ ZPPP0 = ZPP0+ZPP0PPP0
+ ZPPP0P3 = PIBM_FACES(JN,3,:)-ZPPP0
+ ZP1P3 = PIBM_FACES(JN,3,:)-PIBM_FACES(JN,1,:)
+ ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P3,ZP1P3))
+ ZT = SQRT(ZPPP0P3(1)**2+ZPPP0P3(2)**2+ZPPP0P3(3)**2)/ &
+ SQRT(ZP1P3(1)**2+ZP1P3(2)**2+ZP1P3(3)**2)*ZRDIR(1)
+ IF (ZT.GE.0.AND.ZT.LE.1) THEN
+ ZDIST = SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
+ ELSEIF (ZT<0.) THEN
+ ZDIST = SQRT(ZP3P0(1)**2+ZP3P0(2)**2+ZP3P0(3)**2)
+ ELSEIF (ZT>1.) THEN
+ ZDIST = SQRT(ZP1P0(1)**2+ZP1P0(2)**2+ZP1P0(3)**2)
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
+ ENDIF
+ ELSE
+ ZDIST = ZDP0PP0
+ LFACE = .TRUE.
+ ENDIF
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZF instruction' )
+ ENDIF
+ ZDIST = SIGN(ZDIST,-ZSIGN)
+ ZDIST = ANINT(ZDIST*10.E5) / 10.E5
+ PPHI(JI,JJ,JK,JM) = ANINT(PPHI(JI,JJ,JK,JM)*10.E5) / 10.E5
+ IF (ABS(ZDIST).LE.ABS(PPHI(JI,JJ,JK,JM))) THEN
+ ZPHI_OLD = PPHI(JI,JJ,JK,JM)
+ IF (ABS(ZDIST)==ABS(PPHI(JI,JJ,JK,JM))) THEN
+ IF (ABS(ZDP0PP0).GT.ABS(ZDP0PP0PAST(JI,JJ,JK))) THEN
+ PPHI(JI,JJ,JK,JM) = ZDIST
+ ZDP0PP0PAST(JI,JJ,JK) = ZDP0PP0
+ ENDIF
+ ELSE
+ PPHI(JI,JJ,JK,JM) = ZDIST
+ ENDIF
+ IF (ABS(ZDIST).LT.ABS(ZPHI_OLD)) THEN
+ ZDP0PP0PAST(JI,JJ,JK) = ZDP0PP0
+ ENDIF
+ ENDIF
+ IF (ABS(PPHI(JI,JJ,JK,JM)).GT.(SQRT(3.)*4.)) THEN
+ PPHI(JI,JJ,JK,JM) = -999.
+ ENDIF
+ IF (ABS(ZDIST).LT.(SQRT(3.)*4.)) THEN
+ ZVECTDIST(ZCOUNT)=ZDIST
+ ZFACE(ZCOUNT)=LFACE
+ ZCOUNT = ZCOUNT +1
+ ENDIF
+ ENDDO
+ ZVECTDISTPLUS=ZVECTDIST
+ ZVECTDISTMOINS=ZVECTDIST
+ WHERE (ZVECTDIST.GT.0)
+ ZVECTDISTMOINS=-999.
+ ENDWHERE
+ WHERE (ZVECTDIST.LT.0)
+ ZVECTDISTPLUS=999.
+ ENDWHERE
+ IF (ANY(ZVECTDIST.GT.0.).AND.(ABS(ABS(MINVAL(ZVECTDISTPLUS))-ABS(MAXVAL(ZVECTDISTMOINS))).LT.10.E-6)) THEN
+ ZMIN_DIFF = 1.
+ ZIDX = 0
+ DO ZII = 1, SIZE(ZVECTDIST)
+ ZDIFF = ABS(ZVECTDIST(ZII)-MINVAL(ZVECTDISTPLUS))
+ IF ( ZDIFF < ZMIN_DIFF) THEN
+ ZIDX = ZII
+ ZMIN_DIFF = ZDIFF
+ ENDIF
+ ENDDO
+ IF (ZFACE(ZIDX)) THEN
+ PPHI(JI,JJ,JK,JM) = MINVAL(ZVECTDISTPLUS)
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+
+DO JJ=JJ_MIN,JJ_MAX
+DO JI=JI_MIN,JI_MAX
+GABOVE_ROOF=.FALSE.
+DO JK=IKB, IKE
+ ! check if point is flagged as not calculated
+ IF (PPHI(JI,JJ,JK,JM)==-999.) THEN
+ ! check if point is already above a point that encountered a point near the
+ ! surface (that can be outside or inside a building)
+ ! check if that point was inside (if outside, the value of the levelset
+ ! stays at -999.)
+ IF (GABOVE_ROOF .AND. PPHI(JI,JJ,JK-1,JM) > XIBM_EPSI) THEN
+ PPHI(JI,JJ,JK,JM) = 999.
+ CYCLE
+ END IF
+ ! check if the point of the column have not encoutered a near-building
+ ! surface point with a physical value of the level set
+ IF (.NOT. GABOVE_ROOF) THEN
+ ! if the point above has a physical value for the level set, then the
+ ! status inside (999) or outside (-999) is given to all points below,
+ ! depending if this point above (that needs not to be the point at the top
+ ! of the model!) is inside or outside
+ ! checks if the point above has a physical value for the levelset
+ IF (JK<IKE .AND. ABS (PPHI(JI,JJ,JK+1,JM)) < 900.) THEN
+ ! if the point above is inside, all points below are set inside
+ IF (PPHI(JI,JJ,JK+1,JM)>XIBM_EPSI) PPHI(JI,JJ,IKB:JK,JM) = 999.
+ ! indicate for further processing of points above the current point
+ ! that we have encountered a physical value of the level set, near the
+ ! surface building
+ GABOVE_ROOF = .TRUE.
+ END IF
+ CYCLE
+ ENDIF
+ END IF
+ ! if we have never encoutered a roof or point near a building form above,
+ ! then, we are outside, and nothing is changed (value -999 kept)
+ END DO
+ PPHI(JI,JJ,IKB-1,JM) = PPHI(JI,JJ,IKB,JM)
+ PPHI(JI,JJ,IKE+1,JM) = PPHI(JI,JJ,IKE,JM)
+END DO
+END DO
+
+
+JN=1
+PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
+PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
+PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
+PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
+PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
+PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
+
+PPHI(:,:,:,2)=MXM(PPHI(:,:,:,1))
+PPHI(:,:,:,3)=MYM(PPHI(:,:,:,1))
+PPHI(:,:,:,4)=MZM(PPHI(:,:,:,1))
+
+NULLIFY(TZFIELDS_ll)
+DO JN=2,4
+ PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
+ PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
+ PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
+ PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
+ PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
+ PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
+ENDDO
+
+PPHI(:,:,:,5)=MYM(PPHI(:,:,:,2))
+PPHI(:,:,:,6)=MXM(PPHI(:,:,:,4))
+PPHI(:,:,:,7)=MYM(PPHI(:,:,:,4))
+NULLIFY(TZFIELDS_ll)
+DO JN=5,7
+ PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
+ PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
+ PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
+ PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
+ PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
+ PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
+ENDDO
+WHERE (ABS(PPHI(:,:,:,:)).LT.XIBM_EPSI) PPHI(:,:,:,:)=2.*XIBM_EPSI
+
+
+ !COMPLETE PPHI ON THE HALO OF EACH SUBDOMAINS
+ DO JN=1,7
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,JN),'IBM_GENERLS::PPHI')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ !DEALLOCATE(ZDP0PP0,ZDIST,ZC,ZSTEMP)
+ DEALLOCATE(ZC,ZSTEMP)
+ DEALLOCATE(ZXHATM,ZYHATM,ZZHATM)
+ !
+ RETURN
+ !
+CONTAINS
+ !
+ FUNCTION CROSSPRODUCT(PA,PB) RESULT(CROSS)
+ !
+ REAL, DIMENSION(3) :: CROSS
+ REAL, DIMENSION(3), INTENT(IN) :: PA, PB
+ CROSS(1) = PA(2) * PB(3) - PA(3) * PB(2)
+ CROSS(2) = PA(3) * PB(1) - PA(1) * PB(3)
+ CROSS(3) = PA(1) * PB(2) - PA(2) * PB(1)
+ END FUNCTION CROSSPRODUCT
+
+ FUNCTION SCALPRODUCT(PA,PB) RESULT(SCAL)
+ !
+ REAL :: SCAL
+ REAL, DIMENSION(3), INTENT(IN) :: PA, PB
+ SCAL = PA(1)*PB(1)+PA(2)*PB(2)+PA(3)*PB(3)
+ END FUNCTION SCALPRODUCT
+
+END SUBROUTINE IBM_GENERLS
diff --git a/src/MNH/ibm_idealee.f90 b/src/MNH/ibm_idealee.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e08be780d96d538d079536dc127c04074e860dd8
--- /dev/null
+++ b/src/MNH/ibm_idealee.f90
@@ -0,0 +1,261 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_IDEALEE
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_IDEALEE(KNUMB_OBS,PIBM_XYZ,PPHI)
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_IDEALEE
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_IDEALEE
+!
+! ###############################################
+SUBROUTINE IBM_IDEALEE(KNUMB_OBS,PIBM_XYZ,PPHI)
+ ! ###############################################
+ !
+ !
+ !**** IBM_IDEALEE computes LS function for ellipsoidal objects
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to estimate the
+ ! levetset function for many ellipsoidal objects.
+
+ ! METHOD
+ ! ------
+ !**** Use of a analytic solution and approximation in truncated cell
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_IBM_INTERPOS
+ USE MODI_IBM_INTERPOS2
+ !
+ IMPLICIT NONE
+ !
+ ! 0.1 declarations of arguments
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS ! obstacle number
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ ! interface location
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS function
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JN,JM ! loop index
+ INTEGER :: JI_MIN,JI_MAX,JJ_MIN,JJ_MAX,JK_MIN,JK_MAX,IIU,IJU,IKU ! loop boundaries
+ REAL, ALLOCATABLE :: ZPOSI_AXEX,ZPOSI_AXEY,ZPOSI_AXEZ ! saving positions/distances
+ REAL, ALLOCATABLE :: ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ
+ REAL, ALLOCATABLE :: ZCOEFA,ZCOEFB,ZDIST_REF0 ! solid volume and cell volume
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATM,ZYHATM,ZZHATM ! mesh location (mass nodes)
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATC,ZYHATC,ZZHATC ! mesh location (cell nodes)
+ CHARACTER(LEN=1) :: YPOS
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! 0.3 allocation
+ !
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ !
+ ALLOCATE(ZPOSI_AXEX,ZPOSI_AXEY,ZPOSI_AXEZ, &
+ ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ, &
+ ZCOEFA,ZCOEFB,ZDIST_REF0)
+ !
+ ALLOCATE(ZXHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZXHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZYHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZYHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZZHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZZHATM(IIU ,IJU ,IKU ))
+ !
+ JI_MIN = 1 + JPHEXT
+ JI_MAX = IIU - JPHEXT
+ JJ_MIN = 1 + JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MIN = 1 + JPVEXT
+ JK_MAX = IKU - JPVEXT
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ZDIST_AXEX = PIBM_XYZ(KNUMB_OBS,2)
+ ZDIST_AXEY = PIBM_XYZ(KNUMB_OBS,4)
+ ZDIST_AXEZ = PIBM_XYZ(KNUMB_OBS,6)
+ ZPOSI_AXEX = PIBM_XYZ(KNUMB_OBS,1)
+ ZPOSI_AXEY = PIBM_XYZ(KNUMB_OBS,3)
+ ZPOSI_AXEZ = PIBM_XYZ(KNUMB_OBS,5)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ DO JM=1,7
+ !
+ IF (JM==1) THEN
+ YPOS = 'P'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==2) THEN
+ YPOS = 'U'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==3) THEN
+ YPOS = 'V'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==4) THEN
+ YPOS = 'W'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==5) THEN
+ YPOS = 'A'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==6) THEN
+ YPOS = 'B'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==7) THEN
+ YPOS = 'C'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ !
+ CALL IBM_INTERPOS(ZXHATM,ZYHATM,ZZHATM,YPOS)
+ CALL IBM_INTERPOS2(ZXHATM,ZYHATM,ZZHATM,ZXHATC,ZYHATC,ZZHATC)
+ !
+ DO JK = JK_MIN,JK_MAX
+ DO JJ = JJ_MIN,JJ_MAX
+ DO JI = JI_MIN,JI_MAX
+ !
+ ! LS function
+ !
+ IF ((ZDIST_AXEX.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.gt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ)
+ ZCOEFB = sqrt(((ZXHATM(JI,JJ,JK)-ZPOSI_AXEX)*ZCOEFA/ZDIST_AXEX)**2.+&
+ ((ZYHATM(JI,JJ,JK)-ZPOSI_AXEY)*ZCOEFA/ZDIST_AXEY)**2.+&
+ ((ZZHATM(JI,JJ,JK)-ZPOSI_AXEZ)*ZCOEFA/ZDIST_AXEZ)**2.)
+ !
+ ENDIF
+ !
+ IF ((ZDIST_AXEX.lt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.gt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEY,ZDIST_AXEZ)
+ ZCOEFB = sqrt(((ZYHATM(JI,JJ,JK)-ZPOSI_AXEY)*ZCOEFA/ZDIST_AXEY)**2.+&
+ ((ZZHATM(JI,JJ,JK)-ZPOSI_AXEZ)*ZCOEFA/ZDIST_AXEZ)**2.)
+ !
+ ENDIF
+ !
+ IF ((ZDIST_AXEX.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.lt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.gt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEX,ZDIST_AXEZ)
+ ZCOEFB =sqrt(((ZXHATM(JI,JJ,JK)-ZPOSI_AXEX)*ZCOEFA/ZDIST_AXEX)**2.+&
+ ((ZZHATM(JI,JJ,JK)-ZPOSI_AXEZ)*ZCOEFA/ZDIST_AXEZ)**2.)
+ !
+ ENDIF
+ !
+ IF ((ZDIST_AXEX.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.lt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEX,ZDIST_AXEY)
+ ZCOEFB = sqrt(((ZXHATM(JI,JJ,JK)-ZPOSI_AXEX)*ZCOEFA/ZDIST_AXEX)**2.+&
+ ((ZYHATM(JI,JJ,JK)-ZPOSI_AXEY)*ZCOEFA/ZDIST_AXEY)**2.)
+ !
+ ENDIF
+ !
+ ZDIST_REF0 = ZCOEFA-ZCOEFB
+ !
+ IF (PPHI(JI,JJ,JK,JM) .lt. ZDIST_REF0) PPHI(JI,JJ,JK,JM) = ZDIST_REF0
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(ZXHATM,ZYHATM,ZZHATM)
+ DEALLOCATE(ZXHATC,ZYHATC,ZZHATC)
+ DEALLOCATE(ZPOSI_AXEX,ZPOSI_AXEY,ZPOSI_AXEZ,ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ,ZCOEFA,ZCOEFB,ZDIST_REF0)
+ !
+ RETURN
+ !
+ !------------------------------------------------------------------------------
+END SUBROUTINE IBM_IDEALEE
diff --git a/src/MNH/ibm_idealrp.f90 b/src/MNH/ibm_idealrp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a67bb5fd2a5095ed294c0ec9a67bc547dc0e0273
--- /dev/null
+++ b/src/MNH/ibm_idealrp.f90
@@ -0,0 +1,311 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_IDEALRP
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_IDEALRP(KNUMB_OBS,PIBM_XYZ,PPHI)
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_IDEALRP
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_IDEALRP
+!
+! ###############################################
+SUBROUTINE IBM_IDEALRP(KNUMB_OBS,PIBM_XYZ,PPHI)
+ ! ###############################################
+ !
+ !
+ !**** IBM_IDEALRP compute LS function for parallelepipedic objects
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to estimate the
+ ! levetset function for many parallelepipedic objects.
+ ! I_NUMB_ITER is a parameter controlling the fine resolution of
+ ! each surface
+ !
+ ! METHOD
+ ! ------
+ !**** Use of a smooth Heaviside function and a characteristic numerical interface thickness
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODE_GATHER_ll
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_IBM_INTERPOS
+ USE MODI_IBM_INTERPOS2
+ !
+ IMPLICIT NONE
+ !
+ ! 0.1 declarations of arguments
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS ! obstacle number
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ ! array for interface initialization
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JN,JM,IIU,IJU,IKU,IIU_ll,IJU_ll ! loop index
+ INTEGER :: JI_MIN,JI_MAX,JJ_MIN,JJ_MAX,JK_MIN,JK_MAX
+ REAL :: ZDELTX,ZDELTY,ZDELTZ
+ REAL, ALLOCATABLE :: ZTEST_XMIN,ZTEST_XMAX ! saving positions
+ REAL, ALLOCATABLE :: ZTEST_YMIN,ZTEST_YMAX
+ REAL, ALLOCATABLE :: ZTEST_ZMIN,ZTEST_ZMAX
+ REAL, ALLOCATABLE :: ZPOSI_XYZ0,ZPOSI_XYZ1,ZPOSI_XYZ2
+ REAL, ALLOCATABLE :: ZDIST_SUR0,ZDIST_SUR1,ZDIST_SUR2 ! saving distances
+ REAL, ALLOCATABLE :: ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5
+ REAL, ALLOCATABLE :: ZDIST_SUR6,ZDIST_REF0
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATM,ZYHATM,ZZHATM ! mesh location (mass nodes)
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATC,ZYHATC,ZZHATC ! mesh location (cell nodes)
+ REAL, DIMENSION(:) , ALLOCATABLE :: ZXHAT_ll,ZYHAT_ll
+ CHARACTER(LEN=1) :: YPOS
+ INTEGER :: NRESP
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 allocation
+ !
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ !
+ JI_MIN = 1 + JPHEXT
+ JI_MAX = IIU - JPHEXT
+ JJ_MIN = 1 + JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MIN = 1 + JPVEXT
+ JK_MAX = IKU - JPVEXT
+ !
+ ALLOCATE(ZXHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZYHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZZHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZXHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZYHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZZHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZTEST_XMIN,ZTEST_XMAX,ZTEST_YMIN,ZTEST_YMAX,ZTEST_ZMIN,ZTEST_ZMAX)
+ ALLOCATE(ZPOSI_XYZ0,ZPOSI_XYZ1,ZPOSI_XYZ2)
+ ALLOCATE(ZDIST_SUR0,ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6,ZDIST_REF0)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ CALL GET_GLOBALDIMS_ll(IIU_ll,IJU_ll)
+ ALLOCATE(ZXHAT_ll(IIU_ll+ 2 * JPHEXT))
+ ALLOCATE(ZYHAT_ll(IJU_ll+ 2 * JPHEXT))
+ CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,NRESP)
+ CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,NRESP)
+ ZDELTX = abs((PIBM_XYZ(KNUMB_OBS,1)-PIBM_XYZ(KNUMB_OBS,2))/ &
+ ((ZXHAT_ll(IIU_ll+2)-ZXHAT_ll(2))/(IIU_ll*1.)))
+ ZDELTY = abs((PIBM_XYZ(KNUMB_OBS,3)-PIBM_XYZ(KNUMB_OBS,4))/ &
+ ((ZYHAT_ll(IJU_ll+2)-ZYHAT_ll(2))/(IJU_ll*1.)))
+ ZDELTZ = abs((PIBM_XYZ(KNUMB_OBS,5)-PIBM_XYZ(KNUMB_OBS,6))/ &
+ ((XZHAT(IKU)-XZHAT(2))/(IKU*1.-2.)))
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ DO JM=1,7
+ !
+ IF (JM==1) THEN
+ YPOS = 'P'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==2) THEN
+ YPOS = 'U'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==3) THEN
+ YPOS = 'V'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==4) THEN
+ YPOS = 'W'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==5) THEN
+ YPOS = 'A'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==6) THEN
+ YPOS = 'B'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==7) THEN
+ YPOS = 'C'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ CALL IBM_INTERPOS(ZXHATM,ZYHATM,ZZHATM,YPOS)
+ CALL IBM_INTERPOS2(ZXHATM,ZYHATM,ZZHATM,ZXHATC,ZYHATC,ZZHATC)
+ DO JK = JK_MIN,JK_MAX
+ DO JJ = JJ_MIN,JJ_MAX
+ DO JI = JI_MIN,JI_MAX
+ !
+ ! LS function
+ ZTEST_XMIN = PIBM_XYZ(KNUMB_OBS,1)
+ ZTEST_XMAX = PIBM_XYZ(KNUMB_OBS,2)
+ ZTEST_YMIN = PIBM_XYZ(KNUMB_OBS,3)
+ ZTEST_YMAX = PIBM_XYZ(KNUMB_OBS,4)
+ ZTEST_ZMIN = PIBM_XYZ(KNUMB_OBS,5)
+ ZTEST_ZMAX = PIBM_XYZ(KNUMB_OBS,6)
+ !
+ ZPOSI_XYZ0 = ZTEST_XMIN
+ ZDIST_SUR1 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_YMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ0-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ1-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR1 = min(ZDIST_SUR0,ZDIST_SUR1)
+ !
+ ZPOSI_XYZ0 = ZTEST_XMAX
+ ZDIST_SUR2 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_YMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ0-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ1-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR2 = min(ZDIST_SUR0,ZDIST_SUR2)
+ !
+ ZPOSI_XYZ0 = ZTEST_YMIN
+ ZDIST_SUR3 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR3 = min(ZDIST_SUR0,ZDIST_SUR3)
+ !
+ ZPOSI_XYZ0 = ZTEST_YMAX
+ ZDIST_SUR4 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR4 = min(ZDIST_SUR0,ZDIST_SUR4)
+ !
+ ZPOSI_XYZ0 = ZTEST_ZMIN
+ ZDIST_SUR5 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_YMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR5 = min(ZDIST_SUR0,ZDIST_SUR5)
+ !
+ ZPOSI_XYZ0 = ZTEST_ZMAX
+ ZDIST_SUR6 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_YMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR6 = min(ZDIST_SUR0,ZDIST_SUR6)
+ !
+ IF ((ZXHATM(JI,JJ,JK) .gt. ZTEST_XMIN.and.ZXHATM(JI,JJ,JK) .lt. ZTEST_XMAX).and. &
+ (ZYHATM(JI,JJ,JK) .gt. ZTEST_YMIN.and.ZYHATM(JI,JJ,JK) .lt. ZTEST_YMAX).and. &
+ (ZZHATM(JI,JJ,JK) .gt. ZTEST_ZMIN.and.ZZHATM(JI,JJ,JK) .lt. ZTEST_ZMAX)) then
+ ZDIST_REF0 = +min(ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6)
+ ELSE
+ ZDIST_REF0 = -min(ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6)
+ ENDIF
+ !
+ IF (PPHI(JI,JJ,JK,JM) .lt. ZDIST_REF0) PPHI(JI,JJ,JK,JM) = ZDIST_REF0
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(ZXHATC,ZYHATC,ZZHATC)
+ DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
+ DEALLOCATE(ZTEST_XMIN,ZTEST_XMAX,ZTEST_YMIN,ZTEST_YMAX,ZTEST_ZMIN,ZTEST_ZMAX)
+ DEALLOCATE(ZPOSI_XYZ0,ZPOSI_XYZ1,ZPOSI_XYZ2)
+ DEALLOCATE(ZDIST_SUR0,ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6,ZDIST_REF0)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_IDEALRP
diff --git a/src/MNH/ibm_init.f90 b/src/MNH/ibm_init.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3918438ba423b0037191fb61a1c303ce35ffc324
--- /dev/null
+++ b/src/MNH/ibm_init.f90
@@ -0,0 +1,222 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! ####################
+MODULE MODI_IBM_INIT
+ ! ####################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INIT(PIBM_LS)
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIBM_LS
+ !
+ END SUBROUTINE IBM_INIT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INIT
+!
+! ############################
+SUBROUTINE IBM_INIT(PIBM_LS)
+ ! ############################
+ !
+ !**** *IBM_INIT* - routine to initialize the immersed boundary method
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to initialize the IBM variables
+ ! that are stored in module MODD_IBM_PARAM_n
+ !
+ ! METHOD
+ ! ------
+ ! The constants are set to their numerical values
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_SUB_MODEL_n, ONLY: XT_IBM_DETE
+ USE MODD_IBM_PARAM_n
+ USE MODD_FIELD_n
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID
+ USE MODD_GRID_n
+ USE MODD_CST
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_CONF
+ USE MODD_REF_n
+ USE MODN_PARAM_n
+ !
+ ! interface
+ USE MODI_IBM_DETECT
+ USE MODI_SECOND_MNH
+ USE MODI_SHUMAN
+ USE MODI_IBM_VOLUME
+ USE MODI_GRADIENT_M
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIBM_LS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ REAL :: ZTIME1,ZTIME2
+ INTEGER :: IINFO_ll
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IIE,IIB,IJB,IJE,IKE,IKB,JN,IIU,IJU,IKU
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATION
+ ! ---------------
+ !
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ IKU=SIZE(XZZ,3)
+ IIB=1+JPHEXT
+ IIE=IIU-JPHEXT
+ IJB=1+JPHEXT
+ IJE=IJU-JPHEXT
+ IKB=1+JPVEXT
+ IKE=IKU-JPVEXT
+ !
+ ALLOCATE(XIBM_CURV(SIZE(PIBM_LS,1),SIZE(PIBM_LS,2),SIZE(PIBM_LS,3) )) ; XIBM_CURV = 0.
+ ALLOCATE(XIBM_SU (SIZE(PIBM_LS,1),SIZE(PIBM_LS,2),SIZE(PIBM_LS,3),3)) ; XIBM_SU = 0.
+ IF (LIBM_TROUBLE) THEN
+ ALLOCATE(XIBM_SUTR(SIZE(PIBM_LS,1),SIZE(PIBM_LS,2),SIZE(PIBM_LS,3),4)) ; XIBM_SUTR = 1.
+ ENDIF
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ZTIME1=0.
+ ZTIME2=0.
+ XT_IBM_DETE = 0.
+ CALL SECOND_MNH(ZTIME1)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !=== Level Set function
+ JN=1
+ PIBM_LS(:,:,IKB-1,JN)=2*PIBM_LS(:,:,IKB,JN)-PIBM_LS(:,:,IKB+1,JN)
+ PIBM_LS(:,:,IKE+1,JN)=2*PIBM_LS(:,:,IKE,JN)-PIBM_LS(:,:,IKE-1,JN)
+ IF (LWEST_ll ()) THEN
+ PIBM_LS(IIB ,:,:,JN) = PIBM_LS( IIB+1,:,:,JN)
+ PIBM_LS(IIB-1,:,:,JN) = PIBM_LS( IIB ,:,:,JN)
+ ENDIF
+ IF (LEAST_ll ()) THEN
+ PIBM_LS(IIE ,:,:,JN) = PIBM_LS( IIE-1,:,:,JN)
+ PIBM_LS(IIE+1,:,:,JN) = PIBM_LS( IIE ,:,:,JN)
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ PIBM_LS(:,IJB ,:,JN) = PIBM_LS(:, IJB+1,:,JN)
+ PIBM_LS(:,IJB-1,:,JN) = PIBM_LS(:, IJB ,:,JN)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PIBM_LS(:,IJE ,:,JN) = PIBM_LS(:, IJE-1,:,JN)
+ PIBM_LS(:,IJE+1,:,JN) = PIBM_LS(:, IJE ,:,JN)
+ ENDIF
+ !
+ PIBM_LS(:,:,:,2)=MXM(PIBM_LS(:,:,:,1))
+ PIBM_LS(:,:,:,3)=MYM(PIBM_LS(:,:,:,1))
+ PIBM_LS(:,:,:,4)=MZM(PIBM_LS(:,:,:,1))
+ !
+ NULLIFY(TZFIELDS_ll)
+ DO JN=2,4
+ PIBM_LS(:,:,IKB-1,JN)=2*PIBM_LS(:,:,IKB,JN)-PIBM_LS(:,:,IKB+1,JN)
+ PIBM_LS(:,:,IKE+1,JN)=2*PIBM_LS(:,:,IKE,JN)-PIBM_LS(:,:,IKE-1,JN)
+ IF (LWEST_ll ()) THEN
+ PIBM_LS(IIB ,:,:,JN) = PIBM_LS( IIB+1,:,:,JN)
+ PIBM_LS(IIB-1,:,:,JN) = PIBM_LS( IIB ,:,:,JN)
+ ENDIF
+ IF (LEAST_ll ()) THEN
+ PIBM_LS(IIE ,:,:,JN) = PIBM_LS( IIE-1,:,:,JN)
+ PIBM_LS(IIE+1,:,:,JN) = PIBM_LS( IIE ,:,:,JN)
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ PIBM_LS(:,IJB ,:,JN) = PIBM_LS(:, IJB+1,:,JN)
+ PIBM_LS(:,IJB-1,:,JN) = PIBM_LS(:, IJB ,:,JN)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PIBM_LS(:,IJE ,:,JN) = PIBM_LS(:, IJE-1,:,JN)
+ PIBM_LS(:,IJE+1,:,JN) = PIBM_LS(:, IJE ,:,JN)
+ ENDIF
+ ENDDO
+ WHERE (ABS(PIBM_LS(:,:,:,:)).LT.XIBM_EPSI) PIBM_LS(:,:,:,:)=2.*XIBM_EPSI
+ DO JN=1,4
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PIBM_LS(:,:,:,JN),'IBM_INIT::PIBM_LS')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !=== detection ghost/images
+ IF (IP==1) WRITE(*,*)'*IBM* detection ghost/images detection'
+ CALL IBM_DETECT(PIBM_LS)
+ IF (LIBM_TROUBLE) THEN
+ NULLIFY(TZFIELDS_ll)
+ DO JN=1,4
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SUTR(:,:,:,JN),'IBM_INIT::XIBM_SUTR')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ ENDIF
+ !
+ !=== detection surface/volumes
+ IF (IP==1) WRITE(*,*)'*IBM* surface/volumes detection'
+ CALL IBM_VOLUME(PIBM_LS,XIBM_SU)
+ NULLIFY(TZFIELDS_ll)
+ DO JN=1,3
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,JN),'IBM_INIT::XIBM_SU')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !===
+ CALL SECOND_MNH(ZTIME2)
+ XT_IBM_DETE=ZTIME2-ZTIME1
+ IF (IP==1) WRITE(*,*)'*IBM* End initialization in ',XT_IBM_DETE,' s'
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INIT
diff --git a/src/MNH/ibm_init_ls.f90 b/src/MNH/ibm_init_ls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2d881e1fd564803d1d7f786993fa5efc2fe14042
--- /dev/null
+++ b/src/MNH/ibm_init_ls.f90
@@ -0,0 +1,187 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_INIT_LS
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INIT_LS(PPHI)
+ !
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_INIT_LS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INIT_LS
+!
+! ############################
+SUBROUTINE IBM_INIT_LS(PPHI)
+ ! ############################
+ !
+ !**** *IBM_INIT_LS* - routine to initialize the Level-Set function for IBM
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose is to compute the LSF at mass/velocity/vorticity nodes
+ ! to store only its value at the mass node
+ !
+ ! METHOD
+ ! ------
+ ! A preparation is done by IBM_PREP depending on the type of topography
+ ! A smoothing technique done by IBM_SMOOTH is applied if necessary
+ !
+ ! EXTERNAL
+ ! --------
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_MSG
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration,
+ USE MODD_SUB_MODEL_n, ONLY: XT_IBM_PREP
+ USE MODD_IBM_PARAM_n, ONLY: XIBM_EPSI,XIBM_IEPS
+ USE MODD_IBM_LSF, ONLY: LIBM_LSF,CIBM_TYPE,NIBM_SMOOTH,XIBM_SMOOTH
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: XUNDEF,JPHEXT,JPVEXT
+ !
+ ! interface
+ USE MODI_IBM_PREP_LS
+ USE MODI_IBM_SMOOTH_LS
+ USE MODI_SECOND_MNH
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PPHI
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZPHI ! temporary LSF
+ INTEGER :: JJ,JI,JK,IIE,IIB,IJB,IJE,IKE,IKB,IIU,IJU,IKU ! loop index
+ REAL :: ZTIME1,ZTIME2 ! computation times
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ !
+ ALLOCATE(ZPHI(SIZE(PPHI,1),SIZE(PPHI,2),SIZE(PPHI,3),7))
+ ZPHI = -XIBM_IEPS
+ !
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ IKU=SIZE(XZZ,3)
+ IIB=1+JPHEXT
+ IIE=IIU-JPHEXT
+ IJB=1+JPHEXT
+ IJE=IJU-JPHEXT
+ IKB=1+JPVEXT
+ IKE=IKU-JPVEXT
+ ZTIME1=0.
+ ZTIME2=0.
+ XT_IBM_PREP = 0.
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ IF (IP==1) THEN
+ !
+ IF (CIBM_TYPE == 'GENE'.OR.CIBM_TYPE == 'IDEA'.OR.CIBM_TYPE =='REAL' &
+ .OR.CIBM_TYPE == 'GEID'.OR.CIBM_TYPE == 'IDRE') THEN
+ !
+ WRITE(*,*) '****************************'
+ WRITE(*,*) '**** BEGIN LSF BUILDING ****'
+ WRITE(*,*) '****************************'
+ !
+ ELSE
+ !
+ WRITE(*,*) '*****************************'
+ WRITE(*,*) '******** LIBM = TRUE ********'
+ WRITE(*,*) '*** CIBM_TYPE IS REQUIRED ***'
+ WRITE(*,*) '******** = GENE/IDEA ********'
+ WRITE(*,*) '**** (stopped execution) ****'
+ WRITE(*,*) '*****************************'
+ !
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','IBM_INIT_LS','with IBM, CIBM_TYPE is REQUIRED')
+ !
+ ENDIF
+ ENDIF
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ CALL SECOND_MNH(ZTIME1)
+ !
+ ! LSF initialization
+ CALL IBM_PREP_LS(LIBM_LSF,CIBM_TYPE,ZPHI)
+ !
+ ! LSF smoothing
+ IF (XIBM_SMOOTH/=0.) THEN
+ IF (XIBM_SMOOTH==XUNDEF) THEN
+ XIBM_SMOOTH=XIBM_EPSI
+ NIBM_SMOOTH=1
+ ENDIF
+ IF (IP==1) WRITE(*,*)'*IBM* Smoothing is applied on LSF'
+ CALL IBM_SMOOTH_LS(NIBM_SMOOTH,XIBM_SMOOTH,ZPHI)
+ ELSE
+ IF (IP==1) WRITE(*,*)'*IBM* No smoothing is applied on LSF'
+ ENDIF
+ !
+ ! LSF storage
+ PPHI(:,:,:,1:4)=ZPHI(:,:,:,1:4)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS
+ ! ----------------
+ !
+ DEALLOCATE(ZPHI)
+ CALL SECOND_MNH(ZTIME2)
+ XT_IBM_PREP=ZTIME2-ZTIME1
+ !
+ IF (IP==1) THEN
+ WRITE(*,*) '*IBM* Time to build LSF (s):', XT_IBM_PREP
+ WRITE(*,*) '**************************'
+ WRITE(*,*) '**** END LSF BUILDING ****'
+ WRITE(*,*) '**************************'
+ ENDIF
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INIT_LS
diff --git a/src/MNH/ibm_interpos.f90 b/src/MNH/ibm_interpos.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b124e08ef30cc57b09a7fa080d58ce9f43bf84a4
--- /dev/null
+++ b/src/MNH/ibm_interpos.f90
@@ -0,0 +1,181 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! ########################
+MODULE MODI_IBM_INTERPOS
+ ! ########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INTERPOS(PXREF,PYREF,PZREF,HPOS)
+ !
+ CHARACTER(LEN=1) , INTENT(IN) :: HPOS
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXREF,PYREF,PZREF
+ !
+ END SUBROUTINE IBM_INTERPOS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INTERPOS
+!
+! ###############################################
+SUBROUTINE IBM_INTERPOS(PXREF,PYREF,PZREF,HPOS)
+ ! ###############################################
+ !
+ !**** *IBM_INTERPOS* - routine to search location of each type of nodes
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute (X,Y,Z) for (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! interface
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ CHARACTER(LEN=1) , INTENT(IN) :: HPOS ! location UVWP
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXREF,PYREF,PZREF ! variable
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: IIU,IJU,IKU ! domain size
+ INTEGER :: JI,JJ,JK ! loop index
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ IIU = SIZE(PXREF,1)
+ IJU = SIZE(PYREF,2)
+ IKU = SIZE(PZREF,3)
+ !
+ !-----------------------------------------------------------------------------
+ !
+ IF (HPOS=='P') THEN
+ PXREF = MXF(spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = MYF(spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = MZF(XZZ)
+ ENDIF
+ IF (HPOS=='U') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = MXM(MYF(spread(spread(XYHAT(1:IJU),1,IIU),3,IKU)))
+ PZREF = MXM(MZF(XZZ))
+ ENDIF
+ IF (HPOS=='V') THEN
+ PXREF = MYM(MXF(spread(spread(XXHAT(1:IIU),2,IJU),3,IKU)))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = MYM(MZF(XZZ))
+ ENDIF
+ IF (HPOS=='W') THEN
+ PXREF = MZM(MXF((spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))))
+ PYREF = MZM(MYF((spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))))
+ PZREF = XZZ
+ ENDIF
+ IF (HPOS=='A') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = MZF(XZZ)
+ ENDIF
+ IF (HPOS=='B') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = MYF(spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = XZZ
+ ENDIF
+ IF (HPOS=='C') THEN
+ PXREF = MXF(spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = XZZ
+ ENDIF
+ IF (HPOS=='X') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = XZZ
+ ENDIF
+ !
+ IF (LWEST_ll( )) THEN
+ PXREF(1, :, :) = (2.*PXREF(2, :, :)-PXREF(3, :, :))
+ PYREF(1, :, :) = (2.*PYREF(2, :, :)-PYREF(3, :, :))
+ PZREF(1, :, :) = (2.*PZREF(2, :, :)-PZREF(3, :, :))
+ ENDIF
+ IF (LEAST_ll( )) THEN
+ PXREF(IIU, :, :) = (2.*PXREF(IIU-1, :, :)-PXREF(IIU-2, :, :))
+ PYREF(IIU, :, :) = (2.*PYREF(IIU-1, :, :)-PYREF(IIU-2, :, :))
+ PZREF(IIU, :, :) = (2.*PZREF(IIU-1, :, :)-PZREF(IIU-2, :, :))
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ PXREF(: ,1, :) = (2.*PXREF(: ,2, :)-PXREF(: ,3, :))
+ PYREF(: ,1, :) = (2.*PYREF(: ,2, :)-PYREF(: ,3, :))
+ PZREF(: ,1, :) = (2.*PZREF(: ,2, :)-PZREF(: ,3, :))
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PXREF(: ,IJU, :) = (2.*PXREF(: ,IJU-1, :)-PXREF(: ,IJU-2, :))
+ PYREF(: ,IJU, :) = (2.*PYREF(: ,IJU-1, :)-PYREF(: ,IJU-2, :))
+ PZREF(: ,IJU, :) = (2.*PZREF(: ,IJU-1, :)-PZREF(: ,IJU-2, :))
+ ENDIF
+ !
+ PXREF(: , :, 1) = (2.*PXREF(: , :, 2)-PXREF(: , :, 3))
+ PXREF(: , :,IKU) = (2.*PXREF(: , :,IKU-1)-PXREF(: , :,IKU-2))
+ PYREF(: , :, 1) = (2.*PYREF(: , :, 2)-PYREF(: , :, 3))
+ PYREF(: , :,IKU) = (2.*PYREF(: , :,IKU-1)-PYREF(: , :,IKU-2))
+ PZREF(: , :, 1) = (2.*PZREF(: , :, 2)-PZREF(: , :, 3))
+ PZREF(: , :,IKU) = (2.*PZREF(: , :,IKU-1)-PZREF(: , :,IKU-2))
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PXREF,'IBM_INTERPOS::PXREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PYREF,'IBM_INTERPOS::PYREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PZREF,'IBM_INTERPOS::PZREF')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INTERPOS
diff --git a/src/MNH/ibm_interpos2.f90 b/src/MNH/ibm_interpos2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fb2b003b6e976411ac0e0578bcdf4e354625e964
--- /dev/null
+++ b/src/MNH/ibm_interpos2.f90
@@ -0,0 +1,183 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_INTERPOS2
+ ! #########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INTERPOS2(PXREF,PYREF,PZREF,PXNEW,PYNEW,PZNEW)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXREF,PYREF,PZREF
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXNEW,PYNEW,PZNEW
+ !
+ END SUBROUTINE IBM_INTERPOS2
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INTERPOS2
+!
+! #############################################################
+SUBROUTINE IBM_INTERPOS2(PXREF,PYREF,PZREF,PXNEW,PYNEW,PZNEW)
+ ! #############################################################
+ !
+ !**** *IBM_INTERPOS2* - routine to search location of cell corners
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute cell corners for (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXREF,PYREF,PZREF ! node location
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXNEW,PYNEW,PZNEW ! cell location
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: IIU,IJU,IKU ! domain size
+ INTEGER :: JI,JJ,JK ! loop index
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ NULLIFY(TZFIELDS_ll)
+ IIU = SIZE(PXREF,1)
+ IJU = SIZE(PYREF,2)
+ IKU = SIZE(PZREF,3)
+ !
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PXREF,'IBM_INTERPOS2::PXREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PYREF,'IBM_INTERPOS2::PYREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PZREF,'IBM_INTERPOS2::PZREF')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! along X
+ PXNEW(2:IIU,2:IJU,2:IKU) = PXREF(2:IIU-0,2:IJU-0,2:IKU-0) + PXREF(1:IIU-1,2:IJU-0,2:IKU-0) + &
+ PXREF(1:IIU-1,1:IJU-1,2:IKU-0) + PXREF(2:IIU-0,1:IJU-1,2:IKU-0) + &
+ PXREF(2:IIU-0,2:IJU-0,1:IKU-1) + PXREF(1:IIU-1,2:IJU-0,1:IKU-1) + &
+ PXREF(1:IIU-1,1:IJU-1,1:IKU-1) + PXREF(2:IIU-0,1:IJU-1,1:IKU-1)
+ PXNEW(2:IIU,2:IJU,2:IKU) = PXNEW(2:IIU,2:IJU,2:IKU) * (1./8.)
+ !
+ IF (LWEST_ll()) THEN
+ PXNEW(1,:,:) = (2.*PXNEW(2,:,:)-PXNEW(3,:,:))
+ PXNEW(:,1,:) = (2.*PXNEW(:,2,:)-PXNEW(:,3,:))
+ PXNEW(:,:,1) = (2.*PXNEW(:,:,2)-PXNEW(:,:,3))
+ PXNEW(1,1,:) = (2.*PXNEW(2,2,:)-PXNEW(3,3,:))
+ PXNEW(:,1,1) = (2.*PXNEW(:,2,2)-PXNEW(:,3,3))
+ PXNEW(1,:,1) = (2.*PXNEW(2,:,2)-PXNEW(3,:,3))
+ PXNEW(1,1,1) = (2.*PXNEW(2,2,2)-PXNEW(3,3,3))
+ ENDIF
+ !
+ IF (LEAST_ll()) THEN
+ PXNEW(IIU+1, :, :) = (2.*PXNEW(IIU-0, :, :)-PXNEW(IIU-1, :, :))
+ PXNEW(: ,IJU+1, :) = (2.*PXNEW(: ,IJU-0, :)-PXNEW(: ,IJU-1, :))
+ PXNEW(: , :,IKU+1) = (2.*PXNEW(: , :,IKU-0)-PXNEW(: , :,IKU-1))
+ PXNEW(IIU+1,IJU+1, :) = (2.*PXNEW(IIU-0,IJU-0, :)-PXNEW(IIU-1,IJU-1, :))
+ PXNEW(: ,IJU+1,IKU+1) = (2.*PXNEW(: ,IJU-0,IKU-0)-PXNEW(: ,IJU-1,IKU-1))
+ PXNEW(IIU+1, :,IKU+1) = (2.*PXNEW(IIU-0, :,IKU-0)-PXNEW(IIU-1, :,IKU-1))
+ PXNEW(IIU+1,IJU+1,IKU+1) = (2.*PXNEW(IIU-0,IJU-0,IKU-0)-PXNEW(IIU-1,IJU-1,IKU-1))
+ ENDIF
+ !
+ ! along Y
+ PYNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PYREF(2:IIU-0,2:IJU-0,2:IKU-0) + PYREF(1:IIU-1,2:IJU-0,2:IKU-0) + &
+ PYREF(1:IIU-1,1:IJU-1,2:IKU-0) + PYREF(2:IIU-0,1:IJU-1,2:IKU-0) + &
+ PYREF(2:IIU-0,2:IJU-0,1:IKU-1) + PYREF(1:IIU-1,2:IJU-0,1:IKU-1) + &
+ PYREF(1:IIU-1,1:IJU-1,1:IKU-1) + PYREF(2:IIU-0,1:IJU-1,1:IKU-1)
+ PYNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PYNEW(2:IIU,2:IJU,2:IKU) * (1./8.)
+ !
+ IF (LSOUTH_ll()) THEN
+ PYNEW(1,:,:) = (2.*PYNEW(2,:,:)-PYNEW(3,:,:))
+ PYNEW(:,1,:) = (2.*PYNEW(:,2,:)-PYNEW(:,3,:))
+ PYNEW(:,:,1) = (2.*PYNEW(:,:,2)-PYNEW(:,:,3))
+ PYNEW(1,1,:) = (2.*PYNEW(2,2,:)-PYNEW(3,3,:))
+ PYNEW(:,1,1) = (2.*PYNEW(:,2,2)-PYNEW(:,3,3))
+ PYNEW(1,:,1) = (2.*PYNEW(2,:,2)-PYNEW(3,:,3))
+ PYNEW(1,1,1) = (2.*PYNEW(2,2,2)-PYNEW(3,3,3))
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PYNEW(IIU+1, :, :) = (2.*PYNEW(IIU-0, :, :)-PYNEW(IIU-1, :, :))
+ PYNEW(: ,IJU+1, :) = (2.*PYNEW(: ,IJU-0, :)-PYNEW(: ,IJU-1, :))
+ PYNEW(: , :,IKU+1) = (2.*PYNEW(: , :,IKU-0)-PYNEW(: , :,IKU-1))
+ PYNEW(IIU+1,IJU+1, :) = (2.*PYNEW(IIU-0,IJU-0, :)-PYNEW(IIU-1,IJU-1, :))
+ PYNEW(: ,IJU+1,IKU+1) = (2.*PYNEW(: ,IJU-0,IKU-0)-PYNEW(: ,IJU-1,IKU-1))
+ PYNEW(IIU+1, :,IKU+1) = (2.*PYNEW(IIU-0, :,IKU-0)-PYNEW(IIU-1, :,IKU-1))
+ PYNEW(IIU+1,IJU+1,IKU+1) = (2.*PYNEW(IIU-0,IJU-0,IKU-0)-PYNEW(IIU-1,IJU-1,IKU-1))
+ ENDIF
+ !
+ ! along Z
+ PZNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PZREF(2:IIU-0,2:IJU-0,2:IKU-0) + PZREF(1:IIU-1,2:IJU-0,2:IKU-0) + &
+ PZREF(1:IIU-1,1:IJU-1,2:IKU-0) + PZREF(2:IIU-0,1:IJU-1,2:IKU-0) + &
+ PZREF(2:IIU-0,2:IJU-0,1:IKU-1) + PZREF(1:IIU-1,2:IJU-0,1:IKU-1) + &
+ PZREF(1:IIU-1,1:IJU-1,1:IKU-1) + PZREF(2:IIU-0,1:IJU-1,1:IKU-1)
+ PZNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PZNEW(2:IIU-0,2:IJU-0,2:IKU-0) * (1./8.)
+ PZNEW(1,:,:) = (2.*PZNEW(2,:,:)-PZNEW(3,:,:))
+ PZNEW(:,1,:) = (2.*PZNEW(:,2,:)-PZNEW(:,3,:))
+ PZNEW(:,:,1) = (2.*PZNEW(:,:,2)-PZNEW(:,:,3))
+ PZNEW(1,1,:) = (2.*PZNEW(2,2,:)-PZNEW(3,3,:))
+ PZNEW(:,1,1) = (2.*PZNEW(:,2,2)-PZNEW(:,3,3))
+ PZNEW(1,:,1) = (2.*PZNEW(2,:,2)-PZNEW(3,:,3))
+ PZNEW(1,1,1) = (2.*PZNEW(2,2,2)-PZNEW(3,3,3))
+ PZNEW(IIU+1, :, :) = (2.*PZNEW(IIU-0, :, :)-PZNEW(IIU-1, :, :))
+ PZNEW(: ,IJU+1, :) = (2.*PZNEW(: ,IJU-0, :)-PZNEW(: ,IJU-1, :))
+ PZNEW(: , :,IKU+1) = (2.*PZNEW(: , :,IKU-0)-PZNEW(: , :,IKU-1))
+ PZNEW(IIU+1,IJU+1, :) = (2.*PZNEW(IIU-0,IJU-0, :)-PZNEW(IIU-1,IJU-1, :))
+ PZNEW(: ,IJU+1,IKU+1) = (2.*PZNEW(: ,IJU-0,IKU-0)-PZNEW(: ,IJU-1,IKU-1))
+ PZNEW(IIU+1, :,IKU+1) = (2.*PZNEW(IIU-0, :,IKU-0)-PZNEW(IIU-1, :,IKU-1))
+ PZNEW(IIU+1,IJU+1,IKU+1) = (2.*PZNEW(IIU-0,IJU-0,IKU-0)-PZNEW(IIU-1,IJU-1,IKU-1))
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INTERPOS2
diff --git a/src/MNH/ibm_locatcorn.f90 b/src/MNH/ibm_locatcorn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..95eeb7acc1ac48bc738ba5b8bcb1ff267fe85b90
--- /dev/null
+++ b/src/MNH/ibm_locatcorn.f90
@@ -0,0 +1,206 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_LOCATCORN
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_LOCATCORN(IINDEX,KPOS) RESULT(PLOCAT)
+ !
+ INTEGER,DIMENSION(:) , INTENT(IN) :: IINDEX
+ INTEGER , INTENT(IN) :: KPOS
+ REAL, DIMENSION(8,3) :: PLOCAT
+ !
+ END FUNCTION IBM_LOCATCORN
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_LOCATCORN
+!
+! ##################################################
+FUNCTION IBM_LOCATCORN(IINDEX,KPOS) RESULT(PLOCAT)
+ ! ##################################################
+ !
+ !**** *IBM_LOCATCORN* - routine to search location of each type of nodes
+ ! for one cell
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute (X,Y,Z) for corners of cell (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_VAR_ll, ONLY: IP
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ INTEGER, DIMENSION(:) , INTENT(IN) :: IINDEX ! IJK reference
+ INTEGER , INTENT(IN) :: KPOS ! cell type UVWP
+ REAL, DIMENSION(8,3) :: PLOCAT ! location corner
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: JI,JJ,JK,JL ! loop index
+ INTEGER :: IIU,IJU,IKU
+ INTEGER :: JIM1,JIP1,JJM1,JJP1,JKM1,JKP1
+ REAL :: ZIP1,ZJP1,ZKP1,ZIM1,ZJM1,ZKM1
+ REAL :: ZXXP,ZYYP,ZZZP,ZDXP,ZDYP,ZDZP
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ IIU = size(XZZ,1)
+ IJU = size(XZZ,2)
+ IKU = size(XZZ,3)
+ !
+ DO JL = 1,8
+ !
+ ! corners index
+ IF (JL==1) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==2) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==3) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==4) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==5) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==6) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==7) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==8) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ !
+ JIM1=max(1 ,JI-1)
+ JJM1=max(1 ,JJ-1)
+ JKM1=max(1 ,JK-1)
+ JIP1=min(IIU,JI+1)
+ JJP1=min(IJU,JJ+1)
+ JKP1=min(IKU,JK+1)
+ !
+ IF(IINDEX(1)==0.or.IINDEX(2)==0.or.IINDEX(3)==0) WRITE(*,*) 'IINDEX(1,2,3): ', IINDEX(1),IINDEX(2),IINDEX(3)
+ ZXXP = XXHAT(IINDEX(1))
+ ZYYP = XYHAT(IINDEX(2))
+ ZZZP = XZZ(IINDEX(1),IINDEX(2),IINDEX(3))
+ ZDXP = XXHAT(IINDEX(1)+1)-XXHAT(IINDEX(1))
+ ZDYP = XYHAT(IINDEX(2)+1)-XYHAT(IINDEX(2))
+ ZDZP = XZZ(IINDEX(1),IINDEX(2),IINDEX(3)+1)-XZZ(IINDEX(1),IINDEX(2),IINDEX(3))
+ !
+ IF (KPOS==1) THEN
+ PLOCAT(JL,1) = ZXXP+ZDXP/2.+(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP+ZDYP/2.+(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP+ZDZP/2.+(JK-IINDEX(3))*ZDZP
+ ENDIF
+ IF (KPOS==2) THEN
+ PLOCAT(JL,1) = ZXXP +(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP+ZDYP/2.+(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP+ZDZP/2.+(JK-IINDEX(3))*ZDZP
+ ENDIF
+ IF (KPOS==3) THEN
+ PLOCAT(JL,1) = ZXXP+ZDXP/2.+(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP +(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP+ZDZP/2.+(JK-IINDEX(3))*ZDZP
+ ENDIF
+ IF (KPOS==4) THEN
+ PLOCAT(JL,1) = ZXXP+ZDXP/2.+(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP+ZDYP/2.+(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP +(JK-IINDEX(3))*ZDZP
+ ENDIF
+ !
+ ENDDO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END FUNCTION IBM_LOCATCORN
diff --git a/src/MNH/ibm_mixinglength.f90 b/src/MNH/ibm_mixinglength.f90
new file mode 100644
index 0000000000000000000000000000000000000000..14bb0dd89b6effcd7d00516aea80b62a9b222b78
--- /dev/null
+++ b/src/MNH/ibm_mixinglength.f90
@@ -0,0 +1,164 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! ############################
+MODULE MODI_IBM_MIXINGLENGTH
+ ! ############################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMU
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PHI
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ !
+ END SUBROUTINE IBM_MIXINGLENGTH
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_MIXINGLENGTH
+!
+! ###################################################
+SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
+ ! ###################################################
+ !
+ !**** *IBM_MIXINGLENGTH* - Alteration of the mixing lenght (IBM)
+ !
+ ! PURPOSE
+ ! -------
+ ! The limitation is corrected for the immersed bonudary method:
+ ! => using the level set phi
+ ! => LM < k(-phi)
+ !
+ ! METHOD
+ ! ------
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_FIELD_n
+ USE MODD_PARAMETERS
+ USE MODD_IBM_PARAM_n
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+ USE MODD_CTURB
+ USE MODD_CST
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMU
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PHI
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ REAL, DIMENSION(size(PLM,1),size(PLM,2),size(PLM,3)) :: ZALPHA,ZBETA
+ REAL, DIMENSION(size(PLM,1),size(PLM,2),size(PLM,3)) :: ZLM,ZMU,ZLN
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll,IKU,IKB,IKE,IIB,IIE,IJB,IJE
+ REAL :: ZKARMAN
+ !
+ !-------------------------------------------------------------------------------
+ !
+ IKU=SIZE(PLM,3)
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+ !
+ ! Turbulent velocity
+ !
+ ZMU(:,:,:)= 2.*XIBM_CNU**0.25*(PTKE(:,:,:))**(1./2.) !2 correspond to KTKE
+ ZKARMAN = XKARMAN*XCED/XIBM_CNU**0.75
+ !
+ ! Mesh scale
+ !
+ ZLN(:,:,:) = (XRHODJ(:,:,:)/XRHODREF(:,:,:))**(1./3.)
+ ZLM(:,:,:) = PLM(:,:,:)
+ !
+ ! limit domain
+ !
+ ZBETA(:,:,:)= XZZ (:,:,:)
+ ZBETA(:,:,IKB:IKE) = 0.5*(XZZ(:,:,IKB+1:IKE+1)+XZZ(:,:,IKB:IKE))
+ ZBETA(:,:,IKB-1) = -0.5*(XZZ(:,:,IKB+1)+XZZ(:,:,IKB))
+ ZBETA(:,:,IKE+1) = ZBETA(:,:,IKE)
+ ZLM(:,:,:) = MIN(ZLM(:,:,:),+ZKARMAN*ZBETA(:,:,:))
+ !
+ ! limit immersed wall
+ !
+ ZLM(:,:,:) = MIN(ZLM(:,:,:),-ZKARMAN*PHI(:,:,:))
+ !
+ ! limit physical scale
+ ZALPHA(:,:,:) = MIN(9.8*XIBM_RUG,0.5*ZKARMAN*ZLN(:,:,:))
+ ZLM(:,:,:) = MAX(ZALPHA(:,:,:),ZLM(:,:,:))
+ !
+ ! Boundary condition
+ ZMU(:,:,IKB-1)= ZMU(:,:,IKB)
+ ZLM(:,:,IKB-1)= ZLM(:,:,IKB)
+ ZMU(:,:,IKE+1)= ZMU(:,:,IKE)
+ ZLM(:,:,IKE+1)= ZLM(:,:,IKE)
+ IF (LEAST_ll()) THEN
+ ZMU(IIE+1,:,:)= ZMU(IIE,:,:)
+ ZLM(IIE+1,:,:)= ZLM(IIE,:,:)
+ ENDIF
+ IF (LWEST_ll()) THEN
+ ZMU(IIB-1,:,:)= ZMU(IIB,:,:)
+ ZLM(IIB-1,:,:)= ZLM(IIB,:,:)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ ZMU(:,IJE+1,:)= ZMU(:,IJE,:)
+ ZLM(:,IJE+1,:)= ZLM(:,IJE,:)
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ ZMU(:,IJB-1,:)= ZMU(:,IJB,:)
+ ZLM(:,IJB-1,:)= ZLM(:,IJB,:)
+ ENDIF
+ !
+ !Communication
+ PLM(:,:,:) = ZLM(:,:,:)
+ PLEPS(:,:,:) = PLM(:,:,:)
+ PMU(:,:,:) = ZMU(:,:,:)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_MIXINGLENGTH
diff --git a/src/MNH/ibm_prep_ls.f90 b/src/MNH/ibm_prep_ls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bb3ae049b3716b925ea93dbcaca6877ab669290b
--- /dev/null
+++ b/src/MNH/ibm_prep_ls.f90
@@ -0,0 +1,431 @@
+!MNH_LIC Copyright 2021-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.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_PREP_LS
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
+ !
+ LOGICAL , INTENT(IN) :: OIBM
+ CHARACTER(LEN=4) , INTENT(IN) :: HIBM_TYPE
+ REAL, DIMENSION(:,:,:,:) , INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_PREP_LS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_PREP_LS
+!
+! ###########################################
+SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
+ ! ###########################################
+ !
+ !
+ !**** IBM_PREP_LS computes the LS level set function
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to localize fluid-solid interface
+ ! for the immersed boundary method in the help of LS function.
+ ! This functions allow the access to interface characteristics
+ ! (normal vector, curvature,...)
+ !
+ ! METHOD
+ ! ------
+ !**** Types of topography:
+ ! 1)GENE : generalized obstacles (x,y coordinates)
+ ! => read the informations (triangles constituting the
+ ! faces of obstacles) from an .obj file.
+ ! The .obj file must have a particular organization:
+ ! a) A line with 'usemtl' indicates the 2 materials
+ ! of each side of the interface. Only the faces with
+ ! their external face in contact with the outside air
+ ! are read (mat2=air)
+ ! b) A line starting with 'v' indicates the location
+ ! (x,y,z coordinates) of a face vortex.
+ ! c) A line starting with 'f' indicates the vortices
+ ! constituting the face.
+ ! usemtl mat1:mat2
+ ! v xv1 yv1 zv1
+ ! v xv2 yv2 zv2
+ ! v xv3 yv3 zv3
+ ! v xv4 yv4 zv4
+ ! f 1 2 3
+ ! f 1 3 4
+ ! 2)IDEA : idealized obstacles (x,y coordinates)
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ ! For the generalized case, the method is based on '3D Distance from a
+ ! Point to a Triangle' a technical report from Mark W. Jones, University
+ ! of Wales Swansea [Jones (1995)].
+ !
+ ! AUTHORS
+ ! ------
+ ! Franck Auguste (CERFACS-AE), Tim Nagel (Météo-France)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/06/2021
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_CONF, ONLY: NHALO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_IBM_LSF
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_LBC_n
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_GDIV
+ USE MODI_IBM_GENERLS
+ USE MODI_IBM_IDEALRP
+ USE MODI_IBM_IDEALEE
+ !
+ USE MODD_GRID
+ USE MODD_CST
+ USE MODD_GRID_n
+ USE MODE_GRIDPROJ
+ USE MODE_MSG
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ LOGICAL ,INTENT(IN) :: OIBM ! flag for immersed boundary method
+ CHARACTER(LEN=4) ,INTENT(IN) :: HIBM_TYPE ! switch generalized/idealized object
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JN,JM,JNM,JL,JMM,JI,JJ,JK,JF,JV ! loop index
+ INTEGER :: IIU,IJU
+ REAL :: ZX_MIN,ZX_MAX,ZY_MIN,ZY_MAX,DX_LOW,DY_LOW,DX_HIGH,DY_HIGH
+ INTEGER :: ILUIBMIDEA,IRESPIBMGENE,ILUIBMGENE,IRESPIBMIDEA ! integers for open/read files
+ INTEGER :: IIBM_NUMB_NODE_SURF ! number of surface points (generalized case)
+ INTEGER :: IIBM_NUMB_TYPE_SURF ! number of surface type (idealized case)
+ INTEGER :: IIBM_TYPE_SURF ! type of surfaces
+ INTEGER :: IIBM_NUMB_SURF ! number of surfaces in each type
+ REAL :: ZIBM_X1,ZIBM_X2,ZIBM_Y1,ZIBM_Y2,ZIBM_Z1,ZIBM_Z2 ! location of surface points for one object
+ REAL :: ZIBM_TYPE_SURF
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZIBM_XYZ1,ZIBM_XYZ2 ! location of surface points for all object
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZV1,ZV1_2,ZV2,ZV2_2,ZV3,ZV3_2 ! face vectors
+ REAL, DIMENSION(:,:), ALLOCATABLE :: NORM_FACES,NORM_FACES2 ! norm of the faces
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZIBM_FACES,ZIBM_FACES2,ZIBM_FACES2b ! extremities of triangle faces for all object
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ CHARACTER(LEN=12) :: HFILEGENE, HFILEIDEA
+ CHARACTER(LEN=100) :: YSTRING,YSTRING2
+ INTEGER :: NS1,NS2,NS3,NS4,NS5,NS6
+ INTEGER :: ZN1,ZN2,ZN3,JCOUNT
+ REAL, DIMENSION(3) :: ZNA,ZNB
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ HFILEGENE = "ibm_gene.obj"
+ HFILEIDEA = "ibm_idea.nam"
+ !
+ IIU = SIZE(XXHAT)
+ IJU = SIZE(XYHAT)
+ !
+ DX_LOW = XXHAT(2)-XXHAT(1)
+ DX_HIGH = XXHAT(IIU)-XXHAT(IIU-1)
+ DY_LOW = XYHAT(2)-XYHAT(1)
+ DY_HIGH = XYHAT(IJU)-XYHAT(IJU-1)
+ !
+ !Collect the face up to 10 gridsize out of the current processor
+ ZX_MIN = XXHAT(1)-10.*DX_LOW
+ ZX_MAX = XXHAT(IIU)+(11.)*DX_HIGH
+ ZY_MIN = XYHAT(1)-10.*DY_LOW
+ ZY_MAX = XYHAT(IJU)+(11.)*DY_HIGH
+ !
+ !------------------------------------------------------------------------------
+ !
+ !* *** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ! Read input files in order to compute interface location
+ ! - 'ibm_gene.obj' for generalized case
+ ! => read the informations (triangles constituting the
+ ! faces of obstacles) from an .obj file
+ ! - 'm_ideal.nam' for idealized case
+ ! (NUMB_NODE_SURF is the number of objects)
+ ! (NUMB_TYPE_SURF is the number of surface types:
+ ! ( TYPE_SURF = 1 for parallelepipedic shape
+ ! TYPE_SURF = 2 for ellipsoidal shape)
+ ! ( NUMB_SURF is the objects number in each type)
+ !
+ !
+ !--------------------------------
+ !--------Generalized case--------
+ !--------------------------------
+ IF (HIBM_TYPE=='GENE') THEN
+ !
+ !Allocate the tables containing the vortices, the faces locations,
+ !the norms, which are needed to calculate the LSF
+ ALLOCATE(ZIBM_XYZ1(5400000,3))
+ ALLOCATE(ZIBM_FACES(3150000,3,3))
+ ALLOCATE(ZIBM_FACES2b(3150000,3,3))
+ ALLOCATE(NORM_FACES(3150000,3))
+ ALLOCATE(ZV1(3150000,3))
+ ALLOCATE(ZV2(3150000,3))
+ ALLOCATE(ZV3(3150000,3))
+ !
+ OPEN(NEWUNIT=ILUIBMGENE , FILE=HFILEGENE , IOSTAT=IRESPIBMGENE , STATUS='OLD')
+ !
+ JV=1
+ JF=0
+ JCOUNT=0
+ !
+ !Only the faces that are in contact with the air (external faces of
+ !the obstacles) are read.
+ DO
+ IF (IRESPIBMGENE/=0) EXIT
+ READ(UNIT=ILUIBMGENE,FMT='(A100)',IOSTAT=IRESPIBMGENE) YSTRING
+ NS1=LEN(TRIM(YSTRING))
+ IF (TRIM(YSTRING(1:7))=='usemtl') THEN
+ IF (TRIM(YSTRING(NS1-3:NS1))==':air') THEN
+ JN=1
+ ELSE
+ JN=0
+ ENDIF
+ ENDIF
+ IF (TRIM(YSTRING(1:2))=='v') THEN
+ NS2=INDEX(TRIM(YSTRING)," ",back=.true.)
+ NS3=LEN(TRIM(YSTRING(:NS2)))
+ NS4=INDEX(TRIM(YSTRING(:NS3))," ",back=.true.)
+ NS5=LEN(TRIM(YSTRING(:NS4)))
+ NS6=INDEX(TRIM(YSTRING(:NS5))," ",back=.true.)
+ READ(YSTRING(NS6:NS5) , *) ZIBM_XYZ1(JV,1)
+ READ(YSTRING(NS4:NS3) , *) ZIBM_XYZ1(JV,2)
+ READ(YSTRING(NS2:NS1) , *) ZIBM_XYZ1(JV,3)
+ !FIXME temporary spatial modification
+ ZIBM_XYZ1(JV,1) = ZIBM_XYZ1(JV,1) +200.
+ ZIBM_XYZ1(JV,2) = ZIBM_XYZ1(JV,2) +200.
+ JV=JV+1
+ ENDIF
+ IF (JN==1.AND.TRIM(YSTRING(1:2))=='f') THEN
+ NS2=INDEX(TRIM(YSTRING)," ",back=.true.)
+ NS3=LEN(TRIM(YSTRING(:NS2)))
+ NS4=INDEX(TRIM(YSTRING(:NS3))," ",back=.true.)
+ NS5=LEN(TRIM(YSTRING(:NS4)))
+ NS6=INDEX(TRIM(YSTRING(:NS5))," ",back=.true.)
+ READ(YSTRING(NS6:NS5) , *) ZN1
+ READ(YSTRING(NS4:NS3) , *) ZN2
+ READ(YSTRING(NS2:NS1) , *) ZN3
+ ! If the face extremities are far outside of the processor they are not read
+ IF (ZIBM_XYZ1(ZN1,1)<ZX_MIN.AND.ZIBM_XYZ1(ZN2,1)<ZX_MIN.AND.ZIBM_XYZ1(ZN3,1)<ZX_MIN) CYCLE
+ IF (ZIBM_XYZ1(ZN1,1)>ZX_MAX.AND.ZIBM_XYZ1(ZN2,1)>ZX_MAX.AND.ZIBM_XYZ1(ZN3,1)>ZX_MAX) CYCLE
+ IF (ZIBM_XYZ1(ZN1,2)<ZY_MIN.AND.ZIBM_XYZ1(ZN2,2)<ZY_MIN.AND.ZIBM_XYZ1(ZN3,2)<ZY_MIN) CYCLE
+ IF (ZIBM_XYZ1(ZN1,2)>ZY_MAX.AND.ZIBM_XYZ1(ZN2,2)>ZY_MAX.AND.ZIBM_XYZ1(ZN3,2)>ZY_MAX) CYCLE
+ JF=JF+1
+ !
+ ZIBM_FACES(JF,1,1) = ZIBM_XYZ1(ZN1,1)
+ ZIBM_FACES(JF,1,2) = ZIBM_XYZ1(ZN1,2)
+ ZIBM_FACES(JF,1,3) = ZIBM_XYZ1(ZN1,3)
+ ZIBM_FACES(JF,2,1) = ZIBM_XYZ1(ZN2,1)
+ ZIBM_FACES(JF,2,2) = ZIBM_XYZ1(ZN2,2)
+ ZIBM_FACES(JF,2,3) = ZIBM_XYZ1(ZN2,3)
+ ZIBM_FACES(JF,3,1) = ZIBM_XYZ1(ZN3,1)
+ ZIBM_FACES(JF,3,2) = ZIBM_XYZ1(ZN3,2)
+ ZIBM_FACES(JF,3,3) = ZIBM_XYZ1(ZN3,3)
+ !
+ ZNA(1) = ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,2,1)
+ ZNA(2) = ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,2,2)
+ ZNA(3) = ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,2,3)
+ ZNB(1) = ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,3,1)
+ ZNB(2) = ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,3,2)
+ ZNB(3) = ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,3,3)
+ !Elimination of '1D' faces
+ IF (ZNA(1)==0..AND.ZNA(2)==0..AND.ZNA(3)==0.) CYCLE
+ IF (ZNB(1)==0..AND.ZNB(2)==0..AND.ZNB(3)==0.) CYCLE
+ IF (ZNA(2)==0..AND.ZNA(3)==0..AND.ZNB(2)==0..AND.ZNB(3)==0.) CYCLE
+ IF (ZNA(1)==ZNB(1).AND.ZNA(2)==ZNB(2).AND.ZNA(3)==ZNB(3)) CYCLE
+ JCOUNT=JCOUNT+1
+ NORM_FACES(JCOUNT,:)= CROSSPRODUCT(ZNA,ZNB)
+ ZIBM_FACES2b(JCOUNT,:,:)=ZIBM_FACES(JF,:,:)
+ !
+ !Equation (6) of Jones (1995)
+ ZV1(JCOUNT,1) = (ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,2,1))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,2,3))**2)+ &
+ (ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,3,1))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,3,3))**2)
+ !
+ ZV1(JCOUNT,2) = (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,2,2))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,2,3))**2)+ &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,3,2))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,3,3))**2)
+ !
+ ZV1(JCOUNT,3) = (ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,2,3))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,2,3))**2)+ &
+ (ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,3,3))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,3,3))**2)
+ !
+ ZV2(JCOUNT,1) = (ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,3,1))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,3,3))**2)+ &
+ (ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,1,1))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,1,3))**2)
+ !
+ ZV2(JCOUNT,2) = (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,3,2))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,3,3))**2)+ &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,1,2))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,1,3))**2)
+ !
+ ZV2(JCOUNT,3) = (ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,3,3))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,3,3))**2)+ &
+ (ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,1,3))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,1,3))**2)
+ !
+ ZV3(JCOUNT,1) = (ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,1,1))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,1,3))**2)+ &
+ (ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,2,1))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,2,3))**2)
+ !
+ ZV3(JCOUNT,2) = (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,1,2))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,1,3))**2)+ &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,2,2))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,2,3))**2)
+ !
+ ZV3(JCOUNT,3) = (ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,1,3))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,1,3))**2)+ &
+ (ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,2,3))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,2,3))**2)
+ !
+ ENDIF
+ !
+ IF (JN==1.AND.TRIM(YSTRING(1:2))=='vn') THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Unable to read vn found in .obj' )
+ ENDIF
+ !
+ IF (JN==1.AND.TRIM(YSTRING(1:2))=='vt') THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Unable to read vt found in .obj' )
+ ENDIF
+ !
+ END DO
+ !
+ ALLOCATE(ZIBM_FACES2(JCOUNT,3,3))
+ ALLOCATE(NORM_FACES2(JCOUNT,3))
+ ALLOCATE(ZV1_2(JCOUNT,3))
+ ALLOCATE(ZV2_2(JCOUNT,3))
+ ALLOCATE(ZV3_2(JCOUNT,3))
+ !
+ NORM_FACES2 = NORM_FACES(:JCOUNT,:)
+ ZV1_2 = ZV1(:JCOUNT,:)
+ ZV2_2 = ZV2(:JCOUNT,:)
+ ZV3_2 = ZV3(:JCOUNT,:)
+ ZIBM_FACES2 = ZIBM_FACES2b(:JCOUNT,:,:)
+ !
+ ENDIF
+ !
+ !----------------------------
+ !---------Idealized case-----
+ !----------------------------
+ IF (HIBM_TYPE=='IDEA') THEN
+ !
+ OPEN(NEWUNIT=ILUIBMIDEA , FILE= HFILEIDEA , IOSTAT=IRESPIBMIDEA , FORM='FORMATTED' , &
+ STATUS='OLD', ACCESS='SEQUENTIAL', ACTION='READ')
+ !
+ READ(UNIT=ILUIBMIDEA,FMT=*) IIBM_NUMB_NODE_SURF, IIBM_NUMB_TYPE_SURF
+ ALLOCATE(ZIBM_XYZ2(IIBM_NUMB_NODE_SURF,7))
+ !
+ ZIBM_XYZ2(:,:) = 0.
+ JNM = 0
+ DO JN=1,IIBM_NUMB_TYPE_SURF
+ !
+ READ(UNIT=ILUIBMIDEA,FMT=*) IIBM_TYPE_SURF, IIBM_NUMB_SURF
+ ZIBM_TYPE_SURF= float(IIBM_TYPE_SURF)
+ !
+ DO JM=1,IIBM_NUMB_SURF
+ !
+ READ(UNIT=ILUIBMIDEA,FMT=*) ZIBM_X1,ZIBM_X2,ZIBM_Y1,ZIBM_Y2,ZIBM_Z1,ZIBM_Z2
+ !
+ JNM = JNM + 1
+ ZIBM_XYZ2(JNM,1) = ZIBM_X1 !x_mini(pp) or x_cent(ee)
+ ZIBM_XYZ2(JNM,2) = ZIBM_X2 !x_maxi(pp) or x_delt(ee)
+ ZIBM_XYZ2(JNM,3) = ZIBM_Y1 !y_mini(pp) or y_cent(ee)
+ ZIBM_XYZ2(JNM,4) = ZIBM_Y2 !y_maxi(pp) or y_delt(ee)
+ ZIBM_XYZ2(JNM,5) = ZIBM_Z1 !z_mini(pp) or z_cent(ee)
+ ZIBM_XYZ2(JNM,6) = ZIBM_Z2 !z_maxi(pp) or z_delt(ee)
+ ZIBM_XYZ2(JNM,7) = ZIBM_TYPE_SURF !surface type (1=pp/2=ee)
+ !
+ ENDDO
+ !
+ ENDDO
+ ENDIF
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! Computations of volumic fraction (VF) and Level Set function (LS) for all kinds of initialization
+ ! generalized shape => construction of LS function (z<z_interface <=> phi>0)
+ ! the method is based on '3D Distance from a Point to a Triangle' [Jones (1995)].
+ ! => conversion of LS function to VF function (Sussman, JCP (1994)
+ ! idealized shape => construction of VF/LS function using analytical
+ ! locations of interface (ellipsoidal/parallelepipedic shapes)
+ !
+ IF (HIBM_TYPE=='GENE') THEN
+ CALL IBM_GENERLS(ZIBM_FACES2,NORM_FACES2,ZV1_2,ZV2_2,ZV3_2,ZX_MIN,ZY_MIN,ZX_MAX,ZY_MAX,PPHI)
+ ENDIF
+ !
+ IF (HIBM_TYPE=='IDEA') then
+ DO JN=1,JNM
+ IF (abs(ZIBM_XYZ2(JN,7)-1.).lt.XIBM_EPSI) CALL IBM_IDEALRP(JN,ZIBM_XYZ2,PPHI)
+ IF (abs(ZIBM_XYZ2(JN,7)-2.).lt.XIBM_EPSI) CALL IBM_IDEALEE(JN,ZIBM_XYZ2,PPHI)
+ ENDDO
+ ENDIF
+ !
+CONTAINS
+ !
+ FUNCTION CROSSPRODUCT(PA,PB) RESULT(CROSS)
+ !
+ REAL, DIMENSION(3) :: CROSS
+ REAL :: VAL
+ REAL, DIMENSION(3), INTENT(IN) :: PA, PB
+ !
+ CROSS(1) = PA(2) * PB(3) - PA(3) * PB(2)
+ CROSS(2) = PA(3) * PB(1) - PA(1) * PB(3)
+ CROSS(3) = PA(1) * PB(2) - PA(2) * PB(1)
+ !
+ VAL = (CROSS(1)**2+CROSS(2)**2+CROSS(3)**2)**(0.5)
+ !
+ CROSS(1) = CROSS(1)/VAL
+ CROSS(2) = CROSS(2)/VAL
+ CROSS(3) = CROSS(3)/VAL
+ !
+ END FUNCTION CROSSPRODUCT
+ !
+END SUBROUTINE IBM_PREP_LS
diff --git a/src/MNH/ibm_smooth_ls.f90 b/src/MNH/ibm_smooth_ls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..96144123454422ed14e94f1ae592098171937ca9
--- /dev/null
+++ b/src/MNH/ibm_smooth_ls.f90
@@ -0,0 +1,653 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_SMOOTH_LS
+ ! #########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_SMOOTH_LS(KIBM_SMOOTH,PIBM_SMOOTH,PPHI)
+ !
+ INTEGER ,INTENT(IN) :: KIBM_SMOOTH
+ REAL ,INTENT(IN) :: PIBM_SMOOTH
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_SMOOTH_LS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_SMOOTH_LS
+!
+! ######################################################
+SUBROUTINE IBM_SMOOTH_LS(KIBM_SMOOTH,PIBM_SMOOTH,PPHI)
+ ! ######################################################
+ !
+ !
+ !**** IBM_SMOOTH_LS is a smoothing method for LS function
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to smooth VF/LS functions
+ ! in order to improve computations of characteristics surface
+ ! (be careful with singularities and corners)
+ !
+ ! METHOD
+ ! ------
+ !**** Iterative systems
+ ! - value at mass node weighted by values at neighboring flux nodes
+ ! - value at flux node weighted by values at neighboring mass nodes
+ !
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_IBM_LSF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+ USE MODD_VAR_ll, ONLY: IP
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_GRADIENT_M
+ USE MODI_GRADIENT_U
+ USE MODI_GRADIENT_V
+ USE MODI_GRADIENT_W
+ USE MODI_GRADIENT_UV
+ USE MODI_GRADIENT_VW
+ USE MODI_GRADIENT_UW
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ INTEGER , INTENT(IN) :: KIBM_SMOOTH ! Smooth levels
+ REAL , INTENT(IN) :: PIBM_SMOOTH ! Smooth weighting
+ REAL, DIMENSION(:,:,:,:) , INTENT(INOUT) :: PPHI ! LS functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIB,IJB,IKB,IIE,IJE,IKE
+ INTEGER :: IIU,IJU,IKU ! domain size
+ INTEGER :: JI,JJ,JK,JL,JM ! loop index
+ INTEGER :: ILISPT_NUMB ! number of smooth iteration
+ REAL :: ILISPT_FACT ! smooth factor
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ REAL :: ILISPT_FACTU,ILISPT_FACTV
+ REAL :: ILISPT_FACTW,ILISPT_FACTP
+ REAL :: ZPE,ZPW,ZPB,ZPT,ZPN,ZPS
+ REAL :: ZREF,ZREF3
+ REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZTEMP
+ REAL,DIMENSION(:,:,:,:,:), ALLOCATABLE :: Z_NORM_TEMP0
+ REAL,DIMENSION(:,:,:) , ALLOCATABLE :: Z_NORM_TEMP1
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ !
+ IIU=SIZE(PPHI,1)
+ IJU=SIZE(PPHI,2)
+ IKU=SIZE(PPHI,3)
+ !
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ !
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ ZREF =(1.e-2)*((XXHAT(IIB+1)-XXHAT(IIB))*(XYHAT(IJB+1)-XYHAT(IJB)))**0.5
+ ZREF3=((XXHAT(IIB+1)-XXHAT(IIB))*(XYHAT(IJB+1)-XYHAT(IJB)))**0.5
+ !
+ ! Boundary symmetry
+ !
+ PPHI(:,:,1,5) = 2.*PPHI(:,:,2,5)-PPHI(:,:,3,5)
+ PPHI(:,:,1,3) = 2.*PPHI(:,:,2,3)-PPHI(:,:,3,3)
+ PPHI(:,:,1,2) = 2.*PPHI(:,:,2,2)-PPHI(:,:,3,2)
+ PPHI(:,:,1,1) = 2.*PPHI(:,:,2,1)-PPHI(:,:,3,1)
+ WHERE (PPHI(:,:,2,5).GT.XIBM_EPSI) PPHI(:,:,1,5) = PPHI(:,:,2,5)
+ WHERE (PPHI(:,:,2,3).GT.XIBM_EPSI) PPHI(:,:,1,3) = PPHI(:,:,2,3)
+ WHERE (PPHI(:,:,2,2).GT.XIBM_EPSI) PPHI(:,:,1,2) = PPHI(:,:,2,2)
+ WHERE (PPHI(:,:,2,1).GT.XIBM_EPSI) PPHI(:,:,1,1) = PPHI(:,:,2,1)
+ PPHI(:,:,2,6) = (PPHI(:,:,2,2)+PPHI(:,:,1,2))/2.
+ PPHI(:,:,2,7) = (PPHI(:,:,2,3)+PPHI(:,:,1,3))/2.
+ PPHI(:,:,2,4) = (PPHI(:,:,2,1)+PPHI(:,:,1,1))/2.
+ PPHI(:,:,1,6) = 2.*PPHI(:,:,2,6)-PPHI(:,:,3,6)
+ PPHI(:,:,1,7) = 2.*PPHI(:,:,2,7)-PPHI(:,:,3,7)
+ PPHI(:,:,1,4) = 2.*PPHI(:,:,2,4)-PPHI(:,:,3,4)
+ WHERE (PPHI(:,:,2,6).GT.XIBM_EPSI) PPHI(:,:,1,6) = PPHI(:,:,2,6)
+ WHERE (PPHI(:,:,2,7).GT.XIBM_EPSI) PPHI(:,:,1,7) = PPHI(:,:,2,7)
+ WHERE (PPHI(:,:,2,4).GT.XIBM_EPSI) PPHI(:,:,1,4) = PPHI(:,:,2,4)
+ !
+ PPHI(:,:,IKU,5) = 2.*PPHI(:,:,IKU-1,5)-PPHI(:,:,IKU-2,5)
+ PPHI(:,:,IKU,3) = 2.*PPHI(:,:,IKU-1,3)-PPHI(:,:,IKU-2,3)
+ PPHI(:,:,IKU,2) = 2.*PPHI(:,:,IKU-1,2)-PPHI(:,:,IKU-2,2)
+ PPHI(:,:,IKU,1) = 2.*PPHI(:,:,IKU-1,1)-PPHI(:,:,IKU-2,1)
+ WHERE (PPHI(:,:,IKU-1,5).GT.XIBM_EPSI) PPHI(:,:,IKU,5) = PPHI(:,:,IKU-1,5)
+ WHERE (PPHI(:,:,IKU-1,3).GT.XIBM_EPSI) PPHI(:,:,IKU,3) = PPHI(:,:,IKU-1,3)
+ WHERE (PPHI(:,:,IKU-1,2).GT.XIBM_EPSI) PPHI(:,:,IKU,2) = PPHI(:,:,IKU-1,2)
+ WHERE (PPHI(:,:,IKU-1,1).GT.XIBM_EPSI) PPHI(:,:,IKU,1) = PPHI(:,:,IKU-1,1)
+ PPHI(:,:,IKU,6) = (PPHI(:,:,IKU-1,2)+PPHI(:,:,IKU,2))/2.
+ PPHI(:,:,IKU,7) = (PPHI(:,:,IKU-1,3)+PPHI(:,:,IKU,3))/2.
+ PPHI(:,:,IKU,4) = (PPHI(:,:,IKU-1,1)+PPHI(:,:,IKU,1))/2.
+ WHERE (PPHI(:,:,IKU-1,6).GT.XIBM_EPSI) PPHI(:,:,IKU,6) = PPHI(:,:,IKU-1,6)
+ WHERE (PPHI(:,:,IKU-1,7).GT.XIBM_EPSI) PPHI(:,:,IKU,7) = PPHI(:,:,IKU-1,7)
+ WHERE (PPHI(:,:,IKU-1,4).GT.XIBM_EPSI) PPHI(:,:,IKU,4) = PPHI(:,:,IKU-1,4)
+ !
+ DO JL=1,7
+ !
+ IF (LWEST_ll ()) PPHI(2 ,:,:,JL) = PPHI( 3,:,:,JL)
+ IF (LEAST_ll ()) PPHI(IIU-1,:,:,JL) = PPHI(IIU-2,:,:,JL)
+ IF (LSOUTH_ll()) PPHI(:,2 ,:,JL) = PPHI(:, 3,:,JL)
+ IF (LNORTH_ll()) PPHI(:,IJU-1,:,JL) = PPHI(:,IJU-2,:,JL)
+ IF (LWEST_ll ()) PPHI(1 ,:,:,JL) = PPHI( 2,:,:,JL)
+ IF (LEAST_ll ()) PPHI(IIU,:,:,JL) = PPHI(IIU-1,:,:,JL)
+ IF (LSOUTH_ll()) PPHI(:,1 ,:,JL) = PPHI(:, 2,:,JL)
+ IF (LNORTH_ll()) PPHI(:,IJU,:,JL) = PPHI(:,IJU-1,:,JL)
+ !
+ IF(LWEST_ll()) THEN
+ PPHI(IIB-1,IJB:IJE,IKB-1,JL)=PPHI(IIB-1,IJB:IJE,IKB,JL)
+ PPHI(IIB-1,IJB:IJE,IKE+1,JL)=PPHI(IIB-1,IJB:IJE,IKE,JL)
+ END IF
+ !
+ IF (LEAST_ll()) THEN
+ PPHI(IIE+1,IJB:IJE,IKB-1,JL)=PPHI(IIE+1,IJB:IJE,IKB,JL)
+ PPHI(IIE+1,IJB:IJE,IKE+1,JL)=PPHI(IIE+1,IJB:IJE,IKE,JL)
+ END IF
+ !
+ IF (LSOUTH_ll()) THEN
+ PPHI(IIB:IIE,IJB-1,IKB-1,JL)=PPHI(IIB:IIE,IJB-1,IKB,JL)
+ PPHI(IIB:IIE,IJB-1,IKE+1,JL)=PPHI(IIB:IIE,IJB-1,IKE,JL)
+ END IF
+ !
+ IF (LNORTH_ll()) THEN
+ PPHI(IIB:IIE,IJE+1,IKB-1,JL)=PPHI(IIB:IIE,IJE+1,IKB,JL)
+ PPHI(IIB:IIE,IJE+1,IKE+1,JL)=PPHI(IIB:IIE,IJE+1,IKE,JL)
+ END IF
+ !
+ WHERE (ABS(PPHI(:,:,:,JL)).LT.(ZREF-2.*XIBM_EPSI)) PPHI(:,:,:,JL) = ZREF-XIBM_EPSI
+ !
+ ENDDO
+ !
+ NULLIFY(TZFIELDS_ll)
+ !
+ DO JL=1,7
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,JL),'IBM_SMOOTH_LS::PPHI')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ IF (KIBM_SMOOTH==0) RETURN
+ !
+ ALLOCATE(ZTEMP(IIU,IJU,IKU,7))
+ ALLOCATE(Z_NORM_TEMP0(IIU,IJU,IKU,3,7),Z_NORM_TEMP1(IIU,IJU,IKU))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ! LISPT_NUMB correspond to the number of iteration
+ ! LISPT_FACT correspond to correspond to the weight between mass/flux nodes
+ !
+ ILISPT_NUMB=KIBM_SMOOTH
+ ILISPT_FACT=PIBM_SMOOTH
+ !
+ IF (IP==1) WRITE(*,*) 'NIBM_SMOOTH,XIBM_SMOOTH' , ILISPT_NUMB,ILISPT_FACT
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! Techniques to compute with an accurate precision
+ ! the normal vector to the interface, the local curvature
+ !
+ DO JL = 1,ILISPT_NUMB
+ !
+ Z_NORM_TEMP0(:,:,:,:,:)=1.
+ !
+ IF (MOD(JL,2)==0.AND.JL>3) THEN
+ NULLIFY(TZFIELDS_ll)
+ DO JM=1,4
+ IF (JM==1) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = -GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = -GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ ENDIF
+ IF (JM==2) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_M_U(1,IKU,1,PPHI(:,:,:,1),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = -GY_UV_U(PPHI(:,:,:,5),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = -GZ_UW_U(PPHI(:,:,:,6),XDZZ)
+ ENDIF
+ IF (JM==3) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_UV_V(PPHI(:,:,:,5),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = - GY_M_V(1,IKU,1,PPHI(:,:,:,1),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = -GZ_VW_V(PPHI(:,:,:,7),XDZZ)
+ ENDIF
+ IF (JM==4) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_UW_W(PPHI(:,:,:,6),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = -GY_VW_W(PPHI(:,:,:,7),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = - GZ_M_W(1,IKU,1,PPHI(:,:,:,1),XDZZ)
+ ENDIF
+ Z_NORM_TEMP1(:,:,:)=(ABS(Z_NORM_TEMP0(:,:,:,1,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,2,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,3,JM)))
+ WHERE (Z_NORM_TEMP1(:,:,:).GT.XIBM_EPSI)
+ Z_NORM_TEMP0(:,:,:,1,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,1,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,2,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,3,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ ELSEWHERE
+ Z_NORM_TEMP0(:,:,:,1,JM)=1.
+ Z_NORM_TEMP0(:,:,:,2,JM)=1.
+ Z_NORM_TEMP0(:,:,:,3,JM)=1.
+ ENDWHERE
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,1,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,2,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,3,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ IF (JM==4) THEN
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ ENDIF
+ ENDDO
+ NULLIFY(TZFIELDS_ll)
+ DO JM=5,7
+ IF (JM==5) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = (MXM(Z_NORM_TEMP0(:,:,:,1,3))+MYM(Z_NORM_TEMP0(:,:,:,1,2)))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM) = (MXM(Z_NORM_TEMP0(:,:,:,2,3))+MYM(Z_NORM_TEMP0(:,:,:,2,2)))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM) = (MXM(Z_NORM_TEMP0(:,:,:,3,3))+MYM(Z_NORM_TEMP0(:,:,:,3,2)))/2.
+ ENDIF
+ IF (JM==6) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = (MXM(Z_NORM_TEMP0(:,:,:,1,4))+MZM(Z_NORM_TEMP0(:,:,:,1,2)))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM) = (MXM(Z_NORM_TEMP0(:,:,:,2,4))+MZM(Z_NORM_TEMP0(:,:,:,2,2)))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM) = (MXM(Z_NORM_TEMP0(:,:,:,3,4))+MZM(Z_NORM_TEMP0(:,:,:,3,2)))/2.
+ ENDIF
+ IF (JM==7) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = (MYM(Z_NORM_TEMP0(:,:,:,1,4))+MZM(Z_NORM_TEMP0(:,:,:,1,3)))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM) = (MYM(Z_NORM_TEMP0(:,:,:,2,4))+MZM(Z_NORM_TEMP0(:,:,:,2,3)))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM) = (MYM(Z_NORM_TEMP0(:,:,:,3,4))+MZM(Z_NORM_TEMP0(:,:,:,3,3)))/2.
+ ENDIF
+ Z_NORM_TEMP1(:,:,:)=(ABS(Z_NORM_TEMP0(:,:,:,1,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,2,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,3,JM)))
+ WHERE (Z_NORM_TEMP1(:,:,:).GT.XIBM_EPSI)
+ Z_NORM_TEMP0(:,:,:,1,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,1,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,2,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,3,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ ELSEWHERE
+ Z_NORM_TEMP0(:,:,:,1,JM)=1.
+ Z_NORM_TEMP0(:,:,:,2,JM)=1.
+ Z_NORM_TEMP0(:,:,:,3,JM)=1.
+ ENDWHERE
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,1,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,2,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,3,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ IF (JM==7) THEN
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ ENDIF
+ ENDDO
+ !
+ ENDIF
+ !
+ ZTEMP=PPHI
+ !
+ DO JK=1,IKU-1
+ DO JJ=1,IJU-1
+ DO JI=2,IIU
+ !
+ ILISPT_FACTU = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,2))/ILISPT_FACT)
+ !
+ ZPW = PPHI(JI-1,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,1,2)
+ ZPE = PPHI(JI ,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,1,2)
+ ZPB = PPHI(JI ,JJ ,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,2,2)
+ ZPT = PPHI(JI ,JJ+1,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,2,2)
+ ZPS = PPHI(JI ,JJ ,JK ,6)*Z_NORM_TEMP0(JI,JJ,JK,3,2)
+ ZPN = PPHI(JI ,JJ ,JK+1,6)*Z_NORM_TEMP0(JI,JJ,JK,3,2)
+ !
+ ZTEMP(JI,JJ,JK,2) = (0.+ILISPT_FACTU)*PPHI(JI,JJ,JK,2)+ &
+ (1.-ILISPT_FACTU)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=1,IKU-1
+ DO JJ=2,IJU
+ DO JI=1,IIU-1
+ !
+ ILISPT_FACTV = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,3))/ILISPT_FACT)
+ !
+ ZPS = PPHI(JI ,JJ ,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,1,3)
+ ZPN = PPHI(JI+1,JJ ,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,1,3)
+ ZPW = PPHI(JI ,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,2,3)
+ ZPE = PPHI(JI ,JJ-1,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,2,3)
+ ZPB = PPHI(JI ,JJ ,JK ,7)*Z_NORM_TEMP0(JI,JJ,JK,3,3)
+ ZPT = PPHI(JI ,JJ ,JK+1,7)*Z_NORM_TEMP0(JI,JJ,JK,3,3)
+ !
+ ZTEMP(JI,JJ,JK,3) = (0.+ILISPT_FACTV)*PPHI(JI,JJ,JK,3)+ &
+ (1.-ILISPT_FACTV)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU
+ DO JJ=1,IJU-1
+ DO JI=1,IIU-1
+ !
+ ILISPT_FACTW = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,4))/ILISPT_FACT)
+ !
+ ZPB = PPHI(JI ,JJ ,JK ,6)*Z_NORM_TEMP0(JI,JJ,JK,1,4)
+ ZPT = PPHI(JI+1,JJ ,JK ,6)*Z_NORM_TEMP0(JI,JJ,JK,1,4)
+ ZPW = PPHI(JI ,JJ ,JK ,7)*Z_NORM_TEMP0(JI,JJ,JK,2,4)
+ ZPE = PPHI(JI ,JJ+1,JK ,7)*Z_NORM_TEMP0(JI,JJ,JK,2,4)
+ ZPS = PPHI(JI ,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,3,4)
+ ZPN = PPHI(JI ,JJ ,JK-1,1)*Z_NORM_TEMP0(JI,JJ,JK,3,4)
+ !
+ ZTEMP(JI,JJ,JK,4) = (0.+ILISPT_FACTW)*PPHI(JI,JJ,JK,4)+ &
+ (1.-ILISPT_FACTW)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU-1
+ DO JJ=2,IJU-1
+ DO JI=2,IIU-1
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,1))/ILISPT_FACT)
+ !
+ ZPB = PPHI(JI ,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,1,1)
+ ZPT = PPHI(JI+1,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,1,1)
+ ZPW = PPHI(JI ,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,2,1)
+ ZPE = PPHI(JI ,JJ+1,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,2,1)
+ ZPS = PPHI(JI ,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,3,1)
+ ZPN = PPHI(JI ,JJ ,JK+1,4)*Z_NORM_TEMP0(JI,JJ,JK,3,1)
+ !
+ ZTEMP(JI,JJ,JK,1) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,1)+ &
+ (1.-ILISPT_FACTP)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=1,IKU-1
+ DO JJ=2,IJU
+ DO JI=2,IIU
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,5))/ILISPT_FACT)
+ !
+ ZPW = PPHI(JI ,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,1,5)
+ ZPE = PPHI(JI-1,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,1,5)
+ ZPB = PPHI(JI ,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,2,5)
+ ZPT = PPHI(JI ,JJ-1,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,2,5)
+ ZPS = (PPHI(JI ,JJ ,JK ,4)+PPHI(JI-1,JJ-1,JK ,4)+PPHI(JI-1,JJ ,JK ,4)+PPHI(JI ,JJ-1,JK ,4))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,3,5)
+ ZPN = (PPHI(JI ,JJ ,JK+1,4)+PPHI(JI-1,JJ-1,JK+1,4)+PPHI(JI-1,JJ ,JK+1,4)+PPHI(JI ,JJ-1,JK+1,4))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,3,5)
+ !
+ ZTEMP(JI,JJ,JK,5) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,5)+ &
+ (1.-ILISPT_FACTP)*(ZPE+ZPW+ZPB+ZPT+ZPS+ZPN)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU
+ DO JJ=1,IJU-1
+ DO JI=2,IIU
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,6))/ILISPT_FACT)
+ !
+ ZPW = PPHI(JI-1,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,1,6)
+ ZPE = PPHI(JI ,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,1,6)
+ ZPS = (PPHI(JI ,JJ ,JK ,3)+PPHI(JI-1,JJ ,JK-1,3)+PPHI(JI-1,JJ ,JK ,3)+PPHI(JI ,JJ ,JK-1,3))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,2,6)
+ ZPN = (PPHI(JI ,JJ+1,JK ,3)+PPHI(JI-1,JJ+1,JK-1,3)+PPHI(JI-1,JJ+1,JK ,3)+PPHI(JI ,JJ+1,JK-1,3))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,2,6)
+ ZPB = PPHI(JI ,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,3,6)
+ ZPT = PPHI(JI ,JJ ,JK-1,2)*Z_NORM_TEMP0(JI,JJ,JK,3,6)
+ !
+ ZTEMP(JI,JJ,JK,6) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,6)+ &
+ (1.-ILISPT_FACTP)*(ZPE+ZPW+ZPB+ZPT+ZPS+ZPN)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU
+ DO JJ=2,IJU
+ DO JI=1,IIU-1
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,7))/ILISPT_FACT)
+ !
+ ZPW = (PPHI(JI ,JJ ,JK ,2)+PPHI(JI ,JJ-1,JK-1,2)+PPHI(JI ,JJ-1,JK ,2)+PPHI(JI ,JJ ,JK-1,2))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,1,7)
+ ZPE = (PPHI(JI+1,JJ ,JK ,2)+PPHI(JI+1,JJ-1,JK-1,2)+PPHI(JI+1,JJ-1,JK ,2)+PPHI(JI+1,JJ ,JK-1,2))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,1,7)
+ ZPB = PPHI(JI ,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,2,7)
+ ZPT = PPHI(JI ,JJ-1,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,2,7)
+ ZPS = PPHI(JI ,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,3,7)
+ ZPN = PPHI(JI ,JJ ,JK-1,3)*Z_NORM_TEMP0(JI,JJ,JK,3,7)
+ !
+ ZTEMP(JI,JJ,JK,7) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,7)+ &
+ (1.-ILISPT_FACTP)*(ZPB+ZPT+ZPN+ZPS+ZPW+ZPE)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ IF (JL>4) THEN
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,4)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,4)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,1) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB-1:IIE-1,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,6)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,2) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB-1:IJE-1,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,7)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,3) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB:IJE,IKB-1:IKE-1,1)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,4) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,4)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,4)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,1) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB-1:IIE-1,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,6)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,2) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB-1:IJE-1,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,7)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,3) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB:IJE,IKB-1:IKE-1,1)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,4) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB :IIE ,IJB:IJE,2,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB-1:IIE-1,IJB:IJE,2,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB:IIE,IJB :IJE ,2,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB:IIE,IJB-1:IJE-1,2,2)).AND.PPHI(IIB:IIE,IJB:IJE,2,5).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,5) =PPHI(IIB:IIE,IJB:IJE,2,5)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB :IIE ,IJB:IJE,2,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB-1:IIE-1,IJB:IJE,2,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB:IIE,IJB :IJE ,2,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB:IIE,IJB+1:IJE+1,2,5)).AND.PPHI(IIB:IIE,IJB:IJE,2,2).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,2) =PPHI(IIB:IIE,IJB:IJE,2,2)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB :IIE ,IJB:IJE,2,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB+1:IIE+1,IJB:IJE,2,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB:IIE,IJB :IJE ,2,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB:IIE,IJB-1:IJE-1,2,1)).AND.PPHI(IIB:IIE,IJB:IJE,2,3).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,3) =PPHI(IIB:IIE,IJB:IJE,2,3)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB :IIE ,IJB:IJE,2,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB+1:IIE+1,IJB:IJE,2,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB:IIE,IJB :IJE ,2,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB:IIE,IJB+1:IJE+1,2,3)).AND.PPHI(IIB:IIE,IJB:IJE,2,1).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,1) =PPHI(IIB:IIE,IJB:IJE,2,1)
+ ENDWHERE
+ ENDIF
+ !
+ ZTEMP(:,:,1,5) = 2.*ZTEMP(:,:,2,5)-ZTEMP(:,:,3,5)
+ ZTEMP(:,:,1,3) = 2.*ZTEMP(:,:,2,3)-ZTEMP(:,:,3,3)
+ ZTEMP(:,:,1,2) = 2.*ZTEMP(:,:,2,2)-ZTEMP(:,:,3,2)
+ ZTEMP(:,:,1,1) = 2.*ZTEMP(:,:,2,1)-ZTEMP(:,:,3,1)
+ WHERE (ZTEMP(:,:,2,5).GT.XIBM_EPSI) ZTEMP(:,:,1,5) = ZTEMP(:,:,2,5)
+ WHERE (ZTEMP(:,:,2,3).GT.XIBM_EPSI) ZTEMP(:,:,1,3) = ZTEMP(:,:,2,3)
+ WHERE (ZTEMP(:,:,2,2).GT.XIBM_EPSI) ZTEMP(:,:,1,2) = ZTEMP(:,:,2,2)
+ WHERE (ZTEMP(:,:,2,1).GT.XIBM_EPSI) ZTEMP(:,:,1,1) = ZTEMP(:,:,2,1)
+ ZTEMP(:,:,2,6) = (ZTEMP(:,:,2,2)+ZTEMP(:,:,1,2))/2.
+ ZTEMP(:,:,2,7) = (ZTEMP(:,:,2,3)+ZTEMP(:,:,1,3))/2.
+ ZTEMP(:,:,2,4) = (ZTEMP(:,:,2,1)+ZTEMP(:,:,1,1))/2.
+ ZTEMP(:,:,1,6) = 2.*ZTEMP(:,:,2,6)-ZTEMP(:,:,3,6)
+ ZTEMP(:,:,1,7) = 2.*ZTEMP(:,:,2,7)-ZTEMP(:,:,3,7)
+ ZTEMP(:,:,1,4) = 2.*ZTEMP(:,:,2,4)-ZTEMP(:,:,3,4)
+ WHERE (ZTEMP(:,:,2,6).GT.XIBM_EPSI) ZTEMP(:,:,1,6) = ZTEMP(:,:,2,6)
+ WHERE (ZTEMP(:,:,2,7).GT.XIBM_EPSI) ZTEMP(:,:,1,7) = ZTEMP(:,:,2,7)
+ WHERE (ZTEMP(:,:,2,4).GT.XIBM_EPSI) ZTEMP(:,:,1,4) = ZTEMP(:,:,2,4)
+ ZTEMP(:,:,IKU,5) = 2.*ZTEMP(:,:,IKU-1,5)-ZTEMP(:,:,IKU-2,5)
+ ZTEMP(:,:,IKU,3) = 2.*ZTEMP(:,:,IKU-1,3)-ZTEMP(:,:,IKU-2,3)
+ ZTEMP(:,:,IKU,2) = 2.*ZTEMP(:,:,IKU-1,2)-ZTEMP(:,:,IKU-2,2)
+ ZTEMP(:,:,IKU,1) = 2.*ZTEMP(:,:,IKU-1,1)-ZTEMP(:,:,IKU-2,1)
+ WHERE (ZTEMP(:,:,IKU-1,5).GT.XIBM_EPSI) ZTEMP(:,:,IKU,5) = ZTEMP(:,:,IKU-1,5)
+ WHERE (ZTEMP(:,:,IKU-1,3).GT.XIBM_EPSI) ZTEMP(:,:,IKU,3) = ZTEMP(:,:,IKU-1,3)
+ WHERE (ZTEMP(:,:,IKU-1,2).GT.XIBM_EPSI) ZTEMP(:,:,IKU,2) = ZTEMP(:,:,IKU-1,2)
+ WHERE (ZTEMP(:,:,IKU-1,1).GT.XIBM_EPSI) ZTEMP(:,:,IKU,1) = ZTEMP(:,:,IKU-1,1)
+ ZTEMP(:,:,IKU,6) = (ZTEMP(:,:,IKU-1,2)+ZTEMP(:,:,IKU,2))/2.
+ ZTEMP(:,:,IKU,7) = (ZTEMP(:,:,IKU-1,3)+ZTEMP(:,:,IKU,3))/2.
+ ZTEMP(:,:,IKU,4) = (ZTEMP(:,:,IKU-1,1)+ZTEMP(:,:,IKU,1))/2.
+ WHERE (ZTEMP(:,:,IKU-1,6).GT.XIBM_EPSI) ZTEMP(:,:,IKU,6) = ZTEMP(:,:,IKU-1,6)
+ WHERE (ZTEMP(:,:,IKU-1,7).GT.XIBM_EPSI) ZTEMP(:,:,IKU,7) = ZTEMP(:,:,IKU-1,7)
+ WHERE (ZTEMP(:,:,IKU-1,4).GT.XIBM_EPSI) ZTEMP(:,:,IKU,4) = ZTEMP(:,:,IKU-1,4)
+ !
+ WHERE (ABS(ZTEMP(:,:,:,:)).LT.(ZREF-2.*XIBM_EPSI)) ZTEMP(:,:,:,:) = ZREF-XIBM_EPSI
+ !
+ NULLIFY(TZFIELDS_ll)
+ DO JM=1,7
+ ! Boundary symmetry
+ IF (LWEST_ll ()) ZTEMP(2 ,:,:,JM) = ZTEMP( 3,:,:,JM)
+ IF (LEAST_ll ()) ZTEMP(IIU-1,:,:,JM) = ZTEMP(IIU-2,:,:,JM)
+ IF (LSOUTH_ll()) ZTEMP(:,2 ,:,JM) = ZTEMP(:, 3,:,JM)
+ IF (LNORTH_ll()) ZTEMP(:,IJU-1,:,JM) = ZTEMP(:,IJU-2,:,JM)
+ IF (LWEST_ll ()) ZTEMP(1 ,:,:,JM) = ZTEMP( 2,:,:,JM)
+ IF (LEAST_ll ()) ZTEMP(IIU,:,:,JM) = ZTEMP(IIU-1,:,:,JM)
+ IF (LSOUTH_ll()) ZTEMP(:,1 ,:,JM) = ZTEMP(:, 2,:,JM)
+ IF (LNORTH_ll()) ZTEMP(:,IJU,:,JM) = ZTEMP(:,IJU-1,:,JM)
+ !
+ IF(LWEST_ll()) THEN
+ ZTEMP(IIB-1,IJB:IJE,IKB-1,JM)=ZTEMP(IIB-1,IJB:IJE,IKB,JM)
+ ZTEMP(IIB-1,IJB:IJE,IKE+1,JM)=ZTEMP(IIB-1,IJB:IJE,IKE,JM)
+ END IF
+ !
+ IF (LEAST_ll()) THEN
+ ZTEMP(IIE+1,IJB:IJE,IKB-1,JM)=ZTEMP(IIE+1,IJB:IJE,IKB,JM)
+ ZTEMP(IIE+1,IJB:IJE,IKE+1,JM)=ZTEMP(IIE+1,IJB:IJE,IKE,JM)
+ END IF
+ !
+ IF (LSOUTH_ll()) THEN
+ ZTEMP(IIB:IIE,IJB-1,IKB-1,JM)=ZTEMP(IIB:IIE,IJB-1,IKB,JM)
+ ZTEMP(IIB:IIE,IJB-1,IKE+1,JM)=ZTEMP(IIB:IIE,IJB-1,IKE,JM)
+ END IF
+ !
+ IF (LNORTH_ll()) THEN
+ ZTEMP(IIB:IIE,IJE+1,IKB-1,JM)=ZTEMP(IIB:IIE,IJE+1,IKB,JM)
+ ZTEMP(IIB:IIE,IJE+1,IKE+1,JM)=ZTEMP(IIB:IIE,IJE+1,IKE,JM)
+ END IF
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZTEMP(:,:,:,JM),'IBM_SMOOTH_LS::ZTEMP')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ PPHI = ZTEMP
+ !
+ ENDDO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(ZTEMP,Z_NORM_TEMP0,Z_NORM_TEMP1)
+ RETURN
+ !
+END SUBROUTINE IBM_SMOOTH_LS
diff --git a/src/MNH/ibm_valuecorn.f90 b/src/MNH/ibm_valuecorn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9c201a0d50be93337def827b15108f4e7e7f6dbb
--- /dev/null
+++ b/src/MNH/ibm_valuecorn.f90
@@ -0,0 +1,161 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_VALUECORN
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_VALUECORN(PVAR,IINDEX) RESULT(PVALUE)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PVAR
+ INTEGER,DIMENSION(:) , INTENT(IN) :: IINDEX
+ REAL, DIMENSION(8) :: PVALUE
+ !
+ END FUNCTION IBM_VALUECORN
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VALUECORN
+!
+! ##################################################
+FUNCTION IBM_VALUECORN(PVAR,IINDEX) RESULT(PVALUE)
+ ! ##################################################
+ !
+ !**** *IBM_VALUECORN* - routine to affect values at cornes cell
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute (VAR) at corners of cell (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PVAR ! variable array
+ INTEGER, DIMENSION(:) ,INTENT(IN) :: IINDEX ! IJK reference
+ REAL, DIMENSION(8) :: PVALUE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: JI,JJ,JK,JL ! loop index
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ DO JL = 1,8
+ !
+ ! corners index
+ IF (JL==1) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==2) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==3) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==4) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==5) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==6) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==7) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==8) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ !
+ PVALUE(JL) = PVAR(JI,JJ,JK)
+ !
+ ENDDO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END FUNCTION IBM_VALUECORN
diff --git a/src/MNH/ibm_valuemat1.f90 b/src/MNH/ibm_valuemat1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8082f12c8db0e2907fd7f581f15aeec321ac6ac7
--- /dev/null
+++ b/src/MNH/ibm_valuemat1.f90
@@ -0,0 +1,209 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_VALUEMAT1
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_VALUEMAT1(PLOCATG,PLOCATI,PVELOCI,HINTERP) RESULT(PMATRIX)
+ !
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATG
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PVELOCI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL, DIMENSION(3,3) :: PMATRIX
+ !
+ END FUNCTION IBM_VALUEMAT1
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VALUEMAT1
+!
+! #######################################################################
+FUNCTION IBM_VALUEMAT1(PLOCATG,PLOCATI,PVELOCI,HINTERP) RESULT(PMATRIX)
+ ! #######################################################################
+ !
+ !**** *IBM_INTER_VALUEMAT1* - Change of basis (u,v,w) to (n,t,c)
+ !
+ ! PURPOSE
+ ! -------
+ ! This function calculates the vector normal to the interface, the
+ ! tangent and binormal vectors in order to project the basis
+ ! (u,v,w) to (n,t,c). The projection is stored in the PMATRIX matrix.
+ !
+ !
+ ! METHOD
+ ! ------
+ !
+ ! HINTERP can be defined as HIBM_TYPE_BOUND in regard of the tangent vector:
+ ! HIBM_TYPE_BOUND="CST" (Image 1 direction)
+ ! HIBM_TYPE_BOUND="LIN" (linear evolution)
+ ! HIBM_TYPE_BOUND="LOG" (logarithmic evol)
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ !
+ ! interface
+ USE MODD_IBM_PARAM_n
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATG
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PVELOCI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL, DIMENSION(3,3) :: PMATRIX
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL,JH,JLL,JL1,JL2
+ REAL, DIMENSION(:,:) , ALLOCATABLE :: Z_IMAGE_VECT
+ REAL, DIMENSION(:,:) , ALLOCATABLE :: Z_IMAGE_TEMP
+ REAL, DIMENSION(:) , ALLOCATABLE :: Z_NORMA_VECT
+ REAL, DIMENSION(:) , ALLOCATABLE :: Z_TANGE_VECT
+ REAL, DIMENSION(:) , ALLOCATABLE :: Z_BINOR_VECT
+ REAL :: Z_NORMA_TEMP,Z_PRODV_TEMP
+ REAL :: Z_COEFI1,Z_COEFI2
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ALLOCATE(Z_IMAGE_VECT(4,3),Z_IMAGE_TEMP(4,3))
+ ALLOCATE(Z_NORMA_VECT(3),Z_TANGE_VECT(3),Z_BINOR_VECT(3))
+ !
+ Z_IMAGE_VECT(:,:) = 0.
+ Z_IMAGE_TEMP(:,:) = 0.
+ Z_NORMA_VECT(:) = 0.
+ Z_TANGE_VECT(:) = 0.
+ Z_BINOR_VECT(:) = 0.
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! vec(n)
+ Z_NORMA_VECT(:) = PLOCATI(:)-PLOCATG(:)
+ Z_NORMA_TEMP = sqrt(Z_NORMA_VECT(1)**2.+Z_NORMA_VECT(2)**2.+Z_NORMA_VECT(3)**2.)+XIBM_EPSI
+ Z_NORMA_VECT(:) = Z_NORMA_VECT(:) / Z_NORMA_TEMP
+ !
+ ! vec(v)
+ DO JL=1,2
+ IF (JL==1) JL1=0
+ IF (JL==2) JL2=0
+ Z_IMAGE_TEMP(JL,1) = sqrt(PVELOCI(JL,1)**2.+PVELOCI(JL,2)**2.+PVELOCI(JL,3)**2.)
+ Z_PRODV_TEMP = ABS((PVELOCI(JL,2)*Z_NORMA_VECT(3)-PVELOCI(JL,3)*Z_NORMA_VECT(2))+ &
+ (PVELOCI(JL,3)*Z_NORMA_VECT(1)-PVELOCI(JL,1)*Z_NORMA_VECT(3))+ &
+ (PVELOCI(JL,1)*Z_NORMA_VECT(2)-PVELOCI(JL,2)*Z_NORMA_VECT(1))+XIBM_EPSI)
+ IF (Z_IMAGE_TEMP(JL,1).gt.XIBM_EPSI.and.Z_PRODV_TEMP.gt.XIBM_EPSI) THEN
+ Z_IMAGE_VECT(JL,:) = PVELOCI(JL,:)/Z_IMAGE_TEMP(JL,1)
+ ELSE
+ IF (JL==1) JL1=1
+ IF (JL==2) JL2=1
+ Z_NORMA_TEMP = XIBM_IEPS
+ DO JLL=1,3
+ IF (abs(Z_NORMA_VECT(JLL)).lt.Z_NORMA_TEMP) THEN
+ Z_NORMA_TEMP = abs(Z_NORMA_VECT(JLL))
+ JH = JLL
+ ENDIF
+ ENDDO
+ Z_IMAGE_VECT(JL,:) = 0.
+ Z_IMAGE_VECT(JL,JH) = 1.
+ ENDIF
+ ENDDO
+ !
+ IF (JL1==1.AND.JL2==0) Z_IMAGE_VECT(1,:)=Z_IMAGE_VECT(2,:)
+ IF (JL2==1.AND.JL1==0) Z_IMAGE_VECT(2,:)=Z_IMAGE_VECT(1,:)
+ !
+ ! vec(c)
+ DO JL=1,2
+ !
+ ! vec(c)
+ Z_IMAGE_TEMP(JL,1) = -(Z_IMAGE_VECT(JL,2)*Z_NORMA_VECT(3)-Z_IMAGE_VECT(JL,3)*Z_NORMA_VECT(2))
+ Z_IMAGE_TEMP(JL,2) = +(Z_IMAGE_VECT(JL,1)*Z_NORMA_VECT(3)-Z_IMAGE_VECT(JL,3)*Z_NORMA_VECT(1))
+ Z_IMAGE_TEMP(JL,3) = -(Z_IMAGE_VECT(JL,1)*Z_NORMA_VECT(2)-Z_IMAGE_VECT(JL,2)*Z_NORMA_VECT(1))
+ Z_NORMA_TEMP = sqrt(Z_IMAGE_TEMP(JL,1)**2.+Z_IMAGE_TEMP(JL,2)**2.+Z_IMAGE_TEMP(JL,3)**2.)
+ Z_IMAGE_TEMP(JL,:) = Z_IMAGE_TEMP(JL,:) / Z_NORMA_TEMP
+ !
+ ! vec(t)
+ Z_IMAGE_VECT(JL,1) = +(Z_IMAGE_TEMP(JL,2)*Z_NORMA_VECT(3)-Z_IMAGE_TEMP(JL,3)*Z_NORMA_VECT(2))
+ Z_IMAGE_VECT(JL,2) = -(Z_IMAGE_TEMP(JL,1)*Z_NORMA_VECT(3)-Z_IMAGE_TEMP(JL,3)*Z_NORMA_VECT(1))
+ Z_IMAGE_VECT(JL,3) = +(Z_IMAGE_TEMP(JL,1)*Z_NORMA_VECT(2)-Z_IMAGE_TEMP(JL,2)*Z_NORMA_VECT(1))
+ Z_NORMA_TEMP = sqrt(Z_IMAGE_VECT(JL,1)**2.+Z_IMAGE_VECT(JL,2)**2.+Z_IMAGE_VECT(JL,3)**2.)
+ Z_IMAGE_VECT(JL,:) = Z_IMAGE_VECT(JL,:) / Z_NORMA_TEMP
+ !
+ ENDDO
+ !
+ IF (HINTERP=='CST') THEN
+ Z_COEFI1 = 1.
+ Z_COEFI2 = 0.
+ ENDIF
+ !
+ IF (HINTERP=='LIN') THEN
+ Z_COEFI1 = 2.
+ Z_COEFI2 =-1.
+ ENDIF
+ !
+ ! (n/t/c) at the interface
+ Z_TANGE_VECT(:) = Z_COEFI1*Z_IMAGE_VECT(1,:)+Z_COEFI2*Z_IMAGE_VECT(2,:)
+ Z_NORMA_TEMP = sqrt(Z_TANGE_VECT(1)**2.+Z_TANGE_VECT(2)**2.+Z_TANGE_VECT(3)**2.)
+ Z_TANGE_VECT(:) = Z_TANGE_VECT(:) / Z_NORMA_TEMP
+ !
+ Z_BINOR_VECT(1) = -(Z_TANGE_VECT(2)*Z_NORMA_VECT(3)-Z_TANGE_VECT(3)*Z_NORMA_VECT(2))
+ Z_BINOR_VECT(2) = +(Z_TANGE_VECT(1)*Z_NORMA_VECT(3)-Z_TANGE_VECT(3)*Z_NORMA_VECT(1))
+ Z_BINOR_VECT(3) = -(Z_TANGE_VECT(1)*Z_NORMA_VECT(2)-Z_TANGE_VECT(2)*Z_NORMA_VECT(1))
+ Z_NORMA_TEMP = sqrt(Z_BINOR_VECT(1)**2.+Z_BINOR_VECT(2)**2.+Z_BINOR_VECT(3)**2.)
+ Z_BINOR_VECT(:) = Z_BINOR_VECT(:) / Z_NORMA_TEMP
+ !
+ ! matrix
+ PMATRIX(1,1) = Z_NORMA_VECT(1)
+ PMATRIX(1,2) = Z_NORMA_VECT(2)
+ PMATRIX(1,3) = Z_NORMA_VECT(3)
+ PMATRIX(2,1) = Z_TANGE_VECT(1)
+ PMATRIX(2,2) = Z_TANGE_VECT(2)
+ PMATRIX(2,3) = Z_TANGE_VECT(3)
+ PMATRIX(3,1) = Z_BINOR_VECT(1)
+ PMATRIX(3,2) = Z_BINOR_VECT(2)
+ PMATRIX(3,3) = Z_BINOR_VECT(3)
+ !
+ DEALLOCATE(Z_IMAGE_VECT,Z_IMAGE_TEMP)
+ DEALLOCATE(Z_NORMA_VECT,Z_TANGE_VECT,Z_BINOR_VECT)
+ !
+ RETURN
+ !
+END FUNCTION IBM_VALUEMAT1
diff --git a/src/MNH/ibm_valuemat2.f90 b/src/MNH/ibm_valuemat2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1120cfc0d543818a0310ae6c28b95ab0d563a347
--- /dev/null
+++ b/src/MNH/ibm_valuemat2.f90
@@ -0,0 +1,115 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_VALUEMAT2
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_VALUEMAT2(PMATRI1) RESULT(PMATRI2)
+ !
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PMATRI1
+ REAL, DIMENSION(3,3) :: PMATRI2
+ !
+ END FUNCTION IBM_VALUEMAT2
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VALUEMAT2
+!
+! ###############################################
+FUNCTION IBM_VALUEMAT2(PMATRI1) RESULT(PMATRI2)
+ ! ###############################################
+ !
+ !**** *IBM_INTER_VALUEMAT2* - Change of basis (n,t,c) to (u,v,w)
+ !
+ ! PURPOSE
+ ! -------
+ ! Matrix inversion
+ !
+ !
+ ! METHOD
+ ! ------
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:,:), INTENT(IN) :: PMATRI1
+ REAL, DIMENSION(3,3) :: PMATRI2
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL
+ REAL :: Z_DETER
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! det(M)
+ Z_DETER = PMATRI1(1,1)*PMATRI1(2,2)*PMATRI1(3,3) + &
+ PMATRI1(1,2)*PMATRI1(2,3)*PMATRI1(3,1) + &
+ PMATRI1(1,3)*PMATRI1(2,1)*PMATRI1(3,2) - &
+ PMATRI1(1,3)*PMATRI1(2,2)*PMATRI1(3,1) - &
+ PMATRI1(2,3)*PMATRI1(3,2)*PMATRI1(1,1) - &
+ PMATRI1(3,3)*PMATRI1(1,2)*PMATRI1(2,1)
+ !
+ ! M^(-1)
+ PMATRI2(1,1) = PMATRI1(2,2)*PMATRI1(3,3)-PMATRI1(2,3)*PMATRI1(3,2)
+ PMATRI2(1,2) = PMATRI1(1,3)*PMATRI1(3,2)-PMATRI1(1,2)*PMATRI1(3,3)
+ PMATRI2(1,3) = PMATRI1(1,2)*PMATRI1(2,3)-PMATRI1(1,3)*PMATRI1(2,2)
+ PMATRI2(2,1) = PMATRI1(2,3)*PMATRI1(3,1)-PMATRI1(2,1)*PMATRI1(3,3)
+ PMATRI2(2,2) = PMATRI1(1,1)*PMATRI1(3,3)-PMATRI1(1,3)*PMATRI1(3,1)
+ PMATRI2(2,3) = PMATRI1(1,3)*PMATRI1(2,1)-PMATRI1(1,1)*PMATRI1(2,3)
+ PMATRI2(3,1) = PMATRI1(2,1)*PMATRI1(3,2)-PMATRI1(2,2)*PMATRI1(3,1)
+ PMATRI2(3,2) = PMATRI1(1,2)*PMATRI1(3,1)-PMATRI1(1,1)*PMATRI1(3,2)
+ PMATRI2(3,3) = PMATRI1(1,1)*PMATRI1(2,2)-PMATRI1(1,2)*PMATRI1(2,1)
+ !
+ PMATRI2(:,:) = PMATRI2(:,:)/Z_DETER
+ !
+ RETURN
+ !
+END FUNCTION IBM_VALUEMAT2
diff --git a/src/MNH/ibm_volume.f90 b/src/MNH/ibm_volume.f90
new file mode 100644
index 0000000000000000000000000000000000000000..af4012a42b9cba352d527c22179f6de698ff59dc
--- /dev/null
+++ b/src/MNH/ibm_volume.f90
@@ -0,0 +1,220 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! ########################
+MODULE MODI_IBM_VOLUME
+ ! ########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_VOLUME(PPHI,PVOL)
+ !
+ REAL, DIMENSION(:,:,:,:) , INTENT(IN) :: PPHI
+ REAL, DIMENSION(:,:,:,:) , INTENT(INOUT) :: PVOL
+ !
+ END SUBROUTINE IBM_VOLUME
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VOLUME
+!
+! ##################################
+SUBROUTINE IBM_VOLUME(PPHI,PVOL)
+ ! ##################################
+ !
+ !
+ !**** IBM_VOLUME computes surface and volume used in the alteration of the pseudo-equation
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to compute :
+ ! - the surface used in the balance of momentum curvature
+ ! - a volumic fraction deducted from the LS function
+ !
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_LBC_n
+ USE MODD_LUNIT_n, ONLY: TLUOUT
+ !
+ ! interface
+ !
+ USE MODI_IBM_INTERPOS
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPHI ! LS functions
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PVOL
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIU,IJU,IKU
+ INTEGER :: IIE,IIB,IJE,IJB,IKE,IKB
+ INTEGER :: JI,JJ,JK,JL,JM
+ REAL :: ZPH1,ZPH2,ZPH3,ZPH4,ZPH5,ZCOE,ZRAY
+ REAL :: ZPH6,ZPH7,ZPH8,ZDEL,ZPH0,ZBAR,ZVOL
+ REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZXREF,ZYREF,ZZREF
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ !
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ !
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ALLOCATE(ZXREF(IIU,IJU,IKU))
+ ALLOCATE(ZYREF(IIU,IJU,IKU))
+ ALLOCATE(ZZREF(IIU,IJU,IKU))
+ !
+ ZXREF = 0.
+ ZYREF = 0.
+ ZZREF = 0.
+ !
+ PVOL(:,:,:,:)=0.0
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ ! Volume computations
+ JL = 1
+ PVOL(IIB:IIE,IJB:IJE,IKB:IKE,1:2)=1.
+ !
+ CALL IBM_INTERPOS(ZXREF,ZYREF,ZZREF,'P')
+ !
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ !
+ ZDEL = ((ZXREF(JI+1,JJ,JK)-ZXREF(JI,JJ,JK))*&
+ (ZYREF(JI,JJ+1,JK)-ZYREF(JI,JJ,JK))*&
+ (ZZREF(JI,JJ,JK+1)-ZZREF(JI,JJ,JK)))**(1./3.)
+ !
+ ZRAY = ZDEL/2.
+ ZCOE = 1./2.
+ ZPH1 = PPHI(JI ,JJ ,JK ,1)
+ !
+ DO JM=1,6
+ !
+ IF (JM==1) ZPH2 = PPHI(JI ,JJ ,JK ,2)
+ IF (JM==2) ZPH2 = PPHI(JI+1,JJ ,JK ,2)
+ IF (JM==3) ZPH2 = PPHI(JI ,JJ ,JK ,3)
+ IF (JM==4) ZPH2 = PPHI(JI ,JJ+1,JK ,3)
+ IF (JM==5) ZPH2 = PPHI(JI ,JJ ,JK ,4)
+ IF (JM==6) ZPH2 = PPHI(JI ,JJ ,JK+1,4)
+ !
+ ZBAR=0.
+ !
+ IF (ABS(ZPH2-ZPH1).GT.(XIBM_EPSI)) ZBAR = - ZPH1 / ( ZPH2 - ZPH1 ) * ZDEL * ZCOE
+ !
+ ZBAR=min(ZRAY,ZBAR)
+ ZBAR=max(0.,ZBAR)
+ !
+ PVOL(JI,JJ,JK,1) = -max(0.,+ZPH2/abs(ZPH2))*max(0.,+ZPH1/abs(ZPH1))/6. + PVOL(JI,JJ,JK,1) &
+ -max(0.,-ZPH2*ZPH1/abs(ZPH2*ZPH1))*ABS(max(0.,+ZPH2/abs(ZPH2))-(ZBAR/ZRAY)**3.)/6.
+ !
+ PVOL(JI,JJ,JK,1) = min(1.,PVOL(JI,JJ,JK,1))
+ !
+ ENDDO
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ IF (LWEST_ll ()) PVOL(IIB-1,:,:,1)=PVOL(IIB,:,:,1)
+ IF (LEAST_ll ()) PVOL(IIE+1,:,:,1)=PVOL(IIE,:,:,1)
+ IF (LSOUTH_ll()) PVOL(:,IJB-1,:,1)=PVOL(:,IJB,:,1)
+ IF (LNORTH_ll()) PVOL(:,IJE+1,:,1)=PVOL(:,IJE,:,1)
+ !
+ PVOL(:,:,IKB-1,1)=PVOL(:,:,IKB,1)
+ PVOL(:,:,IKE+1,1)=PVOL(:,:,IKE,1)
+ !
+ IF(LWEST_ll()) THEN
+ PVOL(IIB-1,IJB:IJE,IKB-1,1)=PVOL(IIB-1,IJB:IJE,IKB,1)
+ PVOL(IIB-1,IJB:IJE,IKE+1,1)=PVOL(IIB-1,IJB:IJE,IKE,1)
+ END IF
+ !
+ IF (LEAST_ll()) THEN
+ PVOL(IIE+1,IJB:IJE,IKB-1,1)=PVOL(IIE+1,IJB:IJE,IKB,1)
+ PVOL(IIE+1,IJB:IJE,IKE+1,1)=PVOL(IIE+1,IJB:IJE,IKE,1)
+ END IF
+ !
+ IF (LSOUTH_ll()) THEN
+ PVOL(IIB:IIE,IJB-1,IKB-1,1)=PVOL(IIB:IIE,IJB-1,IKB,1)
+ PVOL(IIB:IIE,IJB-1,IKE+1,1)=PVOL(IIB:IIE,IJB-1,IKE,1)
+ END IF
+ !
+ IF (LNORTH_ll()) THEN
+ PVOL(IIB:IIE,IJE+1,IKB-1,1)=PVOL(IIB:IIE,IJE+1,IKB,1)
+ PVOL(IIB:IIE,IJE+1,IKE+1,1)=PVOL(IIB:IIE,IJE+1,IKE,1)
+ END IF
+ !
+ !**************************************************
+ !
+ WHERE ( PVOL(:,:,:,1).lt.(XIBM_EPSI) ) PVOL(:,:,:,1)=0.
+ WHERE ( PVOL(:,:,:,1).lt.(1.) ) PVOL(:,:,:,2)=0.
+ WHERE ( (PVOL(:,:,:,1)-PVOL(:,:,:,2) ) .GT. 0.0 ) PVOL(:,:,:,3)=1.0
+ !
+ !------------------------------------------------------------------------------
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ DEALLOCATE(ZXREF,ZYREF,ZZREF)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_VOLUME
diff --git a/src/MNH/ice4_compute_pdf.f90 b/src/MNH/ice4_compute_pdf.f90
index dc6a40759936aad02741e87f6c39c23569d3b052..bc465eb65ef522324dea8c19d986f578bdab5518 100644
--- a/src/MNH/ice4_compute_pdf.f90
+++ b/src/MNH/ice4_compute_pdf.f90
@@ -1,19 +1,24 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
+!-----------------------------------------------------------------
MODULE MODI_ICE4_COMPUTE_PDF
INTERFACE
-SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV, HSUBG_PR_PDF, &
- PRHODREF, PRCT, PCF, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRF)
+SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
+ PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
@@ -21,13 +26,18 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
! note that PRC = PHLC_HRC + PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_HCF !
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_HRI !
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_LRI !
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRF ! Rain fraction
END SUBROUTINE ICE4_COMPUTE_PDF
END INTERFACE
END MODULE MODI_ICE4_COMPUTE_PDF
-SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV, HSUBG_PR_PDF, &
- PRHODREF, PRCT, PCF, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRF)
+SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
+ PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
!!
!!** PURPOSE
!! -------
@@ -47,7 +57,8 @@ SUBROUTINE ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV, HSUBG_PR_PDF, &
!
!
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: XCRIAUTC
+USE MODD_RAIN_ICE_PARAM, ONLY: XCRIAUTC,XBCRIAUTI,XACRIAUTI,XCRIAUTI
+USE MODD_CST, ONLY : XTT
!
USE MODE_MSG
!
@@ -56,11 +67,14 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KSIZE
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method for cloud water
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method for cloud water
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
@@ -68,72 +82,74 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
! note that PRC = PHLC_HRC + PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_HCF
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_HRI
+REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PHLI_LRI
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRF ! Rain fraction
!
!* 0.2 declaration of local variables
!
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZRCRAUTC, & !RC value to begin rain formation =XCRIAUTC/RHODREF
- ZHLC_RCMAX, & !HLCLOUDS : maximum value for RC in distribution
- ZHLC_LRCLOCAL, & !HLCLOUDS : LWC that is Low LWC local in LCF
- ZHLC_HRCLOCAL !HLCLOUDS : LWC that is High LWC local in HCF
+REAL, DIMENSION(KSIZE) :: ZRCRAUTC, & !RC value to begin rain formation =XCRIAUTC/RHODREF
+ ZCRIAUTI, & !RI value to begin snow formation
+ ZHLC_RCMAX, & !HLCLOUDS : maximum value for RC in distribution
+ ZHLC_LRCLOCAL, & !HLCLOUDS : LWC that is Low LWC local in LCF
+ ZHLC_HRCLOCAL, & !HLCLOUDS : LWC that is High LWC local in HCF
! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL
! = PHLC_HRC/HCF+ PHLC_LRC/LCF
+ ZSUMRC, ZSUMRI
REAL :: ZCOEFFRCM
!-------------------------------------------------------------------------------
!
!Cloud water split between high and low content part is done according to autoconversion option
ZRCRAUTC(:)=XCRIAUTC/PRHODREF(:) ! Autoconversion rc threshold
-IF(HSUBG_AUCV=='NONE') THEN
+IF(HSUBG_AUCV_RC=='NONE') THEN
!Cloud water is entirely in low or high part
WHERE(PRCT(:)>ZRCRAUTC(:))
PHLC_HCF(:)=1.
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- PRF(:) =1.
ELSEWHERE(PRCT(:)>XRTMIN(2))
PHLC_HCF(:)=0.
PHLC_LCF(:)=1.
PHLC_HRC(:)=0.
PHLC_LRC(:)=PRCT(:)
- PRF(:) =0.
ELSEWHERE
PHLC_HCF(:)=0.
PHLC_LCF(:)=0.
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
- PRF(:) =0.
END WHERE
-ELSEIF(HSUBG_AUCV=='CLFR') THEN
+ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
!Cloud water is only in the cloudy part and entirely in low or high part
- WHERE(PCF(:) > 0. .AND. PRCT(:)>ZRCRAUTC(:)*PCF(:))
+ WHERE(PCF(:)>0. .AND. PRCT(:)>ZRCRAUTC(:)*PCF(:))
PHLC_HCF(:)=PCF(:)
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- PRF(:) =PCF(:)
- ELSEWHERE(PCF(:) > 0. .AND. PRCT(:)>XRTMIN(2))
+ ELSEWHERE(PCF(:)>0. .AND. PRCT(:)>XRTMIN(2))
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.0
PHLC_LRC(:)=PRCT(:)
- PRF(:) =0.
- ELSEWHERE (PCF(:) > 0.)
- PHLC_HCF(:)=0.
- PHLC_LCF(:)=0.
- PHLC_HRC(:)=0.
- PHLC_LRC(:)=0.
- PRF(:) =0.
ELSEWHERE
PHLC_HCF(:)=0.
PHLC_LCF(:)=0.
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
- PRF(:) =0.
END WHERE
-
-ELSEIF(HSUBG_AUCV=='PDF ') THEN
+ELSEIF(HSUBG_AUCV_RC=='ADJU') THEN
+ ZSUMRC(:)=PHLC_LRC(:)+PHLC_HRC(:)
+ WHERE(ZSUMRC .GT. 0.)
+ PHLC_LRC(:)=PHLC_LRC(:)*PRCT(:)/ZSUMRC(:)
+ PHLC_HRC(:)=PHLC_HRC(:)*PRCT(:)/ZSUMRC(:)
+ ELSEWHERE
+ PHLC_LRC(:)=0.
+ PHLC_HRC(:)=0.
+ ENDWHERE
+ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
!Cloud water is split between high and low part according to a PDF
! 'HLCRECTPDF' : rectangular PDF form
! 'HLCTRIANGPDF' : triangular PDF form
@@ -147,7 +163,6 @@ ELSEIF(HSUBG_AUCV=='PDF ') THEN
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- PRF(:) =1.
ELSEWHERE(PRCT(:)> (ZRCRAUTC(:)-PSIGMA_RC(:)) .AND. &
& PRCT(:)<=(ZRCRAUTC(:)+PSIGMA_RC(:)) )
PHLC_HCF(:)=(PRCT(:)+PSIGMA_RC(:)-ZRCRAUTC(:))/ &
@@ -157,19 +172,16 @@ ELSEIF(HSUBG_AUCV=='PDF ') THEN
&(PRCT(:)+PSIGMA_RC(:)+ZRCRAUTC(:))/ &
&(4.*PSIGMA_RC(:))
PHLC_LRC(:)=MAX(0., PRCT(:)-PHLC_HRC(:))
- PRF(:) =PHLC_HCF(:)
ELSEWHERE(PRCT(:)>XRTMIN(2) .AND. PCF(:)>0.)
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.
PHLC_LRC(:)=PRCT(:)
- PRF(:) =0.
ELSEWHERE
PHLC_HCF(:)=0.
PHLC_LCF(:)=0.
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
- PRF(:) =0.
END WHERE
! Turner (2011, 2012)
ELSEIF(HSUBG_PR_PDF=='HLCRECTPDF' .OR. HSUBG_PR_PDF=='HLCISOTRIPDF' .OR. &
@@ -248,7 +260,6 @@ ELSEIF(HSUBG_AUCV=='PDF ') THEN
PHLC_LRC(:)=0.
PHLC_HRC(:)=0.
END WHERE
- PRF(:)=PHLC_HCF(:) !Precipitation fraction
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_PR_PDF case')
ENDIF
@@ -256,4 +267,58 @@ ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_AUCV case')
ENDIF
!
+!Ice water split between high and low content part is done according to autoconversion option
+ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI)) ! Autoconversion ri threshold
+IF(HSUBG_AUCV_RI=='NONE') THEN
+ !Cloud water is entirely in low or high part
+ WHERE(PRIT(:)>ZCRIAUTI(:))
+ PHLI_HCF(:)=1.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=PRIT(:)
+ PHLI_LRI(:)=0.
+ ELSEWHERE(PRIT(:)>XRTMIN(2))
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=1.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=PRIT(:)
+ ELSEWHERE
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=0.
+ END WHERE
+ELSEIF(HSUBG_AUCV_RI=='CLFR') THEN
+ !Cloud water is only in the cloudy part and entirely in low or high part
+ WHERE(PCF(:)>0. .AND. PRIT(:)>ZCRIAUTI(:)*PCF(:))
+ PHLI_HCF(:)=PCF(:)
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=PRIT(:)
+ PHLI_LRI(:)=0.
+ ELSEWHERE(PCF(:)>0. .AND. PRIT(:)>XRTMIN(2))
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=PCF(:)
+ PHLI_HRI(:)=0.0
+ PHLI_LRI(:)=PRIT(:)
+ ELSEWHERE
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=0.
+ END WHERE
+ELSEIF(HSUBG_AUCV_RI=='ADJU') THEN
+ ZSUMRI(:)=PHLI_LRI(:)+PHLI_HRI(:)
+ WHERE(ZSUMRI .GT. 0.)
+ PHLI_LRI(:)=PHLI_LRI(:)*PRIT(:)/ZSUMRI(:)
+ PHLI_HRI(:)=PHLI_HRI(:)*PRIT(:)/ZSUMRI(:)
+ ELSEWHERE
+ PHLI_LRI(:)=0.
+ PHLI_HRI(:)=0.
+ ENDWHERE
+ELSE
+ !wrong HSUBG_AUCV_RI case
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'ICE4_COMPUTE_PDF', 'wrong HSUBG_AUCV_RI case' )
+ENDIF
+!
+PRF=MAX(PHLC_HCF,PHLI_HCF)
+!
END SUBROUTINE ICE4_COMPUTE_PDF
diff --git a/src/MNH/ice4_fast_rg.f90 b/src/MNH/ice4_fast_rg.f90
index 8a52f858e8a8410350de734361c37425f4975c4e..b84dda857e7a679561f062eabbe0570f7fc22408 100644
--- a/src/MNH/ice4_fast_rg.f90
+++ b/src/MNH/ice4_fast_rg.f90
@@ -1,17 +1,17 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
!-----------------------------------------------------------------
MODULE MODI_ICE4_FAST_RG
INTERFACE
-SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, &
+SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, PCIT, &
&PLBDAR, PLBDAS, PLBDAG, &
&PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
&PRGSI, PRGSI_MR, &
- &LDWETG, &
+ &PWETG, &
&PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
&PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
&PRG_TEND, &
@@ -19,7 +19,7 @@ SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, &
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
@@ -41,7 +41,7 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
-LOGICAL, DIMENSION(KSIZE), INTENT(OUT) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
@@ -56,7 +56,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -69,13 +69,13 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH
END SUBROUTINE ICE4_FAST_RG
END INTERFACE
END MODULE MODI_ICE4_FAST_RG
-SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, &
+SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, PCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, PCIT, &
&PLBDAR, PLBDAS, PLBDAG, &
&PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
&PRGSI, PRGSI_MR, &
- &LDWETG, &
+ &PWETG, &
&PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
&PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
&PRG_TEND, &
@@ -99,7 +99,8 @@ SUBROUTINE ICE4_FAST_RG(KSIZE, LDSOFT, LDCOMPUTE, KRR, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT, &
+ XEPSILO
USE MODD_PARAM_ICE, ONLY: LCRFLIMIT,LEVLIMIT,LNULLWETG,LWETGPOST
USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXG,XCXS,XDG,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: NDRYLBDAG,NDRYLBDAR,NDRYLBDAS,X0DEPG,X1DEPG,XCOLEXIG,XCOLEXSG,XCOLIG,XCOLSG,XDRYINTP1G, &
@@ -113,7 +114,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
@@ -135,7 +136,7 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST ! Snow/aggregate m.r. at
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT ! Graupel m.r. at t
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
-LOGICAL, DIMENSION(KSIZE), INTENT(OUT) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
@@ -150,7 +151,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSDRYG ! Graupel dry growth
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH ! Conversion of graupel into hail
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRWETGH_MR ! Conversion of graupel into hail, mr change
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRGMLTR ! Melting of the graupel
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -163,34 +164,39 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RH
!
!* 0.2 declaration of local variables
!
-INTEGER, PARAMETER :: IRCDRYG=1, IRIDRYG=2, IRIWETG=3, IRSDRYG=4, IRSWETG=5, IRRDRYG=6
+INTEGER, PARAMETER :: IRCDRYG=1, IRIDRYG=2, IRIWETG=3, IRSDRYG=4, IRSWETG=5, IRRDRYG=6, &
+ & IFREEZ1=7, IFREEZ2=8
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GDRY, LLDRYG, GMASK
+LOGICAL, DIMENSION(KSIZE) :: GDRY
+INTEGER, DIMENSION(KSIZE) :: I1
+REAL, DIMENSION(KSIZE) :: ZDRY, ZDRYG, ZMASK
INTEGER :: IGDRY
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, &
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
+REAL, DIMENSION(KSIZE) :: ZZW, &
ZRDRYG_INIT, & !Initial dry growth rate of the graupeln
ZRWETG_INIT !Initial wet growth rate of the graupeln
-INTEGER :: JJ
+INTEGER :: JJ, JL
!
!-------------------------------------------------------------------------------
!
!* 6.1 rain contact freezing
!
-GMASK(:)=PRIT(:)>XRTMIN(4) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRICFRRG(:)=0.
- PRRCFRIG(:)=0.
- PRICFRR(:)=0.
- ENDWHERE
+ DO JL=1, KSIZE
+ PRICFRRG(JL)=ZMASK(JL) * PRICFRRG(JL)
+ PRRCFRIG(JL)=ZMASK(JL) * PRRCFRIG(JL)
+ PRICFRR(JL)=ZMASK(JL) * PRICFRR(JL)
+ ENDDO
ELSE
PRICFRRG(:)=0.
PRRCFRIG(:)=0.
- PRICFRR(:)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRICFRRG(:) = XICFRR*PRIT(:) & ! RICFRRG
*PLBDAR(:)**XEXICFRR &
*PRHODREF(:)**(-XCEXVT)
@@ -198,50 +204,68 @@ ELSE
* PLBDAR(:)**XEXRCFRI &
* PRHODREF(:)**(-XCEXVT-1.)
END WHERE
- ZZW(:)=1.
+
IF(LCRFLIMIT) THEN
- WHERE(GMASK(:))
+ DO JL=1, KSIZE
!Comparison between heat to be released (to freeze rain) and heat sink (rain and ice temperature change)
!ZZW is the proportion of process that can take place
- ZZW(:) = MAX(0., MIN(1., (PRICFRRG(:)*XCI+PRRCFRIG(:)*XCL)*(XTT-PT(:)) / &
- MAX(1.E-20, XLVTT*PRRCFRIG(:))))
- ENDWHERE
+ ZZW(JL)=(1.-ZMASK(JL)) + & ! 1. outside of mask
+ ZMASK(JL) * MAX(0., MIN(1., (PRICFRRG(JL)*XCI+PRRCFRIG(JL)*XCL)*(XTT-PT(JL)) / &
+ MAX(1.E-20, XLVTT*PRRCFRIG(JL))))
+ ENDDO
+ ELSE
+ ZZW(:)=1.
ENDIF
- PRRCFRIG(:) = ZZW(:) * PRRCFRIG(:) !Part of rain that can be freezed
- PRICFRR(:) = (1-ZZW(:)) * PRICFRRG(:) !Part of collected pristine ice converted to rain
- PRICFRRG(:) = ZZW(:) * PRICFRRG(:) !Part of collected pristine ice that lead to graupel
+ DO JL=1, KSIZE
+ PRRCFRIG(JL) = ZZW(JL) * PRRCFRIG(JL) !Part of rain that can be freezed
+ PRICFRR(JL) = (1.-ZZW(JL)) * PRICFRRG(JL) !Part of collected pristine ice converted to rain
+ PRICFRRG(JL) = ZZW(JL) * PRICFRRG(JL) !Part of collected pristine ice that lead to graupel
+ ENDDO
ENDIF
-PA_RI(:) = PA_RI(:) - PRICFRRG(:) - PRICFRR(:)
-PA_RR(:) = PA_RR(:) - PRRCFRIG(:) + PRICFRR(:)
-PA_RG(:) = PA_RG(:) + PRICFRRG(:) + PRRCFRIG(:)
-PA_TH(:) = PA_TH(:) + (PRRCFRIG(:) - PRICFRR(:))*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PA_RI(JL) = PA_RI(JL) - PRICFRRG(JL) - PRICFRR(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRCFRIG(JL) + PRICFRR(JL)
+ PA_RG(JL) = PA_RG(JL) + PRICFRRG(JL) + PRRCFRIG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRRCFRIG(JL) - PRICFRR(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
!* 6.3 compute the graupel growth
!
! Wet and dry collection of rc and ri on graupel
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRG_TEND(:, IRCDRYG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*PRG_TEND(JL, IRCDRYG)
+ ENDDO
ELSE
- PRG_TEND(:, IRCDRYG)=0.
- WHERE(GMASK(:))
+ ZZW(:)=0.
+ WHERE(ZMASK(:)==1.)
ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
- PRG_TEND(:, IRCDRYG)=XFCDRYG * PRCT(:) * ZZW(:)
END WHERE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*XFCDRYG * PRCT(JL) * ZZW(JL)
+ ENDDO
ENDIF
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:)
+
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRG_TEND(:, IRIDRYG)=0.
- PRG_TEND(:, IRIWETG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRIDRYG)=ZMASK(JL) * PRG_TEND(JL, IRIDRYG)
+ PRG_TEND(JL, IRIWETG)=ZMASK(JL) * PRG_TEND(JL, IRIWETG)
+ ENDDO
ELSE
PRG_TEND(:, IRIDRYG)=0.
PRG_TEND(:, IRIWETG)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
PRG_TEND(:, IRIDRYG)=XFIDRYG*EXP(XCOLEXIG*(PT(:)-XTT))*PRIT(:)*ZZW(:)
PRG_TEND(:, IRIWETG)=PRG_TEND(:, IRIDRYG) / (XCOLIG*EXP(XCOLEXIG*(PT(:)-XTT)))
@@ -251,7 +275,10 @@ ENDIF
! Wet and dry collection of rs on graupel (6.2.1)
IGDRY = 0
DO JJ = 1, SIZE(GDRY)
- IF (PRST(JJ)>XRTMIN(5) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
+ ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZDRY(JJ)>0) THEN
IGDRY = IGDRY + 1
I1(IGDRY) = JJ
GDRY(JJ) = .TRUE.
@@ -261,10 +288,10 @@ DO JJ = 1, SIZE(GDRY)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GDRY(:))
- PRG_TEND(:, IRSDRYG)=0.
- PRG_TEND(:, IRSWETG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRSDRYG)=ZDRY(JL) * PRG_TEND(JL, IRSDRYG)
+ PRG_TEND(JL, IRSWETG)=ZDRY(JL) * PRG_TEND(JL, IRSWETG)
+ ENDDO
ELSE
PRG_TEND(:, IRSDRYG)=0.
PRG_TEND(:, IRSWETG)=0.
@@ -324,7 +351,10 @@ ENDIF
!
IGDRY = 0
DO JJ = 1, SIZE(GDRY)
- IF (PRRT(JJ)>XRTMIN(3) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
+ ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZDRY(JJ)>0) THEN
IGDRY = IGDRY + 1
I1(IGDRY) = JJ
GDRY(JJ) = .TRUE.
@@ -334,9 +364,9 @@ DO JJ = 1, SIZE(GDRY)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GDRY(:))
- PRG_TEND(:, IRRDRYG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IRRDRYG)=ZDRY(JL) * PRG_TEND(JL, IRRDRYG)
+ ENDDO
ELSE
PRG_TEND(:, IRRDRYG)=0.
!
@@ -390,47 +420,77 @@ ELSE
ENDIF
ENDIF
-ZRDRYG_INIT(:)=PRG_TEND(:, IRCDRYG)+PRG_TEND(:, IRIDRYG)+PRG_TEND(:, IRSDRYG)+PRG_TEND(:, IRRDRYG)
+DO JL=1, KSIZE
+ ZRDRYG_INIT(JL)=PRG_TEND(JL, IRCDRYG)+PRG_TEND(JL, IRIDRYG)+ &
+ &PRG_TEND(JL, IRSDRYG)+PRG_TEND(JL, IRRDRYG)
+ENDDO
!Freezing rate
-ZRWETG_INIT(:)=0.
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:)
-WHERE(GMASK(:))
- ZRWETG_INIT(:)=PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
-END WHERE
-IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
- ZRWETG_INIT(:)=MIN(ZRWETG_INIT(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRG_TEND(JL, IFREEZ1)
+ PRG_TEND(JL, IFREEZ2)=ZMASK(JL) * PRG_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZMASK(:)==1.)
+ PRG_TEND(:, IFREEZ1)=MIN(PRG_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ END WHERE
+ ENDIF
+ PRG_TEND(:, IFREEZ2)=0.
+ WHERE(ZMASK(:)==1.)
+ PRG_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRG_TEND(:, IFREEZ1))/(XRV*PT(:)) )
+ PRG_TEND(:, IFREEZ1)=PRG_TEND(:, IFREEZ1)* ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )/ &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRG_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
END WHERE
ENDIF
-WHERE(GMASK(:))
- ZRWETG_INIT(:)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-ZRWETG_INIT(:))/(XRV*PT(:)) )
- ZRWETG_INIT(:)=MAX(0., &
- (ZRWETG_INIT(:) * ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
- X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) + &
- (PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG) ) * &
- (PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) )
+DO JL=1, KSIZE
!We must agregate, at least, the cold species
- ZRWETG_INIT(:)=MAX(ZRWETG_INIT(:), PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG))
-END WHERE
+ ZRWETG_INIT(JL)=ZMASK(JL) * MAX(PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG), &
+ &MAX(0., PRG_TEND(JL, IFREEZ1) + &
+ &PRG_TEND(JL, IFREEZ2) * ( &
+ &PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG) )))
+ENDDO
!Growth mode
-LDWETG(:)=GMASK(:) .AND. &
- &MAX(0., ZRDRYG_INIT(:)-PRG_TEND(:, IRIDRYG)-PRG_TEND(:, IRSDRYG))>= &
- &MAX(0., ZRWETG_INIT(:)-PRG_TEND(:, IRIWETG)-PRG_TEND(:, IRSWETG))
+DO JL=1, KSIZE
+ PWETG(JL) = ZMASK(JL) * & !
+ & MAX(0., SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
+ &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
+ENDDO
IF(LNULLWETG) THEN
- LDWETG(:)=LDWETG(:) .AND. ZRDRYG_INIT(:)>0.
+ DO JL=1, KSIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRDRYG_INIT(JL)))
+ ENDDO
ELSE
- LDWETG(:)=LDWETG(:) .AND. ZRWETG_INIT(:)>0.
+ DO JL=1, KSIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRWETG_INIT(JL)))
+ ENDDO
ENDIF
-IF(.NOT. LWETGPOST) LDWETG(:)=LDWETG(:) .AND. PT(:)<XTT
-
-LLDRYG(:)=GMASK(:) .AND. PT(:)<XTT .AND. ZRDRYG_INIT(:)>0. .AND. &
- &MAX(0., ZRDRYG_INIT(:)-PRG_TEND(:, IRIDRYG)-PRG_TEND(:, IRSDRYG))<&
- &MAX(0., ZRWETG_INIT(:)-PRG_TEND(:, IRIWETG)-PRG_TEND(:, IRSWETG))
+IF(.NOT. LWETGPOST) THEN
+ DO JL=1, KSIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., PT(JL)-XTT))
+ ENDDO
+ENDIF
+DO JL=1, KSIZE
+ ZDRYG(JL) = ZMASK(JL) * & !
+ & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
+ & MAX(0., -SIGN(1., 1.E-20-ZRDRYG_INIT(JL))) * & ! WHERE(ZRDRYG_INIT(:)>0.)
+ & MAX(0., -SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
+ &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
+ENDDO
! Part of ZRWETG to be converted into hail
! Graupel can be produced by other processes instantaneously (inducing a mixing ratio change, PRGSI_MR) or
@@ -438,75 +498,70 @@ LLDRYG(:)=GMASK(:) .AND. PT(:)<XTT .AND. ZRDRYG_INIT(:)>0. .AND. &
PRWETGH(:)=0.
PRWETGH_MR(:)=0.
IF(KRR==7) THEN
- WHERE(LDWETG(:))
+ WHERE(PWETG(:)==1.)
!assume a linear percent of conversion of produced graupel into hail
PRWETGH(:)=(MAX(0., PRGSI(:)+PRICFRRG(:)+PRRCFRIG(:))+ZRWETG_INIT(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
PRWETGH_MR(:)=MAX(0., PRGSI_MR(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
END WHERE
ENDIF
-PRCWETG(:)=0.
-PRIWETG(:)=0.
-PRSWETG(:)=0.
-PRRWETG(:)=0.
-WHERE(LDWETG(:))
+DO JL=1, KSIZE
!Aggregated minus collected
- PRRWETG(:)=-(PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG)+PRG_TEND(:, IRCDRYG)-ZRWETG_INIT(:))
- PRCWETG(:)=PRG_TEND(:, IRCDRYG)
- PRIWETG(:)=PRG_TEND(:, IRIWETG)
- PRSWETG(:)=PRG_TEND(:, IRSWETG)
-END WHERE
-PRCDRYG(:)=0.
-PRIDRYG(:)=0.
-PRRDRYG(:)=0.
-PRSDRYG(:)=0.
-WHERE(LLDRYG(:))
- PRCDRYG(:)=PRG_TEND(:, IRCDRYG)
- PRRDRYG(:)=PRG_TEND(:, IRRDRYG)
- PRIDRYG(:)=PRG_TEND(:, IRIDRYG)
- PRSDRYG(:)=PRG_TEND(:, IRSDRYG)
-END WHERE
-PA_RC(:) = PA_RC(:) - PRCWETG(:)
-PA_RI(:) = PA_RI(:) - PRIWETG(:)
-PA_RS(:) = PA_RS(:) - PRSWETG(:)
-PA_RG(:) = PA_RG(:) + PRCWETG(:) + PRIWETG(:) + PRSWETG(:) + PRRWETG(:)
-PA_RR(:) = PA_RR(:) - PRRWETG(:)
-PA_TH(:) = PA_TH(:) + (PRCWETG(:) + PRRWETG(:))*(PLSFACT(:)-PLVFACT(:))
-PA_RG(:) = PA_RG(:) - PRWETGH(:)
-PA_RH(:) = PA_RH(:) + PRWETGH(:)
-PB_RG(:) = PB_RG(:) - PRWETGH_MR(:)
-PB_RH(:) = PB_RH(:) + PRWETGH_MR(:)
-PA_RC(:) = PA_RC(:) - PRCDRYG(:)
-PA_RI(:) = PA_RI(:) - PRIDRYG(:)
-PA_RS(:) = PA_RS(:) - PRSDRYG(:)
-PA_RR(:) = PA_RR(:) - PRRDRYG(:)
-PA_RG(:) = PA_RG(:) + PRCDRYG(:) + PRIDRYG(:) + PRSDRYG(:) + PRRDRYG(:)
-PA_TH(:) = PA_TH(:) + (PRCDRYG(:)+PRRDRYG(:))*(PLSFACT(:)-PLVFACT(:))
+ PRRWETG(JL)=-PWETG(JL) * (PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG)+&
+ &PRG_TEND(JL, IRCDRYG)-ZRWETG_INIT(JL))
+ PRCWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRCDRYG)
+ PRIWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRIWETG)
+ PRSWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRSWETG)
+
+ PRCDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRCDRYG)
+ PRRDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRRDRYG)
+ PRIDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRIDRYG)
+ PRSDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRSDRYG)
+ PA_RC(JL) = PA_RC(JL) - PRCWETG(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIWETG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSWETG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCWETG(JL) + PRIWETG(JL) + PRSWETG(JL) + PRRWETG(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRWETG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCWETG(JL) + PRRWETG(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RG(JL) = PA_RG(JL) - PRWETGH(JL)
+ PA_RH(JL) = PA_RH(JL) + PRWETGH(JL)
+ PB_RG(JL) = PB_RG(JL) - PRWETGH_MR(JL)
+ PB_RH(JL) = PB_RH(JL) + PRWETGH_MR(JL)
+ PA_RC(JL) = PA_RC(JL) - PRCDRYG(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIDRYG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSDRYG(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRDRYG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCDRYG(JL) + PRIDRYG(JL) + PRSDRYG(JL) + PRRDRYG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCDRYG(JL)+PRRDRYG(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 6.5 Melting of the graupeln
!
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRGMLTR(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRGMLTR(JL)=ZMASK(JL) * PRGMLTR(JL)
+ ENDDO
ELSE
- PRGMLTR(:) = 0.
- WHERE(GMASK(:))
- PRGMLTR(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- END WHERE
+ DO JL=1, KSIZE
+ PRGMLTR(JL)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRGMLTR(:)=MIN(PRGMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
END WHERE
ENDIF
- WHERE(GMASK(:))
- PRGMLTR(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-PRGMLTR(:))/(XRV*PT(:)) )
- END WHERE
- WHERE(GMASK(:))
+ DO JL=1, KSIZE
+ PRGMLTR(JL)=ZMASK(JL) * (PKA(JL)*(XTT-PT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ *(XESTT-PRGMLTR(JL))/(XRV*PT(JL)) ))
+ ENDDO
+ WHERE(ZMASK(:)==1.)
!
! compute RGMLTR
!
@@ -518,9 +573,10 @@ ELSE
( PRHODREF(:)*XLMTT ) )
END WHERE
ENDIF
-PA_RR(:) = PA_RR(:) + PRGMLTR(:)
-PA_RG(:) = PA_RG(:) - PRGMLTR(:)
-PA_TH(:) = PA_TH(:) - PRGMLTR(:)*(PLSFACT(:)-PLVFACT(:))
-
+DO JL=1, KSIZE
+ PA_RR(JL) = PA_RR(JL) + PRGMLTR(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGMLTR(JL)
+ PA_TH(JL) = PA_TH(JL) - PRGMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
END SUBROUTINE ICE4_FAST_RG
diff --git a/src/MNH/ice4_fast_rh.f90 b/src/MNH/ice4_fast_rh.f90
index 9678dceb11cd3bbe9bcb9fdbde003a3ed0721b53..fcac937485414ba29fd691cb0774a32cb3ea4a3c 100644
--- a/src/MNH/ice4_fast_rh.f90
+++ b/src/MNH/ice4_fast_rh.f90
@@ -1,11 +1,11 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
!-----------------------------------------------------------------
MODULE MODI_ICE4_FAST_RH
INTERFACE
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LDWETG, &
+SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
@@ -17,8 +17,8 @@ SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LDWETG, &
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -50,7 +50,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailston
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -61,7 +61,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
END SUBROUTINE ICE4_FAST_RH
END INTERFACE
END MODULE MODI_ICE4_FAST_RH
-SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LDWETG, &
+SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, PCOMPUTE, PWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
@@ -89,7 +89,7 @@ SUBROUTINE ICE4_FAST_RH(KSIZE, LDSOFT, LDCOMPUTE, LDWETG, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
USE MODD_PARAM_ICE, ONLY: LCONVHG,LEVLIMIT,LNULLWETH,LWETHPOST
USE MODD_RAIN_ICE_DESCR, ONLY: XBG,XBS,XCEXVT,XCXG,XCXH,XCXS,XDH,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: NWETLBDAG,NWETLBDAH,NWETLBDAR,NWETLBDAS,X0DEPH,X1DEPH,XCOLEXGH,XCOLEXIH,XCOLGH,XCOLIH,XCOLEXSH, &
@@ -105,8 +105,8 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -138,7 +138,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRDRYH ! Wet growth of hailston
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH ! Wet growth of hailstone
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG ! Conversion of hailstone into graupel
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR ! Melting of the hailstones
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -149,45 +149,55 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RH
!
!* 0.2 declaration of local variables
!
-INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8
+INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8, &
+ & IFREEZ1=9, IFREEZ2=10
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GHAIL, GWET, GMASK, LLWETH, LLDRYH
+LOGICAL, DIMENSION(KSIZE) :: GWET
+REAL, DIMENSION(KSIZE) :: ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH
INTEGER :: IHAIL, IGWET
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, &
+INTEGER, DIMENSION(KSIZE) :: I1
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
+REAL, DIMENSION(KSIZE) :: ZZW, &
ZRDRYH_INIT, ZRWETH_INIT, &
ZRDRYHG
-INTEGER :: JJ
+INTEGER :: JJ, JL
!
!-------------------------------------------------------------------------------
!
!
!* 7.2 compute the Wet and Dry growth of hail
!
-GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRH_TEND(:, IRCWETH)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRCWETH)=ZMASK(JL) * PRH_TEND(JL, IRCWETH)
+ ENDDO
ELSE
PRH_TEND(:, IRCWETH)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
PRH_TEND(:, IRCWETH)=XFWETH * PRCT(:) * ZZW(:) ! RCWETH
END WHERE
ENDIF
-GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRH_TEND(:, IRIWETH)=0.
- PRH_TEND(:, IRIDRYH)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRIWETH)=ZMASK(JL) * PRH_TEND(JL, IRIWETH)
+ PRH_TEND(JL, IRIDRYH)=ZMASK(JL) * PRH_TEND(JL, IRIDRYH)
+ ENDDO
ELSE
PRH_TEND(:, IRIWETH)=0.
PRH_TEND(:, IRIDRYH)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
PRH_TEND(:, IRIWETH)=XFWETH * PRIT(:) * ZZW(:) ! RIWETH
PRH_TEND(:, IRIDRYH)=PRH_TEND(:, IRIWETH)*(XCOLIH*EXP(XCOLEXIH*(PT(:)-XTT))) ! RIDRYH
@@ -199,7 +209,10 @@ ENDIF
!
IGWET = 0
DO JJ = 1, SIZE(GWET)
- IF (PRHT(JJ)>XRTMIN(7) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
+ ZWET(JJ) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
IGWET = IGWET + 1
I1(IGWET) = JJ
GWET(JJ) = .TRUE.
@@ -209,10 +222,10 @@ DO JJ = 1, SIZE(GWET)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GWET(:))
- PRH_TEND(:, IRSWETH)=0.
- PRH_TEND(:, IRSDRYH)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRSWETH)=ZWET(JL) * PRH_TEND(JL, IRSWETH)
+ PRH_TEND(JL, IRSDRYH)=ZWET(JL) * PRH_TEND(JL, IRSDRYH)
+ ENDDO
ELSE
PRH_TEND(:, IRSWETH)=0.
PRH_TEND(:, IRSDRYH)=0.
@@ -271,7 +284,10 @@ ENDIF
!
IGWET = 0
DO JJ = 1, SIZE(GWET)
- IF (PRHT(JJ)>XRTMIN(7) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
IGWET = IGWET + 1
I1(IGWET) = JJ
GWET(JJ) = .TRUE.
@@ -281,10 +297,10 @@ DO JJ = 1, SIZE(GWET)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GWET(:))
- PRH_TEND(:, IRGWETH)=0.
- PRH_TEND(:, IRGDRYH)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRGWETH)=ZWET(JL) * PRH_TEND(JL, IRGWETH)
+ PRH_TEND(JL, IRGDRYH)=ZWET(JL) * PRH_TEND(JL, IRGDRYH)
+ ENDDO
ELSE
PRH_TEND(:, IRGWETH)=0.
PRH_TEND(:, IRGDRYH)=0.
@@ -337,7 +353,7 @@ ELSE
PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGWETH)
END WHERE
!When graupel grows in wet mode, graupel is wet (!) and collection efficiency must remain the same
- WHERE(GWET(:) .AND. .NOT. LDWETG(:))
+ WHERE(GWET(:) .AND. .NOT. PWETG(:)==1.)
PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGDRYH)*(XCOLGH*EXP(XCOLEXGH*(PT(:)-XTT)))
END WHERE
END IF
@@ -347,7 +363,10 @@ ENDIF
!
IGWET = 0
DO JJ = 1, SIZE(GWET)
- IF (PRHT(JJ)>XRTMIN(7) .AND. PRRT(JJ)>XRTMIN(3) .AND. LDCOMPUTE(JJ)) THEN
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
IGWET = IGWET + 1
I1(IGWET) = JJ
GWET(JJ) = .TRUE.
@@ -357,9 +376,9 @@ DO JJ = 1, SIZE(GWET)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GWET(:))
- PRH_TEND(:, IRRWETH)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IRRWETH)=ZWET(JL) * PRH_TEND(JL, IRRWETH)
+ ENDDO
ELSE
PRH_TEND(:, IRRWETH)=0.
IF(IGWET>0)THEN
@@ -412,122 +431,147 @@ ELSE
ENDIF
ENDIF
!
-ZRDRYH_INIT(:)=PRH_TEND(:, IRCWETH)+PRH_TEND(:, IRIDRYH)+PRH_TEND(:, IRSDRYH)+PRH_TEND(:, IRRWETH)+PRH_TEND(:, IRGDRYH)
+DO JL=1, KSIZE
+ ZRDRYH_INIT(JL)=PRH_TEND(JL, IRCWETH)+PRH_TEND(JL, IRIDRYH)+ &
+ &PRH_TEND(JL, IRSDRYH)+PRH_TEND(JL, IRRWETH)+PRH_TEND(JL, IRGDRYH)
+ENDDO
!
!* 7.3 compute the Wet growth of hail
!
-GHAIL(:) = PRHT(:)>XRTMIN(7) .AND. LDCOMPUTE(:)
-ZRWETH_INIT(:)=0.
-WHERE(GHAIL(:))
- ZRWETH_INIT(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
-END WHERE
-IF(LEVLIMIT) THEN
- WHERE(GHAIL(:))
- ZRWETH_INIT(:) = MIN(ZRWETH_INIT(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+DO JL=1, KSIZE
+ ZHAIL(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IFREEZ1)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ1)
+ PRH_TEND(JL, IFREEZ2)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRH_TEND(JL, IFREEZ1)=PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZHAIL(:)==1.)
+ PRH_TEND(:, IFREEZ1)=MIN(PRH_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ END WHERE
+ ENDIF
+ PRH_TEND(:, IFREEZ2)=0.
+ WHERE(ZHAIL(:)==1.)
+ PRH_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRH_TEND(:, IFREEZ1))/(XRV*PT(:)) )
+ PRH_TEND(:, IFREEZ1)=PRH_TEND(:, IFREEZ1)* ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
+ X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH )/ &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRH_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
END WHERE
ENDIF
-WHERE(GHAIL(:))
- ZRWETH_INIT(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-ZRWETH_INIT(:))/(XRV*PT(:)) )
- !
- ! compute RWETH
- !
- ZRWETH_INIT(:) = MAX(0., ( ZRWETH_INIT(:) * ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) + &
- ( PRH_TEND(:, IRIWETH)+PRH_TEND(:, IRSWETH)+PRH_TEND(:, IRGWETH) ) * &
- ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) )
- ZRWETH_INIT(:)=MAX(ZRWETH_INIT(:), PRH_TEND(:, IRIWETH)+PRH_TEND(:, IRSWETH)+PRH_TEND(:, IRGWETH))
-END WHERE
+DO JL=1, KSIZE
+ !We must agregate, at least, the cold species
+ ZRWETH_INIT(JL)=ZHAIL(JL) * MAX(PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH), &
+ &MAX(0., PRH_TEND(JL, IFREEZ1) + &
+ &PRH_TEND(JL, IFREEZ2) * ( &
+ &PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH) )))
+ENDDO
!
!* 7.4 Select Wet or Dry case
!
!Wet case
-LLWETH(:)=GHAIL(:) .AND. MAX(0., ZRDRYH_INIT(:)-PRH_TEND(:, IRIDRYH)-PRH_TEND(:, IRSDRYH)-PRH_TEND(:, IRGDRYH))>= &
- & MAX(0., ZRWETH_INIT(:)-PRH_TEND(:, IRIWETH)-PRH_TEND(:, IRSWETH)-PRH_TEND(:, IRGWETH))
+DO JL=1, KSIZE
+ ZWETH(JL) = ZHAIL(JL) * &
+ & MAX(0., SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)-PRH_TEND(JL, IRGDRYH)) - &
+ &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH)-PRH_TEND(JL, IRGWETH))))
+ENDDO
IF(LNULLWETH) THEN
- LLWETH(:)=LLWETH(:) .AND. ZRDRYH_INIT(:)>0.
+ DO JL=1, KSIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRDRYH_INIT(JL))) ! WHERE(ZRDRYH_INIT(:)>0.)
+ ENDDO
ELSE
- LLWETH(:)=LLWETH(:) .AND. ZRWETH_INIT(:)>0.
+ DO JL=1, KSIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRWETH_INIT(JL))) ! WHERE(ZRWETH_INIT(:)>0.)
+ ENDDO
ENDIF
-IF(.NOT. LWETHPOST) LLWETH(:)=LLWETH(:) .AND. PT(:)<XTT
-LLDRYH(:)=GHAIL(:) .AND. PT(:)<XTT .AND. ZRDRYH_INIT(:)>0. .AND. &
- & MAX(0., ZRDRYH_INIT(:)-PRH_TEND(:, IRIDRYH)-PRH_TEND(:, IRSDRYH))< &
- & MAX(0., ZRWETH_INIT(:)-PRH_TEND(:, IRIWETH)-PRH_TEND(:, IRSWETH))
+IF(.NOT. LWETHPOST) THEN
+ DO JL=1, KSIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ ENDDO
+ENDIF
+DO JL=1, KSIZE
+ ZDRYH(JL) = ZHAIL(JL) * &
+ & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
+ & MAX(0., -SIGN(1., 1.E-20-ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
+ & MAX(0., -SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)) - &
+ &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH))))
+ENDDO
!
-PRCWETH(:)=0.
-PRIWETH(:)=0.
-PRSWETH(:)=0.
-PRGWETH(:)=0.
-PRRWETH(:)=0.
-WHERE (LLWETH(:))
- PRCWETH(:) = PRH_TEND(:, IRCWETH)
- PRIWETH(:) = PRH_TEND(:, IRIWETH)
- PRSWETH(:) = PRH_TEND(:, IRSWETH)
- PRGWETH(:) = PRH_TEND(:, IRGWETH)
- !Collected minus aggregated
- PRRWETH(:) = ZRWETH_INIT(:) - PRH_TEND(:, IRIWETH) - PRH_TEND(:, IRSWETH) - PRH_TEND(:, IRGWETH) - PRH_TEND(:, IRCWETH)
-END WHERE
-
-PRCDRYH(:) = 0.
-PRIDRYH(:) = 0.
-PRSDRYH(:) = 0.
-PRRDRYH(:) = 0.
-PRGDRYH(:) = 0.
-PRDRYHG(:) = 0.
ZRDRYHG(:)=0.
IF(LCONVHG)THEN
- WHERE(LLDRYH(:))
+ WHERE(ZDRYH(:)==1.)
ZRDRYHG(:)=ZRDRYH_INIT(:)*ZRWETH_INIT(:)/(ZRDRYH_INIT(:)+ZRWETH_INIT(:))
END WHERE
ENDIF
-WHERE(LLDRYH(:)) ! Dry
- PRCDRYH(:) = PRH_TEND(:, IRCWETH)
- PRIDRYH(:) = PRH_TEND(:, IRIDRYH)
- PRSDRYH(:) = PRH_TEND(:, IRSDRYH)
- PRRDRYH(:) = PRH_TEND(:, IRRWETH)
- PRGDRYH(:) = PRH_TEND(:, IRGDRYH)
- PRDRYHG(:) = ZRDRYHG(:)
-END WHERE
-PA_RC(:) = PA_RC(:) - PRCWETH(:)
-PA_RI(:) = PA_RI(:) - PRIWETH(:)
-PA_RS(:) = PA_RS(:) - PRSWETH(:)
-PA_RG(:) = PA_RG(:) - PRGWETH(:)
-PA_RH(:) = PA_RH(:) + PRCWETH(:)+PRIWETH(:)+PRSWETH(:)+PRGWETH(:)+PRRWETH
-PA_RR(:) = PA_RR(:) - PRRWETH(:)
-PA_TH(:) = PA_TH(:) + (PRRWETH(:)+PRCWETH(:))*(PLSFACT(:)-PLVFACT(:))
-PA_RC(:) = PA_RC(:) - PRCDRYH(:)
-PA_RI(:) = PA_RI(:) - PRIDRYH(:)
-PA_RS(:) = PA_RS(:) - PRSDRYH(:)
-PA_RR(:) = PA_RR(:) - PRRDRYH(:)
-PA_RG(:) = PA_RG(:) - PRGDRYH(:) + PRDRYHG(:)
-PA_RH(:) = PA_RH(:) + PRCDRYH(:)+PRIDRYH(:)+PRSDRYH(:)+PRRDRYH(:)+PRGDRYH(:) - PRDRYHG(:)
-PA_TH(:) = PA_TH(:) + (PRCDRYH(:)+PRRDRYH(:))*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PRCWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRCWETH)
+ PRIWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRIWETH)
+ PRSWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRSWETH)
+ PRGWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRGWETH)
+ !Collected minus aggregated
+ PRRWETH(JL) = ZWETH(JL) * (ZRWETH_INIT(JL) - PRH_TEND(JL, IRIWETH) - &
+ PRH_TEND(JL, IRSWETH) - PRH_TEND(JL, IRGWETH) - &
+ PRH_TEND(JL, IRCWETH))
+
+ PRCDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRCWETH)
+ PRIDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRIDRYH)
+ PRSDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRSDRYH)
+ PRRDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRRWETH)
+ PRGDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRGDRYH)
+ PRDRYHG(JL) = ZDRYH(JL) * ZRDRYHG(JL)
+
+ PA_RC(JL) = PA_RC(JL) - PRCWETH(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIWETH(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSWETH(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGWETH(JL)
+ PA_RH(JL) = PA_RH(JL) + PRCWETH(JL)+PRIWETH(JL)+PRSWETH(JL)+PRGWETH(JL)+PRRWETH(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRWETH(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRRWETH(JL)+PRCWETH(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RC(JL) = PA_RC(JL) - PRCDRYH(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIDRYH(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSDRYH(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRDRYH(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGDRYH(JL) + PRDRYHG(JL)
+ PA_RH(JL) = PA_RH(JL) + PRCDRYH(JL)+PRIDRYH(JL)+PRSDRYH(JL)+&
+ &PRRDRYH(JL)+PRGDRYH(JL) - PRDRYHG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCDRYH(JL)+PRRDRYH(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 7.5 Melting of the hailstones
!
-GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRHMLTR(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRHMLTR(JL)=ZMASK(JL)*PRHMLTR(JL)
+ ENDDO
ELSE
- PRHMLTR(:) = 0.0
- WHERE(GMASK(:))
- PRHMLTR(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- END WHERE
+ DO JL=1, KSIZE
+ PRHMLTR(JL) = ZMASK(JL)* PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRHMLTR(:)=MIN(PRHMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
END WHERE
ENDIF
- WHERE(GMASK(:))
- PRHMLTR(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-PRHMLTR(:))/(XRV*PT(:)) )
- END WHERE
- WHERE(GMASK(:))
+ DO JL=1, KSIZE
+ PRHMLTR(JL) = ZMASK(JL)* (PKA(JL)*(XTT-PT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ *(XESTT-PRHMLTR(JL))/(XRV*PT(JL)) ))
+ ENDDO
+ WHERE(ZMASK(:)==1.)
!
! compute RHMLTR
!
@@ -539,9 +583,11 @@ ELSE
( PRHODREF(:)*XLMTT ) )
END WHERE
END IF
-PA_RR(:) = PA_RR(:) + PRHMLTR(:)
-PA_RH(:) = PA_RH(:) - PRHMLTR(:)
-PA_TH(:) = PA_TH(:) - PRHMLTR(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PA_RR(JL) = PA_RR(JL) + PRHMLTR(JL)
+ PA_RH(JL) = PA_RH(JL) - PRHMLTR(JL)
+ PA_TH(JL) = PA_TH(JL) - PRHMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
END SUBROUTINE ICE4_FAST_RH
diff --git a/src/MNH/ice4_fast_ri.f90 b/src/MNH/ice4_fast_ri.f90
index 1a067377ad55f460c21fef8505000201342af8de..bbe45f579d904a4eb0ec8bba282b81fe8835501d 100644
--- a/src/MNH/ice4_fast_ri.f90
+++ b/src/MNH/ice4_fast_ri.f90
@@ -1,11 +1,11 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
!-------------------------------------------------------------------------------
MODULE MODI_ICE4_FAST_RI
INTERFACE
-SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&PAI, PCJ, PCIT, &
&PSSI, &
@@ -25,7 +25,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -42,7 +42,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
END SUBROUTINE ICE4_FAST_RI
END INTERFACE
END MODULE MODI_ICE4_FAST_RI
-SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RI(KSIZE, LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&PAI, PCJ, PCIT, &
&PSSI, &
@@ -74,7 +74,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -91,7 +91,8 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RI
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMASK
+REAL, DIMENSION(KSIZE) :: ZMASK
+INTEGER :: JL
!
!-------------------------------------------------------------------------------
!
@@ -99,23 +100,30 @@ LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMASK
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
-GMASK(:)=PSSI(:)>0. .AND. PRCT(:)>XRTMIN(2) .AND. PRIT(:)>XRTMIN(4) .AND. &
- &PCIT(:)>0. .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., -PSSI(JL))) * & ! PSSI(:)>0.
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., 1.E-20-PCIT(JL))) * & ! PCIT(:)>0.
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCBERI(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRCBERI(JL) = PRCBERI(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRCBERI(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRCBERI(:) = MIN(1.E8, XLBI*(PRHODREF(:)*PRIT(:)/PCIT(:))**XLBEXI) ! Lbda_i
PRCBERI(:) = ( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * &
( X0DEPI/PRCBERI(:) + X2DEPI*PCJ(:)*PCJ(:)/PRCBERI(:)**(XDI+2.0) )
END WHERE
ENDIF
-PA_RC(:) = PA_RC(:) - PRCBERI(:)
-PA_RI(:) = PA_RI(:) + PRCBERI(:)
-PA_TH(:) = PA_TH(:) + PRCBERI(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PA_RC(JL) = PA_RC(JL) - PRCBERI(JL)
+ PA_RI(JL) = PA_RI(JL) + PRCBERI(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCBERI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
END SUBROUTINE ICE4_FAST_RI
diff --git a/src/MNH/ice4_fast_rs.f90 b/src/MNH/ice4_fast_rs.f90
index b4cf9bd3b266d1440441dc48491d8c41d1bff625..6d71c7b61b8188969aa488a3b22d65ad15d7cc26 100644
--- a/src/MNH/ice4_fast_rs.f90
+++ b/src/MNH/ice4_fast_rs.f90
@@ -1,11 +1,11 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
!-----------------------------------------------------------------
MODULE MODI_ICE4_FAST_RS
INTERFACE
-SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAR, PLBDAS, &
@@ -19,7 +19,7 @@ SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, &
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -43,7 +43,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG ! Rain accretion onto th
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG ! Rain accretion onto the aggregates
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -52,7 +52,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
END SUBROUTINE ICE4_FAST_RS
END INTERFACE
END MODULE MODI_ICE4_FAST_RS
-SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAR, PLBDAS, &
@@ -82,7 +82,8 @@ SUBROUTINE ICE4_FAST_RS(KSIZE, LDSOFT, LDCOMPUTE, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XCI,XCL,XCPV,XESTT,XGAMI,XGAMW,XLMTT,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XCI,XCL,XCPV,XESTT,XGAMI,XGAMW,XLMTT,XLVTT,XMD,XMV,XRV,XTT, &
+ XEPSILO
USE MODD_PARAM_ICE, ONLY: LEVLIMIT, CSNOWRIMING
USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXS,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: NACCLBDAR,NACCLBDAS,NGAMINC,X0DEPS,X1DEPS,XACCINTP1R,XACCINTP1S,XACCINTP2R,XACCINTP2S, &
@@ -97,7 +98,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT
@@ -121,7 +122,7 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRACCSG ! Rain accretion onto th
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRSACCRG ! Rain accretion onto the aggregates
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRSMLTG ! Conversion-Melting of the aggregates
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCMLTSR ! Cloud droplet collection onto aggregates by positive temperature
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND ! Individual tendencies
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
@@ -130,50 +131,68 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
!
!* 0.2 declaration of local variables
!
-INTEGER, PARAMETER :: IRCRIMS=1, IRCRIMSS=2, IRSRIMCG=3, IRRACCS=4, IRRACCSS=5, IRSACCRG=6
+INTEGER, PARAMETER :: IRCRIMS=1, IRCRIMSS=2, IRSRIMCG=3, IRRACCS=4, IRRACCSS=5, IRSACCRG=6, &
+ & IFREEZ1=7, IFREEZ2=8
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GRIM, GACC, GMASK
+REAL, DIMENSION(KSIZE) :: ZRIM, ZACC, ZMASK
+LOGICAL, DIMENSION(KSIZE) :: GRIM, GACC
INTEGER :: IGRIM, IGACC
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: I1
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE
-INTEGER :: JJ
+INTEGER, DIMENSION(KSIZE) :: I1
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2, ZVEC3
+INTEGER, DIMENSION(KSIZE) :: IVEC1, IVEC2
+REAL, DIMENSION(KSIZE) :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE
+INTEGER :: JJ, JL
!-------------------------------------------------------------------------------
!
!
!* 5.0 maximum freezing rate
!
-ZFREEZ_RATE(:)=0.
-GMASK(:)=PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:)
-WHERE(GMASK(:))
- ZFREEZ_RATE(:)=PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
-END WHERE
-IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
- ZFREEZ_RATE(:)=MIN(ZFREEZ_RATE(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRS_TEND(JL, IFREEZ1)
+ PRS_TEND(JL, IFREEZ2)=ZMASK(JL) * PRS_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZMASK(:)==1.)
+ PRS_TEND(:, IFREEZ1)=MIN(PRS_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ END WHERE
+ ENDIF
+ PRS_TEND(:, IFREEZ2)=0.
+ WHERE(ZMASK(:)==1.)
+ PRS_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRS_TEND(:, IFREEZ1))/(XRV*PT(:)) )
+ PRS_TEND(:, IFREEZ1)=PRS_TEND(:, IFREEZ1)* ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
+ X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )/ &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRS_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
END WHERE
ENDIF
-WHERE(GMASK(:))
- ZFREEZ_RATE(:)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-ZFREEZ_RATE(:))/(XRV*PT(:)) )
- ZFREEZ_RATE(:)=MAX(0., &
- (ZFREEZ_RATE(:) * ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
- X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) + &
- PRIAGGS(:) * &
- (PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) )
+DO JL=1, KSIZE
!We must agregate, at least, the cold species
!And we are only interested by the freezing rate of liquid species
- ZFREEZ_RATE(:)=MAX(ZFREEZ_RATE(:)-PRIAGGS(:), 0.)
-END WHERE
+ ZFREEZ_RATE(JL)=ZMASK(JL) * MAX(0., MAX(0., PRS_TEND(JL, IFREEZ1) + &
+ &PRS_TEND(JL, IFREEZ2) * PRIAGGS(JL)) - &
+ PRIAGGS(JL))
+ENDDO
!
!* 5.1 cloud droplet riming of the aggregates
!
IGRIM = 0
DO JJ = 1, SIZE(GRIM)
- IF (PRCT(JJ)>XRTMIN(2) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
+ ZRIM(JJ)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JJ))) * & !WHERE(PRCT(:)>XRTMIN(2))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (ZRIM(JJ)>0) THEN
IGRIM = IGRIM + 1
I1(IGRIM) = JJ
GRIM(JJ) = .TRUE.
@@ -184,11 +203,11 @@ END DO
!
! Collection of cloud droplets by snow: this rate is used for riming (T<0) and for conversion/melting (T>0)
IF(LDSOFT) THEN
- WHERE(.NOT. GRIM(:))
- PRS_TEND(:, IRCRIMS)=0.
- PRS_TEND(:, IRCRIMSS)=0.
- PRS_TEND(:, IRSRIMCG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IRCRIMS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMS)
+ PRS_TEND(JL, IRCRIMSS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMSS)
+ PRS_TEND(JL, IRSRIMCG)=ZRIM(JL) * PRS_TEND(JL, IRSRIMCG)
+ ENDDO
ELSE
PRS_TEND(:, IRCRIMS)=0.
PRS_TEND(:, IRCRIMSS)=0.
@@ -272,35 +291,37 @@ ELSE
ENDIF
ENDIF
!
-GRIM(:) = GRIM(:) .AND. PT(:)<XTT ! More restrictive GRIM mask to be used for riming by negative temperature only
-PRCRIMSS(:)=0.
-PRCRIMSG(:)=0.
-PRSRIMCG(:)=0.
-WHERE(GRIM(:))
- PRCRIMSS(:) = MIN(ZFREEZ_RATE(:), PRS_TEND(:, IRCRIMSS))
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRCRIMSS(:))
- ZZW(:) = MIN(1., ZFREEZ_RATE(:) / MAX(1.E-20, PRS_TEND(:, IRCRIMS) - PRCRIMSS(:))) ! proportion we are able to freeze
- PRCRIMSG(:) = ZZW(:) * MAX(0., PRS_TEND(:, IRCRIMS) - PRCRIMSS(:)) ! RCRIMSG
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRCRIMSG(:))
- PRSRIMCG(:) = ZZW(:) * PRS_TEND(:, IRSRIMCG)
-END WHERE
-WHERE(PRCRIMSG(:)<=0.)
- PRCRIMSG(:)=0.
- PRSRIMCG(:)=0.
-END WHERE
-PA_RC(:) = PA_RC(:) - PRCRIMSS(:)
-PA_RS(:) = PA_RS(:) + PRCRIMSS(:)
-PA_TH(:) = PA_TH(:) + PRCRIMSS(:)*(PLSFACT(:)-PLVFACT(:))
-PA_RC(:) = PA_RC(:) - PRCRIMSG(:)
-PA_RS(:) = PA_RS(:) - PRSRIMCG(:)
-PA_RG(:) = PA_RG(:) + PRCRIMSG(:)+PRSRIMCG(:)
-PA_TH(:) = PA_TH(:) + PRCRIMSG(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ ! More restrictive RIM mask to be used for riming by negative temperature only
+ ZRIM(JL)=ZRIM(JL) * &
+ &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ PRCRIMSS(JL)=ZRIM(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRCRIMSS))
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSS(JL))
+ ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL))) ! proportion we are able to freeze
+ PRCRIMSG(JL) = ZRIM(JL) * ZZW(JL) * MAX(0., PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL)) ! RCRIMSG
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSG(JL))
+ PRSRIMCG(JL) = ZRIM(JL) * ZZW(JL) * PRS_TEND(JL, IRSRIMCG)
+
+ PRSRIMCG(JL) = PRSRIMCG(JL) * MAX(0., -SIGN(1., -PRCRIMSG(JL)))
+ PRCRIMSG(JL)=MAX(0., PRCRIMSG(JL))
+
+ PA_RC(JL) = PA_RC(JL) - PRCRIMSS(JL)
+ PA_RS(JL) = PA_RS(JL) + PRCRIMSS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCRIMSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RC(JL) = PA_RC(JL) - PRCRIMSG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSRIMCG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCRIMSG(JL)+PRSRIMCG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCRIMSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 5.2 rain accretion onto the aggregates
!
IGACC = 0
DO JJ = 1, SIZE(GACC)
- IF (PRRT(JJ)>XRTMIN(3) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
+ ZACC(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & !WHERE(PRRT(:)>XRTMIN(3))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (ZACC(JJ)>0) THEN
IGACC = IGACC + 1
I1(IGACC) = JJ
GACC(JJ) = .TRUE.
@@ -310,11 +331,11 @@ DO JJ = 1, SIZE(GACC)
END DO
IF(LDSOFT) THEN
- WHERE(.NOT. GACC(:))
- PRS_TEND(:, IRRACCS)=0.
- PRS_TEND(:, IRRACCSS)=0.
- PRS_TEND(:, IRSACCRG)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRS_TEND(JL, IRRACCS)=ZACC(JL) * PRS_TEND(JL, IRRACCS)
+ PRS_TEND(JL, IRRACCSS)=ZACC(JL) * PRS_TEND(JL, IRRACCSS)
+ PRS_TEND(JL, IRSACCRG)=ZACC(JL) * PRS_TEND(JL, IRSACCRG)
+ ENDDO
ELSE
PRS_TEND(:, IRRACCS)=0.
PRS_TEND(:, IRRACCSS)=0.
@@ -417,54 +438,60 @@ ELSE
ENDIF
ENDIF
!
-GACC(:) = GACC(:) .AND. PT(:)<XTT ! More restrictive GACC mask to be used for accretion by negative temperature only
-PRRACCSS(:)=0.
-PRRACCSG(:)=0.
-PRSACCRG(:)=0.
-WHERE(GACC(:))
- PRRACCSS(:) = MIN(ZFREEZ_RATE(:), PRS_TEND(:, IRRACCSS))
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRRACCSS(:))
- ZZW(:) = MIN(1., ZFREEZ_RATE(:) / MAX(1.E-20, PRS_TEND(:, IRRACCS)-PRRACCSS(:))) ! proportion we are able to freeze
- PRRACCSG(:)=ZZW(:) * MAX(0., PRS_TEND(:, IRRACCS)-PRRACCSS(:))
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRRACCSG(:))
- PRSACCRG(:)=ZZW(:) * PRS_TEND(:, IRSACCRG)
-END WHERE
-WHERE(PRRACCSG(:)<=0.)
- PRRACCSG(:)=0.
- PRSACCRG(:)=0.
-END WHERE
-PA_RR(:) = PA_RR(:) - PRRACCSS(:)
-PA_RS(:) = PA_RS(:) + PRRACCSS(:)
-PA_TH(:) = PA_TH(:) + PRRACCSS(:)*(PLSFACT(:)-PLVFACT(:))
-PA_RR(:) = PA_RR(:) - PRRACCSG(:)
-PA_RS(:) = PA_RS(:) - PRSACCRG(:)
-PA_RG(:) = PA_RG(:) + PRRACCSG(:)+PRSACCRG(:)
-PA_TH(:) = PA_TH(:) + PRRACCSG(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ ! More restrictive ACC mask to be used for accretion by negative temperature only
+ ZACC(JL) = ZACC(JL) * &
+ &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ PRRACCSS(JL)=ZACC(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRRACCSS))
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRRACCSS(JL))
+ ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))) ! proportion we are able to freeze
+ PRRACCSG(JL)=ZACC(JL)*ZZW(JL) * MAX(0., PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))
+ ZFREEZ_RATE(JL) = MAX(0., ZFREEZ_RATE(JL)-PRRACCSG(JL))
+ PRSACCRG(JL)=ZACC(JL)*ZZW(JL) * PRS_TEND(JL, IRSACCRG)
+
+ PRSACCRG(JL) = PRSACCRG(JL) * MAX(0., -SIGN(1., -PRRACCSG(JL)))
+ PRRACCSG(JL)=MAX(0., PRRACCSG(JL))
+
+ PA_RR(JL) = PA_RR(JL) - PRRACCSS(JL)
+ PA_RS(JL) = PA_RS(JL) + PRRACCSS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRRACCSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RR(JL) = PA_RR(JL) - PRRACCSG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSACCRG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRRACCSG(JL)+PRSACCRG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRRACCSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
!* 5.3 Conversion-Melting of the aggregates
!
-GMASK(:)=PRST(:)>XRTMIN(5) .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRSMLTG(:) = 0.
- PRCMLTSR(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRSMLTG(JL)=ZMASK(JL)*PRSMLTG(JL)
+ PRCMLTSR(JL)=ZMASK(JL)*PRCMLTSR(JL)
+ ENDDO
ELSE
- PRSMLTG(:) = 0.
- PRCMLTSR(:) = 0.
- WHERE(GMASK(:))
- PRSMLTG(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- END WHERE
+ DO JL=1, KSIZE
+ PRSMLTG(JL)=ZMASK(JL)*PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRSMLTG(:)=MIN(PRSMLTG(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
END WHERE
ENDIF
- WHERE(GMASK(:))
- PRSMLTG(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-PRSMLTG(:))/(XRV*PT(:)) )
+ DO JL=1, KSIZE
+ PRSMLTG(JL)=ZMASK(JL)*( &
+ & PKA(JL)*(XTT-PT(JL)) + &
+ & ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ & *(XESTT-PRSMLTG(JL))/(XRV*PT(JL)) ) &
+ &)
+ ENDDO
+ PRCMLTSR(:) = 0.
+ WHERE(ZMASK(:)==1.)
!
! compute RSMLT
!
@@ -474,21 +501,21 @@ ELSE
( PRS_TEND(:, IRCRIMS) + PRS_TEND(:, IRRACCS) ) * &
( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
( PRHODREF(:)*XLMTT ) )
- !
- ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
- ! because the graupeln produced by this process are still icy!!!
- !
! When T < XTT, rc is collected by snow (riming) to produce snow and graupel
! When T > XTT, if riming was still enabled, rc would produce snow and graupel with snow becomming graupel (conversion/melting) and graupel becomming rain (melting)
- ! To insure consistency when crossint T=XTT, rc collected with T>XTT must be transformed in rain.
+ ! To insure consistency when crossing T=XTT, rc collected with T>XTT must be transformed in rain.
! rc cannot produce iced species with a positive temperature but is still collected with a good efficiency by snow
PRCMLTSR(:) = PRS_TEND(:, IRCRIMS) ! both species are liquid, no heat is exchanged
END WHERE
ENDIF
-PA_RS(:) = PA_RS(:) - PRSMLTG(:)
-PA_RG(:) = PA_RG(:) + PRSMLTG(:)
-PA_RC(:) = PA_RC(:) - PRCMLTSR(:)
-PA_RR(:) = PA_RR(:) + PRCMLTSR(:)
+DO JL=1, KSIZE
+ ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
+ ! because the graupeln produced by this process are still icy!!!
+ PA_RS(JL) = PA_RS(JL) - PRSMLTG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRSMLTG(JL)
+ PA_RC(JL) = PA_RC(JL) - PRCMLTSR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCMLTSR(JL)
+ENDDO
!
END SUBROUTINE ICE4_FAST_RS
diff --git a/src/MNH/ice4_nucleation.f90 b/src/MNH/ice4_nucleation.f90
index 549736b05968f9fe04711ba19eebd7b631adbff2..98459b317087abc474b33d03a27b19c72245a490 100644
--- a/src/MNH/ice4_nucleation.f90
+++ b/src/MNH/ice4_nucleation.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
+!-----------------------------------------------------------------
MODULE MODI_ICE4_NUCLEATION
INTERFACE
SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
@@ -48,7 +49,7 @@ SUBROUTINE ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMI,XGAMW,XMD,XMV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMI,XGAMW,XMD,XMV,XTT,XEPSILO
USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1,XALPHA2,XBETA1,XBETA2,XMNU0,XNU10,XNU20
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
@@ -99,7 +100,7 @@ IF(.NOT. ODSOFT) THEN
END WHERE
WHERE(GNEGT(:))
ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
- ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / ((XMV/XMD)*ZZW(:)) - 1.0
+ ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (XEPSILO*ZZW(:)) - 1.0
! Supersaturation over ice
ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
diff --git a/src/MNH/ice4_nucleation_wrapper.f90 b/src/MNH/ice4_nucleation_wrapper.f90
index 6bd37bd55fb170e8fafd56d08bdaf7c46f7ff18c..2e08a2cd779c2e1088d4e23fdf7fec12017c684f 100644
--- a/src/MNH/ice4_nucleation_wrapper.f90
+++ b/src/MNH/ice4_nucleation_wrapper.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -112,10 +112,6 @@ ALLOCATE(ZB_TH(INEGT))
ALLOCATE(ZB_RV(INEGT))
ALLOCATE(ZB_RI(INEGT))
!
-ZB_TH(:) = 0.
-ZB_RV(:) = 0.
-ZB_RI(:) = 0.
-!
IF(INEGT>0) INEGT_TMP=COUNTJV(GNEGT(:,:,:), I1(:), I2(:), I3(:))
!
PRVHENI_MR(:,:,:)=0.
@@ -132,6 +128,9 @@ IF(INEGT>0) THEN
ENDDO
GDSOFT = .FALSE.
GLDCOMPUTE(:) = ZZT(:)<XTT
+ ZB_TH(:) = 0.
+ ZB_RV(:) = 0.
+ ZB_RI(:) = 0.
CALL ICE4_NUCLEATION(INEGT, GDSOFT, GLDCOMPUTE, &
ZTHT, ZPRES, ZRHODREF, ZEXN, ZLSFACT, ZZT, &
ZRVT, &
diff --git a/src/MNH/ice4_rainfr_vert.f90 b/src/MNH/ice4_rainfr_vert.f90
index a048fc341249d8ccc9aa2f4ac580549d2614af2f..6e817fe769601c4347a4e5fecc692bfe0ba17cc3 100644
--- a/src/MNH/ice4_rainfr_vert.f90
+++ b/src/MNH/ice4_rainfr_vert.f90
@@ -1,18 +1,22 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
+!-----------------------------------------------------------------
MODULE MODI_ICE4_RAINFR_VERT
INTERFACE
-SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR)
+SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR, PRS, PRG, PRH)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRR !Rain field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRS !Snow field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRG !Graupel field
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL,INTENT(IN) :: PRH !Hail field
END SUBROUTINE ICE4_RAINFR_VERT
END INTERFACE
END MODULE MODI_ICE4_RAINFR_VERT
-SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR)
+SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR, PRS, PRG, PRH)
!!
!!** PURPOSE
!! -------
@@ -40,10 +44,14 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PPRFR !Precipitation fraction
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRR !Rain field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRS !Snow field
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRG !Graupel field
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRH !Hail field
!
!* 0.2 declaration of local variables
!
INTEGER :: JI, JJ, JK
+LOGICAL :: MASK
!
!-------------------------------------------------------------------------------
!
@@ -52,7 +60,14 @@ DO JI = KIB,KIE
DO JJ = KJB, KJE
PPRFR(JI,JJ,KKE)=0.
DO JK=KKE-KKL, KKB, -KKL
- IF (PRR(JI,JJ,JK) .GT. XRTMIN(3)) THEN
+ IF(PRESENT(PRH)) THEN
+ MASK=PRR(JI,JJ,JK) .GT. XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. XRTMIN(5) &
+ .OR. PRG(JI,JJ,JK) .GT. XRTMIN(6) .OR. PRH(JI,JJ,JK) .GT. XRTMIN(7)
+ ELSE
+ MASK=PRR(JI,JJ,JK) .GT. XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. XRTMIN(5) &
+ .OR. PRG(JI,JJ,JK) .GT. XRTMIN(6)
+ END IF
+ IF (MASK) THEN
PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+KKL))
IF (PPRFR(JI,JJ,JK)==0) THEN
PPRFR(JI,JJ,JK)=1.
diff --git a/src/MNH/ice4_rimltc.f90 b/src/MNH/ice4_rimltc.f90
index 6b63a46f5da20ab01750461e2145646345529c90..fc4e129862254befe7e652f40780aedbee481759 100644
--- a/src/MNH/ice4_rimltc.f90
+++ b/src/MNH/ice4_rimltc.f90
@@ -1,10 +1,11 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
+!-----------------------------------------------------------------
MODULE MODI_ICE4_RIMLTC
INTERFACE
-SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, &
&PTHT, PRIT, &
@@ -12,7 +13,7 @@ SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, LDCOMPUTE, &
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -26,7 +27,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
END SUBROUTINE ICE4_RIMLTC
END INTERFACE
END MODULE MODI_ICE4_RIMLTC
-SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, &
&PTHT, PRIT, &
@@ -57,7 +58,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -71,7 +72,8 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RI
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(KSIZE) :: GMASK
+REAL, DIMENSION(KSIZE) :: ZMASK
+INTEGER :: JL
!
!-------------------------------------------------------------------------------
!
@@ -79,21 +81,25 @@ LOGICAL, DIMENSION(KSIZE) :: GMASK
!
PRIMLTC_MR(:)=0.
IF(.NOT. LDSOFT) THEN
- GMASK(:)=PRIT(:)>0. .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
- WHERE(GMASK(:))
- PRIMLTC_MR(:)=PRIT(:)
- END WHERE
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., -PRIT(JL))) * & ! PRIT(:)>0.
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! PT(:)>XTT
+ &PCOMPUTE(JL)
+ PRIMLTC_MR(JL)=PRIT(JL) * ZMASK(JL)
+ ENDDO
IF(LFEEDBACKT) THEN
!Limitation due to 0 crossing of temperature
- WHERE(GMASK(:))
- PRIMLTC_MR(:)=MIN(PRIMLTC_MR(:), MAX(0., (PTHT(:)-XTT/PEXN(:)) / (PLSFACT(:)-PLVFACT(:))))
- END WHERE
+ DO JL=1, KSIZE
+ PRIMLTC_MR(JL)=MIN(PRIMLTC_MR(JL), MAX(0., (PTHT(JL)-XTT/PEXN(JL)) / (PLSFACT(JL)-PLVFACT(JL))))
+ ENDDO
ENDIF
ENDIF
-PB_RC(:) = PB_RC(:) + PRIMLTC_MR(:)
-PB_RI(:) = PB_RI(:) - PRIMLTC_MR(:)
-PB_TH(:) = PB_TH(:) - PRIMLTC_MR(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PB_RC(JL) = PB_RC(JL) + PRIMLTC_MR(JL)
+ PB_RI(JL) = PB_RI(JL) - PRIMLTC_MR(JL)
+ PB_TH(JL) = PB_TH(JL) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
END SUBROUTINE ICE4_RIMLTC
diff --git a/src/MNH/ice4_rrhong.f90 b/src/MNH/ice4_rrhong.f90
index 08d296a4d40e86c1933a48b3235610865159739b..da26489475b841ca17b8fcd1d286bacc4aeafd38 100644
--- a/src/MNH/ice4_rrhong.f90
+++ b/src/MNH/ice4_rrhong.f90
@@ -1,10 +1,11 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
+!-----------------------------------------------------------------
MODULE MODI_ICE4_RRHONG
INTERFACE
-SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, PRRT, &
&PTHT, &
@@ -12,7 +13,7 @@ SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, LDCOMPUTE, &
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -26,7 +27,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
END SUBROUTINE ICE4_RRHONG
END INTERFACE
END MODULE MODI_ICE4_RRHONG
-SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, PRRT, &
&PTHT, &
@@ -58,7 +59,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE),INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -72,7 +73,8 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(SIZE(PRRT)) :: GMASK
+REAL, DIMENSION(KSIZE) :: ZMASK
+INTEGER :: JL
!
!-------------------------------------------------------------------------------
!
@@ -80,20 +82,24 @@ LOGICAL, DIMENSION(SIZE(PRRT)) :: GMASK
!
PRRHONG_MR(:) = 0.
IF(.NOT. LDSOFT) THEN
- GMASK(:)=PT(:)<XTT-35.0 .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
- WHERE(GMASK(:))
- PRRHONG_MR(:) = PRRT(:)
- ENDWHERE
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ PRRHONG_MR(JL)=PRRT(JL) * ZMASK(JL)
+ ENDDO
IF(LFEEDBACKT) THEN
!Limitation due to -35 crossing of temperature
- WHERE(GMASK(:))
- PRRHONG_MR(:)=MIN(PRRHONG_MR(:), MAX(0., ((XTT-35.)/PEXN(:)-PTHT)/(PLSFACT(:)-PLVFACT(:))))
- ENDWHERE
+ DO JL=1, KSIZE
+ PRRHONG_MR(JL)=MIN(PRRHONG_MR(JL), MAX(0., ((XTT-35.)/PEXN(JL)-PTHT(JL))/(PLSFACT(JL)-PLVFACT(JL))))
+ ENDDO
ENDIF
ENDIF
-PB_RG(:) = PB_RG(:) + PRRHONG_MR(:)
-PB_RR(:) = PB_RR(:) - PRRHONG_MR(:)
-PB_TH(:) = PB_TH(:) + PRRHONG_MR(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PB_RG(JL) = PB_RG(JL) + PRRHONG_MR(JL)
+ PB_RR(JL) = PB_RR(JL) - PRRHONG_MR(JL)
+ PB_TH(JL) = PB_TH(JL) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
END SUBROUTINE ICE4_RRHONG
diff --git a/src/MNH/ice4_rsrimcg_old.f90 b/src/MNH/ice4_rsrimcg_old.f90
index 01f8f03101f425db59b7c74a7418595e24b03b01..cf88792b1b42827bdce381c4e2ad5644b3fed376 100644
--- a/src/MNH/ice4_rsrimcg_old.f90
+++ b/src/MNH/ice4_rsrimcg_old.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -72,11 +72,11 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PB_RG
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GRIM, GACC, GMASK
-INTEGER :: IGRIM, IGACC
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZVEC1, ZVEC2, ZVEC3
-INTEGER, DIMENSION(SIZE(PRHODREF)) :: IVEC1, IVEC2
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZW6
+LOGICAL, DIMENSION(KSIZE) :: GRIM
+INTEGER :: IGRIM
+REAL, DIMENSION(KSIZE) :: ZVEC1, ZVEC2
+INTEGER, DIMENSION(KSIZE) :: IVEC2, IVEC1
+REAL, DIMENSION(KSIZE) :: ZZW
INTEGER :: JL
!-------------------------------------------------------------------------------
!
@@ -98,7 +98,7 @@ IF(.NOT. ODSOFT) THEN
END IF
END DO
!
- IF(IGRIM>0 .AND. CSNOWRIMING=='OLD ') THEN
+ IF(IGRIM>0) THEN
!
! 5.1.1 select the PLBDAS
!
@@ -133,8 +133,8 @@ IF(.NOT. ODSOFT) THEN
WHERE(GRIM(:))
PRSRIMCG_MR(:) = XSRIMCG * PLBDAS(:)**XEXSRIMCG & ! RSRIMCG
* (1.0 - ZZW(:) )/PRHODREF(:)
+ PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:))
END WHERE
- PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:))
END IF
ENDIF
PB_RS(:) = PB_RS(:) - PRSRIMCG_MR(:)
diff --git a/src/MNH/ice4_sedimentation_stat.f90 b/src/MNH/ice4_sedimentation_stat.f90
index b25b5a90fb8b0dc24e3d205f5f14d5a8205e14f1..3cbb31493eac8295e718f2e1438e4e3a269520e7 100644
--- a/src/MNH/ice4_sedimentation_stat.f90
+++ b/src/MNH/ice4_sedimentation_stat.f90
@@ -36,8 +36,8 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregat
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
@@ -110,8 +110,8 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregat
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC ! Cloud instant precip
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR ! Rain instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRI ! Pristine ice instant precip
REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS ! Snow instant precip
diff --git a/src/MNH/ice4_slow.f90 b/src/MNH/ice4_slow.f90
index f264b0b6fed783dbfdcaf60bdb3bc0cee20b40d1..15d0cd78e495cb255015fb6ed29fbfdb5361c748 100644
--- a/src/MNH/ice4_slow.f90
+++ b/src/MNH/ice4_slow.f90
@@ -1,20 +1,21 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
+!-----------------------------------------------------------------
MODULE MODI_ICE4_SLOW
INTERFACE
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, PT,&
+SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT,&
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT,&
&PLBDAS, PLBDAG,&
- &PAI, PCJ,&
+ &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
@@ -29,6 +30,8 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
@@ -43,11 +46,11 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
END SUBROUTINE ICE4_SLOW
END INTERFACE
END MODULE MODI_ICE4_SLOW
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, LDCOMPUTE, PRHODREF, PT, &
+SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT, &
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT, &
&PLBDAS, PLBDAG, &
- &PAI, PCJ, &
+ &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
!!
@@ -78,7 +81,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(KSIZE), INTENT(IN) :: PSSI ! Supersaturation over ice
@@ -93,6 +96,8 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAS ! Slope parameter of the
REAL, DIMENSION(KSIZE), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
REAL, DIMENSION(KSIZE), INTENT(IN) :: PAI ! Thermodynamical function
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HCF !
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PHLI_HRI !
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
@@ -107,9 +112,10 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMASK
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZCRIAUTI
-REAL :: ZTIMAUTIC
+REAL, DIMENSION(KSIZE) :: ZCRIAUTI, ZMASK
+REAL :: ZTIMAUTIC
+INTEGER :: JL
+!-------------------------------------------------------------------------------
!
!
!-------------------------------------------------------------------------------
@@ -117,21 +123,27 @@ REAL :: ZTIMAUTIC
!
!* 3.2 compute the homogeneous nucleation source: RCHONI
!
-GMASK(:)=PT(:)<XTT-35.0 .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCHONI(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRCHONI(JL) = PRCHONI(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRCHONI(:) = 0.
- WHERE(GMASK(:))
- PRCHONI(:) = XHON*PRHODREF(:)*PRCT(:) &
- *EXP( XALPHA3*(PT(:)-XTT)-XBETA3 )
+ WHERE(ZMASK(:)==1.)
+ PRCHONI(:) = MIN(1000.,XHON*PRHODREF(:)*PRCT(:) &
+ *EXP( XALPHA3*(PT(:)-XTT)-XBETA3 ))
ENDWHERE
ENDIF
-PA_RI(:) = PA_RI(:) + PRCHONI(:)
-PA_RC(:) = PA_RC(:) - PRCHONI(:)
-PA_TH(:) = PA_TH(:) + PRCHONI(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, KSIZE
+ PA_RI(JL) = PA_RI(JL) + PRCHONI(JL)
+ PA_RC(JL) = PA_RC(JL) - PRCHONI(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCHONI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 3.4 compute the deposition, aggregation and autoconversion sources
!
@@ -149,78 +161,103 @@ PA_TH(:) = PA_TH(:) + PRCHONI(:)*(PLSFACT(:)-PLVFACT(:))
!
!* 3.4.3 compute the deposition on r_s: RVDEPS
!
-GMASK(:)=PRVT(:)>XRTMIN(1) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & !PRVT(:)>XRTMIN(1)
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & !PRST(:)>XRTMIN(5)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRVDEPS(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRVDEPS(JL)=PRVDEPS(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRVDEPS(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRVDEPS(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )
END WHERE
ENDIF
-PA_RS(:) = PA_RS(:) + PRVDEPS(:)
-PA_RV(:) = PA_RV(:) - PRVDEPS(:)
-PA_TH(:) = PA_TH(:) + PRVDEPS(:)*PLSFACT(:)
+DO JL=1, KSIZE
+ PA_RS(JL) = PA_RS(JL) + PRVDEPS(JL)
+ PA_RV(JL) = PA_RV(JL) - PRVDEPS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRVDEPS(JL)*PLSFACT(JL)
+ENDDO
!
!* 3.4.4 compute the aggregation on r_s: RIAGGS
!
-GMASK(:)=PRIT(:)>XRTMIN(4) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! PRST(:)>XRTMIN(5)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRIAGGS(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRIAGGS(JL)=PRIAGGS(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRIAGGS(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1)
PRIAGGS(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) &
* PRIT(:) &
* PLBDAS(:)**XEXIAGGS &
* PRHODREF(:)**(-XCEXVT)
END WHERE
ENDIF
-PA_RS(:) = PA_RS(:) + PRIAGGS(:)
-PA_RI(:) = PA_RI(:) - PRIAGGS(:)
+DO JL=1, KSIZE
+ PA_RS(JL) = PA_RS(JL) + PRIAGGS(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIAGGS(JL)
+ENDDO
!
!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
!
-GMASK(:)=PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PHLI_HRI(JL))) * & ! PHLI_HRI(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., 1.E-20-PHLI_HCF(JL))) * & ! PHLI_HCF(:) .GT. 0.
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRIAUTS(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRIAUTS(JL) = PRIAUTS(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRIAUTS(:) = 0.
!ZCRIAUTI(:)=MIN(XCRIAUTI,10**(0.06*(PT(:)-XTT)-3.5))
ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI))
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRIAUTS(:) = XTIMAUTI * EXP( XTEXAUTI*(PT(:)-XTT) ) &
- * MAX( PRIT(:)-ZCRIAUTI(:),0.0 )
+ * MAX( PHLI_HRI(:)/PHLI_HCF(:)-ZCRIAUTI(:),0.0 )
+ PRIAUTS(:) = PHLI_HCF(:)*PRIAUTS(:)
END WHERE
ENDIF
-PA_RS(:) = PA_RS(:) + PRIAUTS(:)
-PA_RI(:) = PA_RI(:) - PRIAUTS(:)
+DO JL=1, KSIZE
+ PA_RS(JL) = PA_RS(JL) + PRIAUTS(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIAUTS(JL)
+ENDDO
!
!* 3.4.6 compute the deposition on r_g: RVDEPG
!
!
-GMASK(:)=PRVT(:)>XRTMIN(1) .AND. PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & ! PRVT(:)>XRTMIN(1)
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! PRGT(:)>XRTMIN(6)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRVDEPG(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRVDEPG(JL) = PRVDEPG(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRVDEPG(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRVDEPG(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )
END WHERE
ENDIF
-PA_RG(:) = PA_RG(:) + PRVDEPG(:)
-PA_RV(:) = PA_RV(:) - PRVDEPG(:)
-PA_TH(:) = PA_TH(:) + PRVDEPG(:)*PLSFACT(:)
+DO JL=1, KSIZE
+ PA_RG(JL) = PA_RG(JL) + PRVDEPG(JL)
+ PA_RV(JL) = PA_RV(JL) - PRVDEPG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRVDEPG(JL)*PLSFACT(JL)
+ENDDO
!
!
END SUBROUTINE ICE4_SLOW
diff --git a/src/MNH/ice4_tendencies.f90 b/src/MNH/ice4_tendencies.f90
index 3259c42fede51028ca895f7a4986a9c6ed86635e..49cd599235d8a67c664bd2710e7864adc0a82123 100644
--- a/src/MNH/ice4_tendencies.f90
+++ b/src/MNH/ice4_tendencies.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -6,13 +6,14 @@
MODULE MODI_ICE4_TENDENCIES
INTERFACE
SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
- &KRR, ODSOFT, ODCOMPUTE, &
- &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, &
+ &KRR, ODSOFT, PCOMPUTE, &
+ &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PT, PTHT, &
- &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, PRRT3D, &
+ &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
&PRVHENI_MR, PRRHONG_MR, PRIMLTC_MR, PRSRIMCG_MR, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PRCAUTR, PRCACCR, PRREVAV, &
@@ -22,19 +23,21 @@ SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, K
&PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
&PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
&PRCBERI, &
- &PRS_TEND, PRG_TEND, PRH_TEND, &
+ &PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
&PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, &
&PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, &
- &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRAINFR)
+ &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ &PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRAINFR)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
INTEGER, INTENT(IN) :: KRR
LOGICAL, INTENT(IN) :: ODSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
LOGICAL, INTENT(IN) :: OWARM
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP
CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC
+CHARACTER(len=80), INTENT(IN) :: HSUBG_AUCV_RI
CHARACTER(len=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF
@@ -56,7 +59,6 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT3D
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR
@@ -104,9 +106,10 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PSSI
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RV
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RC
@@ -127,18 +130,23 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LRI
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction
END SUBROUTINE ICE4_TENDENCIES
END INTERFACE
END MODULE MODI_ICE4_TENDENCIES
SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
- &KRR, ODSOFT, ODCOMPUTE, &
- &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, &
+ &KRR, ODSOFT, PCOMPUTE, &
+ &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PT, PTHT, &
- &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, PRRT3D, &
+ &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
&PRVHENI_MR, PRRHONG_MR, PRIMLTC_MR, PRSRIMCG_MR, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PRCAUTR, PRCACCR, PRREVAV, &
@@ -148,10 +156,11 @@ SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, K
&PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
&PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
&PRCBERI, &
- &PRS_TEND, PRG_TEND, PRH_TEND, &
+ &PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
&PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, &
&PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, &
- &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRAINFR)
+ &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ &PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRAINFR)
!!
!!** PURPOSE
!! -------
@@ -170,7 +179,8 @@ SUBROUTINE ICE4_TENDENCIES(KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, K
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XBETAI,XCI,XCPV,XGAMI,XLSTT,XMD,XMV,XP00,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XBETAI,XCI,XCPV,XEPSILO,XGAMI,XLSTT,XMD,XMV,XP00,XRV,XTT
+USE MODD_PARAM_ICE, ONLY: CSNOWRIMING
USE MODD_RAIN_ICE_DESCR, ONLY: XLBDAS_MAX,XLBEXG,XLBEXH,XLBEXR,XLBEXS,XLBG,XLBH,XLBR,XLBS,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: XSCFAC
!
@@ -194,11 +204,12 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
INTEGER, INTENT(IN) :: KRR
LOGICAL, INTENT(IN) :: ODSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: ODCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
LOGICAL, INTENT(IN) :: OWARM
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP
CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC
+CHARACTER(len=80), INTENT(IN) :: HSUBG_AUCV_RI
CHARACTER(len=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PEXN
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF
@@ -209,6 +220,7 @@ INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K2
INTEGER, DIMENSION(KSIZE), INTENT(IN) :: K3
REAL, DIMENSION(KSIZE), INTENT(IN) :: PPRES
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCF
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PCIT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PTHT
@@ -219,8 +231,6 @@ REAL, DIMENSION(KSIZE), INTENT(IN) :: PRIT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRST
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRGT
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHT
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT3D
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PSIGMA_RC
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRVHENI_MR
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRRHONG_MR
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRIMLTC_MR
@@ -268,9 +278,10 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRGDRYH
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PRDRYHG
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRHMLTR
REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PRCBERI
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRS_TEND
-REAL, DIMENSION(KSIZE, 6), INTENT(INOUT) :: PRG_TEND
-REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRS_TEND
+REAL, DIMENSION(KSIZE, 8), INTENT(INOUT) :: PRG_TEND
+REAL, DIMENSION(KSIZE, 10), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PSSI
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_TH
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RV
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PA_RC
@@ -291,20 +302,24 @@ REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HCF
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LCF
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_HRC
REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLC_LRC
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LCF
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(KSIZE), INTENT(OUT) :: PHLI_LRI
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR ! Rain fraction
!
!* 0.2 declaration of local variables
!
REAL, DIMENSION(KSIZE) :: ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- & ZT, ZTHT, &
+ & ZT, ZTHT, ZRHT, &
& ZZW, &
- & ZSSI, ZKA, ZDV, ZAI, ZCJ, &
+ & ZKA, ZDV, ZAI, ZCJ, &
& ZRF, &
& ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZLBDAR_RF, &
& ZRGSI, ZRGSI_MR
-REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT3D
+REAL, DIMENSION(KIT,KJT,KKT) :: ZRRT3D, ZRST3D, ZRGT3D, ZRHT3D
INTEGER :: JL
-LOGICAL, DIMENSION(KSIZE) :: LLWETG
+REAL, DIMENSION(KSIZE) :: ZWETG ! 1. if graupel growths in wet mode, 0. otherwise
PA_TH(:)=0.
PA_RV(:)=0.
@@ -323,93 +338,134 @@ PB_RS(:)=0.
PB_RG(:)=0.
PB_RH(:)=0.
!
-ZRVT(:)=PRVT(:)
-ZRCT(:)=PRCT(:)
-ZRRT(:)=PRRT(:)
-ZRIT(:)=PRIT(:)
-ZRST(:)=PRST(:)
-ZRGT(:)=PRGT(:)
-ZTHT(:)=PTHT(:)
-ZT(:)=PT(:)
-!
-!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
-! --------------------------------------
-CALL ICE4_NUCLEATION(KSIZE, ODSOFT, ODCOMPUTE, &
- ZTHT, PPRES, PRHODREF, PEXN, PLSFACT, ZT, &
- ZRVT, &
- PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
-ZRIT(:)=ZRIT(:) + PRVHENI_MR(:)
-ZRVT(:)=ZRVT(:) - PRVHENI_MR(:)
-ZTHT(:)=ZTHT(:) + PRVHENI_MR(:)*PLSFACT(:)
-ZT(:) = ZTHT(:) * PEXN(:)
-!
-!* 3.3 compute the spontaneous freezing source: RRHONG
-!
-CALL ICE4_RRHONG(KSIZE, ODSOFT, ODCOMPUTE, &
- &PEXN, PLVFACT, PLSFACT, &
- &ZT, ZRRT, &
- &ZTHT, &
- &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
-ZRGT(:) = ZRGT(:) + PRRHONG_MR(:)
-ZRRT(:) = ZRRT(:) - PRRHONG_MR(:)
-ZTHT(:) = ZTHT(:) + PRRHONG_MR(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RRHONG))
-ZT(:) = ZTHT(:) * PEXN(:)
-!
-!* 7.1 cloud ice melting
-!
-CALL ICE4_RIMLTC(KSIZE, ODSOFT, ODCOMPUTE, &
- &PEXN, PLVFACT, PLSFACT, &
- &ZT, &
- &ZTHT, ZRIT, &
- &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
-ZRCT(:) = ZRCT(:) + PRIMLTC_MR(:)
-ZRIT(:) = ZRIT(:) - PRIMLTC_MR(:)
-ZTHT(:) = ZTHT(:) - PRIMLTC_MR(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RIMLTC))
-ZT(:) = ZTHT(:) * PEXN(:)
-!
-! 5.1.6 riming-conversion of the large sized aggregates into graupel (old parametrisation)
-!
-ZLBDAS(:)=0.
-WHERE(ZRST(:)>0.)
- ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS)
-END WHERE
-CALL ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, ODCOMPUTE, &
- &PRHODREF, &
- &ZLBDAS, &
- &ZT, ZRCT, ZRST, &
- &PRSRIMCG_MR, PB_RS, PB_RG)
-ZRST(:) = ZRST(:) - PRSRIMCG_MR(:)
-ZRGT(:) = ZRGT(:) + PRSRIMCG_MR(:)
+DO JL=1, KSIZE
+ ZRVT(JL)=PRVT(JL)
+ ZRCT(JL)=PRCT(JL)
+ ZRRT(JL)=PRRT(JL)
+ ZRIT(JL)=PRIT(JL)
+ ZRST(JL)=PRST(JL)
+ ZRGT(JL)=PRGT(JL)
+ ZTHT(JL)=PTHT(JL)
+ ZRHT(JL)=PRHT(JL)
+ ZT(JL)=PT(JL)
+ENDDO
+IF(ODSOFT) THEN
+ PRVHENI_MR(:)=0.
+ PRRHONG_MR(:)=0.
+ PRIMLTC_MR(:)=0.
+ PRSRIMCG_MR(:)=0.
+ELSE
+ !
+ !* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
+ ! --------------------------------------
+ CALL ICE4_NUCLEATION(KSIZE, ODSOFT, PCOMPUTE==1., &
+ ZTHT, PPRES, PRHODREF, PEXN, PLSFACT, ZT, &
+ ZRVT, &
+ PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
+ DO JL=1, KSIZE
+ ZRIT(JL)=ZRIT(JL) + PRVHENI_MR(JL)
+ ZRVT(JL)=ZRVT(JL) - PRVHENI_MR(JL)
+ ZTHT(JL)=ZTHT(JL) + PRVHENI_MR(JL)*PLSFACT(JL)
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
+ !
+ !* 3.3 compute the spontaneous freezing source: RRHONG
+ !
+ CALL ICE4_RRHONG(KSIZE, ODSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &ZT, ZRRT, &
+ &ZTHT, &
+ &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
+ DO JL=1, KSIZE
+ ZRGT(JL) = ZRGT(JL) + PRRHONG_MR(JL)
+ ZRRT(JL) = ZRRT(JL) - PRRHONG_MR(JL)
+ ZTHT(JL) = ZTHT(JL) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RRHONG))
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
+ !
+ !* 7.1 cloud ice melting
+ !
+ CALL ICE4_RIMLTC(KSIZE, ODSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &ZT, &
+ &ZTHT, ZRIT, &
+ &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
+ DO JL=1, KSIZE
+ ZRCT(JL) = ZRCT(JL) + PRIMLTC_MR(JL)
+ ZRIT(JL) = ZRIT(JL) - PRIMLTC_MR(JL)
+ ZTHT(JL) = ZTHT(JL) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RIMLTC))
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
+ !
+ ! 5.1.6 riming-conversion of the large sized aggregates into graupel (old parametrisation)
+ !
+ IF(CSNOWRIMING=='OLD ') THEN
+ ZLBDAS(:)=0.
+ WHERE(ZRST(:)>0.)
+ ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS)
+ END WHERE
+ CALL ICE4_RSRIMCG_OLD(KSIZE, ODSOFT, PCOMPUTE==1., &
+ &PRHODREF, &
+ &ZLBDAS, &
+ &ZT, ZRCT, ZRST, &
+ &PRSRIMCG_MR, PB_RS, PB_RG)
+ DO JL=1, KSIZE
+ ZRST(JL) = ZRST(JL) - PRSRIMCG_MR(JL)
+ ZRGT(JL) = ZRGT(JL) + PRSRIMCG_MR(JL)
+ ENDDO
+ ELSE
+ PRSRIMCG_MR(:) = 0.
+ ENDIF
+ENDIF
!
!* Derived fields
!
IF(KSIZE>0) THEN
- ZZW(:) = EXP(XALPI-XBETAI/ZT(:)-XGAMI*ALOG(ZT(:)))
- DO JL=1, KSIZE
- ZSSI(JL) = ZRVT(JL)*( PPRES(JL)-ZZW(JL) ) / ( (XMV/XMD) * ZZW(JL) ) - 1.0
- ! Supersaturation over ice
- ZKA(JL) = 2.38E-2 + 0.0071E-2*(ZT(JL)-XTT) ! k_a
- ZDV(JL) = 0.211E-4*(ZT(JL)/XTT)**1.94 * (XP00/PPRES(JL)) ! D_v
- ZAI(JL) = (XLSTT+(XCPV-XCI)*(ZT(JL)-XTT))**2 / (ZKA(JL)*XRV*ZT(JL)**2) &
- + ( XRV*ZT(JL) ) / (ZDV(JL)*ZZW(JL))
- ZCJ(JL) = XSCFAC*PRHODREF(JL)**0.3 / SQRT(1.718E-5+0.0049E-5*(ZT(JL)-XTT))
- ENDDO
+ IF(.NOT. ODSOFT) THEN
+ ZZW(:) = EXP(XALPI-XBETAI/ZT(:)-XGAMI*ALOG(ZT(:)))
+ DO JL=1, KSIZE
+ PSSI(JL) = ZRVT(JL)*( PPRES(JL)-ZZW(JL) ) / ( XEPSILO * ZZW(JL) ) - 1.0
+ ! Supersaturation over ice
+ ZKA(JL) = 2.38E-2 + 0.0071E-2*(ZT(JL)-XTT) ! k_a
+ ZDV(JL) = 0.211E-4*(ZT(JL)/XTT)**1.94 * (XP00/PPRES(JL)) ! D_v
+ ZAI(JL) = (XLSTT+(XCPV-XCI)*(ZT(JL)-XTT))**2 / (ZKA(JL)*XRV*ZT(JL)**2) &
+ + ( XRV*ZT(JL) ) / (ZDV(JL)*ZZW(JL))
+ ZCJ(JL) = XSCFAC*PRHODREF(JL)**0.3 / SQRT(1.718E-5+0.0049E-5*(ZT(JL)-XTT))
+ ENDDO
+ ENDIF
!
!Cloud water split between high and low content part is done here
- CALL ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_PR_PDF,&
- PRHODREF, ZRCT, PCF, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, ZRF)
- !Diagnostic of precipitation fraction
- PRAINFR(:,:,:) = 0.
- ZRRT3D (:,:,:) = PRRT3D(:,:,:)
- DO JL=1,KSIZE
- PRAINFR(K1(JL), K2(JL), K3(JL)) = ZRF(JL)
- ZRRT3D (K1(JL), K2(JL), K3(JL)) = ZRRT3D(K1(JL), K2(JL), K3(JL)) - PRRHONG_MR(JL)
- END DO
- CALL ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PRAINFR(:,:,:), ZRRT3D(:,:,:))
- DO JL=1,KSIZE
- ZRF(JL)=PRAINFR(K1(JL), K2(JL), K3(JL))
- END DO
+ CALL ICE4_COMPUTE_PDF(KSIZE, HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF,&
+ PRHODREF, ZRCT, ZRIT, PCF, ZT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC,&
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, ZRF)
+ IF(HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
+ !Diagnostic of precipitation fraction
+ PRAINFR(:,:,:) = 0.
+ ZRRT3D (:,:,:) = 0.
+ ZRST3D (:,:,:) = 0.
+ ZRGT3D (:,:,:) = 0.
+ ZRHT3D (:,:,:) = 0.
+ DO JL=1,KSIZE
+ PRAINFR(K1(JL), K2(JL), K3(JL)) = ZRF(JL)
+ ZRRT3D (K1(JL), K2(JL), K3(JL)) = ZRRT(JL)
+ ZRST3D (K1(JL), K2(JL), K3(JL)) = ZRST(JL)
+ ZRGT3D (K1(JL), K2(JL), K3(JL)) = ZRGT(JL)
+ END DO
+ IF (KRR==7) THEN
+ DO JL=1,KSIZE
+ ZRHT3D (K1(JL), K2(JL), K3(JL)) = ZRHT(JL)
+ ENDDO
+ ENDIF
+ CALL ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PRAINFR(:,:,:), ZRRT3D(:,:,:), &
+ &ZRST3D(:,:,:), ZRGT3D(:,:,:), ZRHT3D(:,:,:))
+ DO JL=1,KSIZE
+ ZRF(JL)=PRAINFR(K1(JL), K2(JL), K3(JL))
+ END DO
+ ELSE
+ PRAINFR(:,:,:)=1.
+ ZRF(:)=1.
+ ENDIF
!
!* compute the slope parameters
!
@@ -427,10 +483,14 @@ IF(KSIZE>0) THEN
ZLBDAR(:) = XLBR*( PRHODREF(:)*MAX( ZRRT(:), XRTMIN(3)))**XLBEXR
END WHERE
!ZLBDAR_RF is used when we consider rain concentrated in its fraction
- ZLBDAR_RF(:)=0.
- WHERE(ZRRT(:)>0. .AND. ZRF(:)>0.)
- ZLBDAR_RF(:) = XLBR*( PRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3)))**XLBEXR
- END WHERE
+ IF (HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
+ ZLBDAR_RF(:)=0.
+ WHERE(ZRRT(:)>0. .AND. ZRF(:)>0.)
+ ZLBDAR_RF(:) = XLBR*( PRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3)))**XLBEXR
+ END WHERE
+ ELSE
+ ZLBDAR_RF(:) = ZLBDAR(:)
+ ENDIF
IF(KRR==7) THEN
ZLBDAH(:)=0.
WHERE(PRHT(:)>0.)
@@ -440,11 +500,11 @@ IF(KSIZE>0) THEN
ENDIF
!
!
-CALL ICE4_SLOW(KSIZE, ODSOFT, ODCOMPUTE, PRHODREF, ZT, &
- &ZSSI, PLVFACT, PLSFACT, &
+CALL ICE4_SLOW(KSIZE, ODSOFT, PCOMPUTE, PRHODREF, ZT, &
+ &PSSI, PLVFACT, PLSFACT, &
&ZRVT, ZRCT, ZRIT, ZRST, ZRGT, &
&ZLBDAS, ZLBDAG, &
- &ZAI, ZCJ, &
+ &ZAI, ZCJ, PHLI_HCF, PHLI_HRI, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
!
@@ -457,7 +517,7 @@ CALL ICE4_SLOW(KSIZE, ODSOFT, ODCOMPUTE, PRHODREF, ZT, &
!
IF(OWARM) THEN ! Check if the formation of the raindrops by the slow
! warm processes is allowed
- CALL ICE4_WARM(KSIZE, ODSOFT, ODCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ CALL ICE4_WARM(KSIZE, ODSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
&PRHODREF, PLVFACT, ZT, PPRES, ZTHT,&
&ZLBDAR, ZLBDAR_RF, ZKA, ZDV, ZCJ, &
&PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
@@ -477,7 +537,7 @@ END IF
!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s
! ----------------------------------------------
!
-CALL ICE4_FAST_RS(KSIZE, ODSOFT, ODCOMPUTE, &
+CALL ICE4_FAST_RS(KSIZE, ODSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAR, ZLBDAS, &
@@ -495,15 +555,18 @@ CALL ICE4_FAST_RS(KSIZE, ODSOFT, ODCOMPUTE, &
!* 5. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_g
! ------------------------------------------------------
!
-ZRGSI(:) = PRVDEPG(:) + PRSMLTG(:) + PRRACCSG(:) + PRSACCRG(:) + PRCRIMSG(:) + PRSRIMCG(:)
-ZRGSI_MR(:) = PRRHONG_MR(:) + PRSRIMCG_MR(:)
-CALL ICE4_FAST_RG(KSIZE, ODSOFT, ODCOMPUTE, KRR, &
+DO JL=1, KSIZE
+ ZRGSI(JL) = PRVDEPG(JL) + PRSMLTG(JL) + PRRACCSG(JL) + &
+ & PRSACCRG(JL) + PRCRIMSG(JL) + PRSRIMCG(JL)
+ ZRGSI_MR(JL) = PRRHONG_MR(JL) + PRSRIMCG_MR(JL)
+ENDDO
+CALL ICE4_FAST_RG(KSIZE, ODSOFT, PCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, PCIT, &
&ZLBDAR, ZLBDAS, ZLBDAG, &
&ZT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
&ZRGSI, ZRGSI_MR(:), &
- &LLWETG, &
+ &ZWETG, &
&PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
&PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
&PRG_TEND, &
@@ -516,7 +579,7 @@ CALL ICE4_FAST_RG(KSIZE, ODSOFT, ODCOMPUTE, KRR, &
! ----------------------------------------------
!
IF (KRR==7) THEN
- CALL ICE4_FAST_RH(KSIZE, ODSOFT, ODCOMPUTE, LLWETG, &
+ CALL ICE4_FAST_RH(KSIZE, ODSOFT, PCOMPUTE, ZWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAS, ZLBDAG, ZLBDAR, ZLBDAH, &
@@ -546,10 +609,10 @@ END IF
!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES
! -------------------------------------------------------------
!
-CALL ICE4_FAST_RI(KSIZE, ODSOFT, ODCOMPUTE, &
+CALL ICE4_FAST_RI(KSIZE, ODSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&ZAI, ZCJ, PCIT, &
- &ZSSI, &
+ &PSSI, &
&ZRCT, ZRIT, &
&PRCBERI, PA_TH, PA_RC, PA_RI)
!
diff --git a/src/MNH/ice4_warm.f90 b/src/MNH/ice4_warm.f90
index 429c0522bb81d1b2cf8d5509ad2e5e0d6a6c44ab..aa61b1dac3ee676c3ec2ecca6d2af30c1ec9b8a5 100644
--- a/src/MNH/ice4_warm.f90
+++ b/src/MNH/ice4_warm.f90
@@ -1,11 +1,11 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
!-----------------------------------------------------------------
MODULE MODI_ICE4_WARM
INTERFACE
-SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
PRHODREF, PLVFACT, PT, PPRES, PTHT, &
PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
@@ -16,7 +16,7 @@ SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP,
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
@@ -48,7 +48,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
END SUBROUTINE ICE4_WARM
END INTERFACE
END MODULE MODI_ICE4_WARM
-SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
PRHODREF, PLVFACT, PT, PPRES, PTHT, &
PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
@@ -73,7 +73,7 @@ SUBROUTINE ICE4_WARM(KSIZE, LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP,
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPW,XBETAW,XCL,XCPD,XCPV,XGAMW,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPW,XBETAW,XCL,XCPD,XCPV,XGAMW,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: X0EVAR,X1EVAR,XCRIAUTC,XEX0EVAR,XEX1EVAR,XEXCACCR,XFCACCR,XTIMAUTC
!
@@ -85,7 +85,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(KSIZE), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
@@ -117,10 +117,12 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RR
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMASK, GMASK1, GMASK2
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW2, ZZW3, ZZW4
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZUSW ! Undersaturation over water
-REAL, DIMENSION(SIZE(PRHODREF)) :: ZTHLT ! Liquid potential temperature
+REAL, DIMENSION(KSIZE) :: ZZW2, ZZW3, ZZW4
+REAL, DIMENSION(KSIZE) :: ZUSW ! Undersaturation over water
+REAL, DIMENSION(KSIZE) :: ZTHLT ! Liquid potential temperature
+REAL, DIMENSION(KSIZE) :: ZMASK, ZMASK1, ZMASK2
+INTEGER :: JL
+!-------------------------------------------------------------------------------
!
!
!
@@ -128,33 +130,44 @@ REAL, DIMENSION(SIZE(PRHODREF)) :: ZTHLT ! Liquid potential temperature
!
!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
!
-GMASK(:)=PHLC_HRC(:)>XRTMIN(2) .AND. PHLC_HCF(:) .GT. 0. .AND. LDCOMPUTE(:)
+DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) * & ! PHLC_HCF(:) .GT. 0.
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCAUTR(:) = 0.
- END WHERE
+ DO JL=1, KSIZE
+ PRCAUTR(JL)=PRCAUTR(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRCAUTR(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRCAUTR(:) = XTIMAUTC*MAX(PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:), 0.0)
PRCAUTR(:) = PHLC_HCF(:)*PRCAUTR(:)
END WHERE
ENDIF
-PA_RC(:) = PA_RC(:) - PRCAUTR(:)
-PA_RR(:) = PA_RR(:) + PRCAUTR(:)
+DO JL=1, KSIZE
+ PA_RC(JL) = PA_RC(JL) - PRCAUTR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCAUTR(JL)
+ENDDO
+!
!
!* 4.3 compute the accretion of r_c for r_r production: RCACCR
!
IF (HSUBG_RC_RR_ACCR=='NONE') THEN
!CLoud water and rain are diluted over the grid box
- GMASK(:)=PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCACCR(:)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRCACCR(JL)=PRCACCR(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRCACCR(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRCACCR(:) = XFCACCR * PRCT(:) &
* PLBDAR(:)**XEXCACCR &
* PRHODREF(:)**(-XCEXVT)
@@ -169,23 +182,31 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
! if PRF<PCF (rain is entirely falling in cloud): PRF-PHLC_HCF
! if PRF>PCF (rain is falling in cloud and in clear sky): PCF-PHLC_HCF
! => min(PCF, PRF)-PHLC_HCF
- GMASK(:)=PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
- GMASK1(:)=GMASK(:) .AND. PHLC_HRC(:)>XRTMIN(2) .AND. PHLC_HCF(:)>0.
- GMASK2(:)=GMASK(:) .AND. PHLC_LRC(:)>XRTMIN(2) .AND. PHLC_LCF(:)>0.
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ ZMASK1(JL)=ZMASK(JL) * &
+ &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) ! PHLC_HCF(:)>0.
+ ZMASK2(JL)=ZMASK(JL) * &
+ &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_LRC(JL))) * & ! PHLC_LRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_LCF(JL))) ! PHLC_LCF(:)>0.
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. (GMASK1(:) .OR. GMASK2(:)))
- PRCACCR(:)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRCACCR(JL)=PRCACCR(JL) * MIN(1., ZMASK1(JL)+ZMASK2(JL))
+ ENDDO
ELSE
PRCACCR(:)=0.
- WHERE(GMASK1(:))
+ WHERE(ZMASK1(:)==1.)
!Accretion due to rain falling in high cloud content
PRCACCR(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
* PLBDAR_RF(:)**XEXCACCR &
* PRHODREF(:)**(-XCEXVT) &
* PHLC_HCF
END WHERE
- WHERE(GMASK2(:))
+ WHERE(ZMASK2(:)==1.)
!We add acrretion due to rain falling in low cloud content
PRCACCR(:) = PRCACCR(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
* PLBDAR_RF(:)**XEXCACCR &
@@ -196,24 +217,29 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RC_RR_ACCR case')
ENDIF
-!
-PA_RC(:) = PA_RC(:) - PRCACCR(:)
-PA_RR(:) = PA_RR(:) + PRCACCR(:)
+DO JL=1, KSIZE
+ PA_RC(JL) = PA_RC(JL) - PRCACCR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCACCR(JL)
+ENDDO
!
!* 4.4 compute the evaporation of r_r: RREVAV
!
IF (HSUBG_RR_EVAP=='NONE') THEN
- GMASK(:)=PRRT(:)>XRTMIN(3) .AND. PRCT(:)<=XRTMIN(2) .AND. LDCOMPUTE(:)
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &MAX(0., SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)<=XRTMIN(2)
+ &PCOMPUTE(JL)
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRREVAV(:)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRREVAV(:) = 0.
!Evaporation only when there's no cloud (RC must be 0)
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRREVAV(:) = EXP( XALPW - XBETAW/PT(:) - XGAMW*ALOG(PT(:) ) ) ! es_w
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( (XMV/XMD) * PRREVAV(:) )
+ ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
! Undersaturation over water
PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(PT(:)-XTT) )**2 / ( PKA(:)*XRV*PT(:)**2 ) &
+ ( XRV*PT(:) ) / ( PDV(:)*PRREVAV(:) )
@@ -240,14 +266,18 @@ ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
!Ces variables devraient être sorties de rain_ice_slow et on mettrait le calcul de T^u, T^s
!et plusieurs versions (comme actuellement, en ciel clair, en ciel nuageux) de PKA, PDV, PCJ dans rain_ice
!On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs
- GMASK(:)=PRRT(:)>XRTMIN(3) .AND. ZZW4(:) > PCF(:) .AND. LDCOMPUTE(:)
+ DO JL=1, KSIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &MAX(0., -SIGN(1., PCF(JL)-ZZW4(JL))) * & ! ZZW4(:) > PCF(:)
+ &PCOMPUTE(JL)
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRREVAV(:)=0.
- END WHERE
+ DO JL=1, KSIZE
+ PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRREVAV(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1)
! outside the cloud (environment) the use of T^u (unsaturated) instead of T
! Bechtold et al. 1993
!
@@ -261,7 +291,7 @@ ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
PRREVAV(:) = EXP( XALPW - XBETAW/ZZW2(:) - XGAMW*ALOG(ZZW2(:) ) )
!
! S, Undersaturation over water (with new theta^u)
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( (XMV/XMD) * PRREVAV(:) )
+ ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
!
PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) &
+ ( XRV*ZZW2(:) ) / ( PDV(:)*PRREVAV(:) )
@@ -276,9 +306,11 @@ ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RR_EVAP case')
END IF
-PA_RR(:) = PA_RR(:) - PRREVAV(:)
-PA_RV(:) = PA_RV(:) + PRREVAV(:)
-PA_TH(:) = PA_TH(:) - PRREVAV(:)*PLVFACT(:)
+DO JL=1, KSIZE
+ PA_RR(JL) = PA_RR(JL) - PRREVAV(JL)
+ PA_RV(JL) = PA_RV(JL) + PRREVAV(JL)
+ PA_TH(JL) = PA_TH(JL) - PRREVAV(JL)*PLVFACT(JL)
+ENDDO
!
!
END SUBROUTINE ICE4_WARM
diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index aaf7c903b00284edd640ad3b20351a6d641362f9..8f5a8b35e7619d83bd9bf3c290e0eff346138ea8 100644
--- a/src/MNH/ice_adjust.f90
+++ b/src/MNH/ice_adjust.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-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.
@@ -9,32 +9,38 @@
!
INTERFACE
!
- SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, &
- HBUNAME, OSUBG_COND, OSIGMAS, &
+ SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
+ HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF, &
PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PZZ, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, &
+ PPABST, PZZ, &
PEXN, PCF_MF, PRC_MF, PRI_MF, &
- PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR , &
- PRR, PRI, PRIS, PRS, PRG, &
- PRH, POUT_RV, POUT_RC, POUT_RI, POUT_TH )
+ PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
+ PRR, PRI, PRIS, PRS, PRG, PRH, &
+ POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
LOGICAL :: OSIGMAS ! Switch for Sigma_s:
! use values computed in CONDENSATION
! or that from turbulence scheme
+CHARACTER(len=*), INTENT(IN) :: HSUBG_MF_PDF
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
@@ -42,7 +48,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of model layer
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRI_MF! Convective Mass Flux ice mixing ratio
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
!
@@ -66,6 +72,10 @@ REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HCF
!
!
END SUBROUTINE ICE_ADJUST
@@ -75,14 +85,16 @@ END INTERFACE
END MODULE MODI_ICE_ADJUST
! ##########################################################################
- SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, &
- HBUNAME, OSUBG_COND, OSIGMAS, &
+ SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
+ HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF, &
PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PZZ, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, &
+ PPABST, PZZ, &
PEXN, PCF_MF, PRC_MF, PRI_MF, &
- PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR , &
+ PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
PRR, PRI, PRIS, PRS, PRG, PRH, &
- POUT_RV, POUT_RC, POUT_RI, POUT_TH )
+ POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
! #########################################################################
!
!!**** *ICE_ADJUST* - compute the ajustment of water vapor in mixed-phase
@@ -163,7 +175,6 @@ END MODULE MODI_ICE_ADJUST
!! or to call it on S variables
!! 2016-11 S. Riette: all-or-nothing adjustment now uses condensation
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 24/02/2020: bugfix: corrected budget name (DEPI->CDEPI) for ice_adjust
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
@@ -178,6 +189,7 @@ USE MODD_CST
USE MODD_PARAMETERS
use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
use mode_tools_ll, only: GET_INDICE_ll
USE MODI_CONDENSATION
@@ -194,18 +206,22 @@ INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
LOGICAL :: OSIGMAS ! Switch for Sigma_s:
! use values computed in CONDENSATION
! or that from turbulence scheme
+CHARACTER(len=*), INTENT(IN) :: HSUBG_MF_PDF
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
@@ -238,6 +254,10 @@ REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HCF
!
!* 0.2 Declarations of local variables :
!
@@ -248,7 +268,9 @@ REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
ZCPH, & ! guess of the CPh for the mixing
ZLV, & ! guess of the Lv at t+1
ZLS, & ! guess of the Ls at t+1
- ZW1,ZW2 ! Work arrays for intermediate fields
+ ZW1,ZW2, & ! Work arrays for intermediate fields
+ ZCRIAUT, & ! Autoconversion thresholds
+ ZHCF, ZHR
!
INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
@@ -327,10 +349,11 @@ DO JITER =1,ITERMAX
!
! PSRC= s'rci'/Sigma_s^2
! ZT, ZRV, ZRC and ZRI are INOUT
- CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
- HFRAC_ICE, &
- PPABST, PZZ, ZT, ZRV, ZRC, ZRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSRCS, .TRUE., OSIGMAS, &
- PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
+ CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, &
+ PSRCS, .TRUE., OSIGMAS, &
+ PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH, PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF)
ELSE
!
!* 4. ALL OR NOTHING CONDENSATION SCHEME
@@ -343,12 +366,12 @@ DO JITER =1,ITERMAX
!CALL ADJUST_LANGLOIS(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
! PPABST, ZT, ZRV, ZRC, ZRI, ZLV, ZLS, ZCPH) HFRAC_ICE must be implemented in Langlois before using it again
ZSIGS=0.
- CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
- HFRAC_ICE, &
- PPABST, PZZ, ZT, ZRV, ZRC, ZRI, PRS, PRG, ZSIGS, PMFCONV, PCLDFR, &
- ZSRCS, .TRUE., OSIGMAS=.TRUE., &
- PSIGQSAT=0., PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
- END IF
+ CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRS, PRG, ZSIGS, PMFCONV, PCLDFR, &
+ ZSRCS, .TRUE., OSIGMAS=.TRUE., &
+ PSIGQSAT=0., PLV=ZLV, PLS=ZLS, PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF)
+ ENDIF
ENDDO ! end of the iterative loop
!
!* 5. COMPUTE THE SOURCES AND STORES THE CLOUD FRACTION
@@ -405,6 +428,59 @@ ELSE
ZW1(:,:,:)=ZW1(:,:,:)*PRVS(:,:,:)/(ZW1(:,:,:)+ZW2(:,:,:))
ZW2(:,:,:)=PRVS(:,:,:)-ZW1(:,:,:)
ENDWHERE
+ IF(PRESENT(PHLC_HRC) .AND. PRESENT(PHLC_HCF)) THEN
+ ZCRIAUT(:,:,:)=XCRIAUTC/PRHODREF
+ IF(HSUBG_MF_PDF=='NONE')THEN
+ WHERE(ZW1(:,:,:)*PTSTEP>PCF_MF * ZCRIAUT)
+ PHLC_HRC(:,:,:)=PHLC_HRC(:,:,:)+ZW1(:,:,:)*PTSTEP
+ PHLC_HCF(:,:,:)=MIN(1.,PHLC_HCF(:,:,:)+PCF_MF(:,:,:))
+ ENDWHERE
+ ELSEIF(HSUBG_MF_PDF=='TRIANGLE')THEN
+ !ZHCF is the precipitating part of the *cloud* and not of the grid cell
+ WHERE(ZW1(:,:,:)*PTSTEP>PCF_MF*ZCRIAUT(:,:,:))
+ ZHCF(:,:,:)=1.-.5*(ZCRIAUT(:,:,:)*PCF_MF(:,:,:) / MAX(1.E-20, ZW1(:,:,:)*PTSTEP))**2
+ ZHR(:,:,:)=ZW1(:,:,:)*PTSTEP-(ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**3 / &
+ &(3*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ELSEWHERE(2.*ZW1(:,:,:)*PTSTEP<=PCF_MF * ZCRIAUT(:,:,:))
+ ZHCF(:,:,:)=0.
+ ZHR(:,:,:)=0.
+ ELSEWHERE
+ ZHCF(:,:,:)=(2.*ZW1(:,:,:)*PTSTEP-ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**2 / &
+ &(2.*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ZHR(:,:,:)=(4.*(ZW1(:,:,:)*PTSTEP)**3-3.*ZW1(:,:,:)*PTSTEP*(ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**2+&
+ (ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**3) / &
+ &(3*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ENDWHERE
+ ZHCF(:,:,:)=ZHCF(:,:,:)*PCF_MF(:,:,:) !to retrieve the part of the grid cell
+ PHLC_HCF(:,:,:)=MIN(1.,PHLC_HCF(:,:,:)+ZHCF(:,:,:)) !total part of the grid cell that is precipitating
+ PHLC_HRC(:,:,:)=PHLC_HRC(:,:,:)+ZHR(:,:,:)
+ ENDIF
+ ENDIF
+ IF(PRESENT(PHLI_HRI) .AND. PRESENT(PHLI_HCF)) THEN
+ ZCRIAUT(:,:,:)=MIN(XCRIAUTI,10**(XACRIAUTI*(ZT(:,:,:)-XTT)+XBCRIAUTI))
+ IF(HSUBG_MF_PDF=='NONE')THEN
+ WHERE(ZW2(:,:,:)*PTSTEP>PCF_MF * ZCRIAUT(:,:,:))
+ PHLI_HRI(:,:,:)=PHLI_HRI(:,:,:)+ZW2(:,:,:)*PTSTEP
+ PHLI_HCF(:,:,:)=MIN(1.,PHLI_HCF(:,:,:)+PCF_MF(:,:,:))
+ ENDWHERE
+ ELSEIF(HSUBG_MF_PDF=='TRIANGLE')THEN
+ !ZHCF is the precipitating part of the *cloud* and not of the grid cell
+ WHERE(ZW2(:,:,:)*PTSTEP>PCF_MF*ZCRIAUT)
+ ZHCF(:,:,:)=1.-.5*(ZCRIAUT*PCF_MF(:,:,:) / (ZW2(:,:,:)*PTSTEP))**2
+ ZHR(:,:,:)=ZW2(:,:,:)*PTSTEP-(ZCRIAUT*PCF_MF(:,:,:))**3/(3*(ZW2(:,:,:)*PTSTEP)**2)
+ ELSEWHERE(2.*ZW2(:,:,:)*PTSTEP<=PCF_MF * ZCRIAUT)
+ ZHCF(:,:,:)=0.
+ ZHR(:,:,:)=0.
+ ELSEWHERE
+ ZHCF(:,:,:)=(2.*ZW2(:,:,:)*PTSTEP-ZCRIAUT*PCF_MF(:,:,:))**2 / (2.*(ZW2(:,:,:)*PTSTEP)**2)
+ ZHR(:,:,:)=(4.*(ZW2(:,:,:)*PTSTEP)**3-3.*ZW2(:,:,:)*PTSTEP*(ZCRIAUT*PCF_MF(:,:,:))**2+&
+ (ZCRIAUT*PCF_MF(:,:,:))**3)/(3*(ZW2(:,:,:)*PTSTEP)**2)
+ ENDWHERE
+ ZHCF(:,:,:)=ZHCF(:,:,:)*PCF_MF(:,:,:) !to retrieve the part of the grid cell
+ PHLI_HCF(:,:,:)=MIN(1.,PHLI_HCF(:,:,:)+ZHCF(:,:,:)) !total part of the grid cell that is precipitating
+ PHLI_HRI(:,:,:)=PHLI_HRI(:,:,:)+ZHR(:,:,:)
+ ENDIF
+ ENDIF
PCLDFR(:,:,:)=MIN(1.,PCLDFR(:,:,:)+PCF_MF(:,:,:))
PRCS(:,:,:)=PRCS(:,:,:)+ZW1(:,:,:)
PRIS(:,:,:)=PRIS(:,:,:)+ZW2(:,:,:)
@@ -425,13 +501,13 @@ ELSE
ZRV(:,:,:)=ZRV(:,:,:)-(ZW1(:,:,:)+ZW2(:,:,:))
ZT(:,:,:) = ZT(:,:,:) + &
(ZW1 * ZLV(:,:,:) + ZW2 * ZLS(:,:,:)) / ZCPH(:,:,:)
- IF(PRESENT(POUT_RV)) POUT_RV=ZRV
- IF(PRESENT(POUT_RC)) POUT_RC=ZRC
- IF(PRESENT(POUT_RI)) POUT_RI=ZRI
- IF(PRESENT(POUT_TH)) POUT_TH=ZT / PEXN(:,:,:)
ENDIF
ENDIF
!
+IF(PRESENT(POUT_RV)) POUT_RV=ZRV
+IF(PRESENT(POUT_RC)) POUT_RC=ZRC
+IF(PRESENT(POUT_RI)) POUT_RI=ZRI
+IF(PRESENT(POUT_TH)) POUT_TH=ZT / PEXN(:,:,:)
!
!
!* 6. STORE THE BUDGET TERMS
diff --git a/src/MNH/ice_adjust_elec.f90 b/src/MNH/ice_adjust_elec.f90
index 6d766496dcf250e726ac3331aa423e6d2dd76564..2aa614e7c1c9fa35ba8f9abf82bcef8fec468f94 100644
--- a/src/MNH/ice_adjust_elec.f90
+++ b/src/MNH/ice_adjust_elec.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-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.
@@ -305,15 +305,15 @@ ZT0 = XTT ! Usefull if LPRETREATMENT=T or LNEW_ADJUST=T
ZT00 = XTT-40. ! Usefull if LPRETREATMENT=T or LNEW_ADJUST=T
!
!-------------------------------------------------------------------------------
-if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CDEPI', pths(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CDEPI', prvs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CDEPI', prcs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CDEPI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DEPI', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'DEPI', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DEPI', pris(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'CDEPI', pqpis(:, :, :) * prhodj(:, :, :) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'CDEPI', pqnis(:, :, :) * prhodj(:, :, :) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'CDEPI', pqcs (:, :, :) * prhodj(:, :, :) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CDEPI', pqis (:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPI', pqpis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPI', pqnis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DEPI', pqcs (:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DEPI', pqis (:, :, :) * prhodj(:, :, :) )
end if
!
!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
@@ -370,9 +370,10 @@ DO JITER = 1, ITERMAX
!
! ZW3=water vapor ZW1=rc (INOUT) ZW2=ri (INOUT) PSRC= s'rci'/Sigma_s^2
ZW3 = PRVS * PTSTEP; ZW1 = PRCS * PTSTEP; ZW2 = PRIS * PTSTEP
+ ZW4 = 1. ! PRODREF is not used if HL variables are not present
!
- CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE,1, 'T', &
- PPABST, PZZ, ZT, ZW3, ZW1, ZW2, PRSS*PTSTEP, PRGS*PTSTEP, &
+ CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE,1, 'T', 'CB02', 'CB', &
+ PPABST, PZZ, ZW4, ZT, ZW3, ZW1, ZW2, PRSS*PTSTEP, PRGS*PTSTEP, &
PSIGS, PMFCONV, PCLDFR, PSRCS, .TRUE., &
OSIGMAS, PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
!
@@ -629,15 +630,15 @@ ENDIF
!* 6. STORE THE BUDGET TERMS
! ----------------------
!
-if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CDEPI', pths(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CDEPI', prvs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CDEPI', prcs(:, :, :) * prhodj(:, :, :) )
-if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CDEPI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DEPI', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'DEPI', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DEPI', pris(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'CDEPI', pqpis(:, :, :) * prhodj(:, :, :) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'CDEPI', pqnis(:, :, :) * prhodj(:, :, :) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'CDEPI', pqcs (:, :, :) * prhodj(:, :, :) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CDEPI', pqis (:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPI', pqpis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPI', pqnis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DEPI', pqcs (:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DEPI', pqis (:, :, :) * prhodj(:, :, :) )
end if
!------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index d7a063ba2b98ddcee2f85c093711e8d121442cd7..3152cb6e5e17022fc128393ad806dff7b7a08fa6 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -106,7 +106,7 @@ end subroutine Budget_preallocate
OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, &
OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
OHORELAX_SV, OVE_RELAX, ove_relax_grd, OCHTRANS, &
- ONUDGING,ODRAGTREE,ODEPOTREE, &
+ ONUDGING,ODRAGTREE,ODEPOTREE, OAERO_EOL, &
HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD )
! #################################################################
!
@@ -223,7 +223,7 @@ use modd_dim_n, only: nimax_ll, njmax_ll, nkmax
use modd_dragbldg_n, only: ldragbldg
use modd_dust, only: ldust
use modd_dyn, only: lcorio, xseglen
-use modd_dyn_n, only: xtstep
+use modd_dyn_n, only: xtstep, locean
use modd_elec_descr, only: linductive, lrelax2fw_ion
use modd_field, only: TYPEREAL
use modd_nsv, only: csvnames, &
@@ -236,7 +236,7 @@ use modd_nsv, only: csvnames,
nsv_lgbeg, nsv_lgend, &
nsv_lima_beg, nsv_lima_end, nsv_lima_ccn_acti, nsv_lima_ccn_free, nsv_lima_hom_haze, &
nsv_lima_ifn_free, nsv_lima_ifn_nucl, nsv_lima_imm_nucl, &
- nsv_lima_nc, nsv_lima_nr, nsv_lima_ni, nsv_lima_scavmass, &
+ nsv_lima_nc, nsv_lima_nr, nsv_lima_ni, nsv_lima_scavmass, nsv_lima_spro, &
nsv_lnoxbeg, nsv_lnoxend, nsv_ppbeg, nsv_ppend, &
nsv_sltbeg, nsv_sltend, nsv_sltdepbeg, nsv_sltdepend, nsv_snwbeg, nsv_snwend, &
nsv_user
@@ -245,12 +245,14 @@ use modd_param_c2r2, only: ldepoc_c2r2 => ldepoc, lrain_c2r2 => lrain, lsedc_c
use modd_param_ice, only: ladj_after, ladj_before, ldeposc_ice => ldeposc, lred, lsedic_ice => lsedic, lwarm_ice => lwarm
use modd_param_n, only: cactccn, celec
use modd_param_lima, only: laero_mass_lima => laero_mass, lacti_lima => lacti, lcold_lima => lcold, ldepoc_lima => ldepoc, &
- lhail_lima => lhail, lhhoni_lima => lhhoni, lmeyers_lima => lmeyers, lnucl_lima => lnucl, &
- lptsplit, &
- lrain_lima => lrain, lscav_lima => lscav, lsedc_lima => lsedc, lsedi_lima => lsedi, &
- lsnow_lima => lsnow, lwarm_lima => lwarm, &
+ lhail_lima => lhail, lhhoni_lima => lhhoni, lmeyers_lima => lmeyers, lnucl_lima => lnucl, &
+ lptsplit, &
+ lrain_lima => lrain, lscav_lima => lscav, lsedc_lima => lsedc, lsedi_lima => lsedi, &
+ lsnow_lima => lsnow, lspro_lima => lspro, lwarm_lima => lwarm, &
nmod_ccn, nmod_ifn, nmod_imm
+use modd_ref, only: lcouples
use modd_salt, only: lsalt
+use modd_turb_n, only: lsubg_cond
use modd_viscosity, only: lvisc, lvisc_r, lvisc_sv, lvisc_th, lvisc_uvw
USE MODE_ll
@@ -297,6 +299,7 @@ LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective
LOGICAL, INTENT(IN) :: ONUDGING ! switch to activate nudging
LOGICAL, INTENT(IN) :: ODRAGTREE ! switch to activate vegetation drag
LOGICAL, INTENT(IN) :: ODEPOTREE ! switch to activate droplet deposition on tree
+LOGICAL, INTENT(IN) :: OAERO_EOL ! switch to activate wind turbine wake
CHARACTER (LEN=*), INTENT(IN) :: HRAD ! type of the radiation scheme
CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme
CHARACTER (LEN=*), INTENT(IN) :: HSCONV ! type of the shallow convection scheme
@@ -615,10 +618,15 @@ if ( lbu_ru ) then
call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
tzsource%cmnhname = 'DRAG'
- tzsource%clongname = 'drag force'
+ tzsource%clongname = 'drag force due to trees'
tzsource%lavailable = odragtree
call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
tzsource%cmnhname = 'DRAGB'
tzsource%clongname = 'drag force due to buildings'
tzsource%lavailable = ldragbldg
@@ -750,10 +758,15 @@ if ( lbu_rv ) then
call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
tzsource%cmnhname = 'DRAG'
- tzsource%clongname = 'drag force'
+ tzsource%clongname = 'drag force due to trees'
tzsource%lavailable = odragtree
call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
tzsource%cmnhname = 'DRAGB'
tzsource%clongname = 'drag force due to buildings'
tzsource%lavailable = ldragbldg
@@ -914,6 +927,10 @@ if ( lbu_rw ) then
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
call Sourcelist_sort_compact( tbudgets(NBUDGET_W) )
@@ -1048,6 +1065,11 @@ if ( lbu_rth ) then
tzsource%lavailable = lvisc .and. lvisc_th
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+ tzsource%cmnhname = 'OCEAN'
+ tzsource%clongname = 'radiative tendency due to SW penetrating ocean'
+ tzsource%lavailable = locean .and. (.not. lcouples)
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
tzsource%cmnhname = 'ADV'
tzsource%clongname = 'total advection'
tzsource%lavailable = .true.
@@ -1073,7 +1095,8 @@ if ( lbu_rth ) then
tzsource%cmnhname = 'HENU'
tzsource%clongname = 'heterogeneous nucleation'
gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
- tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 ) &
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
.or. hcloud(1:3) == 'ICE' &
.or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
.or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
@@ -1215,9 +1238,10 @@ if ( lbu_rth ) then
tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
- tzsource%cmnhname = 'CDEPI'
- tzsource%clongname = 'condensation/deposition on ice'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE' )
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'COND'
@@ -1469,7 +1493,8 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
tzsource%cmnhname = 'HENU'
tzsource%clongname = 'heterogeneous nucleation'
gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
- tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 ) &
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
.or. hcloud(1:3) == 'ICE' &
.or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
.or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
@@ -1526,9 +1551,10 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
- tzsource%cmnhname = 'CDEPI'
- tzsource%clongname = 'condensation/deposition on ice'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE' )
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
tzsource%cmnhname = 'CORR2'
@@ -1665,8 +1691,9 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
tzsource%cmnhname = 'CORR'
tzsource%clongname = 'correction'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima ) &
- .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
tzsource%cmnhname = 'SEDI'
@@ -1693,8 +1720,9 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
tzsource%cmnhname = 'HENU'
tzsource%clongname = 'CCN activation'
gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
- tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 ) &
- .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 &
+ .and. ( .not.lptsplit .or. .not.lsubg_cond ) ) &
+ .or. ( hcloud == 'C2R2' .and. ( gtmp .or. .not.lsupsat_c2r2 ) ) &
.or. ( hcloud == 'KHKO' .and. ( gtmp .or. .not.lsupsat_c2r2 ) )
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
@@ -1796,7 +1824,7 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
tzsource%lavailable = hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
- tzsource%cmnhname = 'CDEPI'
+ tzsource%cmnhname = 'DEPI'
tzsource%clongname = 'condensation/deposition on ice'
tzsource%lavailable = hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE' )
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
@@ -1915,8 +1943,9 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
tzsource%cmnhname = 'CORR'
tzsource%clongname = 'correction'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima ) &
- .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
tzsource%cmnhname = 'SEDI'
@@ -2154,8 +2183,9 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
tzsource%cmnhname = 'CORR'
tzsource%clongname = 'correction'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lcold_lima .and. lsnow_lima ) &
- .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lcold_lima .and. lsnow_lima ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'ADJU'
@@ -2274,9 +2304,10 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
tzsource%lavailable = hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
- tzsource%cmnhname = 'CDEPI'
+ tzsource%cmnhname = 'DEPI'
tzsource%clongname = 'condensation/deposition on ice'
- tzsource%lavailable = hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE' )
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'CORR2'
@@ -2385,8 +2416,9 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then
tzsource%cmnhname = 'CORR'
tzsource%clongname = 'correction'
- tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lcold_lima .and. lsnow_lima ) &
- .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+! tzsource%lavailable = ( hcloud == 'LIMA' .and. lptsplit .and. lcold_lima .and. lsnow_lima ) &
+! .or. ( hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE' )
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
tzsource%cmnhname = 'SEDI'
@@ -3063,26 +3095,28 @@ SV_BUDGETS: do jsv = 1, ksv
else if ( jsv >= nsv_lima_beg .and. jsv <= nsv_lima_end ) then SV_VAR
! LIMA case
- ! Source terms in common for all LIMA budgets
- tzsource%cmnhname = 'NETUR'
- tzsource%clongname = 'negativity correction induced by turbulence'
- tzsource%lavailable = hturb == 'TKEL'
- call Budget_source_add( tbudgets(ibudget), tzsource )
+ ! Source terms in common for all LIMA budgets (except supersaturation)
+ if ( jsv /= nsv_lima_spro ) then
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
- tzsource%cmnhname = 'NEADV'
- tzsource%clongname = 'negativity correction induced by advection'
- tzsource%lavailable = .true.
- call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
- tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negativity correction'
- tzsource%lavailable = .true.
- call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
- tzsource%cmnhname = 'NECON'
- tzsource%clongname = 'negativity correction induced by condensation'
- tzsource%lavailable = .true.
- call Budget_source_add( tbudgets(ibudget), tzsource )
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+ end if
! Source terms specific to each budget
@@ -3093,10 +3127,10 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = odragtree .and. odepotree
call Budget_source_add( tbudgets(ibudget), tzsource )
- tzsource%cmnhname = 'CORR'
- tzsource%clongname = 'correction'
- tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima
+! call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'SEDI'
tzsource%clongname = 'sedimentation'
@@ -3115,7 +3149,7 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'HENU'
tzsource%clongname = 'CCN activation'
- tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1
+ tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'HINC'
@@ -3125,7 +3159,7 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'SELF'
tzsource%clongname = 'self-collection of cloud droplets'
- tzsource%lavailable = lwarm_lima .and. lrain_lima
+ tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima)
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'AUTO'
@@ -3185,16 +3219,16 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'CEDS'
tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = .true.
+ tzsource%lavailable = lwarm_lima
call Budget_source_add( tbudgets(ibudget), tzsource )
else if ( jsv == nsv_lima_nr ) then SV_LIMA
! Rain drops concentration
- tzsource%cmnhname = 'CORR'
- tzsource%clongname = 'correction'
- tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima
+! call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'SEDI'
tzsource%clongname = 'sedimentation'
@@ -3281,7 +3315,7 @@ SV_BUDGETS: do jsv = 1, ksv
! Free CCN concentration
tzsource%cmnhname = 'HENU'
tzsource%clongname = 'CCN activation'
- tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1
+ tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'HONH'
@@ -3304,7 +3338,7 @@ SV_BUDGETS: do jsv = 1, ksv
! Activated CCN concentration
tzsource%cmnhname = 'HENU'
tzsource%clongname = 'CCN activation'
- tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1
+ tzsource%lavailable = lwarm_lima .and. lacti_lima .and. nmod_ccn >= 1 .and. ( .not.lptsplit .or. .not.lsubg_cond )
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'HINC'
@@ -3327,16 +3361,16 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'CEDS'
tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = lscav_lima .and. laero_mass_lima
+ tzsource%lavailable = lscav_lima .and. laero_mass_lima .and. .not.lspro_lima
call Budget_source_add( tbudgets(ibudget), tzsource )
else if ( jsv == nsv_lima_ni ) then SV_LIMA
! Pristine ice crystals concentration
- tzsource%cmnhname = 'CORR'
- tzsource%clongname = 'correction'
- tzsource%lavailable = lptsplit .and. lcold_lima .and. lsnow_lima
- call Budget_source_add( tbudgets(ibudget), tzsource )
+! tzsource%cmnhname = 'CORR'
+! tzsource%clongname = 'correction'
+! tzsource%lavailable = lptsplit .and. lcold_lima .and. lsnow_lima
+! call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'SEDI'
tzsource%clongname = 'sedimentation'
@@ -3415,7 +3449,7 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'CEDS'
tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = .true.
+ tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'CORR2'
@@ -3433,7 +3467,7 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'CEDS'
tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = lcold_lima
+ tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'SCAV'
@@ -3462,7 +3496,7 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'CEDS'
tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = lcold_lima
+ tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3475,7 +3509,7 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'CEDS'
tzsource%clongname = 'adjustment to saturation'
- tzsource%lavailable = lcold_lima
+ tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3487,7 +3521,15 @@ SV_BUDGETS: do jsv = 1, ksv
( ( lhhoni_lima .and. nmod_ccn >= 1 ) .or. ( .not.lptsplit .and. lwarm_lima ) )
call Budget_source_add( tbudgets(ibudget), tzsource )
- end if SV_LIMA
+
+ else if ( jsv == nsv_lima_spro ) then SV_LIMA
+ ! Supersaturation
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ end if SV_LIMA
else if ( jsv >= nsv_elecbeg .and. jsv <= nsv_elecend ) then SV_VAR
@@ -3525,7 +3567,7 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = lwarm_ice
call Budget_source_add( tbudgets(ibudget), tzsource )
- tzsource%cmnhname = 'CDEPI'
+ tzsource%cmnhname = 'DEPI'
tzsource%clongname = 'condensation/deposition on ice'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3593,7 +3635,7 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = lsedic_ice
call Budget_source_add( tbudgets(ibudget), tzsource )
- tzsource%cmnhname = 'CDEPI'
+ tzsource%cmnhname = 'DEPI'
tzsource%clongname = 'condensation/deposition on ice'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3728,7 +3770,7 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
- tzsource%cmnhname = 'CDEPI'
+ tzsource%cmnhname = 'DEPI'
tzsource%clongname = 'condensation/deposition on ice'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3926,7 +3968,7 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%lavailable = lwarm_ice
call Budget_source_add( tbudgets(ibudget), tzsource )
- tzsource%cmnhname = 'CDEPI'
+ tzsource%cmnhname = 'DEPI'
tzsource%clongname = 'condensation/deposition on ice'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -4553,7 +4595,7 @@ subroutine Sourcelist_nml_compact( tpbudget, hbulist )
!The list is generated from the group list
use modd_budget, only: NBULISTMAXLEN, tbudgetdata
- type(tbudgetdata), intent(in) :: tpbudget
+ type(tbudgetdata), intent(in) :: tpbudget
character(len=NBULISTMAXLEN), dimension(:), allocatable, intent(inout) :: hbulist
integer :: idx
diff --git a/src/MNH/ini_cst.f90 b/src/MNH/ini_cst.f90
index 91526bed4b1eb67a892802e447ef6ca75e0b6428..7c3170c4cb7e9e48a0fb645cc70efa30d6a6cae8 100644
--- a/src/MNH/ini_cst.f90
+++ b/src/MNH/ini_cst.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -112,6 +112,13 @@ XG = 9.80665
!* 4. REFERENCE PRESSURE
! -------------------
!
+! Ocean model cst same as in 1D/CMO SURFEX
+! values used in ini_cst to overwrite XP00 and XTH00
+XRH00OCEAN =1024.
+XTH00OCEAN = 286.65
+XSA00OCEAN= 32.6
+XP00OCEAN = 201.E5
+!Atmospheric model
XP00 = 1.E5
XTH00 = 300.
!-------------------------------------------------------------------------------
@@ -132,6 +139,7 @@ XMD = 28.9644E-3
XMV = 18.0153E-3
XRD = XAVOGADRO * XBOLTZ / XMD
XRV = XAVOGADRO * XBOLTZ / XMV
+XEPSILO= XMV/XMD
XCPD = 7.* XRD /2.
XCPV = 4.* XRV
XRHOLW = 1000.
@@ -150,7 +158,11 @@ XALPW = LOG(XESTT) + (XBETAW /XTT) + (XGAMW *LOG(XTT))
XGAMI = (XCI - XCPV) / XRV
XBETAI = (XLSTT/XRV) + (XGAMI * XTT)
XALPI = LOG(XESTT) + (XBETAI /XTT) + (XGAMI *LOG(XTT))
-
+! Values identical to ones used in CMO1D in SURFEX /could be modified
+! Coefficient of thermal expansion of water (K-1)
+XALPHAOC = 1.9E-4
+! Coeff of Haline contraction coeff (S-1)
+XBETAOC= 7.7475E-4
!
! Some machine precision value depending of real4/8 use
!
diff --git a/src/MNH/ini_eol_adnr.f90 b/src/MNH/ini_eol_adnr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9e069eed9e0fb5d1578c5831423efbeb0c2828f8
--- /dev/null
+++ b/src/MNH/ini_eol_adnr.f90
@@ -0,0 +1,135 @@
+!MNH_LIC Copyright 2018-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.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_INI_EOL_ADNR
+! ##########################
+!
+INTERFACE
+!
+SUBROUTINE INI_EOL_ADNR
+!
+END SUBROUTINE INI_EOL_ADNR
+!
+END INTERFACE
+!
+END MODULE MODI_INI_EOL_ADNR
+!
+! ############################################################
+ SUBROUTINE INI_EOL_ADNR
+! ############################################################
+!
+!!**** *INI_EOL_ADNR*
+!!
+!! PURPOSE
+!! -------
+!! Routine to initialized the ADNR (wind turbine model) variables
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! **MODD_EOL_SHARED_IO:
+!! for namelist NAM_EOL_ADNR (INPUT) :
+!! CHARACTER(LEN=100) :: CFARM_CSVDATA ! File to read, with farm data
+!! CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! File to read, turbine data
+!! for ouputs :
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTORQT ! Torque [Nm]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XPOWT ! Power [W]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTHRU_SUM ! Sum of thrust (N)
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTORQ_SUM ! Sum of torque (Nm)
+!! REAL, DIMENSION(:), ALLOCATABLE :: XPOW_SUM ! Sum of power (W)
+!!
+!! **MODD_EOL_ADNR (OUTPUT):
+!! TYPE(FARM) :: TFARM
+!! TYPE(TURBINE) :: TTURBINE
+!! REAL, DIMENSION(:), ALLOCATABLE :: XA_INDU ! Induction factor(NumEol,données)
+!! REAL, DIMENSION(:), ALLOCATABLE :: XCT_D ! Adapted thrust coef (for U_d) [-]
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin * Meteo France & IFPEN *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 31/05/18
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!--------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_EOL_ADNR
+USE MODD_EOL_SHARED_IO, ONLY: CFARM_CSVDATA, CTURBINE_CSVDATA
+USE MODD_EOL_SHARED_IO, ONLY: XTHRUT, XTHRU_SUM
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_FARM_ADNR
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_TURBINE_ADNR
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_FARM_ADNR
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_TURBINE_ADNR
+! To print in output listing
+USE MODD_LUNIT_n, ONLY: TLUOUT
+!
+IMPLICIT NONE
+!
+! Integers
+INTEGER :: ILUOUT ! Output listing file
+!
+!
+!-------------------------------------------------------------------
+!
+!* 1. READING AND ALLOCATING DATA
+! ---------------------------
+! Reading in csv files
+! Allocation of TFARM and TTURBINE inside the function
+!
+!* 1.1 Wind farm data
+!
+CALL READ_CSVDATA_FARM_ADNR(TRIM(CFARM_CSVDATA),TFARM)
+!
+!* 1.2 Wind turbine data
+!
+CALL READ_CSVDATA_TURBINE_ADNR(TRIM(CTURBINE_CSVDATA),TTURBINE)
+!
+!
+!-------------------------------------------------------------------
+!
+!* 2. PRINTING DATA
+! -------------
+!
+!* 2.0 Output listing index
+ILUOUT= TLUOUT%NLU
+!
+!* 2.1 Wind farm data
+!
+CALL PRINT_DATA_FARM_ADNR(ILUOUT,TFARM)
+!
+!* 2.2 Wind turbine data
+!
+CALL PRINT_DATA_TURBINE_ADNR(ILUOUT,TTURBINE)
+!
+!
+!-------------------------------------------------------------------
+!
+!* 3. ALLOCATING VARIABLES
+! --------------------
+!
+ALLOCATE(XA_INDU (TFARM%NNB_TURBINES))
+ALLOCATE(XCT_D (TFARM%NNB_TURBINES))
+ALLOCATE(XTHRUT (TFARM%NNB_TURBINES))
+ALLOCATE(XTHRU_SUM(TFARM%NNB_TURBINES))
+!
+END SUBROUTINE INI_EOL_ADNR
diff --git a/src/MNH/ini_eol_alm.f90 b/src/MNH/ini_eol_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..41938d789ae7c876168bdf7c62004aa320eb2615
--- /dev/null
+++ b/src/MNH/ini_eol_alm.f90
@@ -0,0 +1,439 @@
+!MNH_LIC Copyright 2018-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.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_INI_EOL_ALM
+! ##########################
+!
+INTERFACE
+!
+SUBROUTINE INI_EOL_ALM(PDXX,PDYY)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY ! mesh size
+!
+END SUBROUTINE INI_EOL_ALM
+!
+END INTERFACE
+!
+END MODULE MODI_INI_EOL_ALM
+!
+! ############################################################
+ SUBROUTINE INI_EOL_ALM(PDXX,PDYY)
+! ############################################################
+!
+!!**** *INI_EOL_ALM* - routine to initialize the Actuator Line Model
+!! to simulate wind turbines
+!!
+!! PURPOSE
+!! -------
+!! Routine to initialized the ALM (wind turbine model) variables
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! *MODD_EOL_SHARED_IO:
+!! *Namelist NAM_EOL_ADNR (INPUT) :
+!! CHARACTER(LEN=100) :: CFARM_CSVDATA ! File to read, with farm data
+!! CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! File to read, turbine data
+!! CHARACTER(LEN=100) :: CBLADE_CSVDATA ! Blade file to read
+!! CHARACTER(LEN=100) :: CAIRFOIL_CSVDATA ! Airfoil file to read
+!! *for ouputs :
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTORQT ! Torque [Nm]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XPOWT ! Power [W]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTHRU_SUM ! Sum of thrust (N)
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTORQ_SUM ! Sum of torque (Nm)
+!! REAL, DIMENSION(:), ALLOCATABLE :: XPOW_SUM ! Sum of power (W)
+!!
+!! INTEGER :: NNB_BLAELT ! Number of blade elements
+!!
+!! *MODD_EOL_ALM (OUTPUT):
+!! TYPE(FARM) :: TFARM
+!! TYPE(TURBINE) :: TTURBINE
+!! TYPE(BLADE) :: TBLADE
+!! TYPE(AIRFOIL), DIMENSION(:), ALLOCATABLE :: TAIRFOIL
+!! REAL, DIMENSION(:,:,:), ALLOCATABLE :: XELT_RAD ! Blade elements radius [m]
+!! REAL, DIMENSION(:,:,:), ALLOCATABLE :: XAOA_GLB ! Angle of attack of an element [rad]
+!! REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFLIFT_GLB ! Lift force, parallel to Urel [N]
+!! REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFDRAG_GLB ! Drag force, perpendicular to Urel [N]
+!! REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RE_GLB ! Aerodyn. force (lift+drag) in RE [N]
+!! REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RG_GLB ! Aerodyn. force (lift+drag) in RG [N]
+!! REAL, DIMENSION(:,:,:), ALLOCATABLE :: XAOA_SUM ! Sum of angle of attack [rad]
+!! REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RE_SUM ! Sum of aerodyn. force (lift+drag) in RE [N]
+!
+!! *MODD_EOL_KINEMATICS
+!! Positions
+!! Orientations
+!! Velocities
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin * Meteo France & IFPEN *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 31/05/18
+!! Modification 10/11/20 (PA. Joulin) Updated for a main version
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 Modules
+!
+USE MODD_EOL_ALM
+USE MODD_EOL_SHARED_IO, ONLY: CFARM_CSVDATA
+USE MODD_EOL_SHARED_IO, ONLY: CTURBINE_CSVDATA
+USE MODD_EOL_SHARED_IO, ONLY: CBLADE_CSVDATA
+USE MODD_EOL_SHARED_IO, ONLY: CAIRFOIL_CSVDATA
+USE MODD_EOL_SHARED_IO, ONLY: XTHRUT, XTORQT, XPOWT
+USE MODD_EOL_SHARED_IO, ONLY: XTHRU_SUM, XTORQ_SUM, XPOW_SUM
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_FARM_ALM
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_TURBINE_ALM
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_BLADE_ALM
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_AIRFOIL_ALM
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_FARM_ALM
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_TURBINE_ALM
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_BLADE_ALM
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_AIRFOIL_ALM
+USE MODD_EOL_KINE_ALM
+USE MODI_EOL_MATHS
+! To print in output listing
+USE MODD_LUNIT_n, ONLY: TLUOUT
+! Constant
+USE MODD_CST, ONLY: XPI
+! To know the grid
+USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZS
+USE MODE_ll, ONLY: GET_INDICE_ll
+USE MODD_PARAMETERS, ONLY: JPVEXT
+! MPI stuffs
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
+USE MODD_PRECISION, ONLY: MNHREAL_MPI
+USE MODD_MPIF, ONLY: MPI_SUM
+!
+!* 0.2 Variables
+!
+IMPLICIT NONE
+! Interface
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY ! mesh size
+!
+! Some loop controlers
+! .. for wind turbines
+INTEGER :: JROT ! Rotor index
+INTEGER :: JTELT ! Tower element index
+INTEGER :: JNELT ! Nacelle element index
+INTEGER :: JBLA ! Blade index
+INTEGER :: JBELT ! Balde element index
+! .. for domain
+INTEGER :: IIB,IJB,IKB ! Begin of a CPU domain
+INTEGER :: IIE,IJE ! End of a CPU domain
+INTEGER :: JI,JJ ! Domain index
+! Some variables to be coder-friendly
+INTEGER :: INB_WT, INB_B, INB_BELT ! Total numbers of wind turbines, blades, and blade elt
+INTEGER :: INB_TELT, INB_NELT ! Total numbers of tower elt, and nacelle elt
+REAL :: ZRAD ! Radius along the blade
+! Tower base folowing the terrain
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZPOSINI_TOWO_RG ! Initial tower origin position
+INTEGER :: IINFO ! code info return
+!
+!-------------------------------------------------------------------
+!
+!* 1. READING AND ALLOCATING DATA
+! ---------------------------
+! Reading in csv files
+! Allocation of TFARM, TTURBINE, TBLADE and TAIRFOILS inside the function
+!
+!* 1.1 Wind farm data
+!
+CALL READ_CSVDATA_FARM_ALM(TRIM(CFARM_CSVDATA),TFARM)
+!
+!* 1.2 Wind turbine data
+!
+CALL READ_CSVDATA_TURBINE_ALM(TRIM(CTURBINE_CSVDATA),TTURBINE)
+!
+!* 1.3 Blade data
+!
+CALL READ_CSVDATA_BLADE_ALM(TRIM(CBLADE_CSVDATA),TTURBINE,TBLADE)
+!
+!* 1.4 Airfoil data
+!
+CALL READ_CSVDATA_AIRFOIL_ALM(TRIM(CAIRFOIL_CSVDATA),TBLADE,TAIRFOIL)
+!
+!
+!-------------------------------------------------------------------
+!
+!* 2. PRINTING DATA
+! -------------
+!
+!* 2.1 Wind farm data
+!
+CALL PRINT_DATA_FARM_ALM(TLUOUT%NLU,TFARM)
+!
+!* 2.2 Wind turbine data
+!
+CALL PRINT_DATA_TURBINE_ALM(TLUOUT%NLU,TTURBINE)
+!
+!* 2.3 Blade data
+!
+CALL PRINT_DATA_BLADE_ALM(TLUOUT%NLU,TBLADE)
+!
+!* 2.4 Airfoil data
+!
+CALL PRINT_DATA_AIRFOIL_ALM(TLUOUT%NLU,TAIRFOIL)
+!
+!
+!-------------------------------------------------------------------
+!
+!* 3. ALLOCATING VARIABLES
+! --------------------
+!
+!* 3.0 Preliminaries
+INB_WT = TFARM%NNB_TURBINES
+INB_B = TTURBINE%NNB_BLADES
+INB_BELT = TBLADE%NNB_BLAELT
+! Hard coded variables, but they will be usefull in next updates
+INB_TELT = 2
+INB_NELT = 2
+!
+!* 3.1 MODD_EOL_ALM variables
+! at t
+ALLOCATE(XELT_RAD (INB_WT,INB_B,INB_BELT ))
+ALLOCATE(XAOA_GLB (INB_WT,INB_B,INB_BELT ))
+ALLOCATE(XFDRAG_GLB (INB_WT,INB_B,INB_BELT ))
+ALLOCATE(XFLIFT_GLB (INB_WT,INB_B,INB_BELT ))
+ALLOCATE(XFAERO_RE_GLB(INB_WT,INB_B,INB_BELT,3))
+ALLOCATE(XFAERO_RG_GLB(INB_WT,INB_B,INB_BELT,3))
+ALLOCATE(XTHRUT (INB_WT ))
+ALLOCATE(XTORQT (INB_WT ))
+ALLOCATE(XPOWT (INB_WT ))
+! for mean values
+ALLOCATE(XAOA_SUM (INB_WT,INB_B,INB_BELT ))
+ALLOCATE(XFAERO_RE_SUM(INB_WT,INB_B,INB_BELT,3))
+ALLOCATE(XTHRU_SUM (INB_WT))
+ALLOCATE(XTORQ_SUM (INB_WT))
+ALLOCATE(XPOW_SUM (INB_WT))
+!
+!* 3.2 MODD_EOL_KINE_ALM variables
+!
+! - ORIENTATION MATRIX -
+ALLOCATE(XMAT_RG_RT(INB_WT,3,3))
+ALLOCATE(XMAT_RG_RN(INB_WT,3,3))
+ALLOCATE(XMAT_RT_RN(INB_WT,3,3))
+ALLOCATE(XMAT_RG_RH(INB_WT,3,3))
+ALLOCATE(XMAT_RH_RG(INB_WT,3,3))
+ALLOCATE(XMAT_RN_RH(INB_WT,3,3))
+ALLOCATE(XMAT_RG_RB(INB_WT,INB_B,3,3))
+ALLOCATE(XMAT_RH_RB(INB_WT,INB_B,3,3))
+ALLOCATE(XMAT_RG_RE(INB_WT,INB_B,INB_BELT,3,3))
+ALLOCATE(XMAT_RE_RG(INB_WT,INB_B,INB_BELT,3,3))
+ALLOCATE(XMAT_RB_RE(INB_WT,INB_B,INB_BELT,3,3))
+!
+! - POSITIONS & ORIENTATIONS -
+! Tower
+ALLOCATE(ZPOSINI_TOWO_RG (INB_WT,3) ) ! Initial tower origin pos. in RG
+ALLOCATE(XPOSINI_TOWO_RG (INB_WT,3) ) ! Initial tower origin pos. in RG
+ALLOCATE(XPOS_TOWO_RG (INB_WT,3) ) ! Current tower origin pos. in RG
+ALLOCATE(XPOS_TELT_RG (INB_WT,INB_TELT,3) ) ! Current tower element pos. in RG
+ALLOCATE(XPOS_TELT_RT (INB_WT,INB_TELT,3) ) ! Current tower element pos. in RT
+ALLOCATE(XANGINI_TOW_RG (INB_WT,3) ) ! Initial tower ori. in RG
+! Nacelle
+ALLOCATE(XPOSINI_NACO_RT (INB_WT,3) ) ! Initial nacelle origin pos. in RT
+ALLOCATE(XPOS_NACO_RG (INB_WT,3) ) ! Current nacelle origin pos. in RG
+ALLOCATE(XPOS_NELT_RG (INB_WT,INB_NELT,3) ) ! Current nacelle element pos. in RG
+ALLOCATE(XPOS_NELT_RN (INB_WT,INB_NELT,3) ) ! Current nacelle element pos. in RN
+ALLOCATE(XANGINI_NAC_RT (INB_WT,3) ) ! Initial nacelle ori. in RT
+! Hub
+ALLOCATE(XPOSINI_HUB_RN (INB_WT,3) ) ! Initial hub pos. in RN
+ALLOCATE(XPOS_HUB_RG (INB_WT,3) ) ! Current hub pos. in RG
+ALLOCATE(XANGINI_HUB_RN (INB_WT,3) ) ! Initial hub ori. in RN
+! Blade
+ALLOCATE(XPOSINI_BLA_RH (INB_WT,INB_B,3) ) ! Initial blade root pos. in RH
+ALLOCATE(XPOS_BLA_RG (INB_WT,INB_B,3) ) ! Current blade root pos. in RG
+ALLOCATE(XANGINI_BLA_RH (INB_WT,INB_B,3) ) ! Initial blade ori. RH
+! Element
+ALLOCATE(XPOS_ELT_RB (INB_WT,INB_B,INB_BELT,3) ) ! Element pos. in RB
+ALLOCATE(XPOS_ELT_RG (INB_WT,INB_B,INB_BELT,3) ) ! Element pos. in RG
+ALLOCATE(XPOS_SEC_RB (INB_WT,INB_B,INB_BELT+1,3)) ! Section pos. in RB
+ALLOCATE(XPOS_SEC_RG (INB_WT,INB_B,INB_BELT+1,3)) ! Section pos. in RG
+ALLOCATE(XANGINI_ELT_RB (INB_WT,INB_B,INB_BELT,3) ) ! Initial element ori. in RB
+ALLOCATE(XTWIST_ELT (INB_WT,INB_B,INB_BELT) ) ! Element twist in RB
+ALLOCATE(XCHORD_ELT (INB_WT,INB_B,INB_BELT) ) ! Element chord lenght
+ALLOCATE(XSURF_ELT (INB_WT,INB_B,INB_BELT) ) ! Element lift surface
+!
+! - STRUCTURAL VELOCITIES -
+! Tower
+ALLOCATE(XTVEL_TOWO_RG (INB_WT,3) ) ! Tower base trans. vel. in RG
+ALLOCATE(XTVEL_TELT_RG (INB_WT,INB_TELT,3) ) ! Tower element trans. vel. in RG
+ALLOCATE(XRVEL_RT_RG (INB_WT,3) ) ! RT/RG rot. vel.
+! Nacelle
+ALLOCATE(XTVEL_NACO_RT (INB_WT,3) ) ! Nacelle base trans. vel. in RT
+ALLOCATE(XTVEL_NELT_RG (INB_WT,INB_NELT,3) ) ! Nacelle element trans. vel. in RG
+ALLOCATE(XRVEL_RN_RT (INB_WT,3) ) ! RN/RT rot. vel.
+ALLOCATE(XRVEL_RN_RG (INB_WT,3) ) ! RN/RG rot. vel.
+! Hub
+ALLOCATE(XTVEL_HUB_RN (INB_WT,3) ) ! Hub base trans. vel. in RN
+ALLOCATE(XTVEL_HUB_RG (INB_WT,3) ) ! Hub base trans. vel. in RG
+ALLOCATE(XRVEL_RH_RN (INB_WT,3) ) ! RH/RT rot. vel.
+ALLOCATE(XRVEL_RH_RG (INB_WT,3) ) ! RH/RG rot. vel.
+! Blade
+ALLOCATE(XTVEL_BLA_RH (INB_WT,INB_B,3) ) ! Blade base trans. vel. in RH
+ALLOCATE(XTVEL_BLA_RG (INB_WT,INB_B,3) ) ! Blade base trans. vel. in RG
+ALLOCATE(XRVEL_RB_RH (INB_WT,INB_B,3) ) ! RB/RH rot. vel.
+ALLOCATE(XRVEL_RB_RG (INB_WT,INB_B,3) ) ! RB/RG rot. vel.
+! Elements
+ALLOCATE(XTVEL_ELT_RB (INB_WT,INB_B,INB_BELT,3) ) ! Element base trans. vel. in RB
+ALLOCATE(XTVEL_ELT_RG (INB_WT,INB_B,INB_BELT,3) ) ! Element base trans. vel. in RG
+ALLOCATE(XTVEL_ELT_RE (INB_WT,INB_B,INB_BELT,3) ) ! Element base trans. vel. in RE
+ALLOCATE(XRVEL_RE_RB (INB_WT,INB_B,INB_BELT,3) ) ! RE/RB rot. vel.
+ALLOCATE(XRVEL_RE_RG (INB_WT,INB_B,INB_BELT,3) ) ! RE/RG rot. vel.
+!
+!-------------------------------------------------------------------
+!
+!* 4. FIRST BUILDING OF WIND TURBINES
+! -------------------------------
+!
+!* 4.1 Preliminaries
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) ! Get begin and end domain index (CPU)
+IKB=1+JPVEXT ! Vertical begin index
+!
+XPOS_REF(:) = 0d0 ! Global Origin
+!
+!
+!* 4.2 Tower
+DO JROT=1, INB_WT
+! Velocities (Rotor, (XYZ))
+ XTVEL_TOWO_RG(JROT,:) = 0d0
+ XRVEL_RT_RG(JROT,:) = 0d0
+! Positions
+ ! Init
+ ZPOSINI_TOWO_RG(JROT,1) = 0
+ ZPOSINI_TOWO_RG(JROT,2) = 0
+ ZPOSINI_TOWO_RG(JROT,3) = 0
+ ! Finding the elevation at the WT position
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF (TFARM%XPOS_X(JROT) >= XXHAT(JI) .AND. &
+ TFARM%XPOS_X(JROT) < XXHAT(JI) + PDXX(JI,JJ,IKB)) THEN
+ IF (TFARM%XPOS_Y(JROT) >= XYHAT(JJ) .AND. &
+ TFARM%XPOS_Y(JROT) < XYHAT(JJ) + PDYY(JI,JJ,IKB)) THEN
+ ! Horizontal position
+ ZPOSINI_TOWO_RG(JROT,1) = TFARM%XPOS_X(JROT) ! Tower base position
+ ZPOSINI_TOWO_RG(JROT,2) = TFARM%XPOS_Y(JROT)
+ ! Finding the elevation at the WT position
+ ZPOSINI_TOWO_RG(JROT,3) = XZS(JI,JJ)
+ END IF
+ END IF
+ END DO
+ END DO
+ ! Sharing information
+ CALL MPI_ALLREDUCE(ZPOSINI_TOWO_RG, XPOSINI_TOWO_RG, SIZE(XPOSINI_TOWO_RG),&
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+ ! Tower elements
+ DO JTELT=1, INB_TELT
+ XPOS_TELT_RT(JROT,JTELT,1) = 0d0
+ XPOS_TELT_RT(JROT,JTELT,2) = 0d0
+ XPOS_TELT_RT(JROT,JTELT,3) = (JTELT-1)*(TTURBINE%XH_HEIGHT)/(INB_TELT-1)
+ END DO
+ ! Angles
+ XANGINI_TOW_RG(JROT,1) = 0d0
+ XANGINI_TOW_RG(JROT,2) = 0d0
+ XANGINI_TOW_RG(JROT,3) = 0d0
+!
+!
+!* 4.3 Nacelle
+! Velocities
+ XTVEL_NACO_RT(JROT,:) = 0d0
+ XRVEL_RN_RT(JROT,:) = 0d0
+! Positions (Rotor, (XYZ)) ! From last point of tower
+ ! Origin
+ XPOSINI_NACO_RT(JROT,:) = 0d0 ! Distance between nacelle base and tower top
+ ! Elements
+ DO JNELT=1, INB_NELT
+ XPOS_NELT_RN(JROT,JNELT,1) = (JNELT-1)*TTURBINE%XH_DEPORT/(INB_NELT-1)
+ XPOS_NELT_RN(JROT,JNELT,2) = 0d0
+ XPOS_NELT_RN(JROT,JNELT,3) = 0d0
+ END DO
+ ! Angles
+ XANGINI_NAC_RT(JROT,1) = 0d0
+ XANGINI_NAC_RT(JROT,2) = 0d0
+ XANGINI_NAC_RT(JROT,3) = XPI + TFARM%XNAC_YAW(JROT)
+!
+!
+!* 4.4 Hub
+! Velocities
+ XTVEL_HUB_RN(JROT,:) = 0d0
+ XRVEL_RH_RN(JROT,1) = 0d0
+ XRVEL_RH_RN(JROT,2) = 0d0
+ XRVEL_RH_RN(JROT,3) = TFARM%XOMEGA(JROT)
+! Position (Rotor, (XYZ)) ! From nacelle last point
+ XPOSINI_HUB_RN(JROT,1) = 0d0
+ XPOSINI_HUB_RN(JROT,2) = 0d0
+ XPOSINI_HUB_RN(JROT,3) = 0d0
+ XANGINI_HUB_RN(JROT,1) = 0d0
+ XANGINI_HUB_RN(JROT,2) = XPI/2d0 - TTURBINE%XNAC_TILT
+ XANGINI_HUB_RN(JROT,3) = 0d0
+!
+!
+!* 4.5 Blades
+ DO JBLA=1, INB_B
+! Velocities
+ XRVEL_RB_RH(JROT,JBLA,:) = 0d0
+ XTVEL_BLA_RH(JROT,JBLA,:) = 0d0
+! Position (Rotor, Blade, (XYZ)) ! From hub point
+ XPOSINI_BLA_RH(JROT,JBLA,:) = 0d0
+ XANGINI_BLA_RH(JROT,JBLA,1) = 0d0
+ XANGINI_BLA_RH(JROT,JBLA,2) = 0d0
+ XANGINI_BLA_RH(JROT,JBLA,3) = (JBLA-1)*2d0*XPI/INB_B
+!
+!
+!* 4.5 Elements
+! - Positioning of sections (cuts)
+ DO JBELT=1, INB_BELT+1
+
+ XPOS_SEC_RB(JROT,JBLA,JBELT,1) = TTURBINE%XR_MIN + (JBELT-1) &
+ * (TTURBINE%XR_MAX - TTURBINE%XR_MIN)/INB_BELT
+ XPOS_SEC_RB(JROT,JBLA,JBELT,2) = 0d0
+ XPOS_SEC_RB(JROT,JBLA,JBELT,3) = 0d0
+ ENDDO
+ DO JBELT=1, INB_BELT
+! - Positioning of centers (points of application)
+ XPOS_ELT_RB(JROT,JBLA,JBELT,1) = XPOS_SEC_RB(JROT,JBLA,JBELT,1) &
+ + (XPOS_SEC_RB(JROT,JBLA,JBELT+1,1) &
+ - XPOS_SEC_RB(JROT,JBLA,JBELT,1))/2d0
+ XPOS_ELT_RB(JROT,JBLA,JBELT,2) = 0d0
+ XPOS_ELT_RB(JROT,JBLA,JBELT,3) = 0d0
+ XELT_RAD(JROT,JBLA,JBELT) = XPOS_ELT_RB(JROT,JBLA,JBELT,1)
+! - Calculating chord and twist
+ ZRAD = XELT_RAD(JROT,JBLA,JBELT)
+ XCHORD_ELT(JROT,JBLA,JBELT) = INTERP_SPLCUB(ZRAD, TBLADE%XRAD, TBLADE%XCHORD)
+ XTWIST_ELT(JROT,JBLA,JBELT) = INTERP_SPLCUB(ZRAD, TBLADE%XRAD, TBLADE%XTWIST)
+! - Calculating lifting surface
+ XSURF_ELT(JROT,JBLA,JBELT) = XCHORD_ELT(JROT,JBLA,JBELT) &
+ * (XPOS_SEC_RB(JROT,JBLA,JBELT+1,1) &
+ - XPOS_SEC_RB(JROT,JBLA,JBELT,1))
+! Velocities
+ XRVEL_RE_RB(JROT,JBLA,JBELT,:) = 0d0
+ XTVEL_ELT_RB(JROT,JBLA,JBELT,:) = 0d0
+! Orientation
+ XANGINI_ELT_RB(JROT,JBLA,JBELT,1) = -XPI/2d0 + TFARM%XBLA_PITCH(JROT) &
+ + XTWIST_ELT(JROT,JBLA,JBELT)
+ XANGINI_ELT_RB(JROT,JBLA,JBELT,2) = XPI/2d0
+ XANGINI_ELT_RB(JROT,JBLA,JBELT,3) = XPI/2d0
+ END DO ! Loop element
+ END DO ! Loop blade
+END DO ! Loop turbine
+!
+END SUBROUTINE INI_EOL_ALM
diff --git a/src/MNH/ini_lima.f90 b/src/MNH/ini_lima.f90
index 58257019d57ec24e9097d95dc40c878da1e07e01..d90f1e160430b979866f105574478d30d2d5f7dd 100644
--- a/src/MNH/ini_lima.f90
+++ b/src/MNH/ini_lima.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-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.
@@ -136,18 +136,16 @@ IF (ALLOCATED(XRTMIN)) RETURN ! In case of nesting microphysics, constants of
!
! Set bounds for mixing ratios and concentrations
ALLOCATE( XRTMIN(7) )
-XRTMIN(1) = 1.0E-20 ! rv
-XRTMIN(2) = 1.0E-20 ! rc
-!XRTMIN(3) = 1.0E-20 ! rr
-XRTMIN(3) = 1.0E-17 ! rr
-XRTMIN(4) = 1.0E-20 ! ri
-XRTMIN(5) = 1.0E-15 ! rs
-XRTMIN(6) = 1.0E-15 ! rg
-XRTMIN(7) = 1.0E-15 ! rh
+XRTMIN(1) = 1.0E-10 ! rv
+XRTMIN(2) = 1.0E-10 ! rc
+XRTMIN(3) = 1.0E-10 ! rr
+XRTMIN(4) = 1.0E-10 ! ri
+XRTMIN(5) = 1.0E-10 ! rs
+XRTMIN(6) = 1.0E-10 ! rg
+XRTMIN(7) = 1.0E-10 ! rh
ALLOCATE( XCTMIN(7) )
XCTMIN(1) = 1.0 ! Not used
XCTMIN(2) = 1.0E-3 ! Nc
-!XCTMIN(3) = 1.0E+1 ! Nr
XCTMIN(3) = 1.0E-3 ! Nr
XCTMIN(4) = 1.0E-3 ! Ni
XCTMIN(5) = 1.0E-3 ! Not used
diff --git a/src/MNH/ini_lima_warm.f90 b/src/MNH/ini_lima_warm.f90
index 0afeea4928ba710840a31261e0f7d62fa44e73c1..3fac15aaefe54e303ddb025473017407a5a60b6d 100644
--- a/src/MNH/ini_lima_warm.f90
+++ b/src/MNH/ini_lima_warm.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-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.
+!-----------------------------------------------------------------
! #########################
MODULE MODI_INI_LIMA_WARM
! #########################
@@ -276,6 +277,8 @@ XAHENINTP2 = 0.5*REAL(NAHEN-1) - XTT
! G
!
ALLOCATE (XAHENG(NAHEN))
+ALLOCATE (XAHENG2(NAHEN))
+ALLOCATE (XAHENG3(NAHEN))
ALLOCATE (XPSI1(NAHEN))
ALLOCATE (XPSI3(NAHEN))
XCSTHEN = 1.0 / ( XRHOLW*2.0*XPI )
@@ -288,6 +291,8 @@ DO J1 = 1,NAHEN
(XDIVA*EXP(XALPW-(XBETAW/ZTT)-(XGAMW*ALOG(ZTT)))) &
+ (ZLV/ZTT)**2/(XTHCO*XRV) ) )
XAHENG(J1) = XCSTHEN/(ZG)**(3./2.)
+ XAHENG2(J1) = 1/(ZG)**(1./2.) * GAMMA_X0D(XNUC+1./XALPHAC)/GAMMA_X0D(XNUC)
+ XAHENG3(J1) = (ZG) * GAMMA_X0D(XNUC+1./XALPHAC)/GAMMA_X0D(XNUC)
END DO
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_mean_field.f90 b/src/MNH/ini_mean_field.f90
index 36eafb4586599ef980f804c73ac1674cea7448c8..32ddfbb8847adcfe2cbe1887368abee74b2370b9 100644
--- a/src/MNH/ini_mean_field.f90
+++ b/src/MNH/ini_mean_field.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -48,6 +48,8 @@ END MODULE MODI_INI_MEAN_FIELD
!! -------------
!! Original 11/12/09
!! 10/2016 (C.Lac) Add max values
+!! 02/2021 (T.Nagel) add passive scalar (XSVT) and UW wind component
+!! 05/2021 (PA.Joulin) add wind turbine variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -57,11 +59,17 @@ END MODULE MODI_INI_MEAN_FIELD
USE MODD_MEAN_FIELD_n
USE MODD_MEAN_FIELD
USE MODD_PARAM_n
-
+USE MODD_EOL_MAIN, ONLY: LMAIN_EOL, CMETH_EOL, NMODEL_EOL
+USE MODD_EOL_SHARED_IO, ONLY: XTHRU_SUM, XTORQ_SUM, XPOW_SUM
+USE MODD_EOL_ALM
+USE MODE_MODELN_HANDLER
+!
IMPLICIT NONE
!
+INTEGER :: IMI !Current model index
+!
MEAN_COUNT = 0
-
+!
XUM_MEAN = 0.0
XVM_MEAN = 0.0
XWM_MEAN = 0.0
@@ -69,14 +77,31 @@ XTHM_MEAN = 0.0
XTEMPM_MEAN = 0.0
IF (CTURB /= 'NONE') XTKEM_MEAN = 0.0
XPABSM_MEAN = 0.0
-
+XSVT_MEAN = 0.0
+!
XU2_MEAN = 0.0
XV2_MEAN = 0.0
XW2_MEAN = 0.0
+XUW_MEAN = 0.0
XTH2_MEAN = 0.0
XTEMP2_MEAN = 0.0
XPABS2_MEAN = 0.0
-
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+IF (LMAIN_EOL .AND. IMI==NMODEL_EOL) THEN
+ SELECT CASE(CMETH_EOL)
+ CASE('ADNR') ! Actuator Disc Non-Rotating
+ XTHRU_SUM = 0.0
+ CASE('ALM') ! Actuator Line Method
+ XAOA_SUM = 0.0
+ XFAERO_RE_SUM = 0.0
+ XTHRU_SUM = 0.0
+ XTORQ_SUM = 0.0
+ XPOW_SUM = 0.0
+ END SELECT
+END IF
+!
+!
XUM_MAX = -1.E20
XVM_MAX = -1.E20
XWM_MAX = -1.E20
diff --git a/src/MNH/ini_micron.f90 b/src/MNH/ini_micron.f90
index 7f4e0225444fc2c24a8ea7b01af2a5a865b1cadd..b8ab64995358f8d40a6ceebeaaf03aba89fe02de 100644
--- a/src/MNH/ini_micron.f90
+++ b/src/MNH/ini_micron.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-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.
@@ -99,13 +99,7 @@ USE MODE_SET_CONC_LIMA
!
USE MODD_NSV, ONLY : NSV,NSV_CHEM,NSV_C2R2BEG,NSV_C2R2END, &
NSV_C1R3BEG,NSV_C1R3END, &
- NSV_LIMA, NSV_LIMA_BEG, NSV_LIMA_END, &
- NSV_LIMA_NC, NSV_LIMA_NR, &
- NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
- NSV_LIMA_SCAVMASS, &
- NSV_LIMA_NI, &
- NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, &
- NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
+ NSV_LIMA_BEG, NSV_LIMA_END
USE MODD_PARAM_LIMA, ONLY : LSCAV, MSEDC=>LSEDC, MACTIT=>LACTIT, MDEPOC=>LDEPOC
USE MODD_LIMA_PRECIP_SCAVENGING_n
!
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index dea7f4bcc0509d1db7b63b85daec8b7c3e4d1747..b58702a5417dbb08559eb8afb026e01796c94e1e 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -289,6 +289,10 @@ END MODULE MODI_INI_MODEL_n
! P. Wautelet 07/06/2019: allocate lookup tables for optical properties only when needed
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! S. Riette 04/2020: XHL* fields
+! F. Auguste 02/2021: add IBM
+! T.Nigel 02/2021: add turbulence recycling
+! J.L.Redelsperger 06/2011: OCEAN case
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -339,6 +343,7 @@ USE MODD_DYN_n
USE MODD_DYNZD
USE MODD_DYNZD_n
USE MODD_ELEC_n, only: XCION_POS_FW, XCION_NEG_FW
+USE MODD_EOL_MAIN
USE MODD_FIELD_n
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
@@ -349,6 +354,7 @@ USE MODD_FRC_n
USE MODD_GET_n
USE MODD_GRID_n
USE MODD_GRID, only: XLONORI,XLATORI
+USE MODD_IBM_PARAM_n, only: LIBM, XIBM_IEPS, XIBM_LS, XIBM_XMUT
USE MODD_IO, only: CIO_DIR, TFILEDATA, TFILE_DUMMY
USE MODD_IO_SURF_MNH, only: IO_SURF_MNH_MODEL
USE MODD_LATZ_EDFLX
@@ -364,6 +370,7 @@ USE MODD_NESTING, only: CDAD_NAME, NDAD, NDT_2_WAY, NDTRATIO, NDXRATIO
USE MODD_NSV
USE MODD_NSV
USE MODD_NUDGING_n, only: LNUDGING
+USE MODD_OCEANH
USE MODD_OUT_n
USE MODD_PARAMETERS
USE MODD_PARAM_KAFR_n
@@ -375,6 +382,7 @@ USE MODD_PASPOL_n
USE MODD_PAST_FIELD_n
use modd_precision, only: LFIINT
USE MODD_RADIATIONS_n
+USE MODD_RECYCL_PARAM_n
USE MODD_REF
USE MODD_REF_n
USE MODD_RELFRC_n
@@ -427,6 +435,8 @@ USE MODI_INI_DEEP_CONVECTION
USE MODI_INI_DRAG
USE MODI_INI_DYNAMICS
USE MODI_INI_ELEC_n
+USE MODI_INI_EOL_ADNR
+USE MODI_INI_EOL_ALM
USE MODI_INI_LES_N
USE MODI_INI_LG
USE MODI_INI_LW_SETUP
@@ -513,11 +523,12 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMIS ! emissivity
REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSRAD ! surface temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZIBM_LS ! LevelSet IBM
!
!
INTEGER, DIMENSION(:,:),ALLOCATABLE :: IINDEX ! indices of non-zero terms
INTEGER, DIMENSION(:),ALLOCATABLE :: IIND
-INTEGER :: JM
+INTEGER :: JM, JT
!
!------------------------------------------
! Dummy pointers needed to correct an ifort Bug
@@ -695,6 +706,41 @@ CALL UPDATE_NSV(KMI)
!
!* 3. ALLOCATE MEMORY
! -----------------
+! * Module RECYCL
+!
+IF (LRECYCL) THEN
+!
+ NR_COUNT = 0
+!
+ ALLOCATE(XUMEANW(IJU,IKU,INT(XNUMBELT))) ; XUMEANW = 0.0
+ ALLOCATE(XVMEANW(IJU,IKU,INT(XNUMBELT))) ; XVMEANW = 0.0
+ ALLOCATE(XWMEANW(IJU,IKU,INT(XNUMBELT))) ; XWMEANW = 0.0
+ ALLOCATE(XUMEANN(IIU,IKU,INT(XNUMBELT))) ; XUMEANN = 0.0
+ ALLOCATE(XVMEANN(IIU,IKU,INT(XNUMBELT))) ; XVMEANN = 0.0
+ ALLOCATE(XWMEANN(IIU,IKU,INT(XNUMBELT))) ; XWMEANN = 0.0
+ ALLOCATE(XUMEANE(IJU,IKU,INT(XNUMBELT))) ; XUMEANE = 0.0
+ ALLOCATE(XVMEANE(IJU,IKU,INT(XNUMBELT))) ; XVMEANE = 0.0
+ ALLOCATE(XWMEANE(IJU,IKU,INT(XNUMBELT))) ; XWMEANE = 0.0
+ ALLOCATE(XUMEANS(IIU,IKU,INT(XNUMBELT))) ; XUMEANS = 0.0
+ ALLOCATE(XVMEANS(IIU,IKU,INT(XNUMBELT))) ; XVMEANS = 0.0
+ ALLOCATE(XWMEANS(IIU,IKU,INT(XNUMBELT))) ; XWMEANS = 0.0
+ ALLOCATE(XTBV(IIU,IJU,IKU)) ; XTBV = 0.0
+ELSE
+ ALLOCATE(XUMEANW(0,0,0))
+ ALLOCATE(XVMEANW(0,0,0))
+ ALLOCATE(XWMEANW(0,0,0))
+ ALLOCATE(XUMEANN(0,0,0))
+ ALLOCATE(XVMEANN(0,0,0))
+ ALLOCATE(XWMEANN(0,0,0))
+ ALLOCATE(XUMEANE(0,0,0))
+ ALLOCATE(XVMEANE(0,0,0))
+ ALLOCATE(XWMEANE(0,0,0))
+ ALLOCATE(XUMEANS(0,0,0))
+ ALLOCATE(XVMEANS(0,0,0))
+ ALLOCATE(XWMEANS(0,0,0))
+ ALLOCATE(XTBV (0,0,0))
+END IF
+!
!
!* 3.1 Module MODD_FIELD_n
!
@@ -707,6 +753,7 @@ IF (LMEAN_FIELD) THEN
ALLOCATE(XWM_MEAN(IIU,IJU,IKU)) ; XWM_MEAN = 0.0
ALLOCATE(XTHM_MEAN(IIU,IJU,IKU)) ; XTHM_MEAN = 0.0
ALLOCATE(XTEMPM_MEAN(IIU,IJU,IKU)) ; XTEMPM_MEAN = 0.0
+ ALLOCATE(XSVT_MEAN(IIU,IJU,IKU)) ; XSVT_MEAN = 0.0
IF (CTURB/='NONE') THEN
ALLOCATE(XTKEM_MEAN(IIU,IJU,IKU))
XTKEM_MEAN = 0.0
@@ -718,6 +765,7 @@ IF (LMEAN_FIELD) THEN
ALLOCATE(XU2_MEAN(IIU,IJU,IKU)) ; XU2_MEAN = 0.0
ALLOCATE(XV2_MEAN(IIU,IJU,IKU)) ; XV2_MEAN = 0.0
ALLOCATE(XW2_MEAN(IIU,IJU,IKU)) ; XW2_MEAN = 0.0
+ ALLOCATE(XUW_MEAN(IIU,IJU,IKU)) ; XUW_MEAN = 0.0
ALLOCATE(XTH2_MEAN(IIU,IJU,IKU)) ; XTH2_MEAN = 0.0
ALLOCATE(XTEMP2_MEAN(IIU,IJU,IKU)) ; XTEMP2_MEAN = 0.0
ALLOCATE(XPABS2_MEAN(IIU,IJU,IKU)) ; XPABS2_MEAN = 0.0
@@ -740,12 +788,14 @@ ELSE
ALLOCATE(XWM_MEAN(0,0,0))
ALLOCATE(XTHM_MEAN(0,0,0))
ALLOCATE(XTEMPM_MEAN(0,0,0))
+ ALLOCATE(XSVT_MEAN(0,0,0))
ALLOCATE(XTKEM_MEAN(0,0,0))
ALLOCATE(XPABSM_MEAN(0,0,0))
!
ALLOCATE(XU2_MEAN(0,0,0))
ALLOCATE(XV2_MEAN(0,0,0))
ALLOCATE(XW2_MEAN(0,0,0))
+ ALLOCATE(XUW_MEAN(0,0,0))
ALLOCATE(XTH2_MEAN(0,0,0))
ALLOCATE(XTEMP2_MEAN(0,0,0))
ALLOCATE(XPABS2_MEAN(0,0,0))
@@ -795,6 +845,43 @@ ALLOCATE(XRVS_PRES(IIU,IJU,IKU)); XRVS_PRES = 0.0
ALLOCATE(XRWS_PRES(IIU,IJU,IKU)); XRWS_PRES = 0.0
ALLOCATE(XRTHS(IIU,IJU,IKU)) ; XRTHS = 0.0
ALLOCATE(XRTHS_CLD(IIU,IJU,IKU)); XRTHS_CLD = 0.0
+
+IF ( LIBM ) THEN
+ ALLOCATE(ZIBM_LS(IIU,IJU,IKU)) ; ZIBM_LS = 0.0
+ ALLOCATE(XIBM_XMUT(IIU,IJU,IKU)); XIBM_XMUT = 0.0
+ELSE
+ ALLOCATE(ZIBM_LS (0,0,0))
+ ALLOCATE(XIBM_XMUT(0,0,0))
+END IF
+
+IF ( LRECYCL ) THEN
+ ALLOCATE(XFLUCTUNW(IJU,IKU)) ; XFLUCTUNW = 0.0
+ ALLOCATE(XFLUCTVNN(IIU,IKU)) ; XFLUCTVNN = 0.0
+ ALLOCATE(XFLUCTUTN(IIU,IKU)) ; XFLUCTUTN = 0.0
+ ALLOCATE(XFLUCTVTW(IJU,IKU)) ; XFLUCTVTW = 0.0
+ ALLOCATE(XFLUCTUNE(IJU,IKU)) ; XFLUCTUNE = 0.0
+ ALLOCATE(XFLUCTVNS(IIU,IKU)) ; XFLUCTVNS = 0.0
+ ALLOCATE(XFLUCTUTS(IIU,IKU)) ; XFLUCTUTS = 0.0
+ ALLOCATE(XFLUCTVTE(IJU,IKU)) ; XFLUCTVTE = 0.0
+ ALLOCATE(XFLUCTWTW(IJU,IKU)) ; XFLUCTWTW = 0.0
+ ALLOCATE(XFLUCTWTN(IIU,IKU)) ; XFLUCTWTN = 0.0
+ ALLOCATE(XFLUCTWTE(IJU,IKU)) ; XFLUCTWTE = 0.0
+ ALLOCATE(XFLUCTWTS(IIU,IKU)) ; XFLUCTWTS = 0.0
+ELSE
+ ALLOCATE(XFLUCTUNW(0,0))
+ ALLOCATE(XFLUCTVNN(0,0))
+ ALLOCATE(XFLUCTUTN(0,0))
+ ALLOCATE(XFLUCTVTW(0,0))
+ ALLOCATE(XFLUCTUNE(0,0))
+ ALLOCATE(XFLUCTVNS(0,0))
+ ALLOCATE(XFLUCTUTS(0,0))
+ ALLOCATE(XFLUCTVTE(0,0))
+ ALLOCATE(XFLUCTWTW(0,0))
+ ALLOCATE(XFLUCTWTN(0,0))
+ ALLOCATE(XFLUCTWTE(0,0))
+ ALLOCATE(XFLUCTWTS(0,0))
+END IF
+!
IF (CTURB /= 'NONE') THEN
ALLOCATE(XTKET(IIU,IJU,IKU))
ALLOCATE(XRTKES(IIU,IJU,IKU))
@@ -843,6 +930,21 @@ ELSE
ALLOCATE(XSRCT(0,0,0))
ALLOCATE(XSIGS(0,0,0))
END IF
+IF (CCLOUD == 'ICE3'.OR.CCLOUD == 'ICE4') THEN
+ ALLOCATE(XHLC_HRC(IIU,IJU,IKU))
+ ALLOCATE(XHLC_HCF(IIU,IJU,IKU))
+ ALLOCATE(XHLI_HRI(IIU,IJU,IKU))
+ ALLOCATE(XHLI_HCF(IIU,IJU,IKU))
+ XHLC_HRC(:,:,:)=0.
+ XHLC_HCF(:,:,:)=0.
+ XHLI_HRI(:,:,:)=0.
+ XHLI_HCF(:,:,:)=0.
+ELSE
+ ALLOCATE(XHLC_HRC(0,0,0))
+ ALLOCATE(XHLC_HCF(0,0,0))
+ ALLOCATE(XHLI_HRI(0,0,0))
+ ALLOCATE(XHLI_HCF(0,0,0))
+END IF
!
IF (NRR>1) THEN
ALLOCATE(XCLDFR(IIU,IJU,IKU)); XCLDFR (:, :, :) = 0.
@@ -907,11 +1009,19 @@ ALLOCATE(XDZZ(IIU,IJU,IKU))
!
!* 3.3 Modules MODD_REF and MODD_REF_n
!
-IF (KMI == 1) THEN
+! Different reference states for Ocean and Atmosphere models
+! For the moment, same reference states for O and A
+!IF ((KMI == 1).OR.LCOUPLES) THEN
+IF (KMI==1) THEN
ALLOCATE(XRHODREFZ(IKU),XTHVREFZ(IKU))
+ELSE IF (LCOUPLES) THEN
+! in coupled O-A case, need different variables for ocean
+ ALLOCATE(XRHODREFZO(IKU),XTHVREFZO(IKU))
ELSE
!Do not allocate XRHODREFZ and XTHVREFZ because they are the same on all grids (not 'n' variables)
END IF
+!
+ALLOCATE(XPHIT(IIU,IJU,IKU))
ALLOCATE(XRHODREF(IIU,IJU,IKU))
ALLOCATE(XTHVREF(IIU,IJU,IKU))
ALLOCATE(XEXNREF(IIU,IJU,IKU))
@@ -1671,7 +1781,7 @@ IF ( CBUTYPE /= "NONE" .AND. NBUMOD == KMI ) THEN
LHORELAX_UVWTH,LHORELAX_RV, LHORELAX_RC,LHORELAX_RR, &
LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, LHORELAX_RH,LHORELAX_TKE, &
LHORELAX_SV, LVE_RELAX, LVE_RELAX_GRD, &
- LCHTRANS,LNUDGING,LDRAGTREE,LDEPOTREE, &
+ LCHTRANS,LNUDGING,LDRAGTREE,LDEPOTREE,LMAIN_EOL, &
CRAD,CDCONV,CSCONV,CTURB,CTURBDIM,CCLOUD )
END IF
!
@@ -1766,11 +1876,12 @@ IF (CCLOUD=='LIMA') CALL INIT_AEROSOL_PROPERTIES
! --------------------------------
!
CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before read_field::XUT",PRECISION)
-CALL READ_FIELD(TPINIFILE,IIU,IJU,IKU, &
+CALL READ_FIELD(KMI,TPINIFILE,IIU,IJU,IKU, &
CGETTKET,CGETRVT,CGETRCT,CGETRRT,CGETRIT,CGETCIT,CGETZWS, &
CGETRST,CGETRGT,CGETRHT,CGETSVT,CGETSRCT,CGETSIGS,CGETCLDFR, &
- CGETBL_DEPTH,CGETSBL_DEPTH,CGETPHC,CGETPHR,CUVW_ADV_SCHEME, &
- CTEMP_SCHEME,NSIZELBX_ll,NSIZELBXU_ll,NSIZELBY_ll,NSIZELBYV_ll,&
+ CGETBL_DEPTH,CGETSBL_DEPTH,CGETPHC,CGETPHR, &
+ CUVW_ADV_SCHEME, CTEMP_SCHEME, &
+ NSIZELBX_ll, NSIZELBXU_ll, NSIZELBY_ll, NSIZELBYV_ll, &
NSIZELBXTKE_ll,NSIZELBYTKE_ll, &
NSIZELBXR_ll,NSIZELBYR_ll,NSIZELBXSV_ll,NSIZELBYSV_ll, &
XUM,XVM,XWM,XDUM,XDVM,XDWM, &
@@ -1789,7 +1900,10 @@ CALL READ_FIELD(TPINIFILE,IIU,IJU,IKU, &
NADVFRC,TDTADVFRC,XDTHFRC,XDRVFRC, &
NRELFRC,TDTRELFRC,XTHREL,XRVREL, &
XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M, &
- XRUS_PRES,XRVS_PRES,XRWS_PRES,XRTHS_CLD,XRRS_CLD,XRSVS_CLD )
+ XRUS_PRES,XRVS_PRES,XRWS_PRES,XRTHS_CLD,XRRS_CLD,XRSVS_CLD, &
+ ZIBM_LS,XIBM_XMUT,XUMEANW,XVMEANW,XWMEANW,XUMEANN,XVMEANN, &
+ XWMEANN,XUMEANE,XVMEANE,XWMEANE,XUMEANS,XVMEANS,XWMEANS )
+
!
!-------------------------------------------------------------------------------
!
@@ -2081,6 +2195,13 @@ CALL INI_DYNAMICS(XLON,XLAT,XRHODJ,XTHVREF,XMAP,XZZ,XDXHAT,XDYHAT, &
IF (LDRAG) THEN
CALL INI_DRAG(LMOUNT,XZS,XHSTART,NSTART,XDRAG)
ENDIF
+!* 16.2 Initialize the LevelSet function
+! -------------
+IF (LIBM) THEN
+ ALLOCATE(XIBM_LS(IIU,IJU,IKU,4)) ; XIBM_LS = -XIBM_IEPS
+ XIBM_LS(:,:,:,1)=ZIBM_LS(:,:,:)
+ DEALLOCATE(ZIBM_LS)
+ENDIF
!-------------------------------------------------------------------------------
!
!* 17. SURFACE FIELDS
@@ -2155,10 +2276,14 @@ ALLOCATE(ZSCA_ALB(IIU,IJU,NSWB_MNH))
ALLOCATE(ZEMIS (IIU,IJU,NLWB_MNH))
ALLOCATE(ZTSRAD (IIU,IJU))
!
-IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=6) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
- CALL IO_Field_read(TPINIFILE,'SURF',CSURF)
+IF (LCOUPLES.AND.(KMI>1))THEN
+ CSURF ="NONE"
ELSE
- CSURF = "EXTE"
+ IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=6) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
+ CALL IO_Field_read(TPINIFILE,'SURF',CSURF)
+ ELSE
+ CSURF = "EXTE"
+ END IF
END IF
!
!
@@ -2412,7 +2537,7 @@ CALL INI_AIRCRAFT_BALLOON(TPINIFILE,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
! -----------------------
!
CALL INI_SURFSTATION_n(XTSTEP, XSEGLEN, NRR, NSV, &
- CTURB=="TKEL" , &
+ CTURB=="TKEL" , KMI, &
XLATORI, XLONORI )
!
!-------------------------------------------------------------------------------
@@ -2508,6 +2633,38 @@ IF (LCHEMDIAG) THEN
ELSE
ALLOCATE(XTCHEM(0))
END IF
-
+!-------------------------------------------------------------------------------
+!
+!* 32. Wind turbine
+!
+IF (LMAIN_EOL .AND. KMI == NMODEL_EOL) THEN
+ ALLOCATE(XFX_RG(IIU,IJU,IKU))
+ ALLOCATE(XFY_RG(IIU,IJU,IKU))
+ ALLOCATE(XFZ_RG(IIU,IJU,IKU))
+ ALLOCATE(XFX_SMR_RG(IIU,IJU,IKU))
+ ALLOCATE(XFY_SMR_RG(IIU,IJU,IKU))
+ ALLOCATE(XFZ_SMR_RG(IIU,IJU,IKU))
+ SELECT CASE(CMETH_EOL)
+ CASE('ADNR')
+ CALL INI_EOL_ADNR
+ CASE('ALM')
+ CALL INI_EOL_ALM(XDXX,XDYY)
+ END SELECT
+END IF
+!
+!* 33. Auto-coupling Atmos-Ocean LES NH
+!
+IF (LCOUPLES) THEN
+ ALLOCATE(XSSUFL_C(IIU,IJU,1)); XSSUFL_C=0.0
+ ALLOCATE(XSSVFL_C(IIU,IJU,1)); XSSVFL_C=0.0
+ ALLOCATE(XSSTFL_C(IIU,IJU,1)); XSSTFL_C=0.0
+ ALLOCATE(XSSRFL_C(IIU,IJU,1)); XSSRFL_C=0.
+ELSE
+ ALLOCATE(XSSUFL_C(0,0,0))
+ ALLOCATE(XSSVFL_C(0,0,0))
+ ALLOCATE(XSSTFL_C(0,0,0))
+ ALLOCATE(XSSRFL_C(0,0,0))
+END IF
+!
END SUBROUTINE INI_MODEL_n
diff --git a/src/MNH/ini_nsv.f90 b/src/MNH/ini_nsv.f90
index 56b94ec176cacfb3ca48393fbf74517d78c08c09..c49362598ed17e813c213a643ce5474e8711d5d1 100644
--- a/src/MNH/ini_nsv.f90
+++ b/src/MNH/ini_nsv.f90
@@ -69,6 +69,8 @@ END MODULE MODI_INI_NSV
! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
! P. Wautelet 10/03/2021: add CSVNAMES and CSVNAMES_A to store the name of all the scalar variables
! P. Wautelet 30/03/2021: move NINDICE_CCN_IMM and NIMM initializations from init_aerosol_properties to ini_nsv
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -106,7 +108,7 @@ USE MODD_NSV
USE MODD_PARAM_C2R2, ONLY: LSUPSAT
USE MODD_PARAM_LIMA, ONLY: NINDICE_CCN_IMM, NIMM, NMOD_CCN, LSCAV, LAERO_MASS, &
NMOD_IFN, NMOD_IMM, LHHONI, &
- LWARM, LCOLD, LRAIN
+ LWARM, LCOLD, LRAIN, LSPRO
USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
USE MODD_PARAM_LIMA_WARM, ONLY: CAERO_MASS, CLIMA_WARM_NAMES
USE MODD_PARAM_n, ONLY: CCLOUD, CELEC
@@ -253,6 +255,11 @@ IF (CCLOUD == 'LIMA' ) THEN
NSV_LIMA_HOM_HAZE_A(KMI) = ISV
ISV = ISV + 1
END IF
+! Supersaturation
+ IF (LSPRO) THEN
+ NSV_LIMA_SPRO_A(KMI) = ISV
+ ISV = ISV + 1
+ END IF
!
! End and total variables
!
@@ -810,6 +817,8 @@ DO JSV = NSV_LIMA_BEG_A(KMI), NSV_LIMA_END_A(KMI)
CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_COLD_NAMES(4) ) // YNUM2
ELSE IF ( JSV == NSV_LIMA_HOM_HAZE_A(KMI) ) THEN
CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_COLD_NAMES(5) )
+ ELSE IF ( JSV == NSV_LIMA_SPRO_A(KMI) ) THEN
+ CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_WARM_NAMES(5) )
ELSE
CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'invalid index for LIMA' )
END IF
diff --git a/src/MNH/ini_one_wayn.f90 b/src/MNH/ini_one_wayn.f90
index fffb5f8d6f5bd2a47ea253c49cd177eb765a4e8b..78e025b2a89dea147d8cac40f2124c1d7412ac72 100644
--- a/src/MNH/ini_one_wayn.f90
+++ b/src/MNH/ini_one_wayn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1999-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1999-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.
@@ -90,7 +90,7 @@ SUBROUTINE INI_ONE_WAY_n(KDAD,KMI, &
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 03/05/2019: restructuration of one_wayn and ini_one_wayn
! P. Wautelet 04/06/2020: correct call to Set_conc_lima + initialize ZCONCM
-!
+! J-L Redelsperger 06/2021: add Ocean coupling
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -106,6 +106,7 @@ USE MODD_NSV, only: NSV_A, NSV_C1R3BEG_A, NSV_C1R3_A, NSV_C2R2BEG_A,
NSV_SLTBEG_A, NSV_SLTDEPBEG_A, NSV_SLTDEP_A, NSV_SLT_A, NSV_USER_A
USE MODD_PARAM_n, only: CCLOUD
+USE MODD_REF, ONLY: LCOUPLES
USE MODD_REF_n, only: XRHODJ, XRHODREF
!
use mode_bikhardt
@@ -183,6 +184,20 @@ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCHEMM ! chemical concentrations
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCHEMMI ! chemical ice phase concentrations
!-------------------------------------------------------------------------------
!
+IF (LCOUPLES) THEN
+ PLBXUM=0.
+ PLBXVM=0.
+ PLBXWM=0.
+ PLBXTHM=0.
+ PLBYTHM=0.
+ PLBXTKEM=0.
+ PLBYTKEM =0.
+ PLBXRM =0.
+ PLBYRM=0.
+ PLBXSVM =0.
+ PLBYSVM=0.
+RETURN
+ENDIF
!* 0. INITIALISATION
!
CALL GOTO_MODEL(KDAD)
diff --git a/src/MNH/ini_segn.f90 b/src/MNH/ini_segn.f90
index e0819946a423f1d3026e954ffd933dadeafd362f..590efa55c1c37baaab8c9a2ccf4e5eef8c4b2ad4 100644
--- a/src/MNH/ini_segn.f90
+++ b/src/MNH/ini_segn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -172,6 +172,7 @@ END MODULE MODI_INI_SEG_n
USE MODD_CONF
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODN_CONFZ
+USE MODD_DYN_n, ONLY : LOCEAN
USE MODD_DYN
USE MODD_IO, ONLY: NVERB_FATAL, NVERB_WARNING, TFILE_OUTPUTLISTING, TFILEDATA
USE MODD_LUNIT
@@ -440,6 +441,9 @@ END IF
! routine which read related informations in the EXSEG descriptor in order to
! check coherence between both informations.
!
+CALL IO_Field_read(TPINIFILE,'LOCEAN',LOCEAN,IRESP)
+IF ( IRESP /= 0 ) LOCEAN = .FALSE.
+!
CALL READ_EXSEG_n(KMI,TZFILE_DES,YCONF,GFLAT,GUSERV,GUSERC, &
GUSERR,GUSERI,GUSECI,GUSERS,GUSERG,GUSERH,GUSECHEM, &
GUSECHAQ,GUSECHIC,GCH_PH, &
diff --git a/src/MNH/ini_sizen.f90 b/src/MNH/ini_sizen.f90
index 5e21aeeaffa449c582206864c825cfdfaaa846be..4e3425cafeeeb374775f907d85bbfc2296886997 100644
--- a/src/MNH/ini_sizen.f90
+++ b/src/MNH/ini_sizen.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -112,6 +112,7 @@ USE MODD_LUNIT_n, ONLY: CINIFILE, CINIFILEPGD, TLUOUT
USE MODD_NESTING, ONLY: CMY_NAME, CDAD_NAME, NDAD, NDXRATIO_ALL, NDYRATIO_ALL, &
NXOR_ALL, NYOR_ALL, NXEND_ALL,NYEND_ALL
USE MODD_PARAMETERS, ONLY: JPMODELMAX, JPHEXT,JPVEXT
+USE MODD_REF, ONLY: LCOUPLES
!
USE MODE_IO, ONLY: IO_Pack_set
USE MODE_IO_FIELD_READ, only: IO_Field_read
@@ -164,6 +165,12 @@ IF (IRESP /= 0) THEN
END IF
!
IF ( KMI > 1 ) THEN
+ IF ( LCOUPLES ) THEN
+ IF ( KMI == 2 ) THEN
+ CMY_NAME(NDAD(KMI)) = CDAD_NAME(KMI)
+ WRITE(UNIT=ILUOUT,FMT=*) 'NDAD',NDAD(KMI),'changed in '//TRIM(CMY_NAME(NDAD(KMI)))//TRIM(CDAD_NAME(KMI)),KMI
+ END IF
+ END IF
IF ( TRIM(CDAD_NAME(KMI)) /= TRIM(CMY_NAME(NDAD(KMI))) ) THEN
WRITE(UNIT=ILUOUT,FMT=9005) NDAD(KMI)
WRITE(ILUOUT,FMT=*) ' THE INITIAL FM-File IS NOT CONSISTANT WITH THE ONE OF THE DAD MODEL!'
diff --git a/src/MNH/ini_stationn.f90 b/src/MNH/ini_stationn.f90
index ea90fed1e128870ed60fac373163ea75c2fe674d..8bfe8866f73bfc3c855b971514bfb88027409cff 100644
--- a/src/MNH/ini_stationn.f90
+++ b/src/MNH/ini_stationn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-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 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$ $Revision$
-! MASDEV4_7 profiler 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #######################
SUBROUTINE INI_STATION_n
! #######################
@@ -22,7 +17,7 @@
!!** METHOD
!! ------
!!
-!! Must be defined (for each aircraft):
+!! Must be defined (for each station):
!! ---------------
!!
!! No default exist for these variables.
@@ -37,7 +32,7 @@
!!
!!
!!
-!! Can be defined (for each aircraft):
+!! Can be defined (for each station):
!! --------------
!!
!!
@@ -64,15 +59,19 @@
!! MODIFICATIONS
!! -------------
!! Original 15/01/2002
+!! Modification: 02/2021 (E.Jezequel) Read stations from CVS file
!!
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_STATION_n
+USE MODD_ALLSTATION_n
+USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_PARAMETERS
!
+USE MODI_STATION_READER
+!
!
IMPLICIT NONE
!
@@ -84,68 +83,62 @@ IMPLICIT NONE
!
! 0.2 declaration of local variables
!
+INTEGER :: JI
!
!----------------------------------------------------------------------------
!
!* 1. Nameliste
! ---------
-NUMBSTAT = 0
-!
-IF (NUMBSTAT > 0) THEN
-ALLOCATE (TSTATION%LAT(NUMBSTAT))
-ALLOCATE (TSTATION%LON(NUMBSTAT))
-ALLOCATE (TSTATION%I(NUMBSTAT))
-ALLOCATE (TSTATION%J(NUMBSTAT))
-ALLOCATE (TSTATION%Z(NUMBSTAT))
-ALLOCATE (TSTATION%K(NUMBSTAT))
-ALLOCATE (TSTATION%NAME(NUMBSTAT))
-ALLOCATE (TSTATION%TYPE(NUMBSTAT))
-!
-TSTATION%LON = XUNDEF
-TSTATION%LAT = XUNDEF
-TSTATION%Z = XUNDEF
-TSTATION%K = XUNDEF
-TSTATION%I = XUNDEF
-TSTATION%J = XUNDEF
-TSTATION%NAME = " "
-TSTATION%TYPE = " "
-!
-TSTATION%STEP = 10.
-!
-!* location (latitude, longitude, altitude)
-!
-!***************************************************************
-! * Horizontal location
-! You have to choose between (TSTATION%LAT,TSTATION%LON)
-! or (TSTATION%I,TSTATION%J) for all the stations
-! if both are defined it will choose (TSTATION%LAT,TSTATION%LON)
-!***************************************************************
-!
-!TSTATION%LAT = (/ 45.0 /)
-!TSTATION%LON = (/ 4.5 /)
-TSTATION%I = (/ 25 /)
-TSTATION%J = (/ 20 /)
-!
-!***************************************************************
-! * Vertical location
-! You have to choose between TSTATION%K and TSTATION%Z
-! for all the stations
-! if both are defined it will choose TSTATION%K
-!***************************************************************
-!TSTATION%Z = (/ 10., 500. /)
-!
-TSTATION%K = (/ 10 /)
-!
-!***************************************************************
-!* station name
-!***************************************************************
-TSTATION%NAME = (/ 'BIDON' /)
-!***************************************************************
-!* station type
-!***************************************************************
-TSTATION%TYPE = (/ 'sol '/)
-!
-!----------------------------------------------------------------------------
-ENDIF
+
+IF (CFILE_STAT=="NO_INPUT_CSV") THEN
+ NUMBSTAT = NNUMB_STAT
+
+ IF (NUMBSTAT > 0) THEN
+ ALLOCATE (TSTATION%LAT(NUMBSTAT))
+ ALLOCATE (TSTATION%LON(NUMBSTAT))
+ ALLOCATE (TSTATION%X(NUMBSTAT))
+ ALLOCATE (TSTATION%Y(NUMBSTAT))
+ ALLOCATE (TSTATION%Z(NUMBSTAT))
+ ALLOCATE (TSTATION%K(NUMBSTAT))
+ ALLOCATE (TSTATION%NAME(NUMBSTAT))
+ ALLOCATE (TSTATION%TYPE(NUMBSTAT))
+ !
+ TSTATION%LON = XUNDEF
+ TSTATION%LAT = XUNDEF
+ TSTATION%Z = XUNDEF
+ TSTATION%K = XUNDEF
+ TSTATION%X = XUNDEF
+ TSTATION%Y = XUNDEF
+ TSTATION%NAME = " "
+ TSTATION%TYPE = " "
+ !
+ TSTATION%STEP = XSTEP_STAT
+ !
+ IF (LCARTESIAN) THEN
+ DO JI=1,NUMBSTAT
+ TSTATION%X(JI)= XX_STAT(JI)
+ TSTATION%Y(JI)= XY_STAT(JI)
+ TSTATION%Z(JI)= XZ_STAT(JI)
+ TSTATION%NAME(JI)= CNAME_STAT(JI)
+ TSTATION%TYPE(JI)= CTYPE_STAT(JI)
+ END DO
+ ELSE
+ DO JI=1,NUMBSTAT
+ TSTATION%LAT(JI)= XLAT_STAT(JI)
+ TSTATION%LON(JI)= XLON_STAT(JI)
+ TSTATION%Z(JI)= XZ_STAT(JI)
+ TSTATION%NAME(JI)= CNAME_STAT(JI)
+ TSTATION%TYPE(JI)= CTYPE_STAT(JI)
+ END DO
+ ENDIF
+ ENDIF
+ELSE
+!
+!* 2. CSV DATA
+!
+ CALL READ_CSV_STATION(CFILE_STAT,TSTATION,LCARTESIAN)
+ TSTATION%STEP = XSTEP_STAT
+END IF
+
!
END SUBROUTINE INI_STATION_n
diff --git a/src/MNH/ini_surfstationn.f90 b/src/MNH/ini_surfstationn.f90
index bf6f4799317ca1adf9dc464a28cca5a311da940a..f53ee35d11e73fd6873e8e7abf40d90a227579af 100644
--- a/src/MNH/ini_surfstationn.f90
+++ b/src/MNH/ini_surfstationn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -10,7 +10,7 @@ MODULE MODI_INI_SURFSTATION_n
INTERFACE
!
SUBROUTINE INI_SURFSTATION_n(PTSTEP, PSEGLEN, &
- KRR, KSV, OUSETKE, &
+ KRR, KSV, OUSETKE, KMI, &
PLATOR, PLONOR )
!
USE MODD_TYPE_DATE
@@ -21,6 +21,7 @@ INTEGER, INTENT(IN) :: KSV ! number of scalar variables
LOGICAL, INTENT(IN) :: OUSETKE ! flag to use tke
REAL, INTENT(IN) :: PLATOR ! latitude of origine point
REAL, INTENT(IN) :: PLONOR ! longitude of origine point
+INTEGER, INTENT(IN) :: KMI ! MODEL NUMBER
!
!-------------------------------------------------------------------------------
!
@@ -32,7 +33,7 @@ END MODULE MODI_INI_SURFSTATION_n
!
! ########################################################
SUBROUTINE INI_SURFSTATION_n(PTSTEP, PSEGLEN, &
- KRR, KSV, OUSETKE, &
+ KRR, KSV, OUSETKE, KMI, &
PLATOR, PLONOR )
! ########################################################
!
@@ -67,17 +68,20 @@ END MODULE MODI_INI_SURFSTATION_n
! P. 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
! R. Schoetter 11/2019: work for cartesian coordinates + parallel.
+! E.Jezequel 02/2021: read stations from CVS file
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ALLSTATION_n
USE MODD_CONF
USE MODD_DIM_n
USE MODD_DYN_n
USE MODD_GRID
USE MODD_GRID_n
USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NESTING
USE MODD_PARAMETERS
USE MODD_SHADOWS_n
USE MODD_STATION_n
@@ -104,6 +108,7 @@ INTEGER, INTENT(IN) :: KSV ! number of scalar variables
LOGICAL, INTENT(IN) :: OUSETKE ! flag to use tke
REAL, INTENT(IN) :: PLATOR ! latitude of origine point
REAL, INTENT(IN) :: PLONOR ! longitude of origine point
+INTEGER, INTENT(IN) :: KMI ! MODEL NUMBER
!
!-------------------------------------------------------------------------------
!
@@ -135,8 +140,8 @@ LSTATION = (NUMBSTAT>0)
! -----------------------------
!
IF(NUMBSTAT>0) THEN
- CALL ALLOCATE_STATION_n(TSTATION)
- CALL INI_INTERP_STATION_n(TSTATION)
+ CALL ALLOCATE_STATION_n(TSTATION,KMI)
+ IF (.NOT. LCARTESIAN) CALL INI_INTERP_STATION_n(TSTATION)
ENDIF
!----------------------------------------------------------------------------
!
@@ -156,21 +161,26 @@ TSTATION%STEP = XTSTEP
END SUBROUTINE DEFAULT_STATION_n
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
-SUBROUTINE ALLOCATE_STATION_n(TSTATION)
+SUBROUTINE ALLOCATE_STATION_n(TSTATION,KMI)
!
TYPE(STATION), INTENT(INOUT) :: TSTATION !
-
+INTEGER, INTENT(IN) :: KMI ! Model Index
+!
if ( tstation%step < xtstep ) then
call Print_msg( NVERB_ERROR, 'GEN', 'INI_SURFSTATION_n', 'TSTATION%STEP smaller than XTSTEP' )
tstation%step = xtstep
end if
-ISTORE = INT ( (PSEGLEN-XTSTEP) / TSTATION%STEP ) + 1
+IF (KMI==1) THEN
+ ISTORE = NINT ( (PSEGLEN-XTSTEP) / TSTATION%STEP ) + 1
+ELSE
+ ISTORE = NINT ( (PSEGLEN-XTSTEP * NDTRATIO(KMI)) / TSTATION%STEP ) + 1
+END IF
allocate( tstation%tpdates( istore ) )
ALLOCATE(TSTATION%ERROR (NUMBSTAT))
-ALLOCATE(TSTATION%X (NUMBSTAT))
-ALLOCATE(TSTATION%Y (NUMBSTAT))
+!ALLOCATE(TSTATION%X (NUMBSTAT))
+!ALLOCATE(TSTATION%Y (NUMBSTAT))
ALLOCATE(TSTATION%SV (ISTORE,NUMBSTAT,KSV))
ALLOCATE(TSTATION%TSRAD (ISTORE,NUMBSTAT))
ALLOCATE(TSTATION%ZS (NUMBSTAT))
@@ -251,27 +261,7 @@ IF ( ALL(TSTATION%LAT(:)/=XUNDEF) .AND. ALL(TSTATION%LON(:)/=XUNDEF) ) THEN
TSTATION%X(JII), TSTATION%Y(JII) )
ENDDO
ELSE
- DO JII=1,NUMBSTAT
- CALL GET_DIM_EXT_ll ('B',IIU,IJU)
- IIU_ll=NIMAX_ll + 2 * JPHEXT
- IJU_ll=NJMAX_ll + 2 * JPHEXT
- ALLOCATE(XXHAT_ll (IIU_ll))
- ALLOCATE(XYHAT_ll (IJU_ll))
- !
- CALL GATHERALL_FIELD_ll('XX',XXHAT,XXHAT_ll,IRESP)
- CALL GATHERALL_FIELD_ll('YY',XYHAT,XYHAT_ll,IRESP)
- TSTATION%X(JII) = XXHAT_ll(TSTATION%I(JII))
- TSTATION%Y(JII) = XYHAT_ll(TSTATION%J(JII))
- IF (LCARTESIAN) THEN
- XRPK = -1
- ENDIF
- CALL SM_LATLON(PLATOR,PLONOR, &
- TSTATION%X(JII), TSTATION%Y(JII), &
- TSTATION%LAT(JII), TSTATION%LON(JII) )
- ENDDO
-END IF
!
-IF ( ANY(TSTATION%LAT(:)==XUNDEF) .OR. ANY(TSTATION%LON(:)==XUNDEF) ) THEN
WRITE(ILUOUT,*) 'Error in station position '
WRITE(ILUOUT,*) 'either LATitude or LONgitude segment'
WRITE(ILUOUT,*) 'or I and J segment'
diff --git a/src/MNH/ini_tke_eps.f90 b/src/MNH/ini_tke_eps.f90
index c76c795b5e67772a14cd56384910110c2a55a010..3959afe70486b931185037769351051f580d96cb 100644
--- a/src/MNH/ini_tke_eps.f90
+++ b/src/MNH/ini_tke_eps.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-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.
@@ -84,18 +84,21 @@ END MODULE MODI_INI_TKE_EPS
!! Aug 10, 1998 (N. Asencio) add parallel code
!! May 2006 Remove KEPS
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! March 2021 (JL Redelsperger) Add Ocean LES case)
!! -------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CTURB ! XLINI, XCED, XCMFS, XTKEMIN
-USE MODD_CST ! XG, XRD, XRV
-USE MODD_PARAMETERS ! JPVEXT
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_CST, ONLY: XG, XALPHAOC
+USE MODD_CTURB, ONLY: XLINI, XCED, XCMFS, XTKEMIN, XCSHF
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_PARAMETERS, ONLY: JPVEXT
!
-USE MODI_SHUMAN ! DZF, MXF, MYF, MZM
USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+!
+USE MODI_SHUMAN, ONLY: DZF, MXF, MYF, MZM
!
IMPLICIT NONE
!
@@ -148,11 +151,20 @@ IF (HGETTKET == 'INIT' ) THEN
PVT(:,:,IKE+1) = PVT(:,:,IKE)
!
! determines TKE
- PTKET(:,:,:)=(XLINI**2/XCED)*( &
- XCMFS*( DZF(MXF(MZM(PUT)))**2 &
- +DZF(MYF(MZM(PVT)))**2) / ZDELTZ &
- -(XG/PTHVREF)*XCSHF*DZF(MZM(PTHT)) &
- ) / ZDELTZ
+ ! Equilibrium/Stationary/neutral 1D TKE equation
+ IF (LOCEAN) THEN
+ PTKET(:,:,:)=(XLINI**2/XCED)*( &
+ XCMFS*( DZF(MXF(MZM(PUT)))**2 &
+ +DZF(MYF(MZM(PVT)))**2) / ZDELTZ &
+ -(XG*XALPHAOC)*XCSHF*DZF(MZM(PTHT)) &
+ ) / ZDELTZ
+ ELSE
+ PTKET(:,:,:)=(XLINI**2/XCED)*( &
+ XCMFS*( DZF(MXF(MZM(PUT)))**2 &
+ +DZF(MYF(MZM(PVT)))**2) / ZDELTZ &
+ -(XG/PTHVREF)*XCSHF*DZF(MZM(PTHT)) &
+ ) / ZDELTZ
+ END IF
! positivity control
WHERE (PTKET < XTKEMIN) PTKET=XTKEMIN
!
diff --git a/src/MNH/init_aerosol_concentration.f90 b/src/MNH/init_aerosol_concentration.f90
index d9db784b207f56edeba45e332def7a44de45b982..e86998c4b18e3a4f712a57c016ea1cbb7e9c14d0 100644
--- a/src/MNH/init_aerosol_concentration.f90
+++ b/src/MNH/init_aerosol_concentration.f90
@@ -1,3 +1,8 @@
+!MNH_LIC Copyright 2013-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.
+!-----------------------------------------------------------------
!######################################
MODULE MODI_INIT_AEROSOL_CONCENTRATION
!######################################
diff --git a/src/MNH/init_aerosol_properties.f90 b/src/MNH/init_aerosol_properties.f90
index b52de24a753b5687a88bf2e42f6b6155596cdc4e..dd7c5655077d86e07f51df49c0e18f7118f1931e 100644
--- a/src/MNH/init_aerosol_properties.f90
+++ b/src/MNH/init_aerosol_properties.f90
@@ -37,6 +37,8 @@ END MODULE MODI_INIT_AEROSOL_PROPERTIES
!! Philippe Wautelet: 22/01/2019: bugs correction: incorrect writes + unauthorized goto
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 30/03/2021: move NINDICE_CCN_IMM and NIMM initializations from init_aerosol_properties to ini_nsv
+! B. Vié 06/2021: kappa-kohler CCN activation parameters
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -55,6 +57,7 @@ USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, HINI_CCN, HTYPE_CCN, &
use mode_msg
!
USE MODI_GAMMA
+USE MODI_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
!
IMPLICIT NONE
!
@@ -83,7 +86,14 @@ INTEGER :: I,J,JMOD
!
INTEGER :: ILUOUT0 ! Logical unit number for output-listing
INTEGER :: IRESP ! Return code of FM-routines
-
+!
+REAL :: X1, X2, X3, X4, X5
+! REAL, DIMENSION(7) :: diameters=(/ 0.01E-6, 0.05E-6, 0.1E-6, 0.2E-6, 0.5E-6, 1.E-6, 2.E-6 /)
+! REAL, DIMENSION(3) :: sigma=(/ 2., 2.5, 3. /)
+! CHARACTER(LEN=7), DIMENSION(3) :: types=(/ 'NH42SO4', 'NaCl ', ' ' /)
+!REAL, DIMENSION(1) :: diameters=(/ 0.25E-6 /)
+!CHARACTER(LEN=7), DIMENSION(1) :: types=(/ ' ' /)
+INTEGER :: II, IJ, IK
!
!-------------------------------------------------------------------------------
!
@@ -108,15 +118,25 @@ IF ( NMOD_CCN .GE. 1 ) THEN
RCCN(:) = (/ 0.125E-6 , 0.4E-6 , 1.0E-6 /)
LOGSIGCCN(:) = (/ 0.69 , 0.41 , 0.47 /)
RHOCCN(:) = (/ 1000. , 1000. , 1000. /)
- CASE ('MACC')
+ CASE ('CAMS')
RCCN(:) = (/ 0.4E-6 , 0.25E-6 , 0.1E-6 /)
LOGSIGCCN(:) = (/ 0.64 , 0.47 , 0.47 /)
RHOCCN(:) = (/ 2160. , 2000. , 1750. /)
- CASE ('MACC_JPP')
+ CASE ('CAMS_JPP')
! sea-salt, sulfate, hydrophilic (GADS data)
RCCN(:) = (/ 0.209E-6 , 0.0695E-6 , 0.0212E-6 /)
LOGSIGCCN(:) = (/ 0.708 , 0.708 , 0.806 /)
RHOCCN(:) = (/ 2200. , 1700. , 1800. /)
+ CASE ('CAMS_ACC')
+! sea-salt, sulfate, hydrophilic (GADS data)
+ RCCN(:) = (/ 0.2E-6 , 0.5E-6 , 0.4E-6 /)
+ LOGSIGCCN(:) = (/ 0.693 , 0.476 , 0.788 /)
+ RHOCCN(:) = (/ 2200. , 1700. , 1800. /)
+ CASE ('CAMS_AIT')
+! sea-salt, sulfate, hydrophilic (GADS data)
+ RCCN(:) = (/ 0.2E-6 , 0.05E-6 , 0.02E-6 /)
+ LOGSIGCCN(:) = (/ 0.693 , 0.693 , 0.788 /)
+ RHOCCN(:) = (/ 2200. , 1700. , 1800. /)
CASE ('SIRTA')
RCCN(:) = (/ 0.153E-6 , 0.058E-6 , 0.763E-6 /)
LOGSIGCCN(:) = (/ 0.846 , 0.57 , 0.34 /)
@@ -191,48 +211,60 @@ IF ( NMOD_CCN .GE. 1 ) THEN
!
DO JMOD = 1, NMOD_CCN
!
- SELECT CASE (HTYPE_CCN(JMOD))
- CASE ('M') ! CCN marins
- XKHEN0 = 3.251
- XLOGSIG0 = 0.4835
- XALPHA1 = -1.297
- XMUHEN0 = 2.589
- XALPHA2 = -1.511
- XBETAHEN0 = 621.689
- XR_MEAN0 = 0.133E-6
- XALPHA3 = 3.002
- XALPHA4 = 1.081
- XALPHA5 = 1.0
- XACTEMP0 = 290.16
- XALPHA6 = 2.995
- CASE ('C') ! CCN continentaux
- XKHEN0 = 1.403
- XLOGSIG0 = 1.16
- XALPHA1 = -1.172
- XMUHEN0 = 0.834
- XALPHA2 = -1.350
- XBETAHEN0 = 25.499
- XR_MEAN0 = 0.0218E-6
- XALPHA3 = 3.057
- XALPHA4 = 4.092
- XALPHA5 = 1.011
- XACTEMP0 = 290.16
- XALPHA6 = 3.076
- CASE DEFAULT
- call Print_msg(NVERB_FATAL,'GEN','INIT_AEROSOL_PROPERTIES','HTYPE_CNN(JMOD)=C or M must be specified'// &
- ' in EXSEG1.nam for each CCN mode')
- ENDSELECT
-!
- XKHEN_MULTI(JMOD) = XKHEN0*(XLOGSIG_CCN(JMOD)/XLOGSIG0)**XALPHA1
- XMUHEN_MULTI(JMOD) = XMUHEN0*(XLOGSIG_CCN(JMOD)/XLOGSIG0)**XALPHA2
- XBETAHEN_MULTI(JMOD)=XBETAHEN0*(XR_MEAN_CCN(JMOD)/XR_MEAN0)**XALPHA3 &
- * EXP( XALPHA4*((XLOGSIG_CCN(JMOD)/XLOGSIG0)-1.) ) &
- * XFSOLUB_CCN**XALPHA5 &
- * (XACTEMP_CCN/XACTEMP0)**XALPHA6
- XLIMIT_FACTOR(JMOD) = ( GAMMA_X0D(0.5*XKHEN_MULTI(JMOD)+1.) &
- *GAMMA_X0D(XMUHEN_MULTI(JMOD)-0.5*XKHEN_MULTI(JMOD)) ) &
- /( XBETAHEN_MULTI(JMOD)**(0.5*XKHEN_MULTI(JMOD)) &
- *GAMMA_X0D(XMUHEN_MULTI(JMOD)) )
+!!$ SELECT CASE (HTYPE_CCN(JMOD))
+!!$ CASE ('M') ! CCN marins
+!!$ XKHEN0 = 3.251
+!!$ XLOGSIG0 = 0.4835
+!!$ XALPHA1 = -1.297
+!!$ XMUHEN0 = 2.589
+!!$ XALPHA2 = -1.511
+!!$ XBETAHEN0 = 621.689
+!!$ XR_MEAN0 = 0.133E-6
+!!$ XALPHA3 = 3.002
+!!$ XALPHA4 = 1.081
+!!$ XALPHA5 = 1.0
+!!$ XACTEMP0 = 290.16
+!!$ XALPHA6 = 2.995
+!!$ CASE ('C') ! CCN continentaux
+!!$ XKHEN0 = 1.403
+!!$ XLOGSIG0 = 1.16
+!!$ XALPHA1 = -1.172
+!!$ XMUHEN0 = 0.834
+!!$ XALPHA2 = -1.350
+!!$ XBETAHEN0 = 25.499
+!!$ XR_MEAN0 = 0.0218E-6
+!!$ XALPHA3 = 3.057
+!!$ XALPHA4 = 4.092
+!!$ XALPHA5 = 1.011
+!!$ XACTEMP0 = 290.16
+!!$ XALPHA6 = 3.076
+!!$ CASE DEFAULT
+!!$ call Print_msg(NVERB_FATAL,'GEN','INIT_AEROSOL_PROPERTIES','HTYPE_CNN(JMOD)=C or M must be specified'// &
+!!$ ' in EXSEG1.nam for each CCN mode')
+!!$ ENDSELECT
+!!$!
+!!$ XKHEN_MULTI(JMOD) = XKHEN0*(XLOGSIG_CCN(JMOD)/XLOGSIG0)**XALPHA1
+!!$ XMUHEN_MULTI(JMOD) = XMUHEN0*(XLOGSIG_CCN(JMOD)/XLOGSIG0)**XALPHA2
+!!$ XBETAHEN_MULTI(JMOD)=XBETAHEN0*(XR_MEAN_CCN(JMOD)/XR_MEAN0)**XALPHA3 &
+!!$ * EXP( XALPHA4*((XLOGSIG_CCN(JMOD)/XLOGSIG0)-1.) ) &
+!!$ * XFSOLUB_CCN**XALPHA5 &
+!!$ * (XACTEMP_CCN/XACTEMP0)**XALPHA6
+!!$ XLIMIT_FACTOR(JMOD) = ( GAMMA_X0D(0.5*XKHEN_MULTI(JMOD)+1.) &
+!!$ *GAMMA_X0D(XMUHEN_MULTI(JMOD)-0.5*XKHEN_MULTI(JMOD)) ) &
+!!$ /( XBETAHEN_MULTI(JMOD)**(0.5*XKHEN_MULTI(JMOD)) &
+!!$ *GAMMA_X0D(XMUHEN_MULTI(JMOD)) )
+!!$
+!!$
+ CALL LIMA_INIT_CCN_ACTIVATION_SPECTRUM (HTYPE_CCN(JMOD),XR_MEAN_CCN(JMOD)*2.,EXP(XLOGSIG_CCN(JMOD)),X1,X2,X3,X4,X5)
+ !
+ ! LIMA_INIT_CCN_ACTIVATION_SPECTRUM returns X1=C/Nccn (instead of XLIMIT_FACTOR), X2=k, X3=mu, X4=beta, X5=kappa
+ ! So XLIMIT_FACTOR = 1/X1
+ ! Nc = Nccn/XLIMIT_FACTOR * S^k *F() = Nccn * X1 * S^k *F()
+ !
+ XLIMIT_FACTOR(JMOD) = 1./X1
+ XKHEN_MULTI(JMOD) = X2
+ XMUHEN_MULTI(JMOD) = X3
+ XBETAHEN_MULTI(JMOD)= X4
ENDDO
!
! These parameters are correct for a nucleation spectra
@@ -263,7 +295,7 @@ IF ( NMOD_IFN .GE. 1 ) THEN
XMDIAM_IFN = (/ 0.05E-6 , 3.E-6 , 0.016E-6 , 0.016E-6 /)
XSIGMA_IFN = (/ 2.4 , 1.6 , 2.5 , 2.5 /)
XRHO_IFN = (/ 2650. , 2650. , 1000. , 1000. /)
- CASE ('MACC_JPP')
+ CASE ('CAMS_JPP')
! sea-salt, sulfate, hydrophilic (GADS data)
! 2 species, dust-metallic and hydrophobic (as BC)
! (Phillips et al. 2013 and GADS data)
@@ -274,6 +306,28 @@ IF ( NMOD_IFN .GE. 1 ) THEN
XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.025E-6, 0.2E-6/)
XSIGMA_IFN = (/2.0, 2.15, 2.0, 1.6 /)
XRHO_IFN = (/2600., 2600., 1000., 1500./)
+ CASE ('CAMS_ACC')
+! sea-salt, sulfate, hydrophilic (GADS data)
+! 2 species, dust-metallic and hydrophobic (as BC)
+! (Phillips et al. 2013 and GADS data)
+ NSPECIE = 4 ! DM1, DM2, BC, BIO+(O)
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.04E-6, 0.8E-6 /)
+ XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
+ XRHO_IFN = (/2600., 2600., 1000., 2000. /)
+ CASE ('CAMS_AIT')
+! sea-salt, sulfate, hydrophilic (GADS data)
+! 2 species, dust-metallic and hydrophobic (as BC)
+! (Phillips et al. 2013 and GADS data)
+ NSPECIE = 4 ! DM1, DM2, BC, BIO+(O)
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.04E-6, 0.04E-6/)
+ XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
+ XRHO_IFN = (/2600., 2600., 1000., 1800./)
CASE DEFAULT
IF (NPHILLIPS == 8) THEN
! 4 species, according to Phillips et al. 2008
@@ -309,7 +363,7 @@ IF ( NMOD_IFN .GE. 1 ) THEN
XFRAC(3,:)=1.
CASE ('O')
XFRAC(4,:)=1.
- CASE ('MACC')
+ CASE ('CAMS')
XFRAC(1,1)=0.99
XFRAC(2,1)=0.01
XFRAC(3,1)=0.
@@ -318,7 +372,7 @@ IF ( NMOD_IFN .GE. 1 ) THEN
XFRAC(2,2)=0.
XFRAC(3,2)=0.5
XFRAC(4,2)=0.5
- CASE ('MACC_JPP')
+ CASE ('CAMS_JPP')
XFRAC(1,1)=1.0
XFRAC(2,1)=0.0
XFRAC(3,1)=0.0
@@ -327,6 +381,24 @@ IF ( NMOD_IFN .GE. 1 ) THEN
XFRAC(2,2)=0.0
XFRAC(3,2)=0.5
XFRAC(4,2)=0.5
+ CASE ('CAMS_ACC')
+ XFRAC(1,1)=1.0
+ XFRAC(2,1)=0.0
+ XFRAC(3,1)=0.0
+ XFRAC(4,1)=0.0
+ XFRAC(1,2)=0.0
+ XFRAC(2,2)=0.0
+ XFRAC(3,2)=0.0
+ XFRAC(4,2)=1.0
+ CASE ('CAMS_AIT')
+ XFRAC(1,1)=1.0
+ XFRAC(2,1)=0.0
+ XFRAC(3,1)=0.0
+ XFRAC(4,1)=0.0
+ XFRAC(1,2)=0.0
+ XFRAC(2,2)=0.0
+ XFRAC(3,2)=0.0
+ XFRAC(4,2)=1.0
CASE ('MOCAGE')
XFRAC(1,1)=1.
XFRAC(2,1)=0.
diff --git a/src/MNH/init_mnh.f90 b/src/MNH/init_mnh.f90
index 7b7d49a3aa77d54df4e93992845fcadb816821c2..9fe0836d00fcc2caa41a735c227bcfba2aa610e1 100644
--- a/src/MNH/init_mnh.f90
+++ b/src/MNH/init_mnh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -76,7 +76,8 @@
!* 0. DECLARATIONS
! ------------
USE MODD_CONF
-USE MODD_DYN_n, ONLY: CPRESOPT,NITR ! only for spawning purpose
+USE MODD_CST, ONLY: XP00, XTH00, XP00OCEAN, XTH00OCEAN
+USE MODD_DYN_n, ONLY: CPRESOPT, NITR, LOCEAN ! 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
@@ -180,6 +181,13 @@ 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.f90 b/src/MNH/lima.f90
index dc6ccca740d003df2a6ef53fce12aafdbaed926b..c248f1acf5366d8bea72fab2055770f2562e5cc4 100644
--- a/src/MNH/lima.f90
+++ b/src/MNH/lima.f90
@@ -9,15 +9,15 @@ MODULE MODI_LIMA
!
INTERFACE
!
- SUBROUTINE LIMA ( KKA, KKU, KKL, &
- PTSTEP, TPFILE, &
- PRHODREF, PEXNREF, PDZZ, &
- PRHODJ, PPABSM, PPABST, &
- NCCN, NIFN, NIMM, &
- PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
- PTHS, PRS, PSVS, &
+ SUBROUTINE LIMA ( KKA, KKU, KKL, &
+ PTSTEP, TPFILE, &
+ PRHODREF, PEXNREF, PDZZ, &
+ PRHODJ, PPABSM, PPABST, &
+ NCCN, NIFN, NIMM, &
+ PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
+ PTHS, PRS, PSVS, &
PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D )
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR )
!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, only: NSV_LIMA_BEG
@@ -41,7 +41,7 @@ INTEGER, INTENT(IN) :: NCCN ! for array size declarati
INTEGER, INTENT(IN) :: NIFN ! for array size declarations
INTEGER, INTENT(IN) :: NIMM ! for array size declarations
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! dT/dt due to radiation
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
@@ -60,21 +60,25 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRH ! Rain instant precip
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
+!
END SUBROUTINE LIMA
END INTERFACE
END MODULE MODI_LIMA
!
!
! ######spl
- SUBROUTINE LIMA ( KKA, KKU, KKL, &
- PTSTEP, TPFILE, &
- PRHODREF, PEXNREF, PDZZ, &
- PRHODJ, PPABSM, PPABST, &
- NCCN, NIFN, NIMM, &
- PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
- PTHS, PRS, PSVS, &
+ SUBROUTINE LIMA ( KKA, KKU, KKL, &
+ PTSTEP, TPFILE, &
+ PRHODREF, PEXNREF, PDZZ, &
+ PRHODJ, PPABSM, PPABST, &
+ NCCN, NIFN, NIMM, &
+ PDTHRAD, PTHT, PRT, PSVT, PW_NU, &
+ PTHS, PRS, PSVS, &
PINPRC, PINDEP, PINPRR, PINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D )
+ PEVAP3D, PCLDFR, PICEFR, PPRCFR )
! ######################################################################
!
!! PURPOSE
@@ -102,6 +106,7 @@ END MODULE MODI_LIMA
! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS
! P. Wautelet 03/02/2021: budgets: add new source if LIMA splitting: CORR2
+! B. Vie 06/2021: add subgrid condensation with LIMA
!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -125,10 +130,12 @@ USE MODD_PARAM_LIMA, ONLY: LCOLD, LRAIN, LWARM, NMOD_CCN, NMOD_IFN, NMOD_IM
LHAIL, LSNOW
USE MODD_PARAM_LIMA_COLD, ONLY: XAI, XBI
USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, XAC, XBC, XAR, XBR
+USE MODD_TURB_n, ONLY: LSUBG_COND
use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
+USE MODI_LIMA_COMPUTE_CLOUD_FRACTIONS
USE MODI_LIMA_DROPS_TO_DROPLETS_CONV
USE MODI_LIMA_INST_PROCS
USE MODI_LIMA_NUCLEATION_PROCS
@@ -158,7 +165,7 @@ INTEGER, INTENT(IN) :: NCCN ! for array size declarati
INTEGER, INTENT(IN) :: NIFN ! for array size declarations
INTEGER, INTENT(IN) :: NIMM ! for array size declarations
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Theta at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! dT/dt due to radiation
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! Mixing ratios at time t
REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
@@ -177,6 +184,10 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG ! Graupel instant precip
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRH ! Rain instant precip
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D ! Rain evap profile
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Cloud fraction
+!
!* 0.2 Declarations of local variables :
!
!
@@ -225,6 +236,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: &
Z_TH_EVAP, Z_RR_EVAP, & ! evaporation of rain drops (EVAP) : rv=-rr-rc, rc, Nc, rr, Nr, th
Z_RI_CNVI, Z_CI_CNVI, & ! conversion snow -> ice (CNVI) : ri, Ni, rs=-ri
Z_TH_DEPS, Z_RS_DEPS, & ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
+ Z_TH_DEPI, Z_RI_DEPI, & ! deposition of vapor on ice (DEPI) : rv=-ri, ri, th
Z_RI_CNVS, Z_CI_CNVS, & ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
Z_RI_AGGS, Z_CI_AGGS, & ! aggregation of ice on snow (AGGS) : ri, Ni, rs=-ri
Z_TH_DEPG, Z_RG_DEPG, & ! deposition of vapor on graupel (DEPG) : rv=-rg, rg, th
@@ -275,6 +287,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
ZTOT_TH_EVAP, ZTOT_RR_EVAP, & ! evaporation of rain drops (EVAP)
ZTOT_RI_CNVI, ZTOT_CI_CNVI, & ! conversion snow -> ice (CNVI)
ZTOT_TH_DEPS, ZTOT_RS_DEPS, & ! deposition of vapor on snow (DEPS)
+ ZTOT_TH_DEPI, ZTOT_RI_DEPI, & ! deposition of vapor on ice (DEPI)
ZTOT_RI_CNVS, ZTOT_CI_CNVS, & ! conversion ice -> snow (CNVS)
ZTOT_RI_AGGS, ZTOT_CI_AGGS, & ! aggregation of ice on snow (AGGS)
ZTOT_TH_DEPG, ZTOT_RG_DEPG, & ! deposition of vapor on graupel (DEPG)
@@ -312,7 +325,9 @@ LOGICAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: LLCOMPUTE
LOGICAL, DIMENSION(:), ALLOCATABLE :: LLCOMPUTE1D
REAL :: ZTSTEP
INTEGER :: INB_ITER_MAX
-
+!
+!For subgrid clouds
+REAL, DIMENSION(:), ALLOCATABLE :: ZCF1D, ZIF1D, ZPF1D ! 1D packed cloud, ice and precip. frac.
!
! Various parameters
@@ -320,7 +335,7 @@ INTEGER :: INB_ITER_MAX
INTEGER :: KRR
INTEGER :: IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, IKTB, IKTE
! loops and packing
-INTEGER :: II, IPACK, JI
+INTEGER :: II, IPACK, JI, JJ, JK
integer :: idx
INTEGER, DIMENSION(:), ALLOCATABLE :: I1, I2, I3
! Inverse ov PTSTEP
@@ -418,6 +433,8 @@ if ( lbu_enable ) then
allocate( ZTOT_CI_CNVI (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_CNVI(:,:,:) = 0.
allocate( ZTOT_TH_DEPS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_DEPS(:,:,:) = 0.
allocate( ZTOT_RS_DEPS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_DEPS(:,:,:) = 0.
+ allocate( ZTOT_TH_DEPI (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_DEPI(:,:,:) = 0.
+ allocate( ZTOT_RI_DEPI (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_DEPI(:,:,:) = 0.
allocate( ZTOT_RI_CNVS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_CNVS(:,:,:) = 0.
allocate( ZTOT_CI_CNVS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_CNVS(:,:,:) = 0.
allocate( ZTOT_RI_AGGS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_AGGS(:,:,:) = 0.
@@ -540,78 +557,78 @@ IF ( LCOLD .AND. LHHONI ) ZHOMFT(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE) * PTSTE
IF ( LCOLD .AND. LHHONI ) ZHOMFS(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE)
!
ZINV_TSTEP = 1./PTSTEP
-ZEXN(:,:,:) = PEXNREF(:,:,:)
+ZEXN(:,:,:) = (PPABST(:,:,:)/XP00)**(XRD/XCPD)
ZT(:,:,:) = ZTHT(:,:,:) * ZEXN(:,:,:)
!
!-------------------------------------------------------------------------------
!
!* 0. Check mean diameter for cloud, rain and ice
! --------------------------------------------
-if ( lbu_enable ) then
- if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv ) then
- if ( lwarm .and. lrain ) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
- if ( lwarm .and. lrain ) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
- if ( lcold .and. lsnow ) &
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
- end if
-end if
-IF (LWARM .AND. LRAIN) THEN
- WHERE( ZRCT>XRTMIN(2) .AND. ZCCT>XCTMIN(2) .AND. ZRCT>XAC*ZCCT*(100.E-6)**XBC )
- ZRRT=ZRRT+ZRCT
- ZRRS=ZRRS+ZRCS
- ZCRT=ZCRT+ZCCT
- ZCRS=ZCRS+ZCCS
- ZRCT=0.
- ZCCT=0.
- ZRCS=0.
- ZCCS=0.
- END WHERE
-END IF
-!
-IF (LWARM .AND. LRAIN) THEN
- WHERE( ZRRT>XRTMIN(3) .AND. ZCRT>XCTMIN(3) .AND. ZRRT<XAR*ZCRT*(60.E-6)**XBR )
- ZRCT=ZRCT+ZRRT
- ZRCS=ZRCS+ZRRS
- ZCCT=ZCCT+ZCRT
- ZCCS=ZCCS+ZCRS
- ZRRT=0.
- ZCRT=0.
- ZRRS=0.
- ZCRS=0.
- END WHERE
-END IF
-!
-IF (LCOLD .AND. LSNOW) THEN
- WHERE( ZRIT>XRTMIN(4) .AND. ZCIT>XCTMIN(4) .AND. ZRIT>XAI*ZCIT*(250.E-6)**XBI )
- ZRST=ZRST+ZRIT
- ZRSS=ZRSS+ZRIS
- ZRIT=0.
- ZCIT=0.
- ZRIS=0.
- ZCIS=0.
- END WHERE
-END IF
-!
-if ( lbu_enable ) then
- if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
- if ( lbudget_sv ) then
- if ( lwarm .and. lrain ) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
- if ( lwarm .and. lrain ) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
- if ( lcold .and. lsnow ) &
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
- end if
-end if
+! if ( lbu_enable ) then
+! if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_sv ) then
+! if ( lwarm .and. lrain ) &
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
+! if ( lwarm .and. lrain ) &
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
+! if ( lcold .and. lsnow ) &
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
+! end if
+! end if
+!!$IF (LWARM .AND. LRAIN) THEN
+!!$ WHERE( ZRCT>XRTMIN(2) .AND. ZCCT>XCTMIN(2) .AND. ZRCT>XAC*ZCCT*(100.E-6)**XBC )
+!!$ ZRRT=ZRRT+ZRCT
+!!$ ZRRS=ZRRS+ZRCS
+!!$ ZCRT=ZCRT+ZCCT
+!!$ ZCRS=ZCRS+ZCCS
+!!$ ZRCT=0.
+!!$ ZCCT=0.
+!!$ ZRCS=0.
+!!$ ZCCS=0.
+!!$ END WHERE
+!!$END IF
+!!$!
+!!$IF (LWARM .AND. LRAIN) THEN
+!!$ WHERE( ZRRT>XRTMIN(3) .AND. ZCRT>XCTMIN(3) .AND. ZRRT<XAR*ZCRT*(60.E-6)**XBR )
+!!$ ZRCT=ZRCT+ZRRT
+!!$ ZRCS=ZRCS+ZRRS
+!!$ ZCCT=ZCCT+ZCRT
+!!$ ZCCS=ZCCS+ZCRS
+!!$ ZRRT=0.
+!!$ ZCRT=0.
+!!$ ZRRS=0.
+!!$ ZCRS=0.
+!!$ END WHERE
+!!$END IF
+!!$!
+!!$IF (LCOLD .AND. LSNOW) THEN
+!!$ WHERE( ZRIT>XRTMIN(4) .AND. ZCIT>XCTMIN(4) .AND. ZRIT>XAI*ZCIT*(250.E-6)**XBI )
+!!$ ZRST=ZRST+ZRIT
+!!$ ZRSS=ZRSS+ZRIS
+!!$ ZRIT=0.
+!!$ ZCIT=0.
+!!$ ZRIS=0.
+!!$ ZCIS=0.
+!!$ END WHERE
+!!$END IF
+!
+! if ( lbu_enable ) then
+! if ( lbudget_rc .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CORR', zrcs(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CORR', zrrs(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_ri .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CORR', zris(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CORR', zrss(:, :, :) * prhodj(:, :, :) )
+! if ( lbudget_sv ) then
+! if ( lwarm .and. lrain ) &
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CORR', zccs(:, :, :) * prhodj(:, :, :) )
+! if ( lwarm .and. lrain ) &
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CORR', zcrs(:, :, :) * prhodj(:, :, :) )
+! if ( lcold .and. lsnow ) &
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CORR', zcis(:, :, :) * prhodj(:, :, :) )
+! end if
+! end if
!-------------------------------------------------------------------------------
!
!* 1. Sedimentation
@@ -748,14 +765,33 @@ IF ( LCOLD ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
!
!-------------------------------------------------------------------------------
!
+!* 2. Compute cloud, ice and precipitation fractions
+! ----------------------------------------------
+!
+IF (LSUBG_COND) THEN
+ CALL LIMA_COMPUTE_CLOUD_FRACTIONS (IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ ZCCT, ZRCT, &
+ ZCRT, ZRRT, &
+ ZCIT, ZRIT, &
+ ZRST, ZRGT, ZRHT, &
+ PCLDFR, PICEFR, PPRCFR )
+ELSE
+ PCLDFR(:,:,:)=1.
+ PICEFR(:,:,:)=1.
+ PPRCFR(:,:,:)=1.
+END IF
+!
+!-------------------------------------------------------------------------------
+!
!* 2. Nucleation processes
! --------------------
!
-CALL LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
- PRHODREF, ZEXN, PPABST, ZT, PDTHRAD, PW_NU, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCRT, ZCIT, &
- ZCCNFT, ZCCNAT, ZIFNFT, ZIFNNT, ZIMMNT, ZHOMFT )
+CALL LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
+ PRHODREF, ZEXN, PPABST, ZT, PDTHRAD, PW_NU, &
+ ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
+ ZCCT, ZCRT, ZCIT, &
+ ZCCNFT, ZCCNAT, ZIFNFT, ZIFNNT, ZIMMNT, ZHOMFT, &
+ PCLDFR, PICEFR, PPRCFR )
!
! Saving sources before microphysics time-splitting loop
!
@@ -803,7 +839,7 @@ ZTIME(:,:,:)=0. ! Current integration time (all points may have a different inte
ZRT_SUM(:,:,:) = ZRCT(:,:,:) + ZRRT(:,:,:) + ZRIT(:,:,:) + ZRST(:,:,:) + ZRGT(:,:,:) + ZRHT(:,:,:)
WHERE (ZRT_SUM(:,:,:)<XRTMIN(2)) ZTIME(:,:,:)=PTSTEP ! no need to treat hydrometeor-free point
!
-DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
+DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP))
!
IF(XMRSTEP/=0.) THEN
! In this case we need to remember the mixing ratios used to compute the tendencies
@@ -824,7 +860,7 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
ENDIF
!
LLCOMPUTE(:,:,:)=.FALSE.
- LLCOMPUTE(IIB:IIE,IJB:IJE,IKB:IKE) = ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
+ LLCOMPUTE(IIB:IIE,IJB:IJE,IKTB:IKTE) = ZTIME(IIB:IIE,IJB:IJE,IKTB:IKTE)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
WHERE(LLCOMPUTE(:,:,:))
IITER(:,:,:)=IITER(:,:,:)+1
END WHERE
@@ -866,6 +902,9 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
ALLOCATE(Z0RST1D(IPACK))
ALLOCATE(Z0RGT1D(IPACK))
ALLOCATE(Z0RHT1D(IPACK))
+ ALLOCATE(ZCF1D(IPACK))
+ ALLOCATE(ZIF1D(IPACK))
+ ALLOCATE(ZPF1D(IPACK))
IPACK = COUNTJV(LLCOMPUTE,I1,I2,I3)
DO II=1,IPACK
ZRHODREF1D(II) = PRHODREF(I1(II),I2(II),I3(II))
@@ -896,8 +935,16 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
Z0RST1D(II) = Z0RST(I1(II),I2(II),I3(II))
Z0RGT1D(II) = Z0RGT(I1(II),I2(II),I3(II))
Z0RHT1D(II) = Z0RHT(I1(II),I2(II),I3(II))
+ ZCF1D(II) = PCLDFR(I1(II),I2(II),I3(II))
+ ZIF1D(II) = PICEFR(I1(II),I2(II),I3(II))
+ ZPF1D(II) = PPRCFR(I1(II),I2(II),I3(II))
END DO
!
+ WHERE(ZCF1D(:)<1.E-10 .AND. ZRCT1D(:)>XRTMIN(2) .AND. ZCCT1D(:)>XCTMIN(2)) ZCF1D(:)=1.
+ WHERE(ZIF1D(:)<1.E-10 .AND. ZRIT1D(:)>XRTMIN(4) .AND. ZCIT1D(:)>XCTMIN(4)) ZIF1D(:)=1.
+ WHERE(ZPF1D(:)<1.E-10 .AND. (ZRRT1D(:)>XRTMIN(3) .OR. ZRST1D(:)>XRTMIN(5) &
+ .OR. ZRGT1D(:)>XRTMIN(6) .OR. ZRHT1D(:)>XRTMIN(7) ) ) ZPF1D(:)=1.
+ !
! Allocating 1D variables
!
ALLOCATE(ZMAXTIME(IPACK)) ; ZMAXTIME(:) = 0.
@@ -951,6 +998,8 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
ALLOCATE(Z_CI_CNVI(IPACK)) ; Z_CI_CNVI(:) = 0.
ALLOCATE(Z_TH_DEPS(IPACK)) ; Z_TH_DEPS(:) = 0.
ALLOCATE(Z_RS_DEPS(IPACK)) ; Z_RS_DEPS(:) = 0.
+ ALLOCATE(Z_TH_DEPI(IPACK)) ; Z_TH_DEPI(:) = 0.
+ ALLOCATE(Z_RI_DEPI(IPACK)) ; Z_RI_DEPI(:) = 0.
ALLOCATE(Z_RI_CNVS(IPACK)) ; Z_RI_CNVS(:) = 0.
ALLOCATE(Z_CI_CNVS(IPACK)) ; Z_CI_CNVS(:) = 0.
ALLOCATE(Z_RI_AGGS(IPACK)) ; Z_RI_AGGS(:) = 0.
@@ -1025,7 +1074,8 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
Z_TH_IMLT, Z_RC_IMLT, Z_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RG, &
ZB_CC, ZB_CR, ZB_CI, &
- ZB_IFNN )
+ ZB_IFNN, &
+ ZCF1D, ZIF1D, ZPF1D )
CALL LIMA_TENDENCIES (PTSTEP, LLCOMPUTE1D, &
ZEXNREF1D, ZRHODREF1D, ZP1D, ZTHT1D, &
@@ -1039,6 +1089,7 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
Z_TH_EVAP, Z_RR_EVAP, &
Z_RI_CNVI, Z_CI_CNVI, &
Z_TH_DEPS, Z_RS_DEPS, &
+ Z_TH_DEPI, Z_RI_DEPI, &
Z_RI_CNVS, Z_CI_CNVS, &
Z_RI_AGGS, Z_CI_AGGS, &
Z_TH_DEPG, Z_RG_DEPG, &
@@ -1060,7 +1111,8 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
!!! Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
ZA_TH, ZA_RV, ZA_RC, ZA_CC, ZA_RR, ZA_CR, &
ZA_RI, ZA_CI, ZA_RS, ZA_RG, ZA_RH, &
- ZEVAP1D )
+ ZEVAP1D, &
+ ZCF1D, ZIF1D, ZPF1D )
!
!*** 4.2 Integration time
@@ -1323,6 +1375,8 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
ZTOT_CI_CNVI(I1(II),I2(II),I3(II)) = ZTOT_CI_CNVI(I1(II),I2(II),I3(II)) + Z_CI_CNVI(II) * ZMAXTIME(II)
ZTOT_TH_DEPS(I1(II),I2(II),I3(II)) = ZTOT_TH_DEPS(I1(II),I2(II),I3(II)) + Z_TH_DEPS(II) * ZMAXTIME(II)
ZTOT_RS_DEPS(I1(II),I2(II),I3(II)) = ZTOT_RS_DEPS(I1(II),I2(II),I3(II)) + Z_RS_DEPS(II) * ZMAXTIME(II)
+ ZTOT_TH_DEPI(I1(II),I2(II),I3(II)) = ZTOT_TH_DEPI(I1(II),I2(II),I3(II)) + Z_TH_DEPI(II) * ZMAXTIME(II)
+ ZTOT_RI_DEPI(I1(II),I2(II),I3(II)) = ZTOT_RI_DEPI(I1(II),I2(II),I3(II)) + Z_RI_DEPI(II) * ZMAXTIME(II)
ZTOT_RI_CNVS(I1(II),I2(II),I3(II)) = ZTOT_RI_CNVS(I1(II),I2(II),I3(II)) + Z_RI_CNVS(II) * ZMAXTIME(II)
ZTOT_CI_CNVS(I1(II),I2(II),I3(II)) = ZTOT_CI_CNVS(I1(II),I2(II),I3(II)) + Z_CI_CNVS(II) * ZMAXTIME(II)
ZTOT_RI_AGGS(I1(II),I2(II),I3(II)) = ZTOT_RI_AGGS(I1(II),I2(II),I3(II)) + Z_RI_AGGS(II) * ZMAXTIME(II)
@@ -1432,6 +1486,9 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
DEALLOCATE(Z0RST1D)
DEALLOCATE(Z0RGT1D)
DEALLOCATE(Z0RHT1D)
+ DEALLOCATE(ZCF1D)
+ DEALLOCATE(ZIF1D)
+ DEALLOCATE(ZPF1D)
!
DEALLOCATE(ZMAXTIME)
DEALLOCATE(ZTIME_THRESHOLD)
@@ -1484,6 +1541,8 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
DEALLOCATE(Z_CI_CNVI)
DEALLOCATE(Z_TH_DEPS)
DEALLOCATE(Z_RS_DEPS)
+ DEALLOCATE(Z_TH_DEPI)
+ DEALLOCATE(Z_RI_DEPI)
DEALLOCATE(Z_RI_CNVS)
DEALLOCATE(Z_CI_CNVS)
DEALLOCATE(Z_RI_AGGS)
@@ -1589,6 +1648,7 @@ if ( lbu_enable ) then
call Budget_store_add( tbudgets(NBUDGET_TH), 'HONC', ztot_th_honc (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_TH), 'HONR', ztot_th_honr (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', ztot_th_deps (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPI', ztot_th_depi (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', ztot_th_depg (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_TH), 'IMLT', ztot_th_imlt (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', ztot_th_berfi(:, :, :) * zrhodjontstep(:, :, :) )
@@ -1603,6 +1663,7 @@ if ( lbu_enable ) then
if ( lbudget_rv ) then
call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', -ztot_rr_evap (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', -ztot_rs_deps (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPI', -ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', -ztot_rg_depg (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_RV), 'CORR2', ztot_rv_corr2(:, :, :) * zrhodjontstep(:, :, :) )
end if
@@ -1644,6 +1705,7 @@ if ( lbu_enable ) then
call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', -ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_RI), 'HMS', ztot_ri_hms (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', ztot_ri_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'DEPI', ztot_ri_depi (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_RI), 'WETG', ztot_ri_wetg (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYG', ztot_ri_dryg (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(NBUDGET_RI), 'HMG', ztot_ri_hmg (:, :, :) * zrhodjontstep(:, :, :) )
@@ -1689,7 +1751,7 @@ if ( lbu_enable ) then
call Budget_store_add( tbudgets(idx), 'SELF', ztot_cc_self (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(idx), 'AUTO', ztot_cc_auto (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(idx), 'ACCR', ztot_cc_accr (:, :, :) * zrhodjontstep(:, :, :) )
- !call Budget_store_add( tbudgets(idx), 'REVA', 0. )c
+ !call Budget_store_add( tbudgets(idx), 'REVA', 0. )
call Budget_store_add( tbudgets(idx), 'HONC', ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(idx), 'IMLT', ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(idx), 'RIM', ztot_cc_rim (:, :, :) * zrhodjontstep(:, :, :) )
@@ -1703,7 +1765,7 @@ if ( lbu_enable ) then
idx = NBUDGET_SV1 - 1 + nsv_lima_nr
call Budget_store_add( tbudgets(idx), 'AUTO', ztot_cr_auto(:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(idx), 'SCBU', ztot_cr_scbu(:, :, :) * zrhodjontstep(:, :, :) )
- !all Budget_store_add( tbudgets(idx), 'REVA', 0. )
+ !call Budget_store_add( tbudgets(idx), 'REVA', 0. )
call Budget_store_add( tbudgets(idx), 'BRKU', ztot_cr_brku(:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(idx), 'HONR', ztot_cr_honr(:, :, :) * zrhodjontstep(:, :, :) )
call Budget_store_add( tbudgets(idx), 'ACC', ztot_cr_acc (:, :, :) * zrhodjontstep(:, :, :) )
diff --git a/src/MNH/lima_adjust.f90 b/src/MNH/lima_adjust.f90
index a629f3920e97f571a2047de02e078e706f766769..949fabf42b62e7240d2806dc6eaada110ff037f0 100644
--- a/src/MNH/lima_adjust.f90
+++ b/src/MNH/lima_adjust.f90
@@ -9,11 +9,12 @@
!
INTERFACE
!
- SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, HRAD, &
- HTURBDIM, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, &
- PRT, PRS, PSVT, PSVS, &
- PTHS, PSRCS, PCLDFR )
+ SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, &
+ OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PPABSM, &
+ PPABST, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR )
!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, only: NSV_LIMA_BEG
@@ -21,9 +22,6 @@ USE MODD_NSV, only: NSV_LIMA_BEG
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
REAL, INTENT(IN) :: PTSTEP ! Time step
@@ -33,7 +31,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
!
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
@@ -49,7 +46,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
! s'rc'/2Sigma_s2 at time t+1
! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
!
END SUBROUTINE LIMA_ADJUST
!
@@ -57,13 +54,14 @@ END INTERFACE
!
END MODULE MODI_LIMA_ADJUST
!
-! ##########################################################################
- SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, HRAD, &
- HTURBDIM, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PPABST, &
- PRT, PRS, PSVT, PSVS, &
- PTHS, PSRCS, PCLDFR )
-! ##########################################################################
+! ###########################################################
+ SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, &
+ OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PPABSM, &
+ PPABST, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR )
+! ###########################################################
!
!!**** *MIMA_ADJUST* - compute the fast microphysical sources
!!
@@ -138,6 +136,7 @@ END MODULE MODI_LIMA_ADJUST
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS
! P. Wautelet 01/02/2021: bugfix: add missing CEDS source terms for SV budgets
+! B. Vie 06/2020: fix PSRCS
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -165,7 +164,9 @@ use mode_msg
use mode_tools, only: Countjv
!
USE MODI_CONDENS
+USE MODI_CONDENSATION
USE MODI_LIMA_FUNCTIONS
+USE MODI_LIMA_CCN_ACTIVATION
!
IMPLICIT NONE
!
@@ -175,9 +176,6 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
REAL, INTENT(IN) :: PTSTEP ! Time step
@@ -187,7 +185,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
!
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
@@ -203,7 +200,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
! s'rc'/2Sigma_s2 at time t+1
! multiplied by Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
!
!
!* 0.2 Declarations of local variables :
@@ -263,9 +260,12 @@ REAL, DIMENSION(:), ALLOCATABLE &
ZRVSATW, ZRVSATI, ZRVSATW_PRIME, ZRVSATI_PRIME, &
ZAW, ZAI, ZCJ, ZKA, ZDV, ZITW, ZITI, ZAWW, ZAIW, &
ZAWI, ZAII, ZFACT, ZDELTW, &
- ZDELTI, ZDELT1, ZDELT2, ZCND, ZDEP
+ ZDELTI, ZDELT1, ZDELT2, ZCND, ZDEP, ZS, ZVEC1, ZZW2
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1
!
INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
INTEGER :: IKB ! K index value of the first inner mass point
INTEGER :: IKE ! K index value of the last inner mass point
INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
@@ -292,6 +292,9 @@ TYPE(TFIELDDATA) :: TZFIELD
!
ILUOUT = TLUOUT%NLU
!
+IIU = SIZE(PEXNREF,1)
+IJU = SIZE(PEXNREF,2)
+IKU = SIZE(PEXNREF,3)
IIB = 1 + JPHEXT
IIE = SIZE(PRHODJ,1) - JPHEXT
IJB = 1 + JPHEXT
@@ -317,6 +320,7 @@ ALLOCATE(ZCTMIN(ISIZE))
ZCTMIN(:) = XCTMIN(:) / ZDT
!
! Prepare 3D water mixing ratios
+!
PRVT(:,:,:) = PRT(:,:,:,1)
PRVS(:,:,:) = PRS(:,:,:,1)
!
@@ -381,8 +385,10 @@ if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
if ( lscav .and. laero_mass ) &
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
if ( lwarm ) then
@@ -623,12 +629,10 @@ END IF ! IMICRO
!* select cases where r_c>0 and r_i=0
!
!
-GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = &
- .NOT. GMICRO_RI(IIB:IIE,IJB:IJE,IKB:IKE) &
- .AND. ( PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(2) .AND. &
- PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2) ) &
- .AND. .NOT. ( PRIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZRTMIN(4) .AND. &
- PCIS(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4) )
+GMICRO(:,:,:) = .FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) =( PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>0. .AND. &
+ PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>0. ) .AND. &
+ .NOT.GMICRO_RI(IIB:IIE,IJB:IJE,IKB:IKE)
GMICRO_RC(:,:,:) = GMICRO(:,:,:)
IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
IF( IMICRO >= 1 ) THEN
@@ -637,6 +641,7 @@ IF( IMICRO >= 1 ) THEN
!
ALLOCATE(ZRVS(IMICRO))
ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZCCS(IMICRO))
ALLOCATE(ZTHS(IMICRO))
!
ALLOCATE(ZRHODREF(IMICRO))
@@ -650,6 +655,7 @@ IF( IMICRO >= 1 ) THEN
!
ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
!
ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
@@ -660,25 +666,47 @@ IF( IMICRO >= 1 ) THEN
ENDDO
ALLOCATE(ZZW(IMICRO))
ALLOCATE(ZLVFACT(IMICRO))
- ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
+ ALLOCATE(ZCND(IMICRO))
ALLOCATE(ZRVSATW(IMICRO))
- ALLOCATE(ZRVSATW_PRIME(IMICRO))
-!
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
- ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
- * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
- ALLOCATE(ZAWW(IMICRO))
- ALLOCATE(ZDELT1(IMICRO))
- ALLOCATE(ZDELT2(IMICRO))
- ALLOCATE(ZCND(IMICRO))
-!
- ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZLVFACT(:)
- ZDELT2(:) = (ZRVSATW_PRIME(:)*ZLVFACT(:)/ZAWW(:)) * &
- ( ((-2.*XBETAW+XGAMW*ZZT(:))/(XBETAW-XGAMW*ZZT(:)) &
- + (XBETAW/ZZT(:)-XGAMW)*(1.0+2.0*ZRVSATW(:)/ZEPS))/ZZT(:) )
- ZDELT1(:) = (ZLVFACT(:)/ZAWW(:)) * ( ZRVSATW(:) - ZRVS(:)*ZDT )
- ZCND(:) = - ZDELT1(:)*( 1.0 + 0.5*ZDELT1(:)*ZDELT2(:) ) / (ZLVFACT(:)*ZDT)
+
+ IF (LADJ) THEN
+ ALLOCATE(ZRVSATW_PRIME(IMICRO))
+ ALLOCATE(ZAWW(IMICRO))
+ ALLOCATE(ZDELT1(IMICRO))
+ ALLOCATE(ZDELT2(IMICRO))
+ ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
+ * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
+ ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZLVFACT(:)
+ ZDELT2(:) = (ZRVSATW_PRIME(:)*ZLVFACT(:)/ZAWW(:)) * &
+ ( ((-2.*XBETAW+XGAMW*ZZT(:))/(XBETAW-XGAMW*ZZT(:)) &
+ + (XBETAW/ZZT(:)-XGAMW)*(1.0+2.0*ZRVSATW(:)/ZEPS))/ZZT(:) )
+ ZDELT1(:) = (ZLVFACT(:)/ZAWW(:)) * ( ZRVSATW(:) - ZRVS(:)*ZDT )
+ ZCND(:) = - ZDELT1(:)*( 1.0 + 0.5*ZDELT1(:)*ZDELT2(:) ) / (ZLVFACT(:)*ZDT)
+ DEALLOCATE(ZRVSATW_PRIME)
+ DEALLOCATE(ZAWW)
+ DEALLOCATE(ZDELT1)
+ DEALLOCATE(ZDELT2)
+ ELSE
+ ALLOCATE(ZS(IMICRO))
+ ALLOCATE(ZZW2(IMICRO))
+ ALLOCATE(ZVEC1(IMICRO))
+ ALLOCATE(IVEC1(IMICRO))
+ ZVEC1(:) = MAX( 1.0001, MIN( FLOAT(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
+ ZS(:) = ZRVS(:)*PTSTEP / ZRVSATW(:) - 1.
+ ZZW(:) = ZCCS(:)*PTSTEP/(XLBC*ZCCS(:)/ZRCS(:))**XLBEXC
+ ZZW2(:) = XAHENG3(IVEC1(:)+1)*ZVEC1(:)-XAHENG3(IVEC1(:))*(ZVEC1(:)-1.)
+ ZCND(:) = 2.*3.14*1000.*ZZW2(:)*ZS(:)*ZZW(:)
+ DEALLOCATE(ZS)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(IVEC1)
+ END IF
+
!
! Integration
!
@@ -702,6 +730,7 @@ IF( IMICRO >= 1 ) THEN
DEALLOCATE(ZRCT)
DEALLOCATE(ZRVS)
DEALLOCATE(ZRCS)
+ DEALLOCATE(ZCCS)
DEALLOCATE(ZTHS)
DEALLOCATE(ZRHODREF)
DEALLOCATE(ZZT)
@@ -711,10 +740,6 @@ IF( IMICRO >= 1 ) THEN
DEALLOCATE(ZZW)
DEALLOCATE(ZLVFACT)
DEALLOCATE(ZRVSATW)
- DEALLOCATE(ZRVSATW_PRIME)
- DEALLOCATE(ZAWW)
- DEALLOCATE(ZDELT1)
- DEALLOCATE(ZDELT2)
DEALLOCATE(ZCND)
END IF ! IMICRO
!
@@ -1054,6 +1079,8 @@ END IF ! OSUBG_COND
!
! full sublimation of the cloud ice crystals if there are few
!
+IF ( .NOT. OSUBG_COND ) THEN
+
ZMASK(:,:,:) = 0.0
ZW(:,:,:) = 0.
WHERE (PRIS(:,:,:) <= ZRTMIN(4) .OR. PCIS(:,:,:) <= ZCTMIN(4))
@@ -1135,26 +1162,28 @@ IF (LSCAV .AND. LAERO_MASS) PMAS(:,:,:) = PMAS(:,:,:) * (1-ZMASK(:,:,:))
!
! end of the iterative loop
!
+END IF ! .NOT.OSUBG_COND
+
END DO
!
-DEALLOCATE(ZRTMIN)
-DEALLOCATE(ZCTMIN)
!
!* 5.2 compute the cloud fraction PCLDFR (binary !!!!!!!)
!
IF ( .NOT. OSUBG_COND ) THEN
WHERE (PRCS(:,:,:) + PRIS(:,:,:) + PRSS(:,:,:) > 1.E-12 / ZDT)
-! WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / ZDT)
- ZW(:,:,:) = 1.
+ PCLDFR(:,:,:) = 1.
ELSEWHERE
- ZW(:,:,:) = 0.
+ PCLDFR(:,:,:) = 0.
ENDWHERE
- IF ( SIZE(PSRCS,3) /= 0 ) THEN
- PSRCS(:,:,:) = ZW(:,:,:)
- END IF
END IF
!
-PCLDFR(:,:,:) = ZW(:,:,:)
+IF ( SIZE(PSRCS,3) /= 0 ) THEN
+ WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / ZDT)
+ PSRCS(:,:,:) = 1.
+ ELSEWHERE
+ PSRCS(:,:,:) = 0.
+ ENDWHERE
+END IF
!
IF ( tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'NEB'
@@ -1235,8 +1264,10 @@ if ( nbumod == kmi .and. lbu_enable ) then
if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
if ( lscav .and. laero_mass ) &
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
if ( lwarm ) then
@@ -1256,12 +1287,14 @@ if ( nbumod == kmi .and. lbu_enable ) then
end do
do jl = 1, nmod_imm
idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
- call Budget_store_init( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
end do
end if
end if
end if
!++cb++
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
diff --git a/src/MNH/lima_adjust_split.f90 b/src/MNH/lima_adjust_split.f90
new file mode 100644
index 0000000000000000000000000000000000000000..401048c3d4bfe870c94f08db0589a7e877aec7f2
--- /dev/null
+++ b/src/MNH/lima_adjust_split.f90
@@ -0,0 +1,845 @@
+!MNH_LIC Copyright 2013-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.
+!-----------------------------------------------------------------
+! #############################
+ MODULE MODI_LIMA_ADJUST_SPLIT
+! #############################
+!
+INTERFACE
+!
+ SUBROUTINE LIMA_ADJUST_SPLIT(KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
+ OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
+ PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PMFCONV, &
+ PPABST, PZZ, PDTHRAD, PW_NU, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR, PRC_MF, PCF_MF )
+!
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, only: NSV_LIMA_BEG
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+!
+END SUBROUTINE LIMA_ADJUST_SPLIT
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_ADJUST_SPLIT
+!
+! ###########################################################################
+ SUBROUTINE LIMA_ADJUST_SPLIT(KRR, KMI, TPFILE, HCONDENS, HLAMBDA3, &
+ OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
+ PRHODREF, PRHODJ, PEXNREF, PPABSM, PSIGS, PMFCONV, &
+ PPABST, PZZ, PDTHRAD, PW_NU, &
+ PRT, PRS, PSVT, PSVS, &
+ PTHS, PSRCS, PCLDFR, PRC_MF, PCF_MF )
+! ###########################################################################
+!
+!!**** *MIMA_ADJUST* - compute the fast microphysical sources
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the fast microphysical sources
+!! through an explict scheme and a saturation ajustement procedure.
+!!
+!!
+!!** METHOD
+!! ------
+!! Reisin et al., 1996 for the explicit scheme when ice is present
+!! Langlois, Tellus, 1973 for the implict adjustment for the cloud water
+!! (refer also to book 1 of the documentation).
+!!
+!! Computations are done separately for three cases :
+!! - ri>0 and rc=0
+!! - rc>0 and ri=0
+!! - ri>0 and rc>0
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_CST
+!! XP00 ! Reference pressure
+!! XMD,XMV ! Molar mass of dry air and molar mass of vapor
+!! XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+!! XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
+!! XCL ! Cl (liquid)
+!! XTT ! Triple point temperature
+!! XLVTT ! Vaporization heat constant
+!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor
+!! ! pressure function
+!! Module MODD_CONF
+!! CCONF
+!! Module MODD_BUDGET:
+!! NBUMOD
+!! CBUTYPE
+!! LBU_RTH
+!! LBU_RRV
+!! LBU_RRC
+!! Module MODD_LES : NCTR_LES,LTURB_LES,NMODNBR_LES
+!! XNA declaration (cloud fraction as global var)
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 1 and Book2 of documentation ( routine FAST_TERMS )
+!! Langlois, Tellus, 1973
+!!
+!! AUTHOR
+!! ------
+!! E. Richard * Laboratoire d'Aerologie*
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/2021 forked from lima_adjust.f90
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+use modd_field, only: TFIELDDATA, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_COLD
+USE MODD_PARAM_LIMA_MIXED
+USE MODD_PARAM_LIMA_WARM
+!
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+use mode_msg
+use mode_tools, only: Countjv
+!
+USE MODI_CONDENS
+USE MODI_CONDENSATION
+USE MODI_LIMA_FUNCTIONS
+USE MODI_LIMA_CCN_ACTIVATION
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KRR ! Number of moist variables
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+ ! Condensation
+LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
+ ! use values computed in CONDENSATION
+ ! or that from turbulence scheme
+REAL, INTENT(IN) :: PTSTEP ! Time step
+REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Dry density of the
+ ! reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ !
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
+!
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
+!
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRC_MF! Convective Mass Flux liquid mixing ratio
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCF_MF! Convective Mass Flux Cloud fraction
+!
+!
+!* 0.2 Declarations of local variables :
+!
+! 3D Microphysical variables
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: PTHT, &
+ PRVT, & ! Water vapor m.r. at t
+ PRCT, & ! Cloud water m.r. at t
+ PRRT, & ! Rain water m.r. at t
+ PRIT, & ! Cloud ice m.r. at t
+ PRST, & ! Aggregate m.r. at t
+ PRGT, & ! Graupel m.r. at t
+!
+ PRVS, & ! Water vapor m.r. source
+ PRCS, & ! Cloud water m.r. source
+ PRRS, & ! Rain water m.r. source
+ PRIS, & ! Cloud ice m.r. source
+ PRSS, & ! Aggregate m.r. source
+ PRGS, & ! Graupel m.r. source
+!
+ PCCT, & ! Cloud water conc. at t
+ PCIT, & ! Cloud ice conc. at t
+!
+ PCCS, & ! Cloud water C. source
+ PMAS, & ! Mass of scavenged AP
+ PCIS ! Ice crystal C. source
+!
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE &
+ :: PNFS, & ! Free CCN C. source
+ PNAS, & ! Activated CCN C. source
+ PNFT, & ! Free CCN C.
+ PNAT ! Activated CCN C.
+! PIFS, & ! Free IFN C. source
+! PINS, & ! Nucleated IFN C. source
+! PNIS ! Acti. IMM. nuclei C. source
+!
+!
+!
+REAL :: ZEPS ! Mv/Md
+REAL :: ZDT ! Time increment (2*Delta t or Delta t if cold start)
+REAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: ZEXNS,& ! guess of the Exner function at t+1
+ ZT, & ! guess of the temperature at t+1
+ ZCPH, & ! guess of the CPh for the mixing
+ ZW, &
+ ZW1, &
+ ZW2, &
+ ZLV, & ! guess of the Lv at t+1
+ ZLS, & ! guess of the Ls at t+1
+ ZMASK,&
+ ZRV, &
+ ZRC, &
+ ZRI, &
+ ZSIGS, &
+ ZW_MF
+LOGICAL, DIMENSION(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) &
+ :: GMICRO ! Test where to compute cond/dep proc.
+INTEGER :: IMICRO
+REAL, DIMENSION(:), ALLOCATABLE &
+ :: ZRVT, ZRCT, ZRIT, ZRVS, ZRCS, ZRIS, ZTHS, &
+ ZCCT, ZCIT, ZCCS, ZCIS, &
+ ZRHODREF, ZZT, ZPRES, ZEXNREF, ZZCPH, &
+ ZZW, ZLVFACT, ZLSFACT, &
+ ZRVSATW, ZRVSATI, ZRVSATW_PRIME, ZRVSATI_PRIME, &
+ ZAW, ZAI, ZCJ, ZKA, ZDV, ZITW, ZITI, ZAWW, ZAIW, &
+ ZAWI, ZAII, ZFACT, ZDELTW, &
+ ZDELTI, ZDELT1, ZDELT2, ZCND, ZDEP, ZS, ZVEC1, ZZW2
+!
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: IIU,IJU,IKU! dimensions of dummy arrays
+INTEGER :: IKB ! K index value of the first inner mass point
+INTEGER :: IKE ! K index value of the last inner mass point
+INTEGER :: IIB,IJB ! Horz index values of the first inner mass points
+INTEGER :: IIE,IJE ! Horz index values of the last inner mass points
+INTEGER :: JITER,ITERMAX ! iterative loop for first order adjustment
+INTEGER :: ILUOUT ! Logical unit of output listing
+!
+INTEGER :: ISIZE
+REAL, DIMENSION(:), ALLOCATABLE :: ZRTMIN
+REAL, DIMENSION(:), ALLOCATABLE :: ZCTMIN
+!
+integer :: idx
+INTEGER , DIMENSION(SIZE(GMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
+INTEGER :: JMOD, JMOD_IFN, JMOD_IMM
+!
+INTEGER , DIMENSION(3) :: BV
+TYPE(TFIELDDATA) :: TZFIELD
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+ILUOUT = TLUOUT%NLU
+!
+IIU = SIZE(PEXNREF,1)
+IJU = SIZE(PEXNREF,2)
+IKU = SIZE(PEXNREF,3)
+IIB = 1 + JPHEXT
+IIE = SIZE(PRHODJ,1) - JPHEXT
+IJB = 1 + JPHEXT
+IJE = SIZE(PRHODJ,2) - JPHEXT
+IKB = 1 + JPVEXT
+IKE = SIZE(PRHODJ,3) - JPVEXT
+!
+ZEPS= XMV / XMD
+!
+IF (OSUBG_COND) THEN
+ ITERMAX=2
+ELSE
+ ITERMAX=1
+END IF
+!
+ZDT = PTSTEP
+!
+ISIZE = SIZE(XRTMIN)
+ALLOCATE(ZRTMIN(ISIZE))
+ZRTMIN(:) = XRTMIN(:) / ZDT
+ISIZE = SIZE(XCTMIN)
+ALLOCATE(ZCTMIN(ISIZE))
+ZCTMIN(:) = XCTMIN(:) / ZDT
+!
+! Prepare 3D water mixing ratios
+!
+PTHT = PTHS*PTSTEP
+!
+PRVT(:,:,:) = PRT(:,:,:,1)
+PRVS(:,:,:) = PRS(:,:,:,1)
+!
+PRCT(:,:,:) = 0.
+PRCS(:,:,:) = 0.
+PRRT(:,:,:) = 0.
+PRRS(:,:,:) = 0.
+PRIT(:,:,:) = 0.
+PRIS(:,:,:) = 0.
+PRST(:,:,:) = 0.
+PRSS(:,:,:) = 0.
+PRGT(:,:,:) = 0.
+PRGS(:,:,:) = 0.
+!
+IF ( KRR .GE. 2 ) PRCT(:,:,:) = PRT(:,:,:,2)
+IF ( KRR .GE. 2 ) PRCS(:,:,:) = PRS(:,:,:,2)
+IF ( KRR .GE. 3 ) PRRT(:,:,:) = PRT(:,:,:,3)
+IF ( KRR .GE. 3 ) PRRS(:,:,:) = PRS(:,:,:,3)
+IF ( KRR .GE. 4 ) PRIT(:,:,:) = PRT(:,:,:,4)
+IF ( KRR .GE. 4 ) PRIS(:,:,:) = PRS(:,:,:,4)
+IF ( KRR .GE. 5 ) PRST(:,:,:) = PRT(:,:,:,5)
+IF ( KRR .GE. 5 ) PRSS(:,:,:) = PRS(:,:,:,5)
+IF ( KRR .GE. 6 ) PRGT(:,:,:) = PRT(:,:,:,6)
+IF ( KRR .GE. 6 ) PRGS(:,:,:) = PRS(:,:,:,6)
+!
+! Prepare 3D number concentrations
+PCCT(:,:,:) = 0.
+PCIT(:,:,:) = 0.
+PCCS(:,:,:) = 0.
+! PCIS(:,:,:) = 0.
+!
+IF ( LWARM ) PCCT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NC)
+IF ( LCOLD ) PCIT(:,:,:) = PSVT(:,:,:,NSV_LIMA_NI)
+!
+IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+! IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
+!
+IF ( LSCAV .AND. LAERO_MASS ) PMAS(:,:,:) = PSVS(:,:,:,NSV_LIMA_SCAVMASS)
+!
+IF ( LWARM .AND. NMOD_CCN.GE.1 ) THEN
+ ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNFT(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( PNAT(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ PNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ PNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ PNFT(:,:,:,:) = PSVT(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ PNAT(:,:,:,:) = PSVT(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+END IF
+!
+! IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+! ALLOCATE( PIFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+! ALLOCATE( PINS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IFN) )
+! PIFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1)
+! PINS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1)
+! END IF
+!
+! IF ( NMOD_IMM .GE. 1 ) THEN
+! ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_IMM) )
+! PNIS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1)
+! END IF
+!
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+ !Remark: PRIS is not modified but source term kept for better coherence with lima_adjust and lima_notadjust
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lscav .and. laero_mass ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+! if ( lcold ) then
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+! do jl = 1, nmod_ifn
+! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nmod_imm
+! idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! end if
+ end if
+end if
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
+! -------------------------------------------------------
+!
+!* 2.1 remove negative non-precipitating negative water
+! ------------------------------------------------
+!
+IF (ANY(PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.) .AND. NVERB>5) THEN
+ WRITE(ILUOUT,*) 'LIMA_ADJUST: negative values of total water (reset to zero)'
+ WRITE(ILUOUT,*) ' location of minimum PRVS+PRCS+PRIS:',MINLOC(PRVS+PRCS+PRIS)
+ WRITE(ILUOUT,*) ' value of minimum PRVS+PRCS+PRIS:',MINVAL(PRVS+PRCS+PRIS)
+END IF
+!
+WHERE ( PRVS(:,:,:)+PRCS(:,:,:)+PRIS(:,:,:) < 0.)
+ PRVS(:,:,:) = - PRCS(:,:,:) - PRIS(:,:,:)
+END WHERE
+!
+!* 2.2 estimate the Exner function at t+1
+!
+ZEXNS(:,:,:) = ( (2. * PPABST(:,:,:) - PPABSM(:,:,:)) / XP00 ) ** (XRD/XCPD)
+!
+! beginning of the iterative loop
+!
+DO JITER =1,ITERMAX
+!
+!* 2.3 compute the intermediate temperature at t+1, T*
+!
+ ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
+!
+!* 2.4 compute the specific heat for moist air (Cph) at t+1
+!
+ ZCPH(:,:,:) = XCPD + XCPV *ZDT* PRVS(:,:,:) &
+ + XCL *ZDT* ( PRCS(:,:,:) + PRRS(:,:,:) ) &
+ + XCI *ZDT* ( PRIS(:,:,:) + PRSS(:,:,:) + PRGS(:,:,:) )
+!
+!* 2.5 compute the latent heat of vaporization Lv(T*) at t+1
+! and of sublimation Ls(T*) at t+1
+!
+ ZLV(:,:,:) = XLVTT + ( XCPV - XCL ) * ( ZT(:,:,:) -XTT )
+ ZLS(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZT(:,:,:) -XTT )
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. FIRST ORDER SUBGRID CONDENSATION SCHEME
+! ---------------------------------------
+!
+ IF ( OSUBG_COND ) THEN
+ !
+ ZRV=PRVS*PTSTEP
+ ZRC=PRCS*PTSTEP
+ ZRI=0.
+ ZSIGS=PSIGS
+ CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'S', &
+ HCONDENS, HLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRSS*PTSTEP, PRGS*PTSTEP, &
+ ZSIGS, PMFCONV, PCLDFR, PSRCS, .FALSE., OSIGMAS, &
+ PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
+ PCLDFR(:,:,:) = MIN(PCLDFR(:,:,:) + PCF_MF(:,:,:) , 1.)
+ ZRV(:,:,:) = ZRV(:,:,:) - MAX(MIN(PRC_MF(:,:,:), ZRV(:,:,:)),0.)
+ ZRC(:,:,:) = ZRC(:,:,:) + MAX(MIN(PRC_MF(:,:,:), ZRV(:,:,:)),0.)
+ ZW_MF=0.
+ CALL LIMA_CCN_ACTIVATION (TPFILE, &
+ PRHODREF, PEXNREF, PPABST, ZT, PDTHRAD, PW_NU+ZW_MF, &
+ PTHT, ZRV, ZRC, PCCT, PRRT, PNFT, PNAT, &
+ PCLDFR )
+!
+ ELSE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!
+!* FULLY IMPLICIT CONDENSATION SCHEME
+! ---------------------------------
+!
+!* select cases where r_c>0
+!
+!
+ GMICRO(:,:,:) = .FALSE.
+ GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) =( PRCS(IIB:IIE,IJB:IJE,IKB:IKE)>0. .AND. &
+ PCCS(IIB:IIE,IJB:IJE,IKB:IKE)>0. )
+ IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+ IF( IMICRO >= 1 ) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRCT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZCCS(IMICRO))
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZZCPH(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRVT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ !
+ ZRVS(JL) = PRVS(I1(JL),I2(JL),I3(JL))
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
+ ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+ !
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLVFACT(IMICRO))
+ ALLOCATE(ZRVSATW(IMICRO))
+ ALLOCATE(ZCND(IMICRO))
+ ZLVFACT(:) = (XLVTT+(XCPV-XCL)*(ZZT(:)-XTT))/ZZCPH(:) ! L_v/C_ph
+ ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
+ ZRVSATW(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_sw
+
+ IF (LADJ) THEN
+ ALLOCATE(ZRVSATW_PRIME(IMICRO))
+ ALLOCATE(ZAWW(IMICRO))
+ ALLOCATE(ZDELT1(IMICRO))
+ ALLOCATE(ZDELT2(IMICRO))
+ ZRVSATW_PRIME(:) = (( XBETAW/ZZT(:) - XGAMW ) / ZZT(:)) & ! r'_sw
+ * ZRVSATW(:) * ( 1. + ZRVSATW(:)/ZEPS )
+ ZAWW(:) = 1.0 + ZRVSATW_PRIME(:)*ZLVFACT(:)
+ ZDELT2(:) = (ZRVSATW_PRIME(:)*ZLVFACT(:)/ZAWW(:)) * &
+ ( ((-2.*XBETAW+XGAMW*ZZT(:))/(XBETAW-XGAMW*ZZT(:)) &
+ + (XBETAW/ZZT(:)-XGAMW)*(1.0+2.0*ZRVSATW(:)/ZEPS))/ZZT(:) )
+ ZDELT1(:) = (ZLVFACT(:)/ZAWW(:)) * ( ZRVSATW(:) - ZRVS(:)*ZDT )
+ ZCND(:) = - ZDELT1(:)*( 1.0 + 0.5*ZDELT1(:)*ZDELT2(:) ) / (ZLVFACT(:)*ZDT)
+ DEALLOCATE(ZRVSATW_PRIME)
+ DEALLOCATE(ZAWW)
+ DEALLOCATE(ZDELT1)
+ DEALLOCATE(ZDELT2)
+ ELSE
+ ALLOCATE(ZS(IMICRO))
+ ALLOCATE(ZZW2(IMICRO))
+ ALLOCATE(ZVEC1(IMICRO))
+ ALLOCATE(IVEC1(IMICRO))
+ ZVEC1(:) = MAX( 1.0001, MIN( FLOAT(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - FLOAT( IVEC1(:) )
+ ZS(:) = ZRVS(:)*PTSTEP / ZRVSATW(:) - 1.
+ ZZW(:) = ZCCS(:)*PTSTEP/(XLBC*ZCCS(:)/ZRCS(:))**XLBEXC
+ ZZW2(:) = XAHENG3(IVEC1(:)+1)*ZVEC1(:)-XAHENG3(IVEC1(:))*(ZVEC1(:)-1.)
+ ZCND(:) = 2.*3.14*1000.*ZZW2(:)*ZS(:)*ZZW(:)
+ DEALLOCATE(ZS)
+ DEALLOCATE(ZZW2)
+ DEALLOCATE(ZVEC1)
+ DEALLOCATE(IVEC1)
+ END IF
+!
+!
+! Integration
+!
+ WHERE( ZCND(:) < 0.0 )
+ ZCND(:) = MAX ( ZCND(:), -ZRCS(:) )
+ ELSEWHERE
+ ZCND(:) = MIN ( ZCND(:), ZRVS(:) )
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZCND(:)
+ ZRCS(:) = ZRCS(:) + ZCND(:)
+ ZTHS(:) = ZTHS(:) + ZCND(:) * ZLVFACT(:) / ZEXNREF(:)
+!
+ ZW(:,:,:) = PRVS(:,:,:)
+ PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRCS(:,:,:)
+ PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRCT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRCS)
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZCPH)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLVFACT)
+ DEALLOCATE(ZRVSATW)
+ DEALLOCATE(ZCND)
+ END IF ! IMICRO
+!
+ END IF ! end of adjustment procedure (test on OSUBG_COND)
+!
+! Remove cloud droplets if there are few
+
+ ZMASK(:,:,:) = 0.0
+ ZW(:,:,:) = 0.
+ WHERE (PRCS(:,:,:) <= ZRTMIN(2) .OR. PCCS(:,:,:) <= ZCTMIN(2))
+ PRVS(:,:,:) = PRVS(:,:,:) + PRCS(:,:,:)
+ PTHS(:,:,:) = PTHS(:,:,:) - PRCS(:,:,:)*ZLV(:,:,:)/(ZCPH(:,:,:)*ZEXNS(:,:,:))
+ PRCS(:,:,:) = 0.0
+ ZW(:,:,:) = MAX(PCCS(:,:,:),0.)
+ PCCS(:,:,:) = 0.0
+ END WHERE
+!
+ ZW1(:,:,:) = 0.
+ IF (LWARM .AND. NMOD_CCN.GE.1) ZW1(:,:,:) = SUM(PNAS,DIM=4)
+ ZW (:,:,:) = MIN( ZW(:,:,:), ZW1(:,:,:) )
+ ZW2(:,:,:) = 0.
+ WHERE ( ZW(:,:,:) > 0. )
+ ZMASK(:,:,:) = 1.0
+ ZW2(:,:,:) = ZW(:,:,:) / ZW1(:,:,:)
+ ENDWHERE
+!
+ IF (LWARM .AND. NMOD_CCN.GE.1) THEN
+ DO JMOD = 1, NMOD_CCN
+ PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) + &
+ ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
+ PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) - &
+ ZMASK(:,:,:) * PNAS(:,:,:,JMOD) * ZW2(:,:,:)
+ PNAS(:,:,:,JMOD) = MAX( 0.0 , PNAS(:,:,:,JMOD) )
+ ENDDO
+ END IF
+!
+ IF (LSCAV .AND. LAERO_MASS) PMAS(:,:,:) = PMAS(:,:,:) * (1-ZMASK(:,:,:))
+!
+!
+END DO ! end of the iterative loop
+!
+!
+!* 5.2 compute the cloud fraction PCLDFR (binary !!!!!!!)
+!
+IF ( .NOT. OSUBG_COND ) THEN
+ WHERE (PRCS(:,:,:) + PRIS(:,:,:) + PRSS(:,:,:) > 1.E-12 / ZDT)
+ PCLDFR(:,:,:) = 1.
+ ELSEWHERE
+ PCLDFR(:,:,:) = 0.
+ ENDWHERE
+END IF
+!
+IF ( SIZE(PSRCS,3) /= 0 ) THEN
+ WHERE (PRCS(:,:,:) + PRIS(:,:,:) > 1.E-12 / ZDT)
+ PSRCS(:,:,:) = 1.
+ ELSEWHERE
+ PSRCS(:,:,:) = 0.
+ ENDWHERE
+END IF
+!
+IF ( OSUBG_COND ) THEN
+ !
+ ! Mixing ratio change (cloud liquid water)
+ !
+ ZW1(:,:,:) = (ZRC(:,:,:) - PRCS(:,:,:)*PTSTEP) / PTSTEP
+ WHERE( ZW1(:,:,:) < 0.0 )
+ ZW1(:,:,:) = MAX ( ZW1(:,:,:), -PRCS(:,:,:) )
+ ELSEWHERE
+ ZW1(:,:,:) = MIN ( ZW1(:,:,:), PRVS(:,:,:) )
+ END WHERE
+
+ WHERE (PCCT(:,:,:) < PCLDFR(:,:,:)*XCTMIN(2) .OR. ZRC(:,:,:)<PCLDFR(:,:,:)*XRTMIN(2))
+ ZW1=-PRCS
+ PCCS=0.
+ PCLDFR=0.
+ END WHERE
+
+ PRVS(:,:,:) = PRVS(:,:,:) - ZW1(:,:,:)
+ PRCS(:,:,:) = PRCS(:,:,:) + ZW1(:,:,:)
+ PCCS(:,:,:) = PCCT(:,:,:) / PTSTEP
+ PNFS(:,:,:,:) = PNFT(:,:,:,:) / PTSTEP
+ PNAS(:,:,:,:) = PNAT(:,:,:,:) / PTSTEP
+ PTHS(:,:,:) = PTHS(:,:,:) + &
+ ZW1(:,:,:) * ZLV(:,:,:) / (ZCPH(:,:,:) * PEXNREF(:,:,:))
+END IF ! fin test OSUBG_COND
+
+IF ( tpfile%lopened ) THEN
+ TZFIELD%CMNHNAME = 'NEB'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'NEB'
+ TZFIELD%CUNITS = '1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_NEB'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,PCLDFR)
+END IF
+!
+!
+!* 6. SAVE CHANGES IN PRS AND PSVS
+! ----------------------------
+!
+!
+! Prepare 3D water mixing ratios
+PRS(:,:,:,1) = PRVS(:,:,:)
+IF ( KRR .GE. 2 ) PRS(:,:,:,2) = PRCS(:,:,:)
+IF ( KRR .GE. 3 ) PRS(:,:,:,3) = PRRS(:,:,:)
+IF ( KRR .GE. 4 ) PRS(:,:,:,4) = PRIS(:,:,:)
+IF ( KRR .GE. 5 ) PRS(:,:,:,5) = PRSS(:,:,:)
+IF ( KRR .GE. 6 ) PRS(:,:,:,6) = PRGS(:,:,:)
+!
+! Prepare 3D number concentrations
+!
+IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
+! IF ( LCOLD ) PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
+!
+IF ( LSCAV .AND. LAERO_MASS ) PSVS(:,:,:,NSV_LIMA_SCAVMASS) = PMAS(:,:,:)
+!
+IF ( LWARM .AND. NMOD_CCN .GE. 1 ) THEN
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = PNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = PNAS(:,:,:,:)
+END IF
+!
+! IF ( LCOLD .AND. NMOD_IFN .GE. 1 ) THEN
+! PSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1) = PIFS(:,:,:,:)
+! PSVS(:,:,:,NSV_LIMA_IFN_NUCL:NSV_LIMA_IFN_NUCL+NMOD_IFN-1) = PINS(:,:,:,:)
+! END IF
+!
+! IF ( LCOLD .AND. NMOD_IMM .GE. 1 ) THEN
+! PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
+! END IF
+!
+! write SSI in LFI
+!
+IF ( tpfile%lopened ) THEN
+ ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
+ ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
+ ZW1(:,:,:)= 2.0*PPABST(:,:,:)-PPABSM(:,:,:)
+ ZW(:,:,:) = PRVT(:,:,:)*( ZW1(:,:,:)-ZW(:,:,:) ) / ( (XMV/XMD) * ZW(:,:,:) ) - 1.0
+
+ TZFIELD%CMNHNAME = 'SSI'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSI'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_SSI'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+END IF
+!
+!
+!* 7. STORE THE BUDGET TERMS
+! ----------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CEDS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prcs(:, :, :) * prhodj(:, :, :) )
+ !Remark: PRIS is not modified but source term kept for better coherence with lima_adjust and lima_notadjust
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lscav .and. laero_mass ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', pmas(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+! if ( lcold ) then
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', pcis(:, :, :) * prhodj(:, :, :) )
+! do jl = 1, nmod_ifn
+! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+! call Budget_store_end( tbudgets(idx), 'CEDS', pifs(:, :, :, jl) * prhodj(:, :, :) )
+! idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+! call Budget_store_end( tbudgets(idx), 'CEDS', pins(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nmod_imm
+! idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', pnis(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! end if
+ end if
+end if
+!++cb++
+DEALLOCATE(ZRTMIN)
+DEALLOCATE(ZCTMIN)
+IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
+IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
+IF (ALLOCATED(PNFT)) DEALLOCATE(PNFT)
+IF (ALLOCATED(PNAT)) DEALLOCATE(PNAT)
+! IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
+! IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
+! IF (ALLOCATED(PNIS)) DEALLOCATE(PNIS)
+!--cb--
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_ADJUST_SPLIT
diff --git a/src/MNH/lima_ccn_activation.f90 b/src/MNH/lima_ccn_activation.f90
index 3854c543337cc0c2a3d9b118b4fd84b49d2a5eb7..d4204f8f5f508ae7e435aa83068a2502656cc318 100644
--- a/src/MNH/lima_ccn_activation.f90
+++ b/src/MNH/lima_ccn_activation.f90
@@ -8,13 +8,12 @@
! ###############################
!
INTERFACE
- SUBROUTINE LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, &
+ SUBROUTINE LIMA_CCN_ACTIVATION (TPFILE, &
PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
+ PCLDFR )
USE MODD_IO, ONLY: TFILEDATA
!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
@@ -34,13 +33,16 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Precipitation fraction
+!
END SUBROUTINE LIMA_CCN_ACTIVATION
END INTERFACE
END MODULE MODI_LIMA_CCN_ACTIVATION
! #############################################################################
- SUBROUTINE LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, &
+ SUBROUTINE LIMA_CCN_ACTIVATION (TPFILE, &
PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
+ PCLDFR )
! #############################################################################
!
!!
@@ -95,14 +97,16 @@ END MODULE MODI_LIMA_CCN_ACTIVATION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPW, XBETAW, XCL, XCPD, XCPV, XGAMW, XLVTT, XMD, XMV, XRV, XTT
+USE MODD_CST, ONLY: XALPW, XBETAW, XCL, XCPD, XCPV, XGAMW, XLVTT, XMD, XMNH_EPSILON, XMV, XRV, XTT
use modd_field, only: TFIELDDATA, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-USE MODD_PARAM_LIMA, ONLY: LACTIT, NMOD_CCN, XKHEN_MULTI, XCTMIN, XLIMIT_FACTOR
-USE MODD_PARAM_LIMA_WARM, ONLY: XWMIN, NAHEN, NHYP, XAHENINTP1, XAHENINTP2, XCSTDCRIT, XHYPF12, &
- XHYPINTP1, XHYPINTP2, XTMIN, XHYPF32, XPSI3, XAHENG, XPSI1
+USE MODD_PARAM_LIMA, ONLY: LACTIT, NMOD_CCN, XCTMIN, XKHEN_MULTI, XRTMIN, XLIMIT_FACTOR
+USE MODD_PARAM_LIMA_WARM, ONLY: XWMIN, NAHEN, NHYP, XAHENINTP1, XAHENINTP2, XCSTDCRIT, XHYPF12, &
+ XHYPINTP1, XHYPINTP2, XTMIN, XHYPF32, XPSI3, XAHENG, XAHENG2, XPSI1, &
+ XLBC, XLBEXC
+USE MODD_TURB_n, ONLY: LSUBG_COND
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_tools, only: Countjv
@@ -113,8 +117,6 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
- ! (single if cold start)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
@@ -134,6 +136,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Cloud water m.r. at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! CCN C. available at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAT ! CCN C. activated at t
!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Precipitation fraction
!
!* 0.1 Declarations of local variables :
!
@@ -144,8 +147,10 @@ INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
!
! Packed micophysical variables
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFT ! available nucleus conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAT ! activated nucleus conc. source
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCT ! cloud mr
+REAL, DIMENSION(:) , ALLOCATABLE :: ZCCT ! cloud conc.
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFT ! available nucleus conc.
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAT ! activated nucleus conc.
!
! Other packed variables
REAL, DIMENSION(:) , ALLOCATABLE :: ZRHODREF ! RHO Dry REFerence
@@ -197,7 +202,6 @@ ZEPS= XMV / XMD
ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-XALPW+XBETAW/PT(:,:,:)+XGAMW*ALOG(PT(:,:,:))) - 1.0)
ZTDT(:,:,:) = 0.
IF (LACTIT .AND. SIZE(PDTHRAD).GT.0) ZTDT(:,:,:) = PDTHRAD(:,:,:) * PEXNREF(:,:,:)
-!IF (LACTIT) ZTDT(:,:,:) = (PT(:,:,:)-PTM(:,:,:))/PTSTEP ! dT/dt
!
! find locations where CCN are available
!
@@ -211,21 +215,22 @@ ENDDO
!
GNUCT(:,:,:) = .FALSE.
!
-! NEW : -22°C = limit sup for condensation freezing in Fridlin et al., 2007
-IF( LACTIT ) THEN
- GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
- ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN .OR. &
- PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ) .AND.&
- PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
- .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
- .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(4)
-ELSE
- GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
- PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ) .AND.&
- PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
- .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
- .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(4)
-END IF
+GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN &
+ .OR. PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
+IF (LACTIT) GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .OR. ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN
+IF (LSUBG_COND) GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .OR. PCLDFR(IIB:IIE,IJB:IJE,IKB:IKE)>0.01
+!
+GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
+ .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(2)
+!
+IF (.NOT. LSUBG_COND) GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .AND. PRVT(IIB:IIE,IJB:IJE,IKB:IKE).GE.ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)
+!
+
+
INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
!
IF( INUCT >= 1 ) THEN
@@ -233,6 +238,8 @@ IF( INUCT >= 1 ) THEN
ALLOCATE(ZNFT(INUCT,NMOD_CCN))
ALLOCATE(ZNAT(INUCT,NMOD_CCN))
ALLOCATE(ZTMP(INUCT,NMOD_CCN))
+ ALLOCATE(ZRCT(INUCT))
+ ALLOCATE(ZCCT(INUCT))
ALLOCATE(ZZT(INUCT))
ALLOCATE(ZZTDT(INUCT))
ALLOCATE(ZSW(INUCT))
@@ -248,6 +255,8 @@ IF( INUCT >= 1 ) THEN
ALLOCATE(ZRHODREF(INUCT))
ALLOCATE(ZEXNREF(INUCT))
DO JL=1,INUCT
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))
ZZT(JL) = PT(I1(JL),I2(JL),I3(JL))
ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
ZZW2(JL) = PW_NU(I1(JL),I2(JL),I3(JL))
@@ -300,6 +309,8 @@ IF( INUCT >= 1 ) THEN
ZZW3(:) = XAHENG( IVEC1(:)+1)*(ZZW4(:)**1.5)* ZVEC1(:) &
- XAHENG( IVEC1(:) )*(ZZW5(:)**1.5)*(ZVEC1(:) - 1.0)
! Cste*((Psi1*w+Psi3*dT/dt)/(G))**1.5
+ ZZW6(:) = XAHENG2( IVEC1(:)+1)*(ZZW4(:)**0.5)* ZVEC1(:) &
+ - XAHENG2( IVEC1(:) )*(ZZW5(:)**0.5)*(ZVEC1(:) - 1.0)
!
!
ELSE ! LACTIT , for clouds
@@ -315,6 +326,9 @@ IF( INUCT >= 1 ) THEN
ZZW2(:)=MAX(ZZW2(:),0.)
ZZW3(:)=XAHENG(IVEC1(:)+1)*((XPSI1(IVEC1(:)+1)*ZZW2(:))**1.5)* ZVEC1(:) &
-XAHENG(IVEC1(:) )*((XPSI1(IVEC1(:) )*ZZW2(:))**1.5)*(ZVEC1(:)-1.0)
+!
+ ZZW6(:)=XAHENG2(IVEC1(:)+1)*((XPSI1(IVEC1(:)+1)*ZZW2(:))**0.5)* ZVEC1(:) &
+ -XAHENG2(IVEC1(:) )*((XPSI1(IVEC1(:) )*ZZW2(:))**0.5)*(ZVEC1(:)-1.0)
!
END IF ! LACTIT
!
@@ -325,12 +339,17 @@ IF( INUCT >= 1 ) THEN
!
ZZW5(:) = 1.
ZZW3(:) = (ZZW3(:)/ZZW1(:))*ZRHODREF(:) ! R.H.S. of Eq 9 of CPB 98 but
- ! for multiple aerosol modes
+ ! for multiple aerosol modes
+ WHERE (ZRCT(:) > XRTMIN(2) .AND. ZCCT(:) > XCTMIN(2))
+ ZZW6(:) = ZZW6(:) * ZRHODREF(:) * ZCCT(:) / (XLBC*ZCCT(:)/ZRCT(:))**XLBEXC
+ ELSEWHERE
+ ZZW6(:)=0.
+ END WHERE
+
WHERE (ZZW3(:) == 0. .AND. .NOT.(ZSW>0.))
ZZW5(:) = -1.
END WHERE
!
-!
!-------------------------------------------------------------------------------
!
!
@@ -345,9 +364,9 @@ IF( INUCT >= 1 ) THEN
! Check with values used for tabulation in ini_lima_warm.f90
ZS1 = 1.0E-5 ! corresponds to 0.001% supersaturation
ZS2 = 5.0E-2 ! corresponds to 5.0% supersaturation
- ZXACC = 1.0E-7 ! Accuracy needed for the search in [NO UNITS]
+ ZXACC = 1.0E-10 ! Accuracy needed for the search in [NO UNITS]
!
- ZSMAX(:) = ZRIDDR(ZS1,ZS2,ZXACC,ZZW3(:),INUCT) ! ZSMAX(:) is in [NO UNITS]
+ ZSMAX(:) = ZRIDDR(ZS1,ZS2,ZXACC,ZZW3(:),ZZW6(:),INUCT) ! ZSMAX(:) is in [NO UNITS]
ZSMAX(:) = MIN(MAX(ZSMAX(:), ZSW(:)),ZS2)
!
!
@@ -394,17 +413,17 @@ IF( INUCT >= 1 ) THEN
ZZW2(:) = 0.
ZZW3(:) = 0.
!
- WHERE( SUM(ZTMP(:,:),DIM=2) .GT. 15.E6/ZRHODREF(:) )
+ WHERE( SUM(ZTMP(:,:),DIM=2) .GT. 0.01E6/ZRHODREF(:) )
ZZW1(:) = MIN( ZNFT(:,JMOD),MAX( ZTMP(:,JMOD)- ZNAT(:,JMOD) , 0.0 ) )
ENDWHERE
!
!* update the concentration of activated CCN = Na
!
- PNAT(:,:,:,JMOD) = PNAT(:,:,:,JMOD) + UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
+ PNAT(:,:,:,JMOD) = PNAT(:,:,:,JMOD) + PCLDFR(:,:,:) * UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
!
!* update the concentration of free CCN = Nf
!
- PNFT(:,:,:,JMOD) = PNFT(:,:,:,JMOD) - UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
+ PNFT(:,:,:,JMOD) = PNFT(:,:,:,JMOD) - PCLDFR(:,:,:) * UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
!
!* prepare to update the cloud water concentration
!
@@ -417,13 +436,18 @@ IF( INUCT >= 1 ) THEN
WHERE (ZZW5(:)>0.0 .AND. ZSMAX(:)>0.0) ! ZZW1 is computed with ZSMAX [NO UNIT]
ZZW1(:) = MIN(XCSTDCRIT*ZZW6(:)/(((ZZT(:)*ZSMAX(:))**3)*ZRHODREF(:)),1.E-5)
END WHERE
- ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVT(:,:,:) )
!
- PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(PT(:,:,:)-XTT))/ &
+ IF (.NOT.LSUBG_COND) THEN
+ ZW(:,:,:) = MIN( UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVT(:,:,:) )
+ PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(PT(:,:,:)-XTT))/ &
(PEXNREF(:,:,:)*(XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
- PRVT(:,:,:) = PRVT(:,:,:) - ZW(:,:,:)
- PRCT(:,:,:) = PRCT(:,:,:) + ZW(:,:,:)
- PCCT(:,:,:) = PCCT(:,:,:) + UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0. )
+ PRVT(:,:,:) = PRVT(:,:,:) - ZW(:,:,:)
+ PRCT(:,:,:) = PRCT(:,:,:) + ZW(:,:,:)
+ PCCT(:,:,:) = PCCT(:,:,:) + UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0. )
+ ELSE
+ ZW(:,:,:) = MIN( PCLDFR(:,:,:) * UNPACK( ZZW1(:),MASK=GNUCT(:,:,:),FIELD=0.0 ),PRVT(:,:,:) )
+ PCCT(:,:,:) = PCCT(:,:,:) + PCLDFR(:,:,:) * UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0. )
+ END IF
!
ZW(:,:,:) = UNPACK( 100.0*ZSMAX(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
ZW2(:,:,:) = UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
@@ -440,6 +464,8 @@ IF( INUCT >= 1 ) THEN
DEALLOCATE(ZVEC1)
DEALLOCATE(ZNFT)
DEALLOCATE(ZNAT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZRCT)
DEALLOCATE(ZZT)
DEALLOCATE(ZSMAX)
DEALLOCATE(ZZW1)
@@ -498,7 +524,7 @@ END IF
CONTAINS
!------------------------------------------------------------------------------
!
- FUNCTION ZRIDDR(PX1,PX2INIT,PXACC,PZZW3,NPTS) RESULT(PZRIDDR)
+ FUNCTION ZRIDDR(PX1,PX2INIT,PXACC,PZZW3,PZZW6,NPTS) RESULT(PZRIDDR)
!
!
!!**** *ZRIDDR* - iterative algorithm to find root of a function
@@ -552,6 +578,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: NPTS
REAL, DIMENSION(:), INTENT(IN) :: PZZW3
+REAL, DIMENSION(:), INTENT(IN) :: PZZW6
REAL, INTENT(IN) :: PX1, PX2INIT, PXACC
REAL, DIMENSION(:), ALLOCATABLE :: PZRIDDR
!
@@ -573,8 +600,8 @@ ALLOCATE(PZRIDDR(NPTS))
!
PZRIDDR(:)= UNUSED
PX2 = PX2INIT
-fl(:) = FUNCSMAX(PX1,PZZW3(:),NPTS)
-fh(:) = FUNCSMAX(PX2,PZZW3(:),NPTS)
+fl(:) = FUNCSMAX(PX1,PZZW3(:),PZZW6(:),NPTS)
+fh(:) = FUNCSMAX(PX2,PZZW3(:),PZZW6(:),NPTS)
!
DO JL = 1, NPTS
PX2 = PX2INIT
@@ -583,7 +610,7 @@ DO JL = 1, NPTS
xh = PX2
do j=1,MAXIT
xm = 0.5*(xl+xh)
- fm(JL) = SINGL_FUNCSMAX(xm,PZZW3(JL),JL)
+ fm(JL) = SINGL_FUNCSMAX(xm,PZZW3(JL),PZZW6(JL),JL)
s = sqrt(fm(JL)**2-fl(JL)*fh(JL))
if (s == 0.0) then
GO TO 101
@@ -593,7 +620,7 @@ DO JL = 1, NPTS
GO TO 101
endif
PZRIDDR(JL) = xnew
- fnew(JL) = SINGL_FUNCSMAX(PZRIDDR(JL),PZZW3(JL),JL)
+ fnew(JL) = SINGL_FUNCSMAX(PZRIDDR(JL),PZZW3(JL),PZZW6(JL),JL)
if (fnew(JL) == 0.0) then
GO TO 101
endif
@@ -611,7 +638,7 @@ DO JL = 1, NPTS
else if (PX2 .lt. 0.05) then
PX2 = PX2 + 1.0E-2
PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
- fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
+ fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),PZZW6(JL),JL)
go to 100
end if
if (abs(xh-xl) <= PXACC) then
@@ -632,7 +659,7 @@ DO JL = 1, NPTS
else if (PX2 .lt. 0.05) then
PX2 = PX2 + 1.0E-2
PRINT*, 'PX2 too small, we put a greater one : PX2 =',PX2
- fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
+ fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),PZZW6(JL),JL)
go to 100
else
!!$ print*, 'PZRIDDR: root must be bracketed'
@@ -655,7 +682,7 @@ END FUNCTION ZRIDDR
!
!------------------------------------------------------------------------------
!
- FUNCTION FUNCSMAX(PPZSMAX,PPZZW3,NPTS) RESULT(PFUNCSMAX)
+ FUNCTION FUNCSMAX(PPZSMAX,PPZZW3,PPZZW6,NPTS) RESULT(PFUNCSMAX)
!
!
!!**** *FUNCSMAX* - function describing SMAX function that you want to find the root
@@ -714,6 +741,7 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: NPTS
REAL, INTENT(IN) :: PPZSMAX ! supersaturation is already in no units
REAL, DIMENSION(:), INTENT(IN) :: PPZZW3 !
+REAL, DIMENSION(:), INTENT(IN) :: PPZZW6 !
REAL, DIMENSION(:), ALLOCATABLE :: PFUNCSMAX !
!
!* 0.2 declarations of local variables
@@ -726,7 +754,7 @@ INTEGER :: PIVEC1
ALLOCATE(PFUNCSMAX(NPTS))
!
PFUNCSMAX(:) = 0.
-PZVEC1 = MAX( 1.0001,MIN( REAL(NHYP)-0.0001, &
+PZVEC1 = MAX( ( 1.0 + 10.0 * XMNH_EPSILON ) ,MIN( REAL(NHYP)*( 1.0 - 10.0 * XMNH_EPSILON ) , &
XHYPINTP1*LOG(PPZSMAX)+XHYPINTP2 ) )
PIVEC1 = INT( PZVEC1 )
PZVEC1 = PZVEC1 - REAL( PIVEC1 )
@@ -741,13 +769,13 @@ DO JMOD = 1, NMOD_CCN
/ GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
ENDDO
! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
-PFUNCSMAX(:) = PFUNCSMAX(:) - PPZZW3(:)
+PFUNCSMAX(:) = PFUNCSMAX(:) + PPZZW6(:)*PPZSMAX - PPZZW3(:)
!
END FUNCTION FUNCSMAX
!
!------------------------------------------------------------------------------
!
- FUNCTION SINGL_FUNCSMAX(PPZSMAX,PPZZW3,KINDEX) RESULT(PSINGL_FUNCSMAX)
+ FUNCTION SINGL_FUNCSMAX(PPZSMAX,PPZZW3,PPZZW6,KINDEX) RESULT(PSINGL_FUNCSMAX)
!
!
!!**** *SINGL_FUNCSMAX* - same function as FUNCSMAX
@@ -772,6 +800,7 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KINDEX
REAL, INTENT(IN) :: PPZSMAX ! supersaturation is "no unit"
REAL, INTENT(IN) :: PPZZW3 !
+REAL, INTENT(IN) :: PPZZW6 !
REAL :: PSINGL_FUNCSMAX !
!
!* 0.2 declarations of local variables
@@ -797,7 +826,7 @@ DO JMOD = 1, NMOD_CCN
/ GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
ENDDO
! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
-PSINGL_FUNCSMAX = PSINGL_FUNCSMAX - PPZZW3
+PSINGL_FUNCSMAX = PSINGL_FUNCSMAX + PPZZW6*PPZSMAX - PPZZW3
!
END FUNCTION SINGL_FUNCSMAX
!
diff --git a/src/MNH/lima_ccn_hom_freezing.f90 b/src/MNH/lima_ccn_hom_freezing.f90
index a716c4da7ee57d02bf637d56a4be01af1c47463d..86b7a9408b864e7d93dde71f280c0ce432bf57a8 100644
--- a/src/MNH/lima_ccn_hom_freezing.f90
+++ b/src/MNH/lima_ccn_hom_freezing.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-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.
@@ -10,7 +10,8 @@
INTERFACE
SUBROUTINE LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT )
+ PCCT, PCRT, PCIT, PNFT, PNHT, &
+ PICEFR )
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -33,6 +34,8 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! Free CCN conc.
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! haze homogeneous freezing
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
+!
END SUBROUTINE LIMA_CCN_HOM_FREEZING
END INTERFACE
END MODULE MODI_LIMA_CCN_HOM_FREEZING
@@ -40,7 +43,8 @@ END MODULE MODI_LIMA_CCN_HOM_FREEZING
! ##########################################################################
SUBROUTINE LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT )
+ PCCT, PCRT, PCIT, PNFT, PNHT , &
+ PICEFR )
! ##########################################################################
!
!! PURPOSE
@@ -106,6 +110,8 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFT ! Free CCN conc.
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! haze homogeneous freezing
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
+!
!* 0.2 Declarations of local variables :
!
REAL, DIMENSION(:), ALLOCATABLE :: ZRVT ! Water vapor m.r. at t
diff --git a/src/MNH/lima_compute_cloud_fractions.f90 b/src/MNH/lima_compute_cloud_fractions.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ce1cedeeef9b7b72c85bd9b4828619ca1fc6a8aa
--- /dev/null
+++ b/src/MNH/lima_compute_cloud_fractions.f90
@@ -0,0 +1,173 @@
+!MNH_LIC Copyright 2019-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.
+!-------------------------------------------------------------------------------
+!#######################################
+MODULE MODI_LIMA_COMPUTE_CLOUD_FRACTIONS
+!#######################################
+ INTERFACE
+ SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
+ PCCT, PRCT, &
+ PCRT, PRRT, &
+ PCIT, PRIT, &
+ PRST, PRGT, PRHT, &
+ PCLDFR, PICEFR, PPRCFR )
+ INTEGER, INTENT(IN) :: KIB !
+ INTEGER, INTENT(IN) :: KIE !
+ INTEGER, INTENT(IN) :: KJB !
+ INTEGER, INTENT(IN) :: KJE !
+ INTEGER, INTENT(IN) :: KKB !
+ INTEGER, INTENT(IN) :: KKE !
+ INTEGER, INTENT(IN) :: KKL !
+ !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PCCT !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRCT !
+ !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PCRT !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRRT !
+ !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PCIT !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRIT !
+ !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRST !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRGT !
+ REAL, DIMENSION(:,:,:),INTENT(IN) :: PRHT !
+ !
+ REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PCLDFR !
+ REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PICEFR !
+ REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PPRCFR !
+ !
+ END SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS
+ END INTERFACE
+END MODULE MODI_LIMA_COMPUTE_CLOUD_FRACTIONS
+!
+!
+!################################################################
+SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS (KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
+ PCCT, PRCT, &
+ PCRT, PRRT, &
+ PCIT, PRIT, &
+ PRST, PRGT, PRHT, &
+ PCLDFR, PICEFR, PPRCFR )
+!################################################################
+!
+!!
+!! PURPOSE
+!! -------
+!! Compute cloud, ice and precipitating fractions
+!!
+!! AUTHOR
+!! ------
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/03/2019
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XCTMIN, XRTMIN
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KIB !
+INTEGER, INTENT(IN) :: KIE !
+INTEGER, INTENT(IN) :: KJB !
+INTEGER, INTENT(IN) :: KJE !
+INTEGER, INTENT(IN) :: KKB !
+INTEGER, INTENT(IN) :: KKE !
+INTEGER, INTENT(IN) :: KKL !
+!
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PCCT !
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRCT !
+!
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PCRT !
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRRT !
+!
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PCIT !
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRIT !
+!
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRST !
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRGT !
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRHT !
+!
+REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PCLDFR !
+REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PICEFR !
+REAL, DIMENSION(:,:,:),INTENT(INOUT) :: PPRCFR !
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER :: JI, JJ, JK
+!
+!-------------------------------------------------------------------------------
+!
+! CLOUD FRACTIONS
+! ---------------
+!
+! Liquid cloud fraction is kept from input data, except where PCLDFR=0 and rc>0
+WHERE(PCLDFR(:,:,:)<1.E-10 .AND. PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2)) PCLDFR(:,:,:)=1.
+!
+! Ice cloud fraction is currently 0 or 1
+PICEFR(:,:,:)=0.
+WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
+! Precipitation fraction
+!!$PPRCFR(:,:,:) = MAX(PCLDFR(:,:,:),PICEFR(:,:,:))
+!!$DO JI = KIB,KIE
+!!$ DO JJ = KJB, KJE
+!!$ DO JK=KKE-KKL, KKB, -KKL
+!!$ IF ( (PRRT(JI,JJ,JK).GT.XRTMIN(3) .AND. PCRT(JI,JJ,JK).GT.XCTMIN(3)) .OR. &
+!!$ PRST(JI,JJ,JK).GT.XRTMIN(5) .OR. &
+!!$ PRGT(JI,JJ,JK).GT.XRTMIN(6) .OR. &
+!!$ PRHT(JI,JJ,JK).GT.XRTMIN(7) ) THEN
+!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+KKL))
+!!$ IF (PPRCFR(JI,JJ,JK)==0) THEN
+!!$ PPRCFR(JI,JJ,JK)=1.
+!!$ END IF
+!!$ ELSE
+!!$ !PPRCFR(JI,JJ,JK)=0.
+!!$ END IF
+!!$ END DO
+!!$ END DO
+!!$END DO
+!!$
+!!$PPRCFR(:,:,:) = MAX(PCLDFR(:,:,:),PICEFR(:,:,:))
+!!$DO JI = KIB,KIE
+!!$ DO JJ = KJB, KJE
+!!$ DO JK=KKE-KKL, KKB, -KKL
+!!$ IF ( (PRRT(JI,JJ,JK).GT.0. .AND. PCRT(JI,JJ,JK).GT.0.) .OR. &
+!!$ PRST(JI,JJ,JK).GT.0. .OR. &
+!!$ PRGT(JI,JJ,JK).GT.0. .OR. &
+!!$ PRHT(JI,JJ,JK).GT.0. ) THEN
+!!$ PPRCFR(JI,JJ,JK)=MAX(PPRCFR(JI,JJ,JK),PPRCFR(JI,JJ,JK+KKL))
+!!$ IF (PPRCFR(JI,JJ,JK)==0) THEN
+!!$ PPRCFR(JI,JJ,JK)=1.
+!!$ END IF
+!!$ ELSE
+!!$ !PPRCFR(JI,JJ,JK)=0.
+!!$ END IF
+!!$ END DO
+!!$ END DO
+!!$END DO
+!!$
+!!$PPRCFR(:,:,:) = 0.
+!!$WHERE ( (PRRT(:,:,:).GT.XRTMIN(3) .AND. PCRT(:,:,:).GT.XCTMIN(3)) .OR. &
+!!$ PRST(:,:,:).GT.XRTMIN(5) .OR. &
+!!$ PRGT(:,:,:).GT.XRTMIN(6) .OR. &
+!!$ PRHT(:,:,:).GT.XRTMIN(7) ) PPRCFR(:,:,:) = 1.
+!!$
+PPRCFR(:,:,:) = 0.
+WHERE ( (PRRT(:,:,:).GT.0. .AND. PCRT(:,:,:).GT.0.) .OR. &
+ PRST(:,:,:).GT.0. .OR. &
+ PRGT(:,:,:).GT.0. .OR. &
+ PRHT(:,:,:).GT.0. ) PPRCFR(:,:,:) = 1.
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE LIMA_COMPUTE_CLOUD_FRACTIONS
diff --git a/src/MNH/lima_conversion_melting_snow.f90 b/src/MNH/lima_conversion_melting_snow.f90
index 3102a165b0f4c0fb03e0e422c1b5b907024363c7..ff5a691461b7a5de36d44febb6c320ce909eee12 100644
--- a/src/MNH/lima_conversion_melting_snow.f90
+++ b/src/MNH/lima_conversion_melting_snow.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
! #################################
MODULE MODI_LIMA_CONVERSION_MELTING_SNOW
! #################################
@@ -10,8 +11,7 @@ INTERFACE
SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, &
PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
PRVT, PRST, PLBDS, &
- P_RS_CMEL, &
- PA_RS, PA_RG )
+ P_RS_CMEL )
!
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
!
@@ -26,10 +26,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PRVT !
REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_CMEL
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_CMEL
!
END SUBROUTINE LIMA_CONVERSION_MELTING_SNOW
END INTERFACE
@@ -39,8 +36,7 @@ END MODULE MODI_LIMA_CONVERSION_MELTING_SNOW
SUBROUTINE LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, &
PRHODREF, PPRES, PT, PKA, PDV, PCJ, &
PRVT, PRST, PLBDS, &
- P_RS_CMEL, &
- PA_RS, PA_RG )
+ P_RS_CMEL )
! ##############################################################################
!
!! PURPOSE
@@ -86,10 +82,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PRVT !
REAL, DIMENSION(:), INTENT(IN) :: PRST ! Cloud water C. at t
REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_CMEL
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_CMEL
!
!* 0.2 Declarations of local variables :
!
@@ -122,8 +115,6 @@ WHERE( (PRST(:)>XRTMIN(5)) .AND. (PT(:)>XTT) .AND. LDCOMPUTE(:) )
!
END WHERE
!
-PA_RS(:) = PA_RS(:) + P_RS_CMEL(:)
-PA_RG(:) = PA_RG(:) - P_RS_CMEL(:)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/lima_droplets_accretion.f90 b/src/MNH/lima_droplets_accretion.f90
index 6344246004384d4e0acc4bebef3f83fd9e6b5b50..8996b5425b8282ae43f1676dd6b09e55661b8787 100644
--- a/src/MNH/lima_droplets_accretion.f90
+++ b/src/MNH/lima_droplets_accretion.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
! #################################
MODULE MODI_LIMA_DROPLETS_ACCRETION
! #################################
@@ -11,8 +12,7 @@ INTERFACE
PRHODREF, &
PRCT, PRRT, PCCT, PCRT, &
PLBDC, PLBDC3, PLBDR, PLBDR3, &
- P_RC_ACCR, P_CC_ACCR, &
- PA_RC, PA_CC, PA_RR )
+ P_RC_ACCR, P_CC_ACCR )
!
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
!
@@ -27,12 +27,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_ACCR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_ACCR
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_ACCR
!
END SUBROUTINE LIMA_DROPLETS_ACCRETION
END INTERFACE
@@ -43,8 +39,7 @@ END MODULE MODI_LIMA_DROPLETS_ACCRETION
PRHODREF, &
PRCT, PRRT, PCCT, PCRT, &
PLBDC, PLBDC3, PLBDR, PLBDR3, &
- P_RC_ACCR, P_CC_ACCR, &
- PA_RC, PA_CC, PA_RR )
+ P_RC_ACCR, P_CC_ACCR )
! #####################################################################
!
!! PURPOSE
@@ -91,12 +86,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_ACCR
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_ACCR
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_ACCR
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_ACCR
!
!* 0.2 Declarations of local variables :
!
@@ -162,9 +153,6 @@ WHERE( GACCR(:).AND.(ZW4(:)<=1.E-4) )
P_RC_ACCR(:) = - ZW2(:)
END WHERE
!
-PA_RC(:) = PA_RC(:) + P_RC_ACCR(:)
-PA_CC(:) = PA_CC(:) + P_CC_ACCR(:)
-PA_RR(:) = PA_RR(:) - P_RC_ACCR(:)
!
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_droplets_autoconversion.f90 b/src/MNH/lima_droplets_autoconversion.f90
index f88eb265d4d599ecdbb43cf0035fef6923c2212e..044030f792dd2b64affa03bd8407470d8486691b 100644
--- a/src/MNH/lima_droplets_autoconversion.f90
+++ b/src/MNH/lima_droplets_autoconversion.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
! #################################
MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION
! #################################
@@ -9,26 +10,21 @@
INTERFACE
SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, &
PRHODREF, &
- PRCT, PLBDC, PLBDR, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO,&
- PA_RC, PA_CC, PA_RR, PA_CR )
+ PRCT, PCCT, PLBDC, PLBDR, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
!
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
!
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
!
REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_AUTO
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_AUTO
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_AUTO
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_AUTO
!
END SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION
END INTERFACE
@@ -37,9 +33,8 @@ END MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION
! ##########################################################################
SUBROUTINE LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, &
PRHODREF, &
- PRCT, PLBDC, PLBDR, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO,&
- PA_RC, PA_CC, PA_RR, PA_CR )
+ PRCT, PCCT, PLBDC, PLBDR, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
! ##########################################################################
!
!! PURPOSE
@@ -63,7 +58,7 @@ END MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAM_LIMA, ONLY : XRTMIN
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN
USE MODD_PARAM_LIMA_WARM, ONLY : XLAUTR, XAUTO1, XLAUTR_THRESHOLD, &
XITAUTR, XAUTO2, XITAUTR_THRESHOLD, &
XACCR4, XACCR5, XACCR3, XACCR1, XAC
@@ -77,17 +72,13 @@ LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
!
REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water conc. at t
REAL, DIMENSION(:), INTENT(IN) :: PLBDC !
REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_AUTO
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_AUTO
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_AUTO
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_AUTO
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_AUTO
!
!* 0.2 Declarations of local variables :
!
@@ -109,7 +100,7 @@ P_CR_AUTO(:) = 0.0
ZW3(:) = 0.0
ZW2(:) = 0.0
ZW1(:) = 0.0
-WHERE( PRCT(:)>XRTMIN(2) .AND. PLBDC(:)>0. .AND. LDCOMPUTE(:) )
+WHERE( PRCT(:)>XRTMIN(2) .AND. PCCT(:)>XCTMIN(2) .AND. PLBDC(:)>0. .AND. LDCOMPUTE(:) )
ZW2(:) = MAX( 0.0, &
XLAUTR*PRHODREF(:)*PRCT(:)*(XAUTO1/min(PLBDC(:),1.e9)**4-XLAUTR_THRESHOLD) ) ! L
!
@@ -128,10 +119,6 @@ WHERE( PRCT(:)>XRTMIN(2) .AND. PLBDC(:)>0. .AND. LDCOMPUTE(:) )
P_CC_AUTO(:) = -ZW3(:)
P_CR_AUTO(:) = ZW3(:)
!
- PA_RC(:) = PA_RC(:) + P_RC_AUTO(:)
- PA_CC(:) = PA_CC(:) + P_CC_AUTO(:)
- PA_RR(:) = PA_RR(:) - P_RC_AUTO(:)
- PA_CR(:) = PA_CR(:) + P_CR_AUTO(:)
END WHERE
!
!
diff --git a/src/MNH/lima_droplets_riming_snow.f90 b/src/MNH/lima_droplets_riming_snow.f90
index b255295a432345a39639e258f5436bb2ffbe7a9e..6bef29df3bfac250078b40d9c8f45d2d00cc4dfa 100644
--- a/src/MNH/lima_droplets_riming_snow.f90
+++ b/src/MNH/lima_droplets_riming_snow.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2018-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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.
+!-------------------------------------------------------------------------------
! #################################
MODULE MODI_LIMA_DROPLETS_RIMING_SNOW
! #################################
@@ -11,8 +12,7 @@ INTERFACE
PRHODREF, PT, &
PRCT, PCCT, PRST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- PA_TH, PA_RC, PA_CC, PA_RI, PA_CI, PA_RS, PA_RG )
+ P_RI_HMS, P_CI_HMS, P_RS_HMS )
!
REAL, INTENT(IN) :: PTSTEP
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
@@ -28,23 +28,15 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_HMS
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_RIM
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_HMS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_HMS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_HMS
!
END SUBROUTINE LIMA_DROPLETS_RIMING_SNOW
END INTERFACE
@@ -55,8 +47,7 @@ END MODULE MODI_LIMA_DROPLETS_RIMING_SNOW
PRHODREF, PT, &
PRCT, PCCT, PRST, PLBDC, PLBDS, PLVFACT, PLSFACT, &
P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- PA_TH, PA_RC, PA_CC, PA_RI, PA_CI, PA_RS, PA_RG )
+ P_RI_HMS, P_CI_HMS, P_RS_HMS )
! #########################################################################################
!
!! PURPOSE
@@ -106,23 +97,15 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_RIM
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_RIM
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_HMS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_HMS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RC_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_RIM
!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_RIM
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_HMS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_HMS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_HMS
!
!* 0.2 Declarations of local variables :
!
@@ -237,13 +220,6 @@ WHERE ( GRIM )
END WHERE
!
!
-PA_RC(:) = PA_RC(:) + P_RC_RIM(:)
-PA_CC(:) = PA_CC(:) + P_CC_RIM(:)
-PA_RI(:) = PA_RI(:) + P_RI_HMS(:)
-PA_CI(:) = PA_CI(:) + P_CI_HMS(:)
-PA_RS(:) = PA_RS(:) + P_RS_RIM(:) + P_RS_HMS(:)
-PA_RG(:) = PA_RG(:) + P_RG_RIM(:)
-PA_TH(:) = PA_TH(:) + P_TH_RIM(:)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/lima_droplets_self_collection.f90 b/src/MNH/lima_droplets_self_collection.f90
index c97e0cc55b1f66a8b2e30fe659810042dba5e7da..79312e8cb058055804d58a2d48c53f10a04deb65 100644
--- a/src/MNH/lima_droplets_self_collection.f90
+++ b/src/MNH/lima_droplets_self_collection.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
! #################################
MODULE MODI_LIMA_DROPLETS_SELF_COLLECTION
! #################################
@@ -10,8 +11,7 @@ INTERFACE
SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
PRHODREF, &
PCCT, PLBDC3, &
- P_CC_SELF, &
- PA_CC )
+ P_CC_SELF )
!
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
!
@@ -20,9 +20,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_SELF
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_SELF
!
END SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION
END INTERFACE
@@ -32,8 +30,7 @@ END MODULE MODI_LIMA_DROPLETS_SELF_COLLECTION
SUBROUTINE LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
PRHODREF, &
PCCT, PLBDC3, &
- P_CC_SELF, &
- PA_CC )
+ P_CC_SELF )
! ######################################################################
!
!! PURPOSE
@@ -71,9 +68,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference Exner function
REAL, DIMENSION(:), INTENT(IN) :: PCCT ! Cloud water C. at t
REAL, DIMENSION(:), INTENT(IN) :: PLBDC3 !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CC_SELF
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CC
+REAL, DIMENSION(:), INTENT(OUT) :: P_CC_SELF
!
!* 0.2 Declarations of local variables :
!
@@ -91,7 +86,6 @@ P_CC_SELF(:)=0.
WHERE( PCCT(:)>XCTMIN(2) .AND. LDCOMPUTE(:) )
ZW(:) = XSELFC*(PCCT(:)/PLBDC3(:))**2 * PRHODREF(:) ! analytical integration
P_CC_SELF(:) = - ZW(:)
- PA_CC(:) = PA_CC(:) + P_CC_SELF(:)
END WHERE
!
!
diff --git a/src/MNH/lima_drops_self_collection.f90 b/src/MNH/lima_drops_self_collection.f90
index c5bdc6f91fe832689ffd23e4a7712ac76a2398c1..042cde0842bf74116c47e156ce7d85ed03d5522a 100644
--- a/src/MNH/lima_drops_self_collection.f90
+++ b/src/MNH/lima_drops_self_collection.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
! #################################
MODULE MODI_LIMA_DROPS_SELF_COLLECTION
! #################################
@@ -10,8 +11,7 @@ INTERFACE
SUBROUTINE LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, &
PRHODREF, &
PCRT, PLBDR, PLBDR3, &
- P_CR_SCBU, &
- PA_CR )
+ P_CR_SCBU )
!
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
!
@@ -21,9 +21,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Cloud water C. at t
REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_SCBU
!
END SUBROUTINE LIMA_DROPS_SELF_COLLECTION
END INTERFACE
@@ -33,8 +31,7 @@ END MODULE MODI_LIMA_DROPS_SELF_COLLECTION
SUBROUTINE LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, &
PRHODREF, &
PCRT, PLBDR, PLBDR3, &
- P_CR_SCBU, &
- PA_CR )
+ P_CR_SCBU )
! #############################################################
!
!! PURPOSE
@@ -74,9 +71,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PCRT ! Rain drops C. at t
REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
REAL, DIMENSION(:), INTENT(IN) :: PLBDR3 !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_SCBU
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_SCBU
!
!* 0.2 Declarations of local variables :
!
@@ -122,8 +117,6 @@ END WHERE
!
P_CR_SCBU(:) = - ZW3(:) * PRHODREF(:)
!
-PA_CR(:) = PA_CR(:) + P_CR_SCBU(:)
-!
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/lima_graupel_deposition.f90 b/src/MNH/lima_graupel_deposition.f90
index 4c042364de5b785987f468d9c3bb5a92d7981a5a..d283c9699bd1efbb3615b74716c3d50a6a29333f 100644
--- a/src/MNH/lima_graupel_deposition.f90
+++ b/src/MNH/lima_graupel_deposition.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
! #################################
MODULE MODI_LIMA_GRAUPEL_DEPOSITION
! #################################
@@ -9,8 +10,7 @@
INTERFACE
SUBROUTINE LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, &
PRGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
- P_TH_DEPG, P_RG_DEPG, &
- PA_TH, PA_RV, PA_RG )
+ P_TH_DEPG, P_RG_DEPG )
!
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF !
@@ -22,12 +22,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PAI !
REAL, DIMENSION(:), INTENT(IN) :: PCJ !
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPG
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_DEPG
!!
END SUBROUTINE LIMA_GRAUPEL_DEPOSITION
END INTERFACE
@@ -36,8 +32,7 @@ END MODULE MODI_LIMA_GRAUPEL_DEPOSITION
! ###########################################################################
SUBROUTINE LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, &
PRGT, PSSI, PLBDG, PAI, PCJ, PLSFACT, &
- P_TH_DEPG, P_RG_DEPG, &
- PA_TH, PA_RV, PA_RG )
+ P_TH_DEPG, P_RG_DEPG )
! ###########################################################################
!
!! PURPOSE
@@ -78,12 +73,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PAI !
REAL, DIMENSION(:), INTENT(IN) :: PCJ !
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPG
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_DEPG
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPG
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_DEPG
!
!
!-------------------------------------------------------------------------------
@@ -100,10 +91,6 @@ WHERE ( (PRGT(:)>XRTMIN(6)) .AND. LDCOMPUTE(:) )
P_TH_DEPG(:) = P_RG_DEPG(:)*PLSFACT(:)
END WHERE
!
-PA_RV(:) = PA_RV(:) - P_RG_DEPG(:)
-PA_RG(:) = PA_RG(:) + P_RG_DEPG(:)
-PA_TH(:) = PA_TH(:) + P_TH_DEPG(:)
-!
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/lima_ice_aggregation_snow.f90 b/src/MNH/lima_ice_aggregation_snow.f90
index 09ebc41dca2aab029d52c586d4efb67476b8ee9f..15e01ec84b33a508d8b30285ea944540185b1015 100644
--- a/src/MNH/lima_ice_aggregation_snow.f90
+++ b/src/MNH/lima_ice_aggregation_snow.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
! #################################
MODULE MODI_LIMA_ICE_AGGREGATION_SNOW
! #################################
@@ -10,8 +11,7 @@ INTERFACE
SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
PT, PRHODREF, &
PRIT, PRST, PCIT, PLBDI, PLBDS, &
- P_RI_AGGS, P_CI_AGGS, &
- PA_RI, PA_CI, PA_RS )
+ P_RI_AGGS, P_CI_AGGS )
!
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
!
@@ -24,12 +24,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PCIT
REAL, DIMENSION(:), INTENT(IN) :: PLBDI
REAL, DIMENSION(:), INTENT(IN) :: PLBDS
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_AGGS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_AGGS
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_AGGS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_AGGS
!
END SUBROUTINE LIMA_ICE_AGGREGATION_SNOW
END INTERFACE
@@ -39,8 +35,7 @@ END MODULE MODI_LIMA_ICE_AGGREGATION_SNOW
SUBROUTINE LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
PT, PRHODREF, &
PRIT, PRST, PCIT, PLBDI, PLBDS, &
- P_RI_AGGS, P_CI_AGGS, &
- PA_RI, PA_CI, PA_RS )
+ P_RI_AGGS, P_CI_AGGS )
! #######################################################################
!
!! PURPOSE
@@ -83,12 +78,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PCIT
REAL, DIMENSION(:), INTENT(IN) :: PLBDI
REAL, DIMENSION(:), INTENT(IN) :: PLBDS
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_AGGS
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_AGGS
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_AGGS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_AGGS
!
!* 0.2 Declarations of local variables :
!
@@ -123,10 +114,6 @@ WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PRST(:)>XRTMIN(5)) .AND. LDCOMPUTE(:) )
END WHERE
!
!
-PA_RI(:) = PA_RI(:) + P_RI_AGGS(:)
-PA_CI(:) = PA_CI(:) + P_CI_AGGS(:)
-PA_RS(:) = PA_RS(:) - P_RI_AGGS(:)
-!
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_ICE_AGGREGATION_SNOW
diff --git a/src/MNH/lima_ice_deposition.f90 b/src/MNH/lima_ice_deposition.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8c7c57e4091305b31d8906cec050cd18427f63cb
--- /dev/null
+++ b/src/MNH/lima_ice_deposition.f90
@@ -0,0 +1,175 @@
+!MNH_LIC Copyright 2018-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.
+!-------------------------------------------------------------------------------
+! #####################
+ MODULE MODI_LIMA_ICE_DEPOSITION
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRIT, PCIT, PLBDI, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS )
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPI
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_DEPI
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVS
+!
+END SUBROUTINE LIMA_ICE_DEPOSITION
+END INTERFACE
+END MODULE MODI_LIMA_ICE_DEPOSITION
+!
+! ##########################################################################
+SUBROUTINE LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRIT, PCIT, PLBDI, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS )
+! ##########################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! for slow cold processes :
+!! - conversion of snow to ice
+!! - deposition of vapor on snow
+!! - conversion of ice to snow (Harrington 1995)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS
+USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, &
+ XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
+ XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
+ XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
+ XDICNVS_LIM, XLBDAICNVS_LIM, &
+ XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
+ XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
+ XAGGS_RLARGE1, XAGGS_RLARGE2, &
+ XDI, X0DEPI, X2DEPI
+
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, INTENT(IN) :: PTSTEP
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCIT ! Ice crystal C. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDI ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPI
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_DEPI
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVS
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVS
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMICRO ! Computations only where necessary
+REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZX ! Work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+P_TH_DEPI(:) = 0.
+P_RI_DEPI(:) = 0.
+P_RI_CNVS(:) = 0.
+P_CI_CNVS(:) = 0.
+!
+! Physical limitations
+!
+!
+! Looking for regions where computations are necessary
+!
+GMICRO(:) = LDCOMPUTE(:) .AND. PRIT(:)>XRTMIN(4)
+!
+!
+WHERE( GMICRO )
+!
+!
+!* 2.2 Deposition of water vapor on r_i: RVDEPI
+! -----------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ WHERE ( (PRIT(:)>XRTMIN(4)) .AND. (PCIT(:)>XCTMIN(4)) )
+ ZZW(:) = ( PSSI(:) / PAI(:) ) * PCIT(:) * &
+ ( X0DEPI/PLBDI(:)+X2DEPI*PCJ(:)*PCJ(:)/PLBDI(:)**(XDI+2.0) )
+ END WHERE
+!
+ P_RI_DEPI(:) = ZZW(:)
+!!$ P_TH_DEPI(:) = P_RI_DEPI(:) * PLSFACT(:)
+!
+!!$ PA_TH(:) = PA_TH(:) + P_TH_DEPI(:)
+!!$ PA_RV(:) = PA_RV(:) - P_RI_DEPI(:)
+!!$ PA_RI(:) = PA_RI(:) + P_RI_DEPI(:)
+!
+!
+!* 2.3 Conversion of pristine ice to r_s: RICNVS
+! ------------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ ZZW2(:) = 0.0
+ WHERE ( (PLBDI(:)<XLBDAICNVS_LIM) .AND. (PCIT(:)>XCTMIN(4)) &
+ .AND. (PSSI(:)>0.0) )
+ ZZW(:) = (PLBDI(:)*XDICNVS_LIM)**(XALPHAI)
+ ZZX(:) = ( PSSI(:)/PAI(:) )*PCIT(:) * (ZZW(:)**XNUI) *EXP(-ZZW(:))
+!
+ ZZW(:) = ( XR0DEPIS + XR1DEPIS*PCJ(:) )*ZZX(:)
+!
+ ZZW2(:) = ZZW(:) * (XC0DEPIS+XC1DEPIS*PCJ(:)) / (XR0DEPIS+XR1DEPIS*PCJ(:))
+ END WHERE
+!
+P_RI_CNVS(:) = - ZZW(:)
+P_CI_CNVS(:) = - ZZW2(:)
+!
+!
+END WHERE
+!
+!
+END SUBROUTINE LIMA_ICE_DEPOSITION
diff --git a/src/MNH/lima_init_ccn_activation_spectrum.f90 b/src/MNH/lima_init_ccn_activation_spectrum.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d5c513c56d7318479d9fd844a3c5320fbf9c86c5
--- /dev/null
+++ b/src/MNH/lima_init_ccn_activation_spectrum.f90
@@ -0,0 +1,458 @@
+!MNH_LIC Copyright 2007-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.
+!-------------------------------------------------------------------------------
+! ####################
+ MODULE MODI_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+INTERFACE
+ SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE,XD,XSIGMA,XLIMIT_FACTOR,XK,XMU,XBETA,XKAPPA)
+ !
+ CHARACTER(LEN=*), INTENT(IN) :: CTYPE ! Aerosol type
+ REAL, INTENT(IN) :: XD ! Aerosol PSD modal diameter
+ REAL, INTENT(IN) :: XSIGMA ! Aerosol PSD width
+ REAL, INTENT(OUT) :: XLIMIT_FACTOR ! C/Naer
+ REAL, INTENT(OUT) :: XK ! k
+ REAL, INTENT(OUT) :: XMU ! mu
+ REAL, INTENT(OUT) :: XBETA ! beta
+ REAL, INTENT(OUT) :: XKAPPA ! kappa
+!
+ END SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+END INTERFACE
+END MODULE MODI_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
+! ####################
+!
+! #############################################################
+ SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM (CTYPE,XD,XSIGMA,XLIMIT_FACTOR,XK,XMU,XBETA,XKAPPA)
+! #############################################################
+
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!! Compute mu, k and beta parameters of the activation spectrum based on CCN
+!! characteristics (type and PSD)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original ??/??/13
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XMV, XAVOGADRO, XBOLTZ, XRHOLW
+!
+USE MODI_GAMMA_INC
+USE MODI_HYPGEO
+USE MODI_HYPSER
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+CHARACTER(LEN=*), INTENT(IN) :: CTYPE ! Aerosol type
+REAL, INTENT(IN) :: XD ! Aerosol PSD modal diameter
+REAL, INTENT(IN) :: XSIGMA ! Aerosol PSD width
+REAL, INTENT(OUT) :: XLIMIT_FACTOR ! C/Naer
+REAL, INTENT(OUT) :: XK ! k
+REAL, INTENT(OUT) :: XMU ! mu
+REAL, INTENT(OUT) :: XBETA ! beta
+REAL, INTENT(OUT) :: XKAPPA ! kappa
+!
+!* 0.2 Declarations of local variables :
+!
+INTEGER, PARAMETER :: M = 1000 ! Number of points (S,Nccn) used to fit the spectra
+INTEGER, PARAMETER :: N = 3 ! Number of parameters to adjust
+REAL, DIMENSION(N) :: PARAMS ! Parameters to adjust by the LM algorithm (k, mu, beta)
+REAL, DIMENSION(M) :: FVEC ! Array to store the distance between theoretical and fitted spectra
+INTEGER :: IFLAG !
+INTEGER :: INFO !
+REAL :: TOL = 1.E-16 ! Fit precision required
+!
+INTEGER :: II, IJ ! Loop indices
+!
+REAL :: XW !
+REAL :: XDDRY = 0.1E-6 ! Dry diameter for which to compute Scrit
+REAL :: XSCRIT ! Scrit for dry diameter XDDRY
+REAL :: XMIN = 0.1E-6 ! minimum diameter for root search (m)
+REAL :: XMAX = 10.E-6 ! maximum diameter for root search (m)
+REAL :: XPREC = 1.E-8 ! precision wanted for root (m)
+!
+!REAL :: XKAPPA ! kappa coefficient
+REAL, DIMENSION(M) :: XS ! saturation ratio (S=1.01 for a 1% supersaturation)
+REAL, DIMENSION(M) :: XDCRIT ! critical diameters (m) for the chosen S values
+REAL, DIMENSION(M) :: XNCCN ! fraction of the aerosols larger than XDCRIT (ie activable)
+REAL, DIMENSION(1) :: XT ! temperature
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Select kappa value based on CTYPE
+! ---------------------------------
+!
+! Kappa values are from Petters and Kreidenweis (2007), table 1.
+!
+SELECT CASE (CTYPE)
+CASE('NH42SO4','C') ! Ammonium sulfate
+ XKAPPA = 0.61
+CASE('NH4NO3') ! Ammonium nitrate
+ XKAPPA = 0.67
+CASE('NaCl','M') ! Sea Salt
+ XKAPPA = 1.28
+CASE('H2SO4') ! Sulfuric acid
+ XKAPPA = 0.90
+CASE('NaNO3') ! Sodium nitrate
+ XKAPPA = 0.88
+CASE('NaHSO4') ! Sodium bisulfate
+ XKAPPA = 0.91
+CASE('Na2SO4') ! Sodium sulfate
+ XKAPPA = 0.80
+CASE('NH43HSO42') ! Letovicite (rare ammonium sulfate mineral)
+ XKAPPA = 0.65
+CASE('SOA') ! Secondary organic aerosol (alpha-pinene, beta-pinene)
+ XKAPPA = 0.1
+CASE DEFAULT
+ XKAPPA = 1.
+END SELECT
+!
+!XT = (/ 270., 271., 272., 273., 274., 275., 276., 277., 278., 279., 280., 281., 282., 283., 284., 285., 286., 287., 288., 289. /)
+XT = (/ 280. /)
+
+!
+! Initialize supersaturation values (in %)
+!
+DO II=1, SIZE(XS)
+ XS(II)=EXP( LOG(10.**(-3.)) + REAL(II) / REAL(SIZE(XS)) * (LOG(10.**2.)-LOG(10.**(-3.))) )
+END DO
+
+DO IJ=1, SIZE(XT)
+!
+!* 2. Compute Nccn(s) for several supersaturation values
+! --------------------------------------------------
+!
+! Get the value of Scrit at Ddry=0.1 micron
+!
+ XDDRY = XD
+ XMIN = XD
+ XMAX = XD*10.
+ XPREC = XD/100.
+ XW = 4 * 0.072 * XMV / XAVOGADRO / XBOLTZ / XT(IJ) / XRHOLW
+ XSCRIT = ZRIDDR(XMIN,XMAX,XPREC,XDDRY,XKAPPA,XT(IJ)) ! wet diameter at Scrit
+ XSCRIT = (XSCRIT**3-XDDRY**3) * EXP(XW/XSCRIT) / (XSCRIT**3-(1-XKAPPA)*XDDRY**3) ! Saturation ratio at Scrit
+ XSCRIT = (XSCRIT - 1.) * 100. ! Scrit (in %)
+!
+! Get the XDCRIT values for XS using the approx.
+! ln(100*(Sw))~Dcrit^(-3/2) where Sw is in % (Sw=1 for a 1% supersaturation)
+!
+ XW = XDDRY * XSCRIT**0.66 ! "a" factor in Ddry_crit = a*S**-0.66
+ XDCRIT(:) = XW * XS(:)**(-0.66) ! Ddry_crit for each value of S
+!
+! Compute Nccn(S) as the incomplete integral of n(D) from 0 to Ddry_crit(S)
+!
+ DO II=1, SIZE(XS)
+ XNCCN(II) = 1- ( 0.5 + SIGN(0.5,XDCRIT(II)-XD) * GAMMA_INC(0.5,(LOG(XDCRIT(II)/XD)/SQRT(2.)/LOG(XSIGMA))**2) )
+ END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Compute C, k, mu, beta, using the Levenberg-Marquardt algorithm
+! ---------------------------------------------------------------
+!
+ PARAMS(1:3) = (/ 1., 1., 1000. /)
+ IFLAG = 1
+ call lmdif1 ( DISTANCE, M, N, PARAMS, FVEC, TOL, INFO )
+!
+ XLIMIT_FACTOR = gamma(PARAMS(2))*PARAMS(3)**(PARAMS(1)/2)/gamma(1+PARAMS(1)/2)/gamma(PARAMS(2)-PARAMS(1)/2)
+ XK = PARAMS(1)
+ XMU = PARAMS(2)
+ XBETA = PARAMS(3)
+!
+END DO ! loop on temperatures
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. Functions used to compute Scrit at Ddry=0.1 micron
+! --------------------------------------------------
+!
+CONTAINS
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION ZRIDDR(PX1,PX2,PXACC,XDDRY,XKAPPA,XT) RESULT(PZRIDDR)
+!
+!
+!!**** *ZRIDDR* - iterative algorithm to find root of a function
+!!
+!!
+!! PURPOSE
+!! -------
+!! The purpose of this function is to find the root of a given function
+!! the arguments are the brackets bounds (the interval where to find the root)
+!! the accuracy needed and the input parameters of the given function.
+!! Using Ridders' method, return the root of a function known to lie between
+!! PX1 and PX2. The root, returned as PZRIDDR, will be refined to an approximate
+!! accuracy PXACC.
+!!
+!!** METHOD
+!! ------
+!! Ridders' method
+!!
+!! EXTERNAL
+!! --------
+!! FUNCSMAX
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! NUMERICAL RECIPES IN FORTRAN 77: THE ART OF SCIENTIFIC COMPUTING
+!! (ISBN 0-521-43064-X)
+!! Copyright (C) 1986-1992 by Cambridge University Press.
+!! Programs Copyright (C) 1986-1992 by Numerical Recipes Software.
+!!
+!! AUTHOR
+!! ------
+!! Frederick Chosson *CERFACS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/07/07
+!! S.BERTHET 2008 vectorization
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+REAL, INTENT(INOUT) :: PX1, PX2, PXACC
+REAL, INTENT(IN) :: XDDRY, XKAPPA, XT
+REAL :: PZRIDDR
+!
+!* 0.2 declarations of local variables
+!
+!
+INTEGER, PARAMETER :: MAXIT=60
+REAL, PARAMETER :: UNUSED=0.0 !-1.11e30
+REAL :: fh,fl, fm,fnew
+REAL :: s,xh,xl,xm,xnew
+INTEGER :: j, JL
+!
+PZRIDDR= 999999.
+fl = DSDD(PX1,XDDRY,XKAPPA,XT)
+fh = DSDD(PX2,XDDRY,XKAPPA,XT)
+!
+100 if ((fl > 0.0 .and. fh < 0.0) .or. (fl < 0.0 .and. fh > 0.0)) then
+ xl = PX1
+ xh = PX2
+ do j=1,MAXIT
+ xm = 0.5*(xl+xh)
+ fm = DSDD(xm,XDDRY,XKAPPA,XT)
+ s = sqrt(fm**2-fl*fh)
+ if (s == 0.0) then
+ GO TO 101
+ endif
+ xnew = xm+(xm-xl)*(sign(1.0,fl-fh)*fm/s)
+ if (abs(xnew - PZRIDDR) <= PXACC) then
+ GO TO 101
+ endif
+ PZRIDDR = xnew
+ fnew = DSDD(PZRIDDR,XDDRY,XKAPPA,XT)
+ if (fnew == 0.0) then
+ GO TO 101
+ endif
+ if (sign(fm,fnew) /= fm) then
+ xl =xm
+ fl=fm
+ xh =PZRIDDR
+ fh=fnew
+ else if (sign(fl,fnew) /= fl) then
+ xh =PZRIDDR
+ fh=fnew
+ else if (sign(fh,fnew) /= fh) then
+ xl =PZRIDDR
+ fl=fnew
+ else if (PX2 .lt. 0.05) then
+ PX2 = PX2 + 1.0E-2
+ PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
+ fh = DSDD(PX2,XDDRY,XKAPPA,XT)
+ go to 100
+ STOP
+ end if
+ if (abs(xh-xl) <= PXACC) then
+ GO TO 101
+ endif
+ end do
+ STOP
+ else if (fl == 0.0) then
+ PZRIDDR=PX1
+ else if (fh == 0.0) then
+ PZRIDDR=PX2
+ else if (PX2 .lt. 0.05) then
+ PX2 = PX2 + 1.0E-2
+ PRINT*, 'PX2 too small, we put a greater one : PX2 =',PX2
+ fh = DSDD(PX2,XDDRY,XKAPPA,XT)
+ go to 100
+ else
+ PZRIDDR=0.0
+ go to 101
+ end if
+!
+101 END FUNCTION ZRIDDR
+!
+!------------------------------------------------------------------------------
+!
+ FUNCTION DSDD(XD,XDDRY,XKAPPA, XT) RESULT(DS)
+!!
+!! PURPOSE
+!! -------
+!! Derivative of S(D) from Petters and Kreidenweis 2007 (eq. 6) to get Dcrit and Scrit
+!!
+!!** METHOD
+!! ------
+!! This function is called by zriddr
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Petters and Kreidenweis, 2007: "A single parameter representation of hygroscopic
+!! growth and cloud condensation nucleus activity",
+!! ACP, 7, 1961-1971
+!!
+!! AUTHOR
+!! ------
+!! Benoit Vie *CNRM*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/11/17
+!!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODD_CST, ONLY : XMV, XAVOGADRO, XBOLTZ, XRHOLW
+!
+ IMPLICIT NONE
+!
+!* 0.1 declarations of arguments and result
+!
+ REAL, INTENT(IN) :: XD ! supersaturation is already in no units
+ REAL, INTENT(IN) :: XDDRY ! supersaturation is already in no units
+ REAL, INTENT(IN) :: XKAPPA ! supersaturation is already in no units
+ REAL, INTENT(IN) :: XT ! supersaturation is already in no units
+!
+ REAL :: DS ! result
+!
+!* 0.2 declarations of local variables
+!
+ REAL :: XA ! factor inside the exponential
+!
+ XA = 4 * 0.072 * XMV / XAVOGADRO / XBOLTZ / XT / XRHOLW
+ DS = (XD**3-XDDRY**3) * (XD**3-(1-XKAPPA)*XDDRY**3) * XA - 3. * XKAPPA * XD**4 * XDDRY**3
+ DS = DS * EXP(XA/XD) / (XD**3-(1-XKAPPA)*XDDRY**3)**2
+!
+END FUNCTION DSDD
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. Functions used to fit the CCN activation spectra with C s**k F()
+! ----------------------------------------------------------------
+!
+ SUBROUTINE DISTANCE(M,N,X,FVEC,IFLAG)
+!!
+!! PURPOSE
+!! -------
+!! Derivative of S(D) from Petters and Kreidenweis 2007 (eq. 6) to get Dcrit and Scrit
+!!
+!!** METHOD
+!! ------
+!! This function is called by zriddr
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Petters and Kreidenweis, 2007: "A single parameter representation of hygroscopic
+!! growth and cloud condensation nucleus activity",
+!! ACP, 7, 1961-1971
+!!
+!! AUTHOR
+!! ------
+!! Benoit Vie *CNRM*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/11/17
+!!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+!* 0.1 declarations of arguments and result
+!
+ integer M
+ integer N
+ real X(N)
+ real FVEC(M)
+ integer IFLAG
+!
+!* 0.2 declarations of local variables
+!
+ integer I
+ real C
+ real ZW, ZW2
+!
+ ! print *, "X = ", X
+ IF ( ANY(X .LT.0.) .OR. X(1).gt.2*X(2)) THEN
+ FVEC(:) = 999999.
+ ELSE
+ C=gamma(X(2))*X(3)**(X(1)/2)/gamma(1+X(1)/2)/gamma(X(2)-X(1)/2)
+ DO I=1, M
+ ! XS in "no units", ie XS=0.01 for a 1% suersaturation
+ ! ZW= C * (XS(I)/100)**X(1) * HYPGEO(X(2),X(1)/2,X(1)/2+1,X(3),XS(I)/100)
+ ZW= C * (XS(I))**X(1) * HYPGEO(X(2),X(1)/2,X(1)/2+1,X(3),XS(I))
+!!$ IF (X(3)*(XS(I)/100)**2 .LT. 0.98) THEN
+!!$ CALL HYPSER(X(2),X(1)/2,X(1)/2+1,-X(3)*(XS(I)/100)**2,ZW2)
+!!$ print *, "args= ", X(2), X(1)/2, X(1)/2+1, -X(3)*(XS(I)/100)**2, " hypser = ", ZW2
+!!$ CALL HYPSER(27.288,0.82/2,0.82/2+1,-38726*(0.5/100)**2,ZW2)
+!!$ print *, "args= ", 27.288, 0.82/2, 0.82/2+1, -38726*(0.5/100)**2, " hypser = ", ZW2
+!!$ END IF
+ ! print *, I, XS(I), C, ZW, XNCCN(I)
+ IF ( ZW.GT.0. .AND. XNCCN(I).GT.0.) THEN
+ FVEC(I) = LOG(ZW) - LOG(XNCCN(I))
+ ELSE
+ FVEC(I) = 0.
+ END IF
+ !FVEC(I) = LOG(MAX(ZW,1.E-24)) - LOG(MAX(XNCCN(I),1.E-24))
+ !FVEC(I) = ZW - XNCCN(I)
+ END DO
+ END IF
+! print *, "distance : ", SUM(FVEC*FVEC)
+!
+ END SUBROUTINE DISTANCE
+!
+!------------------------------------------------------------------------------
+END SUBROUTINE LIMA_INIT_CCN_ACTIVATION_SPECTRUM
diff --git a/src/MNH/lima_inst_procs.f90 b/src/MNH/lima_inst_procs.f90
index ff8dc1f04df51daa9018d3cf8a1778ce4bde2294..ce7a127815611c7cd97b37c3c2d51c91665fb0e1 100644
--- a/src/MNH/lima_inst_procs.f90
+++ b/src/MNH/lima_inst_procs.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
! ###############################
MODULE MODI_LIMA_INST_PROCS
! ###############################
@@ -17,7 +18,8 @@ INTERFACE
P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
PB_CC, PB_CR, PB_CI, &
- PB_IFNN )
+ PB_IFNN, &
+ PCF1D, PIF1D, PPF1D )
!
REAL, INTENT(IN) :: PTSTEP ! Time step
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
@@ -59,6 +61,10 @@ REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CR ! Cumulated concentration chan
REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CI ! Cumulated concentration change (#/kg)
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN ! Cumulated concentration change (#/kg)
+!
+REAL, DIMENSION(:) , INTENT(INOUT) :: PCF1D ! Liquid cloud fraction
+REAL, DIMENSION(:) , INTENT(INOUT) :: PIF1D ! Ice cloud fraction
+REAL, DIMENSION(:) , INTENT(INOUT) :: PPF1D ! Precipitation fraction
!
END SUBROUTINE LIMA_INST_PROCS
END INTERFACE
@@ -76,7 +82,8 @@ SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE,
P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, & ! ice melting (IMLT) : rc, Nc, ri=-rc, Ni=-Nc, th, IFNF, IFNA
PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RG, &
PB_CC, PB_CR, PB_CI, &
- PB_IFNN )
+ PB_IFNN, &
+ PCF1D, PIF1D, PPF1D )
! ###########################################################################
!
!! PURPOSE
@@ -146,10 +153,14 @@ REAL, DIMENSION(:) , INTENT(INOUT) :: PB_CI ! Cumulated concentration chan
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PB_IFNN ! Cumulated concentration change (#/kg)
!
+REAL, DIMENSION(:) , INTENT(INOUT) :: PCF1D ! Liquid cloud fraction
+REAL, DIMENSION(:) , INTENT(INOUT) :: PIF1D ! Ice cloud fraction
+REAL, DIMENSION(:) , INTENT(INOUT) :: PPF1D ! Precipitation fraction
+!
!-------------------------------------------------------------------------------
!
IF (LWARM .AND. LRAIN) THEN
- CALL LIMA_DROPS_BREAK_UP (LDCOMPUTE, &
+ CALL LIMA_DROPS_BREAK_UP (LDCOMPUTE, & ! no dependance on CF, IF or PF
PCRT, PRRT, &
P_CR_BRKU, &
PB_CR )
@@ -158,7 +169,7 @@ END IF
!-------------------------------------------------------------------------------
!
IF (LCOLD .AND. LWARM .AND. LRAIN) THEN
- CALL LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
+ CALL LIMA_DROPS_HOM_FREEZING (PTSTEP, LDCOMPUTE, & ! no dependance on CF, IF or PF
PEXNREF, PPABST, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCRT, &
@@ -169,12 +180,16 @@ END IF
!-------------------------------------------------------------------------------
!
IF (LCOLD .AND. LWARM) THEN
- CALL LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, &
- PEXNREF, PPABST, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ CALL LIMA_ICE_MELTING (PTSTEP, LDCOMPUTE, & ! no dependance on CF, IF or PF
+ PEXNREF, PPABST, & ! but ice fraction becomes cloud fraction
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, & ! -> where ?
PCIT, PINT, &
P_TH_IMLT, P_RC_IMLT, P_CC_IMLT, &
PB_TH, PB_RC, PB_CC, PB_RI, PB_CI, PB_IFNN)
+ !
+ !PCF1D(:)=MAX(PCF1D(:),PIF1D(:))
+ !PIF1D(:)=0.
+ !
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_meyers_nucleation.f90 b/src/MNH/lima_meyers_nucleation.f90
index 7798bd5d4d90d8cd81615ce516de228d55143ecb..f0c38fd6ad95ec88b8b3517646347640ce7f9091 100644
--- a/src/MNH/lima_meyers_nucleation.f90
+++ b/src/MNH/lima_meyers_nucleation.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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.
@@ -13,7 +13,8 @@ INTERFACE
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PINT, &
P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC )
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
!
REAL, INTENT(IN) :: PTSTEP
!
@@ -40,6 +41,8 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
+!
END SUBROUTINE LIMA_MEYERS_NUCLEATION
END INTERFACE
END MODULE MODI_LIMA_MEYERS_NUCLEATION
@@ -50,7 +53,8 @@ END MODULE MODI_LIMA_MEYERS_NUCLEATION
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PINT, &
P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC )
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
! #############################################################################
!!
!! PURPOSE
@@ -113,6 +117,8 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
+!
!
!* 0.2 Declarations of local variables :
!
diff --git a/src/MNH/lima_mixrat_to_nconc.f90 b/src/MNH/lima_mixrat_to_nconc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f21a1afe23918e0aaf509bdb44721646b7d1a812
--- /dev/null
+++ b/src/MNH/lima_mixrat_to_nconc.f90
@@ -0,0 +1,192 @@
+!MNH_LIC Copyright 2016-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.
+!-----------------------------------------------------------------
+! ################################
+ MODULE MODI_LIMA_MIXRAT_TO_NCONC
+! ################################
+INTERFACE
+SUBROUTINE LIMA_MIXRAT_TO_NCONC(PPABST, PTHT, PRVT, PSVT)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Potential temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water Vapor mix. ratio
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Mixing ratios IN, conc. OUT
+!
+END SUBROUTINE LIMA_MIXRAT_TO_NCONC
+END INTERFACE
+END MODULE MODI_LIMA_MIXRAT_TO_NCONC
+!
+! ########################################################
+ SUBROUTINE LIMA_MIXRAT_TO_NCONC(PPABST, PTHT, PRVT, PSVT)
+! ########################################################
+!
+!
+!!**** *LIMA_MIXRAT_TO_NCONC* - converts CAMS aerosol mixing ratios into
+!! number concentrations
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 23/01/16 (J.-P. Pinty)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_CST, ONLY : XP00, XMD, XMV, XRD, XCPD, XTT, XPI, XRHOLW, &
+ XALPW, XBETAW, XGAMW, XALPI, XBETAI, XGAMI
+USE MODD_NSV, ONLY : NSV_LIMA_CCN_FREE, NSV_LIMA_IFN_FREE
+USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, &
+ XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
+ XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, &
+ NSPECIE, XFRAC, &
+ CCCN_MODES, CIFN_SPECIES
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Potential temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water Vapor mix. ratio
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Mixing ratios IN, conc. OUT
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZT ! Temperature
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZREHU ! Relat. Humid.
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZGROWTH_FACT
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZRHO_CCN_WET
+REAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZWORK
+!
+INTEGER :: JLOC, JCCN, JIFN, JSPECIE
+REAL :: ZFACT_CCN, ZFACT_IFN
+!
+!----------------------------------------------------------------------
+!
+! Temperature to compute the relative humidity
+!
+ZT(:,:,:) = PTHT(:,:,:)*(PPABST(:,:,:)/XP00)**(XRD/XCPD)
+ZWORK(:,:,:) = PRVT(:,:,:)*PPABST(:,:,:)/((XMV/XMD)+PRVT(:,:,:))
+ ! water vapor partial pressure
+ZREHU(:,:,:) = ZWORK(:,:,:)/EXP( XALPW-XBETAW/ZT(:,:,:)-XGAMW*ALOG(ZT(:,:,:)) )
+ ! saturation over water
+WHERE ( ZT(:,:,:)<XTT )
+ ZREHU(:,:,:) = ZWORK(:,:,:)/EXP(XALPI-XBETAI/ZT(:,:,:)-XGAMI*ALOG(ZT(:,:,:)))
+ ! saturation over ice
+END WHERE
+ZREHU(:,:,:) = MIN( 0.99, MAX( 0.01,ZREHU(:,:,:) ) )
+!
+! All size distribution parameters are XLOGSIG_CCN and XR_MEAN_CCN (radii)
+! Treatment of the soluble aerosols (CCN)
+!
+! All CAMS aerosol mr are given for dry particles, except for sea-salt (given at Hu=80%)
+!
+!
+
+!IF( NAERO_TYPE=="CCN" ) THEN
+!
+! sea-salt, sulfate, hydrophilic (GADS data)
+!
+! NMOD_CCN=3
+ IF (.NOT.(ALLOCATED(XR_MEAN_CCN))) ALLOCATE(XR_MEAN_CCN(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XLOGSIG_CCN))) ALLOCATE(XLOGSIG_CCN(NMOD_CCN))
+ IF (.NOT.(ALLOCATED(XRHO_CCN))) ALLOCATE(XRHO_CCN(NMOD_CCN))
+ IF( CCCN_MODES=='CAMS_ACC') THEN
+ XR_MEAN_CCN(:) = (/ 0.2E-6 , 0.5E-6 , 0.4E-6 /)
+ XLOGSIG_CCN(:) = (/ 0.693 , 0.476 , 0.788 /)
+ XRHO_CCN(:) = (/ 2200. , 1700. , 1800. /)
+ END IF
+!
+ IF( CCCN_MODES=='CAMS_AIT') THEN
+ XR_MEAN_CCN(:) = (/ 0.2E-6 , 0.05E-6 , 0.02E-6 /)
+ XLOGSIG_CCN(:) = (/ 0.693 , 0.693 , 0.788 /)
+ XRHO_CCN(:) = (/ 2200. , 1700. , 1800. /)
+ END IF
+!
+DO JCCN = 1,NMOD_CCN
+!
+ JLOC = NSV_LIMA_CCN_FREE + JCCN-1 ! CCN free then CCN acti
+!
+ ZFACT_CCN = ( (0.75/XPI)*EXP(-4.5*(XLOGSIG_CCN(JCCN))**2) )/XR_MEAN_CCN(JCCN)**3
+!
+! JCCN=1 is for Sea Salt
+! JCCN=2 is for Sulphate
+! JCCN=3 is for Hydrophilic OC and BC (sulphate coating)
+!
+ IF( JCCN==1 ) THEN ! Sea salt : convert mass at Hu=80% to dry mass
+ PSVT(:,:,:,JLOC) = PSVT(:,:,:,JLOC) / 4.302
+ END IF
+!
+! compute the CCN number concentration
+!
+! Pourquoi 0.5* ?
+! PSVT(:,:,:,JLOC) =0.5* ZFACT_CCN*(PSVT(:,:,:,JLOC)/XRHO_CCN(JCCN)) ! Result
+ PSVT(:,:,:,JLOC) = ZFACT_CCN*(PSVT(:,:,:,JLOC)/XRHO_CCN(JCCN)) ! Result
+ ! is in #/Kg of dry air
+END DO
+!
+! All size distribution parameters are XSIGMA_IFN and XMDIAM_IFN (diameters)
+! Treatment of the insoluble aerosols (IFN)
+!
+!ELSE IF( NAERO_TYPE=="IFN" ) THEN
+!
+! dust, hydrophobic BIO+ORGA (GADS data)
+!
+! NMOD_IFN=2
+ NSPECIE=4
+ IF (.NOT.(ALLOCATED(XMDIAM_IFN))) ALLOCATE(XMDIAM_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XSIGMA_IFN))) ALLOCATE(XSIGMA_IFN(NSPECIE))
+ IF (.NOT.(ALLOCATED(XRHO_IFN))) ALLOCATE(XRHO_IFN(NSPECIE))
+ IF( CIFN_SPECIES=='CAMS_ACC') THEN
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.04E-6, 0.8E-6 /)
+ XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
+ XRHO_IFN = (/2600., 2600., 1000., 2000. /)
+ END IF
+ IF( CIFN_SPECIES=='CAMS_AIT') THEN
+ XMDIAM_IFN = (/0.8E-6, 3.0E-6, 0.04E-6, 0.04E-6/)
+ XSIGMA_IFN = (/2.0, 2.15, 2.0, 2.2 /)
+ XRHO_IFN = (/2600., 2600., 1000., 1800./)
+ END IF
+ IF (.NOT.(ALLOCATED(XFRAC))) ALLOCATE(XFRAC(NSPECIE,NMOD_IFN))
+ XFRAC(1,1)=1.0
+ XFRAC(2,1)=0.0
+ XFRAC(3,1)=0.0
+ XFRAC(4,1)=0.0
+ XFRAC(1,2)=0.0
+ XFRAC(2,2)=0.0
+ XFRAC(3,2)=0.0
+ XFRAC(4,2)=1.0
+!
+DO JIFN = 1,NMOD_IFN
+!
+! compute the number concentration assuming no deposition of water
+! IFN are considered as insoluble dry aerosols
+!
+ ZFACT_IFN = 0.0
+ DO JSPECIE = 1,NSPECIE ! Conversion factor is weighted by XFRAC
+ ZFACT_IFN = ZFACT_IFN + XFRAC(JSPECIE,JIFN)* &
+ ( (6/XPI)*EXP(-(9.0/2.0)*LOG(XSIGMA_IFN(JSPECIE))**2) ) / &
+ ( XRHO_IFN(JSPECIE)*XMDIAM_IFN(JSPECIE)**3 )
+ END DO
+ JLOC = NSV_LIMA_IFN_FREE + JIFN-1 ! IFN free then IFN nucl
+! Pourquoi 0.5* ?
+! PSVT(:,:,:,JLOC) = 0.5* ZFACT_IFN*PSVT(:,:,:,JLOC) ! Result is in #/Kg of dry air
+ PSVT(:,:,:,JLOC) = ZFACT_IFN*PSVT(:,:,:,JLOC) ! Result is in #/Kg of dry air
+END DO
+!
+END SUBROUTINE LIMA_MIXRAT_TO_NCONC
diff --git a/src/MNH/lima_notadjust.f90 b/src/MNH/lima_notadjust.f90
new file mode 100644
index 0000000000000000000000000000000000000000..94ea1f4fdac0f3df7143f867cdd9e28740f8a5b6
--- /dev/null
+++ b/src/MNH/lima_notadjust.f90
@@ -0,0 +1,624 @@
+!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.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_LIMA_NOTADJUST
+! ##########################
+!
+INTERFACE
+!
+ SUBROUTINE LIMA_NOTADJUST(KMI, TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PEXNREF, PZZ, &
+ PTHT,PRT, PSVT, PTHS, PRS,PSVS, PCLDFR, PSRCS )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Reference density
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+!
+!
+END SUBROUTINE LIMA_NOTADJUST
+!
+END INTERFACE
+!
+END MODULE MODI_LIMA_NOTADJUST
+!
+! ####################################################################################
+ SUBROUTINE LIMA_NOTADJUST(KMI, TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PEXNREF, PZZ, &
+ PTHT,PRT, PSVT, PTHS, PRS,PSVS, PCLDFR, PSRCS )
+! ####################################################################################
+!
+!!**** * - compute pseudo-prognostic of supersaturation according to Thouron
+! et al. 2012
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Thouron, O., J.-L. Brenguier, and F. Burnet, Supersaturation calculation
+!! in large eddy simulation models for prediction of the droplet number
+!! concentration, Geosci. Model Dev., 5, 761-772, 2012.
+!!
+!! AUTHOR
+!! ------
+!! B.Vie forked from lima_adjust.f90
+!!
+!! MODIFICATIONS
+!! -------------
+!
+!* 0. DECLARATIONS
+!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
+USE MODD_CST
+USE MODD_FIELD, ONLY: TFIELDDATA,TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_COLD
+
+!
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+use mode_tools, only: Countjv
+use mode_tools_ll, only: GET_INDICE_ll
+!
+USE MODI_PROGNOS_LIMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+INTEGER, INTENT(IN) :: KMI ! Model index
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
+CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
+REAL, INTENT(IN) :: PTSTEP ! Double Time step
+ ! (single if cold start)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! Absolute Pressure at t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Reference density
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations source
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux
+ ! s'rc'/2Sigma_s2 at time t+1
+ ! multiplied by Lambda_3
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
+!
+!
+!* 0.2 Declarations of local variables :
+!
+!
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILUOUT ! Logical unit of output listing
+
+! For Activation :
+LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
+ :: GNUCT, GMICRO ! Test where to compute the HEN process
+INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL, JMOD ! and PACK intrinsics
+REAL, DIMENSION(:), ALLOCATABLE ::ZPRES,ZRHOD,ZRR,ZTT,ZRV,ZRC,ZS0,ZCCL, &
+ ZZDZ, ZZLV, ZZCPH, &
+ ZRVT, ZRIT, ZCIT, ZRVS, ZRIS, ZCIS, &
+ ZTHS, ZRHODREF, ZZT, ZEXNREF, ZZW, &
+ ZLSFACT, ZRVSATI, ZRVSATI_PRIME, &
+ ZDELTI, ZAI, ZKA, ZDV, ZITI, ZAII, ZDEP, &
+ ZCJ
+!
+INTEGER :: INUCT
+INTEGER :: IMICRO
+INTEGER :: IIB ! Define the domain where
+INTEGER :: IIE ! the microphysical sources have to be computed
+INTEGER :: IJB !
+INTEGER :: IJE !
+INTEGER :: IKB !
+INTEGER :: IKE !
+
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) ::&
+ ZEXNT,ZEXNS,ZT,ZRVSAT,ZWORK,ZLV,ZLS,ZCPH, ZW1, &
+ ZDZ, ZW
+REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) ::&
+ ZSAT,ZCCS
+INTEGER :: JK ! For loop
+integer :: idx
+TYPE(TFIELDDATA) :: TZFIELD
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZNFS ! CCN C. available source
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZNAS ! Cloud C. nuclei C. source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZNFS ! CCN C. available source
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZZNAS ! Cloud C. nuclei C. source
+REAL :: ZEPS
+
+!-------------------------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+ILUOUT = TLUOUT%NLU
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB=1+JPVEXT
+IKE=SIZE(PZZ,3) - JPVEXT
+!
+!-------------------------------------------------------------------------------
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CEDS', prs(:, :, :, 1) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CEDS', prs(:, :, :, 2) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CEDS', prs(:, :, :, 4) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', psvs(:, :, :, nsv_lima_nc) * prhodj(:, :, :) )
+ do jl = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ idx = NBUDGET_SV1 - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ do jl = nsv_lima_ccn_acti, nsv_lima_ccn_acti + nmod_ccn - 1
+ idx = NBUDGET_SV1 - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+! if ( lscav .and. laero_mass ) &
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', psvs(:, :, :, nsv_lima_scavmass) &
+! * prhodj(:, :, :) )
+! if ( lcold ) then
+! call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', psvs(:, :, :, nsv_lima_ni) * prhodj(:, :, :) )
+! do jl = 1, nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nsv_lima_ifn_nucl, nsv_lima_ifn_nucl + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nsv_lima_imm_nucl, nsv_lima_imm_nucl + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_init( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! end if
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_spro), 'CEDS', psvs(:, :, :, nsv_lima_spro) * prhodj(:, :, :) )
+ end if
+end if
+!
+!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
+! -------------------------------------------------------
+!
+!* 2.1 remove negative non-precipitating negative water
+! ------------------------------------------------
+!
+IF (ANY(PRS(:,:,:,2) < 0. .OR. PSVS(:,:,:,NSV_LIMA_NC) < 0.)) THEN
+ WRITE(ILUOUT,*) 'LIMA_NOTADJUST beginning: negative values of PRCS or PCCS'
+ WRITE(ILUOUT,*) ' location of minimum of PRCS:', MINLOC(PRS(:,:,:,2))
+ WRITE(ILUOUT,*) ' value of minimum :', MINVAL(PRS(:,:,:,2))
+ WRITE(ILUOUT,*) ' location of minimum of PCCS:', MINLOC(PSVS(:,:,:,NSV_LIMA_NC))
+ WRITE(ILUOUT,*) ' value of minimum :', MINVAL(PSVS(:,:,:,NSV_LIMA_NC))
+END IF
+!
+IF (ANY(PRS(:,:,:,2)+PRS(:,:,:,1) < 0.) .AND. NVERB>5) THEN
+ WRITE(ILUOUT,*) 'LIMA_NOT_ADJUST: negative values of total water (reset to zero)'
+ WRITE(ILUOUT,*) ' location of minimum:', MINLOC(PRS(:,:,:,2)+PRS(:,:,:,1))
+ WRITE(ILUOUT,*) ' value of minimum :', MINVAL(PRS(:,:,:,2)+PRS(:,:,:,1))
+!callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','LIMA_NOTADJUST','')
+END IF
+!
+!
+!* 2.2 estimate the Exner function at t+1 and t respectively
+!
+ZEXNS(:,:,:)=((2.* PPABST(:,:,:)-PPABSM(:,:,:))/XP00 )**(XRD/XCPD)
+ZEXNT(:,:,:)=(PPABST(:,:,:)/XP00 )**(XRD/XCPD)
+!sources terms *dt
+PRS(:,:,:,:) = PRS(:,:,:,:) * PTSTEP
+PSVS(:,:,:,:) = PSVS(:,:,:,:) * PTSTEP
+ZSAT(:,:,:) = PSVS(:,:,:,NSV_LIMA_SPRO)-1.0
+ZCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
+IF ( NMOD_CCN .GE. 1 ) THEN
+ ALLOCATE( ZNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ALLOCATE( ZNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),NMOD_CCN) )
+ ZNFS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)
+ ZNAS(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)
+ELSE
+ ALLOCATE( ZNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ALLOCATE( ZNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
+ ZNFS(:,:,:,:) = 0.
+ ZNAS(:,:,:,:) = 0.
+END IF
+ZW(:,:,:)=SUM(ZNAS,4)
+!
+!state temperature at t+dt
+PTHS(:,:,:) = PTHS(:,:,:) * PTSTEP * ZEXNS(:,:,:)
+
+!state temperature at t
+ZT(:,:,:)=PTHT(:,:,:)*ZEXNT(:,:,:)
+!Lv and Cph at t
+ZLV(:,:,:) = XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT)
+ZLS(:,:,:) = XLSTT + ( XCPV - XCI ) * ( ZT(:,:,:) -XTT )
+ZCPH(:,:,:)= XCPD+XCPV*PRT(:,:,:,1)+XCL*(PRT(:,:,:,2)+PRT(:,:,:,3)) &
+ +XCI*(PRT(:,:,:,4)+PRT(:,:,:,5)+PRT(:,:,:,6))
+!dz
+DO JK=1,IKE
+ ZDZ(:,:,JK)=PZZ(:,:,JK+1)-PZZ(:,:,JK)
+END DO
+!
+!* 2.3 compute the latent heat of vaporization Lv(T*) at t+1
+!
+!Removed negligible values
+!
+WHERE ( ((PRS(:,:,:,2).LT.XRTMIN(2)) .AND. (ZSAT(:,:,:).LT.0.0)) .OR. &
+ ((PRS(:,:,:,2).GT.0.0) .AND. (ZCCS(:,:,:).LE.0.0)) )
+ PTHS(:,:,:) = PTHS(:,:,:)-(ZLV(:,:,:)/ZCPH(:,:,:))*PRS(:,:,:,2)
+ PRS(:,:,:,1) = PRS(:,:,:,1)+PRS(:,:,:,2)
+ PRS(:,:,:,2) = 0.0
+!ZSAT(:,:,:) = 0.0
+ ZCCS(:,:,:) = 0.0
+!ZNFS(:,:,:,1:NMOD_CCN) = ZNFS(:,:,:,1:NMOD_CCN) + ZNAS(:,:,:,1:NMOD_CCN)
+!ZNAS(:,:,:,1:NMOD_CCN) = 0.
+END WHERE
+!
+
+
+!
+! Ice deposition/sublimation
+!
+ZEPS= XMV / XMD
+GMICRO(:,:,:)=.FALSE.
+GMICRO(IIB:IIE,IJB:IJE,IKB:IKE) = (PRS(IIB:IIE,IJB:IJE,IKB:IKE,4)>XRTMIN(4)/PTSTEP .AND. &
+ PSVS(IIB:IIE,IJB:IJE,IKB:IKE,NSV_LIMA_NI)>XCTMIN(4)/PTSTEP )
+IMICRO = COUNTJV( GMICRO(:,:,:),I1(:),I2(:),I3(:))
+IF( IMICRO >= 1 .AND. .NOT.LPTSPLIT) THEN
+ ALLOCATE(ZRVT(IMICRO))
+ ALLOCATE(ZRIT(IMICRO))
+ ALLOCATE(ZCIT(IMICRO))
+!
+ ALLOCATE(ZRVS(IMICRO))
+ ALLOCATE(ZRIS(IMICRO))
+ ALLOCATE(ZCIS(IMICRO)) !!!BVIE!!!
+ ALLOCATE(ZTHS(IMICRO))
+!
+ ALLOCATE(ZRHODREF(IMICRO))
+ ALLOCATE(ZZT(IMICRO))
+ ALLOCATE(ZPRES(IMICRO))
+ ALLOCATE(ZEXNREF(IMICRO))
+ ALLOCATE(ZZCPH(IMICRO))
+ DO JL=1,IMICRO
+ ZRVT(JL) = PRT(I1(JL),I2(JL),I3(JL),1)
+ ZRIT(JL) = PRT(I1(JL),I2(JL),I3(JL),4)
+ ZCIT(JL) = PSVT(I1(JL),I2(JL),I3(JL),NSV_LIMA_NI)
+!
+ ZRVS(JL) = PRS(I1(JL),I2(JL),I3(JL),1)
+ ZRIS(JL) = PRS(I1(JL),I2(JL),I3(JL),4)
+ ZCIS(JL) = PSVS(I1(JL),I2(JL),I3(JL),NSV_LIMA_NI) !!!BVIE!!!
+ ZTHS(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+!
+ ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZPRES(JL) = 2.0*PPABST(I1(JL),I2(JL),I3(JL))-PPABSM(I1(JL),I2(JL),I3(JL))
+ ZEXNREF(JL) = PEXNREF(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL) = ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ ALLOCATE(ZZW(IMICRO))
+ ALLOCATE(ZLSFACT(IMICRO))
+ ZLSFACT(:) = (XLSTT+(XCPV-XCI)*(ZZT(:)-XTT))/ZZCPH(:) ! L_s/C_ph
+ ALLOCATE(ZRVSATI(IMICRO))
+ ALLOCATE(ZRVSATI_PRIME(IMICRO))
+ ALLOCATE(ZDELTI(IMICRO))
+ ALLOCATE(ZAI(IMICRO))
+ ALLOCATE(ZCJ(IMICRO))
+ ALLOCATE(ZKA(IMICRO))
+ ALLOCATE(ZDV(IMICRO))
+ ALLOCATE(ZITI(IMICRO))
+!
+ ZKA(:) = 2.38E-2 + 0.0071E-2 * ( ZZT(:) - XTT ) ! k_a
+ ZDV(:) = 0.211E-4 * (ZZT(:)/XTT)**1.94 * (XP00/ZPRES(:)) ! D_v
+ ZCJ(:) = XSCFAC * ZRHODREF(:)**0.3 / SQRT( 1.718E-5+0.0049E-5*(ZZT(:)-XTT) )
+!
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ ZRVSATI_PRIME(:) = (( XBETAI/ZZT(:) - XGAMI ) / ZZT(:)) & ! r'_si
+ * ZRVSATI(:) * ( 1. + ZRVSATI(:)/ZEPS )
+!
+ ZDELTI(:) = ZRVS(:)*PTSTEP - ZRVSATI(:)
+ ZAI(:) = ( XLSTT + (XCPV-XCI)*(ZZT(:)-XTT) )**2 / (ZKA(:)*XRV*ZZT(:)**2) &
+ + ( XRV*ZZT(:) ) / (ZDV(:)*ZZW(:))
+ ZZW(:) = MIN(1.E8,( XLBI* MAX(ZCIT(:),XCTMIN(4)) &
+ /(MAX(ZRIT(:),XRTMIN(4))) )**XLBEXI)
+ ! Lbda_I
+ ZITI(:) = ZCIT(:) * (X0DEPI/ZZW(:) + X2DEPI*ZCJ(:)*ZCJ(:)/ZZW(:)**(XDI+2.0)) &
+ / (ZRVSATI(:)*ZAI(:))
+!
+ ALLOCATE(ZAII(IMICRO))
+ ALLOCATE(ZDEP(IMICRO))
+!
+ ZAII(:) = 1.0 + ZRVSATI_PRIME(:)*ZLSFACT(:)
+ ZDEP(:) = 0.0
+!
+ ZZW(:) = ZAII(:)*ZITI(:)*PTSTEP ! R*delta_T
+ WHERE( ZZW(:)<1.0E-2 )
+ ZDEP(:) = ZITI(:)*ZDELTI(:)*(1.0 - (ZZW(:)/2.0)*(1.0-ZZW(:)/3.0))
+ ELSEWHERE
+ ZDEP(:) = ZITI(:)*ZDELTI(:)*(1.0 - EXP(-ZZW(:)))/ZZW(:)
+ END WHERE
+!
+! Integration
+!
+ WHERE( ZDEP(:) < 0.0 )
+ ZDEP(:) = MAX ( ZDEP(:), -ZRIS(:) )
+ ELSEWHERE
+ ZDEP(:) = MIN ( ZDEP(:), ZRVS(:) )
+! ZDEP(:) = MIN ( ZDEP(:), ZCIS(:)*5.E-10 ) !!!BVIE!!!
+ END WHERE
+ WHERE( ZRIS(:) < XRTMIN(4)/PTSTEP )
+ ZDEP(:) = 0.0
+ END WHERE
+ ZRVS(:) = ZRVS(:) - ZDEP(:)
+ ZRIS(:) = ZRIS(:) + ZDEP(:)
+ ZTHS(:) = ZTHS(:) + ZDEP(:) * ZLSFACT(:) / ZEXNREF(:)
+!
+! Implicit ice crystal sublimation if ice saturated conditions are not met
+!
+ ZZT(:) = ( ZTHS(:) * PTSTEP ) * ( ZPRES(:) / XP00 ) ** (XRD/XCPD)
+ ZZW(:) = EXP( XALPI - XBETAI/ZZT(:) - XGAMI*ALOG(ZZT(:) ) ) ! es_i
+ ZRVSATI(:) = ZEPS*ZZW(:) / ( ZPRES(:)-ZZW(:) ) ! r_si
+ WHERE( ZRVS(:)*PTSTEP<ZRVSATI(:) )
+ ZZW(:) = ZRVS(:) + ZRIS(:)
+ ZRVS(:) = MIN( ZZW(:),ZRVSATI(:)/PTSTEP )
+ ZTHS(:) = ZTHS(:) + ( MAX( 0.0,ZZW(:)-ZRVS(:) )-ZRIS(:) ) &
+ * ZLSFACT(:) / ZEXNREF(:)
+ ZRIS(:) = MAX( 0.0,ZZW(:)-ZRVS(:) )
+ END WHERE
+!
+!
+ ZW(:,:,:) = PRS(:,:,:,1)
+ PRS(:,:,:,1) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PRS(:,:,:,4)
+ PRS(:,:,:,4) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ ZW(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+!
+ DEALLOCATE(ZRVT)
+ DEALLOCATE(ZRIT)
+ DEALLOCATE(ZCIT)
+ DEALLOCATE(ZRVS)
+ DEALLOCATE(ZRIS)
+ DEALLOCATE(ZCIS) !!!BVIE!!!
+ DEALLOCATE(ZTHS)
+ DEALLOCATE(ZRHODREF)
+ DEALLOCATE(ZZT)
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZEXNREF)
+ DEALLOCATE(ZZCPH)
+ DEALLOCATE(ZZW)
+ DEALLOCATE(ZLSFACT)
+ DEALLOCATE(ZRVSATI)
+ DEALLOCATE(ZRVSATI_PRIME)
+ DEALLOCATE(ZDELTI)
+ DEALLOCATE(ZAI)
+ DEALLOCATE(ZCJ)
+ DEALLOCATE(ZKA)
+ DEALLOCATE(ZDV)
+ DEALLOCATE(ZITI)
+ DEALLOCATE(ZAII)
+ DEALLOCATE(ZDEP)
+END IF ! IMICRO
+!
+!selection of mesh where condensation/evaportion/activation is performed
+GNUCT(:,:,:) = .FALSE.
+!GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = ZSAT(IIB:IIE,IJB:IJE,IKB:IKE)>0.0 .OR. &
+! ZCCS(IIB:IIE,IJB:IJE,IKB:IKE)>0.0
+!GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = ZSAT(IIB:IIE,IJB:IJE,IKB:IKE)>0.0
+GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = ZSAT(IIB:IIE,IJB:IJE,IKB:IKE)>0.0 .OR. &
+! ZCCS(IIB:IIE,IJB:IJE,IKB:IKE)>1.E+05
+ ZCCS(IIB:IIE,IJB:IJE,IKB:IKE)>XCTMIN(2)
+INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
+!3D array to 1D array
+!
+IF( INUCT >= 1 ) THEN
+ ALLOCATE(ZZNFS(INUCT,NMOD_CCN))
+ ALLOCATE(ZZNAS(INUCT,NMOD_CCN))
+ ALLOCATE(ZPRES(INUCT))
+ ALLOCATE(ZRHOD(INUCT))
+ ALLOCATE(ZRR(INUCT))
+ ALLOCATE(ZTT(INUCT))
+ ALLOCATE(ZRV(INUCT))
+ ALLOCATE(ZRC(INUCT))
+ ALLOCATE(ZS0(INUCT))
+ ALLOCATE(ZCCL(INUCT))
+ ALLOCATE(ZZDZ(INUCT))
+ ALLOCATE(ZZLV(INUCT))
+ ALLOCATE(ZZCPH(INUCT))
+ DO JL=1,INUCT
+ ZPRES(JL) = 2. * PPABST(I1(JL),I2(JL),I3(JL)) - PPABSM(I1(JL),I2(JL),I3(JL))
+ ZRHOD(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
+ ZRR(JL) = PRS(I1(JL),I2(JL),I3(JL),3)
+ ZTT(JL) = PTHS(I1(JL),I2(JL),I3(JL))
+ ZRV(JL) = PRS(I1(JL),I2(JL),I3(JL),1)
+ ZRC(JL) = PRS(I1(JL),I2(JL),I3(JL),2)
+ ZS0(JL) = ZSAT(I1(JL),I2(JL),I3(JL))
+ DO JMOD = 1,NMOD_CCN
+ ZZNFS(JL,JMOD) = ZNFS(I1(JL),I2(JL),I3(JL),JMOD)
+ ZZNAS(JL,JMOD) = ZNAS(I1(JL),I2(JL),I3(JL),JMOD)
+ ENDDO
+ ZCCL(JL) = ZCCS(I1(JL),I2(JL),I3(JL))
+ ZZDZ(JL)=ZDZ(I1(JL),I2(JL),I3(JL))
+ ZZLV(JL)=ZLV(I1(JL),I2(JL),I3(JL))
+ ZZCPH(JL)=ZCPH(I1(JL),I2(JL),I3(JL))
+ ENDDO
+ !
+ !Evaporation/Condensation/activation
+ CALL PROGNOS_LIMA(PTSTEP,ZZDZ,ZZLV,ZZCPH,ZPRES,ZRHOD, &
+ ZRR,ZTT,ZRV,ZRC,ZS0,ZZNAS,ZCCL,ZZNFS)
+ !
+!1D array to 3D array
+ DO JMOD = 1, NMOD_CCN
+ ZWORK(:,:,:) = ZNAS(:,:,:,JMOD)
+ ZNAS(:,:,:,JMOD) = UNPACK( ZZNAS(:,JMOD) ,MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ ZWORK(:,:,:) = ZNFS(:,:,:,JMOD)
+ ZNFS(:,:,:,JMOD) = UNPACK( ZZNFS(:,JMOD) ,MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ END DO
+ PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1) = ZNFS(:,:,:,:)
+ PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1) = ZNAS(:,:,:,:)
+ !
+ ZWORK(:,:,:) = ZCCS(:,:,:)
+ ZCCS(:,:,:) = UNPACK( ZCCL(:),MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ PSVS(:,:,:,NSV_LIMA_NC) = ZCCS(:,:,:)
+ !
+ ZWORK(:,:,:) = PTHS(:,:,:)
+ PTHS(:,:,:) = UNPACK( ZTT(:),MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ ZWORK(:,:,:) = PRS(:,:,:,1)
+ PRS(:,:,:,1) = UNPACK( ZRV(:),MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ ZWORK(:,:,:) = PRS(:,:,:,2)
+ PRS(:,:,:,2) = UNPACK( ZRC(:),MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ ZWORK(:,:,:) = ZSAT(:,:,:)
+ ZSAT(:,:,:) = UNPACK( ZS0(:),MASK=GNUCT(:,:,:),FIELD=ZWORK(:,:,:) )
+ !
+ DEALLOCATE(ZPRES)
+ DEALLOCATE(ZRHOD)
+ DEALLOCATE(ZRR)
+ DEALLOCATE(ZTT)
+ DEALLOCATE(ZRV)
+ DEALLOCATE(ZRC)
+ DEALLOCATE(ZS0)
+ DEALLOCATE(ZZNFS)
+ DEALLOCATE(ZZNAS)
+ DEALLOCATE(ZCCL)
+ DEALLOCATE(ZZDZ)
+!
+ENDIF
+!
+!Computation of saturation in the meshes where there is no
+!condensation/evaporation/activation
+WHERE(.NOT.GNUCT(:,:,:) )
+ ZRVSAT(:,:,:) = EXP(XALPW-XBETAW/PTHS(:,:,:)-XGAMW*ALOG(PTHS(:,:,:)))
+ !rvsat
+ ZRVSAT(:,:,:) = (XMV / XMD)*ZRVSAT(:,:,:)/((2.* PPABST(:,:,:)-PPABSM(:,:,:))-ZRVSAT(:,:,:))
+ ZSAT(:,:,:) = (PRS(:,:,:,1)/ZRVSAT(:,:,:))-1D0
+ENDWHERE
+!
+!source terms /dt
+PRS(:,:,:,:) = PRS(:,:,:,:)/PTSTEP
+PTHS(:,:,:) = PTHS(:,:,:)/PTSTEP/ZEXNS(:,:,:)
+ZSAT(:,:,:) = ZSAT(:,:,:)+1.0
+PSVS(:,:,:,NSV_LIMA_SPRO) = ZSAT(:,:,:)
+PSVS(:,:,:,:) = PSVS(:,:,:,:)/PTSTEP
+!
+IF (ANY(PRS(:,:,:,2)+PRS(:,:,:,1) < 0.) .AND. NVERB>5) THEN
+ WRITE(*,*) 'LIMA_NOTADJUST: negative values of total water (reset to zero)'
+ WRITE(*,*) ' location of minimum:', MINLOC(PRS(:,:,:,2)+PRS(:,:,:,1))
+ WRITE(*,*) ' value of minimum :', MINVAL(PRS(:,:,:,2)+PRS(:,:,:,1))
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','LIMA_NOTADJUST','')
+END IF
+!
+!* compute the cloud fraction PCLDFR
+!
+WHERE (PRS(:,:,:,2) > 0. )
+ ZW1(:,:,:) = 1.
+ELSEWHERE
+ ZW1(:,:,:) = 0.
+ENDWHERE
+IF ( SIZE(PSRCS,3) /= 0 ) THEN
+ PSRCS(:,:,:) = ZW1(:,:,:)
+END IF
+!
+IF ( HRAD /= 'NONE' ) THEN
+ PCLDFR(:,:,:) = ZW1(:,:,:)
+END IF
+!
+IF ( tpfile%lopened ) THEN
+ ZW(:,:,:)=SUM(ZNAS,4)-ZW(:,:,:)
+ TZFIELD%CMNHNAME = 'NACT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'NACT'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_Z_NACT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZW)
+END IF
+!
+!* 7. STORE THE BUDGET TERMS
+! ----------------------
+!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CEDS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CEDS', prs(:, :, :, 1) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CEDS', prs(:, :, :, 2) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CEDS', prs(:, :, :, 4) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'CEDS', psvs(:, :, :, nsv_lima_nc) * prhodj(:, :, :) )
+ do jl = nsv_lima_ccn_free, nsv_lima_ccn_free + nmod_ccn - 1
+ idx = NBUDGET_SV1 - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ do jl = nsv_lima_ccn_acti, nsv_lima_ccn_acti + nmod_ccn - 1
+ idx = NBUDGET_SV1 - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+! if ( lscav .and. laero_mass ) &
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'CEDS', psvs(:, :, :, nsv_lima_scavmass) &
+! * prhodj(:, :, :) )
+! if ( lcold ) then
+! call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CEDS', psvs(:, :, :, nsv_lima_ni) * prhodj(:, :, :) )
+! do jl = 1, nsv_lima_ifn_free, nsv_lima_ifn_free + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_end( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nsv_lima_ifn_nucl, nsv_lima_ifn_nucl + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_end( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! do jl = 1, nsv_lima_imm_nucl, nsv_lima_imm_nucl + nmod_ifn - 1
+! idx = NBUDGET_SV1 - 1 + jl
+! call Budget_store_end( tbudgets(idx), 'CEDS', psvs(:, :, :, jl) * prhodj(:, :, :) )
+! end do
+! end if
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_spro), 'CEDS', psvs(:, :, :, nsv_lima_spro) * prhodj(:, :, :) )
+ end if
+end if
+!
+END SUBROUTINE LIMA_NOTADJUST
diff --git a/src/MNH/lima_nucleation_procs.f90 b/src/MNH/lima_nucleation_procs.f90
index a86bbd8525eac5df91766d54ee8a56d7133d7244..122d4b3c867f2e98af5b9d6461a492df26a45e5e 100644
--- a/src/MNH/lima_nucleation_procs.f90
+++ b/src/MNH/lima_nucleation_procs.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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.
@@ -8,11 +8,12 @@
! ###############################
!
INTERFACE
- SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT )
+ SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
+ PCLDFR, PICEFR, PPRCFR )
!
USE MODD_IO, ONLY: TFILEDATA
!
@@ -46,16 +47,21 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom freezing
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
+!
END SUBROUTINE LIMA_NUCLEATION_PROCS
END INTERFACE
END MODULE MODI_LIMA_NUCLEATION_PROCS
-! ############################################################################
-SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, &
- PNFT, PNAT, PIFT, PINT, PNIT, PNHT )
-! ############################################################################
+! #############################################################################
+SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU,&
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCRT, PCIT, &
+ PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
+ PCLDFR, PICEFR, PPRCFR )
+! #############################################################################
!
!! PURPOSE
!! -------
@@ -83,7 +89,8 @@ USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
NSV_LIMA_NI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL, NSV_LIMA_HOM_HAZE
USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, &
- NMOD_CCN, NMOD_IFN, NMOD_IMM
+ NMOD_CCN, NMOD_IFN, NMOD_IMM, XCTMIN, XRTMIN, LSPRO
+USE MODD_TURB_n, ONLY : LSUBG_COND
use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
@@ -128,6 +135,10 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! IFN C. activated at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Coated IFN activated at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHT ! CCN hom. freezing
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR ! Ice fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRCFR ! Precipitation fraction
+!
!-------------------------------------------------------------------------------
!
REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, Z_TH_HINC, Z_RC_HINC, Z_CC_HINC
@@ -138,39 +149,46 @@ INTEGER :: JL
!-------------------------------------------------------------------------------
!
IF ( LWARM .AND. LACTI .AND. NMOD_CCN >=1 ) THEN
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_init( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
- end if
- end if
- CALL LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, &
- PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
+ IF (.NOT.LSUBG_COND .AND. .NOT.LSPRO) THEN
- if ( lbu_enable ) then
- if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
- if ( lbudget_sv ) then
- call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
- do jl = 1, nmod_ccn
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
- call Budget_store_end( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
- end do
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
end if
- end if
+
+ CALL LIMA_CCN_ACTIVATION( TPFILE, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, PCLDFR )
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', ptht(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvt(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prct(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pcct(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', pnft(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
+ END IF
+
+ WHERE(PCLDFR(:,:,:)<1.E-10 .AND. PRCT(:,:,:)>XRTMIN(2) .AND. PCCT(:,:,:)>XCTMIN(2)) PCLDFR(:,:,:)=1.
+
END IF
!
!-------------------------------------------------------------------------------
@@ -201,8 +219,10 @@ IF ( LCOLD .AND. LNUCL .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_TH_HINC, Z_RC_HINC, Z_CC_HINC )
-
+ Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
if ( lbu_enable ) then
if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
@@ -243,8 +263,10 @@ IF (LCOLD .AND. LNUCL .AND. LMEYERS) THEN
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PINT, &
Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_TH_HINC, Z_RC_HINC, Z_CC_HINC )
-
+ Z_TH_HINC, Z_RC_HINC, Z_CC_HINC, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
if ( lbu_enable ) then
if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HIND', z_th_hind(:, :, :) * prhodj(:, :, :) / ptstep )
if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HIND', -z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
@@ -288,8 +310,10 @@ IF ( LCOLD .AND. LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1) THEN
CALL LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PCCT, PCRT, PCIT, PNFT, PNHT )
-
+ PCCT, PCRT, PCIT, PNFT, PNHT, &
+ PICEFR )
+ WHERE(PICEFR(:,:,:)<1.E-10 .AND. PRIT(:,:,:)>XRTMIN(4) .AND. PCIT(:,:,:)>XCTMIN(4)) PICEFR(:,:,:)=1.
+!
if ( lbu_enable ) then
if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
diff --git a/src/MNH/lima_phillips_ifn_nucleation.f90 b/src/MNH/lima_phillips_ifn_nucleation.f90
index a1103f50bc911925298ab1689f110fbecf87e57f..1010555ff86b477d3fd0dcebb638a0b9b0b32959 100644
--- a/src/MNH/lima_phillips_ifn_nucleation.f90
+++ b/src/MNH/lima_phillips_ifn_nucleation.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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.
@@ -13,7 +13,8 @@ INTERFACE
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC )
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
!
REAL, INTENT(IN) :: PTSTEP
!
@@ -43,6 +44,8 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
+!
END SUBROUTINE LIMA_PHILLIPS_IFN_NUCLEATION
END INTERFACE
END MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
@@ -53,7 +56,8 @@ END MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
P_TH_HIND, P_RI_HIND, P_CI_HIND, &
- P_TH_HINC, P_RC_HINC, P_CC_HINC )
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
! #################################################################################
!!
!! PURPOSE
@@ -158,6 +162,8 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HINC
REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RC_HINC
REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CC_HINC
!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PICEFR
+!
!
!* 0.2 Declarations of local variables :
!
diff --git a/src/MNH/lima_rain_accr_snow.f90 b/src/MNH/lima_rain_accr_snow.f90
index 60817d81741a913204da6857f538a1bfd4c13c22..01c31afbe3ff0152065142f33475281538a3c6ac 100644
--- a/src/MNH/lima_rain_accr_snow.f90
+++ b/src/MNH/lima_rain_accr_snow.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2018-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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.
@@ -11,8 +11,7 @@ INTERFACE
SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
PRHODREF, PT, &
PRRT, PCRT, PRST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC, &
- PA_TH, PA_RR, PA_CR, PA_RS, PA_RG )
+ P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC )
!
REAL, INTENT(IN) :: PTSTEP
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
@@ -28,17 +27,11 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_ACC
!
END SUBROUTINE LIMA_RAIN_ACCR_SNOW
END INTERFACE
@@ -48,8 +41,7 @@ END MODULE MODI_LIMA_RAIN_ACCR_SNOW
SUBROUTINE LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
PRHODREF, PT, &
PRRT, PCRT, PRST, PLBDR, PLBDS, PLVFACT, PLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC, &
- PA_TH, PA_RR, PA_CR, PA_RS, PA_RG )
+ P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC )
! ###################################################################################
!
!! PURPOSE
@@ -101,17 +93,11 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDS !
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT !
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_ACC
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RG_ACC
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RS
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_ACC
+REAL, DIMENSION(:), INTENT(OUT) :: P_RG_ACC
!
!* 0.2 Declarations of local variables :
!
@@ -265,12 +251,6 @@ WHERE( GACC )
END WHERE
!
!
-PA_RR(:) = PA_RR(:) + P_RR_ACC(:)
-PA_CR(:) = PA_CR(:) + P_CR_ACC(:)
-PA_RS(:) = PA_RS(:) + P_RS_ACC(:)
-PA_RG(:) = PA_RG(:) + P_RG_ACC(:)
-PA_TH(:) = PA_TH(:) + P_TH_ACC(:)
-!
!-------------------------------------------------------------------------------
!
CONTAINS
diff --git a/src/MNH/lima_rain_evaporation.f90 b/src/MNH/lima_rain_evaporation.f90
index 9762a2e2607643f7aba69497a6b4934eb6594ea9..2970e027d0ae5d8b380a0c9348ddc7de249fe049 100644
--- a/src/MNH/lima_rain_evaporation.f90
+++ b/src/MNH/lima_rain_evaporation.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ##########################
MODULE MODI_LIMA_RAIN_EVAPORATION
! ##########################
@@ -11,7 +12,6 @@ INTERFACE
PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
PRVT, PRCT, PRRT, PLBDR, &
P_TH_EVAP, P_RR_EVAP, &
- PA_RV, PA_RR, PA_TH, &
PEVAP3D )
!
REAL, INTENT(IN) :: PTSTEP ! Time step
@@ -29,12 +29,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:), INTENT(IN) :: PLBDR ! Lambda(rain)
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_EVAP
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_EVAP
!
REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
!
@@ -46,7 +42,6 @@ END MODULE MODI_LIMA_RAIN_EVAPORATION
PRHODREF, PT, PLV, PLVFACT, PEVSAT, PRVSAT, &
PRVT, PRCT, PRRT, PLBDR, &
P_TH_EVAP, P_RR_EVAP, &
- PA_RV, PA_RR, PA_TH, &
PEVAP3D )
! ###############################################################################
!
@@ -96,12 +91,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
REAL, DIMENSION(:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:), INTENT(IN) :: PLBDR ! Lambda(rain)
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_EVAP
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_EVAP
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RV
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_EVAP
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_EVAP
!
REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D ! Rain evap profile
!
@@ -148,12 +139,9 @@ WHERE ( GEVAP )
ZZW2(:) = MAX(ZZW2(:),0.0)
!
P_RR_EVAP(:) = - ZZW2(:)
- P_TH_EVAP(:) = P_RR_EVAP(:) * PLVFACT(:)
- PEVAP3D(:) = - P_RR_EVAP(:)
+! P_TH_EVAP(:) = P_RR_EVAP(:) * PLVFACT(:)
+! PEVAP3D(:) = - P_RR_EVAP(:)
!
-PA_TH(:) = PA_TH(:) + P_TH_EVAP(:)
-PA_RV(:) = PA_RV(:) - P_RR_EVAP(:)
-PA_RR(:) = PA_RR(:) + P_RR_EVAP(:)
END WHERE
!
!-----------------------------------------------------------------------------
diff --git a/src/MNH/lima_rain_freezing.f90 b/src/MNH/lima_rain_freezing.f90
index d09fc393ac6bc796a4af57a2f14cd7bbaa5f89dc..a5a9225bc78a8382920f419595afa8b0c4b87b65 100644
--- a/src/MNH/lima_rain_freezing.f90
+++ b/src/MNH/lima_rain_freezing.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! #################################
MODULE MODI_LIMA_RAIN_FREEZING
! #################################
@@ -10,8 +11,7 @@ INTERFACE
SUBROUTINE LIMA_RAIN_FREEZING (LDCOMPUTE, &
PRHODREF, PT, PLVFACT, PLSFACT, &
PRRT, PCRT, PRIT, PCIT, PLBDR, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
- PA_TH, PA_RR, PA_CR, PA_RI, PA_CI, PA_RG )
+ P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
!
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
!
@@ -26,18 +26,11 @@ REAL, DIMENSION(:), INTENT(IN) :: PRIT !
REAL, DIMENSION(:), INTENT(IN) :: PCIT !
REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CFRZ
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CFRZ
!
END SUBROUTINE LIMA_RAIN_FREEZING
END INTERFACE
@@ -47,8 +40,7 @@ END MODULE MODI_LIMA_RAIN_FREEZING
SUBROUTINE LIMA_RAIN_FREEZING (LDCOMPUTE, &
PRHODREF, PT, PLVFACT, PLSFACT, &
PRRT, PCRT, PRIT, PCIT, PLBDR, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
- PA_TH, PA_RR, PA_CR, PA_RI, PA_CI, PA_RG )
+ P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
! #######################################################################################
!
!! PURPOSE
@@ -93,18 +85,11 @@ REAL, DIMENSION(:), INTENT(IN) :: PRIT !
REAL, DIMENSION(:), INTENT(IN) :: PCIT !
REAL, DIMENSION(:), INTENT(IN) :: PLBDR !
!
-REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CR_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CFRZ
-REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CFRZ
-!
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_TH
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CR
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_CI
-REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_RR_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_CR_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CFRZ
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CFRZ
!
!* 0.2 Declarations of local variables :
!
@@ -144,14 +129,6 @@ WHERE( (PRIT(:)>XRTMIN(4)) .AND. (PRRT(:)>XRTMIN(3)) .AND. (PT(:)<XTT) .AND. LDC
!
END WHERE
!
-PA_TH(:) = PA_TH(:) + P_TH_CFRZ(:)
-PA_RR(:) = PA_RR(:) + P_RR_CFRZ(:)
-PA_CR(:) = PA_CR(:) + P_CR_CFRZ(:)
-PA_RI(:) = PA_RI(:) + P_RI_CFRZ(:)
-PA_CI(:) = PA_CI(:) + P_CI_CFRZ(:)
-PA_RG(:) = PA_RG(:) - P_RR_CFRZ(:) - P_RI_CFRZ(:)
-!
-!
!-------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_RAIN_FREEZING
diff --git a/src/MNH/lima_snow_deposition.f90 b/src/MNH/lima_snow_deposition.f90
new file mode 100644
index 0000000000000000000000000000000000000000..697f9ee74f5f9101579f9724421e76ee6f93d614
--- /dev/null
+++ b/src/MNH/lima_snow_deposition.f90
@@ -0,0 +1,163 @@
+!MNH_LIC Copyright 2018-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.
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_LIMA_SNOW_DEPOSITION
+! #####################
+!
+INTERFACE
+ SUBROUTINE LIMA_SNOW_DEPOSITION (LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRST, PLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS )
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVI
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVI
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_DEPS
+!
+END SUBROUTINE LIMA_SNOW_DEPOSITION
+END INTERFACE
+END MODULE MODI_LIMA_SNOW_DEPOSITION
+!
+! ##########################################################################
+SUBROUTINE LIMA_SNOW_DEPOSITION (LDCOMPUTE, &
+ PRHODREF, PSSI, PAI, PCJ, PLSFACT, &
+ PRST, PLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS )
+! ##########################################################################
+!
+!! PURPOSE
+!! -------
+!! The purpose of this routine is to compute the microphysical sources
+!! for slow cold processes :
+!! - conversion of snow to ice
+!! - deposition of vapor on snow
+!! - conversion of ice to snow (Harrington 1995)
+!!
+!!
+!! AUTHOR
+!! ------
+!! J.-M. Cohard * Laboratoire d'Aerologie*
+!! J.-P. Pinty * Laboratoire d'Aerologie*
+!! S. Berthet * Laboratoire d'Aerologie*
+!! B. Vié * CNRM *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/03/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, XALPHAI, XALPHAS, XNUI, XNUS
+USE MODD_PARAM_LIMA_COLD, ONLY : XCXS, XCCS, &
+ XLBDAS_MAX, XDSCNVI_LIM, XLBDASCNVI_MAX, &
+ XC0DEPSI, XC1DEPSI, XR0DEPSI, XR1DEPSI, &
+ XSCFAC, X1DEPS, X0DEPS, XEX1DEPS, XEX0DEPS, &
+ XDICNVS_LIM, XLBDAICNVS_LIM, &
+ XC0DEPIS, XC1DEPIS, XR0DEPIS, XR1DEPIS, &
+ XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
+ XAGGS_RLARGE1, XAGGS_RLARGE2
+
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(:), INTENT(IN) :: PSSI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PAI ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PCJ ! abs. pressure at time t
+REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! abs. pressure at time t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLBDS ! Graupel m.r. at t
+!
+REAL, DIMENSION(:), INTENT(OUT) :: P_RI_CNVI
+REAL, DIMENSION(:), INTENT(OUT) :: P_CI_CNVI
+REAL, DIMENSION(:), INTENT(OUT) :: P_TH_DEPS
+REAL, DIMENSION(:), INTENT(OUT) :: P_RS_DEPS
+!
+!* 0.2 Declarations of local variables :
+!
+LOGICAL, DIMENSION(SIZE(PRHODREF)) :: GMICRO ! Computations only where necessary
+REAL, DIMENSION(SIZE(PRHODREF)) :: ZZW, ZZW2, ZZX ! Work array
+!
+!
+!-------------------------------------------------------------------------------
+!
+P_RI_CNVI(:) = 0.
+P_CI_CNVI(:) = 0.
+P_TH_DEPS(:) = 0.
+P_RS_DEPS(:) = 0.
+!
+! Physical limitations
+!
+!
+! Looking for regions where computations are necessary
+!
+GMICRO(:) = LDCOMPUTE(:) .AND. PRST(:)>XRTMIN(5)
+!
+!
+WHERE( GMICRO )
+!
+!* 2.1 Conversion of snow to r_i: RSCNVI
+! ----------------------------------------
+!
+!
+ ZZW2(:) = 0.0
+ ZZW(:) = 0.0
+ WHERE ( PLBDS(:)<XLBDASCNVI_MAX .AND. (PRST(:)>XRTMIN(5)) &
+ .AND. (PSSI(:)<0.0) )
+ ZZW(:) = (PLBDS(:)*XDSCNVI_LIM)**(XALPHAS)
+ ZZX(:) = ( -PSSI(:)/PAI(:) ) * (XCCS*PLBDS(:)**XCXS) * (ZZW(:)**XNUS) * EXP(-ZZW(:))
+!
+ ZZW(:) = ( XR0DEPSI+XR1DEPSI*PCJ(:) )*ZZX(:)
+!
+ ZZW2(:) = ZZW(:)*( XC0DEPSI+XC1DEPSI*PCJ(:) )/( XR0DEPSI+XR1DEPSI*PCJ(:) )
+ END WHERE
+!
+ P_RI_CNVI(:) = ZZW(:)
+ P_CI_CNVI(:) = ZZW2(:)
+!
+!
+!* 2.2 Deposition of water vapor on r_s: RVDEPS
+! -----------------------------------------------
+!
+!
+ ZZW(:) = 0.0
+ WHERE ( (PRST(:)>XRTMIN(5)) )
+ ZZW(:) = ( PSSI(:)/(PAI(:)) ) * &
+ ( X0DEPS*PLBDS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDS(:)**XEX1DEPS )
+ ZZW(:) = ZZW(:)*(0.5+SIGN(0.5,ZZW(:))) - ABS(ZZW(:))*(0.5-SIGN(0.5,ZZW(:)))
+ END WHERE
+!
+ P_RS_DEPS(:) = ZZW(:)
+!!$ P_TH_DEPS(:) = P_RS_DEPS(:) * PLSFACT(:)
+!
+END WHERE
+!
+!
+END SUBROUTINE LIMA_SNOW_DEPOSITION
diff --git a/src/MNH/lima_tendencies.f90 b/src/MNH/lima_tendencies.f90
index 02bf151fce8c8ec637810ab26ae2682d13520e0b..dd02f8a40357abb83d89b6af8513b2119392f25f 100644
--- a/src/MNH/lima_tendencies.f90
+++ b/src/MNH/lima_tendencies.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
!###############################
MODULE MODI_LIMA_TENDENCIES
!###############################
@@ -18,6 +19,7 @@ MODULE MODI_LIMA_TENDENCIES
P_TH_EVAP, P_RR_EVAP, &
P_RI_CNVI, P_CI_CNVI, &
P_TH_DEPS, P_RS_DEPS, &
+ P_TH_DEPI, P_RI_DEPI, &
P_RI_CNVS, P_CI_CNVS, &
P_RI_AGGS, P_CI_AGGS, &
P_TH_DEPG, P_RG_DEPG, &
@@ -39,7 +41,8 @@ MODULE MODI_LIMA_TENDENCIES
!!! Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
PA_TH, PA_RV, PA_RC, PA_CC, PA_RR, PA_CR, &
PA_RI, PA_CI, PA_RS, PA_RG, PA_RH, &
- PEVAP3D )
+ PEVAP3D, &
+ PCF1D, PIF1D, PPF1D )
!
REAL, INTENT(IN) :: PTSTEP
LOGICAL, DIMENSION(:),INTENT(IN) :: LDCOMPUTE
@@ -85,6 +88,9 @@ REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI ! conversion snow -> ice (CNVI
REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DEPI ! deposition of vapor on ice (DEPI) : rv=-ri, ri, th
+!
REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
!
@@ -163,6 +169,10 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
!
REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D
+!
+REAL, DIMENSION(:), INTENT(IN) :: PCF1D
+REAL, DIMENSION(:), INTENT(IN) :: PIF1D
+REAL, DIMENSION(:), INTENT(IN) :: PPF1D
!
END SUBROUTINE LIMA_TENDENCIES
END INTERFACE
@@ -182,6 +192,7 @@ SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE,
P_TH_EVAP, P_RR_EVAP, &
P_RI_CNVI, P_CI_CNVI, &
P_TH_DEPS, P_RS_DEPS, &
+ P_TH_DEPI, P_RI_DEPI, &
P_RI_CNVS, P_CI_CNVS, &
P_RI_AGGS, P_CI_AGGS, &
P_TH_DEPG, P_RG_DEPG, &
@@ -203,7 +214,8 @@ SUBROUTINE LIMA_TENDENCIES (PTSTEP, LDCOMPUTE,
!!! Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
PA_TH, PA_RV, PA_RC, PA_CC, PA_RR, PA_CR, &
PA_RI, PA_CI, PA_RS, PA_RG, PA_RH, &
- PEVAP3D )
+ PEVAP3D, &
+ PCF1D, PIF1D, PPF1D )
! ######################################################################
!!
!! PURPOSE
@@ -238,10 +250,10 @@ USE MODI_LIMA_DROPLETS_AUTOCONVERSION
USE MODI_LIMA_DROPLETS_ACCRETION
USE MODI_LIMA_DROPS_SELF_COLLECTION
USE MODI_LIMA_RAIN_EVAPORATION
-USE MODI_LIMA_ICE_SNOW_DEPOSITION
+USE MODI_LIMA_ICE_DEPOSITION
+USE MODI_LIMA_SNOW_DEPOSITION
USE MODI_LIMA_ICE_AGGREGATION_SNOW
USE MODI_LIMA_GRAUPEL_DEPOSITION
-USE MODI_LIMA_BERGERON
USE MODI_LIMA_DROPLETS_RIMING_SNOW
USE MODI_LIMA_RAIN_ACCR_SNOW
USE MODI_LIMA_CONVERSION_MELTING_SNOW
@@ -296,6 +308,9 @@ REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVI ! conversion snow -> ice (CNVI
REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPS
REAL, DIMENSION(:), INTENT(INOUT) :: P_RS_DEPS ! deposition of vapor on snow (DEPS) : rv=-rs, rs, th
!
+REAL, DIMENSION(:), INTENT(INOUT) :: P_TH_DEPI
+REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_DEPI ! deposition of vapor on ice (DEPI) : rv=-ri, ri, th
+!
REAL, DIMENSION(:), INTENT(INOUT) :: P_RI_CNVS
REAL, DIMENSION(:), INTENT(INOUT) :: P_CI_CNVS ! conversion ice -> snow (CNVS) : ri, Ni, rs=-ri
!
@@ -375,6 +390,10 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
!
REAL, DIMENSION(:), INTENT(INOUT) :: PEVAP3D
!
+REAL, DIMENSION(:), INTENT(IN) :: PCF1D
+REAL, DIMENSION(:), INTENT(IN) :: PIF1D
+REAL, DIMENSION(:), INTENT(IN) :: PPF1D
+!
!* 0.2 Declarations of local variables :
!
REAL, DIMENSION(SIZE(PRCT)) :: ZT
@@ -409,9 +428,28 @@ REAL, DIMENSION(SIZE(PRCT)) :: ZLSFACT
!
REAL, DIMENSION(SIZE(PRCT)) :: ZW
!
+REAL, DIMENSION(SIZE(PRCT)) :: ZCF1D
+REAL, DIMENSION(SIZE(PRCT)) :: ZIF1D
+REAL, DIMENSION(SIZE(PRCT)) :: ZPF1D
+!
!-------------------------------------------------------------------------------
! Pre-compute quantities
!
+! Prevent fractions to reach 0 (divide by 0)
+!
+ZCF1D(:) = MAX(PCF1D(:),0.01)
+ZIF1D(:) = MAX(PIF1D(:),0.01)
+ZPF1D(:) = MAX(PPF1D(:),0.01)
+!
+! Is it necessary to compute the following quantities
+! accounting for subgrig cloud fraction ?
+! lambda does not depend on cloud fraction for 2-m species
+! lambda depends on CF for 1-m species ?
+!
+!
+! Is it necessary to change water vapour in cloudy / non cloudy parts ?
+!
+!
WHERE (LDCOMPUTE(:))
ZT(:) = PTHT(:) * ( PPABST(:)/XP00 ) ** (XRD/XCPD)
!
@@ -480,66 +518,122 @@ END WHERE
! Call microphysical processes
!
IF (LCOLD .AND. LWARM) THEN
- CALL LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, &
+ CALL LIMA_DROPLETS_HOM_FREEZING (PTSTEP, LDCOMPUTE, & ! independent from CF,IF,PF
ZT, ZLVFACT, ZLSFACT, &
PRCT, PCCT, ZLBDC, &
P_TH_HONC, P_RC_HONC, P_CC_HONC, &
PA_TH, PA_RC, PA_CC, PA_RI, PA_CI )
END IF
!
-IF (LWARM .AND. LRAIN) THEN
- CALL LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, &
- PCCT, ZLBDC3, &
- P_CC_SELF, &
- PA_CC )
+IF (LWARM) THEN
+ CALL LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, & ! depends on CF
+ PRHODREF, &
+ PCCT/ZCF1D, ZLBDC3, &
+ P_CC_SELF )
+ P_CC_SELF(:) = P_CC_SELF(:) * ZCF1D(:)
+ PA_CC(:) = PA_CC(:) + P_CC_SELF(:)
END IF
!
IF (LWARM .AND. LRAIN) THEN
- CALL LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, &
- PRHODREF, &
- PRCT, ZLBDC, ZLBDR, &
- P_RC_AUTO, P_CC_AUTO, P_CR_AUTO, &
- PA_RC, PA_CC, PA_RR, PA_CR )
+ CALL LIMA_DROPLETS_AUTOCONVERSION (LDCOMPUTE, & ! depends on CF
+ PRHODREF, &
+ PRCT/ZCF1D, PCCT/ZCF1D, ZLBDC, ZLBDR, &
+ P_RC_AUTO, P_CC_AUTO, P_CR_AUTO )
+ P_RC_AUTO(:) = P_RC_AUTO(:) * ZCF1D(:)
+ P_CC_AUTO(:) = P_CC_AUTO(:) * ZCF1D(:)
+ P_CR_AUTO(:) = P_CR_AUTO(:) * ZCF1D(:)
+ !
+ PA_RC(:) = PA_RC(:) + P_RC_AUTO(:)
+ PA_CC(:) = PA_CC(:) + P_CC_AUTO(:)
+ PA_RR(:) = PA_RR(:) - P_RC_AUTO(:)
+ PA_CR(:) = PA_CR(:) + P_CR_AUTO(:)
END IF
!
IF (LWARM .AND. LRAIN) THEN
- CALL LIMA_DROPLETS_ACCRETION (LDCOMPUTE, &
- PRHODREF, &
- PRCT, PRRT, PCCT, PCRT, &
- ZLBDC, ZLBDC3, ZLBDR, ZLBDR3, &
- P_RC_ACCR, P_CC_ACCR, &
- PA_RC, PA_CC, PA_RR )
+ CALL LIMA_DROPLETS_ACCRETION (LDCOMPUTE, & ! depends on CF, PF
+ PRHODREF, &
+ PRCT/ZCF1D, PRRT/ZPF1D, PCCT/ZCF1D, PCRT/ZPF1D,&
+ ZLBDC, ZLBDC3, ZLBDR, ZLBDR3, &
+ P_RC_ACCR, P_CC_ACCR )
+ !
+ P_CC_ACCR(:) = P_CC_ACCR(:) * ZCF1D(:)
+ P_RC_ACCR(:) = P_RC_ACCR(:) * ZCF1D(:)
+ !
+ PA_RC(:) = PA_RC(:) + P_RC_ACCR(:)
+ PA_CC(:) = PA_CC(:) + P_CC_ACCR(:)
+ PA_RR(:) = PA_RR(:) - P_RC_ACCR(:)
END IF
!
IF (LWARM .AND. LRAIN) THEN
- CALL LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, &
+ CALL LIMA_DROPS_SELF_COLLECTION (LDCOMPUTE, & ! depends on PF
PRHODREF, &
- PCRT, ZLBDR, ZLBDR3, &
- P_CR_SCBU, &
- PA_CR )
+ PCRT/ZPF1D(:), ZLBDR, ZLBDR3, &
+ P_CR_SCBU )
+ !
+ P_CR_SCBU(:) = P_CR_SCBU(:) * ZPF1D(:)
+ !
+ PA_CR(:) = PA_CR(:) + P_CR_SCBU(:)
END IF
!
IF (LWARM .AND. LRAIN) THEN
- CALL LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, &
+ CALL LIMA_RAIN_EVAPORATION (PTSTEP, LDCOMPUTE, & ! depends on PF > CF
PRHODREF, ZT, ZLV, ZLVFACT, ZEVSAT, ZRVSAT, &
- PRVT, PRCT, PRRT, ZLBDR, &
+ PRVT, PRCT/ZPF1D, PRRT/ZPF1D, ZLBDR, &
P_TH_EVAP, P_RR_EVAP, &
- PA_RV, PA_RR, PA_TH, &
PEVAP3D )
+ P_RR_EVAP(:) = P_RR_EVAP(:) * MAX((ZPF1D(:) - ZCF1D(:)),0.)
+ P_TH_EVAP(:) = P_RR_EVAP(:) * ZLVFACT(:)
+ PEVAP3D(:) = - P_RR_EVAP(:)
+ !
+ PA_TH(:) = PA_TH(:) + P_TH_EVAP(:)
+ PA_RV(:) = PA_RV(:) - P_RR_EVAP(:)
+ PA_RR(:) = PA_RR(:) + P_RR_EVAP(:)
+END IF
+!
+IF (LCOLD) THEN
+ !
+ ! Includes vapour deposition on ice, ice -> snow conversion
+ !
+ CALL LIMA_ICE_DEPOSITION (PTSTEP, LDCOMPUTE, & ! depends on IF, PF
+ PRHODREF, ZSSI, ZAI, ZCJ, ZLSFACT, &
+ PRIT/ZIF1D, PCIT/ZIF1D, ZLBDI, &
+ P_TH_DEPI, P_RI_DEPI, &
+ P_RI_CNVS, P_CI_CNVS )
+ !
+ P_RI_DEPI(:) = P_RI_DEPI(:) * ZIF1D(:)
+ P_RI_CNVS(:) = P_RI_CNVS(:) * ZIF1D(:)
+ P_CI_CNVS(:) = P_CI_CNVS(:) * ZIF1D(:)
+ P_TH_DEPI(:) = P_RI_DEPI(:) * ZLSFACT(:)
+ !
+ PA_TH(:) = PA_TH(:) + P_TH_DEPI(:)
+ PA_RV(:) = PA_RV(:) - P_RI_DEPI(:)
+ PA_RI(:) = PA_RI(:) + P_RI_DEPI(:) + P_RI_CNVS(:)
+ PA_CI(:) = PA_CI(:) + P_CI_CNVS(:)
+ PA_RS(:) = PA_RS(:) - P_RI_CNVS(:)
+
END IF
!
IF (LCOLD .AND. LSNOW) THEN
!
- ! Includes vapour deposition on snow, ice -> snow and snow -> ice exchanges
+ ! Includes vapour deposition on snow, snow -> ice conversion
!
- CALL LIMA_ICE_SNOW_DEPOSITION (PTSTEP, LDCOMPUTE, &
- PRHODREF, ZSSI, ZAI, ZCJ, ZLSFACT, &
- PRIT, PRST, PCIT, ZLBDI, ZLBDS, &
- P_RI_CNVI, P_CI_CNVI, &
- P_TH_DEPS, P_RS_DEPS, &
- P_RI_CNVS, P_CI_CNVS, &
- PA_TH, PA_RV, PA_RI, PA_CI, PA_RS )
+ CALL LIMA_SNOW_DEPOSITION (LDCOMPUTE, & ! depends on IF, PF
+ PRHODREF, ZSSI, ZAI, ZCJ, ZLSFACT, &
+ PRST/ZPF1D, ZLBDS, &
+ P_RI_CNVI, P_CI_CNVI, &
+ P_TH_DEPS, P_RS_DEPS )
+ !
+ P_RI_CNVI(:) = P_RI_CNVI(:) * ZPF1D(:)
+ P_CI_CNVI(:) = P_CI_CNVI(:) * ZPF1D(:)
+ P_RS_DEPS(:) = P_RS_DEPS(:) * ZPF1D(:)
+ P_TH_DEPS(:) = P_RS_DEPS(:) * ZLSFACT(:)
+ !
+ PA_RI(:) = PA_RI(:) + P_RI_CNVI(:)
+ PA_CI(:) = PA_CI(:) + P_CI_CNVI(:)
+ PA_RS(:) = PA_RS(:) - P_RI_CNVI(:) + P_RS_DEPS(:)
+ PA_TH(:) = PA_TH(:) + P_TH_DEPS(:)
+ PA_RV(:) = PA_RV(:) - P_RS_DEPS(:)
+
END IF
!
! Lambda_s limited for collection processes to prevent too high concentrations
@@ -549,47 +643,87 @@ ZLBDS(:) = MIN( XLBDAS_MAX, ZLBDS(:))
!
!
IF (LCOLD .AND. LSNOW) THEN
- CALL LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, &
- ZT, PRHODREF, &
- PRIT, PRST, PCIT, ZLBDI, ZLBDS, &
- P_RI_AGGS, P_CI_AGGS, &
- PA_RI, PA_CI, PA_RS )
+ CALL LIMA_ICE_AGGREGATION_SNOW (LDCOMPUTE, & ! depends on IF, PF
+ ZT, PRHODREF, &
+ PRIT/ZIF1D, PRST/ZPF1D, PCIT/ZIF1D, ZLBDI, ZLBDS, &
+ P_RI_AGGS, P_CI_AGGS )
+ P_CI_AGGS(:) = P_CI_AGGS(:) * ZIF1D(:)
+ P_RI_AGGS(:) = P_RI_AGGS(:) * ZIF1D(:)
+ !
+ PA_RI(:) = PA_RI(:) + P_RI_AGGS(:)
+ PA_CI(:) = PA_CI(:) + P_CI_AGGS(:)
+ PA_RS(:) = PA_RS(:) - P_RI_AGGS(:)
END IF
!
IF (LWARM .AND. LCOLD) THEN
- CALL LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, &
- PRGT, ZSSI, ZLBDG, ZAI, ZCJ, ZLSFACT, &
- P_TH_DEPG, P_RG_DEPG, &
- PA_TH, PA_RV, PA_RG )
+ CALL LIMA_GRAUPEL_DEPOSITION (LDCOMPUTE, PRHODREF, & ! depends on PF ?
+ PRGT/ZPF1D, ZSSI, ZLBDG, ZAI, ZCJ, ZLSFACT, &
+ P_TH_DEPG, P_RG_DEPG )
+ P_RG_DEPG(:) = P_RG_DEPG(:) * ZPF1D(:)
+ P_TH_DEPG(:) = P_RG_DEPG(:) * ZLSFACT(:)
+ !
+ PA_RV(:) = PA_RV(:) - P_RG_DEPG(:)
+ PA_RG(:) = PA_RG(:) + P_RG_DEPG(:)
+ PA_TH(:) = PA_TH(:) + P_TH_DEPG(:)
END IF
!
-IF (LWARM .AND. LCOLD) THEN
- CALL LIMA_BERGERON (LDCOMPUTE, &
- PRCT, PRIT, PCIT, ZLBDI, &
- ZSSIW, ZAI, ZCJ, ZLVFACT, ZLSFACT, &
- P_TH_BERFI, P_RC_BERFI, &
- PA_TH, PA_RC, PA_RI )
-END IF
+!!$IF (LWARM .AND. LCOLD) THEN
+!!$ CALL LIMA_BERGERON (LDCOMPUTE, & ! depends on CF, IF
+!!$ PRCT, PRIT, PCIT, ZLBDI, &
+!!$ ZSSIW, ZAI, ZCJ, ZLVFACT, ZLSFACT, &
+!!$ P_TH_BERFI, P_RC_BERFI, &
+!!$ PA_TH, PA_RC, PA_RI )
+!!$END IF
+P_TH_BERFI(:) = 0.
+P_RC_BERFI(:) = 0.
+!
!
IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
!
! Graupel production as tendency (or should be tendency + instant to stick to the previous version ?)
! Includes the Hallett Mossop process for riming of droplets by snow (HMS)
!
- CALL LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, &
+ CALL LIMA_DROPLETS_RIMING_SNOW (PTSTEP, LDCOMPUTE, & ! depends on CF
PRHODREF, ZT, &
- PRCT, PCCT, PRST, ZLBDC, ZLBDS, ZLVFACT, ZLSFACT, &
+ PRCT/ZCF1D, PCCT/ZCF1D, PRST/ZPF1D, ZLBDC, ZLBDS, ZLVFACT, ZLSFACT, &
P_TH_RIM, P_RC_RIM, P_CC_RIM, P_RS_RIM, P_RG_RIM, &
- P_RI_HMS, P_CI_HMS, P_RS_HMS, &
- PA_TH, PA_RC, PA_CC, PA_RI, PA_CI, PA_RS, PA_RG )
+ P_RI_HMS, P_CI_HMS, P_RS_HMS )
+ P_RC_RIM(:) = P_RC_RIM(:) * ZCF1D(:)
+ P_CC_RIM(:) = P_CC_RIM(:) * ZCF1D(:)
+ P_RS_RIM(:) = P_RS_RIM(:) * ZCF1D(:)
+ P_RG_RIM(:) = P_RG_RIM(:) * ZCF1D(:)
+ P_TH_RIM(:) = - P_RC_RIM(:) * (ZLSFACT(:)-ZLVFACT(:))
+ P_RI_HMS(:) = P_RI_HMS(:) * ZCF1D(:)
+ P_CI_HMS(:) = P_CI_HMS(:) * ZCF1D(:)
+ P_RS_HMS(:) = P_RS_HMS(:) * ZCF1D(:)
+ !
+ PA_RC(:) = PA_RC(:) + P_RC_RIM(:)
+ PA_CC(:) = PA_CC(:) + P_CC_RIM(:)
+ PA_RI(:) = PA_RI(:) + P_RI_HMS(:)
+ PA_CI(:) = PA_CI(:) + P_CI_HMS(:)
+ PA_RS(:) = PA_RS(:) + P_RS_RIM(:) + P_RS_HMS(:)
+ PA_RG(:) = PA_RG(:) + P_RG_RIM(:)
+ PA_TH(:) = PA_TH(:) + P_TH_RIM(:)
+
END IF
!
IF (LWARM .AND. LRAIN .AND. LCOLD .AND. LSNOW) THEN
- CALL LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, &
+ CALL LIMA_RAIN_ACCR_SNOW (PTSTEP, LDCOMPUTE, & ! depends on PF
PRHODREF, ZT, &
- PRRT, PCRT, PRST, ZLBDR, ZLBDS, ZLVFACT, ZLSFACT, &
- P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC, &
- PA_TH, PA_RR, PA_CR, PA_RS, PA_RG )
+ PRRT/ZPF1D, PCRT/ZPF1D, PRST/ZPF1D, ZLBDR, ZLBDS, ZLVFACT, ZLSFACT, &
+ P_TH_ACC, P_RR_ACC, P_CR_ACC, P_RS_ACC, P_RG_ACC )
+ P_RR_ACC(:) = P_RR_ACC(:) * ZPF1D(:)
+ P_CR_ACC(:) = P_CR_ACC(:) * ZPF1D(:)
+ P_RS_ACC(:) = P_RS_ACC(:) * ZPF1D(:)
+ P_RG_ACC(:) = P_RG_ACC(:) * ZPF1D(:)
+ P_TH_ACC(:) = - P_RR_ACC(:) * (ZLSFACT(:)-ZLVFACT(:))
+ !
+ PA_RR(:) = PA_RR(:) + P_RR_ACC(:)
+ PA_CR(:) = PA_CR(:) + P_CR_ACC(:)
+ PA_RS(:) = PA_RS(:) + P_RS_ACC(:)
+ PA_RG(:) = PA_RG(:) + P_RG_ACC(:)
+ PA_TH(:) = PA_TH(:) + P_TH_ACC(:)
+
END IF
!
IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
@@ -597,19 +731,35 @@ IF (LWARM .AND. LCOLD .AND. LSNOW) THEN
! Conversion melting of snow should account for collected droplets and drops where T>0C, but does not !
! Some thermodynamical computations inside, to externalize ?
!
- CALL LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, &
+ CALL LIMA_CONVERSION_MELTING_SNOW (LDCOMPUTE, & ! depends on PF
PRHODREF, PPABST, ZT, ZKA, ZDV, ZCJ, &
- PRVT, PRST, ZLBDS, &
- P_RS_CMEL, &
- PA_RS, PA_RG )
+ PRVT, PRST/ZPF1D, ZLBDS, &
+ P_RS_CMEL )
+ P_RS_CMEL(:) = P_RS_CMEL(:) * ZPF1D(:)
+ !
+ PA_RS(:) = PA_RS(:) + P_RS_CMEL(:)
+ PA_RG(:) = PA_RG(:) - P_RS_CMEL(:)
+
END IF
!
IF (LWARM .AND. LRAIN .AND. LCOLD ) THEN
- CALL LIMA_RAIN_FREEZING (LDCOMPUTE, &
+ CALL LIMA_RAIN_FREEZING (LDCOMPUTE, & ! depends on PF, IF
PRHODREF, ZT, ZLVFACT, ZLSFACT, &
- PRRT, PCRT, PRIT, PCIT, ZLBDR, &
- P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ, &
- PA_TH, PA_RR, PA_CR, PA_RI, PA_CI, PA_RG )
+ PRRT/ZPF1D, PCRT/ZPF1D, PRIT/ZIF1D, PCIT/ZIF1D, ZLBDR, &
+ P_TH_CFRZ, P_RR_CFRZ, P_CR_CFRZ, P_RI_CFRZ, P_CI_CFRZ )
+ P_RR_CFRZ(:) = P_RR_CFRZ(:) * ZIF1D(:)
+ P_CR_CFRZ(:) = P_CR_CFRZ(:) * ZIF1D(:)
+ P_RI_CFRZ(:) = P_RI_CFRZ(:) * ZIF1D(:)
+ P_CI_CFRZ(:) = P_CI_CFRZ(:) * ZIF1D(:)
+ P_TH_CFRZ(:) = - P_RR_CFRZ(:) * (ZLSFACT(:)-ZLVFACT(:))
+!
+ PA_TH(:) = PA_TH(:) + P_TH_CFRZ(:)
+ PA_RR(:) = PA_RR(:) + P_RR_CFRZ(:)
+ PA_CR(:) = PA_CR(:) + P_CR_CFRZ(:)
+ PA_RI(:) = PA_RI(:) + P_RI_CFRZ(:)
+ PA_CI(:) = PA_CI(:) + P_CI_CFRZ(:)
+ PA_RG(:) = PA_RG(:) - P_RR_CFRZ(:) - P_RI_CFRZ(:)
+
END IF
!
IF (LWARM .AND. LCOLD) THEN
@@ -620,7 +770,7 @@ IF (LWARM .AND. LCOLD) THEN
! Includes Hallett-Mossop process for riming of droplets by graupel (HMG)
! Some thermodynamical computations inside, to externalize ?
!
- CALL LIMA_GRAUPEL (PTSTEP, LDCOMPUTE, &
+ CALL LIMA_GRAUPEL (PTSTEP, LDCOMPUTE, & ! depends on PF, CF, IF
PRHODREF, PPABST, ZT, ZKA, ZDV, ZCJ, &
PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PCCT, PCRT, PCIT, &
diff --git a/src/MNH/lima_warm.f90 b/src/MNH/lima_warm.f90
index ff1523ffd7e7d2fd9f3f116a3feefc0ffcd2f2b1..14b1a09fc41ca0b6afe5a36bbc3ca9322548d920 100644
--- a/src/MNH/lima_warm.f90
+++ b/src/MNH/lima_warm.f90
@@ -131,6 +131,7 @@ END MODULE MODI_LIMA_WARM
! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS
! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
+! B. Vie 06/2021 Add prognostic supersaturation for LIMA
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -361,7 +362,7 @@ END IF
! --------------------------------------
!
!
-IF ( LACTI .AND. NMOD_CCN > 0 ) THEN
+IF ( LACTI .AND. NMOD_CCN > 0 .AND. .NOT. LSPRO ) THEN
if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
@@ -375,10 +376,10 @@ IF ( LACTI .AND. NMOD_CCN > 0 ) THEN
end do
end if
- CALL LIMA_WARM_NUCL( OACTIT, PTSTEP, KMI, TPFILE, &
- PRHODREF, PEXNREF, PPABST, ZT, PTHM, PW_NU, &
- PRCM, PRVT, PRCT, PRRT, &
- PTHS, PRVS, PRCS, PCCS, ZNFS, ZNAS )
+ CALL LIMA_WARM_NUCL( OACTIT, PTSTEP, KMI, TPFILE, &
+ PRHODREF, PEXNREF, PPABST, ZT, PTHM, PW_NU, &
+ PRCM, PRVT, PRCT, PRRT, &
+ PTHS, PRVS, PRCS, PCCS, ZNFS, ZNAS )
if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
diff --git a/src/MNH/lima_warm_nucl.f90 b/src/MNH/lima_warm_nucl.f90
index a0e6ac692cb57fbbf87a0a3d8f287951d593255b..549a5fc8460f4ac857a2171b64b324f9aec84b95 100644
--- a/src/MNH/lima_warm_nucl.f90
+++ b/src/MNH/lima_warm_nucl.f90
@@ -167,6 +167,7 @@ INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
!
! Packed micophysical variables
+REAL, DIMENSION(:) , ALLOCATABLE :: ZRCS ! cloud mr source
REAL, DIMENSION(:) , ALLOCATABLE :: ZCCS ! cloud conc. source
REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFS ! available nucleus conc. source
REAL, DIMENSION(:,:), ALLOCATABLE :: ZNAS ! activated nucleus conc. source
@@ -223,26 +224,9 @@ ZCTMIN(:) = XCTMIN(:) / PTSTEP
! Saturation vapor mixing ratio and radiative tendency
!
ZEPS= XMV / XMD
-!
-ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
- EXP(-XALPW+XBETAW/PT(:,:,:)+XGAMW*ALOG(PT(:,:,:))) - 1.0)
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-XALPW+XBETAW/PT(:,:,:)+XGAMW*ALOG(PT(:,:,:))) - 1.0)
ZTDT(:,:,:) = 0.
-!! ZDRC(:,:,:) = 0.
-IF (OACTIT .AND. SIZE(PTM).GT.0) THEN
- ZTDT(:,:,:) = PTM(:,:,:) ! dThRad
-! ZTDT(:,:,:) = (PT(:,:,:)-PTM(:,:,:))/PTSTEP ! dT/dt
-!!! JPP
-!!! JPP
-!!! ZDRC(:,:,:) = (PRCT(:,:,:)-PRCM(:,:,:))/PTSTEP ! drc/dt
-!! ZDRC(:,:,:) = PRCS(:,:,:)-(PRCT(:,:,:)/PTSTEP) ! drc/dt
-!!! JPP
-!!! JPP
-!!
-!! BV - W and drc/dt effect should not be included in ZTDT (already accounted for in the computations) ?
-!!
-!! ZTDT(:,:,:) = MIN(0.,ZTDT(:,:,:)+(XG*PW_NU(:,:,:))/XCPD- &
-!! (XLVTT+(XCPV-XCL)*(PT(:,:,:)-XTT))*ZDRC(:,:,:)/XCPD)
-END IF
+IF (OACTIT .AND. SIZE(PTM).GT.0) ZTDT(:,:,:) = PTM(:,:,:) * PEXNREF(:,:,:) ! dThRad
!
! find locations where CCN are available
!
@@ -261,24 +245,24 @@ IF( OACTIT ) THEN
GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
ZTDT(IIB:IIE,IJB:IJE,IKB:IKE)<XTMIN .OR. &
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ) .AND.&
- PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE).GE.ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)&
.AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
- .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4)
+ .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2)
ELSE
GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = (PW_NU(IIB:IIE,IJB:IJE,IKB:IKE)>XWMIN .OR. &
PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE) ) .AND.&
- PRVT(IIB:IIE,IJB:IJE,IKB:IKE)>(0.98*ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE))&
+ PRVT(IIB:IIE,IJB:IJE,IKB:IKE).GE.ZRVSAT(IIB:IIE,IJB:IJE,IKB:IKE)&
.AND. PT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
- .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4)
+ .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(2)
END IF
INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
!
-!
IF( INUCT >= 1 ) THEN
!
ALLOCATE(ZNFS(INUCT,NMOD_CCN))
ALLOCATE(ZNAS(INUCT,NMOD_CCN))
ALLOCATE(ZTMP(INUCT,NMOD_CCN))
+ ALLOCATE(ZRCS(INUCT))
ALLOCATE(ZCCS(INUCT))
ALLOCATE(ZZT(INUCT))
ALLOCATE(ZZTDT(INUCT))
@@ -295,6 +279,7 @@ IF( INUCT >= 1 ) THEN
ALLOCATE(ZRHODREF(INUCT))
ALLOCATE(ZEXNREF(INUCT))
DO JL=1,INUCT
+ ZRCS(JL) = PRCS(I1(JL),I2(JL),I3(JL))
ZCCS(JL) = PCCS(I1(JL),I2(JL),I3(JL))
ZZT(JL) = PT(I1(JL),I2(JL),I3(JL))
ZZW1(JL) = ZRVSAT(I1(JL),I2(JL),I3(JL))
@@ -324,8 +309,7 @@ IF( INUCT >= 1 ) THEN
! Remark : in LIMA's nucleation parameterization, Smax=0.01 for a supersaturation of 1% !
!
!
- ZVEC1(:) = MAX( 1.0001, MIN( REAL(NAHEN)-0.0001, &
- XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
+ ZVEC1(:) = MAX( 1.0001, MIN( REAL(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
IVEC1(:) = INT( ZVEC1(:) )
ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
ALLOCATE(ZSMAX(INUCT))
@@ -349,6 +333,8 @@ IF( INUCT >= 1 ) THEN
ZZW3(:) = XAHENG( IVEC1(:)+1)*(ZZW4(:)**1.5)* ZVEC1(:) &
- XAHENG( IVEC1(:) )*(ZZW5(:)**1.5)*(ZVEC1(:) - 1.0)
! Cste*((Psi1*w+Psi3*dT/dt)/(G))**1.5
+ ZZW6(:) = XAHENG2( IVEC1(:)+1)*(ZZW4(:)**0.5)* ZVEC1(:) &
+ - XAHENG2( IVEC1(:) )*(ZZW5(:)**0.5)*(ZVEC1(:) - 1.0)
!
!
ELSE ! OACTIT , for clouds
@@ -364,6 +350,9 @@ IF( INUCT >= 1 ) THEN
ZZW2(:)=MAX(ZZW2(:),0.)
ZZW3(:)=XAHENG(IVEC1(:)+1)*((XPSI1(IVEC1(:)+1)*ZZW2(:))**1.5)* ZVEC1(:) &
-XAHENG(IVEC1(:) )*((XPSI1(IVEC1(:) )*ZZW2(:))**1.5)*(ZVEC1(:)-1.0)
+!
+ ZZW6(:)=XAHENG2(IVEC1(:)+1)*((XPSI1(IVEC1(:)+1)*ZZW2(:))**0.5)* ZVEC1(:) &
+ -XAHENG2(IVEC1(:) )*((XPSI1(IVEC1(:) )*ZZW2(:))**0.5)*(ZVEC1(:)-1.0)
!
END IF ! OACTIT
!
@@ -374,12 +363,17 @@ IF( INUCT >= 1 ) THEN
!
ZZW5(:) = 1.
ZZW3(:) = (ZZW3(:)/ZZW1(:))*ZRHODREF(:) ! R.H.S. of Eq 9 of CPB 98 but
- ! for multiple aerosol modes
+ ! for multiple aerosol modes
+ WHERE (ZRCS(:) > XRTMIN(2) .AND. ZCCS(:) > XCTMIN(2))
+ ZZW6(:) = ZZW6(:) * ZRHODREF(:) * ZCCS(:) * PTSTEP / (XLBC*ZCCS(:)/ZRCS(:))**XLBEXC
+ ELSEWHERE
+ ZZW6(:)=0.
+ END WHERE
+
WHERE (ZZW3(:) == 0. .AND. .NOT.(ZSW>0.))
ZZW5(:) = -1.
END WHERE
!
-!
!-------------------------------------------------------------------------------
!
!
@@ -394,9 +388,9 @@ IF( INUCT >= 1 ) THEN
! Check with values used for tabulation in ini_lima_warm.f90
ZS1 = 1.0E-5 ! corresponds to 0.001% supersaturation
ZS2 = 5.0E-2 ! corresponds to 5.0% supersaturation
- ZXACC = 1.0E-7 ! Accuracy needed for the search in [NO UNITS]
+ ZXACC = 1.0E-10 ! Accuracy needed for the search in [NO UNITS]
!
- ZSMAX(:) = ZRIDDR(ZS1,ZS2,ZXACC,ZZW3(:),INUCT) ! ZSMAX(:) is in [NO UNITS]
+ ZSMAX(:) = ZRIDDR(ZS1,ZS2,ZXACC,ZZW3(:),ZZW6(:),INUCT) ! ZSMAX(:) is in [NO UNITS]
ZSMAX(:) = MIN(MAX(ZSMAX(:), ZSW(:)),ZS2)
!
!
@@ -411,8 +405,7 @@ IF( INUCT >= 1 ) THEN
! Modified values for Beta and C (see in init_aerosol_properties) account for that
!
WHERE (ZZW5(:) > 0. .AND. ZSMAX(:) > 0.)
- ZVEC1(:) = MAX( 1.0001, MIN( REAL(NHYP)-0.0001, &
- XHYPINTP1*LOG(ZSMAX(:))+XHYPINTP2 ) )
+ ZVEC1(:) = MAX( 1.0001, MIN( REAL(NHYP)-0.0001, XHYPINTP1*LOG(ZSMAX(:))+XHYPINTP2 ) )
IVEC1(:) = INT( ZVEC1(:) )
ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
END WHERE
@@ -428,12 +421,11 @@ IF( INUCT >= 1 ) THEN
ZZW2(:) = 0.
ZZW3(:) = 0.
!
- WHERE( ZSMAX(:)>0.0 )
+ WHERE( ZZW5(:) > 0. .AND. ZSMAX(:)>0.0 )
ZZW2(:) = XHYPF12( IVEC1(:)+1,JMOD )* ZVEC1(:) & ! hypergeo function
- XHYPF12( IVEC1(:) ,JMOD )*(ZVEC1(:) - 1.0) ! XHYPF12 is tabulated
!
- ZTMP(:,JMOD) = (ZCHEN_MULTI(:,JMOD)/ZRHODREF(:))*ZSMAX(:)**XKHEN_MULTI(JMOD) &
- *ZZW2(:)/PTSTEP
+ ZTMP(:,JMOD) = ZCHEN_MULTI(:,JMOD)/ZRHODREF(:)*ZSMAX(:)**XKHEN_MULTI(JMOD)*ZZW2(:)/PTSTEP
ENDWHERE
ENDDO
!
@@ -445,19 +437,17 @@ IF( INUCT >= 1 ) THEN
ZZW2(:) = 0.
ZZW3(:) = 0.
!
- WHERE( SUM(ZTMP(:,:),DIM=2)*PTSTEP .GT. 15.E6/ZRHODREF(:) )
+ WHERE( SUM(ZTMP(:,:),DIM=2)*PTSTEP .GT. 0.01E6/ZRHODREF(:) )
ZZW1(:) = MIN( ZNFS(:,JMOD),MAX( ZTMP(:,JMOD)- ZNAS(:,JMOD) , 0.0 ) )
ENDWHERE
!
!* update the concentration of activated CCN = Na
!
- PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) + &
- UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
+ PNAS(:,:,:,JMOD) = PNAS(:,:,:,JMOD) + UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
!
!* update the concentration of free CCN = Nf
!
- PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) - &
- UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
+ PNFS(:,:,:,JMOD) = PNFS(:,:,:,JMOD) - UNPACK( ZZW1(:), MASK=GNUCT(:,:,:), FIELD=0.0 )
!
!* prepare to update the cloud water concentration
!
@@ -497,6 +487,7 @@ IF( INUCT >= 1 ) THEN
DEALLOCATE(ZNFS)
DEALLOCATE(ZNAS)
DEALLOCATE(ZCCS)
+ DEALLOCATE(ZRCS)
DEALLOCATE(ZZT)
DEALLOCATE(ZSMAX)
DEALLOCATE(ZZW1)
@@ -558,7 +549,7 @@ END IF
CONTAINS
!------------------------------------------------------------------------------
!
- FUNCTION ZRIDDR(PX1,PX2INIT,PXACC,PZZW3,NPTS) RESULT(PZRIDDR)
+ FUNCTION ZRIDDR(PX1,PX2INIT,PXACC,PZZW3,PZZW6,NPTS) RESULT(PZRIDDR)
!
!
!!**** *ZRIDDR* - iterative algorithm to find root of a function
@@ -612,6 +603,7 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: NPTS
REAL, DIMENSION(:), INTENT(IN) :: PZZW3
+REAL, DIMENSION(:), INTENT(IN) :: PZZW6
REAL, INTENT(IN) :: PX1, PX2INIT, PXACC
REAL, DIMENSION(:), ALLOCATABLE :: PZRIDDR
!
@@ -633,8 +625,8 @@ ALLOCATE(PZRIDDR(NPTS))
!
PZRIDDR(:)= UNUSED
PX2 = PX2INIT
-fl(:) = FUNCSMAX(PX1,PZZW3(:),NPTS)
-fh(:) = FUNCSMAX(PX2,PZZW3(:),NPTS)
+fl(:) = FUNCSMAX(PX1,PZZW3(:),PZZW6(:),NPTS)
+fh(:) = FUNCSMAX(PX2,PZZW3(:),PZZW6(:),NPTS)
!
DO JL = 1, NPTS
PX2 = PX2INIT
@@ -643,7 +635,7 @@ DO JL = 1, NPTS
xh = PX2
do j=1,MAXIT
xm = 0.5*(xl+xh)
- fm(JL) = SINGL_FUNCSMAX(xm,PZZW3(JL),JL)
+ fm(JL) = SINGL_FUNCSMAX(xm,PZZW3(JL),PZZW6(JL),JL)
s = sqrt(fm(JL)**2-fl(JL)*fh(JL))
if (s == 0.0) then
GO TO 101
@@ -653,7 +645,7 @@ DO JL = 1, NPTS
GO TO 101
endif
PZRIDDR(JL) = xnew
- fnew(JL) = SINGL_FUNCSMAX(PZRIDDR(JL),PZZW3(JL),JL)
+ fnew(JL) = SINGL_FUNCSMAX(PZRIDDR(JL),PZZW3(JL),PZZW6(JL),JL)
if (fnew(JL) == 0.0) then
GO TO 101
endif
@@ -671,7 +663,7 @@ DO JL = 1, NPTS
else if (PX2 .lt. 0.05) then
PX2 = PX2 + 1.0E-2
PRINT*, 'PX2 ALWAYS too small, we put a greater one : PX2 =',PX2
- fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
+ fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),PZZW6(JL),JL)
go to 100
end if
if (abs(xh-xl) <= PXACC) then
@@ -692,7 +684,7 @@ DO JL = 1, NPTS
else if (PX2 .lt. 0.05) then
PX2 = PX2 + 1.0E-2
PRINT*, 'PX2 too small, we put a greater one : PX2 =',PX2
- fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),JL)
+ fh(JL) = SINGL_FUNCSMAX(PX2,PZZW3(JL),PZZW6(JL),JL)
go to 100
else
!!$ print*, 'PZRIDDR: root must be bracketed'
@@ -715,7 +707,7 @@ END FUNCTION ZRIDDR
!
!------------------------------------------------------------------------------
!
- FUNCTION FUNCSMAX(PPZSMAX,PPZZW3,NPTS) RESULT(PFUNCSMAX)
+ FUNCTION FUNCSMAX(PPZSMAX,PPZZW3,PPZZW6,NPTS) RESULT(PFUNCSMAX)
!
!
!!**** *FUNCSMAX* - function describing SMAX function that you want to find the root
@@ -774,6 +766,7 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: NPTS
REAL, INTENT(IN) :: PPZSMAX ! supersaturation is already in no units
REAL, DIMENSION(:), INTENT(IN) :: PPZZW3 !
+REAL, DIMENSION(:), INTENT(IN) :: PPZZW6 !
REAL, DIMENSION(:), ALLOCATABLE :: PFUNCSMAX !
!
!* 0.2 declarations of local variables
@@ -801,13 +794,13 @@ DO JMOD = 1, NMOD_CCN
/ GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
ENDDO
! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
-PFUNCSMAX(:) = PFUNCSMAX(:) - PPZZW3(:)
+PFUNCSMAX(:) = PFUNCSMAX(:) + PPZZW6(:)*PPZSMAX - PPZZW3(:)
!
END FUNCTION FUNCSMAX
!
!------------------------------------------------------------------------------
!
- FUNCTION SINGL_FUNCSMAX(PPZSMAX,PPZZW3,KINDEX) RESULT(PSINGL_FUNCSMAX)
+ FUNCTION SINGL_FUNCSMAX(PPZSMAX,PPZZW3,PPZZW6,KINDEX) RESULT(PSINGL_FUNCSMAX)
!
!
!!**** *SINGL_FUNCSMAX* - same function as FUNCSMAX
@@ -832,6 +825,7 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KINDEX
REAL, INTENT(IN) :: PPZSMAX ! supersaturation is "no unit"
REAL, INTENT(IN) :: PPZZW3 !
+REAL, INTENT(IN) :: PPZZW6 !
REAL :: PSINGL_FUNCSMAX !
!
!* 0.2 declarations of local variables
@@ -857,7 +851,7 @@ DO JMOD = 1, NMOD_CCN
/ GAMMA_X0D((XKHEN_MULTI(JMOD)+3.0)/2.0)
ENDDO
! function l.h.s. minus r.h.s. of eq. (9) of CPB98 but for NMOD_CCN aerosol mode
-PSINGL_FUNCSMAX = PSINGL_FUNCSMAX - PPZZW3
+PSINGL_FUNCSMAX = PSINGL_FUNCSMAX + PPZZW6*PPZSMAX - PPZZW3
!
END FUNCTION SINGL_FUNCSMAX
!
diff --git a/src/MNH/mean_field.f90 b/src/MNH/mean_field.f90
index b2fd6e083d992ea0e245bd333d2ba7402327896e..048eb689dfa04f798b16e555bb6b220e896b3484 100644
--- a/src/MNH/mean_field.f90
+++ b/src/MNH/mean_field.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -10,11 +10,12 @@
!
INTERFACE
- SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST)
+ SUBROUTINE MEAN_FIELD( PUT, PVT, PWT, PTHT, PTKET, PPABST, PSVT )
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVT ! Passive scalar variables
END SUBROUTINE MEAN_FIELD
@@ -22,9 +23,9 @@ END INTERFACE
END MODULE MODI_MEAN_FIELD
!
-! #######################################################
- SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST)
-! #######################################################
+! #################################################################
+ SUBROUTINE MEAN_FIELD( PUT, PVT, PWT, PTHT, PTKET, PPABST, PSVT )
+! #################################################################
!
!!**** *MEAN_FIELD * -
!!
@@ -46,6 +47,7 @@ END MODULE MODI_MEAN_FIELD
!! -------------
!! Original 07/2009
!! (C.Lac) 09/2016 Max values
+!! (PA.Joulin) 12/2020 Wind turbine variables
!!---------------------------------------------------------------
!
!
@@ -57,8 +59,15 @@ USE MODD_MEAN_FIELD_n
USE MODD_PARAM_n
USE MODD_MEAN_FIELD
USE MODD_CST
-
-!
+USE MODD_PASPOL
+!
+USE MODD_EOL_MAIN, ONLY: LMAIN_EOL, CMETH_EOL, NMODEL_EOL
+USE MODD_EOL_SHARED_IO, ONLY: XTHRUT, XTORQT, XPOWT
+USE MODD_EOL_SHARED_IO, ONLY: XTHRU_SUM, XTORQ_SUM, XPOW_SUM
+USE MODD_EOL_ALM
+USE MODD_EOL_ADNR
+USE MODE_MODELN_HANDLER
+!
IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
@@ -66,12 +75,17 @@ IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVT
!
!* 0.2 Declarations of local variables :
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZTEMPT
INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
INTEGER :: JI,JJ,JK ! Loop indexes
+!
+INTEGER :: IMI !Current model index
+!
+!
!-----------------------------------------------------------------------
!
!* 0. ARRAYS BOUNDS INITIALIZATION
@@ -94,15 +108,32 @@ IKE=IKU-JPVEXT
XWM_MEAN = PWT + XWM_MEAN
XTHM_MEAN = PTHT + XTHM_MEAN
XTEMPM_MEAN = ZTEMPT + XTEMPM_MEAN
+ IF (LPASPOL) XSVT_MEAN = PSVT + XSVT_MEAN
IF (CTURB/='NONE') XTKEM_MEAN = PTKET + XTKEM_MEAN
XPABSM_MEAN = PPABST + XPABSM_MEAN
!
XU2_MEAN = PUT**2 + XU2_MEAN
XV2_MEAN = PVT**2 + XV2_MEAN
XW2_MEAN = PWT**2 + XW2_MEAN
+ XUW_MEAN = PUT*PWT + XUW_MEAN
XTH2_MEAN = PTHT**2 + XTH2_MEAN
XTEMP2_MEAN = ZTEMPT**2 + XTEMP2_MEAN
XPABS2_MEAN = PPABST**2 + XPABS2_MEAN
+!
+! Wind turbine variables
+ IMI = GET_CURRENT_MODEL_INDEX()
+ IF (LMAIN_EOL .AND. IMI==NMODEL_EOL) THEN
+ SELECT CASE(CMETH_EOL)
+ CASE('ADNR') ! Actuator Disc Non-Rotating
+ XTHRU_SUM = XTHRUT + XTHRU_SUM
+ CASE('ALM') ! Actuator Line Method
+ XAOA_SUM = XAOA_GLB + XAOA_SUM
+ XFAERO_RE_SUM = XFAERO_RE_GLB + XFAERO_RE_SUM
+ XTHRU_SUM = XTHRUT + XTHRU_SUM
+ XTORQ_SUM = XTORQT + XTORQ_SUM
+ XPOW_SUM = XPOWT + XPOW_SUM
+ END SELECT
+ END IF
!
MEAN_COUNT = MEAN_COUNT + 1
!
diff --git a/src/MNH/modd_allstationn.f90 b/src/MNH/modd_allstationn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c31413b78a08bf8ea7480265110dcc58331bdff4
--- /dev/null
+++ b/src/MNH/modd_allstationn.f90
@@ -0,0 +1,94 @@
+!MNH_LIC Copyright 2021-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.
+!-----------------------------------------------------------------
+! ############################
+ MODULE MODD_ALLSTATION_n
+! ############################
+!
+!!**** *MODD_STATION* - declaration of stations
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to define
+! the different stations types.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! E. Jezequel *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/06/21
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+USE MODD_STATION_n
+USE MODD_TYPE_STATION
+
+IMPLICIT NONE
+
+TYPE ALLSTATION_t
+!
+!-------------------------------------------------------------------------------------------
+!
+!
+ INTEGER :: NNUMB_STAT !Number of stations as defined in namelist
+ REAL, DIMENSION(100) :: XX_STAT, XY_STAT, XZ_STAT, XLAT_STAT, XLON_STAT
+ CHARACTER(LEN=7), DIMENSION(100) :: CNAME_STAT, CTYPE_STAT
+ CHARACTER(LEN=20) :: CFILE_STAT
+ REAL :: XSTEP_STAT
+ LOGICAL :: LDIAG_RESULTS
+ !
+!
+END TYPE ALLSTATION_t
+
+TYPE(ALLSTATION_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: ALLSTATION_MODEL
+
+INTEGER, POINTER :: NNUMB_STAT=>NULL()
+REAL, POINTER :: XSTEP_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XX_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XY_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XLAT_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XLON_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XZ_STAT=>NULL()
+CHARACTER (LEN=7),DIMENSION(:), POINTER :: CNAME_STAT=>NULL()
+CHARACTER (LEN=7),DIMENSION(:), POINTER :: CTYPE_STAT=>NULL()
+CHARACTER (LEN=20),POINTER :: CFILE_STAT=>NULL()
+LOGICAL, POINTER :: LDIAG_RESULTS=>NULL()
+CONTAINS
+
+SUBROUTINE ALLSTATION_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+!
+! Current model is set to model KTO
+
+NNUMB_STAT =>ALLSTATION_MODEL(KTO)%NNUMB_STAT
+XSTEP_STAT =>ALLSTATION_MODEL(KTO)%XSTEP_STAT
+XX_STAT =>ALLSTATION_MODEL(KTO)%XX_STAT
+XY_STAT =>ALLSTATION_MODEL(KTO)%XY_STAT
+XZ_STAT =>ALLSTATION_MODEL(KTO)%XZ_STAT
+XLAT_STAT =>ALLSTATION_MODEL(KTO)%XLAT_STAT
+XLON_STAT =>ALLSTATION_MODEL(KTO)%XLON_STAT
+CNAME_STAT =>ALLSTATION_MODEL(KTO)%CNAME_STAT
+CTYPE_STAT =>ALLSTATION_MODEL(KTO)%CTYPE_STAT
+CFILE_STAT =>ALLSTATION_MODEL(KTO)%CFILE_STAT
+LDIAG_RESULTS =>ALLSTATION_MODEL(KTO)%LDIAG_RESULTS
+END SUBROUTINE ALLSTATION_GOTO_MODEL
+
+END MODULE MODD_ALLSTATION_n
diff --git a/src/MNH/modd_blankn.f90 b/src/MNH/modd_blankn.f90
index 74c0d8b1607783964152f357a44502f38df75d96..6428103136f77d7639c070c7032add80316721f5 100644
--- a/src/MNH/modd_blankn.f90
+++ b/src/MNH/modd_blankn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-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.
diff --git a/src/MNH/modd_cst.f90 b/src/MNH/modd_cst.f90
index 0becaf15d7402f8c460d16f69a05b4630bfb6301..73607888ccbf0791641a83952225dd0a2a76e9ce 100644
--- a/src/MNH/modd_cst.f90
+++ b/src/MNH/modd_cst.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modd 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###############
MODULE MODD_CST
! ###############
@@ -42,6 +37,7 @@
!! C. Mari 31/10/00 add NDAYSEC
!! V. Masson 01/03/03 add conductivity of ice
!! J.Escobar : 10/2017 : for real*4 , add XMNH_HUGE_12_LOG
+!! J.L. Redelsperger 03/2021 add constants for ocean penetrating solar
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -63,11 +59,14 @@ REAL,SAVE :: XRADIUS,XOMEGA ! Earth radius, earth rotation
REAL,SAVE :: XG ! Gravity constant
!
REAL,SAVE :: XP00 ! Reference pressure
+REAL,SAVE :: XP00OCEAN ! Reference pressure for ocean model
+REAL,SAVE :: XRH00OCEAN ! Reference density for ocean model
!
REAL,SAVE :: XSTEFAN,XI0 ! Stefan-Boltzman constant, solar constant
!
REAL,SAVE :: XMD,XMV ! Molar mass of dry air and molar mass of vapor
REAL,SAVE :: XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+REAL,SAVE :: XEPSILO ! XMV/XMD
REAL,SAVE :: XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
REAL,SAVE :: XRHOLW ! Volumic mass of liquid water
REAL,SAVE :: XCL,XCI ! Cl (liquid), Ci (ice)
@@ -82,8 +81,19 @@ REAL,SAVE :: XALPW,XBETAW,XGAMW ! Constants for saturation vapor
REAL,SAVE :: XALPI,XBETAI,XGAMI ! Constants for saturation vapor
! pressure function over solid ice
REAL,SAVE :: XCONDI ! thermal conductivity of ice (W m-1 K-1)
-REAL, SAVE :: XTH00 ! reference value for the potential
- ! temperature
+REAL,SAVE :: XALPHAOC ! thermal expansion coefficient for ocean (K-1)
+REAL,SAVE :: XBETAOC ! Haline contraction coeff for ocean (S-1)
+REAL,SAVE :: XTH00 ! reference value for the potential temperature
+REAL,SAVE :: XTH00OCEAN ! Ref value for pot temp in ocean model
+REAL,SAVE :: XSA00OCEAN ! Ref value for SAlinity in ocean model
+REAL,SAVE :: XROC=0.69! 3 coeffs for SW penetration in Ocean (Hoecker et al)
+REAL,SAVE :: XD1=1.1
+REAL,SAVE :: XD2=23.
+! Values used in SURFEX CMO
+!REAL,SAVE :: XROC=0.58
+!REAL,SAVE :: XD1=0.35
+!REAL,SAVE :: XD2=23.
+
REAL,SAVE :: XRHOLI ! Volumic mass of liquid water
!
INTEGER, SAVE :: NDAYSEC ! Number of seconds in a day
diff --git a/src/MNH/modd_dynn.f90 b/src/MNH/modd_dynn.f90
index c3b64335c44521991cc06f96a9825de59183ca7c..bf719ed52d8d3120df46e26c4f15b74b4d26237e 100644
--- a/src/MNH/modd_dynn.f90
+++ b/src/MNH/modd_dynn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #################
@@ -43,6 +43,7 @@
!! Modification 01/2016 (JP Pinty) Add LIMA
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Modification 07/2017 (V. Vionnet) Add blowing snow variable
+!! Modification 03/2021 (JL Redelsperger) Add logical LOCEAN
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -55,6 +56,7 @@ TYPE DYN_t
!
INTEGER :: NSTOP ! Number of time step
REAL :: XTSTEP ! Time step
+ LOGICAL :: LOCEAN
!
!++++++++++++++++++++++++++++++++++
!PART USED BY THE PRESSURE SOLVER
@@ -194,6 +196,7 @@ CHARACTER(LEN=5), POINTER :: CPRESOPT=>NULL()
INTEGER, POINTER :: NITR=>NULL()
LOGICAL, POINTER :: LITRADJ=>NULL()
LOGICAL, POINTER :: LRES=>NULL()
+LOGICAL, POINTER :: LOCEAN=>NULL()
REAL, POINTER :: XRES=>NULL()
REAL, POINTER :: XRELAX=>NULL()
REAL, POINTER :: XDXHATM=>NULL()
@@ -297,6 +300,7 @@ CPRESOPT=>DYN_MODEL(KTO)%CPRESOPT
NITR=>DYN_MODEL(KTO)%NITR
LITRADJ=>DYN_MODEL(KTO)%LITRADJ
LRES=>DYN_MODEL(KTO)%LRES
+LOCEAN=>DYN_MODEL(KTO)%LOCEAN
XRES=>DYN_MODEL(KTO)%XRES
XRELAX=>DYN_MODEL(KTO)%XRELAX
XDXHATM=>DYN_MODEL(KTO)%XDXHATM
diff --git a/src/MNH/modd_eol_adnr.f90 b/src/MNH/modd_eol_adnr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d0aa66e3efa2cc0de33cfe908e086d2620e982bf
--- /dev/null
+++ b/src/MNH/modd_eol_adnr.f90
@@ -0,0 +1,69 @@
+!MNH_LIC Copyright 2016-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.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_EOL_ADNR
+!! #####################
+!!
+!!*** *MODD_EOL_ADNR*
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several models are available. One of the models is the Non-Rotating
+!! Actuator Disk (ADNR). MODD_EOL_ADNR contains all the declarations for
+!! the ADNR model.
+!!
+!!** AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/16
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+IMPLICIT NONE
+!
+! ------ TYPES ------
+TYPE FARM
+ INTEGER :: NNB_TURBINES ! Number of wind turbines [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XPOS_X ! Tower base position, X coord [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XPOS_Y ! Tower base position, Y coord [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XCT_INF ! Thrust coefficient from U_infinite [-]
+END TYPE FARM
+!
+TYPE TURBINE
+ CHARACTER(LEN=10) :: CNAME ! Wind turbine name [-]
+ REAL :: XH_HEIGHT ! Hub height [m]
+ REAL :: XR_MAX ! Radius max of the blade [m]
+END TYPE TURBINE
+!
+! ------ VARIABLES ------
+! Farm data
+TYPE(FARM) :: TFARM
+TYPE(TURBINE) :: TTURBINE
+!
+! Global (CPU) variables
+REAL, DIMENSION(:), ALLOCATABLE :: XA_INDU ! Induction factor
+REAL, DIMENSION(:), ALLOCATABLE :: XCT_D ! Adapted thrust coef (for U_d) [-]
+!
+! Implicit from MODD_EOL_SHARED_IO:
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRU_SUM ! Sum of thrust (N)
+!
+! Namelist NAM_EOL_ADNR :
+! Implicit from MODD_EOL_SHARED_IO:
+!CHARACTER(LEN=100) :: CFARM_CSVDATA ! File to read, with farm data
+!CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! File to read, turbine data
+!CHARACTER(LEN=3) :: CINTERP ! Interpolation method for wind speed
+!
+END MODULE MODD_EOL_ADNR
diff --git a/src/MNH/modd_eol_alm.f90 b/src/MNH/modd_eol_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c04f0cb538ec0d35b16b0cb2ceb5a005401dfa81
--- /dev/null
+++ b/src/MNH/modd_eol_alm.f90
@@ -0,0 +1,118 @@
+!MNH_LIC Copyright 2017-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.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_EOL_ALM
+!! #####################
+!!
+!!*** *MODD_EOL_ALM*
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several models are available. One of the models is the Actuator
+!! Line Method (ALM). MODD_EOL_ALM contains all the declarations for
+!! the ALM model.
+!!
+!!
+!!** AUTHOR
+!! ------
+!! PA.Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/01/17
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+IMPLICIT NONE
+!
+! ------ TYPES ------
+!
+TYPE FARM
+ INTEGER :: NNB_TURBINES ! Number of wind turbines [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XPOS_X ! Tower base position, X coord [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XPOS_Y ! Tower base position, Y coord [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XOMEGA ! Rotor rotation speed [rad/s]
+ REAL, DIMENSION(:), ALLOCATABLE :: XNAC_YAW ! Nacelle yaw angle [rad]
+ REAL, DIMENSION(:), ALLOCATABLE :: XBLA_PITCH ! Blade picth angle [rad]
+END TYPE FARM
+!
+TYPE TURBINE
+ CHARACTER(LEN=10) :: CNAME ! Nom de la turbine [-]
+ INTEGER :: NNB_BLADES ! Number of blades [-]
+ REAL :: XH_HEIGHT ! Hub height [m]
+ REAL :: XH_DEPORT ! Hub deport [m]
+ REAL :: XNAC_TILT ! Tilt of the nacelle [m]
+ REAL :: XR_MIN ! Minimum blade radius [m]
+ REAL :: XR_MAX ! Maximum blade radius [m]
+END TYPE TURBINE
+!
+TYPE BLADE
+ INTEGER :: NNB_BLAELT ! Number of blade element
+ INTEGER :: NNB_BLADAT ! Number of blade data
+ REAL, DIMENSION(:), ALLOCATABLE :: XRAD ! Data node radius [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XCHORD ! Element chord [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XTWIST ! Element twist [rad]
+ CHARACTER(LEN=20), DIMENSION(:), ALLOCATABLE :: CAIRFOIL ! Arifoil name [-]
+END TYPE BLADE
+!
+TYPE AIRFOIL
+ CHARACTER(LEN=15) :: CNAME ! Airfoil name [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XAA ! Attack Angle [rad]
+ REAL, DIMENSION(:), ALLOCATABLE :: XRE ! Reynolds Number [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XCL ! Lift coefficient [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XCD ! Drag coefficient [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XCM ! Moment coefficient [-]
+END TYPE AIRFOIL
+!
+! ------ VARIABLES ------
+! --- Farm data ---
+TYPE(FARM) :: TFARM
+TYPE(TURBINE) :: TTURBINE
+TYPE(BLADE) :: TBLADE
+TYPE(AIRFOIL), DIMENSION(:), ALLOCATABLE :: TAIRFOIL
+!
+! --- Global variables (Code & CPU) ---
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XELT_RAD ! Blade elements radius [m]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XAOA_GLB ! Angle of attack of an element [rad]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFLIFT_GLB ! Lift force, parallel to Urel [N]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFDRAG_GLB ! Drag force, perpendicular to Urel [N]
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RE_GLB ! Aerodyn. force (lift+drag) in RE [N]
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RG_GLB ! Aerodyn. force (lift+drag) in RG [N]
+!
+! Mean values
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XAOA_SUM ! Sum of angle of attack [rad]
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RE_SUM ! Sum of aerodyn. force (lift+drag) in RE [N]
+!
+! Implicit from MODD_EOL_SHARED_IO :
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!REAL, DIMENSION(:), ALLOCATABLE :: XTORQT ! Torque [Nm]
+!REAL, DIMENSION(:), ALLOCATABLE :: XPOWT ! Power [W]
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRU_SUM ! Sum of thrust (N)
+!REAL, DIMENSION(:), ALLOCATABLE :: XTORQ_SUM ! Sum of torque (Nm)
+!REAL, DIMENSION(:), ALLOCATABLE :: XPOW_SUM ! Sum of power (W)
+!
+!
+! --- Namelist NAM_EOL_ALM ---
+! Implicit from MODD_EOL_SHARED_IO :
+!CHARACTER(LEN=100) :: CFARM_CSVDATA ! Farm file to read
+!CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! Turbine file to read
+!CHARACTER(LEN=100) :: CBLADE_CSVDATA ! Blade file to read
+!CHARACTER(LEN=100) :: CAIRFOIL_CSVDATA ! Airfoil file to read
+!CHARACTER(LEN=3) :: CINTERP ! Interpolation method for wind speed
+!
+INTEGER :: NNB_BLAELT ! Number of blade elements
+!
+LOGICAL :: LTIMESPLIT ! Flag to apply Time splitting method
+LOGICAL :: LTIPLOSSG ! Flag to apply Glauert's tip loss correction
+LOGICAL :: LTECOUTPTS ! Flag to get Tecplot file output of element points
+!
+END MODULE MODD_EOL_ALM
diff --git a/src/MNH/modd_eol_kine_alm.f90 b/src/MNH/modd_eol_kine_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..84f45c055592e1eaaba34b43d067ffab3b2feb8b
--- /dev/null
+++ b/src/MNH/modd_eol_kine_alm.f90
@@ -0,0 +1,108 @@
+!MNH_LIC Copyright 2018-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.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_EOL_KINE_ALM
+!! #####################
+!!
+!!*** *MODD_EOL_KINE_ALM*
+!!
+!! PURPOSE
+!! -------
+! Declaration to take into account wind turbine motion
+!
+!!
+!!** AUTHOR
+!! ------
+!! PA.Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/18
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+!
+! - Matrix to move from one fram to an other -
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XMAT_RG_RT ! RG = Repere GLOBAL, RT = Repere TOWER
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XMAT_RG_RN, XMAT_RT_RN ! RN = Repere NACELLE
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XMAT_RG_RH, XMAT_RH_RG, XMAT_RN_RH ! RH = Repere HUB
+DOUBLE PRECISION, DIMENSION(:,:,:,:), ALLOCATABLE :: XMAT_RG_RB, XMAT_RH_RB ! RB = Repere BLADE
+DOUBLE PRECISION, DIMENSION(:,:,:,:,:), ALLOCATABLE :: XMAT_RG_RE, XMAT_RE_RG, XMAT_RB_RE ! RE = Repere ELEMENT
+
+! - POSITIONS & ORIENTATIONS -
+DOUBLE PRECISION, DIMENSION(3) :: XPOS_REF ! Reference position
+
+! Tower
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XPOSINI_TOWO_RG ! Initial tower origin position, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XPOS_TOWO_RG ! Current tower origin real position, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XPOS_TELT_RG ! Current tower element position, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XPOS_TELT_RT ! Current tower element position, in tower frame
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XANGINI_TOW_RG ! Initial tower orientation in global ref frame
+
+! Nacelle
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XPOSINI_NACO_RT ! Initial nacelle position, in tower reference frame
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XPOS_NACO_RG ! Initial nacelle position, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XPOS_NELT_RG ! Initial nacelle position, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XPOS_NELT_RN ! Initial nacelle position, in nacelle reference frame
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XANGINI_NAC_RT ! Initial nacelle orientation, in tower reference frame
+
+! Hub
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XPOSINI_HUB_RN ! Initial hub position, in nacelle reference frame
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XPOS_HUB_RG ! Current hub position, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XANGINI_HUB_RN ! Initial hub orientation, in nacelle reference frame
+
+! Blade
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XPOSINI_BLA_RH ! Initial blade root position, in hub reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XPOS_BLA_RG ! Current blade root position, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XANGINI_BLA_RH ! Initial blade orientation, in hub reference frame
+
+! Element
+DOUBLE PRECISION, DIMENSION(:,:,:,:), ALLOCATABLE :: XPOS_ELT_RB ! Element position, in blade reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:,:), ALLOCATABLE :: XPOS_ELT_RG ! Element position, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:,:), ALLOCATABLE :: XPOS_SEC_RB ! Section position, in blade reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:,:), ALLOCATABLE :: XPOS_SEC_RG ! Section position, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:,:), ALLOCATABLE :: XANGINI_ELT_RB ! Initial element orientation in blade reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XTWIST_ELT ! Element twist, interpolated from data
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XCHORD_ELT ! Element chord lenght, interpolated from data
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XSURF_ELT ! Element lift surface
+!
+!
+! - STRUCTURAL VELOCITIES -
+! Tower
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XTVEL_TOWO_RG ! Tower base translation velocity, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XTVEL_TELT_RG ! Tower element velocity, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XRVEL_RT_RG ! RT/RG rotational velocity
+
+! Nacelle
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XTVEL_NACO_RT ! Nacelle base translation velocity, in tower reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XTVEL_NELT_RG ! Nacelle element translation velocity, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XRVEL_RN_RT ! RN/RT rotational velocity
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XRVEL_RN_RG ! RN/RG rotational velocity
+
+! Hub
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XTVEL_HUB_RN ! Hub base translation velocity, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XTVEL_HUB_RG ! Hub base translation velocity, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XRVEL_RH_RN ! RH/RN rotational velocity
+DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: XRVEL_RH_RG ! RH/RG rotational velocity
+
+! Blade
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XTVEL_BLA_RH ! Blade base translation velocity, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XTVEL_BLA_RG ! Blade base translation velocity, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XRVEL_RB_RH ! RB/RH rotational velocity
+DOUBLE PRECISION, DIMENSION(:,:,:), ALLOCATABLE :: XRVEL_RB_RG ! RB/RG rotational velocity
+
+! Elements
+DOUBLE PRECISION, DIMENSION(:,:,:,:), ALLOCATABLE :: XTVEL_ELT_RB ! Element base translation velocity, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:,:), ALLOCATABLE :: XTVEL_ELT_RG ! Element base translation velocity, in global reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:,:), ALLOCATABLE :: XTVEL_ELT_RE ! Element base translation velocity, in element reference frame
+DOUBLE PRECISION, DIMENSION(:,:,:,:), ALLOCATABLE :: XRVEL_RE_RB ! RE/RB rotational velocity
+DOUBLE PRECISION, DIMENSION(:,:,:,:), ALLOCATABLE :: XRVEL_RE_RG ! RE/RG rotational velocity
+
+END MODULE MODD_EOL_KINE_ALM
diff --git a/src/MNH/modd_eol_main.f90 b/src/MNH/modd_eol_main.f90
new file mode 100644
index 0000000000000000000000000000000000000000..671d1602adf0e24accb6095af65e27c5f3013e3f
--- /dev/null
+++ b/src/MNH/modd_eol_main.f90
@@ -0,0 +1,55 @@
+!MNH_LIC Copyright 2017-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.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_EOL_MAIN
+!! #####################
+!!
+!!*** *MODD_EOL_MAIN*
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several methods are available. MODD_EOL_MAIN contains all the
+!! main declarations.
+!!
+!!** AUTHOR
+!! ------
+!! PA.Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/01/17
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+USE MODD_PARAMETERS
+!
+!
+! Necessary for each models
+IMPLICIT NONE
+!
+! ------ VARIABLES ------
+!
+! Aerodynamic forces in cartesian mesh
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFX_RG ! Along X in RG frame [F]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFY_RG ! Along Y in RG frame [F]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFZ_RG ! Along Z in RG frame [F]
+! Smeared forces
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFX_SMR_RG ! Along X in RG frame [F]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFY_SMR_RG ! Along Y in RG frame [F]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFZ_SMR_RG ! ALong Z in RG frame [F]
+!
+! Namelist NAM_EOL :
+LOGICAL :: LMAIN_EOL ! Flag to take into account wind turbine
+CHARACTER(LEN=4) :: CMETH_EOL ! Aerodynamic method
+CHARACTER(LEN=4) :: CSMEAR ! Type of smearing
+INTEGER :: NMODEL_EOL ! Son number, where the wind farm is
+!
+END MODULE MODD_EOL_MAIN
diff --git a/src/MNH/modd_eol_shared_io.f90 b/src/MNH/modd_eol_shared_io.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6132fb28f19890e2f30b56539b55735b70f26be6
--- /dev/null
+++ b/src/MNH/modd_eol_shared_io.f90
@@ -0,0 +1,58 @@
+!MNH_LIC Copyright 2020-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.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_EOL_SHARED_IO
+!! #####################
+!!
+!!*** *MODD_EOL_SHARED_IO*
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several models are available.
+!!
+!! MODD_EOL_SHARED_IO contains the declarations for the inputs/output
+!! shared by the differents models.
+!!
+!!
+!!** AUTHOR
+!! ------
+!! PA.Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 17/11/20
+!!
+!-----------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 1. INPUTS VAR
+! ---------------
+!
+! --- Namelistis NAM_EOL_ADNR/NAM_EOL_ALM ---
+! * .csv files
+CHARACTER(LEN=100) :: CFARM_CSVDATA ! Farm file to read
+CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! Turbine file to read
+CHARACTER(LEN=100) :: CBLADE_CSVDATA ! Blade file to read
+CHARACTER(LEN=100) :: CAIRFOIL_CSVDATA ! Airfoil file to read
+! * flags
+CHARACTER(LEN=3) :: CINTERP ! Interpolation method for wind speed
+!
+!
+!* 2. OUTPUTS VAR
+! -----------------
+!
+! --- Thruts torque and power ---
+REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+REAL, DIMENSION(:), ALLOCATABLE :: XTORQT ! Torque [Nm]
+REAL, DIMENSION(:), ALLOCATABLE :: XPOWT ! Power [W]
+REAL, DIMENSION(:), ALLOCATABLE :: XTHRU_SUM ! Sum of thrust (N)
+REAL, DIMENSION(:), ALLOCATABLE :: XTORQ_SUM ! Sum of torque (Nm)
+REAL, DIMENSION(:), ALLOCATABLE :: XPOW_SUM ! Sum of power (W)
+!
+END MODULE MODD_EOL_SHARED_IO
diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90
index 92e3b89c6c4b3def1b0ddbfb90bc0c8bb4687188..2e28feeae0e88d68dc7de3d6d189917ddcc66dfa 100644
--- a/src/MNH/modd_fieldn.f90
+++ b/src/MNH/modd_fieldn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -53,6 +53,8 @@
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 06/03/2019: correct XZWS entry
! P. Wautelet 14/03/2019: add XZWS_DEFAULT parameter
+! S. Riette 04/2020: highLow cloud
+! T. Nagel 02/2021: add fields for turbulence recycling
!!
!-------------------------------------------------------------------------------
!
@@ -88,7 +90,8 @@ TYPE FIELD_t
! (rho e)
! REAL, DIMENSION(:,:,:), POINTER :: XPABST=>NULL() ! absolute pressure at
! ! time t
-! REAL, DIMENSION(:,:,:,:), POINTER :: XRT=>NULL() ! Moist variables (rho Rn)
+! REAL, DIMENSION(:,:,:), POINTER :: XPHIT=>NULL()
+! REAL, DIMENSION(:,:,:,:), POINTER :: XRT=>NULL() ! Moist variables (rho Rn)
! ! at time t
REAL, DIMENSION(:,:,:,:), POINTER :: XRRS=>NULL() ! Source of Moist variables
! (rho Rn)
@@ -110,7 +113,23 @@ TYPE FIELD_t
REAL, DIMENSION(:,:,:), POINTER :: XTHM=>NULL() ! Theta at Previous time step
REAL, DIMENSION(:,:,:), POINTER :: XRCM=>NULL() ! Cloud mixing ratio at Previous time step
REAL, DIMENSION(:,:,:), POINTER :: XPABSM=>NULL() ! Theta at Previous time step
-!
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUNW=>NULL() !U normal velocity fluctuations WEST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVTW=>NULL() !V tangential velocity fluctuations WEST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVNN=>NULL() !V normal velocity fluctuations NORTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUTN=>NULL() !U tangential velocity fluctuations NORTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUNE=>NULL() !U normal velocity fluctuations EAST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVTE=>NULL() !V tangential velocity fluctuations EAST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVNS=>NULL() !V normal velocity fluctuations SOUTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUTS=>NULL() !U tangential velocity fluctuations SOUTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTW=>NULL() !W tangential velocity fluctuations WEST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTN=>NULL() !W tangential velocity fluctuations NORTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTE=>NULL() !W tangential velocity fluctuations EAST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTS=>NULL() !W tangential velocity fluctuations SOUTH boundary
+ REAL, DIMENSION(:,:,:), POINTER :: XHLC_HRC=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XHLC_HCF=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XHLI_HRI=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XHLI_HCF=>NULL()
+ !
END TYPE FIELD_t
TYPE(FIELD_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: FIELD_MODEL
@@ -129,6 +148,7 @@ REAL, DIMENSION(:,:,:), POINTER :: XSSPRO=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTKET=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRTKES=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABST=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XPHIT=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER :: XRT=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER :: XRRS=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER :: XRRS_CLD=>NULL()
@@ -139,6 +159,10 @@ REAL, POINTER :: XDRYMASST=>NULL()
REAL, POINTER :: XDRYMASSS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSRC=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSRCT=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XHLC_HRC=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XHLC_HCF=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XHLI_HRI=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XHLI_HCF=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XSIGS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XCLDFR=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRAINFR=>NULL()
@@ -146,7 +170,9 @@ REAL, DIMENSION(:,:,:), POINTER :: XCIT=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTHM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABSM=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XRCM=>NULL()
-
+REAL, DIMENSION(:,:), POINTER :: XFLUCTUNW=>NULL(),XFLUCTVNN=>NULL(),XFLUCTUTN=>NULL(),XFLUCTVTW=>NULL()
+REAL, DIMENSION(:,:), POINTER :: XFLUCTUNE=>NULL(),XFLUCTVNS=>NULL(),XFLUCTUTS=>NULL(),XFLUCTVTE=>NULL()
+REAL, DIMENSION(:,:), POINTER :: XFLUCTWTW=>NULL(),XFLUCTWTN=>NULL(),XFLUCTWTE=>NULL(),XFLUCTWTS=>NULL()
CONTAINS
SUBROUTINE FIELD_GOTO_MODEL(KFROM, KTO)
@@ -176,6 +202,7 @@ FIELD_MODEL(KFROM)%XRTHS=>XRTHS
!FIELD_MODEL(KFROM)%XTKET=>XTKET !Done in FIELDLIST_GOTO_MODEL
FIELD_MODEL(KFROM)%XRTKES=>XRTKES
!FIELD_MODEL(KFROM)%XPABST=>XPABST !Done in FIELDLIST_GOTO_MODEL
+!FIELD_MODEL(KFROM)%XPHIT=>XPHIT !Done in FIELDLIST_GOTO_MODEL
!FIELD_MODEL(KFROM)%XRT=>XRT !Done in FIELDLIST_GOTO_MODEL
FIELD_MODEL(KFROM)%XRRS=>XRRS
!FIELD_MODEL(KFROM)%XRRS_CLD=>XRRS_CLD !Done in FIELDLIST_GOTO_MODEL
@@ -190,6 +217,22 @@ FIELD_MODEL(KFROM)%XSRC=>XSRC
FIELD_MODEL(KFROM)%XTHM=>XTHM
FIELD_MODEL(KFROM)%XPABSM=>XPABSM
FIELD_MODEL(KFROM)%XRCM=>XRCM
+FIELD_MODEL(KFROM)%XFLUCTUNW=>XFLUCTUNW
+FIELD_MODEL(KFROM)%XFLUCTVNN=>XFLUCTVNN
+FIELD_MODEL(KFROM)%XFLUCTUTN=>XFLUCTUTN
+FIELD_MODEL(KFROM)%XFLUCTVTW=>XFLUCTVTW
+FIELD_MODEL(KFROM)%XFLUCTUNE=>XFLUCTUNE
+FIELD_MODEL(KFROM)%XFLUCTVNS=>XFLUCTVNS
+FIELD_MODEL(KFROM)%XFLUCTUTS=>XFLUCTUTS
+FIELD_MODEL(KFROM)%XFLUCTVTE=>XFLUCTVTE
+FIELD_MODEL(KFROM)%XFLUCTWTW=>XFLUCTWTW
+FIELD_MODEL(KFROM)%XFLUCTWTN=>XFLUCTWTN
+FIELD_MODEL(KFROM)%XFLUCTWTE=>XFLUCTWTE
+FIELD_MODEL(KFROM)%XFLUCTWTS=>XFLUCTWTS
+FIELD_MODEL(KFROM)%XHLC_HRC=>XHLC_HRC
+FIELD_MODEL(KFROM)%XHLC_HCF=>XHLC_HCF
+FIELD_MODEL(KFROM)%XHLI_HRI=>XHLI_HRI
+FIELD_MODEL(KFROM)%XHLI_HCF=>XHLI_HCF
!
! Current model is set to model KTO
!XZWS=>FIELD_MODEL(KTO)%XZWS !Done in FIELDLIST_GOTO_MODEL
@@ -212,6 +255,7 @@ XRTHS=>FIELD_MODEL(KTO)%XRTHS
!XTKET=>FIELD_MODEL(KTO)%XTKET !Done in FIELDLIST_GOTO_MODEL
XRTKES=>FIELD_MODEL(KTO)%XRTKES
!XPABST=>FIELD_MODEL(KTO)%XPABST !Done in FIELDLIST_GOTO_MODEL
+!XPHIT=>FIELD_MODEL(KTO)%XPHIT !Done in FIELDLIST_GOTO_MODEL
!XRT=>FIELD_MODEL(KTO)%XRT !Done in FIELDLIST_GOTO_MODEL
XRRS=>FIELD_MODEL(KTO)%XRRS
!XRRS_CLD=>FIELD_MODEL(KTO)%XRRS_CLD !Done in FIELDLIST_GOTO_MODEL
@@ -228,7 +272,22 @@ XSRC=>FIELD_MODEL(KTO)%XSRC
XTHM=>FIELD_MODEL(KTO)%XTHM
XPABSM=>FIELD_MODEL(KTO)%XPABSM
XRCM=>FIELD_MODEL(KTO)%XRCM
-
+XFLUCTUNW=>FIELD_MODEL(KTO)%XFLUCTUNW
+XFLUCTVNN=>FIELD_MODEL(KTO)%XFLUCTVNN
+XFLUCTUTN=>FIELD_MODEL(KTO)%XFLUCTUTN
+XFLUCTVTW=>FIELD_MODEL(KTO)%XFLUCTVTW
+XFLUCTUNE=>FIELD_MODEL(KTO)%XFLUCTUNE
+XFLUCTVNS=>FIELD_MODEL(KTO)%XFLUCTVNS
+XFLUCTUTS=>FIELD_MODEL(KTO)%XFLUCTUTS
+XFLUCTVTE=>FIELD_MODEL(KTO)%XFLUCTVTE
+XFLUCTWTW=>FIELD_MODEL(KTO)%XFLUCTWTW
+XFLUCTWTN=>FIELD_MODEL(KTO)%XFLUCTWTN
+XFLUCTWTE=>FIELD_MODEL(KTO)%XFLUCTWTE
+XFLUCTWTS=>FIELD_MODEL(KTO)%XFLUCTWTS
+XHLC_HRC=>FIELD_MODEL(KTO)%XHLC_HRC
+XHLC_HCF=>FIELD_MODEL(KTO)%XHLC_HCF
+XHLI_HRI=>FIELD_MODEL(KTO)%XHLI_HRI
+XHLI_HCF=>FIELD_MODEL(KTO)%XHLI_HCF
END SUBROUTINE FIELD_GOTO_MODEL
END MODULE MODD_FIELD_n
diff --git a/src/MNH/modd_frc.f90 b/src/MNH/modd_frc.f90
index a430ad6034fce90152a49a63052db13cb2f87e2b..0627e3f4fcbdfbce2cc1536fc368f73887593acc 100644
--- a/src/MNH/modd_frc.f90
+++ b/src/MNH/modd_frc.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-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.
@@ -45,6 +45,7 @@
!! add SST and surface pressure forcing
!! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -83,7 +84,7 @@ REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTENDVFRC ! large scale V tendency
LOGICAL, SAVE :: LGEOST_UV_FRC ! enables geostrophic wind term
LOGICAL, SAVE :: LGEOST_TH_FRC ! enables thermal wind advection
LOGICAL, SAVE :: LTEND_THRV_FRC ! enables tendency forcing
-LOGICAL, SAVE :: LTEND_UV_FRC ! enables tendency forcing of the wind
+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
@@ -100,5 +101,10 @@ LOGICAL, SAVE :: LTRANS ! enables a Galilean translation of the
! domain of simulation
LOGICAL, SAVE :: LPGROUND_FRC ! enables surf. pressure forcing
!
+LOGICAL, SAVE :: LDEEPOC ! activates sfc forcing for ideal ocean deep conv
+REAL, SAVE :: XCENTX_OC ! center of sfc forc for ideal ocean
+REAL, SAVE :: XRADX_OC ! radius of sfc forc for ideal ocean
+REAL, SAVE :: XCENTY_OC ! center of sfc forc for ideal ocean
+REAL, SAVE :: XRADY_OC ! radius of sfc forc for ideal ocean
!
END MODULE MODD_FRC
diff --git a/src/MNH/modd_getn.f90 b/src/MNH/modd_getn.f90
index bae3402d5f9a9453dbc6f7f0fa706e3755793aa3..f6531c4f82818662547b4332cfd7e6e2559a28f2 100644
--- a/src/MNH/modd_getn.f90
+++ b/src/MNH/modd_getn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$ $Revision$
-! NEC0 masdev4_7 2007/06/16 01:41:59
-!-----------------------------------------------------------------
! #################
MODULE MODD_GET_n
! #################
@@ -53,6 +48,7 @@
!! 05/2006 Remove EPS and LGETALL
!! M. Leriche 04/2010 add get indicators for pH in cloud and rain
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! S. Riette 04/2020 HighLow cloud
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -92,6 +88,7 @@ TYPE GET_t
! CLouD FRaction
CHARACTER (LEN=4) :: CGETSRCT ! Get indicator for SRCM
! and SRCT related to the subgrid condensation
+ CHARACTER (LEN=4) :: CGETHL ! Get indicator for HighLow cloud
CHARACTER (LEN=4) :: CGETCIT ! Get indicator for the
! primary ice concentration
CHARACTER (LEN=4) :: CGETCONV ! Get indicator for the
@@ -127,6 +124,7 @@ CHARACTER (LEN=4), POINTER :: CGETLSTHM=>NULL(), CGETLSRVM=>NULL()
CHARACTER (LEN=4), POINTER :: CGETSIGS=>NULL(),CGETSRC=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCLDFR=>NULL()
CHARACTER (LEN=4), POINTER :: CGETSRCT=>NULL()
+CHARACTER (LEN=4), POINTER :: CGETHL=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCIT=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCONV=>NULL()
CHARACTER (LEN=4), POINTER :: CGETRAD=>NULL()
@@ -181,6 +179,7 @@ CGETSIGS=>GET_MODEL(KTO)%CGETSIGS
CGETSRC=>GET_MODEL(KTO)%CGETSRC
CGETCLDFR=>GET_MODEL(KTO)%CGETCLDFR
CGETSRCT=>GET_MODEL(KTO)%CGETSRCT
+CGETHL=>GET_MODEL(KTO)%CGETHL
CGETCIT=>GET_MODEL(KTO)%CGETCIT
CGETZWS=>GET_MODEL(KTO)%CGETZWS
CGETCONV=>GET_MODEL(KTO)%CGETCONV
diff --git a/src/MNH/modd_ibm_lsf.f90 b/src/MNH/modd_ibm_lsf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..27dfa7d21e5d01cfca424c965a94f4ef6b070afa
--- /dev/null
+++ b/src/MNH/modd_ibm_lsf.f90
@@ -0,0 +1,78 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODD_IBM_LSF
+ ! #######################
+ !
+ !!**** MODD_IBM_LSF_ - declaration of the control parameters
+ !! used in the LSF building
+ !!
+ !! PURPOSE
+ !! -------
+ !!**** The purpose of this declarative module is to declare the constants
+ !! which allow to initialize the embedded fluid-solid interface
+ !!
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !! None
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste (CERFACS-AE)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ USE MODD_PARAMETERS, ONLY: JPMODELMAX
+ !
+ IMPLICIT NONE
+ !
+ TYPE LSF_t
+ !
+ LOGICAL :: LIBM_LSF = .FALSE. ! IBM logical
+ CHARACTER(LEN=4) :: CIBM_TYPE = 'NONE' ! switch generalized/idealized surface
+ INTEGER :: NIBM_SMOOTH = 1 ! smooth levels for LS
+ REAL :: XIBM_SMOOTH = 0.0001 ! smooth weighting
+ !
+ END TYPE LSF_t
+ !
+ TYPE(LSF_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: LSF_MODEL
+ !
+ LOGICAL , POINTER :: LIBM_LSF=>NULL()
+ CHARACTER(LEN=4) , POINTER :: CIBM_TYPE=>NULL()
+ INTEGER , POINTER :: NIBM_SMOOTH=>NULL()
+ REAL , POINTER :: XIBM_SMOOTH=>NULL()
+ !
+CONTAINS
+ !
+ SUBROUTINE LSF_GOTO_MODEL(KFROM, KTO)
+ !
+ INTEGER, INTENT(IN) :: KFROM, KTO
+ !
+ ! Save current state for allocated arrays
+ !
+ ! Current model is set to model KTO
+ LIBM_LSF=>LSF_MODEL(KTO)%LIBM_LSF
+ CIBM_TYPE=>LSF_MODEL(KTO)%CIBM_TYPE
+ XIBM_SMOOTH=>LSF_MODEL(KTO)%XIBM_SMOOTH
+ NIBM_SMOOTH=>LSF_MODEL(KTO)%NIBM_SMOOTH
+ !
+ END SUBROUTINE LSF_GOTO_MODEL
+ !
+END MODULE MODD_IBM_LSF
+!
+
diff --git a/src/MNH/modd_ibm_paramn.f90 b/src/MNH/modd_ibm_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..642abc204a3d1a3a68f20e35eb4e4840cfe9e276
--- /dev/null
+++ b/src/MNH/modd_ibm_paramn.f90
@@ -0,0 +1,325 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODD_IBM_PARAM_n
+ ! #######################
+ !
+ !**** MODD_IBM_PARAM_n - declaration of the control parameters
+ ! used in the immersed boundary method
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this declarative module is to declare the constants
+ ! which allow to initialize the embedded surface
+ !
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! None
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !----------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ USE MODD_PARAMETERS, ONLY: JPMODELMAX
+ IMPLICIT NONE
+ !
+ TYPE IBM_t
+ !
+ LOGICAL :: LIBM,LIBM_TROUBLE ! IBM logical
+ CHARACTER(LEN=6) :: CIBM_ADV ! GCT switch
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE1_P,CIBM_MODE_INTE1_Q,CIBM_MODE_INTE1_R,CIBM_MODE_INTE1_S ! 1D interpolation type
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE1_T,CIBM_MODE_INTE1_E
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE1NV,CIBM_MODE_INTE1TV,CIBM_MODE_INTE1CV
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE3_P,CIBM_MODE_INTE3_Q,CIBM_MODE_INTE3_R,CIBM_MODE_INTE3_S ! 3D interpolation type
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE3_T,CIBM_MODE_INTE3_E,CIBM_MODE_INTE3_V
+ CHARACTER(LEN=3) :: CIBM_TYPE_BOUND_P,CIBM_TYPE_BOUND_Q,CIBM_TYPE_BOUND_R,CIBM_TYPE_BOUND_S ! Boundary interpolation type
+ CHARACTER(LEN=3) :: CIBM_TYPE_BOUND_T,CIBM_TYPE_BOUND_E
+ CHARACTER(LEN=3) :: CIBM_MODE_BOUND_P,CIBM_MODE_BOUND_Q,CIBM_MODE_BOUND_R,CIBM_MODE_BOUND_S ! Boundary interpolation type
+ CHARACTER(LEN=3) :: CIBM_MODE_BOUND_T,CIBM_MODE_BOUND_E
+ CHARACTER(LEN=3) :: CIBM_FORC_BOUND_P,CIBM_FORC_BOUND_Q,CIBM_FORC_BOUND_R,CIBM_FORC_BOUND_S ! Boundary interpolation type
+ CHARACTER(LEN=3) :: CIBM_FORC_BOUND_T,CIBM_FORC_BOUND_E
+ REAL :: XIBM_FORC_BOUND_P,XIBM_FORC_BOUND_Q,XIBM_FORC_BOUND_R,XIBM_FORC_BOUND_S ! Boundary interpolation type
+ REAL :: XIBM_FORC_BOUND_T,XIBM_FORC_BOUND_E
+ CHARACTER(LEN=3) :: CIBM_TYPE_BOUNN_V,CIBM_TYPE_BOUNT_V,CIBM_TYPE_BOUNC_V ! BI type (velocity)
+ CHARACTER(LEN=3) :: CIBM_MODE_BOUNN_V,CIBM_MODE_BOUNT_V,CIBM_MODE_BOUNC_V
+ CHARACTER(LEN=3) :: CIBM_FORC_BOUNN_V,CIBM_FORC_BOUNT_V,CIBM_FORC_BOUNC_V,CIBM_FORC_BOUNR_V
+ REAL :: XIBM_FORC_BOUNN_V,XIBM_FORC_BOUNT_V,XIBM_FORC_BOUNC_V
+ REAL :: XIBM_RADIUS_P,XIBM_RADIUS_Q,XIBM_RADIUS_R,XIBM_RADIUS_S ! radius of IDW,MDW
+ REAL :: XIBM_RADIUS_T,XIBM_RADIUS_E,XIBM_RADIUS_V
+ REAL :: XIBM_POWERS_P,XIBM_POWERS_Q,XIBM_POWERS_R,XIBM_POWERS_S ! power of IDW,MDW
+ REAL :: XIBM_POWERS_T,XIBM_POWERS_E,XIBM_POWERS_V
+ INTEGER :: NIBM_LAYER_V,NIBM_LAYER_T,NIBM_LAYER_P,NIBM_LAYER_R ! layers number in each type
+ INTEGER :: NIBM_LAYER_E,NIBM_LAYER_Q,NIBM_LAYER_S
+ INTEGER :: NIBM_ITR ! maximum iteration in pressure solver
+ REAL :: XIBM_RUG ,XIBM_VISC, XIBM_CNU ! physical parameters for wall model
+ REAL :: XIBM_EPSI ! min truncation parameters
+ REAL :: XIBM_IEPS ! max truncation parameters
+ !
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_XMUT=>NULL() ! turbulent viscosity
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_CURV=>NULL() ! parameter for interface curvature
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_LS=>NULL() ! LSF for MNH
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SU=>NULL() ! volume fraction based on LSF
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SUTR=>NULL() ! volume fraction based on LSF if trouble
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_P=>NULL() ! Ghosts,Images location/Index
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:), POINTER :: NIBM_IMAGE_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:), POINTER :: NIBM_IMAGE_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_V=>NULL()
+ !
+ END TYPE IBM_t
+ !
+ TYPE(IBM_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: IBM_MODEL
+ !
+ LOGICAL , POINTER :: LIBM=>NULL()
+ LOGICAL , POINTER :: LIBM_TROUBLE=>NULL()
+ CHARACTER(LEN=6), POINTER :: CIBM_ADV=>NULL()
+ REAL , POINTER :: XIBM_EPSI=>NULL()
+ REAL , POINTER :: XIBM_IEPS=>NULL()
+ INTEGER , POINTER :: NIBM_ITR=>NULL()
+ !
+ INTEGER, POINTER :: NIBM_LAYER_P=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_Q=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_R=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_S=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_T=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_V=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_E=>NULL()
+ !
+ REAL, POINTER :: XIBM_RADIUS_P=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_Q=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_R=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_S=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_T=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_E=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_V=>NULL()
+ REAL, POINTER :: XIBM_POWERS_P=>NULL()
+ REAL, POINTER :: XIBM_POWERS_Q=>NULL()
+ REAL, POINTER :: XIBM_POWERS_R=>NULL()
+ REAL, POINTER :: XIBM_POWERS_S=>NULL()
+ REAL, POINTER :: XIBM_POWERS_T=>NULL()
+ REAL, POINTER :: XIBM_POWERS_E=>NULL()
+ REAL, POINTER :: XIBM_POWERS_V=>NULL()
+ !
+ REAL, POINTER :: XIBM_FORC_BOUNN_V=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUNT_V=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUNC_V=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_P=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_Q=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_R=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_S=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_T=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_E=>NULL()
+ !
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1NV=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1TV=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1CV=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUNN_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUNN_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUNT_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUNT_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUNC_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUNC_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNN_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNR_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNT_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNC_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_E=>NULL()
+ !
+ REAL, POINTER :: XIBM_RUG=>NULL()
+ REAL, POINTER :: XIBM_VISC=>NULL()
+ REAL, POINTER :: XIBM_CNU=>NULL()
+ !
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_XMUT=>NULL()
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_CURV=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_LS=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SU=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SUTR=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_P=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:) , POINTER :: NIBM_IMAGE_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:) , POINTER :: NIBM_IMAGE_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_V=>NULL()
+ !
+CONTAINS
+ !
+ SUBROUTINE IBM_GOTO_MODEL(KFROM, KTO)
+ !
+ INTEGER, INTENT(IN) :: KFROM, KTO
+ !
+ ! Save current state for allocated arrays
+ IBM_MODEL(KFROM)%XIBM_XMUT=>XIBM_XMUT
+ IBM_MODEL(KFROM)%XIBM_CURV=>XIBM_CURV
+ IBM_MODEL(KFROM)%XIBM_LS=>XIBM_LS
+ IBM_MODEL(KFROM)%XIBM_SU=>XIBM_SU
+ IBM_MODEL(KFROM)%XIBM_GHOST_P=>XIBM_GHOST_P
+ IBM_MODEL(KFROM)%XIBM_GHOST_V=>XIBM_GHOST_V
+ IBM_MODEL(KFROM)%XIBM_GHOST_P=>XIBM_GHOST_P
+ IBM_MODEL(KFROM)%XIBM_GHOST_V=>XIBM_GHOST_V
+ IBM_MODEL(KFROM)%NIBM_IMAGE_P=>NIBM_IMAGE_P
+ IBM_MODEL(KFROM)%NIBM_IMAGE_V=>NIBM_IMAGE_V
+ IBM_MODEL(KFROM)%NIBM_IMAGE_P=>NIBM_IMAGE_P
+ IBM_MODEL(KFROM)%NIBM_IMAGE_V=>NIBM_IMAGE_V
+ IBM_MODEL(KFROM)%XIBM_TESTI_P=>XIBM_TESTI_P
+ IBM_MODEL(KFROM)%XIBM_TESTI_V=>XIBM_TESTI_V
+ !
+ ! Current model is set to model KTO
+ LIBM=>IBM_MODEL(KTO)%LIBM
+ LIBM_TROUBLE=>IBM_MODEL(KTO)%LIBM_TROUBLE
+ CIBM_ADV=>IBM_MODEL(KTO)%CIBM_ADV
+ XIBM_EPSI=>IBM_MODEL(KTO)%XIBM_EPSI
+ XIBM_IEPS=>IBM_MODEL(KTO)%XIBM_IEPS
+ XIBM_RUG=>IBM_MODEL(KTO)%XIBM_RUG
+ XIBM_VISC=>IBM_MODEL(KTO)%XIBM_VISC
+ XIBM_CNU=>IBM_MODEL(KTO)%XIBM_CNU
+ NIBM_ITR=>IBM_MODEL(KTO)%NIBM_ITR
+ NIBM_LAYER_E=>IBM_MODEL(KTO)%NIBM_LAYER_E
+ NIBM_LAYER_P=>IBM_MODEL(KTO)%NIBM_LAYER_P
+ NIBM_LAYER_Q=>IBM_MODEL(KTO)%NIBM_LAYER_Q
+ NIBM_LAYER_R=>IBM_MODEL(KTO)%NIBM_LAYER_R
+ NIBM_LAYER_S=>IBM_MODEL(KTO)%NIBM_LAYER_S
+ NIBM_LAYER_T=>IBM_MODEL(KTO)%NIBM_LAYER_T
+ NIBM_LAYER_V=>IBM_MODEL(KTO)%NIBM_LAYER_V
+ XIBM_XMUT=>IBM_MODEL(KTO)%XIBM_XMUT
+ XIBM_CURV=>IBM_MODEL(KTO)%XIBM_CURV
+ XIBM_LS=>IBM_MODEL(KTO)%XIBM_LS
+ XIBM_SU=>IBM_MODEL(KTO)%XIBM_SU
+ XIBM_SUTR=>IBM_MODEL(KTO)%XIBM_SUTR
+ XIBM_GHOST_P=>IBM_MODEL(KTO)%XIBM_GHOST_P
+ XIBM_GHOST_V=>IBM_MODEL(KTO)%XIBM_GHOST_V
+ NIBM_GHOST_P=>IBM_MODEL(KTO)%NIBM_GHOST_P
+ NIBM_GHOST_V=>IBM_MODEL(KTO)%NIBM_GHOST_V
+ XIBM_IMAGE_P=>IBM_MODEL(KTO)%XIBM_IMAGE_P
+ XIBM_IMAGE_V=>IBM_MODEL(KTO)%XIBM_IMAGE_V
+ NIBM_IMAGE_P=>IBM_MODEL(KTO)%NIBM_IMAGE_P
+ NIBM_IMAGE_V=>IBM_MODEL(KTO)%NIBM_IMAGE_V
+ XIBM_TESTI_P=>IBM_MODEL(KTO)%XIBM_TESTI_P
+ XIBM_TESTI_V=>IBM_MODEL(KTO)%XIBM_TESTI_V
+ XIBM_RADIUS_P=>IBM_MODEL(KTO)%XIBM_RADIUS_P
+ XIBM_POWERS_P=>IBM_MODEL(KTO)%XIBM_POWERS_P
+ XIBM_RADIUS_Q=>IBM_MODEL(KTO)%XIBM_RADIUS_Q
+ XIBM_POWERS_Q=>IBM_MODEL(KTO)%XIBM_POWERS_Q
+ XIBM_RADIUS_R=>IBM_MODEL(KTO)%XIBM_RADIUS_R
+ XIBM_POWERS_R=>IBM_MODEL(KTO)%XIBM_POWERS_R
+ XIBM_RADIUS_S=>IBM_MODEL(KTO)%XIBM_RADIUS_S
+ XIBM_POWERS_S=>IBM_MODEL(KTO)%XIBM_POWERS_S
+ XIBM_RADIUS_T=>IBM_MODEL(KTO)%XIBM_RADIUS_T
+ XIBM_POWERS_T=>IBM_MODEL(KTO)%XIBM_POWERS_T
+ XIBM_RADIUS_E=>IBM_MODEL(KTO)%XIBM_RADIUS_E
+ XIBM_POWERS_E=>IBM_MODEL(KTO)%XIBM_POWERS_E
+ XIBM_RADIUS_V=>IBM_MODEL(KTO)%XIBM_RADIUS_V
+ XIBM_POWERS_V=>IBM_MODEL(KTO)%XIBM_POWERS_V
+ XIBM_FORC_BOUND_P => IBM_MODEL(KTO)%XIBM_FORC_BOUND_P
+ XIBM_FORC_BOUND_Q => IBM_MODEL(KTO)%XIBM_FORC_BOUND_Q
+ XIBM_FORC_BOUND_R => IBM_MODEL(KTO)%XIBM_FORC_BOUND_R
+ XIBM_FORC_BOUND_S => IBM_MODEL(KTO)%XIBM_FORC_BOUND_S
+ XIBM_FORC_BOUND_T => IBM_MODEL(KTO)%XIBM_FORC_BOUND_T
+ XIBM_FORC_BOUND_E => IBM_MODEL(KTO)%XIBM_FORC_BOUND_E
+ XIBM_FORC_BOUNN_V => IBM_MODEL(KTO)%XIBM_FORC_BOUNN_V
+ XIBM_FORC_BOUNT_V => IBM_MODEL(KTO)%XIBM_FORC_BOUNT_V
+ XIBM_FORC_BOUNC_V => IBM_MODEL(KTO)%XIBM_FORC_BOUNC_V
+ CIBM_MODE_INTE1_P => IBM_MODEL(KTO)%CIBM_MODE_INTE1_P
+ CIBM_MODE_INTE3_P => IBM_MODEL(KTO)%CIBM_MODE_INTE3_P
+ CIBM_MODE_BOUND_P => IBM_MODEL(KTO)%CIBM_MODE_BOUND_P
+ CIBM_TYPE_BOUND_P => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_P
+ CIBM_MODE_INTE1_Q => IBM_MODEL(KTO)%CIBM_MODE_INTE1_Q
+ CIBM_MODE_INTE3_Q => IBM_MODEL(KTO)%CIBM_MODE_INTE3_Q
+ CIBM_MODE_BOUND_Q => IBM_MODEL(KTO)%CIBM_MODE_BOUND_Q
+ CIBM_TYPE_BOUND_Q => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_Q
+ CIBM_MODE_INTE1_R => IBM_MODEL(KTO)%CIBM_MODE_INTE1_R
+ CIBM_MODE_INTE3_R => IBM_MODEL(KTO)%CIBM_MODE_INTE3_R
+ CIBM_MODE_BOUND_R => IBM_MODEL(KTO)%CIBM_MODE_BOUND_R
+ CIBM_TYPE_BOUND_R => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_R
+ CIBM_MODE_INTE1_S => IBM_MODEL(KTO)%CIBM_MODE_INTE1_S
+ CIBM_MODE_INTE3_S => IBM_MODEL(KTO)%CIBM_MODE_INTE3_S
+ CIBM_MODE_BOUND_S => IBM_MODEL(KTO)%CIBM_MODE_BOUND_S
+ CIBM_TYPE_BOUND_S => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_S
+ CIBM_MODE_INTE1_T => IBM_MODEL(KTO)%CIBM_MODE_INTE1_T
+ CIBM_MODE_INTE3_T => IBM_MODEL(KTO)%CIBM_MODE_INTE3_T
+ CIBM_MODE_BOUND_T => IBM_MODEL(KTO)%CIBM_MODE_BOUND_T
+ CIBM_TYPE_BOUND_T => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_T
+ CIBM_MODE_INTE1_E => IBM_MODEL(KTO)%CIBM_MODE_INTE1_E
+ CIBM_MODE_INTE3_E => IBM_MODEL(KTO)%CIBM_MODE_INTE3_E
+ CIBM_MODE_BOUND_E => IBM_MODEL(KTO)%CIBM_MODE_BOUND_E
+ CIBM_TYPE_BOUND_E => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_E
+ CIBM_MODE_INTE1NV => IBM_MODEL(KTO)%CIBM_MODE_INTE1NV
+ CIBM_MODE_INTE1TV => IBM_MODEL(KTO)%CIBM_MODE_INTE1TV
+ CIBM_MODE_INTE1CV => IBM_MODEL(KTO)%CIBM_MODE_INTE1CV
+ CIBM_MODE_INTE3_V => IBM_MODEL(KTO)%CIBM_MODE_INTE3_V
+ CIBM_MODE_BOUNN_V => IBM_MODEL(KTO)%CIBM_MODE_BOUNN_V
+ CIBM_TYPE_BOUNN_V => IBM_MODEL(KTO)%CIBM_TYPE_BOUNN_V
+ CIBM_MODE_BOUNT_V => IBM_MODEL(KTO)%CIBM_MODE_BOUNT_V
+ CIBM_TYPE_BOUNT_V => IBM_MODEL(KTO)%CIBM_TYPE_BOUNT_V
+ CIBM_MODE_BOUNC_V => IBM_MODEL(KTO)%CIBM_MODE_BOUNC_V
+ CIBM_TYPE_BOUNC_V => IBM_MODEL(KTO)%CIBM_TYPE_BOUNC_V
+ CIBM_FORC_BOUNN_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNN_V
+ CIBM_FORC_BOUNR_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNR_V
+ CIBM_FORC_BOUNT_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNT_V
+ CIBM_FORC_BOUNC_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNC_V
+ CIBM_FORC_BOUND_P => IBM_MODEL(KTO)%CIBM_FORC_BOUND_P
+ CIBM_FORC_BOUND_Q => IBM_MODEL(KTO)%CIBM_FORC_BOUND_Q
+ CIBM_FORC_BOUND_R => IBM_MODEL(KTO)%CIBM_FORC_BOUND_R
+ CIBM_FORC_BOUND_S => IBM_MODEL(KTO)%CIBM_FORC_BOUND_S
+ CIBM_FORC_BOUND_T => IBM_MODEL(KTO)%CIBM_FORC_BOUND_T
+ CIBM_FORC_BOUND_E => IBM_MODEL(KTO)%CIBM_FORC_BOUND_E
+ !
+ END SUBROUTINE IBM_GOTO_MODEL
+ !
+END MODULE MODD_IBM_PARAM_n
+!
diff --git a/src/MNH/modd_mean_fieldn.f90 b/src/MNH/modd_mean_fieldn.f90
index 0bf49a62dd62c1e4cf4f52d8f5ea45cebf83e27c..38572bc0bb2cb8f50ea1bc4cd4352100af779c84 100644
--- a/src/MNH/modd_mean_fieldn.f90
+++ b/src/MNH/modd_mean_fieldn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-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 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/Attic/modd_mean_fieldn.f90,v $ $Revision: 1.1.2.1.12.1 $
-! MASDEV4_7 modd 2006/06/27 14:17:24
-!-----------------------------------------------------------------
! ###################
MODULE MODD_MEAN_FIELD_n
! ###################
@@ -51,8 +46,9 @@ TYPE MEAN_FIELD_t
REAL, DIMENSION(:,:,:), POINTER :: XTEMPM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTKEM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABSM_MEAN=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XSVT_MEAN=>NULL()
- REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL(),XUW_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTH2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTEMP2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABS2_MEAN=>NULL()
@@ -76,8 +72,9 @@ REAL, DIMENSION(:,:,:), POINTER :: XTHM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTEMPM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTKEM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABSM_MEAN=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSVT_MEAN=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL(),XUW_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTH2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTEMP2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABS2_MEAN=>NULL()
@@ -103,6 +100,7 @@ MEAN_FIELD_MODEL(KFROM)%XTHM_MEAN=>XTHM_MEAN
MEAN_FIELD_MODEL(KFROM)%XTEMPM_MEAN=>XTEMPM_MEAN
MEAN_FIELD_MODEL(KFROM)%XTKEM_MEAN=>XTKEM_MEAN
MEAN_FIELD_MODEL(KFROM)%XPABSM_MEAN=>XPABSM_MEAN
+MEAN_FIELD_MODEL(KFROM)%XSVT_MEAN=>XSVT_MEAN
MEAN_FIELD_MODEL(KFROM)%XUM_MAX=>XUM_MAX
MEAN_FIELD_MODEL(KFROM)%XVM_MAX=>XVM_MAX
@@ -115,6 +113,7 @@ MEAN_FIELD_MODEL(KFROM)%XPABSM_MAX=>XPABSM_MAX
MEAN_FIELD_MODEL(KFROM)%XU2_MEAN=>XU2_MEAN
MEAN_FIELD_MODEL(KFROM)%XV2_MEAN=>XV2_MEAN
MEAN_FIELD_MODEL(KFROM)%XW2_MEAN=>XW2_MEAN
+MEAN_FIELD_MODEL(KFROM)%XUW_MEAN=>XUW_MEAN
MEAN_FIELD_MODEL(KFROM)%XTH2_MEAN=>XTH2_MEAN
MEAN_FIELD_MODEL(KFROM)%XTEMP2_MEAN=>XTEMP2_MEAN
MEAN_FIELD_MODEL(KFROM)%XPABS2_MEAN=>XPABS2_MEAN
@@ -128,6 +127,7 @@ XTHM_MEAN=>MEAN_FIELD_MODEL(KTO)%XTHM_MEAN
XTEMPM_MEAN=>MEAN_FIELD_MODEL(KTO)%XTEMPM_MEAN
XTKEM_MEAN=>MEAN_FIELD_MODEL(KTO)%XTKEM_MEAN
XPABSM_MEAN=>MEAN_FIELD_MODEL(KTO)%XPABSM_MEAN
+XSVT_MEAN=>MEAN_FIELD_MODEL(KTO)%XSVT_MEAN
XUM_MAX=>MEAN_FIELD_MODEL(KTO)%XUM_MAX
XVM_MAX=>MEAN_FIELD_MODEL(KTO)%XVM_MAX
@@ -140,6 +140,7 @@ XPABSM_MAX=>MEAN_FIELD_MODEL(KTO)%XPABSM_MAX
XU2_MEAN=>MEAN_FIELD_MODEL(KTO)%XU2_MEAN
XV2_MEAN=>MEAN_FIELD_MODEL(KTO)%XV2_MEAN
XW2_MEAN=>MEAN_FIELD_MODEL(KTO)%XW2_MEAN
+XUW_MEAN=>MEAN_FIELD_MODEL(KTO)%XUW_MEAN
XTH2_MEAN=>MEAN_FIELD_MODEL(KTO)%XTH2_MEAN
XTEMP2_MEAN=>MEAN_FIELD_MODEL(KTO)%XTEMP2_MEAN
XPABS2_MEAN=>MEAN_FIELD_MODEL(KTO)%XPABS2_MEAN
diff --git a/src/MNH/modd_nsv.f90 b/src/MNH/modd_nsv.f90
index 50e18d615472d2eed88be9656218996d6b2c0f08..7a842a5c1cacb3073ca3daa6139f327c1ed1543e 100644
--- a/src/MNH/modd_nsv.f90
+++ b/src/MNH/modd_nsv.f90
@@ -29,6 +29,8 @@
!! Modification 01/2016 (JP Pinty) Add LIMA
!! V. Vionnet 07/17 add blowing snow
! P. Wautelet 10/03/2021: add CSVNAMES and CSVNAMES_A to store the name of all the scalar variables
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -133,6 +135,7 @@ INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_FREE_A = 0 ! First Free IFN conc.
INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IFN_NUCL_A = 0 ! First Nucl. IFN conc.
INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_IMM_NUCL_A = 0 ! First Nucl. IMM conc.
INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_HOM_HAZE_A = 0 ! Hom. freezing of CCN
+INTEGER,DIMENSION(JPMODELMAX)::NSV_LIMA_SPRO_A = 0 ! Supersaturation
!
#ifdef MNH_FOREFIRE
INTEGER,DIMENSION(JPMODELMAX)::NSV_FF_A = 0 ! number of ForeFire scalar variables
@@ -235,6 +238,7 @@ INTEGER :: NSV_LIMA_IFN_FREE !
INTEGER :: NSV_LIMA_IFN_NUCL !
INTEGER :: NSV_LIMA_IMM_NUCL !
INTEGER :: NSV_LIMA_HOM_HAZE !
+INTEGER :: NSV_LIMA_SPRO !
!
#ifdef MNH_FOREFIRE
INTEGER :: NSV_FF = 0 ! number of ForeFire scalar variables
diff --git a/src/MNH/modd_oceanh.f90 b/src/MNH/modd_oceanh.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e9936173ec35b1d57c9884cd19cd98774c9d0334
--- /dev/null
+++ b/src/MNH/modd_oceanh.f90
@@ -0,0 +1,47 @@
+!MNH_LIC Copyright 2021-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.
+!-----------------------------------------------------------------
+! #################
+ MODULE MODD_OCEANH
+! #################
+!
+!!**** *MODD_OCEAN* - declaration of variables used in ocean version
+!!
+!! PURPOSE
+!! -------
+! Declarative module for the variables
+!! at interface for OCEAN LES MESONH version including auto-coupling O-A LES
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! AUTHOR
+!! ------
+!! JL Redelsperger LOPS
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 03/2021
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_TYPE_DATE
+!
+IMPLICIT NONE
+!
+!* fields for Sea Sfc FORCINGs
+! ------------------
+!
+INTEGER, SAVE :: NFRCLT ! number of sea surface forcings PLUS 1
+INTEGER, SAVE :: NINFRT ! Interval in second between forcings
+TYPE (DATE_TIME), SAVE, DIMENSION(:), ALLOCATABLE :: TFRCLT ! date/time of sea surface forcings
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XSSUFL,XSSVFL,XSSTFL,XSSOLA ! Time evol Flux U V T Solar_Rad at sea surface
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XSSUFL_XY,XSSVFL_XY,XSSTFL_XY! XY flux shape
+REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XSSUFL_T,XSSVFL_T,XSSTFL_T,XSSOLA_T ! given time forcing fluxes
+!
+END MODULE MODD_OCEANH
diff --git a/src/MNH/modd_param_lima.f90 b/src/MNH/modd_param_lima.f90
index 6245699483a7465fafd690f360a99197229a0ef6..66156a05620e98e2662a314f7338b2453cdb5e51 100644
--- a/src/MNH/modd_param_lima.f90
+++ b/src/MNH/modd_param_lima.f90
@@ -1,3 +1,8 @@
+!MNH_LIC Copyright 2013-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.
+!-------------------------------------------------------------------------------
! ######################
MODULE MODD_PARAM_LIMA
! ######################
@@ -126,6 +131,8 @@ LOGICAL, SAVE :: LBOUND ! TRUE to enable the continuously replenishing
! lateral boundaries -> boundaries.f90
LOGICAL, SAVE :: LDEPOC ! Deposition of rc at 1st level above ground
LOGICAL, SAVE :: LACTTKE ! TRUE to take into account TKE in W for activation
+LOGICAL, SAVE :: LADJ ! TRUE for adjustment procedure + Smax (false for diagnostic supersaturation)
+LOGICAL, SAVE :: LSPRO ! TRUE for prognostic supersaturation
!
! 2.2 CCN initialisation
!
@@ -151,7 +158,7 @@ REAL,SAVE :: XALPHAR,XNUR, & ! Raindrop distribution parameters
!
CHARACTER(LEN=3),SAVE :: HPARAM_CCN = 'CPB' ! Parameterization of the CCN activation
CHARACTER(LEN=3),SAVE :: HINI_CCN ! Initialization type of CCN activation
-CHARACTER(LEN=1),DIMENSION(JPLIMACCNMAX),SAVE :: HTYPE_CCN ! 'M' or 'C' CCN type
+CHARACTER(LEN=10),DIMENSION(JPLIMACCNMAX),SAVE :: HTYPE_CCN ! 'M' or 'C' CCN type
REAL,SAVE :: XFSOLUB_CCN, & ! Fractionnal solubility of the CCN
XACTEMP_CCN, & ! Expected temperature of CCN activation
XAERDIFF, XAERHEIGHT ! For the vertical gradient of aerosol distribution
diff --git a/src/MNH/modd_param_lima_warm.f90 b/src/MNH/modd_param_lima_warm.f90
index 4d20c978934e33e1e4f0d8251f4c86a8062f5e8e..65a3d10279364cb382048f19ed657c7eca2d2c39 100644
--- a/src/MNH/modd_param_lima_warm.f90
+++ b/src/MNH/modd_param_lima_warm.f90
@@ -36,12 +36,12 @@ REAL,SAVE :: XAR,XBR,XCR,XDR,XF0R,XF1R, & ! Raindrop charact.
XAC,XBC,XCC,XDC,XF0C,XF2C,XC1C ! Cloud droplet charact.
!
!
-CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(4),PARAMETER &
- :: CLIMA_WARM_NAMES=(/'CCLOUD ','CRAIN ','CCCNFREE','CCCNACTI'/)
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
+ :: CLIMA_WARM_NAMES=(/'CCLOUD ','CRAIN ','CCCNFREE','CCCNACTI','SPRO '/)
! basenames of the SV articles stored
! in the binary files
-CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(4),PARAMETER &
- :: CLIMA_WARM_CONC=(/'NC ','NR ','NFREE','NCCN '/)
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
+ :: CLIMA_WARM_CONC=(/'NC ','NR ','NFREE','NCCN ','SS '/)
! ! basenames of the SV articles stored
! ! in the binary files for DIAG
!
@@ -76,7 +76,7 @@ INTEGER, SAVE :: NAHEN ! Number of value of the AHEN
REAL,SAVE :: XAHENINTP1, XAHENINTP2 ! Factors defining the
! temperatures in lin scale
REAL, DIMENSION(:), SAVE, ALLOCATABLE & !
- :: XAHENG,XPSI1, XPSI3, & ! Twomey-CPB98 and
+ :: XAHENG,XAHENG2,XAHENG3,XPSI1, XPSI3, & ! Twomey-CPB98 and
XAHENF,XAHENY ! Feingold-Heymsfield
! parameterization to compute Smax
REAL,SAVE :: XWCOEF_F1, XWCOEF_F2, XWCOEF_F3, & ! COEF_F of the polynomial temp.
diff --git a/src/MNH/modd_recycl_paramn.f90 b/src/MNH/modd_recycl_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bfc4d7b3e7d1c7c605b745dc00316ea44705f280
--- /dev/null
+++ b/src/MNH/modd_recycl_paramn.f90
@@ -0,0 +1,169 @@
+!MNH_LIC Copyright 2021-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.
+!-----------------------------------------------------------------
+!
+! #######################
+ MODULE MODD_RECYCL_PARAM_n
+! #######################
+!
+!**** MODD_RECYCL_PARAM_n - declaration of the control parameters
+! used in the turbulence recycling method
+!
+! PURPOSE
+! -------
+!**** The purpose of this module is to declare the constants
+! allowing to initialize the turbulence recycling method
+!
+!
+! IMPLICIT ARGUMENTS
+! ------------------
+! None
+!
+! REFERENCE
+! ---------
+!
+! AUTHOR
+! ------
+! Tim Nagel (Meteo-France)
+!
+! MODIFICATIONS
+! -------------
+! Original 01/02/2021
+!
+!------------------------------------------------------------------------------
+!
+!**** 0. DECLARATIONS
+! ---------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+!
+TYPE RECYCL_t
+!
+LOGICAL :: LRECYCL,LRECYCLN,LRECYCLW,LRECYCLE,LRECYCLS ! Recycling logical
+REAL :: XDRECYCLN,XDRECYCLW,XDRECYCLE,XDRECYCLS, &
+ XARECYCLN,XARECYCLW,XARECYCLE,XARECYCLS, &
+ XTMOY,XTMOYCOUNT,XNUMBELT,XRCOEFF,XTBVTOP,XTBVBOT
+
+INTEGER :: NR_COUNT
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANW=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANW=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANW=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANN=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANN=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANN=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANE=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANE=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANE=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANS=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANS=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANS=>NULL()
+!
+END TYPE RECYCL_t
+
+TYPE(RECYCL_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: RECYCL_MODEL
+
+LOGICAL ,POINTER :: LRECYCL=>NULL()
+LOGICAL ,POINTER :: LRECYCLN=>NULL()
+LOGICAL ,POINTER :: LRECYCLW=>NULL()
+LOGICAL ,POINTER :: LRECYCLE=>NULL()
+LOGICAL ,POINTER :: LRECYCLS=>NULL()
+
+REAL ,POINTER :: XDRECYCLN=>NULL()
+REAL ,POINTER :: XARECYCLN=>NULL()
+REAL ,POINTER :: XDRECYCLW=>NULL()
+REAL ,POINTER :: XARECYCLW=>NULL()
+REAL ,POINTER :: XDRECYCLE=>NULL()
+REAL ,POINTER :: XARECYCLE=>NULL()
+REAL ,POINTER :: XDRECYCLS=>NULL()
+REAL ,POINTER :: XARECYCLS=>NULL()
+REAL ,POINTER :: XTMOY=>NULL()
+REAL ,POINTER :: XTMOYCOUNT=>NULL()
+REAL ,POINTER :: XNUMBELT=>NULL()
+REAL ,POINTER :: XRCOEFF=>NULL()
+REAL ,POINTER :: XTBVTOP=>NULL()
+REAL ,POINTER :: XTBVBOT=>NULL()
+
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANW=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANW=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANW=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANN=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANN=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANN=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANE=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANE=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANE=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANS=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANS=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANS=>NULL()
+
+
+
+INTEGER ,POINTER :: NR_COUNT =>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XTBV=>NULL()
+
+CONTAINS
+
+SUBROUTINE RECYCL_GOTO_MODEL(KFROM, KTO)
+
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+RECYCL_MODEL(KFROM)%XUMEANW=>XUMEANW
+RECYCL_MODEL(KFROM)%XVMEANW=>XVMEANW
+RECYCL_MODEL(KFROM)%XWMEANW=>XWMEANW
+RECYCL_MODEL(KFROM)%XUMEANN=>XUMEANN
+RECYCL_MODEL(KFROM)%XVMEANN=>XVMEANN
+RECYCL_MODEL(KFROM)%XWMEANN=>XWMEANN
+RECYCL_MODEL(KFROM)%XUMEANE=>XUMEANE
+RECYCL_MODEL(KFROM)%XVMEANE=>XVMEANE
+RECYCL_MODEL(KFROM)%XWMEANE=>XWMEANE
+RECYCL_MODEL(KFROM)%XUMEANS=>XUMEANS
+RECYCL_MODEL(KFROM)%XVMEANS=>XVMEANS
+RECYCL_MODEL(KFROM)%XWMEANS=>XWMEANS
+
+
+!
+! Current model is set to model KTO
+LRECYCL=>RECYCL_MODEL(KTO)%LRECYCL
+LRECYCLN=>RECYCL_MODEL(KTO)%LRECYCLN
+LRECYCLW=>RECYCL_MODEL(KTO)%LRECYCLW
+LRECYCLE=>RECYCL_MODEL(KTO)%LRECYCLE
+LRECYCLS=>RECYCL_MODEL(KTO)%LRECYCLS
+XDRECYCLN=>RECYCL_MODEL(KTO)%XDRECYCLN
+XARECYCLN=>RECYCL_MODEL(KTO)%XARECYCLN
+XDRECYCLW=>RECYCL_MODEL(KTO)%XDRECYCLW
+XARECYCLW=>RECYCL_MODEL(KTO)%XARECYCLW
+XDRECYCLE=>RECYCL_MODEL(KTO)%XDRECYCLE
+XARECYCLE=>RECYCL_MODEL(KTO)%XARECYCLE
+XDRECYCLS=>RECYCL_MODEL(KTO)%XDRECYCLS
+XARECYCLS=>RECYCL_MODEL(KTO)%XARECYCLS
+XTMOY=>RECYCL_MODEL(KTO)%XTMOY
+XTMOYCOUNT=>RECYCL_MODEL(KTO)%XTMOYCOUNT
+XNUMBELT=>RECYCL_MODEL(KTO)%XNUMBELT
+XRCOEFF=>RECYCL_MODEL(KTO)%XRCOEFF
+XTBVTOP=>RECYCL_MODEL(KTO)%XTBVTOP
+XTBVBOT=>RECYCL_MODEL(KTO)%XTBVBOT
+
+XUMEANW=>RECYCL_MODEL(KTO)%XUMEANW
+XVMEANW=>RECYCL_MODEL(KTO)%XVMEANW
+XWMEANW=>RECYCL_MODEL(KTO)%XWMEANW
+XUMEANN=>RECYCL_MODEL(KTO)%XUMEANN
+XVMEANN=>RECYCL_MODEL(KTO)%XVMEANN
+XWMEANN=>RECYCL_MODEL(KTO)%XWMEANN
+XUMEANE=>RECYCL_MODEL(KTO)%XUMEANE
+XVMEANE=>RECYCL_MODEL(KTO)%XVMEANE
+XWMEANE=>RECYCL_MODEL(KTO)%XWMEANE
+XUMEANS=>RECYCL_MODEL(KTO)%XUMEANS
+XVMEANS=>RECYCL_MODEL(KTO)%XVMEANS
+XWMEANS=>RECYCL_MODEL(KTO)%XWMEANS
+
+NR_COUNT=>RECYCL_MODEL(KTO)%NR_COUNT
+
+END SUBROUTINE RECYCL_GOTO_MODEL
+
+END MODULE MODD_RECYCL_PARAM_n
+!
+
diff --git a/src/MNH/modd_ref.f90 b/src/MNH/modd_ref.f90
index 8b2f932878b87b893353170624ea8473cf167f79..3d1e6025ba5ac880c2d388e7adfe3be615ad2099 100644
--- a/src/MNH/modd_ref.f90
+++ b/src/MNH/modd_ref.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###############
@@ -46,6 +46,13 @@ REAL,SAVE, DIMENSION(:), ALLOCATABLE, TARGET :: XRHODREFZ ! rhod(z) for referenc
REAL,SAVE, DIMENSION(:), ALLOCATABLE, TARGET :: XTHVREFZ ! Thetav(z) for reference
! state without orography
REAL,SAVE :: XEXNTOP ! Exner function at model top
+!
+! For coupled A-O case
+REAL,SAVE, DIMENSION(:), ALLOCATABLE, TARGET :: XRHODREFZO! rhod(z) for ocean ref state in coupled mode
+REAL,SAVE, DIMENSION(:), ALLOCATABLE, TARGET :: XTHVREFZO !Thetav(z) for ocean ref state in coupled mode
+REAL,SAVE :: XEXNTOPO ! Exner function at ocean model top in coupled mode
+!
LOGICAL, SAVE :: LBOUSS ! Boussinesq approximation
+LOGICAL, SAVE ::LCOUPLES ! AUTOCOUPLED ATMS-OCEAN LES VERSION
!
END MODULE MODD_REF
diff --git a/src/MNH/modd_sub_modeln.f90 b/src/MNH/modd_sub_modeln.f90
index 7bf9f5301aafec7fca42c78aaf5fe7b30c22d564..f4ed4089cd95efc9450293846468a61dd4809cba 100644
--- a/src/MNH/modd_sub_modeln.f90
+++ b/src/MNH/modd_sub_modeln.f90
@@ -11,6 +11,7 @@
! J. Escobar 09/07/2019: norme Doctor -> Rename Module Type variable TZ -> T
! J. Escobar 09/07/2019: for bug in management of XLSZWSM variable, add/use specific 2D TLSFIELD2D_ll pointer
! P. Wautelet 07/01/2021: rename ibak/iout into nfile_backup_current/nfile_output_current
+! F. Auguste 01/02/2021: add IBM
!-----------------------------------------------------------------
! #################
MODULE MODD_SUB_MODEL_n
@@ -41,12 +42,13 @@ TYPE SUB_MODEL_t
integer :: nfile_output_current = 0 ! Number of the current output file
REAL(kind=MNHTIME), DIMENSION(2) :: XT_START
REAL(kind=MNHTIME), DIMENSION(2) :: XT_STORE, XT_BOUND, XT_GUESS
- REAL(kind=MNHTIME), DIMENSION(2) :: XT_ADV, XT_SOURCES, XT_DRAG
+ REAL(kind=MNHTIME), DIMENSION(2) :: XT_ADV, XT_SOURCES, XT_DRAG, XT_EOL
REAL(kind=MNHTIME), DIMENSION(2) :: XT_ADVUVW, XT_GRAV, XT_VISC
REAL(kind=MNHTIME), DIMENSION(2) :: XT_DIFF, XT_RELAX, XT_PARAM, XT_SPECTRA
REAL(kind=MNHTIME), DIMENSION(2) :: XT_HALO, XT_RAD_BOUND, XT_PRESS
REAL(kind=MNHTIME), DIMENSION(2) :: XT_CLOUD, XT_STEP_SWA, XT_STEP_MISC
REAL(kind=MNHTIME), DIMENSION(2) :: XT_ELEC
+ REAL(kind=MNHTIME), DIMENSION(2) :: XT_IBM_FORC,XT_IBM_DETE,XT_IBM_PREP
REAL(kind=MNHTIME), DIMENSION(2) :: XT_COUPL, XT_1WAY, XT_STEP_BUD
REAL(kind=MNHTIME), DIMENSION(2) :: XT_RAD, XT_DCONV, XT_GROUND, XT_TRACER, XT_MAFL
REAL(kind=MNHTIME), DIMENSION(2) :: XT_TURB, XT_2WAY, XT_SHADOWS
@@ -68,13 +70,14 @@ integer, pointer :: nfile_backup_current => Null()
integer, pointer :: nfile_output_current => Null()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_START=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_STORE=>NULL(), XT_BOUND=>NULL(), XT_GUESS=>NULL()
-REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_ADV=>NULL(), XT_SOURCES=>NULL(), XT_DRAG=>NULL()
+REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_ADV=>NULL(), XT_SOURCES=>NULL(), XT_DRAG=>NULL(), XT_EOL=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_ADVUVW=>NULL(), XT_GRAV=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_DIFF=>NULL(), XT_RELAX=>NULL(), XT_PARAM=>NULL(), XT_SPECTRA=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_HALO=>NULL(), XT_RAD_BOUND=>NULL(), XT_PRESS=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_VISC=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_CLOUD=>NULL(), XT_STEP_SWA=>NULL(), XT_STEP_MISC=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_ELEC=>NULL(), XT_SHADOWS=>NULL()
+REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_IBM_FORC=>NULL(),XT_IBM_PREP=>NULL(),XT_IBM_DETE=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_COUPL=>NULL(), XT_1WAY=>NULL(), XT_STEP_BUD=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_RAD=>NULL(), XT_DCONV=>NULL(), XT_GROUND=>NULL(), XT_MAFL=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_TURB=>NULL(), XT_2WAY=>NULL(), XT_TRACER=>NULL()
@@ -127,6 +130,7 @@ XT_ADVUVW=>SUB_MODEL_MODEL(KTO)%XT_ADVUVW
XT_GRAV=>SUB_MODEL_MODEL(KTO)%XT_GRAV
XT_SOURCES=>SUB_MODEL_MODEL(KTO)%XT_SOURCES
XT_DRAG=>SUB_MODEL_MODEL(KTO)%XT_DRAG
+XT_EOL=>SUB_MODEL_MODEL(KTO)%XT_EOL
XT_DIFF=>SUB_MODEL_MODEL(KTO)%XT_DIFF
XT_RELAX=>SUB_MODEL_MODEL(KTO)%XT_RELAX
XT_PARAM=>SUB_MODEL_MODEL(KTO)%XT_PARAM
@@ -137,6 +141,9 @@ XT_RAD_BOUND=>SUB_MODEL_MODEL(KTO)%XT_RAD_BOUND
XT_PRESS=>SUB_MODEL_MODEL(KTO)%XT_PRESS
XT_CLOUD=>SUB_MODEL_MODEL(KTO)%XT_CLOUD
XT_ELEC=>SUB_MODEL_MODEL(KTO)%XT_ELEC
+XT_IBM_FORC=>SUB_MODEL_MODEL(KTO)%XT_IBM_FORC
+XT_IBM_DETE=>SUB_MODEL_MODEL(KTO)%XT_IBM_DETE
+XT_IBM_PREP=>SUB_MODEL_MODEL(KTO)%XT_IBM_PREP
XT_STEP_SWA=>SUB_MODEL_MODEL(KTO)%XT_STEP_SWA
XT_STEP_MISC=>SUB_MODEL_MODEL(KTO)%XT_STEP_MISC
XT_COUPL=>SUB_MODEL_MODEL(KTO)%XT_COUPL
diff --git a/src/MNH/modd_turbn.f90 b/src/MNH/modd_turbn.f90
index 8dc0cb5e140998ad83f86d6771a45d213ae16f5f..8c35fd9d4be7bd61167ee2e6aba4a4fb40e521a5 100644
--- a/src/MNH/modd_turbn.f90
+++ b/src/MNH/modd_turbn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##################
@@ -39,6 +39,8 @@
!! May 2006 Remove KEPS
!! C.Lac Nov 2014 add terms of TKE production for LES diag
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! D. Ricard May 2021 add the switches for Leonard terms
+!! JL Redelsperger 03/2021 Add O-A flux for auto-coupled LES case
!!
!-------------------------------------------------------------------------------
!
@@ -55,6 +57,7 @@ TYPE TURB_t
! the turbulence scheme
REAL :: XKEMIN ! mimimum value for the TKE
REAL :: XCEDIS ! Constant for dissipation of Tke
+ REAL :: XCADAP ! Coefficient for ADAPtative mixing length
CHARACTER (LEN=4) :: CTURBLEN ! type of length used for the closure
! 'BL89' Bougeault and Lacarrere scheme
! 'DELT' length = ( volum) ** 1/3
@@ -77,7 +80,12 @@ TYPE TURB_t
CHARACTER(LEN=4) :: CTOM ! type of Third Order Moments
! 'NONE' none
! 'TM06' Tomas Masson 2006
- CHARACTER(LEN=4) :: CSUBG_AUCV ! type of subgrid autoconv. method
+ CHARACTER(LEN=4) :: CSUBG_AUCV ! type of subgrid rc->rr autoconv. method
+ CHARACTER(LEN=80) :: CSUBG_AUCV_RI ! type of subgrid ri->rs autoconv. method
+ CHARACTER(LEN=80) :: CCONDENS ! subrgrid condensation PDF
+ CHARACTER(LEN=4) :: CLAMBDA3 ! lambda3 choice for subgrid cloud scheme
+ CHARACTER(LEN=80) :: CSUBG_MF_PDF ! PDF to use for MF cloud autoconversions
+
! REAL, DIMENSION(:,:), POINTER :: XBL_DEPTH=>NULL() ! BL depth for TOMS computations
! REAL, DIMENSION(:,:), POINTER :: XSBL_DEPTH=>NULL()! SurfaceBL depth for RMC01 computations
! REAL, DIMENSION(:,:,:), POINTER :: XWTHVMF=>NULL()! Mass Flux vert. transport of buoyancy
@@ -87,6 +95,17 @@ TYPE TURB_t
REAL, DIMENSION(:,:,:), POINTER :: XTR=>NULL() ! Transport production of Kinetic energy
REAL, DIMENSION(:,:,:), POINTER :: XDISS=>NULL() ! Dissipation of Kinetic energy
REAL, DIMENSION(:,:,:), POINTER :: XLEM=>NULL() ! Mixing length
+ REAL, DIMENSION(:,:,:), POINTER :: XSSUFL_C=>NULL() ! O-A interface flux for u
+ REAL, DIMENSION(:,:,:), POINTER :: XSSVFL_C=>NULL() ! O-A interface flux for v
+ REAL, DIMENSION(:,:,:), POINTER :: XSSTFL_C=>NULL() ! O-A interface flux for theta
+ REAL, DIMENSION(:,:,:), POINTER :: XSSRFL_C=>NULL() ! O-A interface flux for vapor
+ LOGICAL :: LHGRAD ! logical switch for the computation of the Leornard Terms
+ REAL :: XCOEFHGRADTHL ! coeff applied to thl contribution
+ REAL :: XCOEFHGRADRM ! coeff applied to mixing ratio contribution
+ REAL :: XALTHGRAD ! altitude from which to apply the Leonard terms
+ REAL :: XCLDTHOLD ! cloud threshold to apply the Leonard terms
+ ! negative value : applied everywhere
+ ! 0.000001 applied only inside the clouds ri+rc > 10**-6 kg/kg
!
END TYPE TURB_t
@@ -95,6 +114,7 @@ TYPE(TURB_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: TURB_MODEL
REAL, POINTER :: XIMPL=>NULL()
REAL, POINTER :: XKEMIN=>NULL()
REAL, POINTER :: XCEDIS=>NULL()
+REAL, POINTER :: XCADAP=>NULL()
CHARACTER (LEN=4), POINTER :: CTURBLEN=>NULL()
CHARACTER (LEN=4), POINTER :: CTURBDIM=>NULL()
LOGICAL, POINTER :: LTURB_FLX=>NULL()
@@ -105,6 +125,10 @@ LOGICAL, POINTER :: LSIG_CONV=>NULL()
LOGICAL, POINTER :: LRMC01=>NULL()
CHARACTER(LEN=4),POINTER :: CTOM=>NULL()
CHARACTER(LEN=4),POINTER :: CSUBG_AUCV=>NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_AUCV_RI=>NULL()
+CHARACTER(LEN=80),POINTER :: CCONDENS=>NULL()
+CHARACTER(LEN=4),POINTER :: CLAMBDA3=>NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_MF_PDF=>NULL()
REAL, DIMENSION(:,:), POINTER :: XBL_DEPTH=>NULL()
REAL, DIMENSION(:,:), POINTER :: XSBL_DEPTH=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XWTHVMF=>NULL()
@@ -114,6 +138,15 @@ REAL, DIMENSION(:,:,:), POINTER :: XTHP=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTR=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XDISS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLEM=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSUFL_C=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSVFL_C=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSTFL_C=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSRFL_C=>NULL()
+LOGICAL, POINTER :: LHGRAD=>NULL()
+REAL, POINTER :: XCOEFHGRADTHL=>NULL()
+REAL, POINTER :: XCOEFHGRADRM=>NULL()
+REAL, POINTER :: XALTHGRAD=>NULL()
+REAL, POINTER :: XCLDTHOLD=>NULL()
CONTAINS
@@ -130,11 +163,16 @@ TURB_MODEL(KFROM)%XTHP=>XTHP
TURB_MODEL(KFROM)%XTR=>XTR
TURB_MODEL(KFROM)%XDISS=>XDISS
TURB_MODEL(KFROM)%XLEM=>XLEM
+TURB_MODEL(KFROM)%XSSUFL_C=>XSSUFL_C
+TURB_MODEL(KFROM)%XSSVFL_C=>XSSVFL_C
+TURB_MODEL(KFROM)%XSSTFL_C=>XSSTFL_C
+TURB_MODEL(KFROM)%XSSRFL_C=>XSSRFL_C
!
! Current model is set to model KTO
XIMPL=>TURB_MODEL(KTO)%XIMPL
XKEMIN=>TURB_MODEL(KTO)%XKEMIN
XCEDIS=>TURB_MODEL(KTO)%XCEDIS
+XCADAP=>TURB_MODEL(KTO)%XCADAP
CTURBLEN=>TURB_MODEL(KTO)%CTURBLEN
CTURBDIM=>TURB_MODEL(KTO)%CTURBDIM
LTURB_FLX=>TURB_MODEL(KTO)%LTURB_FLX
@@ -145,6 +183,10 @@ LSIG_CONV=>TURB_MODEL(KTO)%LSIG_CONV
LRMC01=>TURB_MODEL(KTO)%LRMC01
CTOM=>TURB_MODEL(KTO)%CTOM
CSUBG_AUCV=>TURB_MODEL(KTO)%CSUBG_AUCV
+CSUBG_AUCV_RI=>TURB_MODEL(KTO)%CSUBG_AUCV_RI
+CCONDENS=>TURB_MODEL(KTO)%CCONDENS
+CLAMBDA3=>TURB_MODEL(KTO)%CLAMBDA3
+CSUBG_MF_PDF=>TURB_MODEL(KTO)%CSUBG_MF_PDF
!XBL_DEPTH=>TURB_MODEL(KTO)%XBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
!XSBL_DEPTH=>TURB_MODEL(KTO)%XSBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
!XWTHVMF=>TURB_MODEL(KTO)%XWTHVMF !Done in FIELDLIST_GOTO_MODEL
@@ -154,6 +196,15 @@ XTHP=>TURB_MODEL(KTO)%XTHP
XTR=>TURB_MODEL(KTO)%XTR
XDISS=>TURB_MODEL(KTO)%XDISS
XLEM=>TURB_MODEL(KTO)%XLEM
+XSSUFL_C=>TURB_MODEL(KTO)%XSSUFL_C
+XSSVFL_C=>TURB_MODEL(KTO)%XSSVFL_C
+XSSTFL_C=>TURB_MODEL(KTO)%XSSTFL_C
+XSSRFL_C=>TURB_MODEL(KTO)%XSSRFL_C
+LHGRAD=>TURB_MODEL(KTO)%LHGRAD
+XCOEFHGRADTHL=>TURB_MODEL(KTO)%XCOEFHGRADTHL
+XCOEFHGRADRM=>TURB_MODEL(KTO)%XCOEFHGRADRM
+XALTHGRAD=>TURB_MODEL(KTO)%XALTHGRAD
+XCLDTHOLD=>TURB_MODEL(KTO)%XCLDTHOLD
END SUBROUTINE TURB_GOTO_MODEL
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 3ae4c24cab15fcd04948ff3a2aafb90575db8707..038399dcd59eb8675f4ac3afa39931b8c9ab396b 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -268,7 +268,10 @@ END MODULE MODI_MODEL_n
! J. Escobar 27/09/2019: add missing report timing of RESOLVED_ELEC
! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
! P. Wautelet 12/10/2020: Write_les_n: remove HLES_AVG dummy argument and group all 4 calls
+! F. Auguste 01/02/2021: add IBM
+! T. Nagel 01/02/2021: add turbulence recycling
! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets
+! J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version)
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -277,6 +280,7 @@ END MODULE MODI_MODEL_n
USE MODD_2D_FRC
USE MODD_ADV_n
USE MODD_AIRCRAFT_BALLOON
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_BAKOUT
USE MODD_BIKHARDT_n
USE MODD_BLANK_n
@@ -303,12 +307,14 @@ USE MODD_DYN_n
USE MODD_DYNZD
USE MODD_DYNZD_n
USE MODD_ELEC_DESCR
+USE MODD_EOL_MAIN
USE MODD_FIELD_n
USE MODD_FRC
USE MODD_FRC_n
USE MODD_GET_n
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODD_GRID_n
+USE MODD_IBM_PARAM_n, ONLY: CIBM_ADV, LIBM, LIBM_TROUBLE, XIBM_LS
USE MODD_ICE_C1R3_DESCR, ONLY: XRTMIN_C1R3=>XRTMIN
USE MODD_IO, ONLY: LIO_NO_WRITE, TFILEDATA, TFILE_SURFEX, TFILE_DUMMY
USE MODD_LBC_n
@@ -342,6 +348,8 @@ use modd_precision, only: MNHTIME
USE MODD_PROFILER_n
USE MODD_RADIATIONS_n, ONLY: XTSRAD,XSCAFLASWD,XDIRFLASWD,XDIRSRFSWD, XAER, XDTHRAD
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_RECYCL_PARAM_n, ONLY: LRECYCL
+USE MODD_REF, ONLY: LCOUPLES
USE MODD_REF_n
USE MODD_SALT, ONLY: LSALT
USE MODD_SERIES, ONLY: LSERIES
@@ -370,10 +378,12 @@ use mode_menu_diachro, only: MENU_DIACHRO
USE MODE_MNH_TIMING
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
+USE MODE_MSG
USE MODE_ONE_WAY_n
use mode_write_les_n, only: Write_les_n
use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
!
+USE MODI_ADDFLUCTUATIONS
USE MODI_ADVECTION_METSV
USE MODI_ADVECTION_UVW
USE MODI_ADVECTION_UVW_CEN
@@ -396,6 +406,10 @@ USE MODI_FORC_SQUALL_LINE
USE MODI_FORC_WIND
USE MODI_GET_HALO
USE MODI_GRAVITY_IMPL
+USE MODI_IBM_INIT
+USE MODI_IBM_FORCING
+USE MODI_IBM_FORCING_TR
+USE MODI_IBM_FORCING_ADV
USE MODI_INI_DIAG_IN_RUN
USE MODI_INI_LG
USE MODI_INI_MEAN_FIELD
@@ -414,6 +428,7 @@ USE MODI_PHYS_PARAM_n
USE MODI_PRESSUREZ
USE MODI_PROFILER_n
USE MODI_RAD_BOUND
+USE MODI_RECYCLING
USE MODI_RELAX2FW_ION
USE MODI_RELAXATION
USE MODI_REL_FORCING_n
@@ -714,12 +729,15 @@ IF (KTCOUNT == 1) THEN
XT_TURB = 0.0_MNHTIME
XT_MAFL = 0.0_MNHTIME
XT_DRAG = 0.0_MNHTIME
+ XT_EOL = 0.0_MNHTIME
XT_TRACER = 0.0_MNHTIME
XT_SHADOWS = 0.0_MNHTIME
XT_ELEC = 0.0_MNHTIME
XT_CHEM = 0.0_MNHTIME
XT_2WAY = 0.0_MNHTIME
!
+ XT_IBM_FORC = 0.0_MNHTIME
+ !
END IF
!
!* 1.7 Allocation of arrays for observation diagnostics
@@ -739,11 +757,14 @@ CALL SECOND_MNH2(ZTIME1)
!
ISYNCHRO = MODULO (KTCOUNT, NDTRATIO(IMI) ) ! test of synchronisation
!
-
-
-IF (IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) THEN
-!
- ! Use dummy pointers to correct an ifort BUG
+!
+IF (LCOUPLES.AND.LOCEAN) THEN
+ CALL NHOA_COUPL_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT,IKU)
+END IF
+! No Gridnest in coupled OA LES for now
+IF (.NOT. LCOUPLES .AND. IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) THEN
+!
+! Use dummy pointers to correct an ifort BUG
DPTR_XBMX1=>XBMX1
DPTR_XBMX2=>XBMX2
DPTR_XBMX3=>XBMX3
@@ -870,7 +891,28 @@ IF (IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) TH
END IF
!
CALL SECOND_MNH2(ZTIME2)
-XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1
+XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1
+!
+!* 2.1 RECYCLING TURBULENCE
+! ----
+IF (CTURB /= 'NONE' .AND. LRECYCL) THEN
+ CALL RECYCLING(XFLUCTUNW,XFLUCTVNN,XFLUCTUTN,XFLUCTVTW,XFLUCTWTW,XFLUCTWTN, &
+ XFLUCTUNE,XFLUCTVNS,XFLUCTUTS,XFLUCTVTE,XFLUCTWTE,XFLUCTWTS, &
+ KTCOUNT)
+ENDIF
+!
+!* 2.2 IBM
+! ----
+!
+IF (LIBM .AND. KTCOUNT==1) THEN
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_INIT(XIBM_LS)
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!
@@ -979,6 +1021,42 @@ XT_STORE = XT_STORE + ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
+!* 4.BIS IBM and Fluctuations application
+! -----------------------------
+!
+!* 4.B1 Add fluctuations at the domain boundaries
+!
+IF (LRECYCL) THEN
+ CALL ADDFLUCTUATIONS ( &
+ CLBCX,CLBCY, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT, &
+ XFLUCTUTN,XFLUCTVTW,XFLUCTUTS,XFLUCTVTE, &
+ XFLUCTWTW,XFLUCTWTN,XFLUCTWTS,XFLUCTWTE )
+ENDIF
+!
+!* 4.B2 Immersed boundaries
+!
+IF (LIBM) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_FORCING(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ !
+ IF (LIBM_TROUBLE) THEN
+ CALL IBM_FORCING_TR(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ ENDIF
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!-------------------------------------------------------------------------------
+!
!* 5. INITIALIZATION OF THE BUDGET VARIABLES
! --------------------------------------
!
@@ -1335,10 +1413,10 @@ XT_RELAX = XT_RELAX + ZTIME2 - ZTIME1 &
!
ZTIME1 = ZTIME2
!
-CALL PHYS_PARAM_n( KTCOUNT, TZBAKFILE, &
- XT_RAD, XT_SHADOWS, XT_DCONV, XT_GROUND, &
- XT_MAFL, XT_DRAG, XT_TURB, XT_TRACER, &
- ZTIME, ZWETDEPAER, GMASKkids, GCLOUD_ONLY )
+CALL PHYS_PARAM_n( KTCOUNT, TZBAKFILE, &
+ XT_RAD, XT_SHADOWS, XT_DCONV, XT_GROUND, &
+ XT_MAFL, XT_DRAG, XT_EOL, XT_TURB, XT_TRACER, &
+ ZTIME, ZWETDEPAER, GMASKkids, GCLOUD_ONLY )
!
IF (CDCONV/='NONE') THEN
XPACCONV = XPACCONV + XPRCONV * XTSTEP
@@ -1557,6 +1635,18 @@ CALL SECOND_MNH2(ZTIME2)
!
XT_GRAV = XT_GRAV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
!
+IF ( LIBM .AND. CIBM_ADV=='FORCIN' ) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ CALL IBM_FORCING_ADV (XRUS,XRVS,XRWS)
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
@@ -1640,6 +1730,7 @@ CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
XDXHAT, XDYHAT, XZHAT, &
XUT, XVT, &
XLBXUM, XLBYVM, XLBXUS, XLBYVS, &
+ XFLUCTUNW,XFLUCTVNN,XFLUCTUNE,XFLUCTVNS, &
XCPHASE, XCPHASE_PBL, XRHODJ, &
XTKET,XRUS, XRVS, XRWS )
ZRUS=XRUS-ZRUS
@@ -1803,6 +1894,7 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF, &
ZSEA, ZTOWN )
DEALLOCATE(ZTOWN)
ELSE
@@ -1820,7 +1912,8 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
- XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR )
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF )
END IF
XRTHS_CLD = XRTHS - XRTHS_CLD
XRRS_CLD = XRRS - XRRS_CLD
@@ -1947,7 +2040,7 @@ XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES
! --------------------
!
IF (LMEAN_FIELD) THEN
- CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST)
+ CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XSVT(:,:,:,1))
END IF
!
!-------------------------------------------------------------------------------
@@ -2137,6 +2230,7 @@ IF (OEXIT) THEN
CALL TIME_STAT_ll(XT_ADVUVW,ZTOT, ' ADVECTION UVW','=')
CALL TIME_STAT_ll(XT_GRAV,ZTOT, ' GRAVITY','=')
CALL TIME_STAT_ll(XT_FORCING,ZTOT, ' FORCING','=')
+ CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT, ' IBM','=')
CALL TIME_STAT_ll(XT_NUDGING,ZTOT, ' NUDGING','=')
CALL TIME_STAT_ll(XT_SOURCES,ZTOT, ' DYN_SOURCES','=')
CALL TIME_STAT_ll(XT_DIFF,ZTOT, ' NUM_DIFF','=')
@@ -2152,6 +2246,7 @@ IF (OEXIT) THEN
CALL TIME_STAT_ll(XT_TURB,ZTOT, ' TURB = '//CTURB ,'-')
CALL TIME_STAT_ll(XT_MAFL,ZTOT, ' MAFL = '//CSCONV,'-')
CALL TIME_STAT_ll(XT_CHEM,ZTOT, ' CHIMIE' ,'-')
+ CALL TIME_STAT_ll(XT_EOL,ZTOT, ' WIND TURBINE' ,'-')
CALL TIMING_LEGEND()
CALL TIME_STAT_ll(XT_COUPL,ZTOT, ' SET_COUPLING','=')
CALL TIME_STAT_ll(XT_RAD_BOUND,ZTOT, ' RAD_BOUND','=')
@@ -2176,12 +2271,13 @@ IF (OEXIT) THEN
CALL TIME_STAT_ll(XT_STEP_BUD,ZTOT, ' BUDGETS','=')
CALL TIME_STAT_ll(XT_SPECTRA,ZTOT, ' LES','=')
CALL TIME_STAT_ll(XT_STEP_MISC,ZTOT, ' MISCELLANEOUS','=')
+ IF (LIBM) CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT,' IBM FORCING','=')
!
! sum of call subroutine
!
ZALL = XT_1WAY + XT_BOUND + XT_STORE + XT_GUESS + XT_2WAY + &
XT_ADV + XT_FORCING + XT_NUDGING + XT_SOURCES + XT_DIFF + &
- XT_ADVUVW + XT_GRAV + &
+ XT_ADVUVW + XT_GRAV + XT_IBM_FORC + &
XT_RELAX+ XT_PARAM + XT_COUPL + XT_RAD_BOUND+XT_PRESS + &
XT_CLOUD+ XT_ELEC + XT_HALO + XT_SPECTRA + XT_STEP_SWA + &
XT_STEP_MISC+ XT_STEP_BUD
diff --git a/src/MNH/modn_blankn.f90 b/src/MNH/modn_blankn.f90
index 4a060461035968635ab1c79d5c3b6d4de9bcb20a..44845258a5bddb348b631ccd3052e30696c64fb6 100644
--- a/src/MNH/modn_blankn.f90
+++ b/src/MNH/modn_blankn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-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 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$ $Revision$
-! MASDEV4_7 modn 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #################
MODULE MODN_BLANK_n
! #################
diff --git a/src/MNH/modn_dynn.f90 b/src/MNH/modn_dynn.f90
index 0f6585f99f5adf5dd4cd7466946cd2b1cd1a2711..b943d5202086aedabbdb4adbbc9a0f0e22134bba 100644
--- a/src/MNH/modn_dynn.f90
+++ b/src/MNH/modn_dynn.f90
@@ -1,9 +1,7 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
!-----------------------------------------------------------------
! #################
MODULE MODN_DYN_n
@@ -55,6 +53,7 @@
!! Modifications 09/06/11 (Barthe) add LHORELAX_SVELEC in namelist
!! Modifications 15/06/11 (Lac) add LHORELAX for conditional sampling
!! Modifications 12/02/12 (Pialat/Tulet) add LHORELAX_SVFF for ForeFire scalar variables
+!! Modification 03/2021 (JL Redelsperger) add logical LOCEAN for ocean LES version
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -62,6 +61,7 @@
!
USE MODD_PARAMETERS, ONLY : JPSVMAX
USE MODD_DYN_n, ONLY : &
+ LOCEAN_n => LOCEAN, &
XTSTEP_n => XTSTEP, &
CPRESOPT_n => CPRESOPT, &
NITR_n => NITR, &
@@ -109,7 +109,8 @@ REAL ,SAVE :: XTSTEP
CHARACTER(LEN=5),SAVE :: CPRESOPT
INTEGER ,SAVE :: NITR
LOGICAL ,SAVE :: LITRADJ
-LOGICAL ,SAVE :: LRES
+LOGICAL ,SAVE :: LRES
+LOGICAL ,SAVE :: LOCEAN
REAL ,SAVE :: XRES
REAL ,SAVE :: XRELAX
LOGICAL, SAVE :: LHORELAX_UVWTH
@@ -156,12 +157,14 @@ NAMELIST/NAM_DYNn/XTSTEP,CPRESOPT,NITR,LITRADJ,LRES,XRES,XRELAX,LHORELAX_UVWTH,
#ifdef MNH_FOREFIRE
LHORELAX_SVFF, &
#endif
+ LOCEAN,&
NRIMX,NRIMY,XRIMKMAX,XT4DIFU, &
XT4DIFTH,XT4DIFSV
!
CONTAINS
!
SUBROUTINE INIT_NAM_DYNn
+ LOCEAN = LOCEAN_n
XTSTEP = XTSTEP_n
CPRESOPT = CPRESOPT_n
NITR = NITR_n
@@ -205,6 +208,7 @@ SUBROUTINE INIT_NAM_DYNn
END SUBROUTINE INIT_NAM_DYNn
SUBROUTINE UPDATE_NAM_DYNn
+ LOCEAN_n = LOCEAN
XTSTEP_n = XTSTEP
CPRESOPT_n = CPRESOPT
NITR_n = NITR
diff --git a/src/MNH/modn_eol.f90 b/src/MNH/modn_eol.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c232ce3baf7cedf3a0e8fffa4204b7a46a8a3dca
--- /dev/null
+++ b/src/MNH/modn_eol.f90
@@ -0,0 +1,40 @@
+!MNH_LIC Copyright 2017-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.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODN_EOL
+!! #####################
+!!
+!!*** *MODN_EOL*
+!!
+!! PURPOSE
+!! -------
+!! NAM_EOL activate the parameterization of wind turbines, and allows
+!! the selection of the aerodynamic method.
+!!
+!!** AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/01/17
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+USE MODD_EOL_MAIN
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+SAVE
+NAMELIST /NAM_EOL/ &
+ LMAIN_EOL,CMETH_EOL,CSMEAR,NMODEL_EOL
+!
+END MODULE MODN_EOL
diff --git a/src/MNH/modn_eol_adnr.f90 b/src/MNH/modn_eol_adnr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3e3c77cec046bd2bf1754362f815d0b06df362d4
--- /dev/null
+++ b/src/MNH/modn_eol_adnr.f90
@@ -0,0 +1,44 @@
+!MNH_LIC Copyright 2016-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.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODN_EOL_ADNR
+!! #####################
+!!
+!!*** *MODN_EOL_ADNR*
+!!
+!! PURPOSE
+!! -------
+!! NAM_EOL activate the parameterization of wind turbines, and several
+!! models are available. One of the models is the Non-Rotating Actuator
+!! Disk Non Rotating (ADNR).
+!! The aim of NAM_EOL_ADNR is to specify ADNR parameters.
+!!
+!!** AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/16
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+USE MODD_EOL_ADNR
+USE MODD_EOL_SHARED_IO
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+SAVE
+NAMELIST /NAM_EOL_ADNR/ &
+ CFARM_CSVDATA, CTURBINE_CSVDATA, &
+ CINTERP
+!
+END MODULE MODN_EOL_ADNR
diff --git a/src/MNH/modn_eol_alm.f90 b/src/MNH/modn_eol_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..54f7a389bda529ce0ea80fac0fd6ff62124d4b18
--- /dev/null
+++ b/src/MNH/modn_eol_alm.f90
@@ -0,0 +1,46 @@
+!MNH_LIC Copyright 2017-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.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODN_EOL_ALM
+!! #####################
+!!
+!!*** *MODN_EOL_ALM*
+!!
+!! PURPOSE
+!! -------
+!! NAM_EOL activate the parameterization of wind turbines, and several
+!! models are available. One of the models is the Actuator Line
+!! Method (ALM).
+!! The aim of NAM_EOL_ALM is to specify ALM parameters.
+!!
+!!** AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/01/17
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+USE MODD_EOL_ALM
+USE MODD_EOL_SHARED_IO
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+SAVE
+NAMELIST /NAM_EOL_ALM/ &
+ CFARM_CSVDATA, CTURBINE_CSVDATA, CBLADE_CSVDATA, CAIRFOIL_CSVDATA, &
+ NNB_BLAELT, &
+ CINTERP, LTIMESPLIT, LTIPLOSSG, &
+ LTECOUTPTS
+!
+END MODULE MODN_EOL_ALM
diff --git a/src/MNH/modn_frc.f90 b/src/MNH/modn_frc.f90
index 685ee4f243d5c526fed26540b16b1cabf6259430..ae7d5e41dac257a6881440f4d0a291f65794a562 100644
--- a/src/MNH/modn_frc.f90
+++ b/src/MNH/modn_frc.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-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 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$ $Revision$
-! MASDEV4_7 modn 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###############
MODULE MODN_FRC
! ###############
@@ -66,6 +61,11 @@ NAMELIST /NAM_FRC/ LGEOST_UV_FRC , &
LTRANS , &
XUTRANS , &
XVTRANS , &
- LPGROUND_FRC
+ LPGROUND_FRC ,&
+ LDEEPOC ,&
+ XCENTX_OC ,&
+ XCENTY_OC ,&
+ XRADX_OC ,&
+ XRADY_OC
!
END MODULE MODN_FRC
diff --git a/src/MNH/modn_ibm_paramn.f90 b/src/MNH/modn_ibm_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a17e89362b9ae1945f9f5a7670ab7f7af82e9b28
--- /dev/null
+++ b/src/MNH/modn_ibm_paramn.f90
@@ -0,0 +1,374 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #######################
+ MODULE MODN_IBM_PARAM_n
+! #######################
+!
+!**** *MODN_IBM_PARAM$n* - declaration of namelist NAM_IBM_PARAMn
+!
+! PURPOSE
+! -------
+!**** The purpose of this declarative module is to declare the constants
+! which allow to initialize the embedded surface
+!
+!
+! IMPLICIT ARGUMENTS
+! ------------------
+! Module MODD_IBM_PARAM$n : contains declaration of IBM parameters
+!
+!
+! REFERENCE
+! ---------
+!
+! AUTHOR
+! ------
+! Franck Auguste (CERFACS-AE)
+!
+! MODIFICATIONS
+! -------------
+! Original 01/01/2019
+!
+USE MODD_IBM_PARAM_n, ONLY: &
+ LIBM_n => LIBM, &
+ NIBM_ITR_n => NIBM_ITR, &
+ CIBM_ADV_n => CIBM_ADV, &
+ LIBM_TROUBLE_n => LIBM_TROUBLE, &
+ XIBM_EPSI_n => XIBM_EPSI, &
+ XIBM_IEPS_n => XIBM_IEPS, &
+ XIBM_RUG_n => XIBM_RUG, &
+ XIBM_VISC_n => XIBM_VISC, &
+ XIBM_CNU_n => XIBM_CNU, &
+
+ NIBM_LAYER_P_n => NIBM_LAYER_P ,&
+ XIBM_RADIUS_P_n => XIBM_RADIUS_P ,&
+ XIBM_POWERS_P_n => XIBM_POWERS_P ,&
+ CIBM_MODE_INTE1_P_n => CIBM_MODE_INTE1_P ,&
+ CIBM_MODE_INTE3_P_n => CIBM_MODE_INTE3_P ,&
+ CIBM_MODE_BOUND_P_n => CIBM_MODE_BOUND_P ,&
+ CIBM_TYPE_BOUND_P_n => CIBM_TYPE_BOUND_P ,&
+ CIBM_FORC_BOUND_P_n => CIBM_FORC_BOUND_P ,&
+ XIBM_FORC_BOUND_P_n => XIBM_FORC_BOUND_P ,&
+
+ NIBM_LAYER_Q_n => NIBM_LAYER_Q ,&
+ XIBM_RADIUS_Q_n => XIBM_RADIUS_Q ,&
+ XIBM_POWERS_Q_n => XIBM_POWERS_Q ,&
+ CIBM_MODE_INTE1_Q_n => CIBM_MODE_INTE1_Q ,&
+ CIBM_MODE_INTE3_Q_n => CIBM_MODE_INTE3_Q ,&
+ CIBM_MODE_BOUND_Q_n => CIBM_MODE_BOUND_Q ,&
+ CIBM_TYPE_BOUND_Q_n => CIBM_TYPE_BOUND_Q ,&
+ CIBM_FORC_BOUND_Q_n => CIBM_FORC_BOUND_Q ,&
+ XIBM_FORC_BOUND_Q_n => XIBM_FORC_BOUND_Q ,&
+
+ NIBM_LAYER_R_n => NIBM_LAYER_R ,&
+ XIBM_RADIUS_R_n => XIBM_RADIUS_R ,&
+ XIBM_POWERS_R_n => XIBM_POWERS_R ,&
+ CIBM_MODE_INTE1_R_n => CIBM_MODE_INTE1_R ,&
+ CIBM_MODE_INTE3_R_n => CIBM_MODE_INTE3_R ,&
+ CIBM_MODE_BOUND_R_n => CIBM_MODE_BOUND_R ,&
+ CIBM_TYPE_BOUND_R_n => CIBM_TYPE_BOUND_R ,&
+ CIBM_FORC_BOUND_R_n => CIBM_FORC_BOUND_R ,&
+ XIBM_FORC_BOUND_R_n => XIBM_FORC_BOUND_R ,&
+
+ NIBM_LAYER_S_n => NIBM_LAYER_S ,&
+ XIBM_RADIUS_S_n => XIBM_RADIUS_S ,&
+ XIBM_POWERS_S_n => XIBM_POWERS_S ,&
+ CIBM_MODE_INTE1_S_n => CIBM_MODE_INTE1_S ,&
+ CIBM_MODE_INTE3_S_n => CIBM_MODE_INTE3_S ,&
+ CIBM_MODE_BOUND_S_n => CIBM_MODE_BOUND_S ,&
+ CIBM_TYPE_BOUND_S_n => CIBM_TYPE_BOUND_S ,&
+ CIBM_FORC_BOUND_S_n => CIBM_FORC_BOUND_S ,&
+ XIBM_FORC_BOUND_S_n => XIBM_FORC_BOUND_S ,&
+
+ NIBM_LAYER_T_n => NIBM_LAYER_T ,&
+ XIBM_RADIUS_T_n => XIBM_RADIUS_T ,&
+ XIBM_POWERS_T_n => XIBM_POWERS_T ,&
+ CIBM_MODE_INTE1_T_n => CIBM_MODE_INTE1_T ,&
+ CIBM_MODE_INTE3_T_n => CIBM_MODE_INTE3_T ,&
+ CIBM_MODE_BOUND_T_n => CIBM_MODE_BOUND_T ,&
+ CIBM_TYPE_BOUND_T_n => CIBM_TYPE_BOUND_T ,&
+ CIBM_FORC_BOUND_T_n => CIBM_FORC_BOUND_T ,&
+ XIBM_FORC_BOUND_T_n => XIBM_FORC_BOUND_T ,&
+
+ NIBM_LAYER_E_n => NIBM_LAYER_E ,&
+ XIBM_RADIUS_E_n => XIBM_RADIUS_E ,&
+ XIBM_POWERS_E_n => XIBM_POWERS_E ,&
+ CIBM_MODE_INTE1_E_n => CIBM_MODE_INTE1_E ,&
+ CIBM_MODE_INTE3_E_n => CIBM_MODE_INTE3_E ,&
+ CIBM_MODE_BOUND_E_n => CIBM_MODE_BOUND_E ,&
+ CIBM_TYPE_BOUND_E_n => CIBM_TYPE_BOUND_E ,&
+ CIBM_FORC_BOUND_E_n => CIBM_FORC_BOUND_E ,&
+ XIBM_FORC_BOUND_E_n => XIBM_FORC_BOUND_E ,&
+
+ NIBM_LAYER_V_n => NIBM_LAYER_V ,&
+ XIBM_RADIUS_V_n => XIBM_RADIUS_V ,&
+ XIBM_POWERS_V_n => XIBM_POWERS_V ,&
+ CIBM_MODE_INTE1NV_n => CIBM_MODE_INTE1NV ,&
+ CIBM_MODE_INTE1TV_n => CIBM_MODE_INTE1TV ,&
+ CIBM_MODE_INTE1CV_n => CIBM_MODE_INTE1CV ,&
+ CIBM_MODE_INTE3_V_n => CIBM_MODE_INTE3_V ,&
+ CIBM_MODE_BOUNN_V_n => CIBM_MODE_BOUNN_V ,&
+ CIBM_TYPE_BOUNN_V_n => CIBM_TYPE_BOUNN_V ,&
+ CIBM_MODE_BOUNT_V_n => CIBM_MODE_BOUNT_V ,&
+ CIBM_TYPE_BOUNT_V_n => CIBM_TYPE_BOUNT_V ,&
+ CIBM_MODE_BOUNC_V_n => CIBM_MODE_BOUNC_V ,&
+ CIBM_TYPE_BOUNC_V_n => CIBM_TYPE_BOUNC_V ,&
+ CIBM_FORC_BOUNN_V_n => CIBM_FORC_BOUNN_V ,&
+ CIBM_FORC_BOUNR_V_n => CIBM_FORC_BOUNR_V ,&
+ CIBM_FORC_BOUNT_V_n => CIBM_FORC_BOUNT_V ,&
+ CIBM_FORC_BOUNC_V_n => CIBM_FORC_BOUNC_V ,&
+ XIBM_FORC_BOUNN_V_n => XIBM_FORC_BOUNN_V ,&
+ XIBM_FORC_BOUNT_V_n => XIBM_FORC_BOUNT_V ,&
+ XIBM_FORC_BOUNC_V_n => XIBM_FORC_BOUNC_V
+!
+IMPLICIT NONE
+!
+LOGICAL,SAVE :: LIBM,LIBM_TROUBLE
+REAL,SAVE :: XIBM_EPSI
+REAL,SAVE :: XIBM_IEPS
+REAL,SAVE :: XIBM_RUG,XIBM_VISC,XIBM_CNU
+INTEGER,SAVE :: NIBM_ITR
+INTEGER,SAVE :: NIBM_LAYER_P,NIBM_LAYER_Q,NIBM_LAYER_R,NIBM_LAYER_S,NIBM_LAYER_T,NIBM_LAYER_E,NIBM_LAYER_V
+CHARACTER (LEN=6),SAVE :: CIBM_ADV
+CHARACTER (LEN=3),SAVE :: CIBM_MODE_INTE1_P,CIBM_MODE_INTE1_Q,CIBM_MODE_INTE1_R,CIBM_MODE_INTE1_S,&
+ CIBM_MODE_INTE1_T,CIBM_MODE_INTE1_E,&
+ CIBM_MODE_INTE1NV,CIBM_MODE_INTE1TV,CIBM_MODE_INTE1CV,&
+ CIBM_MODE_INTE3_P,CIBM_MODE_INTE3_Q,CIBM_MODE_INTE3_R,CIBM_MODE_INTE3_S,&
+ CIBM_MODE_INTE3_T,CIBM_MODE_INTE3_E,CIBM_MODE_INTE3_V
+CHARACTER (LEN=3),SAVE :: CIBM_MODE_BOUND_P,CIBM_MODE_BOUND_Q,CIBM_MODE_BOUND_R,CIBM_MODE_BOUND_S,&
+ CIBM_MODE_BOUND_T,CIBM_MODE_BOUND_E,&
+ CIBM_TYPE_BOUND_P,CIBM_TYPE_BOUND_Q,CIBM_TYPE_BOUND_R,CIBM_TYPE_BOUND_S,&
+ CIBM_TYPE_BOUND_T,CIBM_TYPE_BOUND_E,&
+ CIBM_FORC_BOUND_P,CIBM_FORC_BOUND_Q,CIBM_FORC_BOUND_R,CIBM_FORC_BOUND_S,&
+ CIBM_FORC_BOUND_T,CIBM_FORC_BOUND_E,&
+ CIBM_MODE_BOUNN_V,CIBM_MODE_BOUNT_V,CIBM_MODE_BOUNC_V,&
+ CIBM_TYPE_BOUNN_V,CIBM_TYPE_BOUNT_V,CIBM_TYPE_BOUNC_V,&
+ CIBM_FORC_BOUNN_V,CIBM_FORC_BOUNT_V,CIBM_FORC_BOUNC_V,CIBM_FORC_BOUNR_V
+REAL,SAVE :: XIBM_FORC_BOUNN_V,XIBM_FORC_BOUNT_V,XIBM_FORC_BOUNC_V,&
+ XIBM_FORC_BOUND_P,XIBM_FORC_BOUND_Q,XIBM_FORC_BOUND_R,XIBM_FORC_BOUND_S,&
+ XIBM_FORC_BOUND_T,XIBM_FORC_BOUND_E
+REAL,SAVE :: XIBM_RADIUS_P,XIBM_RADIUS_Q,XIBM_RADIUS_R,XIBM_RADIUS_S,&
+ XIBM_RADIUS_T,XIBM_RADIUS_E,XIBM_RADIUS_V,&
+ XIBM_POWERS_P,XIBM_POWERS_Q,XIBM_POWERS_R,XIBM_POWERS_S,&
+ XIBM_POWERS_T,XIBM_POWERS_E,XIBM_POWERS_V
+!
+NAMELIST /NAM_IBM_PARAMn/ LIBM, LIBM_TROUBLE, CIBM_ADV, NIBM_ITR, &
+ XIBM_VISC, XIBM_EPSI, XIBM_IEPS, XIBM_RUG, XIBM_CNU, &
+ NIBM_LAYER_P,NIBM_LAYER_Q,NIBM_LAYER_R,NIBM_LAYER_S,&
+ NIBM_LAYER_T,NIBM_LAYER_E,NIBM_LAYER_V,&
+ CIBM_MODE_INTE1_P,CIBM_MODE_INTE1_Q,CIBM_MODE_INTE1_R,CIBM_MODE_INTE1_S,&
+ CIBM_MODE_INTE1_T,CIBM_MODE_INTE1_E,&
+ CIBM_MODE_INTE1NV,CIBM_MODE_INTE1TV,CIBM_MODE_INTE1CV,&
+ CIBM_MODE_INTE3_P,CIBM_MODE_INTE3_Q,CIBM_MODE_INTE3_R,CIBM_MODE_INTE3_S,&
+ CIBM_MODE_INTE3_T,CIBM_MODE_INTE3_E,CIBM_MODE_INTE3_V,&
+ CIBM_MODE_BOUND_P,CIBM_MODE_BOUND_Q,CIBM_MODE_BOUND_R,CIBM_MODE_BOUND_S,&
+ CIBM_MODE_BOUND_T,CIBM_MODE_BOUND_E,&
+ CIBM_TYPE_BOUND_P,CIBM_TYPE_BOUND_Q,CIBM_TYPE_BOUND_R,CIBM_TYPE_BOUND_S,&
+ CIBM_TYPE_BOUND_T,CIBM_TYPE_BOUND_E,&
+ CIBM_FORC_BOUND_P,CIBM_FORC_BOUND_Q,CIBM_FORC_BOUND_R,CIBM_FORC_BOUND_S,&
+ CIBM_FORC_BOUND_T,CIBM_FORC_BOUND_E,&
+ XIBM_FORC_BOUND_P,XIBM_FORC_BOUND_Q,XIBM_FORC_BOUND_R,XIBM_FORC_BOUND_S,&
+ XIBM_FORC_BOUND_T,XIBM_FORC_BOUND_E,&
+ CIBM_MODE_BOUNN_V,CIBM_MODE_BOUNT_V,CIBM_MODE_BOUNC_V,&
+ CIBM_TYPE_BOUNN_V,CIBM_TYPE_BOUNT_V,CIBM_TYPE_BOUNC_V,&
+ CIBM_FORC_BOUNN_V,CIBM_FORC_BOUNT_V,CIBM_FORC_BOUNC_V,CIBM_FORC_BOUNR_V,&
+ XIBM_FORC_BOUNN_V,XIBM_FORC_BOUNT_V,XIBM_FORC_BOUNC_V,&
+ XIBM_RADIUS_P,XIBM_RADIUS_Q,XIBM_RADIUS_R,XIBM_RADIUS_S,&
+ XIBM_RADIUS_T,XIBM_RADIUS_E,XIBM_RADIUS_V,&
+ XIBM_POWERS_P,XIBM_POWERS_Q,XIBM_POWERS_R,XIBM_POWERS_S,&
+ XIBM_POWERS_T,XIBM_POWERS_E,XIBM_POWERS_V
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_IBM_PARAMn
+ LIBM = LIBM_n
+ CIBM_ADV = CIBM_ADV_n
+ NIBM_ITR = NIBM_ITR_n
+ LIBM_TROUBLE = LIBM_TROUBLE_n
+ XIBM_EPSI = XIBM_EPSI_n
+ XIBM_IEPS = XIBM_IEPS_n
+ XIBM_RUG = XIBM_RUG_n
+ XIBM_VISC = XIBM_VISC_n
+ XIBM_CNU = XIBM_CNU_n
+
+ NIBM_LAYER_P = NIBM_LAYER_P_n
+ XIBM_RADIUS_P = XIBM_RADIUS_P_n
+ XIBM_POWERS_P = XIBM_POWERS_P_n
+ CIBM_MODE_INTE1_P = CIBM_MODE_INTE1_P_n
+ CIBM_MODE_INTE3_P = CIBM_MODE_INTE3_P_n
+ CIBM_MODE_BOUND_P = CIBM_MODE_BOUND_P_n
+ CIBM_TYPE_BOUND_P = CIBM_TYPE_BOUND_P_n
+ CIBM_FORC_BOUND_P = CIBM_FORC_BOUND_P_n
+ XIBM_FORC_BOUND_P = XIBM_FORC_BOUND_P_n
+
+ NIBM_LAYER_Q = NIBM_LAYER_Q_n
+ XIBM_RADIUS_Q = XIBM_RADIUS_Q_n
+ XIBM_POWERS_Q = XIBM_POWERS_Q_n
+ CIBM_MODE_INTE1_Q = CIBM_MODE_INTE1_Q_n
+ CIBM_MODE_INTE3_Q = CIBM_MODE_INTE3_Q_n
+ CIBM_MODE_BOUND_Q = CIBM_MODE_BOUND_Q_n
+ CIBM_TYPE_BOUND_Q = CIBM_TYPE_BOUND_Q_n
+ CIBM_FORC_BOUND_Q = CIBM_FORC_BOUND_Q_n
+ XIBM_FORC_BOUND_Q = XIBM_FORC_BOUND_Q_n
+
+ NIBM_LAYER_R = NIBM_LAYER_R_n
+ XIBM_RADIUS_R = XIBM_RADIUS_R_n
+ XIBM_POWERS_R = XIBM_POWERS_R_n
+ CIBM_MODE_INTE1_R = CIBM_MODE_INTE1_R_n
+ CIBM_MODE_INTE3_R = CIBM_MODE_INTE3_R_n
+ CIBM_MODE_BOUND_R = CIBM_MODE_BOUND_R_n
+ CIBM_TYPE_BOUND_R = CIBM_TYPE_BOUND_R_n
+ CIBM_FORC_BOUND_R = CIBM_FORC_BOUND_R_n
+ XIBM_FORC_BOUND_R = XIBM_FORC_BOUND_R_n
+
+ NIBM_LAYER_S = NIBM_LAYER_S_n
+ XIBM_RADIUS_S = XIBM_RADIUS_S_n
+ XIBM_POWERS_S = XIBM_POWERS_S_n
+ CIBM_MODE_INTE1_S = CIBM_MODE_INTE1_S_n
+ CIBM_MODE_INTE3_S = CIBM_MODE_INTE3_S_n
+ CIBM_MODE_BOUND_S = CIBM_MODE_BOUND_S_n
+ CIBM_TYPE_BOUND_S = CIBM_TYPE_BOUND_S_n
+ CIBM_FORC_BOUND_S = CIBM_FORC_BOUND_S_n
+ XIBM_FORC_BOUND_S = XIBM_FORC_BOUND_S_n
+
+ NIBM_LAYER_T = NIBM_LAYER_T_n
+ XIBM_RADIUS_T = XIBM_RADIUS_T_n
+ XIBM_POWERS_T = XIBM_POWERS_T_n
+ CIBM_MODE_INTE1_T = CIBM_MODE_INTE1_T_n
+ CIBM_MODE_INTE3_T = CIBM_MODE_INTE3_T_n
+ CIBM_MODE_BOUND_T = CIBM_MODE_BOUND_T_n
+ CIBM_TYPE_BOUND_T = CIBM_TYPE_BOUND_T_n
+ CIBM_FORC_BOUND_T = CIBM_FORC_BOUND_T_n
+ XIBM_FORC_BOUND_T = XIBM_FORC_BOUND_T_n
+
+ NIBM_LAYER_E = NIBM_LAYER_E_n
+ XIBM_RADIUS_E = XIBM_RADIUS_E_n
+ XIBM_POWERS_E = XIBM_POWERS_E_n
+ CIBM_MODE_INTE1_E = CIBM_MODE_INTE1_E_n
+ CIBM_MODE_INTE3_E = CIBM_MODE_INTE3_E_n
+ CIBM_MODE_BOUND_E = CIBM_MODE_BOUND_E_n
+ CIBM_TYPE_BOUND_E = CIBM_TYPE_BOUND_E_n
+ CIBM_FORC_BOUND_E = CIBM_FORC_BOUND_E_n
+ XIBM_FORC_BOUND_E = XIBM_FORC_BOUND_E_n
+
+ NIBM_LAYER_V = NIBM_LAYER_V_n
+ XIBM_RADIUS_V = XIBM_RADIUS_V_n
+ XIBM_POWERS_V = XIBM_POWERS_V_n
+ CIBM_MODE_INTE1NV = CIBM_MODE_INTE1NV_n
+ CIBM_MODE_INTE1TV = CIBM_MODE_INTE1TV_n
+ CIBM_MODE_INTE1CV = CIBM_MODE_INTE1CV_n
+ CIBM_MODE_INTE3_V = CIBM_MODE_INTE3_V_n
+ CIBM_MODE_BOUNN_V = CIBM_MODE_BOUNN_V_n
+ CIBM_TYPE_BOUNN_V = CIBM_TYPE_BOUNN_V_n
+ CIBM_MODE_BOUNT_V = CIBM_MODE_BOUNT_V_n
+ CIBM_TYPE_BOUNT_V = CIBM_TYPE_BOUNT_V_n
+ CIBM_MODE_BOUNC_V = CIBM_MODE_BOUNC_V_n
+ CIBM_TYPE_BOUNC_V = CIBM_TYPE_BOUNC_V_n
+ CIBM_FORC_BOUNN_V = CIBM_FORC_BOUNN_V_n
+ CIBM_FORC_BOUNR_V = CIBM_FORC_BOUNR_V_n
+ CIBM_FORC_BOUNT_V = CIBM_FORC_BOUNT_V_n
+ CIBM_FORC_BOUNC_v = CIBM_FORC_BOUNC_V_n
+ XIBM_FORC_BOUNN_V = XIBM_FORC_BOUNN_V_n
+ XIBM_FORC_BOUNT_V = XIBM_FORC_BOUNT_V_n
+ XIBM_FORC_BOUNC_v = XIBM_FORC_BOUNC_V_n
+
+END SUBROUTINE INIT_NAM_IBM_PARAMn
+
+SUBROUTINE UPDATE_NAM_IBM_PARAMn
+ LIBM_n = LIBM
+ CIBM_ADV_n = CIBM_ADV
+ NIBM_ITR_n = NIBM_ITR
+ LIBM_TROUBLE_n = LIBM_TROUBLE
+ XIBM_EPSI_n = XIBM_EPSI
+ XIBM_IEPS_n = XIBM_IEPS
+ XIBM_RUG_n = XIBM_RUG
+ XIBM_VISC_n = XIBM_VISC
+ XIBM_CNU_n = XIBM_CNU
+
+ NIBM_LAYER_P_n = NIBM_LAYER_P
+ XIBM_RADIUS_P_n = XIBM_RADIUS_P
+ XIBM_POWERS_P_n = XIBM_POWERS_P
+ CIBM_MODE_INTE1_P_n = CIBM_MODE_INTE1_P
+ CIBM_MODE_INTE3_P_n = CIBM_MODE_INTE3_P
+ CIBM_MODE_BOUND_P_n = CIBM_MODE_BOUND_P
+ CIBM_TYPE_BOUND_P_n = CIBM_TYPE_BOUND_P
+ CIBM_FORC_BOUND_P_n = CIBM_FORC_BOUND_P
+ XIBM_FORC_BOUND_P_n = XIBM_FORC_BOUND_P
+
+ NIBM_LAYER_Q_n = NIBM_LAYER_Q
+ XIBM_RADIUS_Q_n = XIBM_RADIUS_Q
+ XIBM_POWERS_Q_n = XIBM_POWERS_Q
+ CIBM_MODE_INTE1_Q_n = CIBM_MODE_INTE1_Q
+ CIBM_MODE_INTE3_Q_n = CIBM_MODE_INTE3_Q
+ CIBM_MODE_BOUND_Q_n = CIBM_MODE_BOUND_Q
+ CIBM_TYPE_BOUND_Q_n = CIBM_TYPE_BOUND_Q
+ CIBM_FORC_BOUND_Q_n = CIBM_FORC_BOUND_Q
+ XIBM_FORC_BOUND_Q_n = XIBM_FORC_BOUND_Q
+
+ NIBM_LAYER_R_n = NIBM_LAYER_R
+ XIBM_RADIUS_R_n = XIBM_RADIUS_R
+ XIBM_POWERS_R_n = XIBM_POWERS_R
+ CIBM_MODE_INTE1_R_n = CIBM_MODE_INTE1_R
+ CIBM_MODE_INTE3_R_n = CIBM_MODE_INTE3_R
+ CIBM_MODE_BOUND_R_n = CIBM_MODE_BOUND_R
+ CIBM_TYPE_BOUND_R_n = CIBM_TYPE_BOUND_R
+ CIBM_FORC_BOUND_R_n = CIBM_FORC_BOUND_R
+ XIBM_FORC_BOUND_R_n = XIBM_FORC_BOUND_R
+
+ NIBM_LAYER_S_n = NIBM_LAYER_S
+ XIBM_RADIUS_S_n = XIBM_RADIUS_S
+ XIBM_POWERS_S_n = XIBM_POWERS_S
+ CIBM_MODE_INTE1_S_n = CIBM_MODE_INTE1_S
+ CIBM_MODE_INTE3_S_n = CIBM_MODE_INTE3_S
+ CIBM_MODE_BOUND_S_n = CIBM_MODE_BOUND_S
+ CIBM_TYPE_BOUND_S_n = CIBM_TYPE_BOUND_S
+ CIBM_FORC_BOUND_S_n = CIBM_FORC_BOUND_S
+ XIBM_FORC_BOUND_S_n = XIBM_FORC_BOUND_S
+
+ NIBM_LAYER_T_n = NIBM_LAYER_T
+ XIBM_RADIUS_T_n = XIBM_RADIUS_T
+ XIBM_POWERS_T_n = XIBM_POWERS_T
+ CIBM_MODE_INTE1_T_n = CIBM_MODE_INTE1_T
+ CIBM_MODE_INTE3_T_n = CIBM_MODE_INTE3_T
+ CIBM_MODE_BOUND_T_n = CIBM_MODE_BOUND_T
+ CIBM_TYPE_BOUND_T_n = CIBM_TYPE_BOUND_T
+ CIBM_FORC_BOUND_T_n = CIBM_FORC_BOUND_T
+ XIBM_FORC_BOUND_T_n = XIBM_FORC_BOUND_T
+
+ NIBM_LAYER_E_n = NIBM_LAYER_E
+ XIBM_RADIUS_E_n = XIBM_RADIUS_E
+ XIBM_POWERS_E_n = XIBM_POWERS_E
+ CIBM_MODE_INTE1_E_n = CIBM_MODE_INTE1_E
+ CIBM_MODE_INTE3_E_n = CIBM_MODE_INTE3_E
+ CIBM_MODE_BOUND_E_n = CIBM_MODE_BOUND_E
+ CIBM_TYPE_BOUND_E_n = CIBM_TYPE_BOUND_E
+ CIBM_FORC_BOUND_E_n = CIBM_FORC_BOUND_E
+ XIBM_FORC_BOUND_E_n = XIBM_FORC_BOUND_E
+
+ NIBM_LAYER_V_n = NIBM_LAYER_V
+ XIBM_RADIUS_V_n = XIBM_RADIUS_V
+ XIBM_POWERS_V_n = XIBM_POWERS_V
+ CIBM_MODE_INTE1NV_n = CIBM_MODE_INTE1NV
+ CIBM_MODE_INTE1TV_n = CIBM_MODE_INTE1TV
+ CIBM_MODE_INTE1CV_n = CIBM_MODE_INTE1CV
+ CIBM_MODE_INTE3_V_n = CIBM_MODE_INTE3_V
+ CIBM_MODE_BOUNN_V_n = CIBM_MODE_BOUNN_V
+ CIBM_TYPE_BOUNN_V_n = CIBM_TYPE_BOUNN_V
+ CIBM_MODE_BOUNT_V_n = CIBM_MODE_BOUNT_V
+ CIBM_TYPE_BOUNT_V_n = CIBM_TYPE_BOUNT_V
+ CIBM_MODE_BOUNC_V_n = CIBM_MODE_BOUNC_V
+ CIBM_TYPE_BOUNC_V_n = CIBM_TYPE_BOUNC_V
+ XIBM_FORC_BOUNN_V_n = XIBM_FORC_BOUNN_V
+ CIBM_FORC_BOUNN_V_n = CIBM_FORC_BOUNN_V
+ CIBM_FORC_BOUNR_V_n = CIBM_FORC_BOUNR_V
+ XIBM_FORC_BOUNT_V_n = XIBM_FORC_BOUNT_V
+ CIBM_FORC_BOUNT_V_n = CIBM_FORC_BOUNT_V
+ XIBM_FORC_BOUNC_V_n = XIBM_FORC_BOUNC_V
+ CIBM_FORC_BOUNC_V_n = CIBM_FORC_BOUNC_V
+
+END SUBROUTINE UPDATE_NAM_IBM_PARAMn
+!------------------------------------------------------------------------------
+END MODULE MODN_IBM_PARAM_n
diff --git a/src/MNH/modn_nesting.f90 b/src/MNH/modn_nesting.f90
index 90a3f00212fc22a1a5b535a9353b1bb736c5571e..6ed5dda136fccf1b1983c8c072cb7ef51fa3b5a4 100644
--- a/src/MNH/modn_nesting.f90
+++ b/src/MNH/modn_nesting.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-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 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$ $Revision$
-! MASDEV4_7 modn 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###################
MODULE MODN_NESTING
! ###################
@@ -43,16 +38,18 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original 16/08/95
+!! Original 16/08/95
+!! JL Redelsperger 03/2021 : Add Auto-coupled O-A LES case
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_NESTING
+USE MODD_REF, ONLY: LCOUPLES
!
IMPLICIT NONE
!
-NAMELIST/NAM_NESTING/NDAD,NDTRATIO,XWAY
+NAMELIST/NAM_NESTING/NDAD,NDTRATIO,XWAY,LCOUPLES
!
END MODULE MODN_NESTING
diff --git a/src/MNH/modn_param_lima.f90 b/src/MNH/modn_param_lima.f90
index 0b3c41d5e4495c8839490c3f29dea7521ef67ef9..f86b1add06cd8ac04da64b6bac6556d924bbc223 100644
--- a/src/MNH/modn_param_lima.f90
+++ b/src/MNH/modn_param_lima.f90
@@ -1,4 +1,9 @@
-! ######################
+!MNH_LIC Copyright 2001-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.
+!-------------------------------------------------------------------------------
+! ######################
MODULE MODN_PARAM_LIMA
! ######################
!
@@ -19,7 +24,8 @@ NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,&
XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, &
XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, &
!
- LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, &
+ LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, LSPRO, &
+ LADJ, &
NMOD_CCN, XCCN_CONC, &
LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, &
XALPHAC, XNUC, XALPHAR, XNUR, &
diff --git a/src/MNH/modn_recycl_paramn.f90 b/src/MNH/modn_recycl_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fbe4cf57671ac025b45799a14c88e53458838c80
--- /dev/null
+++ b/src/MNH/modn_recycl_paramn.f90
@@ -0,0 +1,118 @@
+!MNH_LIC Copyright 2019-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.
+!-----------------------------------------------------------------
+!
+! #######################
+ MODULE MODN_RECYCL_PARAM_n
+! #######################
+!
+!**** *MODN_RECYCL_PARAM$n* - declaration of namelist NAM_RECYCL_PARAMn
+!
+! PURPOSE
+! -------
+!**** The purpose of this declarative module is to declare the constants
+! allowing to initialize the turbulence recycling method
+!
+!
+! IMPLICIT ARGUMENTS
+! ------------------
+! Module MODD_RECYCL_PARAM$n : contains declaration of RECYCLING parameters
+!
+!
+! REFERENCE
+! ---------
+!
+! AUTHOR
+! ------
+! Tim Nagel (Meteo-France)
+!
+! MODIFICATIONS
+! -------------
+! Original 01/02/2021
+!
+USE MODD_RECYCL_PARAM_n, ONLY: &
+ LRECYCL_n => LRECYCL, &
+ LRECYCLN_n => LRECYCLN, &
+ LRECYCLW_n => LRECYCLW, &
+ LRECYCLE_n => LRECYCLE, &
+ LRECYCLS_n => LRECYCLS, &
+ XDRECYCLN_n => XDRECYCLN , &
+ XARECYCLN_n => XARECYCLN , &
+ XDRECYCLW_n => XDRECYCLW , &
+ XARECYCLW_n => XARECYCLW , &
+ XDRECYCLE_n => XDRECYCLE , &
+ XARECYCLE_n => XARECYCLE , &
+ XDRECYCLS_n => XDRECYCLS , &
+ XARECYCLS_n => XARECYCLS , &
+ XTMOY_n => XTMOY, &
+ XTMOYCOUNT_n => XTMOYCOUNT , &
+ XNUMBELT_n => XNUMBELT, &
+ XRCOEFF_n => XRCOEFF, &
+ XTBVTOP_n => XTBVTOP, &
+ XTBVBOT_n => XTBVBOT
+!
+IMPLICIT NONE
+!
+LOGICAL,SAVE :: LRECYCL,LRECYCLN,LRECYCLW,LRECYCLE,LRECYCLS
+REAL,SAVE :: XDRECYCLN,XARECYCLN,XDRECYCLW,XARECYCLW,XDRECYCLE,XARECYCLE,XDRECYCLS,&
+ XARECYCLS,XTMOY,XTMOYCOUNT,XNUMBELT,XRCOEFF,XTBVTOP,XTBVBOT
+
+!
+NAMELIST /NAM_RECYCL_PARAMn/ LRECYCL,LRECYCLN,LRECYCLW,LRECYCLE,LRECYCLS,XDRECYCLW, &
+ XARECYCLW,XDRECYCLN,XARECYCLN,XDRECYCLE,XARECYCLE,XDRECYCLS,&
+ XARECYCLS,XTMOY,XTMOYCOUNT,XNUMBELT,XRCOEFF,XTBVTOP,XTBVBOT
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_RECYCL_PARAMn
+ LRECYCL = LRECYCL_n
+ LRECYCLN = LRECYCLN_n
+ LRECYCLW = LRECYCLW_n
+ LRECYCLE = LRECYCLE_n
+ LRECYCLS = LRECYCLS_n
+ XDRECYCLN = XDRECYCLN_n
+ XARECYCLN = XARECYCLN_n
+ XDRECYCLW = XDRECYCLW_n
+ XARECYCLW = XARECYCLW_n
+ XDRECYCLE = XDRECYCLE_n
+ XARECYCLE = XARECYCLE_n
+ XDRECYCLS = XDRECYCLS_n
+ XARECYCLS = XARECYCLS_n
+ XTMOY = XTMOY_n
+ XTMOYCOUNT = XTMOYCOUNT_n
+ XNUMBELT = XNUMBELT_n
+ XRCOEFF = XRCOEFF_n
+ XTBVTOP = XTBVTOP_n
+ XTBVBOT = XTBVBOT_n
+
+
+END SUBROUTINE INIT_NAM_RECYCL_PARAMn
+
+SUBROUTINE UPDATE_NAM_RECYCL_PARAMn
+ LRECYCL_n = LRECYCL
+ LRECYCLN_n = LRECYCLN
+ LRECYCLW_n = LRECYCLW
+ LRECYCLE_n = LRECYCLE
+ LRECYCLS_n = LRECYCLS
+ XDRECYCLN_n = XDRECYCLN
+ XARECYCLN_n = XARECYCLN
+ XDRECYCLW_n = XDRECYCLW
+ XARECYCLW_n = XARECYCLW
+ XDRECYCLE_n = XDRECYCLE
+ XARECYCLE_n = XARECYCLE
+ XDRECYCLS_n = XDRECYCLS
+ XARECYCLS_n = XARECYCLS
+ XTMOY_n = XTMOY
+ XTMOYCOUNT_n = XTMOYCOUNT
+ XNUMBELT_n = XNUMBELT
+ XRCOEFF_n = XRCOEFF
+ XTBVTOP_n = XTBVTOP
+ XTBVBOT_n = XTBVBOT
+
+
+END SUBROUTINE UPDATE_NAM_RECYCL_PARAMn
+!------------------------------------------------------------------------------
+END MODULE MODN_RECYCL_PARAM_n
+!
diff --git a/src/MNH/modn_stationn.f90 b/src/MNH/modn_stationn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6715b3c645ea69132add98d2d21a4371fd3fd78c
--- /dev/null
+++ b/src/MNH/modn_stationn.f90
@@ -0,0 +1,90 @@
+!MNH_LIC Copyright 2020-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.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODN_STATION_n
+!! #####################
+!!
+!!*** *MODN_STATION*
+!!
+!! PURPOSE
+!! -------
+! Namelist to define the stations
+!!
+!!** AUTHOR
+!! ------
+!! E. Jézéquel *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 10/03/20
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+USE MODD_STATION_n
+USE MODD_ALLSTATION_n, ONLY:&
+ NNUMB_STAT_n =>NNUMB_STAT ,&
+ XSTEP_STAT_n =>XSTEP_STAT ,&
+ XX_STAT_n =>XX_STAT ,&
+ XY_STAT_n =>XY_STAT ,&
+ XLAT_STAT_n =>XLAT_STAT ,&
+ XLON_STAT_n =>XLON_STAT ,&
+ XZ_STAT_n =>XZ_STAT ,&
+ CNAME_STAT_n =>CNAME_STAT ,&
+ CTYPE_STAT_n =>CTYPE_STAT ,&
+ CFILE_STAT_n =>CFILE_STAT ,&
+ LDIAG_RESULTS_n =>LDIAG_RESULTS
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+INTEGER ,SAVE:: NNUMB_STAT
+REAL ,SAVE:: XSTEP_STAT
+REAL, DIMENSION(100) ,SAVE:: XX_STAT, XY_STAT, XZ_STAT, XLAT_STAT, XLON_STAT
+CHARACTER (LEN=7), DIMENSION(100),SAVE:: CNAME_STAT, CTYPE_STAT
+CHARACTER (LEN=20) ,SAVE:: CFILE_STAT !filename
+LOGICAL ,SAVE:: LDIAG_RESULTS
+
+NAMELIST /NAM_STATIONn/ &
+ NNUMB_STAT, XSTEP_STAT, &
+ XX_STAT,XY_STAT,XZ_STAT,&
+ XLON_STAT,XLAT_STAT,&
+ CNAME_STAT,CTYPE_STAT,&
+ CFILE_STAT,LDIAG_RESULTS
+
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_STATIONn
+ NNUMB_STAT = NNUMB_STAT_n
+ XSTEP_STAT = XSTEP_STAT_n
+ XX_STAT = XX_STAT_n
+ XY_STAT = XY_STAT_n
+ XLAT_STAT = XLAT_STAT_n
+ XLON_STAT = XLON_STAT_n
+ XZ_STAT = XZ_STAT_n
+ CNAME_STAT = CNAME_STAT_n
+ CTYPE_STAT = CTYPE_STAT_n
+ CFILE_STAT = CFILE_STAT_n
+ LDIAG_RESULTS= LDIAG_RESULTS_n
+END SUBROUTINE INIT_NAM_STATIONn
+
+SUBROUTINE UPDATE_NAM_STATIONn
+ NNUMB_STAT_n = NNUMB_STAT
+ XSTEP_STAT_n = XSTEP_STAT
+ XX_STAT_n = XX_STAT
+ XY_STAT_n = XY_STAT
+ XLAT_STAT_n = XLAT_STAT
+ XLON_STAT_n = XLON_STAT
+ XZ_STAT_n = XZ_STAT
+ CNAME_STAT_n = CNAME_STAT
+ CTYPE_STAT_n = CTYPE_STAT
+ CFILE_STAT_n = CFILE_STAT
+ LDIAG_RESULTS_n= LDIAG_RESULTS
+END SUBROUTINE UPDATE_NAM_STATIONn
+END MODULE MODN_STATION_n
diff --git a/src/MNH/modn_turbn.f90 b/src/MNH/modn_turbn.f90
index a91112bee27e5a13e81436142becc9f120a120ca..3e777d2da81815862ba89818f858227e14421550 100644
--- a/src/MNH/modn_turbn.f90
+++ b/src/MNH/modn_turbn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-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 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$ $Revision$
-! MASDEV4_7 modn 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###################
MODULE MODN_TURB_n
! ###################
@@ -47,6 +42,7 @@
!! P. Bechtold Feb 11, 2002 add switch for Sigma_s computation
!! P. Jabouille Apr 4, 2002 add switch for Sigma_s convection
!! V. Masson Nov 13 2002 add switch for SBL lengths
+!! D. Ricard May, 2021 add switch for Leonard Terms
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -56,6 +52,7 @@ USE MODD_TURB_n, ONLY: &
XIMPL_n => XIMPL, &
XKEMIN_n => XKEMIN, &
XCEDIS_n => XCEDIS, &
+ XCADAP_n => XCADAP, &
CTURBLEN_n => CTURBLEN, &
CTURBDIM_n => CTURBDIM, &
LTURB_FLX_n => LTURB_FLX, &
@@ -66,13 +63,23 @@ USE MODD_TURB_n, ONLY: &
LRMC01_n => LRMC01, &
CTOM_n => CTOM, &
CSUBG_AUCV_n => CSUBG_AUCV, &
- VSIGQSAT_n => VSIGQSAT
+ VSIGQSAT_n => VSIGQSAT, &
+ CSUBG_AUCV_RI_n => CSUBG_AUCV_RI, &
+ CCONDENS_n => CCONDENS, &
+ CLAMBDA3_n => CLAMBDA3, &
+ CSUBG_MF_PDF_n => CSUBG_MF_PDF, &
+ LHGRAD_n => LHGRAD, &
+ XCOEFHGRADTHL_n => XCOEFHGRADTHL, &
+ XCOEFHGRADRM_n => XCOEFHGRADRM, &
+ XALTHGRAD_n => XALTHGRAD, &
+ XCLDTHOLD_n => XCLDTHOLD
!
IMPLICIT NONE
!
REAL,SAVE :: XIMPL
REAL,SAVE :: XKEMIN
REAL,SAVE :: XCEDIS
+REAL,SAVE :: XCADAP
CHARACTER (LEN=4),SAVE :: CTURBLEN
CHARACTER (LEN=4),SAVE :: CTURBDIM
LOGICAL,SAVE :: LTURB_FLX
@@ -83,11 +90,22 @@ LOGICAL,SAVE :: LSIG_CONV
LOGICAL,SAVE :: LRMC01
CHARACTER (LEN=4),SAVE :: CTOM
CHARACTER (LEN=4),SAVE :: CSUBG_AUCV
+CHARACTER (LEN=80),SAVE :: CSUBG_AUCV_RI
+CHARACTER (LEN=80),SAVE :: CCONDENS
+CHARACTER (LEN=4),SAVE :: CLAMBDA3
+CHARACTER (LEN=80),SAVE :: CSUBG_MF_PDF
REAL,SAVE :: VSIGQSAT
+LOGICAL,SAVE :: LHGRAD
+REAL,SAVE :: XCOEFHGRADTHL
+REAL,SAVE :: XCOEFHGRADRM
+REAL,SAVE :: XALTHGRAD
+REAL,SAVE :: XCLDTHOLD
!
NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
LSUBG_COND,LSIGMAS,LSIG_CONV,LRMC01,CTOM,CSUBG_AUCV,&
- XKEMIN,VSIGQSAT,XCEDIS
+ XKEMIN,VSIGQSAT,XCEDIS,XCADAP,CSUBG_AUCV_RI,CCONDENS,&
+ CLAMBDA3,CSUBG_MF_PDF,LHGRAD,XCOEFHGRADTHL, XCOEFHGRADRM, &
+ XALTHGRAD, XCLDTHOLD
!
CONTAINS
@@ -96,6 +114,7 @@ SUBROUTINE INIT_NAM_TURBn
XIMPL = XIMPL_n
XKEMIN = XKEMIN_n
XCEDIS = XCEDIS_n
+ XCADAP = XCADAP_n
CTURBLEN = CTURBLEN_n
CTURBDIM = CTURBDIM_n
LTURB_FLX = LTURB_FLX_n
@@ -107,12 +126,22 @@ SUBROUTINE INIT_NAM_TURBn
CTOM = CTOM_n
CSUBG_AUCV = CSUBG_AUCV_n
VSIGQSAT = VSIGQSAT_n
+ CSUBG_AUCV_RI = CSUBG_AUCV_RI_n
+ CCONDENS = CCONDENS_n
+ CLAMBDA3 = CLAMBDA3_n
+ CSUBG_MF_PDF = CSUBG_MF_PDF_n
+ LHGRAD = LHGRAD_n
+ XCOEFHGRADTHL = XCOEFHGRADTHL_n
+ XCOEFHGRADRM = XCOEFHGRADRM_n
+ XALTHGRAD = XALTHGRAD_n
+ XCLDTHOLD = XCLDTHOLD_n
END SUBROUTINE INIT_NAM_TURBn
SUBROUTINE UPDATE_NAM_TURBn
XIMPL_n = XIMPL
XKEMIN_n = XKEMIN
XCEDIS_n = XCEDIS
+ XCADAP_n = XCADAP
CTURBLEN_n = CTURBLEN
CTURBDIM_n = CTURBDIM
LTURB_FLX_n = LTURB_FLX
@@ -124,6 +153,15 @@ SUBROUTINE UPDATE_NAM_TURBn
CTOM_n = CTOM
CSUBG_AUCV_n = CSUBG_AUCV
VSIGQSAT_n = VSIGQSAT
+ CSUBG_AUCV_RI_n = CSUBG_AUCV_RI
+ CCONDENS_n = CCONDENS
+ CLAMBDA3_n = CLAMBDA3
+ CSUBG_MF_PDF_n = CSUBG_MF_PDF
+ LHGRAD_n = LHGRAD
+ XCOEFHGRADTHL_n = XCOEFHGRADTHL
+ XCOEFHGRADRM_n = XCOEFHGRADRM
+ XALTHGRAD_n = XALTHGRAD
+ XCLDTHOLD_n = XCLDTHOLD
END SUBROUTINE UPDATE_NAM_TURBn
END MODULE MODN_TURB_n
diff --git a/src/MNH/nhoa_coupln.f90 b/src/MNH/nhoa_coupln.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f8ea30639b021065de23652e151303524f0644f4
--- /dev/null
+++ b/src/MNH/nhoa_coupln.f90
@@ -0,0 +1,155 @@
+!MNH_LIC Copyright 2021-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.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_NHOA_COUPL_n
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE NHOA_COUPL_n(KDAD,PTSTEP,KMI,KTCOUNT,KKU)
+!
+INTEGER, INTENT(IN) :: KDAD ! Number of the DAD model
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! model number
+INTEGER, INTENT(IN) :: KKU
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+ ! (=1 at the segment beginning)
+!
+END SUBROUTINE NHOA_COUPL_n
+END INTERFACE
+END MODULE MODI_NHOA_COUPL_n
+!
+! ####################################################################
+SUBROUTINE NHOA_COUPL_n(KDAD,PTSTEP,KMI,KTCOUNT,KKU)
+! ####################################################################
+!!
+!! PURPOSE
+!! -------
+! To compute the flux at the O-A interface in the auto-coupling O-A LES case
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: JPHEXT,JPVEXT
+!! Module MODD_FIELD$n : XUT,XVT,XWT,XRT,XTHT,XPABST
+!! Module MODD_REF$n : XRHODJ, XRVREF,XTHVREF, XRHODREF
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! JL Redelsperger 03/2021 Version 0
+!! MODIFICATIONS
+!! -------------
+!!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+!
+USE MODD_PARAMETERS
+USE MODD_NESTING
+USE MODD_CST
+USE MODD_REF_n ! modules relative to the outer model $n
+USE MODD_FIELD_n
+USE MODD_CONF
+USE MODD_PARAM_n
+USE MODD_TURB_n
+USE MODD_DYN_n, ONLY : LOCEAN
+USE MODD_REF, ONLY: LCOUPLES
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KDAD ! Number of the DAD model
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! model number
+INTEGER, INTENT(IN) :: KKU !
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IIB,IIE,IJB,IJE,IIU,IJU
+INTEGER :: IKE
+INTEGER :: ILBX,ILBY,ILBX2,ILBY2
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+ ! (=1 at the segment beginning)
+!
+INTEGER :: JRR,JSV ! Loop index
+!
+INTEGER :: IINFO_ll, IDIMX, IDIMY
+! surface variables: wind, current, Temp
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOUPUA,ZCOUPVA,ZCOUPTA
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOUPUO,ZCOUPVO,ZCOUPTO
+!surf flux local work space
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOUPTFL,ZCOUPUFL,ZCOUPVFL
+CHARACTER(LEN=4) :: ZINIT_TYPE
+!
+!---Coupled OA MesoNH----------------------------------------------------------------------------
+!* 0. INITIALISATION
+! --------------
+! allocate flux local array
+ALLOCATE(ZCOUPTFL(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPUFL(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPVFL(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+! allocate sfc variable local array
+ALLOCATE(ZCOUPUA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPVA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPTA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPUO(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPVO(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPTO(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+! values in ocean sfc
+IKE=KKU-JPVEXT
+ZCOUPUO(:,:)= XUT(:,:,IKE)
+ZCOUPVO(:,:)= XVT(:,:,IKE)
+ZCOUPTO(:,:)= XTHT(:,:,IKE)
+!
+! we are going to the atmos model i.e. Model 1
+CALL GOTO_MODEL(KDAD)
+IIB=1
+IIE=IIU
+IJB=1
+IJE=IJU
+!
+! compute gradient between ocean & atmosphere
+ZCOUPUA(:,:)= XUT(:,:,2)-ZCOUPUO(:,:)
+ZCOUPVA(:,:)= XVT(:,:,2)-ZCOUPVO(:,:)
+ZCOUPTA(:,:)= XTHT(:,:,2)-ZCOUPTO(:,:)
+!
+! sfc flux computation * RHO AIR !!!!
+! flux vu atmosp
+!
+ZCOUPTFL(:,:) = -1.2*1.E-3* SQRT(ZCOUPUA(:,:)**2 +ZCOUPVA(:,:)**2) * ZCOUPTA(:,:)
+ZCOUPUFL(:,:) = -1.2*1.E-3* SQRT(ZCOUPUA(:,:)**2 +ZCOUPVA(:,:)**2) * ZCOUPUA(:,:)
+ZCOUPVFL(:,:) = -1.2*1.E-3* SQRT(ZCOUPUA(:,:)**2 +ZCOUPVA(:,:)**2) * ZCOUPVA(:,:)
+!
+XSSUFL_C(:,:,1)= ZCOUPUFL(:,:)
+XSSVFL_C(:,:,1)= ZCOUPVFL(:,:)
+XSSTFL_C(:,:,1)= ZCOUPTFL(:,:)
+!
+!
+! We are going back in the ocean model
+! same sign & unit at the top of ocean model and the bottom of atmospheric model
+! rho_atmos * (w'u')_atmos = rho_ocean * (u'w')_ocean
+! rho_atmos *Cp_atmos* (u'w')_atmos = rho_ocean * CP_ocean * (u'w')_ocean
+!
+CALL GOTO_MODEL(KMI)
+XSSUFL_C(:,:,1)= ZCOUPUFL(:,:)/XRH00OCEAN
+XSSVFL_C(:,:,1)= ZCOUPVFL(:,:)/XRH00OCEAN
+XSSTFL_C(:,:,1)= ZCOUPTFL(:,:)*1004./(3900.*XRH00OCEAN)
+DEALLOCATE(ZCOUPUA,ZCOUPVA,ZCOUPUO,ZCOUPVO,ZCOUPTA,ZCOUPTO)
+DEALLOCATE(ZCOUPTFL)
+!
+END SUBROUTINE NHOA_COUPL_n
+
diff --git a/src/MNH/one_wayn.f90 b/src/MNH/one_wayn.f90
index dae09f3c1fb37f07aab0a4caaa7996cf63b98b41..035f9498615835453bd56cbdf1462d6dabeeeb5c 100644
--- a/src/MNH/one_wayn.f90
+++ b/src/MNH/one_wayn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-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.
@@ -128,6 +128,7 @@ SUBROUTINE ONE_WAY_n(KDAD,PTSTEP,KMI,KTCOUNT, &
USE MODD_CH_MNHC_n, only: LUSECHAQ, LUSECHIC
USE MODD_CONF, only: CEQNSYS
USE MODD_CST, only: XCPD, XP00, XRD, XRV, XTH00
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_FIELD_n, only: XPABST, XRT, XSVT, XUT, XVT, XWT, XTHT, XTKET
USE MODD_NESTING, only: NXOR_ALL, NXEND_ALL, NYOR_ALL, NYEND_ALL
USE MODD_NSV, only: NSV_A, NSV_C1R3BEG_A, NSV_C1R3_A, NSV_C2R2BEG_A, NSV_C2R2_A, NSV_CHEMBEG_A, NSV_CHEMEND_A, &
@@ -139,6 +140,7 @@ USE MODD_NSV, only: NSV_A, NSV_C1R3BEG_A, NSV_C1R3_A, NSV_C2R2BEG_A,
USE MODD_PARAMETERS, only: JPHEXT, JPVEXT
USE MODD_PARAM_n, only: CCLOUD
+USE MODD_REF, ONLY: LCOUPLES
USE MODD_REF_n, only: XRHODJ, XRHODREF, XRVREF, XTHVREF
!
use mode_bikhardt
@@ -239,6 +241,21 @@ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCHEMTI
!
integer :: igrid
!
+IF (LCOUPLES) THEN
+ PDRYMASST=0.
+ PDRYMASSS=0.
+ PLBXUS=0.
+ PLBXVS=0.
+ PLBXWS=0.
+ PLBXTHS=0.
+ PLBYTHS=0.
+ PLBXTKES=0.
+ PLBYTKES =0.
+ PLBXRS =0.
+ PLBYRS=0.
+ PLBXSVS =0.
+ PLBYSVS=0.
+ELSE
!-------------------------------------------------------------------------------
!
!* 0. INITIALISATION
@@ -790,6 +807,8 @@ DEALLOCATE(ZWORK)
DEALLOCATE(ZCOEFLIN_LBXM_RED,ZCOEFLIN_LBYM_RED,IKLIN_LBXM_RED,IKLIN_LBYM_RED)
!
!------------------------------------------------------------------------------
+ENDIF ! END LCOUPLES coupling
+!
CALL GOTO_MODEL(KMI)
!
END SUBROUTINE ONE_WAY_n
diff --git a/src/MNH/open_prc_files.f90 b/src/MNH/open_prc_files.f90
index bb02f6951579522024fcc1b29da9240a08de5a83..52124869b62a05bac87768bc0bb002951cdc3e1e 100644
--- a/src/MNH/open_prc_files.f90
+++ b/src/MNH/open_prc_files.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -11,7 +11,8 @@ INTERFACE
SUBROUTINE OPEN_PRC_FILES(TPPRE_REAL1FILE,HATMFILE,HATMFILETYPE,TPATMFILE, &
HCHEMFILE,HCHEMFILETYPE, &
HSURFFILE,HSURFFILETYPE, &
- HPGDFILE,TPPGDFILE)
+ HPGDFILE,TPPGDFILE, &
+ HCAMSFILE,HCAMSFILETYPE)
!
USE MODD_IO, ONLY: TFILEDATA
!
@@ -25,7 +26,8 @@ CHARACTER(LEN=28), INTENT(OUT) :: HSURFFILE ! name of the input surface file
CHARACTER(LEN=6), INTENT(OUT) :: HSURFFILETYPE! type of the input surface file
CHARACTER(LEN=28), INTENT(OUT) :: HPGDFILE ! name of the physiographic data file
TYPE(TFILEDATA),POINTER, INTENT(OUT) :: TPPGDFILE ! physiographic data file
-!
+CHARACTER(LEN=28), INTENT(OUT) :: HCAMSFILE ! name of the input CAMS file
+CHARACTER(LEN=6), INTENT(OUT) :: HCAMSFILETYPE! type of the input CAMS file
END SUBROUTINE OPEN_PRC_FILES
END INTERFACE
END MODULE MODI_OPEN_PRC_FILES
@@ -34,7 +36,8 @@ END MODULE MODI_OPEN_PRC_FILES
SUBROUTINE OPEN_PRC_FILES(TPPRE_REAL1FILE,HATMFILE,HATMFILETYPE,TPATMFILE, &
HCHEMFILE,HCHEMFILETYPE, &
HSURFFILE,HSURFFILETYPE, &
- HPGDFILE,TPPGDFILE)
+ HPGDFILE,TPPGDFILE, &
+ HCAMSFILE,HCAMSFILETYPE)
! ###############################################################
!
!!**** *OPEN_PRC_FILES* - openning of the files used in PREP_REAL_CASE
@@ -95,6 +98,7 @@ END MODULE MODI_OPEN_PRC_FILES
! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
! (nsubfiles_ioz is now determined in IO_File_add2list)
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! B. Vie 06/2021: LIMA - CAMS coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -136,6 +140,8 @@ CHARACTER(LEN=28), INTENT(OUT) :: HSURFFILE ! name of the input surface file
CHARACTER(LEN=6), INTENT(OUT) :: HSURFFILETYPE! type of the input surface file
CHARACTER(LEN=28), INTENT(OUT) :: HPGDFILE ! name of the physiographic data file
TYPE(TFILEDATA),POINTER, INTENT(OUT) :: TPPGDFILE ! physiographic data file
+CHARACTER(LEN=28), INTENT(OUT) :: HCAMSFILE ! name of the input CAMS file
+CHARACTER(LEN=6), INTENT(OUT) :: HCAMSFILETYPE! type of the input CAMS file
!
!* 0.2 Declaration of local variables
! ------------------------------
@@ -153,7 +159,8 @@ CHARACTER(LEN=28) :: CINIFILE ! re-declaration of this model variable for nameli
! ------------------------
!
NAMELIST/NAM_FILE_NAMES/ HATMFILE,HATMFILETYPE,HCHEMFILE,HCHEMFILETYPE, &
- HSURFFILE,HSURFFILETYPE,HPGDFILE,CINIFILE
+ HSURFFILE,HSURFFILETYPE,HPGDFILE,CINIFILE, &
+ HCAMSFILE,HCAMSFILETYPE
!-------------------------------------------------------------------------------
!
!* 1. SET DEFAULT NAMES
@@ -165,6 +172,8 @@ HCHEMFILE=' '
HCHEMFILETYPE='MESONH'
HSURFFILE=' '
HSURFFILETYPE='MESONH'
+HCAMSFILE=' '
+HCAMSFILETYPE='MESONH'
!
!-------------------------------------------------------------------------------
!
@@ -211,23 +220,9 @@ CALL POSNAM(IPRE_REAL1,'NAM_FILE_NAMES',GFOUND,ILUOUT0)
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_FILE_NAMES)
CINIFILE_n = CINIFILE
!
-ILEN = LEN_TRIM(HATMFILE)
-IF (ILEN>0) THEN
- YFILE=' '
- YFILE(1:ILEN) = HATMFILE(1:ILEN)
- HATMFILE = ' '
- HATMFILE(1:ILEN) = YFILE(1:ILEN)
-END IF
WRITE(ILUOUT0,*) 'HATMFILE= ', HATMFILE
!
-ILEN = LEN_TRIM(HCHEMFILE)
-IF (ILEN>0) THEN
- YFILE=' '
- YFILE(1:ILEN) = HCHEMFILE(1:ILEN)
- HCHEMFILE = ' '
- HCHEMFILE(1:ILEN) = YFILE(1:ILEN)
- IF (HCHEMFILE==HATMFILE) HCHEMFILE=''
-END IF
+IF (HCHEMFILE==HATMFILE) HCHEMFILE=''
IF (LEN_TRIM(HCHEMFILE)>0 .AND. HATMFILETYPE/='GRIBEX') THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','OPEN_PRC_FILES',&
@@ -235,26 +230,14 @@ IF (LEN_TRIM(HCHEMFILE)>0 .AND. HATMFILETYPE/='GRIBEX') THEN
END IF
WRITE(ILUOUT0,*) 'HCHEMFILE=', HCHEMFILE
!
-ILEN = LEN_TRIM(HSURFFILE)
-IF (ILEN>0) THEN
- YFILE=' '
- YFILE(1:ILEN) = HSURFFILE(1:ILEN)
- HSURFFILE = ' '
- HSURFFILE(1:ILEN) = YFILE(1:ILEN)
-ELSE
- HSURFFILE = HATMFILE
+WRITE(ILUOUT0,*) 'HCAMSFILE=', HCAMSFILE
+!
+IF ( LEN_TRIM( HSURFFILE ) == 0 ) THEN
+ HSURFFILE = HATMFILE
HSURFFILETYPE = HATMFILETYPE
END IF
WRITE(ILUOUT0,*) 'HSURFFILE=', HSURFFILE
!
-ILEN = LEN_TRIM(HPGDFILE)
-IF (ILEN>0) THEN
- YFILE=' '
- YFILE(1:ILEN) = HPGDFILE(1:ILEN)
- HPGDFILE = ' '
- HPGDFILE(1:ILEN) = YFILE(1:ILEN)
-END IF
-!
CINIFILEPGD_n = HPGDFILE
IF (LEN_TRIM(HPGDFILE)==0) THEN
! IF (HATMFILETYPE=='MESONH') THEN
diff --git a/src/MNH/p_abs.f90 b/src/MNH/p_abs.f90
index f00d38d387a7aac873872ace9711472125d33845..1d3e2d6e86e530869ab21319107d62bc45641b79 100644
--- a/src/MNH/p_abs.f90
+++ b/src/MNH/p_abs.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$ $Revision$
-! MASDEV4_7 solver 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #################
MODULE MODI_P_ABS
! #################
@@ -16,7 +11,7 @@ INTERFACE
!
SUBROUTINE P_ABS (KRR, KRRL, KRRI, PDRYMASST, PREFMASS, PMASS_O_PHI0, &
PTHT, PRT, PRHODJ, PRHODREF, PTHETAV, PTHVREF, &
- PRVREF, PEXNREF, PPHIT )
+ PRVREF, PEXNREF, PPHIT, PPHI0)
!
IMPLICIT NONE
!
@@ -44,7 +39,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF! Exner function of the
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPHIT ! Perturbation of
! either the Exner function Pi or Pi * Cpd * THvref
-!
+REAL, INTENT(INOUT) :: PPHI0 ! Phi0 at time t !
!
END SUBROUTINE P_ABS
!
@@ -54,7 +49,7 @@ END MODULE MODI_P_ABS
! #######################################################################
SUBROUTINE P_ABS (KRR, KRRL, KRRI, PDRYMASST, PREFMASS, PMASS_O_PHI0, &
PTHT, PRT, PRHODJ, PRHODREF, PTHETAV, PTHVREF, &
- PRVREF, PEXNREF, PPHIT )
+ PRVREF, PEXNREF, PPHIT, PPHI0 )
! #######################################################################
!
!!**** *P_ABS * - routine to compute the absolute Exner pressure deviation PHI
@@ -108,6 +103,8 @@ END MODULE MODI_P_ABS
!! from Durran (1989), MAE and DUR respectively
!! 15/06/98 (D.Lugato, R.Guivarch) Parallelisation
!! J. Colin 07/13 Add LBOUSS
+!! J.L Redelsperger 03/2021 Change of one step to pressure computation
+!! in order to perform Ocean runs (equivalent to LHE shallow convection)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -115,14 +112,14 @@ END MODULE MODI_P_ABS
!
USE MODD_CST
USE MODD_CONF
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS, LIBM, XIBM_EPSI
USE MODD_PARAMETERS
-USE MODD_REF, ONLY : LBOUSS
+USE MODD_REF, ONLY: LBOUSS
!
USE MODE_ll
-!JUAN
USE MODE_REPRO_SUM
-!JUAN
-!
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -150,6 +147,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVREF ! vapor mixing ratio
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF! Exner function of the
! reference state
!
+REAL, INTENT(INOUT) :: PPHI0 ! PHI0 at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPHIT ! Perturbation of
! either the Exner function Pi or Pi * Cpd * THvref
!
@@ -350,8 +348,13 @@ ELSEIF( CEQNSYS == 'LHE' ) THEN
ZRTOT(:,:,:) = 0.
END IF
!
+ IF (LIBM) THEN
+ WHERE (XIBM_LS(:,:,:,1).GT.-XIBM_EPSI)
+ ZWORK(:,:,:) = PTHVREF(:,:,:)
+ ENDWHERE
+ ENDIF
!
- ! compute the absolute pressure function
+ ! compute the absolute pressure function (LHE equation system case)
!
!
!
@@ -373,8 +376,16 @@ ELSEIF( CEQNSYS == 'LHE' ) THEN
ZMASSGUESS = SUM_DD_R2_ll(ZMASSGUESS_2D)
ZWATERMASST = SUM_DD_R2_ll(ZWATERMASST_2D)
!
- ZPHI0 = (PDRYMASST + ZWATERMASST - 2. * PREFMASS + ZMASSGUESS ) / PMASS_O_PHI0
- PPHIT(:,:,:) = PPHIT(:,:,:) + ZPHI0
+ ! case shallow bouss : to get the real pressure fluctuation
+ ! Eq 2.40 p15 : constant not resolved in poisson equation
+ IF (.NOT. LOCEAN) THEN
+ PPHI0 = (PDRYMASST + ZWATERMASST - 2. * PREFMASS + ZMASSGUESS ) / PMASS_O_PHI0
+ ELSE
+ ! PPHI0 = 0. => to be possibly modified for ocean LES case
+ PPHI0=0.
+ END IF
+ ! following computation moved in PRESSURE routine (Eq 2.40 bis p15: Phi_total)
+ ! PPHIT(:,:,:) = PPHIT(:,:,:) + ZPHI0
!
END IF
!
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 921afbd475c9005f1a2b21261aaf63b281a1418f..327f252f01893ae368664c04eb59d6faffe9bb3c 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -11,8 +11,8 @@
INTERFACE
!
SUBROUTINE PHYS_PARAM_n( KTCOUNT, TPFILE, &
- PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PDRAG, PTURB, PTRACER, &
- PTIME_BU, PWETDEPAER, OMASKkids, OCLOUD_ONLY )
+ PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PDRAG,PEOL, PTURB, &
+ PTRACER, PTIME_BU, PWETDEPAER, OMASKkids, OCLOUD_ONLY )
!
USE MODD_IO, ONLY: TFILEDATA
use modd_precision, only: MNHTIME
@@ -20,7 +20,7 @@ use modd_precision, only: MNHTIME
INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
! advection schemes
-REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER,PEOL ! to store CPU
! time for computing time
REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets statistics
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PWETDEPAER
@@ -36,8 +36,8 @@ END MODULE MODI_PHYS_PARAM_n
!
! ########################################################################################
SUBROUTINE PHYS_PARAM_n( KTCOUNT, TPFILE, &
- PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PDRAG, PTURB, PTRACER, &
- PTIME_BU, PWETDEPAER, OMASKkids, OCLOUD_ONLY )
+ PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PEOL, PDRAG, PTURB, &
+ PTRACER, PTIME_BU, PWETDEPAER, OMASKkids, OCLOUD_ONLY )
! ########################################################################################
!
!!**** *PHYS_PARAM_n * -monitor of the parameterizations used by model _n
@@ -234,7 +234,9 @@ END MODULE MODI_PHYS_PARAM_n
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 21/11/2019: ZRG_HOUR and ZRAT_HOUR are now parameter arrays
-!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! F. Auguste 02/2021: add IBM
+! JL Redelsperger 03/2021: add the SW flux penetration for Ocean model case
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -263,11 +265,13 @@ USE MODD_DRAGTREE_n
USE MODD_DUST
USE MODD_DYN
USE MODD_DYN_n
+USE MODD_EOL_MAIN, ONLY: LMAIN_EOL, CMETH_EOL, NMODEL_EOL
USE MODD_FIELD_n
USE MODD_FRC
USE MODD_FRC_n
USE MODD_GRID
USE MODD_GRID_n
+USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_EPSI, XIBM_LS
USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN_C1R3=>XRTMIN
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LATZ_EDFLX
@@ -280,6 +284,7 @@ USE MODD_METRICS_n
USE MODD_MNH_SURFEX_n
USE MODD_NESTING, ONLY : XWAY,NDAD, NDXRATIO_ALL, NDYRATIO_ALL
USE MODD_NSV
+USE MODD_OCEANH
USE MODD_OUT_n
USE MODD_PARAM_C2R2, ONLY : LSEDC
USE MODD_PARAMETERS
@@ -294,7 +299,8 @@ USE MODD_PASPOL_n
USE MODD_PRECIP_n
use modd_precision, only: MNHTIME
USE MODD_RADIATIONS_n
-USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_REF, ONLY: LCOUPLES
USE MODD_REF_n
USE MODD_SALT
USE MODD_SHADOWS_n
@@ -327,6 +333,7 @@ USE MODI_EDDY_FLUX_n ! Ajout PP
USE MODI_EDDY_FLUX_ONE_WAY_n ! Ajout PP
USE MODI_EDDYUV_FLUX_n ! Ajout PP
USE MODI_EDDYUV_FLUX_ONE_WAY_n ! Ajout PP
+USE MODI_EOL_MAIN
USE MODI_GROUND_PARAM_n
USE MODI_PASPOL
USE MODI_RADIATIONS
@@ -346,7 +353,7 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
! advection schemes
-REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER,PEOL ! to store CPU
! time for computing time
REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets statistics
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PWETDEPAER
@@ -440,6 +447,11 @@ INTEGER :: IKIDM ! index loop
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSAVE_INPRR,ZSAVE_INPRS,ZSAVE_INPRG,ZSAVE_INPRH
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSAVE_DIRFLASWD, ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD
+! for ocean model
+INTEGER :: JKM , JSW ! vertical index loop
+REAL :: ZSWA,TINTSW ! index for SW interpolation and int time betwenn forcings (ocean model)
+REAL, DIMENSION(:), ALLOCATABLE :: ZIZOCE(:) ! Solar flux penetrating in ocean
+REAL, DIMENSION(:), ALLOCATABLE :: ZPROSOL1(:),ZPROSOL2(:) ! Funtions for penetrating solar flux
!
!-----------------------------------------------------------------------------
@@ -802,6 +814,48 @@ IF (CRAD /='NONE') THEN
if ( lbudget_th ) call Budget_store_end ( tbudgets(NBUDGET_TH), 'RAD', xrths(:, :, :) )
END IF
!
+!
+!* 1.6 Ocean case:
+! Sfc turbulent fluxes & Radiative tendency due to SW penetrating ocean
+!
+IF (LOCEAN .AND. (.NOT.LCOUPLES)) THEN
+!
+ ALLOCATE( ZIZOCE(IKU)); ZIZOCE(:)=0.
+ ALLOCATE( ZPROSOL1(IKU))
+ ALLOCATE( ZPROSOL2(IKU))
+ ALLOCATE(XSSUFL(IIU,IJU))
+ ALLOCATE(XSSVFL(IIU,IJU))
+ ALLOCATE(XSSTFL(IIU,IJU))
+ ALLOCATE(XSSOLA(IIU,IJU))
+ ! Time interpolation
+ JSW = INT(TDTCUR%xtime/REAL(NINFRT))
+ ZSWA = TDTCUR%xtime/REAL(NINFRT)-REAL(JSW)
+ XSSTFL = (XSSTFL_T(JSW+1)*(1.-ZSWA)+XSSTFL_T(JSW+2)*ZSWA)
+ XSSUFL = (XSSUFL_T(JSW+1)*(1.-ZSWA)+XSSUFL_T(JSW+2)*ZSWA)
+ XSSVFL = (XSSVFL_T(JSW+1)*(1.-ZSWA)+XSSVFL_T(JSW+2)*ZSWA)
+!
+ ZIZOCE(IKU) = XSSOLA_T(JSW+1)*(1.-ZSWA)+XSSOLA_T(JSW+2)*ZSWA
+ ZPROSOL1(IKU) = XROC*ZIZOCE(IKU)
+ ZPROSOL2(IKU) = (1.-XROC)*ZIZOCE(IKU)
+ IF(NVERB >= 5 ) THEN
+ WRITE(ILUOUT,*)'ZSWA JSW TDTCUR XTSTEP FT FU FV SolarR(IKU)', NINFRT, ZSWA,JSW,&
+ TDTCUR%xtime, XTSTEP, XSSTFL(2,2), XSSUFL(2,2),XSSVFL(2,2),ZIZOCE(IKU)
+ END IF
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'OCEAN', xrths(:, :, :) )
+ DO JKM=IKU-1,2,-1
+ ZPROSOL1(JKM) = ZPROSOL1(JKM+1)* exp(-XDZZ(2,2,JKM)/XD1)
+ ZPROSOL2(JKM) = ZPROSOL2(JKM+1)* exp(-XDZZ(2,2,JKM)/XD2)
+ ZIZOCE(JKM) = (ZPROSOL1(JKM+1)-ZPROSOL1(JKM) + ZPROSOL2(JKM+1)-ZPROSOL2(JKM))/XDZZ(2,2,JKM)
+ ! Adding to temperature tendency, the solar radiation penetrating in ocean
+ XRTHS(:,:,JKM) = XRTHS(:,:,JKM) + XRHODJ(:,:,JKM)*ZIZOCE(JKM)
+ END DO
+ if ( lbudget_th ) call Budget_store_end ( tbudgets(NBUDGET_TH), 'OCEAN', xrths(:, :, :) )
+ DEALLOCATE( ZIZOCE)
+ DEALLOCATE (ZPROSOL1)
+ DEALLOCATE (ZPROSOL2)
+END IF
+!
+!
CALL SECOND_MNH2(ZTIME2)
!
PRAD = PRAD + ZTIME2 - ZTIME1 &
@@ -1170,6 +1224,20 @@ IF (CSURF=='EXTE') THEN
CALL GROUND_PARAM_n(ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD )
!
+ IF (LIBM) THEN
+ WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI)
+ ZSFTH(:,:)=0.
+ ZSFRV(:,:)=0.
+ ZSFU (:,:)=0.
+ ZSFV (:,:)=0.
+ ENDWHERE
+ IF (NSV>0) THEN
+ DO JSV = 1 , NSV
+ WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI) ZSFSV(:,:,JSV)=0.
+ ENDDO
+ ENDIF
+ ENDIF
+ !
IF (SIZE(XEMIS)>0) THEN
XDIR_ALB = ZDIR_ALB
XSCA_ALB = ZSCA_ALB
@@ -1245,7 +1313,7 @@ CALL SECOND_MNH2(ZTIME2)
PTRACER = PTRACER + ZTIME2 - ZTIME1
!-----------------------------------------------------------------------------
!
-!* 5. Drag force
+!* 5a. Drag force
! ----------
!
ZTIME1 = ZTIME2
@@ -1265,6 +1333,29 @@ PDRAG = PDRAG + ZTIME2 - ZTIME1 &
!
PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
!
+!* 5b. Drag force from wind turbines
+! -----------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (LMAIN_EOL .AND. IMI == NMODEL_EOL) THEN
+ CALL EOL_MAIN(KTCOUNT,XTSTEP, &
+ XDXX,XDYY,XDZZ, &
+ XRHODJ, &
+ XUT,XVT,XWT, &
+ XRUS, XRVS, XRWS )
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+PEOL = PEOL + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+!
+!*
!-----------------------------------------------------------------------------
!
!* 6. TURBULENCE SCHEME
@@ -1485,7 +1576,14 @@ PMAFL = PMAFL + ZTIME4 - ZTIME3 - ZTIME_LES_MF
PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
!
!
+!* deallocate sf flux array for ocean model (in grid nesting, dimensions can vary)
!
+IF (LOCEAN .AND. (.NOT. LCOUPLES)) THEN
+ DEALLOCATE(XSSUFL)
+ DEALLOCATE(XSSVFL)
+ DEALLOCATE(XSSTFL)
+ DEALLOCATE(XSSOLA)
+END IF
!-------------------------------------------------------------------------------
!
!* deallocation of variables used in more than one parameterization
diff --git a/src/MNH/prandtl.f90 b/src/MNH/prandtl.f90
index dc9e578612d8bac8a73a236086e6af7bc890c9a1..fbfe0a7621714cebb151faee288c99338a4a555b 100644
--- a/src/MNH/prandtl.f90
+++ b/src/MNH/prandtl.f90
@@ -187,6 +187,7 @@ END MODULE MODI_PRANDTL
!! vertical levels
!! 2017-09 J.Escobar, use epsilon XMNH_TINY_12 for R*4
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! JL Redelsperger 03/2021 : adding Ocean case for temperature only
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -195,8 +196,9 @@ END MODULE MODI_PRANDTL
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
use modd_field, only: tfielddata, TYPEREAL
-USE MODD_IO, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
!
USE MODI_GRADIENT_M
@@ -287,15 +289,22 @@ PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
!
! 1.3 1D Redelsperger numbers
!
-PBLL_O_E(:,:,:) = MZM( XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
-IF (KRR /= 0) THEN ! moist case
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
- & GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
- PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * &
- & GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)
-ELSE ! dry case
+IF (LOCEAN) THEN
+ PBLL_O_E(:,:,:) = MZM(XG *XALPHAOC* PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
PREDR1(:,:,:) = 0.
+ELSE
+ PBLL_O_E(:,:,:) = MZM(XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
+ IF (KRR /= 0) THEN ! moist case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
+ & GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * &
+ & GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)
+ ELSE ! dry case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = 0.
+ END IF
+!
END IF
!
! 3. Limits on 1D Redelperger numbers
@@ -335,9 +344,11 @@ PREDR1 (:,:,:) = PREDR1 (:,:,:) * ZW1(:,:,:)
ZW2=SIGN(1.,PREDTH1(:,:,:))
PREDTH1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDTH1(:,:,:))
!
-IF (KRR /= 0) THEN ! dry case
- ZW2=SIGN(1.,PREDR1(:,:,:))
- PREDR1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDR1(:,:,:))
+IF (.NOT.LOCEAN) THEN
+ IF (KRR /= 0) THEN ! dry case
+ ZW2=SIGN(1.,PREDR1(:,:,:))
+ PREDR1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDR1(:,:,:))
+ END IF
END IF
!
!
@@ -448,57 +459,73 @@ IF(HTURBDIM=='1DIM') THEN
!
ELSE IF (L2D) THEN ! 3D case in a 2D model
!
- DO JSV=1,ISV
+ IF (LOCEAN) THEN
IF (KRR /= 0) THEN
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2 ) *PETHETA
ELSE
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
- END IF
- PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1* &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
- )
-!
- IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1 * PEMOIST * &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
- )
- ELSE
- PRED2RS3(:,:,:,JSV) = 0.
- END IF
- ENDDO
+ ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2)
+ END IF
+ ELSE
+ DO JSV=1,ISV
+ IF (KRR /= 0) THEN
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ELSE
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
+ END IF
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1* &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
+ )
+!
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ )
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+ ENDDO
+ END IF
!
ELSE ! 3D case in a 3D model
!
- DO JSV=1,ISV
- IF (KRR /= 0) THEN
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
- ELSE
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
- END IF
- PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1* &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
- +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
- GY_M_M(PTHLM,PDYY,PDZZ,PDZY) &
- )
-!
- IF (KRR /= 0) THEN
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1 * PEMOIST * &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
- +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
- GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
- )
- ELSE
- PRED2RS3(:,:,:,JSV) = 0.
- END IF
- ENDDO
+ IF (LOCEAN) THEN
+ IF (KRR /= 0) THEN
+ ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ELSE
+ ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2)
+ END IF
+ ELSE
+ DO JSV=1,ISV
+ IF (KRR /= 0) THEN
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ELSE
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
+ END IF
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1* &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
+ GY_M_M(PTHLM,PDYY,PDZZ,PDZY) &
+ )
+!
+ IF (KRR /= 0) THEN
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ +GY_M_M(PSVM(:,:,:,JSV),PDYY,PDZZ,PDZY)* &
+ GY_M_M(PRM(:,:,:,1),PDYY,PDZZ,PDZY) &
+ )
+ ELSE
+ PRED2RS3(:,:,:,JSV) = 0.
+ END IF
+ ENDDO
+ END IF
!
END IF ! end of HTURBDIM if-block
!
diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90
index eb0e3b6b60b22abd910df50ddba69e388fc2ebf5..3e5ea35b14a4343165833fcc22e6f09c9d624be0 100644
--- a/src/MNH/prep_ideal_case.f90
+++ b/src/MNH/prep_ideal_case.f90
@@ -318,7 +318,9 @@
! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! F. Auguste 02/2021: add IBM
! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! Jean-Luc Redelsperger 03/2021 : : ocean LES case
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -331,6 +333,8 @@ USE MODD_CONF
USE MODD_CST
USE MODD_GRID
USE MODD_GRID_n
+USE MODD_IBM_LSF, ONLY: CIBM_TYPE, LIBM_LSF, NIBM_SMOOTH, XIBM_SMOOTH
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS
USE MODD_METRICS_n
USE MODD_PGDDIM
USE MODD_PGDGRID
@@ -376,6 +380,7 @@ USE MODE_MSG
!
USE MODI_DEFAULT_DESFM_n ! Interface modules
USE MODI_DEFAULT_EXPRE
+USE MODI_IBM_INIT_LS
USE MODI_READ_HGRID
USE MODI_SHUMAN
USE MODI_SET_RSOU
@@ -572,7 +577,7 @@ TYPE(TFILEDATA),POINTER :: TZEXPREFILE => NULL()
NAMELIST/NAM_CONF_PRE/ LTHINSHELL,LCARTESIAN, &! Declarations in MODD_CONF
LPACK, &!
NVERB,CIDEAL,CZS, &!+global variables initialized
- LBOUSS,LPERTURB, &! at their declarations
+ LBOUSS,LOCEAN,LPERTURB, &! at their declarations
LFORCING,CEQNSYS, &! at their declarations
LSHIFT,L2D_ADV_FRC,L2D_REL_FRC, &
NHALO , JPHEXT
@@ -602,6 +607,8 @@ NAMELIST/NAM_AERO_PRE/ LORILAM, LINITPM, XINIRADIUSI, XINIRADIUSJ, &
XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, &
NMODE_SLT
!
+NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
+!
!-------------------------------------------------------------------------------
!
!* 0. PROLOGUE
@@ -691,11 +698,17 @@ CALL POSNAM(NLUPRE,'NAM_GRIDH_PRE',GFOUND,NLUOUT)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRIDH_PRE)
CALL POSNAM(NLUPRE,'NAM_VPROF_PRE',GFOUND,NLUOUT)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_VPROF_PRE)
-CALL POSNAM(NLUPRE,'NAM_BLANKn',GFOUND,NLUOUT)
-IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_BLANKn)
+CALL POSNAM(NLUPRE,'NAM_BLANKN',GFOUND,NLUOUT)
+CALL INIT_NAM_BLANKn
+IF (GFOUND) THEN
+ READ(UNIT=NLUPRE,NML=NAM_BLANKn)
+ CALL UPDATE_NAM_BLANKn
+END IF
CALL READ_PRE_IDEA_NAM_n(NLUPRE,NLUOUT)
CALL POSNAM(NLUPRE,'NAM_AERO_PRE',GFOUND,NLUOUT)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_AERO_PRE)
+CALL POSNAM(NLUPRE,'NAM_IBM_LSF' ,GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_IBM_LSF )
!
CALL INI_FIELD_LIST(1)
!
@@ -964,6 +977,11 @@ ALLOCATE(XDZZ(NIU,NJU,NKU))
!
ALLOCATE(XRHODREFZ(NKU),XTHVREFZ(NKU))
XTHVREFZ(:)=0.0
+IF (LCOUPLES) THEN
+ ! Arrays for reference state different in ocean and atmosphere
+ ALLOCATE(XRHODREFZO(NKU),XTHVREFZO(NKU))
+ XTHVREFZO(:)=0.0
+END IF
IF(CEQNSYS == 'DUR') THEN
ALLOCATE(XRVREF(NIU,NJU,NKU))
ELSE
@@ -978,7 +996,11 @@ ALLOCATE(XLSUM(NIU,NJU,NKU))
ALLOCATE(XLSVM(NIU,NJU,NKU))
ALLOCATE(XLSWM(NIU,NJU,NKU))
ALLOCATE(XLSTHM(NIU,NJU,NKU))
-ALLOCATE(XLSRVM(NIU,NJU,NKU))
+IF ( NRR >= 1) THEN
+ ALLOCATE(XLSRVM(NIU,NJU,NKU))
+ELSE
+ ALLOCATE(XLSRVM(0,0,0))
+ENDIF
!
! allocate lateral boundary field used for coupling
!
@@ -1351,7 +1373,7 @@ IF ( LEN_TRIM(CPGD_FILE) == 0 .OR. .NOT. LREAD_ZS) THEN
!
CASE DEFAULT ! undefined shape of orography
!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','erroneous terrain type')
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','erroneous ground type')
END SELECT
!
CALL ADD2DFIELD_ll( TZ_FIELDS_ll, XZS, 'PREP_IDEAL_CASE::XZS' )
@@ -1623,9 +1645,11 @@ IF(LPERTURB) CALL SET_PERTURB(TZEXPREFILE)
!
!* 5.9 Anelastic correction and pressure:
!
-CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
-IF ( .NOT. L1D ) CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ)
-CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+IF (.NOT.LOCEAN) THEN
+ CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+ IF ( .NOT. L1D ) CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ)
+ CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+END IF
!
!
!* 5.10 Compute THETA, vapor and cloud mixing ratio
@@ -1642,19 +1666,28 @@ IF (CIDEAL == 'RSOU') THEN
ALLOCATE(ZRSATW(NIU,NJU,NKU))
ALLOCATE(ZRSATI(NIU,NJU,NKU))
ZRT=XRT(:,:,:,1)+XRT(:,:,:,2)+XRT(:,:,:,4)
+IF (LOCEAN) THEN
+ ZEXN(:,:,:)= 1.
+ ZT=XTHT
+ ZTHL=XTHT
+ ZCPH=XCPD+ XCPV * XRT(:,:,:,1)
+ ZLVOCPEXN = XLVTT
+ ZLSOCPEXN = XLSTT
+ELSE
ZEXN=(XPABST/XP00) ** (XRD/XCPD)
ZT=XTHT*(XPABST/XP00)**(XRD/XCPD)
ZCPH=XCPD+ XCPV * XRT(:,:,:,1)+ XCL *XRT(:,:,:,2) + XCI * XRT(:,:,:,4)
ZLVOCPEXN = (XLVTT + (XCPV-XCL) * (ZT-XTT))/(ZCPH*ZEXN)
ZLSOCPEXN = (XLSTT + (XCPV-XCI) * (ZT-XTT))/(ZCPH*ZEXN)
ZTHL=XTHT-ZLVOCPEXN*XRT(:,:,:,2)-ZLSOCPEXN*XRT(:,:,:,4)
+ CALL TH_R_FROM_THL_RT_3D('T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
+ XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI)
+END IF
DEALLOCATE(ZEXN)
DEALLOCATE(ZT)
DEALLOCATE(ZCPH)
DEALLOCATE(ZLVOCPEXN)
DEALLOCATE(ZLSOCPEXN)
- CALL TH_R_FROM_THL_RT_3D('T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
- XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI)
DEALLOCATE(ZTHL)
DEALLOCATE(ZRT)
! Coherence test
@@ -1697,7 +1730,27 @@ IF ( LCH_INIT_FIELD ) CALL CH_INIT_FIELD_n(1, NLUOUT, NVERB)
!
!-------------------------------------------------------------------------------
!
-!* 7. WRITE THE FMFILE
+!* 7. INITIALIZE LEVELSET FOR IBM
+! ---------------------------
+!
+IF (LIBM_LSF) THEN
+ !
+ ! In their current state, the IBM can only be used in
+ ! combination with cartesian coordinates and flat orography.
+ !
+ IF ((CZS.NE."FLAT").OR.(.NOT.LCARTESIAN)) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with flat ground')
+ ENDIF
+ !
+ ALLOCATE(XIBM_LS(NIU,NJU,NKU,4))
+ !
+ CALL IBM_INIT_LS(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. WRITE THE FMFILE
! ----------------
!
CALL SECOND_MNH2(ZTIME1)
@@ -1724,7 +1777,7 @@ XT_STORE = XT_STORE + ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
-!* 8. EXTERNALIZED SURFACE
+!* 9. EXTERNALIZED SURFACE
! --------------------
!
!
@@ -1799,7 +1852,7 @@ END IF
!
!-------------------------------------------------------------------------------
!
-!* 9. CLOSES THE FILE
+!* 10. CLOSES THE FILE
! ---------------
!
IF (CSURF =='EXTE' .AND. (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM)) THEN
@@ -1813,7 +1866,7 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 10. PRINTS ON OUTPUT-LISTING
+!* 11. PRINTS ON OUTPUT-LISTING
! ------------------------
!
IF (NVERB >= 5) THEN
diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90
index e0fff03f797676f343c3a395d29916e95f7e1241..3e3167691431dd68287e8573c951d8aa8ea3b985 100644
--- a/src/MNH/prep_real_case.f90
+++ b/src/MNH/prep_real_case.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-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.
@@ -374,15 +374,22 @@
!! Aug 2015 (M.Moge) removing EXTRAPOL on XDXX and XDYY in part 8
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! M.Leriche 2015 : add LUSECHEM dans NAM_CH_CONF
+!! Feb 02, 2012 (C. Mari & BV) interpolation from CAMS
+!! add call to READ_CAMS_NETCDF_CASE &
+!! VER_PREP_NETCDF_CASE
+!! Modification 01/2016 (JP Pinty) Add LIMA
+!! Modification 02/2016 (JP Pinty) Convert CAMS mix ratio to nbr conc
+!
!! 06/2016 (G.Delautier) phasage surfex 8
!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
!! B.VIE 2016 : LIMA
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! S. Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 20/03/2019: missing use MODI_INIT_SALT
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! T.Nagel 02/2021: add IBM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -402,6 +409,8 @@ USE MODD_GR_FIELD_n
USE MODD_GRID
USE MODD_GRID_n
USE MODD_HURR_CONF
+USE MODD_IBM_LSF, ONLY: CIBM_TYPE, LIBM_LSF, NIBM_SMOOTH, XIBM_SMOOTH
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS
USE MODD_IO, ONLY: TFILEDATA,NIO_VERB,NVERB_DEBUG,TFILE_SURFEX
USE MODD_LBC_n
USE MODD_LSFIELD_n
@@ -440,8 +449,10 @@ USE MODI_DEALLOCATE_MODEL1
USE MODI_DEALLOC_PARA_LL
USE MODI_DEFAULT_DESFM_n
USE MODI_ERROR_ON_TEMPERATURE
+USE MODI_IBM_INIT_LS
USE MODI_INI_PROG_VAR
USE MODI_INIT_SALT
+USE MODI_LIMA_MIXRAT_TO_NCONC
USE MODI_METRICS
USE MODI_MNHREAD_ZS_DUMMY_n
USE MODI_MNHWRITE_ZS_DUMMY_n
@@ -451,6 +462,7 @@ USE MODI_PRESSURE_IN_PREP
USE MODI_READ_ALL_DATA_GRIB_CASE
USE MODI_READ_ALL_DATA_MESONH_CASE
USE MODI_READ_ALL_NAMELISTS
+USE MODI_READ_CAMS_DATA_NETCDF_CASE
USE MODI_READ_CHEM_DATA_NETCDF_CASE
USE MODI_READ_VER_GRID
USE MODI_SECOND_MNH
@@ -467,6 +479,7 @@ USE MODI_WRITE_LFIFM_n
!
USE MODN_CONF, ONLY: JPHEXT , NHALO
USE MODN_CONFZ
+USE MODN_PARAM_LIMA
!
IMPLICIT NONE
!
@@ -477,6 +490,8 @@ CHARACTER(LEN=28) :: YATMFILE ! name of the Atmospheric file
CHARACTER(LEN=6) :: YATMFILETYPE! type of the Atmospheric file
CHARACTER(LEN=28) :: YCHEMFILE ! name of the Chemical file
CHARACTER(LEN=6) :: YCHEMFILETYPE! type of the Chemical file
+CHARACTER(LEN=28) :: YCAMSFILE ! name of the input CAMS file
+CHARACTER(LEN=6) :: YCAMSFILETYPE! type of the input CAMS file
CHARACTER(LEN=28) :: YSURFFILE ! name of the Surface file
CHARACTER(LEN=6) :: YSURFFILETYPE! type of the Surface file
CHARACTER(LEN=28) :: YPGDFILE ! name of the physiographic data
@@ -494,6 +509,7 @@ INTEGER :: ILUOUT0 ! logical unit for listing file
INTEGER :: IPRE_REAL1 ! logical unit for namelist file
INTEGER :: IRESP ! return code in FM routines
LOGICAL :: GFOUND ! Return code when searching namelist
+INTEGER :: NIU,NJU,NKU ! Upper bounds in x,y,z directions
!
REAL :: ZSTART, ZEND, ZTIME1, ZTIME2, ZTOT, ZALL ! for computing time analysis
REAL :: ZMISC, ZREAD, ZHORI, ZPREP, ZSURF, ZTHERMO, ZDYN, ZDIAG, ZWRITE
@@ -534,6 +550,9 @@ XANGCONV0, XANGCONV1000, XANGCONV2000, &
LSALT, CRGUNITS, NMODE_DST, XINISIG, XINIRADIUS, XN0MIN,&
XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, NMODE_SLT
NAMELIST/NAM_CH_CONF/ LUSECHAQ,LUSECHIC,LUSECHEM
+!
+NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
+!
! name of dad of input FM file
INTEGER :: II, IJ, IGRID, ILENGTH
CHARACTER (LEN=100) :: HCOMMENT
@@ -573,7 +592,8 @@ CALL IO_Init()
CALL OPEN_PRC_FILES(TZPRE_REAL1FILE,YATMFILE, YATMFILETYPE,TZATMFILE &
,YCHEMFILE,YCHEMFILETYPE &
,YSURFFILE,YSURFFILETYPE &
- ,YPGDFILE,TPGDFILE)
+ ,YPGDFILE,TPGDFILE &
+ ,YCAMSFILE,YCAMSFILETYPE)
ILUOUT0 = TLUOUT0%NLU
TLUOUT => TLUOUT0
!
@@ -613,6 +633,8 @@ IPRE_REAL1 = TZPRE_REAL1FILE%NLU
CALL INIT_NMLVAR
CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0)
IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
+CALL POSNAM(IPRE_REAL1,'NAM_PARAM_LIMA',GFOUND,ILUOUT0)
+IF (GFOUND) READ(IPRE_REAL1,NAM_PARAM_LIMA)
!
CALL INI_FIELD_LIST(1)
!
@@ -692,6 +714,8 @@ CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
CALL POSNAM(IPRE_REAL1,'NAM_CONFZ',GFOUND,ILUOUT0)
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CONFZ)
+CALL POSNAM(IPRE_REAL1,'NAM_IBM_LSF' ,GFOUND,ILUOUT0)
+IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_IBM_LSF)
!
! Sea salt
CALL INIT_SALT
@@ -747,6 +771,16 @@ IF(LEN_TRIM(YCHEMFILE)>0)THEN
CALL READ_CHEM_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
END IF
!
+!* 5.2 reading the input CAMS data
+!
+IF(LEN_TRIM(YCAMSFILE)>0)THEN
+ IF(YCAMSFILETYPE=='NETCDF') THEN
+ CALL READ_CAMS_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCAMSFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','CANNOT READ CAMS GRIB FILES YET')
+ END IF
+END IF
+!
CALL IO_File_close(TZPRE_REAL1FILE)
!
CALL SECOND_MNH(ZTIME2)
@@ -885,7 +919,8 @@ END IF
IF (LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='GRIBEX') THEN
CALL VER_PREP_GRIBEX_CASE('CHEM',ZDG)
END IF
-IF (LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='NETCDF') THEN
+IF ((LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='NETCDF') .OR. &
+ (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF')) THEN
CALL VER_PREP_NETCDF_CASE(ZDG)
END IF
!
@@ -973,6 +1008,11 @@ IF(LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='MESONH')THEN
LHORELAX_SVSLT = (NSV_SLT > 0)
LHORELAX_SVAER = (NSV_AER > 0)
ELSE
+!
+IF (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF') THEN
+ CALL LIMA_MIXRAT_TO_NCONC(XPABST, XTHT, XRT(:,:,:,1), XSV_MX)
+END IF
+!
CALL INI_PROG_VAR(XTKE_MX,XSV_MX)
END IF
!
@@ -1014,7 +1054,27 @@ CALL SECOND_MNH(ZTIME2)
ZDIAG = ZDIAG + ZTIME2 - ZTIME1
!-------------------------------------------------------------------------------
!
-!* 16. WRITING OF THE MESO-NH FM-FILE
+!* 16. INITIALIZE LEVELSET FOR IBM
+! ---------------------------
+!
+IF (LIBM_LSF) THEN
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with cartesian coordinates')
+ ENDIF
+ !
+ CALL GET_DIM_EXT_ll('B',NIU,NJU)
+ NKU=NKMAX+2*JPVEXT
+ !
+ ALLOCATE(XIBM_LS(NIU,NJU,NKU,4))
+ !
+ CALL IBM_INIT_LS(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 17. WRITING OF THE MESO-NH FM-FILE
! ------------------------------
!
ZTIME1 = ZTIME2
@@ -1063,7 +1123,7 @@ ZWRITE = ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
-!* 17. OROGRAPHIC and DUMMY PHYSIOGRAPHIC FIELDS
+!* 18. OROGRAPHIC and DUMMY PHYSIOGRAPHIC FIELDS
! -----------------------------------------
!
!* reading in the PGD file
@@ -1083,7 +1143,7 @@ IF (YATMFILETYPE=='MESONH'.AND. YATMFILE/=YPGDFILE) THEN
END IF
!-------------------------------------------------------------------------------
!
-!* 18. INTERPOLATION OF SURFACE VARIABLES
+!* 19. INTERPOLATION OF SURFACE VARIABLES
! ----------------------------------
!
IF (.NOT. LCOUPLING ) THEN
@@ -1108,7 +1168,7 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 19. EPILOGUE
+!* 20. EPILOGUE
! --------
!
WRITE(ILUOUT0,*)
diff --git a/src/MNH/prep_surfex.f90 b/src/MNH/prep_surfex.f90
index 8493ac43da7fbc0362702f02ade48fdbd8ac639e..16908f2aed0504c1434651fbb05cf86e40fd0b57 100644
--- a/src/MNH/prep_surfex.f90
+++ b/src/MNH/prep_surfex.f90
@@ -1,8 +1,8 @@
-!MNH_LIC Copyright 2004-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2004-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.
----------------------------------------------------------------
+!-----------------------------------------------------------------
! #############################
PROGRAM PREP_SURFEX
! #############################
@@ -27,6 +27,7 @@
!! 06/2016 (G.Delautier) phasage surfex 8
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
+!! 2021 B.Vie LIMA - CAMS coupling
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -67,6 +68,8 @@ CHARACTER(LEN=28) :: YATMFILE ! name of the Atmospheric file
CHARACTER(LEN=6) :: YATMFILETYPE ! type of the Atmospheric file
CHARACTER(LEN=28) :: YCHEMFILE ! name of the Chemical file (not used)
CHARACTER(LEN=6) :: YCHEMFILETYPE ! type of the Chemical file (not used)
+CHARACTER(LEN=28) :: YCAMSFILE ! name of the input CAMS file
+CHARACTER(LEN=6) :: YCAMSFILETYPE ! type of the input CAMS file
CHARACTER(LEN=28) :: YSURFFILE ! name of the Surface file (not used)
CHARACTER(LEN=6) :: YSURFFILETYPE ! type of the Surface file (not used)
CHARACTER(LEN=28) :: YPGDFILE ! name of the physiographic data
@@ -105,7 +108,8 @@ CALL IO_Init()
CALL OPEN_PRC_FILES(TZPRE_REAL1FILE,YATMFILE, YATMFILETYPE,TZATMFILE &
,YCHEMFILE,YCHEMFILETYPE &
,YSURFFILE,YSURFFILETYPE &
- ,YPGDFILE,TPGDFILE)
+ ,YPGDFILE,TPGDFILE &
+ ,YCAMSFILE,YCAMSFILETYPE)
ILUOUT0 = TLUOUT0%NLU
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index c015ab250313a97dca40978a587656cc6af99196..1f597f1046fe54250debe75b86c1098f011be758 100644
--- a/src/MNH/pressurez.f90
+++ b/src/MNH/pressurez.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -220,6 +220,8 @@ END MODULE MODI_PRESSUREZ
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+!! JL Redelsperger 03/2021 : Shallow convection case added in LHE case:
+!! working for both atmosphere and ocean cases
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -229,7 +231,9 @@ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, NBUDGET_U, NBUDGET_V, NBUDGET_W, tbudgets
USE MODD_CST
USE MODD_CONF
-USE MODD_DYN_n, ONLY: LRES, XRES
+USE MODD_DYN_n, ONLY: LRES, XRES,LOCEAN
+USE MODD_FIELD_n, ONLY: XPHIT
+USE MODD_IBM_PARAM_n, ONLY: LIBM, NIBM_ITR, XIBM_EPSI, XIBM_LS, XIBM_SU
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_MPIF
USE MODD_PARAMETERS
@@ -250,6 +254,7 @@ USE MODI_FLAT_INV
USE MODI_FLAT_INVZ
USE MODI_GDIV
USE MODI_GRADIENT_M
+USE MODI_IBM_BALANCE
USE MODI_MASS_LEAK
USE MODI_P_ABS
USE MODI_RICHARDSON
@@ -357,6 +362,7 @@ REAL, DIMENSION(SIZE(PPABST,1),SIZE(PPABST,2),SIZE(PPABST,3)) :: ZTHETAV, &
! MAE + DUR => Exner function perturbation
! LHE => Exner function perturbation * CPD * THVREF
!
+REAL :: ZPHI0
REAL :: ZRV_OV_RD ! XRV / XRD
REAL :: ZMAXVAL, ZMAXRES, ZMAX,ZMAX_ll ! for print
INTEGER, DIMENSION(3) :: IMAXLOC ! purpose
@@ -422,6 +428,11 @@ END IF
!* 4. COMPUTE THE FORCING TERM FOR THE PRESSURE EQUATION
! --------------------------------------------------
!
+IF (LIBM) THEN
+ WHERE(XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) PRUS(:,:,:) = 0.
+ WHERE(XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) PRVS(:,:,:) = 0.
+ WHERE(XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) PRWS(:,:,:) = 0.
+ENDIF
!
CALL MPPDB_CHECK3D(PRUS,"pressurez 4-before update_halo_ll::PRUS",PRECISION)
CALL MPPDB_CHECK3D(PRVS,"pressurez 4-before update_halo_ll::PRVS",PRECISION)
@@ -438,6 +449,10 @@ CALL MPPDB_CHECK3D(PRWS,"pressurez 4-after update_halo_ll::PRWS",PRECISION)
!
CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRUS,PRVS,PRWS,ZDV_SOURCE)
!
+IF (LIBM) THEN
+ CALL IBM_BALANCE(XIBM_LS,XIBM_SU,PRUS,PRVS,PRWS,ZDV_SOURCE)
+ENDIF
+!
! The non-homogenous Neuman problem is transformed in an homogenous Neuman
! problem in the non-periodic cases
IF (HLBCX(1) /= 'CYCL') THEN
@@ -449,6 +464,23 @@ IF (.NOT. L2D .AND. HLBCY(1) /= 'CYCL') THEN
IF (LSOUTH_ll()) ZDV_SOURCE(:,IJB-1,:) = 0.
IF (LNORTH_ll()) ZDV_SOURCE(:,IJE+1,:) = 0.
ENDIF
+
+IF (LIBM) THEN
+ !
+ IF (HLBCX(1) == 'CYCL') THEN
+ IF (LWEST_ll()) ZDV_SOURCE(IIB-1,:,:) = ZDV_SOURCE(IIB-1,:,:)*XIBM_SU(IIB,:,:,1)
+ IF (LEAST_ll()) ZDV_SOURCE(IIE+1,:,:) = ZDV_SOURCE(IIE+1,:,:)*XIBM_SU(IIE,:,:,1)
+ ENDIF
+ !
+ IF (HLBCY(1) == 'CYCL') THEN
+ IF (LSOUTH_ll()) ZDV_SOURCE(:,IJB-1,:) = ZDV_SOURCE(:,IJB-1,:)*XIBM_SU(:,IJB,:,1)
+ IF (LNORTH_ll()) ZDV_SOURCE(:,IJE+1,:) = ZDV_SOURCE(:,IJE+1,:)*XIBM_SU(:,IJE,:,1)
+ ENDIF
+ !
+ ZDV_SOURCE(:,:,IKB-1) = ZDV_SOURCE(:,:,IKB-1)*XIBM_SU(:,:,IKB,1)
+ ZDV_SOURCE(:,:,IKE+1) = ZDV_SOURCE(:,:,IKE+1)*XIBM_SU(:,:,IKE,1)
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!
@@ -476,15 +508,27 @@ IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
ZTHETAV(:,:,:) = PTHT(:,:,:)
END IF
!
+ IF (LIBM) THEN
+ WHERE (XIBM_LS(:,:,:,1).GT.-XIBM_EPSI)
+ ZTHETAV(:,:,:) = PTHVREF(:,:,:)
+ ENDWHERE
+ ENDIF
+ !
ZPHIT(:,:,:)=(PPABST(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)
!
ELSEIF(CEQNSYS=='LHE') THEN
- ZPHIT(:,:,:)= ((PPABST(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)) &
- * XCPD * PTHVREF(:,:,:)
- !
+ IF ( .NOT. LOCEAN) THEN
+ ZPHIT(:,:,:)= ((PPABST(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)) &
+ * XCPD * PTHVREF(:,:,:)
+ ELSE
+ ! Field at T- DT for LHE anelastic approx
+ ! not used in ocean case (flat LHE)
+ ZPHIT(:,:,:)=0.
+ END IF
+!
END IF
!
-IF(CEQNSYS=='LHE'.AND. LFLAT .AND. LCARTESIAN) THEN
+IF(CEQNSYS=='LHE'.AND. LFLAT .AND. LCARTESIAN .AND. .NOT. LIBM) THEN
! flat cartesian LHE case -> exact solution
IF ( HPRESOPT /= "ZRESI" ) THEN
CALL FLAT_INV(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOT,PAF,PBF,PCF, &
@@ -528,18 +572,57 @@ END IF
! ----------------------------------------
!
IF ( HLBCX(1) /= 'CYCL' ) THEN
- IF(LWEST_ll()) ZPHIT(IIB-1,:,IKB-1) = ZPHIT(IIB,:,IKB-1)
- IF(LEAST_ll()) ZPHIT(IIE+1,:,IKB-1) = ZPHIT(IIE,:,IKB-1)
+ IF(LWEST_ll()) THEN
+ ZPHIT(IIB-1,:,IKB-1) = ZPHIT(IIB,:,IKB)
+ ZPHIT(IIB-1,:,IKE+1) = ZPHIT(IIB,:,IKE)
+ ENDIF
+ IF(LEAST_ll()) THEN
+ ZPHIT(IIE+1,:,IKB-1) = ZPHIT(IIE,:,IKB)
+ ZPHIT(IIE+1,:,IKE+1) = ZPHIT(IIE,:,IKE)
+ ENDIF
ENDIF
+!
IF ( HLBCY(1) /= 'CYCL' ) THEN
- IF (LSOUTH_ll()) ZPHIT(:,IJB-1,IKB-1) = ZPHIT(:,IJB,IKB-1)
- IF (LNORTH_ll()) ZPHIT(:,IJE+1,IKB-1) = ZPHIT(:,IJE,IKB-1)
+ IF (LSOUTH_ll()) THEN
+ ZPHIT(:,IJB-1,IKB-1) = ZPHIT(:,IJB,IKB)
+ ZPHIT(:,IJB-1,IKE+1) = ZPHIT(:,IJB,IKE)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ ZPHIT(:,IJE+1,IKB-1) = ZPHIT(:,IJE,IKB)
+ ZPHIT(:,IJE+1,IKE+1) = ZPHIT(:,IJE,IKE)
+ ENDIF
ENDIF
!
IF ( L2D ) THEN
IF (LSOUTH_ll()) ZPHIT(:,IJB-1,:) = ZPHIT(:,IJB,:)
IF (LNORTH_ll()) ZPHIT(:,IJE+1,:) = ZPHIT(:,IJB,:)
-END IF
+ENDIF
+!
+IF (LIBM) THEN
+ !
+ IF ( HLBCX(1) == 'CYCL' ) THEN
+ IF (LWEST_ll()) THEN
+ ZPHIT(IIB-1,:,:) = ZPHIT(IIB,:,:)*(1.-XIBM_SU(IIB,:,:,1))+XIBM_SU(IIB,:,:,1)*ZPHIT(IIB-1,:,:)
+ ENDIF
+ IF (LEAST_ll()) THEN
+ ZPHIT(IIE+1,:,:) = ZPHIT(IIE,:,:)*(1.-XIBM_SU(IIE,:,:,1))+XIBM_SU(IIE,:,:,1)*ZPHIT(IIE+1,:,:)
+ ENDIF
+ ENDIF
+ !
+ IF ( HLBCY(1) == 'CYCL' ) THEN
+ IF (LSOUTH_ll()) THEN
+ ZPHIT(:,IJB-1,:) = ZPHIT(:,IJB,:)*(1.-XIBM_SU(:,IJB,:,1))+XIBM_SU(:,IJB,:,1)*ZPHIT(:,IJB-1,:)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ ZPHIT(:,IJE+1,:) = ZPHIT(:,IJE,:)*(1.-XIBM_SU(:,IJE,:,1))+XIBM_SU(:,IJE,:,1)*ZPHIT(:,IJE+1,:)
+ ENDIF
+ ENDIF
+ !
+ !-------------Bottom Boundary conditions
+ ZPHIT(:,:,IKB-1) = ZPHIT(:,:,IKB-1)*XIBM_SU(:,:,IKB,1)+(1.-XIBM_SU(:,:,IKB,1))*ZPHIT(:,:,IKB)
+ ZPHIT(:,:,IKE+1) = ZPHIT(:,:,IKE+1)*XIBM_SU(:,:,IKE,1)+(1.-XIBM_SU(:,:,IKE,1))*ZPHIT(:,:,IKE)
+ !
+ENDIF
!
ZDV_SOURCE = GX_M_U(1,IKU,1,ZPHIT,PDXX,PDZZ,PDZX)
!
@@ -638,6 +721,10 @@ CALL CLEANLIST_ll(TZFIELDS2_ll)
! compute the residual divergence
CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRUS,PRVS,PRWS,ZDV_SOURCE)
!
+IF (LIBM) THEN
+ ZDV_SOURCE(:,:,:)=ZDV_SOURCE(:,:,:)*XIBM_SU(:,:,:,2)
+ENDIF
+!
IF ( CEQNSYS=='DUR' ) THEN
IF ( SIZE(PRVREF,1) == 0 ) THEN
ZDV_SOURCE=ZDV_SOURCE/PRHODJ/XTH00*PRHODREF*PTHVREF
@@ -679,6 +766,10 @@ IF (OITRADJ) THEN
ENDIF
ENDIF
!
+IF (LIBM) THEN
+ KITR=MIN(NIBM_ITR,KITR)
+ENDIF
+!
!* 7. STORAGE OF THE FIELDS IN BUDGET ARRAYS
! --------------------------------------
!
@@ -700,12 +791,23 @@ IF ((ZMAX_ll > 1.E-12) .AND. KTCOUNT >0 ) THEN
!IF ( KTCOUNT >0 .AND. .NOT.LBOUSS ) THEN
CALL P_ABS ( KRR, KRRL, KRRI, PDRYMASST, PREFMASS, PMASS_O_PHI0, &
PTHT, PRT, PRHODJ, PRHODREF, ZTHETAV, PTHVREF, &
- PRVREF, PEXNREF, ZPHIT )
+ PRVREF, PEXNREF, ZPHIT, ZPHI0 )
!
IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
PPABST(:,:,:)=XP00*(ZPHIT+PEXNREF)**(XCPD/XRD)
ELSEIF(CEQNSYS=='LHE') THEN
- PPABST(:,:,:)=XP00*(ZPHIT/(XCPD*PTHVREF)+PEXNREF)**(XCPD/XRD)
+ IF (.NOT. LOCEAN) THEN
+ ! Deep atmosphere case : computing of PI fluctuation ; ZPHI0 (computed in P_ABS routine) is added
+ XPHIT(:,:,:) = (ZPHIT+ZPHI0)/(XCPD*PTHVREF)
+ ! Absolute Pressure
+ PPABST(:,:,:)=XP00*(XPHIT(:,:,:)+PEXNREF)**(XCPD/XRD)
+ ! Computing press fluctuation
+ XPHIT(:,:,:) = PPABST(:,:,:) - XP00*PEXNREF**(XCPD/XRD)
+ ELSE
+! Shallow atmosphere ou ocean
+ XPHIT(:,:,:) = (ZPHIT+ZPHI0)*PRHODREF
+ PPABST(:,:,:)=XPHIT(:,:,:) + XP00*PEXNREF**(XCPD/XRD)
+ END IF
ENDIF
!
IF( HLBCX(1) == 'CYCL' ) THEN
diff --git a/src/MNH/prognos_lima.f90 b/src/MNH/prognos_lima.f90
new file mode 100644
index 0000000000000000000000000000000000000000..967dd166ab2933510cf616c46e378076e66a5ffe
--- /dev/null
+++ b/src/MNH/prognos_lima.f90
@@ -0,0 +1,392 @@
+!MNH_LIC Copyright 2012-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.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_PROGNOS_LIMA
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE PROGNOS_LIMA(PTSTEP,PDZ,PLV,PCPH,PPRES,PRHOD,PRR,PTT,PRV,PRC,PS0,PNAS,PCCS,PNFS)
+!
+REAL, INTENT(IN) :: PTSTEP
+REAL, DIMENSION(:), INTENT(IN) :: PPRES
+REAL, DIMENSION(:), INTENT(IN) :: PDZ
+REAL, DIMENSION(:), INTENT(IN) :: PLV
+REAL, DIMENSION(:), INTENT(IN) :: PCPH
+REAL, DIMENSION(:), INTENT(IN) :: PRHOD
+REAL, DIMENSION(:), INTENT(IN) :: PRR
+REAL, DIMENSION(:), INTENT(INOUT) :: PTT ! PTHS
+REAL, DIMENSION(:), INTENT(INOUT) :: PRV ! PRVS
+REAL, DIMENSION(:), INTENT(INOUT) :: PRC ! PRCS
+REAL, DIMENSION(:), INTENT(INOUT) :: PS0 ! PSVS sursat source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PNAS ! PSVS activated aerosols source
+REAL, DIMENSION(:), INTENT(INOUT) :: PCCS ! PSVS droplet concentration source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PNFS ! PSVS free aerosol source
+!
+END SUBROUTINE PROGNOS_LIMA
+!
+END INTERFACE
+!
+END MODULE MODI_PROGNOS_LIMA
+!
+! ###################################################################################
+ SUBROUTINE PROGNOS_LIMA(PTSTEP,PDZ,PLV,PCPH,PPRES,PRHOD,PRR,PTT,PRV,PRC,PS0,PNAS,PCCS,PNFS)
+! ###################################################################################
+!
+!!**** * - compute pseudo-prognostic of supersaturation according to Thouron
+! et al. 2012
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Thouron, O., J.-L. Brenguier, and F. Burnet, Supersaturation calculation
+!! in large eddy simulation models for prediction of the droplet number
+!! concentration, Geosci. Model Dev., 5, 761-772, 2012.
+!!
+!! AUTHOR
+!! ------
+!! 06/2021 B. Vie forked from prognos.f90
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_CST
+USE MODD_PARAM_LIMA
+USE MODD_PARAM_LIMA_WARM
+!
+USE MODE_IO
+USE MODE_MSG
+!
+USE MODI_GAMMA
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+!
+!
+REAL, INTENT(IN) :: PTSTEP
+REAL, DIMENSION(:), INTENT(IN) :: PPRES
+REAL, DIMENSION(:), INTENT(IN) :: PDZ
+REAL, DIMENSION(:), INTENT(IN) :: PLV
+REAL, DIMENSION(:), INTENT(IN) :: PCPH
+REAL, DIMENSION(:), INTENT(IN) :: PRHOD
+REAL, DIMENSION(:), INTENT(IN) :: PRR
+REAL, DIMENSION(:), INTENT(INOUT) :: PTT ! PTHS
+REAL, DIMENSION(:), INTENT(INOUT) :: PRV ! PRVS
+REAL, DIMENSION(:), INTENT(INOUT) :: PRC ! PRCS
+REAL, DIMENSION(:), INTENT(INOUT) :: PS0 ! PSVS sursat source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PNAS ! PSVS activated aerosols source
+REAL, DIMENSION(:), INTENT(INOUT) :: PCCS ! PSVS droplet concentration source
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PNFS ! PSVS free aerosol source
+!
+!
+!* 0.2 Declarations of local variables :
+!
+!
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZW1,ZW2,ZDZRC2,ZDZRC,ZCPH
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZA1,ZA2,ZB,ZC,ZG
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZLV,ZTT1,ZRT,ZTL,ZTT1_TEMP,ZTT2_TEMP
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZRMOY,ZRVSAT1,ZRVSAT2
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZVEC2 ! Work vectors forinterpolations
+INTEGER, DIMENSION(SIZE(PRHOD,1)):: IVEC2 ! Vectors of indices for interpolations
+INTEGER :: J1,J2,JMOD,INUCT,JL
+REAL,DIMENSION(SIZE(PS0,1)) ::MEM_PS0,ADJU2
+REAL::AER_RAD
+REAL, DIMENSION(SIZE(PRHOD,1)) :: ZFLAG_ACT !Flag for activation
+!
+INTEGER :: IRESP ! Return code of FM routines
+INTEGER :: ILUOUT ! Logical unit of output listing
+CHARACTER(LEN=100) :: YMSG
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCHEN_MULTI,ZTMP
+REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW6, ZVEC1
+INTEGER, DIMENSION(:), ALLOCATABLE :: IVEC1 ! Vectors of indices for
+ ! interpolations
+
+!
+INUCT = SIZE(PTT,1)
+!
+!
+ ALLOCATE(ZZW1(INUCT))
+ ALLOCATE(ZZW2(INUCT))
+ ALLOCATE(ZZW6(INUCT))
+ ALLOCATE(ZCHEN_MULTI(INUCT,NMOD_CCN))
+ ALLOCATE(ZTMP(INUCT,NMOD_CCN))
+ ALLOCATE(ZVEC1(INUCT))
+ ALLOCATE(IVEC1(INUCT))
+!
+!
+ DO JL=1,INUCT
+ DO JMOD = 1,NMOD_CCN
+ ZCHEN_MULTI(JL,JMOD) = (PNFS(JL,JMOD)+PNAS(JL,JMOD))*PRHOD(JL) &
+ / XLIMIT_FACTOR(JMOD)
+ ENDDO
+ END DO
+!print*,'ZCHEN_MULTI=',MINVAL(ZCHEN_MULTI(:,1)), MAXVAL(ZCHEN_MULTI(:,1)), &
+! 'ZCHEN_MULTI(1,1)=',ZCHEN_MULTI(1,1)
+!
+!* . Compute the nucleus source
+! -----------------------------
+!
+!
+! Modified values for Beta and C (see in init_aerosol_properties) account for that
+!
+ WHERE ( PS0(:) > 0.)
+ ZVEC1(:) = MAX( 1.0001, MIN( REAL(NHYP)-0.0001, &
+ XHYPINTP1*LOG(PS0(:))+XHYPINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( IVEC1(:) )
+ END WHERE
+!print*,'ZVEC1=',MINVAL(ZVEC1), MAXVAL(ZVEC1)
+ ZZW6(:) = 0. ! initialize the change of cloud droplet concentration
+!
+ ZTMP(:,:)=0.0
+!
+! Compute the concentration of activable aerosols for each mode
+! based on the supersaturation ( -> ZTMP )
+!
+ DO JMOD = 1, NMOD_CCN ! iteration on mode number
+ ZZW1(:) = 0.
+ !
+ WHERE( PS0(:)>0.0 )
+ ZZW1(:) = XHYPF12( IVEC1(:)+1,JMOD )* ZVEC1(:) & ! hypergeo function
+ - XHYPF12( IVEC1(:) ,JMOD )*(ZVEC1(:) - 1.0) ! XHYPF12 is tabulated
+ !
+ ZTMP(:,JMOD) = (ZCHEN_MULTI(:,JMOD)/PRHOD(:))*PS0(:)**XKHEN_MULTI(JMOD) &
+ *ZZW1(:)
+ ! ZTMP(:,JMOD) = (ZCHEN_MULTI(:,JMOD)/PRHOD(:))*100*PS0(:)**XKHEN_MULTI(JMOD) &
+ ENDWHERE
+!print*,'ZZW1=',MINVAL(ZZW1), MAXVAL(ZZW1)
+!print*,'ZTMP=',MINVAL(ZTMP), MAXVAL(ZTMP)
+ ENDDO
+!
+! Compute the concentration of aerosols activated at this time step
+! as the difference between ZTMP and the aerosols already activated at t-dt (ZZW1)
+!
+ DO JMOD = 1, NMOD_CCN ! iteration on mode number
+ ZZW2(:) = 0.
+ !
+! WHERE( SUM(ZTMP(:,:),DIM=2)*PTSTEP .GT. 15.E6/PRHOD(:) )
+ ZZW2(:) = MIN( PNFS(:,JMOD),MAX( ZTMP(:,JMOD)- PNAS(:,JMOD) , 0.0 ) )
+! ENDWHERE
+!print*,'ZTMP=',ZTMP(:,1)
+!print*,'PNAS=',PNAS(:,1)
+!print*,'PNFS=',PNFS(:,1)
+!print*,'ZZW2=',ZZW2(:)
+ !
+ !* update the concentration of activated CCN = Na
+ !
+ PNAS(:,JMOD) = (PNAS(:,JMOD) + ZZW2(:))
+ !
+ !* update the concentration of free CCN = Nf
+ !
+ PNFS(:,JMOD) = (PNFS(:,JMOD) - ZZW2(:))
+ !
+ !* prepare to update the cloud water concentration
+ !
+ ZZW6(:) = ZZW6(:) + ZZW2(:)
+!print*,'ZZW6=',MINVAL(ZZW6), MAXVAL(ZZW6)
+ ENDDO
+!
+!FLAG ACTIVE A TRUE (1.0) si on active pas
+ZFLAG_ACT(:)=0.0
+DO J2=1,SIZE(PRC,1)
+ IF (ZZW2(J2).EQ.0.0) THEN
+ ZFLAG_ACT(J2)=1.0
+ ENDIF
+!print*,'ZFLAG_ACT=',ZFLAG_ACT(J2)
+ENDDO
+!
+! Mean radius
+!minimum radius of cloud droplet
+AER_RAD=1.0E-6
+ZRMOY(:)=0.0
+DO J2=1,SIZE(PRC,1)
+ IF ((PRC(J2).NE.0.) .AND. (PCCS(J2).NE.0.)) THEN
+ ZRMOY(J2)=(MOMG(XALPHAC,XNUC,3.0)*4.0*XPI*PCCS(J2)*XRHOLW/&
+ (3.0*PRC(J2)*PRHOD(J2)))**(1.0/3.0)
+ ZRMOY(J2)=(PCCS(J2)*MOMG(XALPHAC,XNUC,1.0)/ZRMOY(J2))
+ ENDIF
+!ZRMOY(J2)=ZRMOY(J2)+(ZZW2(J2)*AER_RAD)
+ ZRMOY(J2)=ZRMOY(J2)+(ZZW6(J2)*AER_RAD)
+ENDDO
+ !print*,'prognos RMOY=',MINVAL(ZRMOY),MAXVAL(ZRMOY)
+!
+! PCCS(:) = ZZW6(:) * PTSTEP
+ PCCS(:) = PCCS(:) + ZZW6(:)
+ !print*,'prognos PCCS=',MINVAL(PCCS),MAXVAL(PCCS)
+!
+!CALCUL DE A1 => Estimation de (drs/dt)f
+!T(=Ã determiner) avant forcage; T'(=PTT) apres forcage
+!Calcul de ZTT1: calculé en inversant S0(T)jusqu'à T:
+! l'erreur faite sur cette inversion est supérieur à la précision
+! recherchée, on applique à rs(T') pour cxalculer le DT=T'-T qui
+! correspond à la variation rs(T')-rs(T). Permet de recuperer une valeur
+! correcte de DT et donc de determiner T comme T=T'-DT
+!ZRVSAT1=rs(T)
+!
+!print*,'prognos : PS0=',MINVAL(PS0),MAXVAL(PS0)
+ZRVSAT1(:)=PRV(:)/(PS0(:)+1.0)
+!ZTT1<--es(T) de rs(T)
+ZTT1_TEMP(:)=PPRES(:)*((((XMV / XMD)/ZRVSAT1(:))+1.0)**(-1D0))
+!ZTT1<--T de es(T)
+ZTT1_TEMP(:)=LOG(ZTT1_TEMP(:)/610.8)
+ZTT1_TEMP(:)=(31.25*ZTT1_TEMP(:) -17.5688*273.15)/(ZTT1_TEMP(:) - 17.5688)
+!es(T')
+ZW1(:)=EXP(XALPW-XBETAW/PTT(:)-XGAMW*LOG(PTT(:)))
+!ZRVSAT2=rs(T')
+ZRVSAT2(:)=(XMV / XMD)*ZW1(:)/(PPRES(:)-ZW1(:))
+!ZTT2<--es(T') de rs(T')
+ZTT2_TEMP(:)=PPRES(:)*((((XMV / XMD)/ZRVSAT2(:))+1.0)**(-1D0))
+!ZTT2<--T' de es(T')
+IF (MINVAL(ZTT2_TEMP).LT.0.0) THEN
+ WRITE(YMSG,*) 'ZTT2_TEMP',MINVAL(ZTT2_TEMP),MINLOC(ZTT2_TEMP)
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PROGNOS_LIMA',YMSG)
+ENDIF
+!
+ZTT2_TEMP(:)=LOG(ZW1(:)/610.8)
+ZTT2_TEMP(:)=(31.25*ZTT2_TEMP(:) -17.5688*273.15)/(ZTT2_TEMP(:) - 17.5688)
+!ZTT1=T'-DT
+ZTT1(:)=PTT(:)-(ZTT2_TEMP(:)-ZTT1_TEMP(:))
+!Lv(T)
+ZLV(:) = XLVTT+(XCPV-XCL)*(ZTT1(:)-XTT)
+!
+ZA1(:)=-(((PS0(:)+1.0)**2.0)/PRV(:))*(ZRVSAT2(:)-(PRV(:)/(PS0(:)+1.0)))/PTSTEP
+!G
+ZG(:)= 1.0/(XRHOLW*((XRV*ZTT1(:)/(XDIVA*EXP(XALPW-(XBETAW/ZTT1(:))-(XGAMW*LOG(ZTT1(:)))))) &
++((ZLV(:)/(XTHCO*ZTT1(:)))*((ZLV(:)/(ZTT1(:)*XRV))-1.0))))
+!
+ZC(:)=4.0*XPI*(XRHOLW/PRHOD(:))*ZG(:)
+ZDZRC(:)=0.0
+ZDZRC(:)=ZC(:)*PS0(:)*ZRMOY(:)
+MEM_PS0(:)=PS0(:)
+!CALCUL DE B => Estimation de (drs/dT)ce
+!T(=PTT) avant condensation; T'(=Ã determiner) apres condensation
+!Lv(T),Cph(T)
+ZLV(:) = XLVTT+(XCPV-XCL)*(PTT(:)-XTT)
+ZCPH(:)= XCPD+XCPV*PRV(:)+XCL*(PRC(:)+PRR(:))
+!T'=T+(DT)ce
+ZTT1(:)=PTT(:)+(ZDZRC(:)*PTSTEP*ZLV(:)/ZCPH(:))
+!es(T')
+ZW1(:)=EXP(XALPW-XBETAW/PTT(:)-XGAMW*LOG(PTT(:)))
+!rs(T')
+ZW1(:)=(XMV / XMD)*ZW1(:)/(PPRES(:)-ZW1(:))
+!es(Tcond)
+ZW2(:)=EXP(XALPW-XBETAW/ZTT1(:)-XGAMW*LOG(ZTT1(:)))
+!rs(Tcond)
+ZW2(:)=(XMV / XMD)*ZW2(:)/(PPRES(:)-ZW2(:))
+!
+WHERE (ZTT1(:).NE.PTT(:))
+ ZB(:)=(ZLV(:)/ZCPH(:))*((ZW2(:)-ZW1(:))/(ZTT1(:)-PTT(:)))
+ELSEWHERE
+ ZB(:)=0.0
+ ZDZRC(:)=0.0
+ENDWHERE
+!Calcul de S+dS
+PS0(:)=PS0(:)+((ZA1(:)-(((ZB(:)*(PS0(:)+1.0)+1.0)*ZDZRC(:))/ZRVSAT1(:)))*PTSTEP)
+!
+!Ajustement tel que rv=(s+1)*rvs
+ZTL(:)=PTT(:)-(PLV(:)/PCPH(:))*PRC(:)
+ZRT(:)=PRC(:)+PRV(:)
+ZDZRC2(:)=PRC(:)
+DO J2=1,SIZE(ZDZRC,1)
+ IF ((ZDZRC(J2).NE.0.0).OR.(ZDZRC2(J2).NE.0.0)) THEN
+ DO J1=1,5
+ ZLV(J2) = XLVTT+(XCPV-XCL)*(PTT(J2)-XTT)
+ ZCPH(J2)=XCPD+XCPV*PRV(J2)+XCL*(PRC(J2)+PRR(J2))
+ ZW1(J2)=EXP(XALPW-XBETAW/PTT(J2)-XGAMW*LOG(PTT(J2)))
+ ZRVSAT1(J2)=(XMV / XMD)*ZW1(J2)/(PPRES(J2)-ZW1(J2))
+ PRV(J2)=MIN(ZRT(J2),(PS0(J2)+1.0)*ZRVSAT1(J2))
+ PRC(J2)=MAX(ZRT(J2)-PRV(J2),0.0)
+ PTT(J2)=0.5*PTT(J2)+0.5*(ZTL(J2)+(ZLV(J2)*PRC(J2)/ZCPH(J2)))
+ ENDDO
+ ZLV(J2) = XLVTT+(XCPV-XCL)*(PTT(J2)-XTT)
+ ZCPH(J2)=XCPD+XCPV*PRV(J2)+XCL*(PRC(J2)+PRR(J2))
+ PTT(J2)=ZTL(J2)+(ZLV(J2)*PRC(J2)/ZCPH(J2))
+ ENDIF
+ENDDO
+ADJU2(:)=0.0
+!
+!Correction dans les mailles où ds a été surestimée
+ZDZRC2(:)=PRC(:)-ZDZRC2(:)
+WHERE ((MEM_PS0(:).LE.0.0).AND.(PS0(:).GT.0.0).AND.(ZDZRC2(:).LT.0.0))
+ PS0(:)=0.0
+ ADJU2(:)=1.0
+ENDWHERE
+!
+WHERE ((MEM_PS0(:).GE.0.0).AND.(PS0(:).LT.0.0).AND.(ZDZRC2(:).GT.0.0))
+ PS0(:)=0.0
+ ADJU2(:)=1.0
+ENDWHERE
+!
+DO J2=1,SIZE(ADJU2,1)
+ IF (ADJU2(J2)==1) THEN
+ DO J1=1,5
+ ZLV(J2) = XLVTT+(XCPV-XCL)*(PTT(J2)-XTT)
+ ZCPH(J2)=XCPD+XCPV*PRV(J2)+XCL*(PRC(J2)+PRR(J2))
+ ZW1(J2)=EXP(XALPW-XBETAW/PTT(J2)-XGAMW*LOG(PTT(J2)))
+ ZRVSAT1(J2)=(XMV / XMD)*ZW1(J2)/(PPRES(J2)-ZW1(J2))
+ PRV(J2)=MIN(ZRT(J2),(PS0(J2)+1.0)*ZRVSAT1(J2))
+ PRC(J2)=MAX(ZRT(J2)-PRV(J2),0.0)
+ PTT(J2)=0.5*PTT(J2)+0.5*(ZTL(J2)+(ZLV(J2)*PRC(J2)/ZCPH(J2)))
+ ENDDO
+ ZLV(J2) = XLVTT+(XCPV-XCL)*(PTT(J2)-XTT)
+ ZCPH(J2)=XCPD+XCPV*PRV(J2)+XCL*(PRC(J2)+PRR(J2))
+ PTT(J2)=ZTL(J2)+(ZLV(J2)*PRC(J2)/ZCPH(J2))
+ ENDIF
+ENDDO
+!
+!Elimination de l'eau liquide dans les mailles où le rayon des gouttelettes est
+!inférieur à AER_RAD
+ZRMOY(:)=0.0
+DO J2=1,SIZE(PRC,1)
+ IF ((PRC(J2).NE.0.) .AND. (PCCS(J2).NE.0.)) THEN
+ ZRMOY(J2)=(MOMG(XALPHAC,XNUC,3.0)*4.0*XPI*PCCS(J2)*XRHOLW/&
+ (3.0*PRC(J2)*PRHOD(J2)))**(1.0/3.0)
+ ZRMOY(J2)=MOMG(XALPHAC,XNUC,1.0)/ZRMOY(J2)
+ IF ((ZFLAG_ACT(J2).EQ.1.0).AND.(MEM_PS0(J2).LT.0.0).AND.(ZRMOY(J2).LT.AER_RAD)) THEN
+ PTT(J2)=ZTL(J2)
+ PRV(J2)=ZRT(J2)
+ PRC(J2)=0.0
+ ENDIF
+ ENDIF
+ENDDO
+!
+!Calcul de S au regard de T et rv en fin de pas de temps
+ZW1=EXP(XALPW-XBETAW/PTT(:)-XGAMW*LOG(PTT(:)))
+ !rvsat
+ZRVSAT1(:)=(XMV / XMD)*ZW1(:)/(PPRES-ZW1(:))
+!
+WHERE (PRC(:)==0.0D0)
+ PS0(:)=(PRV(:)/ZRVSAT1(:))-1D0
+ENDWHERE
+!
+ DEALLOCATE(ZZW1,ZZW2,ZZW6,ZCHEN_MULTI,ZTMP,ZVEC1,IVEC1)
+!
+!
+CONTAINS
+!
+FUNCTION MOMG (PALPHA,PNU,PP) RESULT (PMOMG)
+USE MODI_GAMMA
+IMPLICIT NONE
+REAL :: PALPHA ! first shape parameter of the DIMENSIONnal distribution
+REAL :: PNU ! second shape parameter of the DIMENSIONnal distribution
+REAL :: PP ! order of the moment
+REAL :: PMOMG ! result: moment of order ZP
+PMOMG = GAMMA(PNU+PP/PALPHA)/GAMMA(PNU)
+!
+END FUNCTION MOMG
+!
+END SUBROUTINE PROGNOS_LIMA
diff --git a/src/MNH/qlap.f90 b/src/MNH/qlap.f90
index d4da491d97bc6c716267088375a88a11fbeac7cc..24c49ab38f58702aec4c40a6996f0575a3d2f8e5 100644
--- a/src/MNH/qlap.f90
+++ b/src/MNH/qlap.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -110,6 +110,7 @@ END MODULE MODI_QLAP
!! 06/12 V.Masson : update_halo due to CONTRAV changes
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! F. Auguste 02/21: add IBM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -126,6 +127,9 @@ USE MODI_SHUMAN
!
USE MODE_MPPDB
!
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS, LIBM, XIBM_SU
+USE MODI_IBM_BALANCE
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -160,7 +164,7 @@ INTEGER :: IIU,IJU,IKU ! I,J,K array sizes
INTEGER :: JK,JJ,JI ! vertical loop index
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
INTEGER :: IINFO_ll
-INTEGER :: IIB,IIE,IJB,IJE
+INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE
!-------------------------------------------------------------------------------
!
!
@@ -170,6 +174,8 @@ INTEGER :: IIB,IIE,IJB,IJE
CALL GET_DIM_EXT_ll('B',IIU,IJU)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKU=SIZE(PY,3)
+IKE = IKU - JPVEXT
+IKB = 1 + JPVEXT
!
ZU = GX_M_U(1,IKU,1,PY,PDXX,PDZZ,PDZX)
CALL MPPDB_CHECK3D(ZU,'QLAP::ZU',PRECISION)
@@ -257,7 +263,26 @@ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZW, 'QLAP::ZW' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
!
-CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,ZU,ZV,ZW,PQLAP)
+CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,ZU,ZV,ZW,PQLAP)
+!
+IF (LIBM) THEN
+ !
+ CALL IBM_BALANCE(XIBM_LS,XIBM_SU,ZU,ZV,ZW,PQLAP)
+ !
+ PQLAP(:,:,IKB-1) = PQLAP(:,:,IKB-1)*XIBM_SU(:,:,IKB,1)
+ PQLAP(:,:,IKE+1) = PQLAP(:,:,IKE+1)*XIBM_SU(:,:,IKE,1)
+ !
+ IF ( HLBCX(1) /= 'CYCL' ) THEN
+ IF(LWEST_ll()) PQLAP(IIB-1,:,:) = PQLAP(IIB-1,:,:)*XIBM_SU(IIB,:,:,1)
+ IF(LEAST_ll()) PQLAP(IIE+1,:,:) = PQLAP(IIE+1,:,:)*XIBM_SU(IIE,:,:,1)
+ ENDIF
+ !
+ IF ( HLBCY(1) /= 'CYCL' ) THEN
+ IF (LSOUTH_ll()) PQLAP(:,IJB-1,:) = PQLAP(:,IJB-1,:)*XIBM_SU(:,IJB,:,1)
+ IF (LNORTH_ll()) PQLAP(:,IJE+1,:) = PQLAP(:,IJE+1,:)*XIBM_SU(:,IJE,:,1)
+ ENDIF
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/rad_bound.f90 b/src/MNH/rad_bound.f90
index 5c77800b0ba8a034eb63c69e1110d1f71367b3bc..296d476b44d32be4d2814e4614cfe0c7cfc1e1b2 100644
--- a/src/MNH/rad_bound.f90
+++ b/src/MNH/rad_bound.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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$ $Revision$
-!-----------------------------------------------------------------
!####################
MODULE MODI_RAD_BOUND
!####################
@@ -17,6 +13,7 @@ INTERFACE
PTSTEP,PDXHAT,PDYHAT,PZHAT, &
PUT,PVT, &
PLBXUM,PLBYVM,PLBXUS,PLBYVS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS, &
PCPHASE,PCPHASE_PBL,PRHODJ, &
PTKET,PRUS,PRVS,PRWS )
!
@@ -31,6 +28,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Y-direc. meshlength
REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT ! at t
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS
!
! Lateral Boundary fields at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBYVM
@@ -58,6 +56,7 @@ END MODULE MODI_RAD_BOUND
PTSTEP,PDXHAT,PDYHAT,PZHAT, &
PUT,PVT, &
PLBXUM,PLBYVM,PLBXUS,PLBYVS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS, &
PCPHASE,PCPHASE_PBL,PRHODJ, &
PTKET,PRUS,PRVS,PRWS )
! #################################################################
@@ -152,7 +151,8 @@ END MODULE MODI_RAD_BOUND
!! Lac.C. 2011 : Adaptation to FIT temporal scheme
!! Modification 06/13 (C.Lac) Introduction of cphase_pbl
!! Modification 03/14 (C.Lac) Replacement of XRIMKMAX by XCARPKMAX
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Modification 02/2021 (T.Nagel) Add velocity fluctuations for turbulence recycling purpose
!!
!-------------------------------------------------------------------------------
!
@@ -160,13 +160,14 @@ END MODULE MODI_RAD_BOUND
! ------------
!
USE MODD_CONF
-USE MODD_PARAMETERS
USE MODD_CTURB
-!
-USE MODI_CPHASE_PROFILE
+USE MODD_PARAMETERS
+USE MODD_RECYCL_PARAM_n, ONLY: LRECYCL, XRCOEFF
!
USE MODE_ll
!
+USE MODI_CPHASE_PROFILE
+!
IMPLICIT NONE
!
!
@@ -185,6 +186,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Y-direc. meshlength
REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT ! at t
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS
!
! Lateral Boundary fields at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBYVM
@@ -256,8 +258,8 @@ ZALPHA2 = 1.
!
!* 2. LBC FILLING IN THE X DIRECTION (LEFT WEST SIDE):
! ------------------------------
-! ====> It only concernes U component
-! -----------
+! ====> It only concerns U component
+! -----------
!
IF (LWEST_ll( )) THEN
!
@@ -289,12 +291,20 @@ SELECT CASE ( HLBCX(1) )
IF ( SIZE(PLBXUS,1) == 0 ) THEN
ZLBEU (:,:) = 0.
ZLBGU (:,:) = PLBXUM(JPHEXT+1,:,:) - PLBXUM(JPHEXT,:,:) ! 2 - 1
- ZLBXU(:,:) = PLBXUM(JPHEXT,:,:) ! 1
+ IF ( LRECYCL ) THEN
+ ZLBXU(:,:) = PLBXUM(JPHEXT,:,:) + PFLUCTUNW * XRCOEFF
+ ELSE
+ ZLBXU(:,:) = PLBXUM(JPHEXT,:,:)
+ END IF
ELSE
ZLBEU (:,:) = PLBXUS(JPHEXT,:,:) ! 1
ZLBGU (:,:) = PLBXUM(JPHEXT+1,:,:) - PLBXUM(JPHEXT,:,:) + & ! 2 - 1
PTSTEP * (PLBXUS(JPHEXT+1,:,:) - PLBXUS(JPHEXT,:,:)) ! 2 - 1
- ZLBXU(:,:) = PLBXUM(JPHEXT,:,:) + PTSTEP * PLBXUS(JPHEXT,:,:) ! 1 + 1
+ IF ( LRECYCL ) THEN
+ ZLBXU(:,:) = PLBXUM(JPHEXT,:,:)+ PTSTEP *PLBXUS(JPHEXT,:,:) + PFLUCTUNW * XRCOEFF ! 1 + 1
+ ELSE
+ ZLBXU(:,:) = PLBXUM(JPHEXT,:,:)+ PTSTEP *PLBXUS(JPHEXT,:,:) ! 1 + 1
+ END IF
END IF
!
! ============================================================
@@ -324,8 +334,8 @@ END IF
!
!* 3. LBC FILLING IN THE X DIRECTION (RIGHT EAST SIDE):
! ------------------------------
-! ====> It only concernes U component
-! -----------
+! ====> It only concerns U component
+! -----------
!
IF (LEAST_ll( )) THEN
!
@@ -358,12 +368,20 @@ SELECT CASE ( HLBCX(2) )
IF (SIZE(PLBXUS,1) == 0 ) THEN
ZLBEU (:,:) = 0.
ZLBGU (:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) - PLBXUM(ILBX-JPHEXT,:,:) ! ILBX / (ILBX-1
- ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:)
+ IF ( LRECYCL ) THEN
+ ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) + PFLUCTUNE * XRCOEFF
+ ELSE
+ ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:)
+ END IF
ELSE
ZLBEU (:,:) = PLBXUS(ILBX-JPHEXT+1,:,:)
ZLBGU (:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) - PLBXUM(ILBX-JPHEXT,:,:) + &
PTSTEP * (PLBXUS(ILBX-JPHEXT+1,:,:) - PLBXUS(ILBX-JPHEXT,:,:))
- ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) + PTSTEP * PLBXUS(ILBX-JPHEXT+1,:,:)
+ IF ( LRECYCL ) THEN
+ ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) + PTSTEP * PLBXUS(ILBX-JPHEXT+1,:,:) + PFLUCTUNE * XRCOEFF
+ ELSE
+ ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) + PTSTEP * PLBXUS(ILBX-JPHEXT+1,:,:)
+ END IF
END IF
!
! ============================================================
@@ -395,8 +413,8 @@ END IF
!
!* 4. LBC FILLING IN THE Y DIRECTION (BOTTOM SOUTH SIDE):
! ------------------------------
-! ====> It only concernes V component
-! -----------
+! ====> It only concerns V component
+! -----------
!
IF (LSOUTH_ll( )) THEN
!
@@ -426,12 +444,20 @@ SELECT CASE ( HLBCY(1) )
IF ( SIZE(PLBYVS,1) == 0 ) THEN
ZLBEV (:,:) = 0.
ZLBGV (:,:) = PLBYVM(:,JPHEXT+1,:) - PLBYVM(:,JPHEXT,:)
- ZLBYV(:,:) = PLBYVM(:,JPHEXT,:)
+ IF ( LRECYCL ) THEN
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PFLUCTVNS * XRCOEFF
+ ELSE
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:)
+ END IF
ELSE
ZLBEV (:,:) = PLBYVS(:,JPHEXT,:)
ZLBGV (:,:) = PLBYVM(:,JPHEXT+1,:) - PLBYVM(:,JPHEXT,:) + &
PTSTEP * (PLBYVS(:,JPHEXT+1,:) - PLBYVS(:,JPHEXT,:))
- ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PTSTEP * PLBYVS(:,JPHEXT,:)
+ IF ( LRECYCL ) THEN
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PTSTEP * PLBYVS(:,JPHEXT,:) + PFLUCTVNS * XRCOEFF
+ ELSE
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PTSTEP * PLBYVS(:,JPHEXT,:)
+ END IF
END IF
!
! ============================================================
@@ -461,8 +487,8 @@ END IF
!
!* 5. LBC FILLING IN THE Y DIRECTION (TOP NORTH SIDE):
! ------------------------------
-! ====> It only concernes V component
-! -----------
+! ====> It only concerns V component
+! -----------
!
IF (LNORTH_ll( )) THEN
!
@@ -494,12 +520,20 @@ SELECT CASE ( HLBCY(2) )
IF ( SIZE(PLBYVS,1) == 0 ) THEN
ZLBEV (:,:) = 0.
ZLBGV (:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) - PLBYVM(:,ILBY-JPHEXT,:)
- ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:)
+ IF ( LRECYCL ) THEN
+ ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) + PFLUCTVNN * XRCOEFF
+ ELSE
+ ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:)
+ END IF
ELSE
ZLBEV (:,:) = PLBYVS(:,ILBY-JPHEXT+1,:)
ZLBGV (:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) - PLBYVM(:,ILBY-JPHEXT,:) + &
PTSTEP * (PLBYVS(:,ILBY-JPHEXT+1,:) - PLBYVS(:,ILBY-JPHEXT,:))
- ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) + PTSTEP * PLBYVS(:,ILBY-JPHEXT+1,:)
+ IF ( LRECYCL ) THEN
+ ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) + PTSTEP *PLBYVS(:,ILBY-JPHEXT+1,:) + PFLUCTVNN * XRCOEFF
+ ELSE
+ ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) + PTSTEP *PLBYVS(:,ILBY-JPHEXT+1,:)
+ END IF
END IF
!
! ============================================================
diff --git a/src/MNH/radtr_satel.f90 b/src/MNH/radtr_satel.f90
index 851030cd802f30efaafe2a856c5c3921fc60057c..ce4f86451ba3abeb5fa293ff5036fccfe8d9138e 100644
--- a/src/MNH/radtr_satel.f90
+++ b/src/MNH/radtr_satel.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
@@ -257,6 +257,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZNCLD ! grid scale cloud fraction
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC ! grid scale r_c mixing ratio (kg/kg)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI ! grid scale r_i (kg/kg)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV ! grid scale r_v (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
!----------------------------------------------------------------------------
!
!* 1. INITIALIZATION OF CONSTANTS FOR TRANSFERT CODE
@@ -476,8 +477,10 @@ IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
ALLOCATE(ZSIGRC(IIU,IJU,IKU))
ALLOCATE(ZRV(IIU,IJU,IKU))
ZRV=PRT(:,:,:,1)
- CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'T',&
- PPABST, PZZ, ZTEMP, ZRV, ZRC, ZRI, PRT(:,:,:,5), PRT(:,:,:,6), PSIGS,&
+ ALLOCATE(ZRHO(IIU,IJU,IKU))
+ ZRHO=1. !unused
+ CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'T', 'CB02', 'CB',&
+ PPABST, PZZ, ZRHO, ZTEMP, ZRV, ZRC, ZRI, PRT(:,:,:,5), PRT(:,:,:,6), PSIGS,&
PMFCONV, ZNCLD, ZSIGRC, OUSERI, OSIGMAS,PSIGQSAT )
DEALLOCATE(ZTEMP,ZSIGRC)
ELSE
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index ec1f392049c5b4efdf295c90d3fe66342325628d..d736f5a9cc920751da778ad291aa4ad4898d93aa 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-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.
@@ -751,7 +751,9 @@ IF( IMICRO >= 0 ) THEN
DO JL=1,IMICRO
PRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
END DO
- CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRT(:,:,:))
+ CALL ICE4_RAINFR_VERT( IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRT(:,:,:), &
+ RESHAPE( SOURCE = [ ( 0., JL = 1, SIZE( PRSS ) ) ], SHAPE = SHAPE( PRSS ) ), &
+ RESHAPE( SOURCE = [ ( 0., JL = 1, SIZE( PRGS ) ) ], SHAPE = SHAPE( PRGS ) ) )
DO JL=1,IMICRO
ZRF(JL)=PRAINFR(I1(JL),I2(JL),I3(JL))
END DO
@@ -935,7 +937,8 @@ ELSE
call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
!sedimentation of rain fraction
-CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP)
+CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index 1a7088f1854b780ad91b299670c871e33ccdccce..2416326653944702f6e731bfda3d47c2f2f7d9d3 100644
--- a/src/MNH/rain_ice_red.f90
+++ b/src/MNH/rain_ice_red.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-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.
@@ -8,20 +8,27 @@
! ########################
!
INTERFACE
- SUBROUTINE RAIN_ICE_RED ( OSEDIC,HSEDIM, HSUBG_AUCV_RC, OWARM, KKA, KKU, KKL, &
+ SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
+ OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM, KKA, KKU, KKL, &
PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
!
!
+INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
+INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Switch for rc->rr Subgrid autoconversion
! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Switch for ri->rs Subgrid autoconversion
+ ! Kind of Subgrid autoconversion method
LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
@@ -32,63 +39,69 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: ODMICRO ! mask to limit computation
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(:,:,:),INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D! Rain evap profile
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HCF
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
END SUBROUTINE RAIN_ICE_RED
END INTERFACE
END MODULE MODI_RAIN_ICE_RED
! ######spl
- SUBROUTINE RAIN_ICE_RED ( OSEDIC,HSEDIM, HSUBG_AUCV_RC, OWARM, KKA, KKU, KKL, &
- PTSTEP, KRR, ODMICRO, PEXN, &
+ SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
+ OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM,KKA,KKU,KKL,&
+ PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
! ######################################################################
!
@@ -249,6 +262,9 @@ END MODULE MODI_RAIN_ICE_RED
!* 0. DECLARATIONS
! ------------
!
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
use modd_budget, only: lbu_enable, &
lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
@@ -277,9 +293,12 @@ IMPLICIT NONE
!
!
!
+INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
+INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
@@ -288,200 +307,216 @@ INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: ODMICRO ! mask to limit computation
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXN ! Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Convective Mass Flux Cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel m.r. source
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINDEP ! Cloud instant deposition
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR! Rain instant precip
-REAL, DIMENSION(:,:,:),INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D! Rain evap profile
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
-REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
+LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: ODMICRO ! mask to limit computation
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXN ! Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PCLDFR ! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PHLI_HCF
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRVT ! Water vapor m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
+!
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PTHS ! Theta source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC! Cloud instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRR! Rain instant precip
+REAL, DIMENSION(KIT,KJT,KKT),INTENT(OUT) :: PINPRR3D! Rain inst precip 3D
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PEVAP3D! Rain evap profile
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRS! Snow instant precip
+REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG! Graupel instant precip
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
+REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
+REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH! Hail instant precip
+REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIB ! Define the domain where is
INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IIT !
INTEGER :: IJB !
INTEGER :: IJE !
-INTEGER :: IJT !
-INTEGER :: IKB, IKTB, IKT!
+INTEGER :: IKB, IKTB !
INTEGER :: IKE, IKTE !
!
+INTEGER :: JI, JJ, JK
+!
!For packing
INTEGER :: IMICRO ! Case r_x>0 locations
-INTEGER, DIMENSION(COUNT(ODMICRO)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
+INTEGER, DIMENSION(KSIZE) :: I1,I2,I3 ! Used to replace the COUNT
+INTEGER :: JL ! and PACK intrinsics
!
-!Arrays for nucleation call outisde of ODMICRO points
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) :: ZW ! work array
-real, dimension(:,:,:), allocatable :: zw1, zw2, zw3, zw4, zw5, zw6 !Work arrays
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) :: ZT ! Temperature
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
+!Arrays for nucleation call outisde of LDMICRO points
+REAL, DIMENSION(KIT, KJT, KKT) :: ZW ! work array
+REAL, DIMENSION(KIT, KJT, KKT) :: ZT ! Temperature
+REAL, DIMENSION(KIT, KJT, KKT) :: &
& ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
& ZZ_RVHENI ! heterogeneous nucleation
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZZ_LVFACT, ZZ_LSFACT
+real, dimension(:,:,:), allocatable :: zw1, zw2, zw3, zw4, zw5, zw6 !Work arrays
real, dimension(:,:,:), allocatable :: zz_diff
+REAL, DIMENSION(KIT, KJT, KKT) :: ZZ_LVFACT, ZZ_LSFACT
!
!Diagnostics
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
- & ZHLC_HCF3D,& ! HLCLOUDS cloud fraction in high water content part
- & ZHLC_LCF3D,& ! HLCLOUDS cloud fraction in low water content part
- & ZHLC_HRC3D,& ! HLCLOUDS cloud water content in high water content
- & ZHLC_LRC3D ! HLCLOUDS cloud water content in low water content
+REAL, DIMENSION(KIT, KJT, KKT) :: &
+ & ZHLC_HCF3D,& ! HLCLOUDS cloud fraction in high water content part
+ & ZHLC_LCF3D,& ! HLCLOUDS cloud fraction in low water content part
+ & ZHLC_HRC3D,& ! HLCLOUDS cloud water content in high water content
+ & ZHLC_LRC3D,& ! HLCLOUDS cloud water content in low water content
+ & ZHLI_HCF3D,& ! HLCLOUDS cloud fraction in high ice content part
+ & ZHLI_LCF3D,& ! HLCLOUDS cloud fraction in low ice content part
+ & ZHLI_HRI3D,& ! HLCLOUDS cloud water content in high ice content
+ & ZHLI_LRI3D ! HLCLOUDS cloud water content in high ice content
+
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZINPRI ! Pristine ice instant precip
!
!Packed variables
-REAL, DIMENSION(COUNT(ODMICRO)) :: ZRVT, & ! Water vapor m.r. at t
- & ZRCT, & ! Cloud water m.r. at t
- & ZRRT, & ! Rain water m.r. at t
- & ZRIT, & ! Pristine ice m.r. at t
- & ZRST, & ! Snow/aggregate m.r. at t
- & ZRGT, & ! Graupel m.r. at t
- & ZRHT, & ! Hail m.r. at t
- & ZCIT, & ! Pristine ice conc. at t
- & ZTHT, & ! Potential temperature
- & ZRHODREF, & ! RHO Dry REFerence
- & ZZT, & ! Temperature
- & ZPRES, & ! Pressure
- & ZEXN, & ! EXNer Pressure
- & ZLSFACT, & ! L_s/(Pi*C_ph)
- & ZLVFACT, & ! L_v/(Pi*C_ph)
- & ZSIGMA_RC,& ! Standard deviation of rc at time t
- & ZCF, & ! Cloud fraction
- & ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
- & ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
- ! note that ZCF = ZHLC_HCF + ZHLC_LCF
- & ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
- & ZHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
- ! note that ZRC = ZHLC_HRC + ZHLC_LRC
+REAL, DIMENSION(KSIZE) :: ZRVT, & ! Water vapor m.r. at t
+ & ZRCT, & ! Cloud water m.r. at t
+ & ZRRT, & ! Rain water m.r. at t
+ & ZRIT, & ! Pristine ice m.r. at t
+ & ZRST, & ! Snow/aggregate m.r. at t
+ & ZRGT, & ! Graupel m.r. at t
+ & ZRHT, & ! Hail m.r. at t
+ & ZCIT, & ! Pristine ice conc. at t
+ & ZTHT, & ! Potential temperature
+ & ZRHODREF, & ! RHO Dry REFerence
+ & ZZT, & ! Temperature
+ & ZPRES, & ! Pressure
+ & ZEXN, & ! EXNer Pressure
+ & ZLSFACT, & ! L_s/(Pi*C_ph)
+ & ZLVFACT, & ! L_v/(Pi*C_ph)
+ & ZSIGMA_RC,& ! Standard deviation of rc at time t
+ & ZCF, & ! Cloud fraction
+ & ZHLC_HCF, & ! HLCLOUDS : fraction of High Cloud Fraction in grid
+ & ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
+ ! note that ZCF = ZHLC_HCF + ZHLC_LCF
+ & ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
+ & ZHLC_LRC, & ! HLCLOUDS : LWC that is Low LWC in grid
+ ! note that ZRC = ZHLC_HRC + ZHLC_LRC
+ & ZHLI_HCF, &
+ & ZHLI_LCF, &
+ & ZHLI_HRI, &
+ & ZHLI_LRI, &
+ & ZFRAC
!
!Output packed tendencies (for budgets only)
-REAL, DIMENSION(COUNT(ODMICRO)) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
- & ZRCHONI, & ! Homogeneous nucleation
- & ZRRHONG_MR, & ! Spontaneous freezing mixing ratio change
- & ZRVDEPS, & ! Deposition on r_s,
- & ZRIAGGS, & ! Aggregation on r_s
- & ZRIAUTS, & ! Autoconversion of r_i for r_s production
- & ZRVDEPG, & ! Deposition on r_g
- & ZRCAUTR, & ! Autoconversion of r_c for r_r production
- & ZRCACCR, & ! Accretion of r_c for r_r production
- & ZRREVAV, & ! Evaporation of r_r
- & ZRIMLTC_MR, & ! Cloud ice melting mixing ratio change
- & ZRCBERI, & ! Bergeron-Findeisen effect
- & ZRHMLTR, & ! Melting of the hailstones
- & ZRSMLTG, & ! Conversion-Melting of the aggregates
- & ZRCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
- & ZRRACCSS, ZRRACCSG, ZRSACCRG, & ! Rain accretion onto the aggregates
- & ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRSRIMCG_MR, & ! Cloud droplet riming of the aggregates
- & ZRICFRRG, ZRRCFRIG, ZRICFRR, & ! Rain contact freezing
- & ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, & ! Graupel wet growth
- & ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, & ! Graupel dry growth
- & ZRWETGH, & ! Conversion of graupel into hail
- & ZRWETGH_MR, & ! Conversion of graupel into hail, mr change
- & ZRGMLTR, & ! Melting of the graupel
- & ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, & ! Dry growth of hailstone
- & ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, & ! Wet growth of hailstone
- & ZRDRYHG ! Conversion of hailstone into graupel
+REAL, DIMENSION(KSIZE) :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
+ & ZRCHONI, & ! Homogeneous nucleation
+ & ZRRHONG_MR, & ! Spontaneous freezing mixing ratio change
+ & ZRVDEPS, & ! Deposition on r_s,
+ & ZRIAGGS, & ! Aggregation on r_s
+ & ZRIAUTS, & ! Autoconversion of r_i for r_s production
+ & ZRVDEPG, & ! Deposition on r_g
+ & ZRCAUTR, & ! Autoconversion of r_c for r_r production
+ & ZRCACCR, & ! Accretion of r_c for r_r production
+ & ZRREVAV, & ! Evaporation of r_r
+ & ZRIMLTC_MR, & ! Cloud ice melting mixing ratio change
+ & ZRCBERI, & ! Bergeron-Findeisen effect
+ & ZRHMLTR, & ! Melting of the hailstones
+ & ZRSMLTG, & ! Conversion-Melting of the aggregates
+ & ZRCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+ & ZRRACCSS, ZRRACCSG, ZRSACCRG, & ! Rain accretion onto the aggregates
+ & ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRSRIMCG_MR, & ! Cloud droplet riming of the aggregates
+ & ZRICFRRG, ZRRCFRIG, ZRICFRR, & ! Rain contact freezing
+ & ZRCWETG, ZRIWETG, ZRRWETG, ZRSWETG, & ! Graupel wet growth
+ & ZRCDRYG, ZRIDRYG, ZRRDRYG, ZRSDRYG, & ! Graupel dry growth
+ & ZRWETGH, & ! Conversion of graupel into hail
+ & ZRWETGH_MR, & ! Conversion of graupel into hail, mr change
+ & ZRGMLTR, & ! Melting of the graupel
+ & ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, & ! Dry growth of hailstone
+ & ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, & ! Wet growth of hailstone
+ & ZRDRYHG ! Conversion of hailstone into graupel
!
!Output packed total mixing ratio change (for budgets only)
-REAL, DIMENSION(COUNT(ODMICRO)) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
- & ZTOT_RCHONI, & ! Homogeneous nucleation
- & ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
- & ZTOT_RVDEPS, & ! Deposition on r_s,
- & ZTOT_RIAGGS, & ! Aggregation on r_s
- & ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
- & ZTOT_RVDEPG, & ! Deposition on r_g
- & ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
- & ZTOT_RCACCR, & ! Accretion of r_c for r_r production
- & ZTOT_RREVAV, & ! Evaporation of r_r
- & ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
- & ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
- & ZTOT_RCBERI, & ! Bergeron-Findeisen effect
- & ZTOT_RHMLTR, & ! Melting of the hailstones
- & ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
- & ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
- & ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
- & ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
- & ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
- & ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
- & ZTOT_RWETGH, & ! Conversion of graupel into hail
- & ZTOT_RGMLTR, & ! Melting of the graupel
- & ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
- & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
- & ZTOT_RDRYHG ! Conversion of hailstone into graupel
+REAL, DIMENSION(KSIZE) :: ZTOT_RVHENI, & ! heterogeneous nucleation mixing ratio change
+ & ZTOT_RCHONI, & ! Homogeneous nucleation
+ & ZTOT_RRHONG, & ! Spontaneous freezing mixing ratio change
+ & ZTOT_RVDEPS, & ! Deposition on r_s,
+ & ZTOT_RIAGGS, & ! Aggregation on r_s
+ & ZTOT_RIAUTS, & ! Autoconversion of r_i for r_s production
+ & ZTOT_RVDEPG, & ! Deposition on r_g
+ & ZTOT_RCAUTR, & ! Autoconversion of r_c for r_r production
+ & ZTOT_RCACCR, & ! Accretion of r_c for r_r production
+ & ZTOT_RREVAV, & ! Evaporation of r_r
+ & ZTOT_RCRIMSS, ZTOT_RCRIMSG, ZTOT_RSRIMCG, & ! Cloud droplet riming of the aggregates
+ & ZTOT_RIMLTC, & ! Cloud ice melting mixing ratio change
+ & ZTOT_RCBERI, & ! Bergeron-Findeisen effect
+ & ZTOT_RHMLTR, & ! Melting of the hailstones
+ & ZTOT_RSMLTG, & ! Conversion-Melting of the aggregates
+ & ZTOT_RCMLTSR, & ! Cloud droplet collection onto aggregates by positive temperature
+ & ZTOT_RRACCSS, ZTOT_RRACCSG, ZTOT_RSACCRG, & ! Rain accretion onto the aggregates
+ & ZTOT_RICFRRG, ZTOT_RRCFRIG, ZTOT_RICFRR, & ! Rain contact freezing
+ & ZTOT_RCWETG, ZTOT_RIWETG, ZTOT_RRWETG, ZTOT_RSWETG, & ! Graupel wet growth
+ & ZTOT_RCDRYG, ZTOT_RIDRYG, ZTOT_RRDRYG, ZTOT_RSDRYG, & ! Graupel dry growth
+ & ZTOT_RWETGH, & ! Conversion of graupel into hail
+ & ZTOT_RGMLTR, & ! Melting of the graupel
+ & ZTOT_RCWETH, ZTOT_RIWETH, ZTOT_RSWETH, ZTOT_RGWETH, ZTOT_RRWETH, & ! Dry growth of hailstone
+ & ZTOT_RCDRYH, ZTOT_RIDRYH, ZTOT_RSDRYH, ZTOT_RRDRYH, ZTOT_RGDRYH, & ! Wet growth of hailstone
+ & ZTOT_RDRYHG ! Conversion of hailstone into graupel
!
!For time- or mixing-ratio- splitting
-REAL, DIMENSION(COUNT(ODMICRO)) :: Z0RVT, & ! Water vapor m.r. at the beginig of the current loop
- & Z0RCT, & ! Cloud water m.r. at the beginig of the current loop
- & Z0RRT, & ! Rain water m.r. at the beginig of the current loop
- & Z0RIT, & ! Pristine ice m.r. at the beginig of the current loop
- & Z0RST, & ! Snow/aggregate m.r. at the beginig of the current loop
- & Z0RGT, & ! Graupel m.r. at the beginig of the current loop
- & Z0RHT, & ! Hail m.r. at the beginig of the current loop
- & ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
- & ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH
+REAL, DIMENSION(KSIZE) :: Z0RVT, & ! Water vapor m.r. at the beginig of the current loop
+ & Z0RCT, & ! Cloud water m.r. at the beginig of the current loop
+ & Z0RRT, & ! Rain water m.r. at the beginig of the current loop
+ & Z0RIT, & ! Pristine ice m.r. at the beginig of the current loop
+ & Z0RST, & ! Snow/aggregate m.r. at the beginig of the current loop
+ & Z0RGT, & ! Graupel m.r. at the beginig of the current loop
+ & Z0RHT, & ! Hail m.r. at the beginig of the current loop
+ & ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
+ & ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH
!
!To take into acount external tendencies inside the splitting
-REAL, DIMENSION(COUNT(ODMICRO)) :: ZEXT_RV, & ! External tendencie for rv
- ZEXT_RC, & ! External tendencie for rc
- ZEXT_RR, & ! External tendencie for rr
- ZEXT_RI, & ! External tendencie for ri
- ZEXT_RS, & ! External tendencie for rs
- ZEXT_RG, & ! External tendencie for rg
- ZEXT_RH, & ! External tendencie for rh
- ZEXT_TH, & ! External tendencie for th
- ZEXT_WW ! Working array
+REAL, DIMENSION(KSIZE) :: ZEXT_RV, & ! External tendencie for rv
+ & ZEXT_RC, & ! External tendencie for rc
+ & ZEXT_RR, & ! External tendencie for rr
+ & ZEXT_RI, & ! External tendencie for ri
+ & ZEXT_RS, & ! External tendencie for rs
+ & ZEXT_RG, & ! External tendencie for rg
+ & ZEXT_RH, & ! External tendencie for rh
+ & ZEXT_TH, & ! External tendencie for th
+ & ZEXT_WW ! Working array
LOGICAL :: GEXT_TEND
!
-INTEGER, DIMENSION(COUNT(ODMICRO)) :: IITER ! Number of iterations done (with real tendencies computation)
+INTEGER, DIMENSION(KSIZE) :: IITER ! Number of iterations done (with real tendencies computation)
INTEGER :: INB_ITER_MAX ! Maximum number of iterations (with real tendencies computation)
-REAL, DIMENSION(COUNT(ODMICRO)) :: ZTIME, & ! Current integration time (starts with 0 and ends with PTSTEP)
- & ZMAXTIME, & ! Time on which we can apply the current tendencies
- & ZTIME_THRESHOLD, & ! Time to reach threshold
- & ZTIME_LASTCALL ! Integration time when last tendecies call has been done
-LOGICAL, DIMENSION(COUNT(ODMICRO)) :: LLCOMPUTE ! Points where we must compute tendenceis
+REAL, DIMENSION(KSIZE) :: ZTIME, & ! Current integration time (starts with 0 and ends with PTSTEP)
+ & ZMAXTIME, & ! Time on which we can apply the current tendencies
+ & ZTIME_THRESHOLD, & ! Time to reach threshold
+ & ZTIME_LASTCALL ! Integration time when last tendecies call has been done
+REAL, DIMENSION(KSIZE) :: ZW1D
+REAL, DIMENSION(KSIZE) :: ZCOMPUTE ! 1. for points where we must compute tendencies, 0. elsewhere
LOGICAL :: LSOFT ! Must we really compute tendencies or only adjust them to new T variables
LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
-REAL, DIMENSION(COUNT(ODMICRO), 6) :: ZRS_TEND
-REAL, DIMENSION(COUNT(ODMICRO), 6) :: ZRG_TEND
-REAL, DIMENSION(COUNT(ODMICRO), 8) :: ZRH_TEND
+REAL, DIMENSION(KSIZE, 8) :: ZRS_TEND
+REAL, DIMENSION(KSIZE, 8) :: ZRG_TEND
+REAL, DIMENSION(KSIZE, 10) :: ZRH_TEND
+REAL, DIMENSION(KSIZE) :: ZSSI
!
!For total tendencies computation
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
@@ -498,33 +533,43 @@ end if
! -----------------------
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IIT=SIZE(PDZZ,1)
-IJT=SIZE(PDZZ,2)
IKB=KKA+JPVEXT*KKL
IKE=KKU-JPVEXT*KKL
-IKT=SIZE(PDZZ,3)
IKTB=1+JPVEXT
-IKTE=IKT-JPVEXT
+IKTE=KKT-JPVEXT
!
ZINV_TSTEP=1./PTSTEP
GEXT_TEND=.TRUE.
!
-ZT(:,:,:) = PTHT(:,:,:) * PEXN(:,:,:)
! LSFACT and LVFACT without exner
IF(KRR==7) THEN
- ZZ_LSFACT(:,:,:)=(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))
- ZZ_LVFACT(:,:,:)=(XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
+ ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
+ ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
+ ENDDO
+ ENDDO
+ ENDDO
ELSE
- ZZ_LSFACT(:,:,:)=(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))
- ZZ_LVFACT(:,:,:)=(XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
+ ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
+ ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
+ ENDDO
+ ENDDO
+ ENDDO
ENDIF
!
!-------------------------------------------------------------------------------
@@ -552,22 +597,22 @@ IF(.NOT. LSEDIM_AFTER) THEN
IF(HSEDIM=='STAT') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
@@ -575,20 +620,20 @@ IF(.NOT. LSEDIM_AFTER) THEN
ELSEIF(HSEDIM=='SPLI') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC,XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC,XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
@@ -602,9 +647,10 @@ IF(.NOT. LSEDIM_AFTER) THEN
! will be still active and will lead to negative values.
! We could prevent the algorithm to not consume too much a specie, instead we apply
! a correction here.
- CALL CORRECT_NEGATIVITIES(KRR, PRVS, PRCS, PRRS, &
+ CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
+ ELSEIF(HSEDIM=='NONE') THEN
ELSE
call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
@@ -631,8 +677,8 @@ ENDIF
! optimization by looking for locations where
! the microphysical fields are larger than a minimal value only !!!
!
-! IMICRO=0
-IMICRO=COUNTJV(ODMICRO(:,:,:), I1(:), I2(:), I3(:))
+IMICRO=0
+IF(KSIZE/=0) IMICRO=COUNTJV(ODMICRO(:,:,:), I1(:), I2(:), I3(:))
!Packing
IF(IMICRO>0) THEN
DO JL=1, IMICRO
@@ -648,6 +694,22 @@ IF(IMICRO>0) THEN
ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
ZEXN(JL) = PEXN(I1(JL),I2(JL),I3(JL))
+ ZHLC_HCF(JL) = PHLC_HCF(I1(JL),I2(JL),I3(JL))
+ ZHLC_HRC(JL) = PHLC_HRC(I1(JL),I2(JL),I3(JL))
+ ZHLC_LRC(JL) = ZRCT(JL) - ZHLC_HRC(JL)
+ ZHLI_HCF(JL) = PHLI_HCF(I1(JL),I2(JL),I3(JL))
+ ZHLI_HRI(JL) = PHLI_HRI(I1(JL),I2(JL),I3(JL))
+ ZHLI_LRI(JL) = ZRIT(JL) - ZHLI_HRI(JL)
+ IF(ZRCT(JL)>0.) THEN
+ ZHLC_LCF(JL) = ZCF(JL)- ZHLC_HCF(JL)
+ ELSE
+ ZHLC_LCF(JL)=0.
+ ENDIF
+ IF(ZRIT(JL)>0.) THEN
+ ZHLI_LCF(JL) = ZCF(JL)- ZHLI_HCF(JL)
+ ELSE
+ ZHLI_LCF(JL)=0.
+ ENDIF
ENDDO
IF(GEXT_TEND) THEN
DO JL=1, IMICRO
@@ -664,7 +726,6 @@ IF(IMICRO>0) THEN
IF(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM') THEN
DO JL=1, IMICRO
ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL))*2.
-! ZSIGMA_RC(JL) = MAX(PSIGS(I1(JL),I2(JL),I3(JL)) * 2., 1.E-12)
ENDDO
ENDIF
IF(KRR==7) THEN
@@ -747,53 +808,59 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
IF(XMRSTEP/=0.) THEN
! In this case we need to remember the mixing ratios used to compute the tendencies
! because when mixing ratio has evolved more than a threshold, we must re-compute tendecies
- Z0RVT(:)=ZRVT(:)
- Z0RCT(:)=ZRCT(:)
- Z0RRT(:)=ZRRT(:)
- Z0RIT(:)=ZRIT(:)
- Z0RST(:)=ZRST(:)
- Z0RGT(:)=ZRGT(:)
- Z0RHT(:)=ZRHT(:)
+ DO JL=1, IMICRO
+ Z0RVT(JL)=ZRVT(JL)
+ Z0RCT(JL)=ZRCT(JL)
+ Z0RRT(JL)=ZRRT(JL)
+ Z0RIT(JL)=ZRIT(JL)
+ Z0RST(JL)=ZRST(JL)
+ Z0RGT(JL)=ZRGT(JL)
+ Z0RHT(JL)=ZRHT(JL)
+ ENDDO
ENDIF
IF(XTSTEP_TS/=0.) THEN
! In this case we need to remember the time when tendencies were computed
! because when time has evolved more than a limit, we must re-compute tendecies
ZTIME_LASTCALL(:)=ZTIME(:)
ENDIF
- LLCOMPUTE(:)=ZTIME(:)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
+ ZCOMPUTE(:)=MAX(0., -SIGN(1., ZTIME(:)-PTSTEP)) ! Compuation (1.) only for points for which integration time has not reached the timestep
LSOFT=.FALSE. ! We *really* compute the tendencies
- WHERE(LLCOMPUTE(:))
- IITER(:)=IITER(:)+1
- END WHERE
- DO WHILE(ANY(LLCOMPUTE(:))) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
- ZZT(:) = ZTHT(:) * ZEXN(:)
+ IITER(:)=IITER(:)+INT(ZCOMPUTE(:))
+ DO WHILE(SUM(ZCOMPUTE(:))>0.) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
IF(KRR==7) THEN
- ZLSFACT(:)=(XLSTT+(XCPV-XCI)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)+ZRHT(:)))*ZEXN(:) )
- ZLVFACT(:)=(XLVTT+(XCPV-XCL)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)+ZRHT(:)))*ZEXN(:) )
+ DO JL=1, IMICRO
+ ZZT(JL) = ZTHT(JL) * ZEXN(JL)
+ ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
+ ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
+ ENDDO
ELSE
- ZLSFACT(:)=(XLSTT+(XCPV-XCI)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)))*ZEXN(:) )
- ZLVFACT(:)=(XLVTT+(XCPV-XCL)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)))*ZEXN(:) )
+ DO JL=1, IMICRO
+ ZZT(JL) = ZTHT(JL) * ZEXN(JL)
+ ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
+ ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
+ ENDDO
ENDIF
!
!*** 4.1 Tendecies computation
!
! Tendencies are *really* computed when LSOFT==.FALSE. and only adjusted otherwise
- CALL ICE4_TENDENCIES(IMICRO, IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, &
- &KRR, LSOFT, LLCOMPUTE, &
- &OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, HSUBG_AUCV_RC, CSUBG_PR_PDF, &
+ CALL ICE4_TENDENCIES(IMICRO, IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, &
+ &KRR, LSOFT, ZCOMPUTE, &
+ &OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, CSUBG_PR_PDF, &
&ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, I1, I2, I3, &
- &ZPRES, ZCF, ZSIGMA_RC, &
+ &ZPRES, ZCF, ZSIGMA_RC,&
&ZCIT, &
&ZZT, ZTHT, &
- &ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, PRRT, &
+ &ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
&ZRVHENI_MR, ZRRHONG_MR, ZRIMLTC_MR, ZRSRIMCG_MR, &
&ZRCHONI, ZRVDEPS, ZRIAGGS, ZRIAUTS, ZRVDEPG, &
&ZRCAUTR, ZRCACCR, ZRREVAV, &
@@ -803,181 +870,229 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
&ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, &
&ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, ZRDRYHG, ZRHMLTR, &
&ZRCBERI, &
- &ZRS_TEND, ZRG_TEND, ZRH_TEND, &
+ &ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, &
&ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
&ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH, &
- &ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, PRAINFR)
+ &ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
+ &ZHLI_HCF, ZHLI_LCF, ZHLI_HRI, ZHLI_LRI, PRAINFR)
! External tendencies
IF(GEXT_TEND) THEN
- ZA_TH(:) = ZA_TH(:) + ZEXT_TH(:)
- ZA_RV(:) = ZA_RV(:) + ZEXT_RV(:)
- ZA_RC(:) = ZA_RC(:) + ZEXT_RC(:)
- ZA_RR(:) = ZA_RR(:) + ZEXT_RR(:)
- ZA_RI(:) = ZA_RI(:) + ZEXT_RI(:)
- ZA_RS(:) = ZA_RS(:) + ZEXT_RS(:)
- ZA_RG(:) = ZA_RG(:) + ZEXT_RG(:)
- ZA_RH(:) = ZA_RH(:) + ZEXT_RH(:)
+ DO JL=1, IMICRO
+ ZA_TH(JL) = ZA_TH(JL) + ZEXT_TH(JL)
+ ZA_RV(JL) = ZA_RV(JL) + ZEXT_RV(JL)
+ ZA_RC(JL) = ZA_RC(JL) + ZEXT_RC(JL)
+ ZA_RR(JL) = ZA_RR(JL) + ZEXT_RR(JL)
+ ZA_RI(JL) = ZA_RI(JL) + ZEXT_RI(JL)
+ ZA_RS(JL) = ZA_RS(JL) + ZEXT_RS(JL)
+ ZA_RG(JL) = ZA_RG(JL) + ZEXT_RG(JL)
+ ZA_RH(JL) = ZA_RH(JL) + ZEXT_RH(JL)
+ ENDDO
ENDIF
!
!*** 4.2 Integration time
!
- ! If we can, we will use these tendecies until the end of the timestep
- ZMAXTIME(:)=0.
- WHERE(LLCOMPUTE(:))
- ZMAXTIME(:)=PTSTEP-ZTIME(:) ! Remaining time until the end of the timestep
- ENDWHERE
+ ! If we can, we will use these tendencies until the end of the timestep
+ ZMAXTIME(:)=ZCOMPUTE(:) * (PTSTEP-ZTIME(:)) ! Remaining time until the end of the timestep
!We need to adjust tendencies when temperature reaches 0
IF(LFEEDBACKT) THEN
- !Is ZB_TH enough to change temperature sign?
- WHERE( (ZTHT(:) - XTT/ZEXN(:)) * (ZTHT(:) + ZB_TH(:) - XTT/ZEXN(:)) < 0. )
- ZMAXTIME(:)=0.
- ENDWHERE
- !Can ZA_TH make temperature change of sign?
- ZTIME_THRESHOLD(:)=-1.
- WHERE(ABS(ZA_TH(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(XTT/ZEXN(:) - ZB_TH(:) - ZTHT(:))/ZA_TH(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>0.)
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- ENDWHERE
+ DO JL=1, IMICRO
+ !Is ZB_TH enough to change temperature sign?
+ ZW1D(JL)=(ZTHT(JL) - XTT/ZEXN(JL)) * (ZTHT(JL) + ZB_TH(JL) - XTT/ZEXN(JL))
+ ZMAXTIME(JL)=ZMAXTIME(JL)*MAX(0., SIGN(1., ZW1D(JL)))
+ !Can ZA_TH make temperature change of sign?
+ ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ABS(ZA_TH(JL)))) ! WHERE(ABS(ZA_TH(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1. - ZW1D(JL))*(-1.) + &
+ ZW1D(JL) * &
+ (XTT/ZEXN(JL) - ZB_TH(JL) - ZTHT(JL))/ &
+ SIGN(MAX(ABS(ZA_TH(JL)), 1.E-20), ZA_TH(JL))
+ ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ZTIME_THRESHOLD(JL))) ! WHERE(ZTIME_THRESHOLD(:)>1.E-20)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ ZW1D(JL) * MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ENDDO
ENDIF
!We need to adjust tendencies when a specy disappears
!When a species is missing, only the external tendencies can be negative (and we must keep track of it)
- WHERE(ZA_RV(:)<-1.E-20 .AND. ZRVT(:)>XRTMIN(1))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RV(:)+ZRVT(:))/ZA_RV(:))
- END WHERE
- WHERE(ZA_RC(:)<-1.E-20 .AND. ZRCT(:)>XRTMIN(2))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RC(:)+ZRCT(:))/ZA_RC(:))
- END WHERE
- WHERE(ZA_RR(:)<-1.E-20 .AND. ZRRT(:)>XRTMIN(3))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RR(:)+ZRRT(:))/ZA_RR(:))
- END WHERE
- WHERE(ZA_RI(:)<-1.E-20 .AND. ZRIT(:)>XRTMIN(4))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RI(:)+ZRIT(:))/ZA_RI(:))
- END WHERE
- WHERE(ZA_RS(:)<-1.E-20 .AND. ZRST(:)>XRTMIN(5))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RS(:)+ZRST(:))/ZA_RS(:))
- END WHERE
- WHERE(ZA_RG(:)<-1.E-20 .AND. ZRGT(:)>XRTMIN(6))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RG(:)+ZRGT(:))/ZA_RG(:))
- END WHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RV(JL)+1.E-20)) * & ! WHERE(ZA_RV(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(1)-ZRVT(JL))) ! WHERE(ZRVT(:)>XRTMIN(1))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RV(JL)+ZRVT(JL))/MIN(ZA_RV(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RC(JL)+1.E-20)) * & ! WHERE(ZA_RC(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(2)-ZRCT(JL))) ! WHERE(ZRCT(:)>XRTMIN(2))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RC(JL)+ZRCT(JL))/MIN(ZA_RC(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RR(JL)+1.E-20)) * & ! WHERE(ZA_RR(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(3)-ZRRT(JL))) ! WHERE(ZRRT(:)>XRTMIN(3))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RR(JL)+ZRRT(JL))/MIN(ZA_RR(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RI(JL)+1.E-20)) * & ! WHERE(ZI_RV(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(4)-ZRIT(JL))) ! WHERE(ZRIT(:)>XRTMIN(4))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RI(JL)+ZRIT(JL))/MIN(ZA_RI(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RS(JL)+1.E-20)) * & ! WHERE(ZA_RS(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(5)-ZRST(JL))) ! WHERE(ZRST(:)>XRTMIN(5))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RS(JL)+ZRST(JL))/MIN(ZA_RS(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RG(JL)+1.E-20)) * & ! WHERE(ZA_RG(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) ! WHERE(ZRGT(:)>XRTMIN(6))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RG(JL)+ZRGT(JL))/MIN(ZA_RG(JL), -1.E-20))
+ ENDDO
+
IF(KRR==7) THEN
- WHERE(ZA_RH(:)<-1.E-20 .AND. ZRHT(:)>XRTMIN(7))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RH(:)+ZRHT(:))/ZA_RH(:))
- END WHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RH(JL)+1.E-20)) * & ! WHERE(ZA_RH(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(7)-ZRHT(JL))) ! WHERE(ZRHT(:)>XRTMIN(7))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RH(JL)+ZRHT(JL))/MIN(ZA_RH(JL), -1.E-20))
+ ENDDO
ENDIF
!We stop when the end of the timestep is reached
- WHERE(PTSTEP-ZTIME(:)-ZMAXTIME(:)<=0.)
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ ZCOMPUTE(:)=ZCOMPUTE(:) * MAX(0., -SIGN(1., ZTIME(:)+ZMAXTIME(:)-PTSTEP))
!We must recompute tendencies when the end of the sub-timestep is reached
IF(XTSTEP_TS/=0.) THEN
- WHERE(IITER(:)<INB_ITER_MAX .AND. ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP)
- ZMAXTIME(:)=ZTIME_LASTCALL(:)-ZTIME(:)+ZTSTEP
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., ZTIME_LASTCALL(JL)+ZTSTEP-ZTIME(JL)-ZMAXTIME(JL))) ! WHERE(ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * (ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP)
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
ENDIF
!We must recompute tendencies when the maximum allowed change is reached
!When a specy is missing, only the external tendencies can be active and we do not want to recompute
!the microphysical tendencies when external tendencies are negative (results won't change because specy was already missing)
IF(XMRSTEP/=0.) THEN
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RV(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RV(:))*XMRSTEP+Z0RVT(:)-ZRVT(:)-ZB_RV(:))/ZA_RV(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRVT(:)>XRTMIN(1) .OR. ZA_RV(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RC(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RC(:))*XMRSTEP+Z0RCT(:)-ZRCT(:)-ZB_RC(:))/ZA_RC(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRCT(:)>XRTMIN(2) .OR. ZA_RC(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RR(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RR(:))*XMRSTEP+Z0RRT(:)-ZRRT(:)-ZB_RR(:))/ZA_RR(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRRT(:)>XRTMIN(3) .OR. ZA_RR(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RI(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RI(:))*XMRSTEP+Z0RIT(:)-ZRIT(:)-ZB_RI(:))/ZA_RI(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRIT(:)>XRTMIN(4) .OR. ZA_RI(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RS(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RS(:))*XMRSTEP+Z0RST(:)-ZRST(:)-ZB_RS(:))/ZA_RS(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRST(:)>XRTMIN(5) .OR. ZA_RS(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RG(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RG(:))*XMRSTEP+Z0RGT(:)-ZRGT(:)-ZB_RG(:))/ZA_RG(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRGT(:)>XRTMIN(6) .OR. ZA_RG(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RV(JL)))) ! WHERE(ABS(ZA_RV(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RV(JL))*XMRSTEP+Z0RVT(JL)-ZRVT(JL)-ZB_RV(JL))/ &
+ &SIGN(MAX(ABS(ZA_RV(JL)), 1.E-20), ZA_RV(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRVT(JL))) + & !WHERE(ZRVT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RV(JL)))) !WHERE(ZA_RV(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RC(JL)))) ! WHERE(ABS(ZA_RC(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RC(JL))*XMRSTEP+Z0RCT(JL)-ZRCT(JL)-ZB_RC(JL))/ &
+ &SIGN(MAX(ABS(ZA_RC(JL)), 1.E-20), ZA_RC(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRCT(JL))) + & !WHERE(ZRCT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RC(JL)))) !WHERE(ZA_RC(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RR(JL)))) ! WHERE(ABS(ZA_RR(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RR(JL))*XMRSTEP+Z0RRT(JL)-ZRRT(JL)-ZB_RR(JL))/ &
+ &SIGN(MAX(ABS(ZA_RR(JL)), 1.E-20), ZA_RR(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRRT(JL))) + & !WHERE(ZRRT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RR(JL)))) !WHERE(ZA_RR(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RI(JL)))) ! WHERE(ABS(ZA_RI(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RI(JL))*XMRSTEP+Z0RIT(JL)-ZRIT(JL)-ZB_RI(JL))/ &
+ &SIGN(MAX(ABS(ZA_RI(JL)), 1.E-20), ZA_RI(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRIT(JL))) + & !WHERE(ZRIT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RI(JL)))) !WHERE(ZA_RI(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RS(JL)))) ! WHERE(ABS(ZA_RS(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RS(JL))*XMRSTEP+Z0RST(JL)-ZRST(JL)-ZB_RS(JL))/ &
+ &SIGN(MAX(ABS(ZA_RS(JL)), 1.E-20), ZA_RS(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRST(JL))) + & !WHERE(ZRST(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RS(JL)))) !WHERE(ZA_RS(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RG(JL)))) ! WHERE(ABS(ZA_RG(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RG(JL))*XMRSTEP+Z0RGT(JL)-ZRGT(JL)-ZB_RG(JL))/ &
+ &SIGN(MAX(ABS(ZA_RG(JL)), 1.E-20), ZA_RG(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) + & !WHERE(ZRGT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RG(JL)))) !WHERE(ZA_RG(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
IF(KRR==7) THEN
- ZTIME_THRESHOLD(:)=-1.
- WHERE(IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RH(:))>1.E-20)
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RH(:))*XMRSTEP+Z0RHT(:)-ZRHT(:)-ZB_RH(:))/ZA_RH(:)
- ENDWHERE
- WHERE(ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- &(ZRHT(:)>XRTMIN(7) .OR. ZA_RH(:)>0.))
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RH(JL)))) ! WHERE(ABS(ZA_RH(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RH(JL))*XMRSTEP+Z0RHT(JL)-ZRHT(JL)-ZB_RH(JL))/ &
+ &SIGN(MAX(ABS(ZA_RH(JL)), 1.E-20), ZA_RH(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRHT(JL))) + & !WHERE(ZRHT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RH(JL)))) !WHERE(ZA_RH(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
ENDIF
- WHERE(IITER(:)<INB_ITER_MAX .AND. MAX(ABS(ZB_RV(:)), ABS(ZB_RC(:)), ABS(ZB_RR(:)), ABS(ZB_RI(:)), &
- ABS(ZB_RS(:)), ABS(ZB_RG(:)), ABS(ZB_RH(:)))>XMRSTEP)
- ZMAXTIME(:)=0.
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(ABS(ZB_RV(JL)), ABS(ZB_RC(JL)), ABS(ZB_RR(JL)), ABS(ZB_RI(JL)), &
+ &ABS(ZB_RS(JL)), ABS(ZB_RG(JL)), ABS(ZB_RH(JL)))
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & !WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., XMRSTEP-ZW1D(JL))) !WHERE(ZW1D(:)>XMRSTEP)
+ ZMAXTIME(JL)=(1.-ZW1D(JL))*ZMAXTIME(JL)
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
ENDIF
!
!*** 4.3 New values of variables for next iteration
!
- ZTHT=ZTHT+ZA_TH(:)*ZMAXTIME(:)+ZB_TH(:)
- ZRVT=ZRVT+ZA_RV(:)*ZMAXTIME(:)+ZB_RV(:)
- ZRCT=ZRCT+ZA_RC(:)*ZMAXTIME(:)+ZB_RC(:)
- ZRRT=ZRRT+ZA_RR(:)*ZMAXTIME(:)+ZB_RR(:)
- ZRIT=ZRIT+ZA_RI(:)*ZMAXTIME(:)+ZB_RI(:)
- ZRST=ZRST+ZA_RS(:)*ZMAXTIME(:)+ZB_RS(:)
- ZRGT=ZRGT+ZA_RG(:)*ZMAXTIME(:)+ZB_RG(:)
- IF(KRR==7) ZRHT=ZRHT+ZA_RH(:)*ZMAXTIME(:)+ZB_RH(:)
- WHERE(ZRIT(:)==0.)
- ZCIT(:) = 0.
- END WHERE
+ DO JL=1, IMICRO
+ ZTHT(JL)=ZTHT(JL)+ZA_TH(JL)*ZMAXTIME(JL)+ZB_TH(JL)
+ ZRVT(JL)=ZRVT(JL)+ZA_RV(JL)*ZMAXTIME(JL)+ZB_RV(JL)
+ ZRCT(JL)=ZRCT(JL)+ZA_RC(JL)*ZMAXTIME(JL)+ZB_RC(JL)
+ ZRRT(JL)=ZRRT(JL)+ZA_RR(JL)*ZMAXTIME(JL)+ZB_RR(JL)
+ ZRIT(JL)=ZRIT(JL)+ZA_RI(JL)*ZMAXTIME(JL)+ZB_RI(JL)
+ ZRST(JL)=ZRST(JL)+ZA_RS(JL)*ZMAXTIME(JL)+ZB_RS(JL)
+ ZRGT(JL)=ZRGT(JL)+ZA_RG(JL)*ZMAXTIME(JL)+ZB_RG(JL)
+ ZCIT(JL)=ZCIT(JL) * MAX(0., -SIGN(1., -ZRIT(JL))) ! WHERE(ZRIT(:)==0.) ZCIT(:) = 0.
+ ENDDO
+ IF(KRR==7) ZRHT(:)=ZRHT(:)+ZA_RH(:)*ZMAXTIME(:)+ZB_RH(:)
!
!*** 4.4 Mixing ratio change due to each process
!
@@ -1045,11 +1160,19 @@ IF(IMICRO>0) THEN
ZHLC_LCF3D(:,:,:)=0.
ZHLC_HRC3D(:,:,:)=0.
ZHLC_LRC3D(:,:,:)=0.
+ ZHLI_HCF3D(:,:,:)=0.
+ ZHLI_LCF3D(:,:,:)=0.
+ ZHLI_HRI3D(:,:,:)=0.
+ ZHLI_LRI3D(:,:,:)=0.
DO JL=1,IMICRO
ZHLC_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HCF(JL)
ZHLC_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LCF(JL)
ZHLC_HRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HRC(JL)
ZHLC_LRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LRC(JL)
+ ZHLI_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LCF(JL)
+ ZHLI_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HCF(JL)
+ ZHLI_HRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HRI(JL)
+ ZHLI_LRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LRI(JL)
PCIT(I1(JL), I2(JL), I3(JL)) = ZCIT(JL)
END DO
ELSE
@@ -1058,6 +1181,10 @@ ELSE
ZHLC_LCF3D(:,:,:)=0.
ZHLC_HRC3D(:,:,:)=0.
ZHLC_LRC3D(:,:,:)=0.
+ ZHLI_HCF3D(:,:,:)=0.
+ ZHLI_LCF3D(:,:,:)=0.
+ ZHLI_HRI3D(:,:,:)=0.
+ ZHLI_LRI3D(:,:,:)=0.
PCIT(:,:,:) = 0.
ENDIF
IF(OWARM) THEN
@@ -1071,24 +1198,29 @@ ENDIF
!* 6. COMPUTES THE SLOW COLD PROCESS SOURCES OUTSIDE OF ODMICRO POINTS
! ----------------------------------------------------------------
!
-CALL ICE4_NUCLEATION_WRAPPER(IIT, IJT, IKT, .NOT. ODMICRO, &
+CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, .NOT. ODMICRO, &
PTHT, PPABST, PRHODREF, PEXN, ZZ_LSFACT/PEXN, ZT, &
PRVT, &
PCIT, ZZ_RVHENI_MR)
-ZZ_LSFACT(:,:,:)=ZZ_LSFACT(:,:,:)/PEXNREF(:,:,:)
-ZZ_LVFACT(:,:,:)=ZZ_LVFACT(:,:,:)/PEXNREF(:,:,:)
-ZZ_RVHENI(:,:,:) = MIN(PRVS(:,:,:), ZZ_RVHENI_MR(:,:,:)/PTSTEP)
-PRIS(:,:,:)=PRIS(:,:,:)+ZZ_RVHENI(:,:,:)
-PRVS(:,:,:)=PRVS(:,:,:)-ZZ_RVHENI(:,:,:)
-PTHS(:,:,:)=PTHS(:,:,:) + ZZ_RVHENI(:,:,:)*ZZ_LSFACT(:,:,:)
-
+DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZZ_LSFACT(JI,JJ,JK)=ZZ_LSFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
+ ZZ_LVFACT(JI,JJ,JK)=ZZ_LVFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
+ ZZ_RVHENI(JI,JJ,JK) = MIN(PRVS(JI,JJ,JK), ZZ_RVHENI_MR(JI,JJ,JK)/PTSTEP)
+ PRIS(JI,JJ,JK)=PRIS(JI,JJ,JK)+ZZ_RVHENI(JI,JJ,JK)
+ PRVS(JI,JJ,JK)=PRVS(JI,JJ,JK)-ZZ_RVHENI(JI,JJ,JK)
+ PTHS(JI,JJ,JK)=PTHS(JI,JJ,JK) + ZZ_RVHENI(JI,JJ,JK)*ZZ_LSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+!
if ( lbu_enable ) then
!Note: there is an other contribution for HENU later
if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HENU', zz_rvheni(:, :, :) * prhodj(:, :, :) )
end if
-
!-------------------------------------------------------------------------------
!
!* 7. UNPACKING AND TOTAL TENDENCIES
@@ -1101,14 +1233,16 @@ end if
!
IF(GEXT_TEND) THEN
!Z..T variables contain the exeternal tendency, we substract it
- ZRVT(:) = ZRVT(:) - ZEXT_RV(:) * PTSTEP
- ZRCT(:) = ZRCT(:) - ZEXT_RC(:) * PTSTEP
- ZRRT(:) = ZRRT(:) - ZEXT_RR(:) * PTSTEP
- ZRIT(:) = ZRIT(:) - ZEXT_RI(:) * PTSTEP
- ZRST(:) = ZRST(:) - ZEXT_RS(:) * PTSTEP
- ZRGT(:) = ZRGT(:) - ZEXT_RG(:) * PTSTEP
+ DO JL=1, IMICRO
+ ZRVT(JL) = ZRVT(JL) - ZEXT_RV(JL) * PTSTEP
+ ZRCT(JL) = ZRCT(JL) - ZEXT_RC(JL) * PTSTEP
+ ZRRT(JL) = ZRRT(JL) - ZEXT_RR(JL) * PTSTEP
+ ZRIT(JL) = ZRIT(JL) - ZEXT_RI(JL) * PTSTEP
+ ZRST(JL) = ZRST(JL) - ZEXT_RS(JL) * PTSTEP
+ ZRGT(JL) = ZRGT(JL) - ZEXT_RG(JL) * PTSTEP
+ ZTHT(JL) = ZTHT(JL) - ZEXT_TH(JL) * PTSTEP
+ ENDDO
IF (KRR==7) ZRHT(:) = ZRHT(:) - ZEXT_RH(:) * PTSTEP
- ZTHT(:) = ZTHT(:) - ZEXT_TH(:) * PTSTEP
ENDIF
!Tendencies computed from difference between old state and new state (can be negative)
ZW_RVS(:,:,:) = 0.
@@ -1155,7 +1289,7 @@ if ( lbu_enable ) then
end if
!We correct negativities with conservation
-CALL CORRECT_NEGATIVITIES(KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
+CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
&ZW_RIS, ZW_RSS, ZW_RGS, &
&ZW_THS, ZZ_LVFACT, ZZ_LSFACT, ZW_RHS)
@@ -1507,16 +1641,20 @@ ENDIF
!
!*** 7.3 Final tendencies
!
-PRVS(:,:,:) = ZW_RVS(:,:,:)
-PRCS(:,:,:) = ZW_RCS(:,:,:)
-PRRS(:,:,:) = ZW_RRS(:,:,:)
-PRIS(:,:,:) = ZW_RIS(:,:,:)
-PRSS(:,:,:) = ZW_RSS(:,:,:)
-PRGS(:,:,:) = ZW_RGS(:,:,:)
-IF (KRR==7) THEN
- PRHS(:,:,:) = ZW_RHS(:,:,:)
-ENDIF
-PTHS(:,:,:) = ZW_THS(:,:,:)
+DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ PRVS(JI,JJ,JK) = ZW_RVS(JI,JJ,JK)
+ PRCS(JI,JJ,JK) = ZW_RCS(JI,JJ,JK)
+ PRRS(JI,JJ,JK) = ZW_RRS(JI,JJ,JK)
+ PRIS(JI,JJ,JK) = ZW_RIS(JI,JJ,JK)
+ PRSS(JI,JJ,JK) = ZW_RSS(JI,JJ,JK)
+ PRGS(JI,JJ,JK) = ZW_RGS(JI,JJ,JK)
+ PTHS(JI,JJ,JK) = ZW_THS(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+IF (KRR==7) PRHS(:,:,:) = ZW_RHS(:,:,:)
!
!-------------------------------------------------------------------------------
!
@@ -1543,22 +1681,22 @@ IF(LSEDIM_AFTER) THEN
IF(HSEDIM=='STAT') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ,&
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
@@ -1566,20 +1704,20 @@ IF(LSEDIM_AFTER) THEN
ELSEIF(HSEDIM=='SPLI') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
PINPRS(:,:) = PINPRS(:,:) + ZINPRI(:,:)
@@ -1593,7 +1731,7 @@ IF(LSEDIM_AFTER) THEN
! will be still active and will lead to negative values.
! We could prevent the algorithm to not consume too much a specie, instead we apply
! a correction here.
- CALL CORRECT_NEGATIVITIES(KRR, PRVS, PRCS, PRRS, &
+ CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSE
@@ -1615,96 +1753,130 @@ IF(LSEDIM_AFTER) THEN
call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
!sedimentation of rain fraction
- CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP)
+ IF (PRESENT(PRHS)) THEN
+ CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP, PRHS(:,:,:)*PTSTEP)
+ ELSE
+ CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
+ ENDIF
ENDIF
!
!
CONTAINS
!
- SUBROUTINE CORRECT_NEGATIVITIES(KRR, PRV, PRC, PRR, &
+ SUBROUTINE CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRV, PRC, PRR, &
&PRI, PRS, PRG, &
&PTH, PLVFACT, PLSFACT, PRH)
!
IMPLICIT NONE
!
- INTEGER, INTENT(IN) :: KRR
- REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PLVFACT, PLSFACT
- REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRH
+ INTEGER, INTENT(IN) :: KIT, KJT, KKT, KRR
+ REAL, DIMENSION(KIT, KJT, KKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
+ REAL, DIMENSION(KIT, KJT, KKT), INTENT(IN) :: PLVFACT, PLSFACT
+ REAL, DIMENSION(KIT, KJT, KKT), OPTIONAL, INTENT(INOUT) :: PRH
+ !
+ REAL, DIMENSION(KIT, KJT, KKT) :: ZW
+ INTEGER :: JI, JJ, JK
!
- REAL, DIMENSION(SIZE(PRV,1), SIZE(PRV,2), SIZE(PRV,3)) :: ZW
!
!We correct negativities with conservation
! 1) deal with negative values for mixing ratio, except for vapor
- WHERE(PRC(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRC(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRC(:,:,:)*PLVFACT(:,:,:)
- PRC(:,:,:)=0.
- ENDWHERE
- WHERE(PRR(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRR(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRR(:,:,:)*PLVFACT(:,:,:)
- PRR(:,:,:)=0.
- ENDWHERE
- WHERE(PRI(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRI(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRI(:,:,:)*PLSFACT(:,:,:)
- PRI(:,:,:)=0.
- ENDWHERE
- WHERE(PRS(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRS(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRS(:,:,:)*PLSFACT(:,:,:)
- PRS(:,:,:)=0.
- ENDWHERE
- WHERE(PRG(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRG(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRG(:,:,:)*PLSFACT(:,:,:)
- PRG(:,:,:)=0.
- ENDWHERE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK) =PRC(JI,JJ,JK)-MAX(PRC(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+ PRC(JI,JJ,JK)=PRC(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRR(JI,JJ,JK)-MAX(PRR(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+ PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRI(JI,JJ,JK)-MAX(PRI(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRI(JI,JJ,JK)=PRI(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRS(JI,JJ,JK)-MAX(PRS(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRG(JI,JJ,JK)-MAX(PRG(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+
IF(KRR==7) THEN
- WHERE(PRH(:,:,:)<0.)
- PRV(:,:,:)=PRV(:,:,:)+PRH(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRH(:,:,:)*PLSFACT(:,:,:)
- PRH(:,:,:)=0.
- ENDWHERE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK) =PRH(JI,JJ,JK)-MAX(PRH(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
ENDIF
+
! 2) deal with negative vapor mixing ratio
- WHERE(PRV(:,:,:)<0. .AND. PRC(:,:,:)+PRI(:,:,:)>0.)
- ! for rc and ri, we keep ice fraction constant
- ZW(:,:,:)=MIN(1., -PRV(:,:,:)/(PRC(:,:,:)+PRI(:,:,:))) ! Proportion of rc+ri to convert into rv
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*(PRC(:,:,:)*PLVFACT(:,:,:)+PRI(:,:,:)*PLSFACT(:,:,:))
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)*(PRC(:,:,:)+PRI(:,:,:))
- PRC(:,:,:)=(1.-ZW(:,:,:))*PRC(:,:,:)
- PRI(:,:,:)=(1.-ZW(:,:,:))*PRI(:,:,:)
- ENDWHERE
- WHERE(PRV(:,:,:)<0. .AND. PRR(:,:,:)>0.)
- ZW(:,:,:)=MIN(PRR(:,:,:), -PRV(:,:,:)) ! Quantity of rr to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRR(:,:,:)=PRR(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLVFACT(:,:,:)
- ENDWHERE
- WHERE(PRV(:,:,:)<0. .AND. PRS(:,:,:)>0.)
- ZW(:,:,:)=MIN(PRS(:,:,:), -PRV(:,:,:)) ! Quantity of rs to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRS(:,:,:)=PRS(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLSFACT(:,:,:)
- ENDWHERE
- WHERE(PRV(:,:,:)<0. .AND. PRG(:,:,:)>0.)
- ZW(:,:,:)=MIN(PRG(:,:,:), -PRV(:,:,:)) ! Quantity of rg to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRG(:,:,:)=PRG(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLSFACT(:,:,:)
- ENDWHERE
+
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ! for rc and ri, we keep ice fraction constant
+ ZW(JI,JJ,JK)=MIN(1., MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.) / &
+ &MAX(PRC(JI,JJ,JK)+PRI(JI,JJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)* &
+ &(PRC(JI,JJ,JK)*PLVFACT(JI,JJ,JK)+PRI(JI,JJ,JK)*PLSFACT(JI,JJ,JK))
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)*(PRC(JI,JJ,JK)+PRI(JI,JJ,JK))
+ PRC(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRC(JI,JJ,JK)
+ PRI(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRI(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRR(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rr to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRS(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rs to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRG(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rg to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+
IF(KRR==7) THEN
- WHERE(PRV(:,:,:)<0. .AND. PRH(:,:,:)>0.)
- ZW(:,:,:)=MIN(PRH(:,:,:), -PRV(:,:,:)) ! Quantity of rh to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRH(:,:,:)=PRH(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLSFACT(:,:,:)
- ENDWHERE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK)=MIN(MAX(PRH(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rh to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
ENDIF
!
!
END SUBROUTINE CORRECT_NEGATIVITIES
+!
END SUBROUTINE RAIN_ICE_RED
diff --git a/src/MNH/read_cams_data_netcdf_case.f90 b/src/MNH/read_cams_data_netcdf_case.f90
new file mode 100644
index 0000000000000000000000000000000000000000..10fea94e34ce68125ed82b456ac9ea5214f8d7f8
--- /dev/null
+++ b/src/MNH/read_cams_data_netcdf_case.f90
@@ -0,0 +1,810 @@
+!MNH_LIC Copyright 2012-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.
+!-----------------------------------------------------------------
+! ################################
+ MODULE MODI_READ_CAMS_DATA_NETCDF_CASE
+! #################################
+INTERFACE
+SUBROUTINE READ_CAMS_DATA_NETCDF_CASE(TPPRE_REAL1,HFILE,TPPGDFILE, &
+ PTIME_HORI,KVERB,ODUMMY_REAL )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file
+TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields
+END SUBROUTINE READ_CAMS_DATA_NETCDF_CASE
+!
+END INTERFACE
+END MODULE MODI_READ_CAMS_DATA_NETCDF_CASE
+! ####################################################################
+ SUBROUTINE READ_CAMS_DATA_NETCDF_CASE(TPPRE_REAL1,HFILE,TPPGDFILE, &
+ PTIME_HORI,KVERB,ODUMMY_REAL )
+! ####################################################################
+!
+!!**** *READ_CAMS_DATA_NETCDF_CASE* - reads data for the initialization of real cases.
+!!
+!! PURPOSE
+!! -------
+! This routine reads the two input files :
+! The PGD which is closed after reading
+! The NETCDF file
+! Projection is read in READ_LFIFM_PGD (MODD_GRID).
+! Grid and definition of large domain are read in PGD file and
+! NETCDF files.
+! The PGD files are also read in READ_LFIFM_PGD.
+! The PGD file is closed.
+! Vertical grid is defined in READ_VER_GRID.
+! PGD fields are stored on MESO-NH domain (in TRUNC_PGD).
+!!
+!!** METHOD
+!! ------
+!! 0. Declarations
+!! 1. Declaration of arguments
+!! 2. Declaration of local variables
+!! 1. Read PGD file
+!! 1. Domain restriction
+!! 2. Coordinate conversion to lat,lon system
+!! 2. Read Netcdf fields
+!! 3. Vertical grid
+!! 4. Free all temporary allocations
+!!
+!! EXTERNAL
+!! --------
+!! subroutine READ_LFIFM_PGD : to read PGD file
+!! subroutine READ_VER_GRID : to read the vertical grid in namelist file.
+!! subroutine HORIBL : horizontal bilinear interpolation
+!! subroutine XYTOLATLON : projection from conformal to lat,lon
+!!
+!! Module MODI_READ_VER_GRID : interface for subroutine READ_VER_GRID
+!! Module MODI_HORIBL : interface for subroutine HORIBL
+!! Module MODI_XYTOLATLON : interface for subroutine XYTOLATLON
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF : contains configuration variables for all models.
+!! NVERB : verbosity level for output-listing
+!! Module MODD_LUNIT : contains logical unit names for all models
+!! TLUOUT0 : name of output-listing
+!! Module MODD_PGDDIM : contains dimension of PGD fields
+!! NPGDIMAX: dimension along x (no external point)
+!! NPGDJMAX: dimension along y (no external point)
+!! Module MODD_PARAMETERS
+!! JPHEXT
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/2021 forked from read_chem_data_netcdf_case.f90
+
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!------------
+!
+USE MODD_CH_AEROSOL, ONLY: CORGANIC, NCARB, NSOA, NSP, LORILAM,&
+ JPMODE, LVARSIGI, LVARSIGJ,CAERONAMES
+USE MODD_CH_M9_n, ONLY: NEQ , CNAMES
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LUSECHAQ,LUSECHIC,LCH_PH
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST
+USE MODD_DIM_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT, ONLY: TLUOUT0
+USE MODE_MODELN_HANDLER
+USE MODD_NETCDF, ONLY:CDFINT
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_n, ONLY : CTURB
+USE MODD_PRECISION, ONLY:CDFINT
+USE MODD_PREP_REAL
+USE MODD_TIME
+USE MODD_TIME_n
+!
+USE MODE_IO_FILE, only: IO_File_close
+USE MODE_MPPDB
+USE MODE_THERMO
+USE MODE_TIME
+USE MODE_TOOLS, ONLY: UPCASE
+use mode_tools_ll, only: GET_DIM_EXT_ll
+!
+USE MODI_CH_AER_INIT_SOA
+USE MODI_CH_INIT_SCHEME_n
+USE MODI_CH_OPEN_INPUT
+USE MODI_HORIBL
+USE MODI_INI_NSV
+USE MODI_READ_HGRID_n
+USE MODI_READ_VER_GRID
+USE MODI_XYTOLATLON
+!
+USE NETCDF
+!
+USE MODD_PARAM_n, ONLY : CCLOUD
+USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, LSCAV, LAERO_MASS, HINI_CCN, HTYPE_CCN, &
+ NMOD_IFN, NMOD_IMM, LHHONI, NINDICE_CCN_IMM,CCCN_MODES,&
+ CIFN_SPECIES
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file
+TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+! General purpose variables
+INTEGER :: ILUOUT0 ! Unit used for output msg.
+INTEGER :: JJ ! Dummy counters
+INTEGER :: JLOOP1
+! Variables used by the PGD reader
+CHARACTER(LEN=28) :: YPGD_NAME ! not used - dummy argument
+CHARACTER(LEN=28) :: YPGD_DAD_NAME ! not used - dummy argument
+CHARACTER(LEN=2) :: YPGD_TYPE ! not used - dummy argument
+! PGD Grib definition variables
+INTEGER :: INO ! Number of points of the grid
+INTEGER :: IIU ! Number of points along X
+INTEGER :: IJU ! Number of points along Y
+REAL, DIMENSION(:), ALLOCATABLE :: ZLONOUT ! mapping PGD -> Grib (lon.)
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATOUT ! mapping PGD -> Grib (lat.)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! X of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! Y of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! Lat of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! Lon of PGD mass points
+INTEGER :: IMI
+!
+! For netcdf
+!
+integer(kind=CDFINT) :: istatus, incid
+integer(kind=CDFINT) :: ilatlen, ilonlen, ilevlen, inrecs
+integer(kind=CDFINT) :: itimeindex
+INTEGER(kind=CDFINT) :: ind_netcdf ! Indice for netcdf var.
+REAL, DIMENSION(:), ALLOCATABLE :: zlats
+REAL, DIMENSION(:), ALLOCATABLE :: zlons
+REAL, DIMENSION(:), ALLOCATABLE :: zlevs
+REAL, DIMENSION(:), ALLOCATABLE :: ztime
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: zmmr_dust1, zmmr_dust2, zmmr_dust3
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: zmmr_seasalt1, zmmr_seasalt2, zmmr_seasalt3
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: zmmr_bc_hydrophilic, zmmr_bc_hydrophobic
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: zmmr_oc_hydrophilic, zmmr_oc_hydrophobic
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: zmmr_sulfaer
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTMOZ, ZQMOZ, ZPSMOZ
+REAL, DIMENSION(:), ALLOCATABLE :: ZTMP1, ZTMP2
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTMP3
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMP4,ZTMP5
+!----------------------------------------------------------------------
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!* 1. READ PGD FILE
+! -------------
+!
+ILUOUT0 = TLUOUT0%NLU
+CALL READ_HGRID_n(TPPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE)
+!
+! 1.1 Domain restriction
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+INO = IIU * IJU
+!
+!
+! 1.2 Coordinate conversion to lat,lon system
+!
+ALLOCATE (ZXM(IIU,IJU))
+ALLOCATE (ZYM(IIU,IJU))
+ALLOCATE (ZLONM(IIU,IJU))
+ALLOCATE (ZLATM(IIU,IJU))
+ZXM(1:IIU-1,1) = (XXHAT(1:IIU-1) + XXHAT(2:IIU) ) / 2.
+ZXM(IIU,1) = XXHAT(IIU) - XXHAT(IIU-1) + ZXM(IIU-1,1)
+ZXM(:,2:IJU) = SPREAD(ZXM(:,1),2,IJU-1)
+ZYM(1,1:IJU-1) = (XYHAT(1:IJU-1) + XYHAT(2:IJU)) / 2.
+ZYM(1,IJU) = XYHAT(IJU) - XYHAT(IJU-1) + ZYM(1,IJU-1)
+ZYM(2:IIU,:) = SPREAD(ZYM(1,:),1,IIU-1)
+CALL SM_XYTOLATLON_A (XLAT0,XLON0,XRPK,XLATORI,XLONORI,ZXM,ZYM,ZLATM,ZLONM, &
+ IIU,IJU)
+ALLOCATE (ZLONOUT(INO))
+ALLOCATE (ZLATOUT(INO))
+JLOOP1 = 0
+DO JJ = 1, IJU
+ ZLONOUT(JLOOP1+1:JLOOP1+IIU) = ZLONM(1:IIU,JJ)
+ ZLATOUT(JLOOP1+1:JLOOP1+IIU) = ZLATM(1:IIU,JJ)
+ JLOOP1 = JLOOP1 + IIU
+ENDDO
+DEALLOCATE (ZYM)
+DEALLOCATE (ZXM)
+DEALLOCATE (ZLONM)
+DEALLOCATE (ZLATM)
+!
+!
+!* 2. READ NETCDF FIELDS
+! ------------------
+!
+! 2.1 Open netcdf files
+!
+istatus = nf90_open(HFILE, nf90_nowrite, incid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+!
+! 2.2 Read netcdf files
+!
+! get dimensions
+!
+CALL READ_DIM(incid,"latitude",ilatlen)
+CALL READ_DIM(incid,"longitude",ilonlen)
+CALL READ_DIM(incid,"level",ilevlen)
+!
+! 2.3 Read data.
+!
+ALLOCATE (zlats(ilatlen))
+ALLOCATE (zlons(ilonlen))
+ALLOCATE (zlevs(ilevlen))
+ALLOCATE (ztime(inrecs))
+! T, Q, Ps :
+ALLOCATE (ZTMOZ(ilonlen,ilatlen,ilevlen))
+ALLOCATE (ZQMOZ(ilonlen,ilatlen,ilevlen))
+ALLOCATE (ZPSMOZ(ilonlen,ilatlen,ilevlen))
+! transformed a, b :
+ALLOCATE (XA_SV_LS(ilevlen))
+ALLOCATE (XB_SV_LS(ilevlen))
+!
+ALLOCATE (zmmr_dust1(ilonlen,ilatlen,ilevlen))
+ALLOCATE (zmmr_dust2(ilonlen,ilatlen,ilevlen))
+ALLOCATE (zmmr_dust3(ilonlen,ilatlen,ilevlen))
+!
+ALLOCATE (zmmr_seasalt1(ilonlen,ilatlen,ilevlen))
+ALLOCATE (zmmr_seasalt2(ilonlen,ilatlen,ilevlen))
+ALLOCATE (zmmr_seasalt3(ilonlen,ilatlen,ilevlen))
+!
+ALLOCATE (zmmr_bc_hydrophilic(ilonlen,ilatlen,ilevlen))
+ALLOCATE (zmmr_bc_hydrophobic(ilonlen,ilatlen,ilevlen))
+!
+ALLOCATE (zmmr_oc_hydrophilic(ilonlen,ilatlen,ilevlen))
+ALLOCATE (zmmr_oc_hydrophobic(ilonlen,ilatlen,ilevlen))
+!
+ALLOCATE (zmmr_sulfaer(ilonlen,ilatlen,ilevlen))
+!
+ALLOCATE (ZWORK(ilonlen,ilatlen,ilevlen))
+!
+! get values of variables
+!
+!
+! Reference pressure (needed for the vertical interpolation)
+!
+XP00_SV_LS = 101325.0
+!
+! a and b coefficients (needed for the vertical interpolation)
+!
+IF (ilevlen .eq. 60) THEN
+XA_SV_LS(:) = (/ 20.000000000, 38.425343000, 63.647804000, 95.636963000, 134.48330700, &
+ 180.58435100, 234.77905300, 298.49578900, 373.97192400, 464.61813400, &
+ 575.65100100, 713.21807900, 883.66052200, 1094.8347170, 1356.4746090, &
+ 1680.6402590, 2082.2739260, 2579.8886720, 3196.4216310, 3960.2915040, &
+ 4906.7084960, 6018.0195310, 7306.6313480, 8765.0537110, 10376.126953, &
+ 12077.446289, 13775.325195, 15379.805664, 16819.474609, 18045.183594, &
+ 19027.695313, 19755.109375, 20222.205078, 20429.863281, 20384.480469, &
+ 20097.402344, 19584.330078, 18864.750000, 17961.357422, 16899.468750, &
+ 15706.447266, 14411.124023, 13043.218750, 11632.758789, 10209.500977, &
+ 8802.3564450, 7438.8032230, 6144.3149410, 4941.7783200, 3850.9133300, &
+ 2887.6965330, 2063.7797850, 1385.9125980, 855.36175500, 467.33358800, &
+ 210.39389000, 65.889244000, 7.3677430000, 0.0000000000, 0.0000000000 /)
+
+XA_SV_LS(:) = XA_SV_LS(:) / XP00_SV_LS
+
+XB_SV_LS(:) = (/ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00007582, 0.00046139, &
+ 0.00181516, 0.00508112, 0.01114291, 0.02067788, 0.03412116, &
+ 0.05169041, 0.07353383, 0.09967469, 0.13002251, 0.16438432, &
+ 0.20247594, 0.24393314, 0.28832296, 0.33515489, 0.38389215, &
+ 0.43396294, 0.48477158, 0.53570992, 0.58616841, 0.63554746, &
+ 0.68326861, 0.72878581, 0.77159661, 0.81125343, 0.84737492, &
+ 0.87965691, 0.90788388, 0.93194032, 0.95182151, 0.96764523, &
+ 0.97966272, 0.98827010, 0.99401945, 0.99763012, 1.00000000 /)
+
+ELSE IF (ilevlen .eq. 137) THEN
+
+XA_SV_LS(:) = (/ &
+2.000365 , 3.102241 , 4.666084 , 6.827977 , 9.746966 , 13.605424 , 18.608931 , 24.985718 , &
+32.985710 , 42.879242 , 54.955463 , 69.520576 , 86.895882 , 107.415741 , 131.425507 , 159.279404 , &
+191.338562 , 227.968948 , 269.539581 , 316.420746 , 368.982361 , 427.592499 , 492.616028 , 564.413452 , &
+643.339905 , 729.744141 , 823.967834 , 926.344910 , 1037.201172 , 1156.853638 , 1285.610352 , 1423.770142 , &
+1571.622925 , 1729.448975 , 1897.519287 , 2076.095947 , 2265.431641 , 2465.770508 , 2677.348145 , 2900.391357 , &
+3135.119385 , 3381.743652 , 3640.468262 , 3911.490479 , 4194.930664 , 4490.817383 , 4799.149414 , 5119.895020 , &
+5452.990723 , 5798.344727 , 6156.074219 , 6526.946777 , 6911.870605 , 7311.869141 , 7727.412109 , 8159.354004 , &
+8608.525391 , 9076.400391 , 9562.682617 , 10065.978516 , 10584.631836 , 11116.662109 , 11660.067383 , 12211.547852 , &
+12766.873047 , 13324.668945 , 13881.331055 , 14432.139648 , 14975.615234 , 15508.256836 , 16026.115234 , 16527.322266 , &
+17008.789063 , 17467.613281 , 17901.621094 , 18308.433594 , 18685.718750 , 19031.289063 , 19343.511719 , 19620.042969 , &
+19859.390625 , 20059.931641 , 20219.664063 , 20337.863281 , 20412.308594 , 20442.078125 , 20425.718750 , 20361.816406 , &
+20249.511719 , 20087.085938 , 19874.025391 , 19608.572266 , 19290.226563 , 18917.460938 , 18489.707031 , 18006.925781 , &
+17471.839844 , 16888.687500 , 16262.046875 , 15596.695313 , 14898.453125 , 14173.324219 , 13427.769531 , 12668.257813 , &
+11901.339844 , 11133.304688 , 10370.175781 , 9617.515625 , 8880.453125 , 8163.375000 , 7470.343750 , 6804.421875 , &
+6168.531250 , 5564.382813 , 4993.796875 , 4457.375000 , 3955.960938 , 3489.234375 , 3057.265625 , 2659.140625 , &
+2294.242188 , 1961.500000 , 1659.476563 , 1387.546875 , 1143.250000 , 926.507813 , 734.992188 , 568.062500 , &
+424.414063 , 302.476563 , 202.484375 , 122.101563 , 62.781250 , 22.835938 , 3.757813 , 0.000000 , 0.000000 /)
+
+XA_SV_LS(:) = XA_SV_LS(:) / XP00_SV_LS
+
+XB_SV_LS(:) = (/ &
+0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , &
+0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , &
+0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , &
+0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , &
+0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , &
+0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , &
+0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000000 , 0.000007 , 0.000024 , &
+0.000059 , 0.000112 , 0.000199 , 0.000340 , 0.000562 , 0.000890 , 0.001353 , 0.001992 , &
+0.002857 , 0.003971 , 0.005378 , 0.007133 , 0.009261 , 0.011806 , 0.014816 , 0.018318 , &
+0.022355 , 0.026964 , 0.032176 , 0.038026 , 0.044548 , 0.051773 , 0.059728 , 0.068448 , &
+0.077958 , 0.088286 , 0.099462 , 0.111505 , 0.124448 , 0.138313 , 0.153125 , 0.168910 , &
+0.185689 , 0.203491 , 0.222333 , 0.242244 , 0.263242 , 0.285354 , 0.308598 , 0.332939 , &
+0.358254 , 0.384363 , 0.411125 , 0.438391 , 0.466003 , 0.493800 , 0.521619 , 0.549301 , &
+0.576692 , 0.603648 , 0.630036 , 0.655736 , 0.680643 , 0.704669 , 0.727739 , 0.749797 , &
+0.770798 , 0.790717 , 0.809536 , 0.827256 , 0.843881 , 0.859432 , 0.873929 , 0.887408 , &
+0.899900 , 0.911448 , 0.922096 , 0.931881 , 0.940860 , 0.949064 , 0.956550 , 0.963352 , &
+0.969513 , 0.975078 , 0.980072 , 0.984542 , 0.988500 , 0.991984 , 0.995003 , 0.997630 , 1.000000 /)
+
+END IF
+
+CALL READ_VAR_1D(incid,"latitude",ilatlen,zlats)
+CALL READ_VAR_1D(incid,"longitude",ilonlen,zlons)
+CALL READ_VAR_1D(incid,"level",ilevlen,zlevs)
+
+CALL READ_VAR_2D(incid,"sp",ilonlen,ilatlen,ZPSMOZ)
+
+CALL READ_VAR_3D(incid,"t",ilonlen,ilatlen,ilevlen,ZTMOZ)
+CALL READ_VAR_3D(incid,"q",ilonlen,ilatlen,ilevlen,ZQMOZ)
+
+CALL READ_VAR_3D(incid,"aermr01",ilonlen,ilatlen,ilevlen,zmmr_seasalt1)
+CALL READ_VAR_3D(incid,"aermr02",ilonlen,ilatlen,ilevlen,zmmr_seasalt2)
+CALL READ_VAR_3D(incid,"aermr03",ilonlen,ilatlen,ilevlen,zmmr_seasalt3)
+CALL READ_VAR_3D(incid,"aermr04",ilonlen,ilatlen,ilevlen,zmmr_dust1)
+CALL READ_VAR_3D(incid,"aermr05",ilonlen,ilatlen,ilevlen,zmmr_dust2)
+CALL READ_VAR_3D(incid,"aermr06",ilonlen,ilatlen,ilevlen,zmmr_dust3)
+CALL READ_VAR_3D(incid,"aermr07",ilonlen,ilatlen,ilevlen,zmmr_oc_hydrophobic)
+CALL READ_VAR_3D(incid,"aermr08",ilonlen,ilatlen,ilevlen,zmmr_oc_hydrophilic)
+CALL READ_VAR_3D(incid,"aermr09",ilonlen,ilatlen,ilevlen,zmmr_bc_hydrophobic)
+CALL READ_VAR_3D(incid,"aermr10",ilonlen,ilatlen,ilevlen,zmmr_bc_hydrophilic)
+CALL READ_VAR_3D(incid,"aermr11",ilonlen,ilatlen,ilevlen,zmmr_sulfaer)
+!
+!------------------------------------------------------------------------
+!* 3 Conversion of CAMS variables into LIMA variables
+!---------------------------------------------------------------------
+!
+! initialise NSV_* variables
+! cas simple : 3 modes de CCN (dont 1 actif par immersion), 2 modes IFN
+! CCN1 : seasalt
+! CCN2 : sulfates
+! CCN3 (IMM) : hydrophilic OM and BC
+! IFN1 : dust
+! IFN2 : hydrophobic OM and BC
+!
+! XSV : Nc, Nr, 3 CCN free, 3 CCN activés, Ni, 2 IN free, 2 IN activé = 11 variables
+!
+! Concentrations en nombre par kilo !
+!
+!
+CCLOUD='LIMA'
+NMOD_CCN=3
+LSCAV=.FALSE.
+LAERO_MASS=.FALSE.
+NMOD_IFN=2
+NMOD_IMM=1
+LHHONI=.FALSE.
+HINI_CCN='AER'
+HTYPE_CCN(1)='M'
+HTYPE_CCN(2)='C'
+HTYPE_CCN(3)='C'
+CCCN_MODES='CAMS_AIT'
+CIFN_SPECIES='CAMS_AIT'
+!
+! Always initialize chemical scheme variables before INI_NSV call !
+!
+!CALL CH_INIT_SCHEME_n(IMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT0,KVERB)
+!LUSECHEM = .TRUE.
+!IF (LORILAM) THEN
+! CORGANIC = "MPMPO"
+! LVARSIGI = .TRUE.
+! LVARSIGJ = .TRUE.
+! CALL CH_AER_INIT_SOA(ILUOUT0, KVERB)
+!END IF
+!
+!
+!
+CALL INI_NSV(IMI)
+DEALLOCATE(XSV_LS)
+ALLOCATE (XSV_LS(IIU,IJU,ilevlen,NSV))
+XSV_LS(:,:,:,:) = 0.
+!
+!ALLOCATE(NINDICE_CCN_IMM(1)) already allocated in ini_nsv
+NINDICE_CCN_IMM(1)=3
+!
+! Define work arrays
+!
+ALLOCATE (XPS_SV_LS(IIU,IJU))
+ALLOCATE (XZS_SV_LS(IIU,IJU))
+ALLOCATE (XT_SV_LS(IIU,IJU,ilevlen))
+ALLOCATE (XQ_SV_LS(IIU,IJU,ilevlen,NRR))
+XQ_SV_LS(:,:,:,2:)=0.000000000001
+!
+XZS_SV_LS(:,:) = XZS_LS(:,:) ! orography from the PGD file
+where (ZLONOUT(:) < 0.) ZLONOUT(:) = ZLONOUT(:) + 360. ! correct longitudes
+!
+!
+! Select CAMS mixing ratios
+! and perform the horizontal interpolation
+!
+! Free CCN concentration (mode 1)
+!
+ZWORK(:,:,:)=zmmr_seasalt1(:,:,:)+zmmr_seasalt2(:,:,:)+zmmr_seasalt3(:,:,:)
+CALL INTERP_3D (ilonlen,ilatlen,ilevlen,ZWORK,zlats,zlons,IIU,IJU,ZLATOUT,ZLONOUT,PTIME_HORI,XSV_LS(:,:,:,NSV_LIMA_CCN_FREE))
+!
+! Free CCN concentration (mode 2)
+!
+ZWORK(:,:,:)=zmmr_sulfaer(:,:,:)
+CALL INTERP_3D (ilonlen,ilatlen,ilevlen,ZWORK,zlats,zlons,IIU,IJU,ZLATOUT,ZLONOUT,PTIME_HORI,XSV_LS(:,:,:,NSV_LIMA_CCN_FREE + 1))
+!
+! Free CCN concentration (mode 3, IMM)
+!
+ZWORK(:,:,:)=zmmr_bc_hydrophilic(:,:,:)+zmmr_oc_hydrophilic(:,:,:)
+CALL INTERP_3D (ilonlen,ilatlen,ilevlen,ZWORK,zlats,zlons,IIU,IJU,ZLATOUT,ZLONOUT,PTIME_HORI,XSV_LS(:,:,:,NSV_LIMA_CCN_FREE + 2))
+!
+! Free IFN concentration (mode 1)
+!
+ZWORK(:,:,:)=zmmr_dust1(:,:,:) + zmmr_dust2(:,:,:) + zmmr_dust3(:,:,:)
+CALL INTERP_3D (ilonlen,ilatlen,ilevlen,ZWORK,zlats,zlons,IIU,IJU,ZLATOUT,ZLONOUT,PTIME_HORI,XSV_LS(:,:,:,NSV_LIMA_IFN_FREE))
+!
+! Free IFN concentration (mode 2)
+!
+ZWORK(:,:,:)=zmmr_bc_hydrophobic(:,:,:)+zmmr_oc_hydrophobic(:,:,:)
+CALL INTERP_3D (ilonlen,ilatlen,ilevlen,ZWORK,zlats,zlons,IIU,IJU,ZLATOUT,ZLONOUT,PTIME_HORI,XSV_LS(:,:,:,NSV_LIMA_IFN_FREE + 1))
+!
+! Temperature (needed for the vertical interpolation)
+!
+CALL INTERP_3D (ilonlen,ilatlen,ilevlen,ZTMOZ,zlats,zlons,IIU,IJU,ZLATOUT,ZLONOUT,PTIME_HORI,XT_SV_LS)
+!
+! Spec. Humidity (needed for the vertical interpolation)
+!
+CALL INTERP_3D (ilonlen,ilatlen,ilevlen,ZQMOZ,zlats,zlons,IIU,IJU,ZLATOUT,ZLONOUT,PTIME_HORI,XQ_SV_LS(:,:,:,1))
+!
+! Surface pressure (needed for the vertical interpolation)
+!
+CALL INTERP_2D (ilonlen,ilatlen,ZPSMOZ,zlats,zlons,IIU,IJU,ZLATOUT,ZLONOUT,PTIME_HORI,XPS_SV_LS)
+!
+! Correct negative values produced by the horizontal interpolations
+!
+XSV_LS(:,:,:,:) = MAX(XSV_LS(:,:,:,:),0.)
+XPS_SV_LS(:,:) = MAX(XPS_SV_LS(:,:),0.)
+XT_SV_LS(:,:,:) = MAX(XT_SV_LS(:,:,:),0.)
+XQ_SV_LS(:,:,:,1) = MAX(XQ_SV_LS(:,:,:,1),0.)
+!
+! If Netcdf vertical levels have to be reversed :
+!
+ALLOCATE(ZTMP1(ilevlen))
+ALLOCATE(ZTMP2(ilevlen))
+ALLOCATE(ZTMP3(IIU,IJU,ilevlen))
+ALLOCATE(ZTMP4(IIU,IJU,ilevlen,NRR))
+ALLOCATE(ZTMP5(IIU,IJU,ilevlen,NSV))
+DO JJ=1,ilevlen
+ ! inv. lev
+ ZTMP1(JJ) = XA_SV_LS(ilevlen+1-JJ)
+ ZTMP2(JJ) = XB_SV_LS(ilevlen+1-JJ)
+ ZTMP3(:,:,JJ) = XT_SV_LS(:,:,ilevlen+1-JJ)
+ ZTMP4(:,:,JJ,:) = XQ_SV_LS(:,:,ilevlen+1-JJ,:)
+ ZTMP5(:,:,JJ,:) = XSV_LS(:,:,ilevlen+1-JJ,:)
+ENDDO
+XA_SV_LS(:) = ZTMP1(:)
+XB_SV_LS(:) = ZTMP2(:)
+XT_SV_LS(:,:,:) = ZTMP3(:,:,:)
+XQ_SV_LS(:,:,:,:) = ZTMP4(:,:,:,:)
+XSV_LS(:,:,:,:) = ZTMP5(:,:,:,:)
+DEALLOCATE(ZTMP1)
+DEALLOCATE(ZTMP2)
+DEALLOCATE(ZTMP3)
+DEALLOCATE(ZTMP4)
+DEALLOCATE(ZTMP5)
+!
+! close the netcdf file
+istatus = nf90_close(incid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+!
+!-------------------------------------------------------------
+!
+!* 4. VERTICAL GRID
+!
+!* 4.1 Read VERTICAL GRID
+!
+WRITE (ILUOUT0,'(A)') ' | Reading of vertical grid in progress'
+CALL READ_VER_GRID(TPPRE_REAL1)
+!
+!--------------------------------------------------------------
+!
+!* Free all temporary allocations
+!
+DEALLOCATE (ZLATOUT)
+DEALLOCATE (ZLONOUT)
+!
+DEALLOCATE (zlats)
+DEALLOCATE (zlons)
+DEALLOCATE (zlevs)
+DEALLOCATE (ztime)
+! ps, T, Q :
+DEALLOCATE (ZPSMOZ)
+DEALLOCATE (ZTMOZ)
+DEALLOCATE (ZQMOZ)
+!
+DEALLOCATE (zmmr_dust1)
+DEALLOCATE (zmmr_dust2)
+DEALLOCATE (zmmr_dust3)
+!
+DEALLOCATE (zmmr_seasalt1)
+DEALLOCATE (zmmr_seasalt2)
+DEALLOCATE (zmmr_seasalt3)
+!
+DEALLOCATE (zmmr_bc_hydrophilic)
+DEALLOCATE (zmmr_bc_hydrophobic)
+!
+DEALLOCATE (zmmr_oc_hydrophilic)
+DEALLOCATE (zmmr_oc_hydrophobic)
+!
+DEALLOCATE (zmmr_sulfaer)
+!
+DEALLOCATE (ZWORK)
+!
+WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successfully'
+WRITE (ILUOUT0,'(A,A4,A)') 'CAMS mixing ratios are interpolated horizontally'
+!
+!
+CONTAINS
+!
+! #############################
+ subroutine handle_err(istatus)
+! #############################
+ use mode_msg
+
+ integer(kind=CDFINT) istatus
+
+ if ( istatus /= NF90_NOERR ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'HANDLE_ERR', NF90_STRERROR(istatus) )
+ end if
+
+ end subroutine handle_err
+!
+!
+! #############################################
+ SUBROUTINE ARRAY_1D_TO_2D (KN1,P1,KL1,KL2,P2)
+! #############################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+USE MODE_MSG
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KN1
+REAL,DIMENSION(KN1), INTENT(IN) :: P1
+INTEGER, INTENT(IN) :: KL1
+INTEGER, INTENT(IN) :: KL2
+REAL,DIMENSION(KL1,KL2),INTENT(OUT) :: P2
+INTEGER :: JLOOP1_A1T2
+INTEGER :: JLOOP2_A1T2
+INTEGER :: JPOS_A1T2
+!
+IF (KN1 < KL1*KL2) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ARRAY_1D_TO_2D','sizes do not match')
+END IF
+JPOS_A1T2 = 1
+DO JLOOP2_A1T2 = 1, KL2
+ DO JLOOP1_A1T2 = 1, KL1
+ P2(JLOOP1_A1T2,JLOOP2_A1T2) = P1(JPOS_A1T2)
+ JPOS_A1T2 = JPOS_A1T2 + 1
+ END DO
+END DO
+END SUBROUTINE ARRAY_1D_TO_2D
+!
+! #############################################
+ SUBROUTINE READ_DIM (file,name,output)
+! #############################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+IMPLICIT NONE
+INTEGER(kind=CDFINT), INTENT(IN) :: file
+CHARACTER(*), INTENT(IN) :: name
+INTEGER(kind=CDFINT), INTENT(OUT) :: output
+!
+INTEGER(kind=CDFINT) :: istatus, index
+!
+istatus = nf90_inq_dimid(file, name, index)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inquire_dimension(file, index, len=output)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+!
+END SUBROUTINE READ_DIM
+!
+! #############################################
+ SUBROUTINE READ_VAR_1D (file,name,size,output)
+! #############################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+IMPLICIT NONE
+INTEGER(kind=CDFINT), INTENT(IN) :: file
+CHARACTER(*), INTENT(IN) :: name
+INTEGER(kind=CDFINT), INTENT(IN) :: size
+REAL, DIMENSION(size), INTENT(INOUT) :: output
+!
+INTEGER(kind=CDFINT) :: istatus, index
+!
+istatus = nf90_inq_varid(file, name, index)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_get_var(file, index, output)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+!
+END SUBROUTINE READ_VAR_1D
+!
+! #############################################
+ SUBROUTINE READ_VAR_2D (file,name,size_lon,size_lat,output)
+! #############################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+IMPLICIT NONE
+INTEGER(kind=CDFINT), INTENT(IN) :: file
+CHARACTER(*), INTENT(IN) :: name
+INTEGER(kind=CDFINT), INTENT(IN) :: size_lon
+INTEGER(kind=CDFINT), INTENT(IN) :: size_lat
+REAL, DIMENSION(size_lon,size_lat), INTENT(INOUT) :: output
+!
+INTEGER(kind=CDFINT) :: istatus, index
+REAL :: scale, offset
+INTEGER,DIMENSION(4) :: s, c
+!
+s(:)=1
+c(1)=size_lon
+c(2)=size_lat
+c(3)=1
+c(4)=1
+istatus = nf90_inq_varid(file, name, index)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_get_var(file, index, output)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_get_att(file, index, "scale_factor", scale)
+istatus = nf90_get_att(file, index, "add_offset", offset)
+output = offset + scale * output
+!
+END SUBROUTINE READ_VAR_2D
+!
+! #############################################
+ SUBROUTINE READ_VAR_3D (file,name,size_lon,size_lat,size_lev,output)
+! #############################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+IMPLICIT NONE
+INTEGER(kind=CDFINT), INTENT(IN) :: file
+CHARACTER(*), INTENT(IN) :: name
+INTEGER(kind=CDFINT), INTENT(IN) :: size_lon
+INTEGER(kind=CDFINT), INTENT(IN) :: size_lat
+INTEGER(kind=CDFINT), INTENT(IN) :: size_lev
+REAL, DIMENSION(size_lon,size_lat,size_lev), INTENT(INOUT) :: output
+!
+INTEGER(kind=CDFINT) :: istatus, index
+REAL :: scale, offset
+INTEGER,DIMENSION(4) :: s, c
+!
+s(:)=1
+c(1)=size_lon
+c(2)=size_lat
+c(3)=size_lev
+c(4)=1
+istatus = nf90_inq_varid(file, name, index)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_get_var(file, index, output,start=s,count=c)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_get_att(file, index, "scale_factor", scale)
+istatus = nf90_get_att(file, index, "add_offset", offset)
+output = offset + scale * output
+!
+END SUBROUTINE READ_VAR_3D
+!
+! #############################################
+ SUBROUTINE INTERP_2D (size_lon,size_lat,input,zlats,zlons,IIU,IJU,PLATOUT,PLONOUT,PTIME_HORI,output)
+! #############################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: size_lon
+INTEGER, INTENT(IN) :: size_lat
+REAL, DIMENSION(size_lon,size_lat), INTENT(IN) :: input
+REAL, DIMENSION(size_lat), INTENT(IN) :: zlats
+REAL, DIMENSION(size_lon), INTENT(IN) :: zlons
+INTEGER, INTENT(IN) :: IIU
+INTEGER, INTENT(IN) :: IJU
+REAL, DIMENSION(IIU*IJU), INTENT(IN) :: PLATOUT
+REAL, DIMENSION(IIU*IJU), INTENT(IN) :: PLONOUT
+REAL, INTENT(INOUT) :: PTIME_HORI
+REAL, DIMENSION(IIU,IJU), INTENT(INOUT) :: output
+!
+INTEGER :: JLOOP1, JJ, INO
+REAL, DIMENSION(size_lat*size_lon) :: ZVALUE
+REAL, DIMENSION(IIU*IJU) :: ZOUT
+INTEGER, DIMENSION(size_lat) :: kinlo
+INTEGER :: KILEN
+!
+kinlo(:)=size_lon
+KILEN=size_lat*size_lon
+INO=IIU*IJU
+JLOOP1 = 0
+DO JJ = 1, size_lat
+ ZVALUE(JLOOP1+1:JLOOP1+size_lon) = input(1:size_lon,JJ)
+ JLOOP1 = JLOOP1 + size_lon
+ENDDO
+CALL HORIBL(zlats(1),zlons(1),zlats(size_lat),zlons(size_lon), &
+ size_lat,kinlo,KILEN, &
+ ZVALUE(:),INO,PLONOUT,PLATOUT, &
+ ZOUT(:),.FALSE.,PTIME_HORI,.TRUE. )
+CALL ARRAY_1D_TO_2D(INO,ZOUT(:),IIU,IJU,output(:,:))
+!
+END SUBROUTINE INTERP_2D
+!
+! #############################################
+ SUBROUTINE INTERP_3D (size_lon,size_lat,size_lev,input,zlats,zlons,IIU,IJU,PLATOUT,PLONOUT,PTIME_HORI,output)
+! #############################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: size_lon
+INTEGER, INTENT(IN) :: size_lat
+INTEGER, INTENT(IN) :: size_lev
+REAL, DIMENSION(size_lon,size_lat,size_lev), INTENT(IN) :: input
+REAL, DIMENSION(size_lat), INTENT(IN) :: zlats
+REAL, DIMENSION(size_lon), INTENT(IN) :: zlons
+INTEGER, INTENT(IN) :: IIU
+INTEGER, INTENT(IN) :: IJU
+REAL, DIMENSION(IIU*IJU), INTENT(IN) :: PLATOUT
+REAL, DIMENSION(IIU*IJU), INTENT(IN) :: PLONOUT
+REAL, INTENT(INOUT) :: PTIME_HORI
+REAL, DIMENSION(IIU,IJU,size_lev), INTENT(INOUT) :: output
+!
+INTEGER :: JLOOP1, JJ, JK, INO
+REAL, DIMENSION(size_lev,size_lat*size_lon) :: ZVALUE
+REAL, DIMENSION(size_lev,IIU*IJU) :: ZOUT
+INTEGER, DIMENSION(size_lat) :: kinlo
+INTEGER :: KILEN
+!
+kinlo(:)=size_lon
+KILEN=size_lat*size_lon
+INO=IIU*IJU
+DO JK = 1, ilevlen
+ JLOOP1 = 0
+ DO JJ = 1, size_lat
+ ZVALUE(JK,JLOOP1+1:JLOOP1+size_lon) = input(1:size_lon,JJ,JK)
+ JLOOP1 = JLOOP1 + size_lon
+ ENDDO
+ CALL HORIBL(zlats(1),zlons(1),zlats(size_lat),zlons(size_lon), &
+ size_lat,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,PLONOUT,PLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. )
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,output(:,:,JK))
+ENDDO
+!
+END SUBROUTINE INTERP_3D
+!
+END SUBROUTINE READ_CAMS_DATA_NETCDF_CASE
diff --git a/src/MNH/read_chem_data_netcdf_case.f90 b/src/MNH/read_chem_data_netcdf_case.f90
index c15b8e4b1aa735b70a7f7865b8e5ead669b85245..547a55b535791a53149ef6e20f232706ddfbff71 100644
--- a/src/MNH/read_chem_data_netcdf_case.f90
+++ b/src/MNH/read_chem_data_netcdf_case.f90
@@ -92,7 +92,7 @@ END MODULE MODI_READ_CHEM_DATA_NETCDF_CASE
!* 0. DECLARATIONS
!------------
!
-USE MODD_BLANK_n, ONLY: CDUMMY1
+USE MODD_BLANK_n, ONLY: CDUMMY1
USE MODD_CH_AEROSOL, ONLY: CORGANIC, NCARB, NSOA, NSP, LORILAM,&
JPMODE, LVARSIGI, LVARSIGJ,CAERONAMES
USE MODD_CH_M9_n, ONLY: NEQ , CNAMES
diff --git a/src/MNH/read_desfmn.f90 b/src/MNH/read_desfmn.f90
index 4fc913e4bb8b99074775dcd262c3629fc4c8b96e..2f781f8e7c208bd4bbc9d2bdc0461fa767033a95 100644
--- a/src/MNH/read_desfmn.f90
+++ b/src/MNH/read_desfmn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -192,6 +192,9 @@ END MODULE MODI_READ_DESFM_n
!! Modification 02/2018 (Q.Libois) ECRAD
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Modification 07/2017 (V. Vionnet) Add blowing snow scheme
+!! Modification 02/2021 (F.Auguste) add IBM
+!! (T.Nagel) add turbulence recycling
+!! (E.Jezequel) add stations read from CSV file
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -260,11 +263,15 @@ USE MODN_LATZ_EDFLX
USE MODN_2D_FRC
USE MODN_BLOWSNOW_n
USE MODN_BLOWSNOW
+USE MODN_STATION_n
!
USE MODN_PARAM_LIMA
!
USE MODE_MSG
USE MODE_POS
+USE MODN_RECYCL_PARAM_n
+USE MODN_IBM_PARAM_n
+USE MODD_IBM_LSF, ONLY: LIBM_LSF
!
IMPLICIT NONE
!
@@ -434,20 +441,42 @@ IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_DRAGn)
CALL UPDATE_NAM_DRAGn
END IF
-
+CALL POSNAM(ILUDES,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+CALL INIT_NAM_IBM_PARAMn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_IBM_PARAMn)
+ CALL UPDATE_NAM_IBM_PARAMn
+END IF
+CALL POSNAM(ILUDES,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+CALL INIT_NAM_RECYCL_PARAMn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_RECYCL_PARAMn)
+ CALL UPDATE_NAM_RECYCL_PARAMn
+END IF
CALL POSNAM(ILUDES,'NAM_SERIESN',GFOUND,ILUOUT)
CALL INIT_NAM_SERIESn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_SERIESn)
CALL UPDATE_NAM_SERIESn
END IF
-
CALL POSNAM(ILUDES,'NAM_BLOWSNOWn',GFOUND,ILUOUT)
CALL INIT_NAM_BLOWSNOWn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_BLOWSNOWn)
CALL UPDATE_NAM_BLOWSNOWn
END IF
+CALL POSNAM(ILUDES,'NAM_BLANKN',GFOUND,ILUOUT)
+CALL INIT_NAM_BLANKn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_BLANKn)
+ CALL UPDATE_NAM_BLANKn
+END IF
+CALL POSNAM(ILUDES,'NAM_STATIONN',GFOUND,ILUOUT)
+CALL INIT_NAM_STATIONn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_STATIONn)
+ CALL UPDATE_NAM_STATIONn
+END IF
!
!
IF (KMI == 1) THEN
@@ -542,8 +571,6 @@ IF (KMI == 1) THEN
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_LES)
CALL POSNAM(ILUDES,'NAM_PDF',GFOUND)
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PDF)
- CALL POSNAM(ILUDES,'NAM_BLANKn',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BLANKn)
CALL POSNAM(ILUDES,'NAM_FRC',GFOUND)
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FRC)
CALL POSNAM(ILUDES,'NAM_PARAM_ICE',GFOUND)
@@ -684,6 +711,12 @@ IF (NVERB >= 10) THEN
!
WRITE(UNIT=ILUOUT,FMT="('********** DRAGn *******************')")
WRITE(UNIT=ILUOUT,NML=NAM_DRAGn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** IBM FORCING *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_IBM_PARAMn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** RECYLING *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_RECYCL_PARAMn)
!
WRITE(UNIT=ILUOUT,FMT="('********** NUDGINGn ****************')")
WRITE(UNIT=ILUOUT,NML=NAM_NUDGINGn)
@@ -691,15 +724,18 @@ IF (NVERB >= 10) THEN
WRITE(UNIT=ILUOUT,FMT="('********** CHEMICAL MONITORn *******')")
WRITE(UNIT=ILUOUT,NML=NAM_CH_MNHCn)
!
- WRITE(UNIT=ILUOUT,FMT="('************ CHEMICAL SOLVER ******************')")
+ WRITE(UNIT=ILUOUT,FMT="('********** CHEMICAL SOLVER *********')")
WRITE(UNIT=ILUOUT,NML=NAM_CH_SOLVERn)
!
- WRITE(UNIT=ILUOUT,FMT="('********** BLOWSNOWn *******************')")
+ WRITE(UNIT=ILUOUT,FMT="('********** BLOWSNOWn ***************')")
WRITE(UNIT=ILUOUT,NML=NAM_BLOWSNOWn)
!
- WRITE(UNIT=ILUOUT,FMT="('************ BLANKn ****************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
-!
+ WRITE(UNIT=ILUOUT,FMT="('********** BLANKn ******************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** STATIONn ******************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_STATIONn)
+!
IF (KMI==1) THEN
WRITE(UNIT=ILUOUT,FMT="(/,'PART OF INITIAL FILE COMMON TO ALL THE MODELS')")
WRITE(UNIT=ILUOUT,FMT="( '---------------------------------------------')")
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index 170904e6019807d2d4e856d4ee487613e53e3a42..793e407af8923876d115ba8af9d4002d89a919b5 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -295,10 +295,14 @@ END MODULE MODI_READ_EXSEG_n
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
! Q. Rodier 03/2020: add abort if use of any LHORELAX and cyclic conditions
+! F.Auguste 02/2021: add IBM
+! T.Nagel 02/2021: add turbulence recycling
+! E.Jezequel 02/2021: add stations read from CSV file
! P. Wautelet 09/03/2021: simplify allocation of scalar variable names
! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
! R. Honnert 23/04/2021: add ADAP mixing length and delete HRIO and BOUT from CMF_UPDRAFT
+! S. Riette 11/05/2021 HighLow cloud
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -356,10 +360,14 @@ USE MODN_DUST
USE MODN_DYN
USE MODN_DYN_n ! to avoid the duplication of this routine for each model.
USE MODN_ELEC
+USE MODN_EOL
+USE MODN_EOL_ADNR
+USE MODN_EOL_ALM
#ifdef MNH_FOREFIRE
USE MODN_FOREFIRE
#endif
USE MODN_FRC
+USE MODN_IBM_PARAM_n
USE MODN_LATZ_EDFLX
USE MODN_LBC_n ! routine is used for each nested model. This has been done
USE MODN_LES
@@ -377,14 +385,17 @@ USE MODN_PARAM_ICE
USE MODN_PARAM_KAFR_n
USE MODN_PARAM_LIMA, ONLY : FINI_CCN=>HINI_CCN,NAM_PARAM_LIMA,NMOD_CCN,LSCAV, &
CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, NMOD_IFN, &
- LCOLD, LACTI, LNUCL, XALPHAC, XNUC, LMEYERS, LHAIL
+ LCOLD, LACTI, LNUCL, XALPHAC, XNUC, LMEYERS, LHAIL,&
+ LPTSPLIT
USE MODN_PARAM_MFSHALL_n
USE MODN_PARAM_n ! realized in subroutine ini_model n
USE MODN_PARAM_RAD_n
USE MODN_PASPOL
+USE MODN_RECYCL_PARAM_n
USE MODN_SALT
USE MODN_SERIES
USE MODN_SERIES_n
+USE MODN_STATION_n
USE MODN_TURB
USE MODN_TURB_CLOUD
USE MODN_TURB_n
@@ -481,10 +492,13 @@ CALL INIT_NAM_NUDGINGN
CALL INIT_NAM_TURBN
CALL INIT_NAM_BLANKN
CALL INIT_NAM_DRAGN
+CALL INIT_NAM_IBM_PARAMN
+CALL INIT_NAM_RECYCL_PARAMN
CALL INIT_NAM_CH_MNHCN
CALL INIT_NAM_CH_SOLVERN
CALL INIT_NAM_SERIESN
CALL INIT_NAM_BLOWSNOWN
+CALL INIT_NAM_STATIONn
!
WRITE(UNIT=ILUOUT,FMT="(/,'READING THE EXSEG.NAM FILE')")
CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND,ILUOUT)
@@ -515,6 +529,10 @@ CALL POSNAM(ILUSEG,'NAM_TURBN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURBn)
CALL POSNAM(ILUSEG,'NAM_DRAGN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGn)
+CALL POSNAM(ILUSEG,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
+CALL POSNAM(ILUSEG,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_RECYCL_PARAMn)
CALL POSNAM(ILUSEG,'NAM_CH_MNHCN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_MNHCn)
CALL POSNAM(ILUSEG,'NAM_CH_SOLVERN',GFOUND,ILUOUT)
@@ -529,6 +547,14 @@ CALL POSNAM(ILUSEG,'NAM_DRAGTREEN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREEn)
CALL POSNAM(ILUSEG,'NAM_DRAGBLDGN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGBLDGn)
+CALL POSNAM(ILUSEG,'NAM_EOL',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL)
+CALL POSNAM(ILUSEG,'NAM_EOL_ADNR',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ADNR)
+CALL POSNAM(ILUSEG,'NAM_EOL_ALM',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ALM)
+CALL POSNAM(ILUSEG,'NAM_STATIONN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_STATIONn)
!
IF (KMI == 1) THEN
WRITE(UNIT=ILUOUT,FMT="(' namelists common to all the models ')")
@@ -860,7 +886,11 @@ CALL TEST_NAM_VAR(ILUOUT,'CLBCY(2)',CLBCY(2),'CYCL','WALL','OPEN')
CALL TEST_NAM_VAR(ILUOUT,'CTURBDIM',CTURBDIM,'1DIM','3DIM')
CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN',CTURBLEN,'DELT','BL89','RM17','DEAR','BLKR','ADAP')
CALL TEST_NAM_VAR(ILUOUT,'CTOM',CTOM,'NONE','TM06')
-CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV',CSUBG_AUCV,'NONE','CLFR','SIGM','PDF')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV',CSUBG_AUCV,'NONE','CLFR','SIGM','PDF','ADJU')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV_RI',CSUBG_AUCV_RI,'NONE','CLFR','ADJU')
+CALL TEST_NAM_VAR(ILUOUT,'CCONDENS',CCONDENS,'CB02','GAUS')
+CALL TEST_NAM_VAR(ILUOUT,'CLAMBDA3',CLAMBDA3,'CB','NONE')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_MF_PDF',CSUBG_MF_PDF,'NONE','TRIANGLE')
!
CALL TEST_NAM_VAR(ILUOUT,'CCH_TDISCRETIZATION',CCH_TDISCRETIZATION, &
'SPLIT ','CENTER ','LAGGED ')
@@ -1226,16 +1256,23 @@ SELECT CASE ( CCLOUD )
LUSERH=LHAIL
END IF
!
- IF (LSUBG_COND .AND. LCOLD) THEN
- WRITE(UNIT=ILUOUT,FMT=9003) KMI
- WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE SIMPLE MIXED PHASE'
- WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYS. SCHEME AND THE SUBGRID COND. SCHEME.'
- WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LSUBG_COND '
- WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "REVE", "KESS" '
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
- END IF
-!
+!!$ IF (LSUBG_COND .AND. LCOLD) THEN
+!!$ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+!!$ WRITE(UNIT=ILUOUT,FMT=*) 'YOU WANT TO USE BOTH THE SIMPLE MIXED PHASE'
+!!$ WRITE(UNIT=ILUOUT,FMT=*) 'MICROPHYS. SCHEME AND THE SUBGRID COND. SCHEME.'
+!!$ WRITE(UNIT=ILUOUT,FMT=*) 'THIS IS NOT YET AVAILABLE. SET LSUBG_COND '
+!!$ WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE OR CCLOUD TO "REVE", "KESS" '
+!!$ !callabortstop
+!!$ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+!!$ END IF
+!
+ IF (CCLOUD == 'LIMA' .AND. LSUBG_COND .AND. (.NOT. LPTSPLIT)) THEN
+ WRITE(UNIT=ILUOUT,FMT=9001) KMI
+ WRITE(UNIT=ILUOUT,FMT=*) 'YOU MUST USE LPTSPLIT=T with CCLOUD=LIMA'
+ WRITE(UNIT=ILUOUT,FMT=*) 'AND LSUBG_COND '
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','use LPTSPLIT=T with LIMA and LSUBG_COND=T')
+ END IF
+!
IF ( XALPHAC /= 3.0 .OR. XNUC /= 2.0) THEN
WRITE(UNIT=ILUOUT,FMT=9001) KMI
WRITE(UNIT=ILUOUT,FMT=*) 'IT IS ADVISED TO USE XALPHAC=3. and XNUC=2.'
@@ -1286,6 +1323,8 @@ LUSETKE(KMI) = (CTURB /= 'NONE')
!
!* 2.3 Chemical and NSV_* variables initializations
!
+CALL UPDATE_NAM_IBM_PARAMN
+CALL UPDATE_NAM_RECYCL_PARAMN
CALL UPDATE_NAM_PARAMN
CALL UPDATE_NAM_DYNN
CALL UPDATE_NAM_CONFN
@@ -2919,6 +2958,7 @@ CALL UPDATE_NAM_CH_MNHCN
CALL UPDATE_NAM_CH_SOLVERN
CALL UPDATE_NAM_SERIESN
CALL UPDATE_NAM_BLOWSNOWN
+CALL UPDATE_NAM_STATIONn
!-------------------------------------------------------------------------------
WRITE(UNIT=ILUOUT,FMT='(/)')
!-------------------------------------------------------------------------------
diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90
index cf8b156bf51075f447fce253232fe221c69639f8..1f8d4b3cab8e98abd0698ec2c34249c956ec75ba 100644
--- a/src/MNH/read_field.f90
+++ b/src/MNH/read_field.f90
@@ -9,7 +9,7 @@
!
INTERFACE
!
- SUBROUTINE READ_FIELD(TPINIFILE,KIU,KJU,KKU, &
+ SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, &
HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, &
HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR, &
HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, &
@@ -29,14 +29,17 @@ INTERFACE
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
- PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD )
+ PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
+ PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
+ PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS )
!
USE MODD_IO, ONLY : TFILEDATA
USE MODD_TIME ! for type DATE_TIME
!
!
+INTEGER, INTENT(IN) :: KOCEMI !Ocan model index
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
-INTEGER, INTENT(IN) :: KIU, KJU, KKU
+INTEGER, INTENT(IN) :: KIU, KJU, KKU
! array sizes in x, y and z directions
!
CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
@@ -115,6 +118,11 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLU
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF,PIBM_XMUT
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS
!
!
END SUBROUTINE READ_FIELD
@@ -124,7 +132,7 @@ END INTERFACE
END MODULE MODI_READ_FIELD
!
! ########################################################################
- SUBROUTINE READ_FIELD(TPINIFILE,KIU,KJU,KKU, &
+ SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, &
HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, &
HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR, &
HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, &
@@ -144,7 +152,9 @@ END MODULE MODI_READ_FIELD
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
- PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD )
+ PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
+ PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
+ PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS )
! ########################################################################
!
!!**** *READ_FIELD* - routine to read prognostic and surface fields
@@ -242,8 +252,11 @@ END MODULE MODI_READ_FIELD
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
! M. Leriche 10/06/2019: in restart case read all immersion modes for LIMA
-! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
-!-------------------------------------------------------------------------------
+!! B. Vie 06/2020: Add prognostic supersaturation for LIMA
+!! F. Auguste 02/2021: add fields necessary for IBM
+!! T. Nagel 02/2021: add fields necessary for turbulence recycling
+!! J.L. Redelsperger 03/2021: add necessary variables for Ocean LES case
+!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -259,27 +272,32 @@ USE MODD_CONF_n
USE MODD_CST
USE MODD_CTURB
USE MODD_DUST
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
-use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEREAL
+use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEREAL,TYPELOG,TYPEINT
USE MODD_FIELD_n, only: XZWS_DEFAULT
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
#endif
+USE MODD_IBM_PARAM_n, ONLY: LIBM
USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LATZ_EDFLX
USE MODD_LG, ONLY: CLGNAMES
USE MODD_LUNIT_N, ONLY: TLUOUT
USE MODD_NSV
+USE MODD_OCEANH
USE MODD_PARAM_C2R2, ONLY: LSUPSAT
!
USE MODD_PARAM_LIMA , ONLY: NMOD_CCN, LSCAV, LAERO_MASS, &
NMOD_IFN, NMOD_IMM, NINDICE_CCN_IMM, LHHONI
USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES, CAERO_MASS
-USE MODD_PARAM_n, ONLY: CSCONV
+USE MODD_PARAM_n, ONLY: CSCONV
USE MODD_PASPOL
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
+USE MODD_RECYCL_PARAM_n
+USE MODD_REF, ONLY: LCOUPLES
USE MODD_SALT
USE MODD_TIME ! for type DATE_TIME
!
@@ -297,8 +315,9 @@ IMPLICIT NONE
!
!
!
+INTEGER, INTENT(IN) :: KOCEMI !Ocan model index
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
-INTEGER, INTENT(IN) :: KIU, KJU, KKU
+INTEGER, INTENT(IN) :: KIU, KJU, KKU
! array sizes in x, y and z directions
!
CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
@@ -382,6 +401,12 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLU
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF ! LSF for IBM
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_XMUT ! Turbulent viscosity
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW ! Velocity average at West boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN ! Velocity average at North boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE ! Velocity average at East boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS ! Velocity average at South boundary
!
!* 0.2 declarations of local variables
!
@@ -394,6 +419,7 @@ INTEGER :: JKLOOP,JRR ! Loop indexes
INTEGER :: IIUP,IJUP ! size of working window arrays
INTEGER :: JT ! loop index
LOGICAL :: GLSOURCE ! switch for the source term (for ini_ls and ini_lb)
+LOGICAL :: ZLRECYCL ! switch if turbulence recycling is activated
CHARACTER(LEN=2) :: INDICE
CHARACTER(LEN=3) :: YFRC ! To mark the different forcing dates
CHARACTER(LEN=15) :: YVAL
@@ -587,6 +613,203 @@ SELECT CASE(HGETCIT) ! ice concentration
PCIT(:,:,:)=0.
END SELECT
!
+IF (LIBM .AND. CPROGRAM=='MESONH') THEN
+ !
+ TZFIELD%CMNHNAME = 'LSFP'
+ TZFIELD%CLONGNAME = 'LSFP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_LSF)
+ !
+ TZFIELD%CMNHNAME = 'XMUT'
+ TZFIELD%CLONGNAME = 'XMUT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm2 s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_XMUT)
+ !
+ENDIF
+!
+TZFIELD%CMNHNAME = 'RECYCLING'
+TZFIELD%CLONGNAME = 'RECYCLING'
+TZFIELD%CSTDNAME = ''
+TZFIELD%CUNITS = ''
+TZFIELD%CDIR = '--'
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPELOG
+TZFIELD%NDIMS = 0
+TZFIELD%LTIMEDEP = .FALSE.
+CALL IO_Field_read(TPINIFILE,TZFIELD,ZLRECYCL,IRESP)
+!If field not found (file from older version of MesoNH) => set ZLRECYCL to false
+IF ( IRESP /= 0 ) ZLRECYCL = .FALSE.
+
+IF (ZLRECYCL) THEN
+ !
+ TZFIELD%CMNHNAME = 'RCOUNT'
+ TZFIELD%CLONGNAME = 'RCOUNT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = '--'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEINT
+ TZFIELD%NDIMS = 0
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,NR_COUNT)
+ !
+ IF (NR_COUNT .NE. 0) THEN
+ IF (LRECYCLW) THEN
+ TZFIELD%CMNHNAME = 'URECYCLW'
+ TZFIELD%CLONGNAME = 'URECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANW)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLW'
+ TZFIELD%CLONGNAME = 'VRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANW)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLW'
+ TZFIELD%CLONGNAME = 'WRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANW)
+ !
+ ENDIF
+ IF (LRECYCLN) THEN
+ TZFIELD%CMNHNAME = 'URECYCLN'
+ TZFIELD%CLONGNAME = 'URECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANN)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLN'
+ TZFIELD%CLONGNAME = 'VRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANN)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLN'
+ TZFIELD%CLONGNAME = 'WRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANN)
+ !
+ ENDIF
+ IF (LRECYCLE) THEN
+ TZFIELD%CMNHNAME = 'URECYCLE'
+ TZFIELD%CLONGNAME = 'URECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANE)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLE'
+ TZFIELD%CLONGNAME = 'VRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANE)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLE'
+ TZFIELD%CLONGNAME = 'WRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANE)
+ !
+ ENDIF
+ IF (LRECYCLS) THEN
+ TZFIELD%CMNHNAME = 'URECYCLS'
+ TZFIELD%CLONGNAME = 'URECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANS)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLS'
+ TZFIELD%CLONGNAME = 'VRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANS)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLS'
+ TZFIELD%CLONGNAME = 'WRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANS)
+ ENDIF
+ ENDIF
+ENDIF
+!
! Scalar Variables Reading : Users, C2R2, C1R3, LIMA, ELEC, Chemical SV
!
ISV= SIZE(PSVT,4)
@@ -725,6 +948,11 @@ DO JSV = NSV_LIMA_BEG,NSV_LIMA_END
IF (JSV .EQ. NSV_LIMA_HOM_HAZE) THEN
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(5))//'T'
END IF
+!
+! Super saturation
+ IF (JSV .EQ. NSV_LIMA_SPRO) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(5))//'T'
+ END IF
!
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
@@ -1318,6 +1546,66 @@ END SELECT
!* 2.4 READ FORCING VARIABLES
! ----------------------
!
+! READ FIELD ONLY FOR MODEL1 (identical for all model in GN)
+IF (LOCEAN .AND. (.NOT.LCOUPLES) .AND. (KOCEMI==1)) THEN
+!
+ CALL IO_Field_read(TPINIFILE,'NFRCLT',NFRCLT)
+ CALL IO_Field_read(TPINIFILE,'NINFRT',NINFRT)
+!
+ TZFIELD%CMNHNAME = 'SSUFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSUFL'
+ TZFIELD%CUNITS = 'kg m-1 s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc stress along U to force ocean LES '
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ ALLOCATE(XSSUFL_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSUFL_T(:))
+!
+ TZFIELD%CMNHNAME = 'SSVFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSVFL'
+ TZFIELD%CUNITS = 'kg m-1 s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc stress along V to force ocean LES '
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ALLOCATE(XSSVFL_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSVFL_T(:))
+!
+ TZFIELD%CMNHNAME = 'SSTFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSTFL'
+ TZFIELD%CUNITS = 'kg m3 K m s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc total heat flux to force ocean LES '
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ ALLOCATE(XSSTFL_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSTFL_T(:))
+!
+ TZFIELD%CMNHNAME = 'SSOLA_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSOLA'
+ TZFIELD%CUNITS = 'kg m3 K m s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc solar flux at sfc to force ocean LES '
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ ALLOCATE(XSSOLA_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSOLA_T(:))
+!
+END IF ! ocean sfc forcing end
+
!
IF ( LFORCING ) THEN
DO JT=1,KFRC
@@ -1666,4 +1954,3 @@ END IF
!
!
END SUBROUTINE READ_FIELD
-
diff --git a/src/MNH/read_ver_grid.f90 b/src/MNH/read_ver_grid.f90
index a78e3b77778b890aa68aa4f9652daa50146b541c..2f8b1fc47b98956bea3fd157a989b8b733546377 100644
--- a/src/MNH/read_ver_grid.f90
+++ b/src/MNH/read_ver_grid.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -194,8 +194,12 @@ XLEN2_n = XLEN2
!
IF (CPROGRAM=='REAL ') THEN
IF (ASSOCIATED (XZHAT) ) DEALLOCATE(XZHAT)
- CALL POSNAM(IPRE_REAL1,'NAM_BLANKn',GFOUND,ILUOUT0)
- IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_BLANKn)
+ CALL POSNAM(IPRE_REAL1,'NAM_BLANKN',GFOUND,ILUOUT0)
+ IF (GFOUND) THEN
+ CALL INIT_NAM_BLANKn
+ READ(UNIT=IPRE_REAL1,NML=NAM_BLANKn)
+ CALL UPDATE_NAM_BLANKn
+ END IF
END IF
!
IKB=JPVEXT+1
diff --git a/src/MNH/recycl_fluc.f90 b/src/MNH/recycl_fluc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2ee5471c1cbaf789bda33b71efde9b70cdb644e8
--- /dev/null
+++ b/src/MNH/recycl_fluc.f90
@@ -0,0 +1,491 @@
+!MNH_LIC Copyright 2021-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.
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_RECYCL_FLUC
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE RECYCL_FLUC (PPTABU,PPTABV,PPTABW,PTHT,PDZZ,ONR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS )
+
+ INTEGER ,INTENT(IN) :: ONR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PPTABU,PPTABV,PPTABW,PTHT,PDZZ
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+
+END SUBROUTINE RECYCL_FLUC
+!
+END INTERFACE
+!
+END MODULE MODI_RECYCL_FLUC
+!
+!
+!
+! ####################################
+ SUBROUTINE RECYCL_FLUC (PPTABU,PPTABV,PPTABW,PTHT,PDZZ,ONR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS )
+
+! ####################################
+!
+!!**** *RECYCL_FLUC* - routine calculating the velocity forcing fluctuations
+!
+!!
+!! PURPOSE
+!! -------
+! RECYCLING METHOD
+!
+!! METHOD
+!! ------
+!!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Tim Nagel * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/2021
+!!
+!------------------------------------------------------------------------------
+!
+!**** 0. DECLARATIONS
+! ---------------
+!
+! module
+USE MODE_POS
+USE MODE_ll
+USE MODE_IO
+USE MODI_SHUMAN
+!
+! declaration
+USE MODD_VAR_ll, ONLY: IP, NPROC
+USE MODD_CONF, ONLY: NHALO
+!
+USE MODD_RECYCL_PARAM_n
+!
+USE MODD_PARAMETERS
+USE MODD_CONF
+!
+USE MODD_CST
+!
+USE MODD_DIM_n
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_METRICS_n
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_DYN_n
+USE MODD_FIELD_n
+USE MODD_CURVCOR_n
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_W
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODE_GRIDPROJ
+USE MODD_REF
+USE MODD_LATZ_EDFLX
+!
+USE MODI_MEAN_Z
+!
+IMPLICIT NONE
+!
+!------------------------------------------------------------------------------
+!
+! 0.1 declarations of arguments
+ INTEGER ,INTENT(IN) :: ONR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PPTABU,PPTABV,PPTABW,PTHT,PDZZ
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+!
+!------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+INTEGER :: IIU,IJU,IKU,IIP,JJ,JI,JK,IIB,IJB,IIE,IJE,IKE,IKB
+INTEGER :: ICOUNT,JCOUNT,IIMAX_ll,IJMAX_ll
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUTN,ZTMPVNN,ZTMPWTN !Velocity in the recycling Plan, NORTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUTN,ZTMPFVNN,ZTMPFWTN !Fluctuations in the recycling Plan, NORTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUNW,ZTMPVTW,ZTMPWTW !Velocity in the recycling Plan, WEST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUNW,ZTMPFVTW,ZTMPFWTW !Fluctuations in the recycling Plan, WEST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUNE,ZTMPVTE,ZTMPWTE !Velocity in the recycling Plan EAST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUNE,ZTMPFVTE,ZTMPFWTE !Fluctuations in the recycling Plan, EAST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUTS,ZTMPVNS,ZTMPWTS !Velocity in the recycling Plan, SOUTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUTS,ZTMPFVNS,ZTMPFWTS !Fluctuations in the recycling Plan, SOUTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPZ
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZALPNORTH,ZALPWEST,ZALPSOUTH,ZALPEAST !Coefficient for the fluctuation (ZALP IN [0-1])
+REAL, DIMENSION(:,:) ,ALLOCATABLE :: ZTMPNDW,ZTMPNDN,ZTMPNDE,ZTMPNDS !Brunt Vaisala frequency
+REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZND,ZWORK32 !Brunt Vaisala frequency (3D fields)
+INTEGER :: IINFO_ll
+
+!------------------------------------------------------------------------------
+!
+! *** Allocation and dimension
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
+IKU = SIZE(PPTABU,3)
+IKE=IKU-JPVEXT
+IKB = 1 + JPVEXT
+
+ALLOCATE(ZWORK32(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ALLOCATE(ZND(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+
+!
+! *** Dry Brunt Vaisala frequency
+!
+ZWORK32(:,:,:)=DZM(PTHT(:,:,:))/ MZM(PTHT(:,:,:))
+DO JK=1,(IKE+1)
+ DO JJ=1,(IJE+1)
+ DO JI=1,(IIE+1)
+ IF(ZWORK32(JI,JJ,JK)<0.) THEN
+ ZND(JI,JJ,JK)= -1.*SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ PDZZ(JI,JJ,JK) ))
+ ELSE
+ ZND(JI,JJ,JK)= SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ PDZZ(JI,JJ,JK) ) )
+ ENDIF
+ ENDDO
+ ENDDO
+ENDDO
+ZND(:,:,:) = ABS(ZND(:,:,:))
+DO JK=1,(IKE+1)
+ DO JJ=1,(IJE+1)
+ DO JI=1,(IIE+1)
+ IF(ZND(JI,JJ,JK)>1.E6) THEN
+ ZND(JI,JJ,JK)= 1.E6
+ ELSEIF(ZND(JI,JJ,JK)<1.E-6) THEN
+ ZND(JI,JJ,JK)= 1.E-6
+ ENDIF
+ ZND(JI,JJ,JK) = 1./ZND(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+IF (LWEST_ll ()) ZND(IIB-1,:,:)=ZND(IIB,:,:)
+IF (LNORTH_ll()) ZND(:,IJE+1,:)=ZND(:,IJE,:)
+IF (LEAST_ll ()) ZND(IIE+1,:,:)=ZND(IIE,:,:)
+IF (LSOUTH_ll()) ZND(:,IJB-1,:)=ZND(:,IJB,:)
+ZND(:,:,IKE+1)=ZND(:,:,IKE)
+ZND(:,:,IKB-1)=ZND(:,:,IKB)
+
+
+IF (LRECYCLW) THEN
+ !-------------------------------------------------------
+ !-----------WEST
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUNW (IJU,IKU))
+ ALLOCATE(ZTMPVTW (IJU,IKU))
+ ALLOCATE(ZTMPWTW (IJU,IKU))
+ ALLOCATE(ZTMPZ (IJU,IKU))
+ ALLOCATE(ZTMPNDW (IJU,IKU))
+ ALLOCATE(ZALPWEST (IJU,IKU))
+ ALLOCATE(ZTMPFUNW (IJU,IKU))
+ ALLOCATE(ZTMPFVTW (IJU,IKU))
+ ALLOCATE(ZTMPFWTW (IJU,IKU))
+ ZTMPUNW =0.
+ ZTMPVTW =0.
+ ZTMPWTW =0.
+ ZTMPZ =0.
+ ZTMPNDW =0.
+ ZALPWEST=0.
+ CALL GET_2DSLICE_ll(PPTABU,'Y',PMINW,ZTMPUNW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'Y',PMINW,ZTMPVTW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'Y',PMINW,ZTMPWTW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'Y',PMINW,ZTMPZ(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'Y',1+JPHEXT,ZTMPNDW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(ONR_COUNT.LE.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=ONR_COUNT/XTMOYCOUNT
+ XUMEANW(:,:,ICOUNT)=ZTMPUNW(:,:)
+ XVMEANW(:,:,ICOUNT)=ZTMPVTW(:,:)
+ XWMEANW(:,:,ICOUNT)=ZTMPWTW(:,:)
+ ENDIF
+ IF(ONR_COUNT.GT.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANW(:,:,JCOUNT)=XUMEANW(:,:,JCOUNT+1)
+ XVMEANW(:,:,JCOUNT)=XVMEANW(:,:,JCOUNT+1)
+ XWMEANW(:,:,JCOUNT)=XWMEANW(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANW(:,:,INT(XNUMBELT))=ZTMPUNW(:,:)
+ XVMEANW(:,:,INT(XNUMBELT))=ZTMPVTW(:,:)
+ XWMEANW(:,:,INT(XNUMBELT))=ZTMPWTW(:,:)
+ ENDIF
+ IF (LWEST_ll( )) THEN
+ DO JJ = 1,IJU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDW(JJ,JK)>XTBVTOP) THEN
+ ZALPWEST(JJ,JK)=1.
+ ELSE IF (ZTMPNDW(JJ,JK)<XTBVBOT) THEN
+ ZALPWEST(JJ,JK)=0.
+ ELSE
+ ZALPWEST(JJ,JK)=1./ABS(XTBVTOP-XTBVBOT)*ABS(ZTMPNDW(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(NR_COUNT.GT.XTMOY) THEN
+ ZTMPFUNW =ZTMPUNW(:,:)-(SUM(XUMEANW,DIM=3)/INT(XNUMBELT))
+ ZTMPFVTW =ZTMPVTW(:,:)-(SUM(XVMEANW,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTW =ZTMPWTW(:,:)-(SUM(XWMEANW,DIM=3)/INT(XNUMBELT))
+ PFLUCTUNW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUNW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPWEST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTVTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPWEST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPWEST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPUNW,ZTMPVTW,ZTMPWTW,ZTMPZ,ZTMPNDW,ZALPWEST,ZTMPFUNW,ZTMPFVTW,ZTMPFWTW)
+ENDIF
+
+IF (LRECYCLN) THEN
+ !-------------------------------------------------------
+ !-----------NORTH
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUTN (IIU,IKU))
+ ALLOCATE(ZTMPVNN (IIU,IKU))
+ ALLOCATE(ZTMPWTN (IIU,IKU))
+ ALLOCATE(ZTMPZ (IIU,IKU))
+ ALLOCATE(ZTMPNDN (IIU,IKU))
+ ALLOCATE(ZALPNORTH (IIU,IKU))
+ ALLOCATE(ZTMPFUTN (IIU,IKU))
+ ALLOCATE(ZTMPFVNN (IIU,IKU))
+ ALLOCATE(ZTMPFWTN (IIU,IKU))
+ ZTMPUTN =0.
+ ZTMPVNN =0.
+ ZTMPWTN =0.
+ ZTMPZ =0.
+ ZTMPNDN =0.
+ ZALPNORTH=0.
+ CALL GET_2DSLICE_ll(PPTABU,'X',PMINN,ZTMPUTN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'X',PMINN,ZTMPVNN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'X',PMINN,ZTMPWTN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'X',PMINN,ZTMPZ(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'X',IJMAX_ll+JPHEXT,ZTMPNDN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(ONR_COUNT.LE.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=ONR_COUNT/XTMOYCOUNT
+ XUMEANN(:,:,ICOUNT)=ZTMPUTN(:,:)
+ XVMEANN(:,:,ICOUNT)=ZTMPVNN(:,:)
+ XWMEANN(:,:,ICOUNT)=ZTMPWTN(:,:)
+ ENDIF
+ IF(ONR_COUNT.GT.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANN(:,:,JCOUNT)=XUMEANN(:,:,JCOUNT+1)
+ XVMEANN(:,:,JCOUNT)=XVMEANN(:,:,JCOUNT+1)
+ XWMEANN(:,:,JCOUNT)=XWMEANN(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANN(:,:,INT(XNUMBELT))=ZTMPUTN(:,:)
+ XVMEANN(:,:,INT(XNUMBELT))=ZTMPVNN(:,:)
+ XWMEANN(:,:,INT(XNUMBELT))=ZTMPWTN(:,:)
+ ENDIF
+
+ IF (LNORTH_ll( )) THEN
+ DO JJ = 1,IIU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDN(JJ,JK)>XTBVTOP) THEN
+ ZALPNORTH(JJ,JK)=1.
+ ELSE IF (ZTMPNDN(JJ,JK)<XTBVBOT) THEN
+ ZALPNORTH(JJ,JK)=0.
+ ELSE
+ ZALPNORTH(JJ,JK)=1./(XTBVTOP-XTBVBOT)*(ZTMPNDN(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(NR_COUNT.GT.XTMOY) THEN
+ ZTMPFUTN =ZTMPUTN(:,:)-(SUM(XUMEANN,DIM=3)/INT(XNUMBELT))
+ ZTMPFVNN =ZTMPVNN(:,:)-(SUM(XVMEANN,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTN =ZTMPWTN(:,:)-(SUM(XWMEANN,DIM=3)/INT(XNUMBELT))
+ PFLUCTVNN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVNN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPNORTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTUTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPNORTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPNORTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPVNN,ZTMPUTN,ZTMPWTN,ZTMPZ,ZTMPNDN,ZALPNORTH,ZTMPFVNN,ZTMPFUTN,ZTMPFWTN)
+ENDIF
+
+IF (LRECYCLE) THEN
+ !-------------------------------------------------------
+ !-----------EAST
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUNE (IJU,IKU))
+ ALLOCATE(ZTMPVTE (IJU,IKU))
+ ALLOCATE(ZTMPWTE (IJU,IKU))
+ ALLOCATE(ZTMPZ (IJU,IKU))
+ ALLOCATE(ZTMPNDE (IJU,IKU))
+ ALLOCATE(ZALPEAST (IJU,IKU))
+ ALLOCATE(ZTMPFUNE (IJU,IKU))
+ ALLOCATE(ZTMPFVTE (IJU,IKU))
+ ALLOCATE(ZTMPFWTE (IJU,IKU))
+ ZTMPUNE =0.
+ ZTMPVTE =0.
+ ZTMPWTE =0.
+ ZTMPZ =0.
+ ZTMPNDE =0.
+ ZALPEAST=0.
+ CALL GET_2DSLICE_ll(PPTABU,'Y',PMINE,ZTMPUNE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'Y',PMINE,ZTMPVTE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'Y',PMINE,ZTMPWTE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'Y',PMINE,ZTMPZ(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'Y',IIMAX_ll+JPHEXT,ZTMPNDE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(ONR_COUNT.LE.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=ONR_COUNT/XTMOYCOUNT
+ XUMEANE(:,:,ICOUNT)=ZTMPUNE(:,:)
+ XVMEANE(:,:,ICOUNT)=ZTMPVTE(:,:)
+ XWMEANE(:,:,ICOUNT)=ZTMPWTE(:,:)
+ ENDIF
+ IF(ONR_COUNT.GT.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANE(:,:,JCOUNT)=XUMEANE(:,:,JCOUNT+1)
+ XVMEANE(:,:,JCOUNT)=XVMEANE(:,:,JCOUNT+1)
+ XWMEANE(:,:,JCOUNT)=XWMEANE(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANE(:,:,INT(XNUMBELT))=ZTMPUNE(:,:)
+ XVMEANE(:,:,INT(XNUMBELT))=ZTMPVTE(:,:)
+ XWMEANE(:,:,INT(XNUMBELT))=ZTMPWTE(:,:)
+ ENDIF
+ IF (LEAST_ll( )) THEN
+ DO JJ = 1,IJU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDE(JJ,JK)>XTBVTOP) THEN
+ ZALPEAST(JJ,JK)=1.
+ ELSE IF (ZTMPNDE(JJ,JK)<XTBVBOT) THEN
+ ZALPEAST(JJ,JK)=0.
+ ELSE
+ ZALPEAST(JJ,JK)=1./ABS(XTBVTOP-XTBVBOT)*ABS(ZTMPNDE(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(NR_COUNT.GT.XTMOY) THEN
+ ZTMPFUNE =ZTMPUNE(:,:)-(SUM(XUMEANE,DIM=3)/INT(XNUMBELT))
+ ZTMPFVTE =ZTMPVTE(:,:)-(SUM(XVMEANE,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTE =ZTMPWTE(:,:)-(SUM(XWMEANE,DIM=3)/INT(XNUMBELT))
+ PFLUCTUNE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUNE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPEAST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTVTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPEAST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPEAST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPUNE,ZTMPVTE,ZTMPWTE,ZTMPZ,ZTMPNDE,ZALPEAST,ZTMPFUNE,ZTMPFVTE,ZTMPFWTE)
+ENDIF
+!
+IF (LRECYCLS) THEN
+ !-------------------------------------------------------
+ !-----------SOUTH
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUTS (IIU,IKU))
+ ALLOCATE(ZTMPVNS (IIU,IKU))
+ ALLOCATE(ZTMPWTS (IIU,IKU))
+ ALLOCATE(ZTMPZ (IIU,IKU))
+ ALLOCATE(ZTMPNDS (IIU,IKU))
+ ALLOCATE(ZALPSOUTH (IIU,IKU))
+ ALLOCATE(ZTMPFUTS (IIU,IKU))
+ ALLOCATE(ZTMPFVNS (IIU,IKU))
+ ALLOCATE(ZTMPFWTS (IIU,IKU))
+ ZTMPUTS =0.
+ ZTMPVNS =0.
+ ZTMPWTS =0.
+ ZTMPZ =0.
+ ZTMPNDS =0.
+ ZALPSOUTH=0.
+ CALL GET_2DSLICE_ll(PPTABU,'X',PMINS,ZTMPUTS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'X',PMINS,ZTMPVNS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'X',PMINS,ZTMPWTS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'X',PMINS,ZTMPZ(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'X',1+JPHEXT,ZTMPNDS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(ONR_COUNT.LE.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=ONR_COUNT/XTMOYCOUNT
+ XUMEANS(:,:,ICOUNT)=ZTMPUTS(:,:)
+ XVMEANS(:,:,ICOUNT)=ZTMPVNS(:,:)
+ XWMEANS(:,:,ICOUNT)=ZTMPWTS(:,:)
+ ENDIF
+ IF(ONR_COUNT.GT.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANS(:,:,JCOUNT)=XUMEANS(:,:,JCOUNT+1)
+ XVMEANS(:,:,JCOUNT)=XVMEANS(:,:,JCOUNT+1)
+ XWMEANS(:,:,JCOUNT)=XWMEANS(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANS(:,:,INT(XNUMBELT))=ZTMPUTS(:,:)
+ XVMEANS(:,:,INT(XNUMBELT))=ZTMPVNS(:,:)
+ XWMEANS(:,:,INT(XNUMBELT))=ZTMPWTS(:,:)
+ ENDIF
+ IF (LSOUTH_ll( )) THEN
+ DO JJ = 1,IIU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDS(JJ,JK)>XTBVTOP) THEN
+ ZALPSOUTH(JJ,JK)=1.
+ ELSE IF (ZTMPNDS(JJ,JK)<XTBVBOT) THEN
+ ZALPSOUTH(JJ,JK)=0.
+ ELSE
+ ZALPSOUTH(JJ,JK)=1./(XTBVTOP-XTBVBOT)*(ZTMPNDS(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(NR_COUNT.GT.XTMOY) THEN
+ ZTMPFUTS =ZTMPUTS(:,:)-(SUM(XUMEANS,DIM=3)/INT(XNUMBELT))
+ ZTMPFVNS =ZTMPVNS(:,:)-(SUM(XVMEANS,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTS =ZTMPWTS(:,:)-(SUM(XWMEANS,DIM=3)/INT(XNUMBELT))
+ PFLUCTVNS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVNS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPSOUTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTUTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPSOUTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPSOUTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPVNS,ZTMPUTS,ZTMPWTS,ZTMPZ,ZTMPNDS,ZALPSOUTH,ZTMPFVNS,ZTMPFUTS,ZTMPFWTS)
+ENDIF
+
+DEALLOCATE(ZWORK32,ZND)
+
+RETURN
+
+END SUBROUTINE RECYCL_FLUC
diff --git a/src/MNH/recycling.f90 b/src/MNH/recycling.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9734eebc00e2f5bc16e8e923bfdc04cba2f120e7
--- /dev/null
+++ b/src/MNH/recycling.f90
@@ -0,0 +1,184 @@
+!MNH_LIC Copyright 2021-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.
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_RECYCLING
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE RECYCLING (PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS, &
+ PTCOUNT)
+
+ INTEGER ,INTENT(IN) :: PTCOUNT
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+
+END SUBROUTINE RECYCLING
+!
+END INTERFACE
+!
+END MODULE MODI_RECYCLING
+!
+!
+!
+! ####################################
+ SUBROUTINE RECYCLING (PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS, &
+ PTCOUNT)
+! ####################################
+!
+!!**** *RECYCLING* - routine initializing and building the velocity fluctuations fields
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize and calculate
+! turbulent fluctuations in order to be applied at the domain
+! boundaries.
+!
+!! METHOD
+!! ------
+!!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Tim Nagel * Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/2021
+!!
+!------------------------------------------------------------------------------
+!
+!**** 0. DECLARATIONS
+! ---------------
+!
+! module
+USE MODE_POS
+USE MODE_ll
+USE MODE_IO
+!USE MODI_SHUMAN
+!
+USE MODD_PARAMETERS
+USE MODD_CONF
+!
+USE MODD_CST
+!
+USE MODD_DIM_n
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_METRICS_n
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_DYN_n
+USE MODD_FIELD_n
+USE MODD_CURVCOR_n
+USE MODD_REF
+!
+USE MODD_VAR_ll, ONLY: IP, NPROC
+USE MODD_RECYCL_PARAM_n
+USE MODI_RECYCL_FLUC
+USE MODD_LUNIT_n, ONLY : TLUOUT
+!
+IMPLICIT NONE
+!
+!------------------------------------------------------------------------------
+!
+! 0.1 declarations of arguments
+INTEGER ,INTENT(IN) :: PTCOUNT ! temporal loop index of model KMODEL
+REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+!
+!------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+INTEGER :: IIU,IJU,IKU,JCOUNT,ICOUNT,ILUOUT
+INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE,IIP
+INTEGER :: IIBG,IIEG,IJBG,IJEG,IIMAX,IJMAX
+INTEGER :: PMINW,PMINE,PMINN,PMINS
+INTEGER :: JIDIST,JJDIST
+REAL :: Z_DELTX,Z_DELTY
+!
+!------------------------------------------------------------------------------
+!
+! 0.3 allocation
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+IKU=NKMAX+2*JPVEXT
+PMINW=0
+PMINN=0
+PMINS=0
+PMINE=0
+
+CALL GET_OR_ll('B',IIBG,IJBG)
+IIBG = IIBG+IIB-1
+IJBG = IJBG+IJB-1
+CALL GET_GLOBALDIMS_ll( IIMAX,IJMAX)
+IIEG=IIBG+IIE-IIB
+IJEG=IJBG+IJE-IJB
+Z_DELTX = XXHAT(2)-XXHAT(1)
+Z_DELTY = XYHAT(2)-XYHAT(1)
+
+
+ILUOUT = TLUOUT%NLU
+!------------------------------------------------------------------------------
+!
+!**** 1. Recycling distance calculation
+! ---------------
+!
+!Moving averaged parameter verification
+IF (PTCOUNT==1 .AND. INT(XTMOY)/INT(XTMOYCOUNT) /= INT(XNUMBELT)) THEN
+ CMNHMSG(1) = 'XTMOY/XTMOYCOUNT must be equal to XNUMBELT'
+ CMNHMSG(2) = 'Please change the above parameters accordingly in NAM_RECYCL_PARAMn'
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'RECYCLING' )
+END IF
+
+IF(CCONF == "RESTA" .AND. PTCOUNT == 1 ) THEN
+ NR_COUNT = NR_COUNT
+ELSE
+ NR_COUNT = NR_COUNT +1
+ !IF (IP==1) WRITE(*,*)'RCOUNT: ', NR_COUNT
+ENDIF
+
+ IF (LRECYCLW) THEN
+ JIDIST = INT(XDRECYCLW*cos(XARECYCLW)/Z_DELTX)
+ JJDIST = INT(XDRECYCLW*sin(XARECYCLW)/Z_DELTY)
+ PMINW = 1+JPHEXT+JIDIST
+ ENDIF
+ IF (LRECYCLN) THEN
+ JIDIST = INT(XDRECYCLN*cos(XARECYCLN)/Z_DELTX)
+ JJDIST = INT(XDRECYCLN*sin(XARECYCLN)/Z_DELTY)
+ PMINN = 1+JPHEXT+JJDIST
+ ENDIF
+ IF (LRECYCLE) THEN
+ JIDIST = INT(XDRECYCLE*cos(XARECYCLE)/Z_DELTX)
+ JJDIST = INT(XDRECYCLE*sin(XARECYCLE)/Z_DELTY)
+ PMINE = 1+JPHEXT+JIDIST
+ ENDIF
+ IF (LRECYCLS) THEN
+ JIDIST = INT(XDRECYCLS*cos(XARECYCLS)/Z_DELTX)
+ JJDIST = INT(XDRECYCLS*sin(XARECYCLS)/Z_DELTY)
+ PMINS = 1+JPHEXT+JJDIST!
+ ENDIF
+
+ CALL RECYCL_FLUC (XUT,XVT,XWT,XTHT,XDZZ,NR_COUNT,PTCOUNT,PMINW,PMINN,PMINE,PMINS,&
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS )
+
+RETURN
+
+END SUBROUTINE RECYCLING
+
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 6d4e94f46bd238d4dec01735e6ed335680bad9e6..30616e6c57314d97e5f5e032bf5f4b6e77d89c87 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -23,6 +23,7 @@ INTERFACE
PSOLORG,PMI, &
PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PSEA,PTOWN )
!
USE MODD_IO, ONLY: TFILEDATA
@@ -132,8 +133,12 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols a
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
!
END SUBROUTINE RESOLVED_CLOUD
END INTERFACE
@@ -156,6 +161,7 @@ END MODULE MODI_RESOLVED_CLOUD
PSOLORG,PMI, &
PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PSEA,PTOWN )
! ##########################################################################
!
@@ -265,7 +271,6 @@ END MODULE MODI_RESOLVED_CLOUD
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 01/02/2019: ZRSMIN is now allocatable (instead of size of XRTMIN which was sometimes not allocated)
! C. Lac 02/2019: add rain fraction as an output field
-! P. Wautelet 24/02/2020: bugfix: corrected budget name (DEPI->CDEPI) for ice_adjust
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
@@ -275,6 +280,7 @@ END MODULE MODI_RESOLVED_CLOUD
! P. Wautelet 23/06/2020: remove ZSVS and ZSVT to improve code readability
! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
! P. Wautelet 30/06/2020: remove non-local corrections
+! B. Vie 06/2020: add prognostic supersaturation for LIMA
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -290,10 +296,10 @@ USE MODD_NSV, ONLY: NSV_C1R3END, NSV_C2R2BEG, NSV_C2R2END,
USE MODD_PARAM_C2R2, ONLY: LSUPSAT
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_ICE, ONLY: CSEDIM, LADJ_BEFORE, LADJ_AFTER, CFRAC_ICE_ADJUST, LRED
-USE MODD_PARAM_LIMA, ONLY: LCOLD, LRAIN, LWARM, XCONC_CCN_TOT, NMOD_CCN, NMOD_IFN, NMOD_IMM, LPTSPLIT, &
- YRTMIN=>XRTMIN, YCTMIN=>XCTMIN
+USE MODD_PARAM_LIMA, ONLY: LADJ, LCOLD, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_SALT, ONLY: LSALT
+USE MODD_TURB_n, ONLY: CSUBG_AUCV_RI, CCONDENS, CLAMBDA3, CSUBG_MF_PDF
!
USE MODE_ll
use mode_sources_neg_correct, only: Sources_neg_correct
@@ -305,8 +311,10 @@ USE MODI_ICE_ADJUST
USE MODI_KHKO_NOTADJUST
USE MODI_LIMA
USE MODI_LIMA_ADJUST
+USE MODI_LIMA_ADJUST_SPLIT
USE MODI_LIMA_COLD
USE MODI_LIMA_MIXED
+USE MODI_LIMA_NOTADJUST
USE MODI_LIMA_WARM
USE MODI_RAIN_C2R2_KHKO
USE MODI_RAIN_ICE
@@ -423,8 +431,12 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols a
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
!
!
!* 0.2 Declarations of local variables :
@@ -462,6 +474,9 @@ INTEGER :: JMOD, JMOD_IFN
LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH
! BVIE work array waiting for PINPRI
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2)):: ZINPRI
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZICEFR
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZPRCFR
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZTM
!
!------------------------------------------------------------------------------
!
@@ -725,17 +740,20 @@ SELECT CASE ( HCLOUD )
ENDDO
ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'ADJU', &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF,PRC_MF,PRI_MF, &
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'ADJU', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
PRR=PRS(:,:,:,3)*PTSTEP, &
PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP )
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
ENDIF
IF (LRED) THEN
LLMICRO(:,:,:)=PRT(:,:,:,2)>XRTMIN(2) .OR. &
@@ -749,16 +767,20 @@ SELECT CASE ( HCLOUD )
PRS(:,:,:,4)>ZRSMIN(4) .OR. &
PRS(:,:,:,5)>ZRSMIN(5) .OR. &
PRS(:,:,:,6)>ZRSMIN(6)
- CALL RAIN_ICE_RED ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
+ CALL RAIN_ICE_RED (SIZE(PTHT, 1), SIZE(PTHT, 2), SIZE(PTHT, 3), COUNT(LLMICRO), &
+ OSEDIC, CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI, &
+ OWARM,1,IKU,1, &
PTSTEP, KRR, LLMICRO, ZEXN, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
PRT(:,:,:,3), PRT(:,:,:,4), &
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC,PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA,PTOWN, PFPR=ZFPR)
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ PSEA,PTOWN, PFPR=ZFPR )
ELSE
CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
KSPLITR, PTSTEP, KRR, &
@@ -777,17 +799,20 @@ SELECT CASE ( HCLOUD )
!
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'CDEPI', &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF,PRC_MF,PRI_MF, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP )
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'DEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
END IF
deallocate( zexn )
@@ -808,18 +833,21 @@ SELECT CASE ( HCLOUD )
ENDDO
ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'ADJU', &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF,PRC_MF,PRI_MF, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- PRH=PRS(:,:,:,7)*PTSTEP )
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'ADJU', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
ENDIF
IF (LRED) THEN
LLMICRO(:,:,:)=PRT(:,:,:,2)>XRTMIN(2) .OR. &
@@ -835,16 +863,19 @@ SELECT CASE ( HCLOUD )
PRS(:,:,:,5)>ZRSMIN(5) .OR. &
PRS(:,:,:,6)>ZRSMIN(6) .OR. &
PRS(:,:,:,7)>ZRSMIN(7)
- CALL RAIN_ICE_RED ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
- PTSTEP, KRR, LLMICRO, ZEXN, &
+ CALL RAIN_ICE_RED (SIZE(PTHT, 1), SIZE(PTHT, 2), SIZE(PTHT, 3), COUNT(LLMICRO), &
+ OSEDIC, CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI,&
+ OWARM, 1, IKU, 1, &
+ PTSTEP, KRR, LLMICRO, ZEXN, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
PRT(:,:,:,3), PRT(:,:,:,4), &
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
ELSE
CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
@@ -866,18 +897,21 @@ SELECT CASE ( HCLOUD )
!* 10.2 Perform the saturation adjustment over cloud ice and cloud water
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'CDEPI', &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF,PRC_MF,PRI_MF, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- PRH=PRS(:,:,:,7)*PTSTEP )
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'DEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
END IF
deallocate( zexn )
@@ -905,7 +939,7 @@ SELECT CASE ( HCLOUD )
PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), PW_ACT, &
PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, PINPRH, &
- PEVAP3D )
+ PEVAP3D, PCLDFR, ZICEFR, ZPRCFR )
ELSE
IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
@@ -934,12 +968,28 @@ SELECT CASE ( HCLOUD )
!
!* 12.2 Perform the saturation adjustment
!
- CALL LIMA_ADJUST(KRR, KMI, TPFILE, HRAD, &
- HTURBDIM, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PPABST, PSIGS, PPABST, &
- PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- PTHS, PSRCS, PCLDFR )
+ IF (LSPRO) THEN
+ CALL LIMA_NOTADJUST (KMI, TPFILE, HRAD, &
+ PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PEXNREF, PZZ, &
+ PTHT,PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS,PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PCLDFR, PSRCS )
+ ELSE IF (LPTSPLIT) THEN
+ CALL LIMA_ADJUST_SPLIT(KRR, KMI, TPFILE, CCONDENS, CLAMBDA3, &
+ OSUBG_COND, OSIGMAS, PTSTEP, PSIGQSAT, &
+ PRHODREF, PRHODJ, PEXNREF, PPABST, PSIGS, PMFCONV, PPABST, ZZZ, &
+ PDTHRAD, PW_ACT, &
+ PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PSRCS, PCLDFR, PRC_MF, PCF_MF )
+ ELSE
+ CALL LIMA_ADJUST(KRR, KMI, TPFILE, &
+ OSUBG_COND, PTSTEP, &
+ PRHODREF, PRHODJ, PEXNREF, PPABST, PPABST, &
+ PRT, PRS, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PSRCS, PCLDFR )
+ ENDIF
!
END SELECT
!
diff --git a/src/MNH/set_cstn.f90 b/src/MNH/set_cstn.f90
index 986526c82b5fd2812e3c20c9d54300592149a19e..31f00cb4dda81f39600edc8f0560ac6b91e7ed37 100644
--- a/src/MNH/set_cstn.f90
+++ b/src/MNH/set_cstn.f90
@@ -170,6 +170,7 @@ END MODULE MODI_SET_CSTN
!
USE MODD_CONF
USE MODD_CST
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
@@ -393,8 +394,12 @@ END DO
!* 4.3 Compute Mixing ratio
!
! determines the pressure under the ground
-ZEXNGRDM= ( ZPGROUND / XP00) ** ZRDSCPD &
- - XG/XCPD / (0.5*(ZTHV(1)+ZTHVM(1))) * (ZZMASS_PROFILE(1) - ZHEIGHT(1))
+IF (LOCEAN) THEN
+ ZEXNGRDM= ( ZPGROUND / XP00) ** ZRDSCPD
+ELSE
+ ZEXNGRDM= ( ZPGROUND / XP00) ** ZRDSCPD &
+ - XG/XCPD / (0.5*(ZTHV(1)+ZTHVM(1))) * (ZZMASS_PROFILE(1) - ZHEIGHT(1))
+END IF
ZPGRDM = XP00 * ZEXNGRDM ** (1./ZRDSCPD)
ZPM(:) = PRESS_HEIGHT(ZZMASS_PROFILE(:),ZTHVM,ZPGRDM,ZTHVM(1),ZZMASS_PROFILE(1)) ! compute P
ZTVM(:) = ZTHVM(:) * (ZPM(:) / XP00) ** ZRDSCPD ! compute Tv
diff --git a/src/MNH/set_mass.f90 b/src/MNH/set_mass.f90
index a7b266aaa997e476fbc3fa3d32a820b47f56efbe..4563a4c6d85559ec5ec5a334bd5c3efdb7f4c3a0 100644
--- a/src/MNH/set_mass.f90
+++ b/src/MNH/set_mass.f90
@@ -121,6 +121,7 @@ SUBROUTINE SET_MASS(TPFILE,OPROFILE_IN_PROC, PZFLUX_PROFILE,
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! J-L Redelsperger 06/2021: Ocean case
!
!-------------------------------------------------------------------------------
!!
@@ -135,6 +136,7 @@ USE MODD_CST
USE MODD_REF
USE MODD_PARAMETERS
USE MODD_DIM_n
+USE MODD_DYN_n, ONLY : LOCEAN
!
USE MODE_GATHER_ll
USE MODE_ll
@@ -147,6 +149,8 @@ USE MODI_VER_INT_DYN
USE MODI_SHUMAN
USE MODI_COMPUTE_EXNER_FROM_GROUND
USE MODI_COMPUTE_EXNER_FROM_TOP
+USE MODI_COMPUTE_PRESS_FROM_OCEANSFC
+USE MODI_COMPUTE_PRESS_FROM_OCEANBOT
USE MODI_SET_GEOSBAL
USE MODE_REPRO_SUM
USE MODE_MPPDB
@@ -191,7 +195,10 @@ REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZPMHP_MX ! pressu
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZRHOD_MX ! local rhod (mass level)
REAL,DIMENSION(SIZE(XZHAT)) :: ZRHOD_PROFILE ! local rhod (mass level) at initialization profile column
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZPMASS_MX ! pressure (mass level)
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZPFLUX_MX ! pressure (mass level)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) :: ZEXNSURF2D_MX ! local Exner function at ground
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) :: ZPRESS2D_MX ! local pressure at ground
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) :: ZPRESSFC ! pressure at ocean sfc (ocen model case)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZHEXNFLUX_MX ! local hyd. Exner function at flux points on the mixed grid
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZHEXNMASS_MX ! local hyd. Exner function at mass points on the mixed grid
!
@@ -224,6 +231,8 @@ REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZRHODJU ! horiz
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZRHODJV ! the MESONH Arakawa C grid
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZHEXNFLUX ! local hyd. Exner function at flux points (MNH grid)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZHEXNMASS ! local hyd. Exner function at mass points (MNH grid)
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZPMASS ! local hyd. pres at mass points (MNH grid)
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZPFLUX ! local hyd. pres at flux points (MNH grid)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZRHOD ! dry density on MESO-NH grid
!
!!$INTEGER :: IIBP,IIEP,IJBP,IJEP
@@ -279,17 +288,35 @@ ENDIF
!------------------------------
!* 2.2 compute exner function on mixed grid
!
-ZEXNSURF2D_MX(:,:)=(PPGROUND/XP00)**(XRD/XCPD)
-CALL COMPUTE_EXNER_FROM_GROUND(ZTHV3D_MX,PZFLUX_MX,&
- ZEXNSURF2D_MX,ZHEXNFLUX_MX,ZHEXNMASS_MX)
-ZEXNTOP2D(:,:)=ZHEXNFLUX_MX(:,:,IKE+1)
-ZPMASS_MX(:,:,:)=XP00*(ZHEXNMASS_MX(:,:,:))**(XCPD/XRD)
-ZRHOD_MX(:,:,:)=ZPMASS_MX(:,:,:)/(ZPMASS_MX(:,:,:)/XP00)**(XRD/XCPD) &
+ZEXNSURF2D_MX(:,:)=(PPGROUND/XP00)**(XRD/XCPD)
+!
+IF (LOCEAN) THEN
+ ZTHVREF3D(:,:,:) = ZTHV3D_MX(:,:,:)
+ ZRHOD_MX(:,:,:)= XRH00OCEAN*(1.-XALPHAOC*(ZTHV3D_MX(:,:,:)-XTH00OCEAN) &
+ +XBETAOC *(ZMR3D_MX(:,:,:,1)-XSA00OCEAN))
+ ZPRESS2D_MX(:,:)=PPGROUND
+ CALL COMPUTE_PRESS_FROM_OCEANBOT(ZRHOD_MX,PZFLUX_MX,ZPRESS2D_MX,ZPFLUX_MX,ZPMASS_MX)
+ ZHEXNFLUX_MX(:,:,:)=(ZPFLUX_MX(:,:,:)/XP00)**(XRD/XCPD)
+ ZHEXNMASS_MX(:,:,:)=(ZPMASS_MX(:,:,:)/XP00)**(XRD/XCPD)
+ ZEXNTOP2D(:,:)=ZHEXNFLUX_MX(:,:,IKE+1)
+ELSE
+ CALL COMPUTE_EXNER_FROM_GROUND(ZTHV3D_MX,PZFLUX_MX,&
+ ZEXNSURF2D_MX,ZHEXNFLUX_MX,ZHEXNMASS_MX)
+ ZEXNTOP2D(:,:)=ZHEXNFLUX_MX(:,:,IKE+1)
+ ZPMASS_MX(:,:,:)=XP00*(ZHEXNMASS_MX(:,:,:))**(XCPD/XRD)
+ENDIF
+!
+IF (LOCEAN) THEN
+ IF (LCOUPLES) THEN
+ XEXNTOPO=SUM_DD_R2_ll(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
+ ELSE
+ XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
+ END IF
+ELSE
+ ZRHOD_MX(:,:,:)=ZPMASS_MX(:,:,:)/(ZPMASS_MX(:,:,:)/XP00)**(XRD/XCPD) &
/(XRD*ZTHV3D_MX(:,:,:)*(1.+WATER_SUM(ZMR3D_MX(:,:,:,:))))
-
-XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
-
-
+ XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
+END IF
!------------------------------
!* 2.3 Rotate wind in model axis and take into account variations in x,y
! directions on the mixed grid
@@ -445,15 +472,17 @@ DEALLOCATE(ZNFLYZ_TOT,ZNFLYZ_TOT_ll)
!
IF (PRESENT(PCORIOZ)) THEN
+!To be modified later for ocean model case
CALL SET_GEOSBAL(ZUW3D_FL,ZVW3D_FL,PTHVM,PMRM, &
KILOC,KJLOC,OBOUSS,ZTHV3D,PCORIOZ)
CALL COMPUTE_EXNER_FROM_TOP(ZTHV3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
XPABSM(:,:,:)=XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
ELSE
-!
-! Interpolation of theta and r
!
- IF (SIZE(ZTHV3D_MX,3) > 3) THEN
+!No interpolation for ocean case (no bathimetry)
+! Interpolation of theta and r in atmos case
+!
+ IF (SIZE(ZTHV3D_MX,3) > 3) THEN
CALL VER_INT_THERMO(TPFILE,OSHIFT,ZTHV3D_MX,ZMR3D_MX,PZS_MX,PZS_MX,PZMASS_MX,&
PZFLUX_MX,ZPMHP_MX,ZEXNTOP2D, &
ZTHV3D,XRT,ZPMHP,ZDIAG)
@@ -462,7 +491,11 @@ ELSE
XRT = ZMR3D_MX
ZDIAG = 0.
END IF
- XTHT(:,:,:)=ZTHV3D(:,:,:)*(1.+WATER_SUM(XRT(:,:,:,:)))/(1.+XRV/XRD*XRT(:,:,:,1))
+ IF (LOCEAN) THEN
+ XTHT(:,:,:)=ZTHV3D(:,:,:)
+ ELSE
+ XTHT(:,:,:)=ZTHV3D(:,:,:)*(1.+WATER_SUM(XRT(:,:,:,:)))/(1.+XRV/XRD*XRT(:,:,:,1))
+ ENDIF
ZTHV3D(:,:,1)=ZTHV3D(:,:,2)
XTHT(:,:,1)=XTHT(:,:,2)
XRT(:,:,1,:)=XRT(:,:,2,:)
@@ -472,7 +505,6 @@ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTHV3D, 'SET_MASS::ZTHV3D' )
CALL ADD3DFIELD_ll( TZFIELDS_ll, XRT(:,:,1,:), 'SET_MASS::XRT(:,:,1,:)' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
-
!
IF (NRR>=3) THEN
WHERE (XRT(:,:,:,3)<1.E-20)
@@ -489,17 +521,19 @@ CALL CLEANLIST_ll(TZFIELDS_ll)
CALL VER_INT_DYN(OSHIFT,ZRHODU_MX,ZRHODV_MX,PZFLUX_MX,PZMASS_MX,PZS_MX,ZRHODUA,ZRHODVA)
ZRHODJU(:,:,:)=MXM(ZRHODUA(:,:,:)*PJ(:,:,:))
ZRHODJV(:,:,:)=MYM(ZRHODVA(:,:,:)*PJ(:,:,:))
- CALL COMPUTE_EXNER_FROM_TOP(ZTHV3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
- XPABST(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
- ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
- /(XRD*XTHT(:,:,:)*(1.+XRV/XRD*XRT(:,:,:,1)))
+ IF (.NOT.LOCEAN) THEN
+ CALL COMPUTE_EXNER_FROM_TOP(ZTHV3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
+ XPABST(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
+ ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) /(XRD*XTHT(:,:,:)*(1.+XRV/XRD*XRT(:,:,:,1)))
+ ELSE
+ ZRHOD(:,:,:)=XRH00OCEAN*(1.-XALPHAOC*(XTHT(:,:,:)-XTH00OCEAN)+XBETAOC*(XRT(:,:,:,1)-XSA00OCEAN))
+ END IF
XUT(:,:,:)=ZRHODJU(:,:,:)/MXM(ZRHOD(:,:,:)*PJ(:,:,:))
XVT(:,:,:)=ZRHODJV(:,:,:)/MYM(ZRHOD(:,:,:)*PJ(:,:,:))
XWT(:,:,:)=0
CALL MPPDB_CHECK3DM("SET_MASS:XVT,ZRHODJV,PJ,ZRHODVA",PRECISION,&
& XVT,ZRHODJV,PJ,ZRHODVA )
ENDIF
-
!
!-------------------------------------------------------------------------------
!* 4. COMPUTE ANELASTIC REFERENCE (PV)
@@ -518,17 +552,35 @@ ELSE
DO JK = 1,IKU
CALL REDUCESUM_ll(XTHVREFZ(JK), IINFO_ll)
END DO
-
- XRHODREFZ(:) = XP00/ (XRD* XTHVREFZ(:))
- ZTHVREF3D(:,:,:)=XTHVREFZ(2)
- CALL COMPUTE_EXNER_FROM_GROUND(ZTHVREF3D,PZFLUX_MX,&
+!
+ IF (LOCEAN) THEN
+! Ocean case boussinesq
+ IF (LCOUPLES) THEN
+ XRHODREFZO(:) = XRH00OCEAN
+ XTHVREFZ(:) = ZTHV3D(KILOC,KJLOC,IKU-3) ! XTHVREFZ is uniform
+ ZTHVREF3D(:,:,:)=XTHVREFZ(IKU-3)
+ ZPRESSFC(:,:)=XP00*XEXNTOPO**(XCPD/XRD)
+ ELSE
+ XRHODREFZ(:) = XRH00OCEAN
+ ZPRESSFC(:,:)=XP00*XEXNTOP**(XCPD/XRD)
+! on prend pour le moment la valeur de la couche mélangée
+ END IF
+ CALL COMPUTE_PRESS_FROM_OCEANSFC(ZRHOD,XZZ,ZPRESSFC,ZPFLUX,ZPMASS)
+ XPABST(:,:,:)= ZPMASS(:,:,:)
+!
+ ELSE
+! ATmos: rho = P/ (R Tv)
+ XRHODREFZ(:) = XP00/ (XRD* XTHVREFZ(:))
+ ZTHVREF3D(:,:,:)=XTHVREFZ(2)
+ CALL COMPUTE_EXNER_FROM_GROUND(ZTHVREF3D,PZFLUX_MX,&
ZEXNSURF2D_MX,ZHEXNFLUX,ZHEXNMASS)
- XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
-
- ZEXNTOP2D=ZHEXNFLUX(:,:,IKE+1)
- CALL COMPUTE_EXNER_FROM_TOP(ZTHVREF3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
- XPABST(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
+ XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
+ ZEXNTOP2D=ZHEXNFLUX(:,:,IKE+1)
+ CALL COMPUTE_EXNER_FROM_TOP(ZTHVREF3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
+ XPABST(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
+ENDIF
+ ! end of bouss case
ENDIF
!---------------------------------------------------------------------------------
END SUBROUTINE SET_MASS
diff --git a/src/MNH/set_perturb.f90 b/src/MNH/set_perturb.f90
index 1f88a63cfff307d1dd499afd5f73d1d7d1f51d9e..42e384c2a602a5eff3e16415e897edff93ae7922 100644
--- a/src/MNH/set_perturb.f90
+++ b/src/MNH/set_perturb.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -98,7 +98,8 @@ END MODULE MODI_SET_PERTURB
!! C.Lac, V.Masson 1/2018 : White noise in the LBC
!! Q.Rodier 10/2018 : move allocate(ZWHITE) for NKWH>2
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-!
+!! J.L Redelsperger 03/2021 : : white noise in Ocean LES case at the top of domain(Sfc)
+!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -106,6 +107,7 @@ END MODULE MODI_SET_PERTURB
!
USE MODD_CST
USE MODD_CONF
+USE MODD_DYN_n, ONLY : LOCEAN
USE MODD_DIM_n
USE MODD_FIELD_n
USE MODD_GRID_n
@@ -115,6 +117,7 @@ USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_LSFIELD_n
USE MODD_PARAMETERS
USE MODD_REF_n
+USE MODD_REF
USE MODD_VAR_ll , ONLY : NMNH_COMM_WORLD
!
USE MODE_GATHER_ll
@@ -196,6 +199,7 @@ INTEGER, DIMENSION(:), ALLOCATABLE :: i_seed
INTEGER :: ni_seed
!
INTEGER :: IXOR,IYOR,JI_ll,JJ_ll
+INTEGER :: INOISB,INOISE ! Loop indice for White noise
!
NAMELIST/NAM_PERT_PRE/CPERT_KIND,XAMPLITH, &! Perturbation parameters
XAMPLIRV,XCENTERZ,XRADX, &!
@@ -249,6 +253,13 @@ IJE_ll=IJU_ll-JPHEXT
!
CALL GET_OR_ll('B',IXOR,IYOR)
!
+IF (LOCEAN) THEN
+ INOISB=NKWH
+ INOISE=IKE
+ELSE
+ INOISB=IKB
+ INOISE=NKWH
+ENDIF
!-------------------------------------------------------------------------------
!
!* 2. COMPUTE THE PERTURBATION ON THETA :
@@ -375,8 +386,7 @@ SELECT CASE(CPERT_KIND)
! J.Escobar optim => need only identical random on all domain
!
ALLOCATE(ZWHITE(IIU,IJU))
-!
- DO JK = IKB, NKWH
+ DO JK = INOISB,INOISE
IKX = (NIMAX_ll+1)/2
ZX = 2*XPI/NIMAX_ll
ALLOCATE(ZCX_ll(IIU_ll,IKX))
diff --git a/src/MNH/set_ref.f90 b/src/MNH/set_ref.f90
index 925fd52efdf6c0189af56d44e594453beaf3bd85..3fbd530b720dad8acead062a8a9854cfbc3950a0 100644
--- a/src/MNH/set_ref.f90
+++ b/src/MNH/set_ref.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -150,14 +150,16 @@ END MODULE MODI_SET_REF
!! PRHODREF, PEXNREF, PTHVREF after computation
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! Jean-Luc Redelsperger 03/2021 : OCEAN LES case
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODD_CONF
USE MODD_CST
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
USE MODD_REF
!
@@ -210,6 +212,7 @@ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZRHOREF
! Reference density
REAL, DIMENSION(SIZE(PZZ,3)) :: ZZHATM ! height of the mass levels
! in the transformed space (GCS transf.) or without orography
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZDENSOC,ZPFLUX,ZPMASS
!
INTEGER :: IIU ! Upper dimension in x direction
INTEGER :: IJU ! Upper dimension in y direction
@@ -263,7 +266,12 @@ IF (KMI == 1) THEN
LNEUTRAL=.FALSE.
IF (MAXVAL(XTHVREFZ(IKB:IKE))-MINVAL(XTHVREFZ(IKB:IKE)) < 1.E-10) LNEUTRAL=.TRUE.
END IF
-!
+!* Ref state diff for O & A in LES coupled mode
+IF (LCOUPLES .AND. LOCEAN) THEN
+ CALL IO_Field_read(TPINIFILE,'RHOREFZ',XRHODREFZO)
+ CALL IO_Field_read(TPINIFILE,'THVREFZ',XTHVREFZO)
+ CALL IO_Field_read(TPINIFILE,'EXNTOP', XEXNTOPO)
+END IF
!-------------------------------------------------------------------------------
!
!* 3. SET REFERENCE STATE WITH OROGRAPHY
@@ -285,7 +293,13 @@ CALL MPPDB_CHECK3D(ZZM,"SET_REF::ZZM",PRECISION)
!
!* 3.2 Interpolation
!
-DO JI = 1,SIZE(PZZ,1)
+IF (LCOUPLES .AND. LOCEAN) THEN
+ DO JK = 1,IKU
+ PTHVREF(:,:,JK) = XTHVREFZO(JK)
+ PRHODREF(:,:,JK)= XRHODREFZO(JK)
+ END DO
+ELSE
+ DO JI = 1,SIZE(PZZ,1)
DO JJ = 1,SIZE(PZZ,2)
!
DO JK = 1,IKU
@@ -316,22 +330,21 @@ DO JI = 1,SIZE(PZZ,1)
END IF
END DO
END DO
-END DO
+ END DO
+END IF
!
! change the extrapolation option for the thvref field to be consistent with
! the extrapolation option for the flottability at the ground and for rhodref
! to be consistent with the extrapolation to compute a divergence
PTHVREF(:,:,IKB-1) = PTHVREF(:,:,IKB)
PRHODREF(:,:,IKB-1) = PRHODREF(:,:,IKB)
-
CALL MPPDB_CHECK3D(PTHVREF,"SET_REF::PTHVREF",PRECISION)
CALL MPPDB_CHECK3D(PRHODREF,"SET_REF::PRHODREF",PRECISION)
!
!-------------------------------------------------------------------------------
!
-!* 4. COMPUTE EXNER FUNCTION
-! ----------------------
-!
+!* 4. COMPUTE EXNER FUNCTION AT MASS GRID POINT
+! ----------------------------------------
IF (LCARTESIAN .OR. LTHINSHELL) THEN
ZD1=0.
ELSE
@@ -340,24 +353,56 @@ ENDIF
!
ZGSCPD = XG/XCPD
!
-PEXNREF(:,:,IKE)=(XEXNTOP*(1.+ZD1*2./7.*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE))/ &
- (XRADIUS+(PZZ(:,:,IKE+1)+ZZM(:,:,IKE))/2.)) &
- + ZGSCPD/PTHVREF(:,:,IKE)*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE)))/ &
-(1.-ZD1*2./7.*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE))/(XRADIUS+(PZZ(:,:,IKE+1)+ZZM(:,:,IKE))/2.))
+IF (LOCEAN) THEN
+!--------------------------------
+! Pressure at domain top (Flux point !!!) saved in Press_mass above the ocen sfc
+ IF (LCOUPLES) THEN
+ ZPMASS(:,:,IKE+1)= XP00 *XEXNTOPO**(XCPD/XRD)
+ ELSE
+ ZPMASS(:,:,IKE+1)= XP00 *XEXNTOP**(XCPD/XRD)
+ ENDIF
+ ZPMASS(:,:,IKE) = ZPMASS(:,:,IKE+1) +XG*PRHODREF(:,:,IKE)*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE))
+ DO JK = IKE-1,1,-1
+ ZPMASS(:,:,JK) = ZPMASS(:,:,JK+1) + XG * &
+ .5*(PRHODREF(:,:,JK)+ PRHODREF(:,:,JK+1)) * (ZZM(:,:,JK+1) -ZZM(:,:,JK))
+ END DO
+!
+ IF (LCOUPLES) THEN
+ DO JK = IKE+1, IKU
+! Pressure above domain top (i.e. ocean sfc), i.e. in atmosphere (should be not used)
+ ZPMASS(:,:,JK) = XP00 *XEXNTOPO**(XCPD/XRD)
+ END DO
+ ELSE
+ DO JK = IKE+1, IKU
+! Pressure above domain top (i.e. ocean sfc), i.e. in atmosphere (should be not used)
+ ZPMASS(:,:,JK) = XP00 *XEXNTOP**(XCPD/XRD)
+ END DO
+ ENDIF
+ PEXNREF(:,:,:)= (ZPMASS(:,:,:)/XP00)**(XRD/XCPD)
+ ! OCEAN end
+ELSE
+ ! ATMOSPHERE
+ PEXNREF(:,:,IKE)=(XEXNTOP*(1.+ZD1*2./7.*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE))/ &
+ (XRADIUS+(PZZ(:,:,IKE+1)+ZZM(:,:,IKE))/2.)) &
+ + ZGSCPD/PTHVREF(:,:,IKE)*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE)))/ &
+ (1.-ZD1*2./7.*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE))/(XRADIUS+(PZZ(:,:,IKE+1)+ZZM(:,:,IKE))/2.))
+!
+ DO JK = IKE-1, 1, -1
+ PEXNREF(:,:,JK)=(PEXNREF(:,:,JK+1)*(1.+ZD1*2./7.*(ZZM(:,:,JK+1) -ZZM(:,:,JK))/ &
+ (XRADIUS+PZZ(:,:,JK+1)))+ &
+ 2.*ZGSCPD/(PTHVREF(:,:,JK+1)+PTHVREF(:,:,JK))*(ZZM(:,:,JK+1) -ZZM(:,:,JK)))/&
+ (1.-ZD1*2./7.*(ZZM(:,:,JK+1) -ZZM(:,:,JK))/(XRADIUS+PZZ(:,:,JK+1)))
+ END DO
+!
+ DO JK = IKE+1, IKU
+ PEXNREF(:,:,JK)=(PEXNREF(:,:,JK-1)*(1.+ZD1*2./7.*(ZZM(:,:,JK-1) -ZZM(:,:,JK))/ &
+ (XRADIUS+PZZ(:,:,JK)))+ &
+ 2.*ZGSCPD/(PTHVREF(:,:,JK-1)+PTHVREF(:,:,JK))*(ZZM(:,:,JK-1) -ZZM(:,:,JK)))/&
+ (1.-ZD1*2./7.*(ZZM(:,:,JK-1) -ZZM(:,:,JK))/ (XRADIUS+PZZ(:,:,JK)))
+ END DO
!
-DO JK = IKE-1, 1, -1
- PEXNREF(:,:,JK)=(PEXNREF(:,:,JK+1)*(1.+ZD1*2./7.*(ZZM(:,:,JK+1) -ZZM(:,:,JK))/ &
- (XRADIUS+PZZ(:,:,JK+1)))+ &
- 2.*ZGSCPD/(PTHVREF(:,:,JK+1)+PTHVREF(:,:,JK))*(ZZM(:,:,JK+1) -ZZM(:,:,JK)))/&
- (1.-ZD1*2./7.*(ZZM(:,:,JK+1) -ZZM(:,:,JK))/(XRADIUS+PZZ(:,:,JK+1)))
-END DO
+END IF
!
-DO JK = IKE+1, IKU
- PEXNREF(:,:,JK)=(PEXNREF(:,:,JK-1)*(1.+ZD1*2./7.*(ZZM(:,:,JK-1) -ZZM(:,:,JK))/ &
- (XRADIUS+PZZ(:,:,JK)))+ &
- 2.*ZGSCPD/(PTHVREF(:,:,JK-1)+PTHVREF(:,:,JK))*(ZZM(:,:,JK-1) -ZZM(:,:,JK)))/&
- (1.-ZD1*2./7.*(ZZM(:,:,JK-1) -ZZM(:,:,JK))/ (XRADIUS+PZZ(:,:,JK)))
-END DO
!
CALL MPPDB_CHECK3D(PEXNREF,"SET_REF::PEXNREF",PRECISION)
!-------------------------------------------------------------------------------
@@ -372,8 +417,8 @@ IF (LBOUSS) THEN
ELSE
ZRHOREF(:,:,:) = PEXNREF(:,:,:) ** ZCVD_O_RD * XP00 / ( XRD * PTHVREF(:,:,:) )
ZRHOREF(:,:,1)=ZRHOREF(:,:,2) ! this avoids to obtain erroneous values for
+ ! rv at this last point
END IF
- ! rv at this last point
!
IF ( CEQNSYS == 'DUR' ) THEN
IF ( SIZE(PRVREF,1) == 0 ) THEN
@@ -402,8 +447,6 @@ CALL CLEANLIST_ll(TZFIELDS_ll)
CALL MPPDB_CHECK3D(ZRHOREF,"SET_REF::ZRHOREF",PRECISION)
IF ( SIZE(PRVREF,1) /= 0 ) CALL MPPDB_CHECK3D(PRVREF,"SET_REF::PRVREF",PRECISION)
CALL MPPDB_CHECK3D(PRHODJ,"SET_REF::PRHODJ",PRECISION)
-
-
!
!* 6. COMPUTES THE TOTAL MASS OF REFERENCE ATMOSPHERE
! -----------------------------------------------
@@ -480,7 +523,7 @@ IF ( HLBCY(1)=='OPEN' ) THEN
ENDDO
ENDIF
PLINMASS = PLINMASS + SUM_DD_R2_ll(ZLINMASS_S_2D)
-!
+ !
ALLOCATE( ZLINMASS_N_2D(IIB:IIE,IJE+1:IJE+1))
ZLINMASS_N_2D = 0.0
IF (LNORTH_ll(HSPLITTING='B')) THEN
diff --git a/src/MNH/set_rsou.f90 b/src/MNH/set_rsou.f90
index 353c6298bd02baa8db936c4df60565fc4235c013..23423e8b01178ae7d5fb010d2e182a45ddcffe16 100644
--- a/src/MNH/set_rsou.f90
+++ b/src/MNH/set_rsou.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -102,7 +102,17 @@ END MODULE MODI_SET_RSOU
! (Pressure, U, V) ,
! (Pressure, T, Hu)
!
+! For ocean-LES case the following kind of data is permitted
+!
+! YKIND = 'IDEALOCE' : ZGROUND (Water depth),PGROUND(Sfc Atmos Press),
+! TGROUND (SST), RGROUND (SSS)
+! (Depth , U, V) starting from sfc
+! (Depth, T, S)
+! (Time, LE, H, SW_d,SW_u,LW_d,LW_u,Stress_X,Stress_Y)
!
+! YKIND = 'STANDOCE' : (Depth , Temp, Salinity, U, V) starting from sfc
+! (Time, LE, H, SW_d,SW_u,LW_d,LW_u,Stress_X,Stress_Y)
+!
!!** METHOD
!! ------
!! The radiosounding is first read, then data are converted in order to
@@ -242,6 +252,7 @@ END MODULE MODI_SET_RSOU
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
+! JL Redelsperger 01/2021: Ocean LES cases added
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -250,11 +261,16 @@ END MODULE MODI_SET_RSOU
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_FIELD_n
USE MODD_GRID
USE MODD_GRID_n
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NETCDF
+USE MODD_OCEANH
USE MODD_PARAMETERS, ONLY: JPHEXT
+USE MODD_TYPE_DATE
!
USE MODE_ll
USE MODE_MSG
@@ -269,6 +285,8 @@ USE MODI_THETAVPU_THETAVPM
USE MODI_TH_R_FROM_THL_RT_1D
USE MODI_VERT_COORD
!
+USE NETCDF ! for reading the NR files
+!
IMPLICIT NONE
!
!
@@ -291,10 +309,15 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ ! jacobien
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: ILUPRE ! logical unit number
-!
-! variables read in EXPRE file at the RS levels
-!
+INTEGER :: ILUPRE ! logical unit number of the EXPRE return code
+INTEGER :: ILUOUT ! Logical unit number for output-listing
+! local variables for reading sea sfc flux forcing for ocean model
+INTEGER :: IFRCLT
+REAL, DIMENSION(:), ALLOCATABLE :: ZSSUFL_T,ZSSVFL_T,ZSSTFL_T,ZSSOLA_T !
+TYPE (DATE_TIME), DIMENSION(:), ALLOCATABLE :: ZFRCLT ! date/time of sea surface forcings
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! variables read in EXPRE file at the RS/CTD levels
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
CHARACTER(LEN=8) :: YKIND ! Kind of variables in
! EXPRE FILE
INTEGER :: ILEVELU ! number of wind levels
@@ -332,7 +355,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZLSOCPEXN
REAL, DIMENSION(SIZE(XZHAT)) :: ZZFLUX_PROFILE ! altitude of flux points on the initialization columns
REAL, DIMENSION(SIZE(XZHAT)) :: ZZMASS_PROFILE ! altitude of mass points on the initialization columns
!
-! fieds on the grid of the model without orography
+! fields on the grid of the model without orography
!
REAL, DIMENSION(SIZE(XZHAT)) :: ZUW,ZVW ! Wind at w model grid levels
REAL, DIMENSION(SIZE(XZHAT)) :: ZMRM ! vapor mixing ratio at mass model
@@ -341,19 +364,22 @@ REAL, DIMENSION(SIZE(XZHAT)) :: ZMRCM,ZMRIM
REAL, DIMENSION(SIZE(XZHAT)) :: ZTHVM ! Temperature at mass model grid levels
REAL, DIMENSION(SIZE(XZHAT)) :: ZTHLM ! Thetal at mass model grid levels
REAL, DIMENSION(SIZE(XZHAT)) :: ZTHM ! Thetal at mass model grid levels
+REAL, DIMENSION(SIZE(XZHAT)) :: ZRHODM ! density at mass model grid level
REAL, DIMENSION(:), ALLOCATABLE :: ZMRT ! Total Vapor mixing ratio at mass levels on mixed grid
REAL, DIMENSION(:), ALLOCATABLE :: ZEXNMASS ! exner fonction at mass level
REAL, DIMENSION(:), ALLOCATABLE :: ZEXNFLUX ! exner fonction at flux level
REAL :: ZEXNSURF ! exner fonction at surface
+REAL, DIMENSION(:), ALLOCATABLE :: ZPREFLUX ! pressure at flux model grid level
REAL, DIMENSION(:), ALLOCATABLE :: ZFRAC_ICE ! ice fraction
REAL, DIMENSION(:), ALLOCATABLE :: ZRSATW, ZRSATI
REAL :: ZDZSDH,ZDZ1SDH,ZDZ2SDH ! interpolation
! working arrays
!
-INTEGER :: JK,JKLEV, JKU,JKM ! Loop indexes
+INTEGER :: JK,JKLEV,JKU,JKM,JKT,JJ,JI,JO,JLOOP ! Loop indexes
INTEGER :: IKU ! Upper bound in z direction
REAL :: ZRDSCPD,ZRADSDG, & ! Rd/Cpd, Pi/180.,
- ZRVSRD,ZRDSRV ! Rv/Rd, Rd/Rv
+ ZRVSRD,ZRDSRV, & ! Rv/Rd, Rd/Rv
+ ZPTOP ! Pressure at domain top
LOGICAL :: GUSERC ! use of input data cloud
INTEGER :: IIB, IIE, IJB, IJE
INTEGER :: IXOR_ll, IYOR_ll
@@ -362,8 +388,18 @@ LOGICAL :: GPROFILE_IN_PROC ! T : initialization profile is in current
!
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) ::ZZS_LS
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) ::ZZFLUX_MX,ZZMASS_MX ! mixed grid
-INTEGER :: JLOOP
!-------------------------------------------------------------------------------
+! For standard ocean version, reading external files
+CHARACTER(LEN=256) :: yinfile, yinfisf ! files to be read
+INTEGER :: INZ, INLATI, INLONGI, IDX
+INTEGER(KIND=CDFINT) :: incid, ivarid, idimid, idimlen
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOC_TEMPERATURE,ZOC_SALINITY,ZOC_U,ZOC_V
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_DEPTH
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_LE,ZOC_H
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_SW_DOWN,ZOC_SW_UP,ZOC_LW_DOWN,ZOC_LW_UP
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_TAUX,ZOC_TAUY
+
+!--------------------------------------------------------------------------------
!
!* 1. PROLOGUE : INITIALIZE SOME CONSTANTS, RETRIEVE LOGICAL
! UNIT NUMBERS AND READ KIND OF DATA IN EXPRE FILE
@@ -380,31 +416,21 @@ ZRVSRD = XRV/XRD
ZRDSRV = XRD/XRV
!
!* 1.2 Retrieve logical unit numbers
-!
-!
+!
ILUPRE = TPEXPREFILE%NLU
+ILUOUT = TLUOUT%NLU
!
!* 1.3 Read data kind in EXPRE file
!
READ(ILUPRE,*) YKIND
-!
+WRITE(ILUOUT,*) 'YKIND read in set_rsou: ', YKIND
!
IF(LUSERC .AND. YKIND/='PUVTHDMR' .AND. YKIND/='ZUVTHDMR' .AND. YKIND/='ZUVTHLMR') THEN
CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','hydrometeors are not allowed for YKIND = '//trim(YKIND))
ENDIF
-! Demande Thierry Bergot Sept 2012
-!IF(LUSERC .AND.(YKIND == 'PUVTHDMR' .OR. YKIND == 'ZUVTHDMR').AND. .NOT. L1D) THEN
-! !callabortstop
-! CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','use of hydrometeors for YKIND=P(Z)UVTHDMR is only allowed in 1D case')
-!ENDIF
-!
-!IF(LUSERI .AND. YKIND=='ZUVTHLMR') THEN
-! !callabortstop
-! CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','use of ice for YKIND=ZUVTHLMR is not allowed')
-!ENDIF
!
IF(YKIND=='ZUVTHLMR' .AND. .NOT. LUSERC) THEN
- !callabortstop
+!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','LUSERC=T is required for YKIND=ZUVTHLMR')
ENDIF
!
@@ -416,8 +442,347 @@ IF(LUSERC .AND. (YKIND == 'PUVTHDMR' .OR. YKIND == 'ZUVTHDMR')) GUSERC=.TRUE.
! --------------------------------------------------------
!
SELECT CASE(YKIND)
+!
+! 2.0.1 Ocean case 1
+!
+ CASE ('IDEALOCE')
+!
+ XP00=XP00OCEAN
+ ! Read data in PRE_IDEA1.nam
+ ! Surface
+ WRITE(ILUOUT,FMT=*) 'Reading data for ideal ocean :IDEALOCE'
+ READ(ILUPRE,*) ZPTOP ! P_atmosphere at sfc =P top domain
+ READ(ILUPRE,*) ZTGROUND ! SST
+ READ(ILUPRE,*) ZMRGROUND ! SSS
+ WRITE(ILUOUT,FMT=*) 'Patm SST SSS', ZPTOP,ZTGROUND,ZMRGROUND
+ READ(ILUPRE,*) ILEVELU ! Read number of Current levels
+ ! Allocate required memory
+ ALLOCATE(ZHEIGHTU(ILEVELU),ZU(ILEVELU),ZV(ILEVELU))
+ ALLOCATE(ZOC_U(ILEVELU,1,1),ZOC_V(ILEVELU,1,1))
+ WRITE(ILUOUT,FMT=*) 'Level number for Current in data', ILEVELU
+ ! Read U and V at each wind level
+ DO JKU = 1,ILEVELU
+ READ(ILUPRE,*) ZHEIGHTU(JKU),ZOC_U(JKU,1,1),ZOC_V(JKU,1,1)
+ ! WRITE(ILUOUT,FMT=*) 'Leveldata D(m) under sfc: U_cur, V_cur', JKU, ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+ DO JKU=1,ILEVELU
+ ! Z axis reoriented as in the model
+ IDX = ILEVELU-JKU+1
+ ZU(JKU) = ZOC_U(IDX,1,1)
+ ZV(JKU) = ZOC_V(IDX,1,1)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ ! Z oriented in same time to have a model domain axis going
+ ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
+ END DO
+ ! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+ ! Allocate required memory
+ ALLOCATE(ZOC_DEPTH(ILEVELM))
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM),ZTH(ILEVELM),ZTHV(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM),ZRT(ILEVELM))
+ ALLOCATE(ZOC_TEMPERATURE(ILEVELM,1,1),ZOC_SALINITY(ILEVELM,1,1))
+ ! Read T and S at each mass level
+ DO JKM= 2,ILEVELM
+ READ(ILUPRE,*) ZOC_DEPTH(JKM),ZOC_TEMPERATURE(JKM,1,1),ZOC_SALINITY(JKM,1,1)
+ END DO
+ ! Complete the mass arrays with the ground informations read in EXPRE file
+ ZOC_DEPTH(1) = 0.
+ ZOC_TEMPERATURE(1,1,1)= ZTGROUND
+ ZOC_SALINITY(1,1,1)= ZMRGROUND
+ !!!!!!!!!!!!!!!!!!!!!!!!Inversing Axis!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Going from the data (axis downward i.e inverse model) grid to the model grid (axis upward)
+ ! Uniform bathymetry; depth goes from ocean sfc downwards (data grid)
+ ! ZHEIGHT goes from the model domain bottom up to the sfc ocean (top of model domain)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ZZGROUND = 0.
+ ZTGROUND = ZOC_TEMPERATURE(ILEVELM,1,1)
+ ZMRGROUND = ZOC_SALINITY(ILEVELM,1,1)
+ DO JKM= 1,ILEVELM
+ ! Z upward axis (oriented as in the model), i.e.
+ ! going from 0m (ocean bottom/model bottom) upward to H (ocean sfc/model top)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ IDX = ILEVELM-JKM+1
+ ZTH(JKM) = ZOC_TEMPERATURE(IDX,1,1)
+ ZMR(JKM) = ZOC_SALINITY(IDX,1,1)
+ ZHEIGHTM(JKM)= ZOC_DEPTH(ILEVELM)- ZOC_DEPTH(IDX)
+ WRITE(ILUOUT,FMT=*) 'Model oriented initial data: JKM IDX depth T S ZHEIGHTM', &
+ JKM,IDX,ZOC_DEPTH(IDX),ZTH(JKM),ZMR(JKM),ZHEIGHTM(JKM)
+ END DO
+ ! mass levels of the RS
+ ZTHV = ZTH ! TV==THETA=TL
+ ZTHL = ZTH
+ ZRT = ZMR
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! READ Sea Surface Forcing !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Reading the forcings from prep_idea1.nam
+ READ(ILUPRE,*) IFRCLT ! Number of time-dependent forcing
+ IF (IFRCLT > 99*8) THEN
+ ! CAUTION: number of forcing times is limited by the WRITE format 99(8E10.3)
+ ! and also by the name of forcing variables (format I3.3)
+ ! You have to modify those if you need more forcing times
+ CALL PRINT_MSG(NVERB_FATAL,'IO','SET_RSOU','maximum forcing times NFRCLT is 99*8')
+ END IF
+!
+ WRITE(UNIT=ILUOUT,FMT='(" THERE ARE ",I2," SFC FLUX FORCINGs AT:")') IFRCLT
+ ALLOCATE(ZFRCLT(IFRCLT))
+ ALLOCATE(ZSSUFL_T(IFRCLT)); ZSSUFL_T = 0.0
+ ALLOCATE(ZSSVFL_T(IFRCLT)); ZSSVFL_T = 0.0
+ ALLOCATE(ZSSTFL_T(IFRCLT)); ZSSTFL_T = 0.0
+ ALLOCATE(ZSSOLA_T(IFRCLT)); ZSSOLA_T = 0.0
+ DO JKT = 1,IFRCLT
+ WRITE(ILUOUT,FMT='(A, I4)') "SET_RSOU/Reading Sea Surface forcing: Number=", JKT
+ READ(ILUPRE,*) ZFRCLT(JKT)%nyear, ZFRCLT(JKT)%nmonth, &
+ ZFRCLT(JKT)%nday, ZFRCLT(JKT)%xtime
+ READ(ILUPRE,*) ZSSUFL_T(JKT)
+ READ(ILUPRE,*) ZSSVFL_T(JKT)
+ READ(ILUPRE,*) ZSSTFL_T(JKT)
+ READ(ILUPRE,*) ZSSOLA_T(JKT)
+ END DO
+!
+ DO JKT = 1 , IFRCLT
+ WRITE(UNIT=ILUOUT,FMT='(F9.0, "s, date:", I3, "/", I3, "/", I5)') &
+ ZFRCLT(JKT)%xtime, ZFRCLT(JKT)%nday, &
+ ZFRCLT(JKT)%nmonth, ZFRCLT(JKT)%nyear
+ END DO
+ NINFRT= INT(ZFRCLT(2)%xtime)
+ WRITE(ILUOUT,FMT='(A)') &
+ "Number U-Stress, V-Stress, Heat turb Flux, Solar Flux Interval(s)",NINFRT
+ DO JKT = 1, IFRCLT
+ WRITE(ILUOUT,FMT='(I10,99(3F10.2))') JKT, ZSSUFL_T(JKT),ZSSVFL_T(JKT),ZSSTFL_T(JKT)
+ END DO
+ NFRCLT = IFRCLT
+ ALLOCATE(TFRCLT(NFRCLT))
+ ALLOCATE(XSSUFL_T(NFRCLT));XSSUFL_T(:)=0.
+ ALLOCATE(XSSVFL_T(NFRCLT));XSSVFL_T(:)=0.
+ ALLOCATE(XSSTFL_T(NFRCLT));XSSTFL_T(:)=0.
+ ALLOCATE(XSSOLA_T(NFRCLT));XSSOLA_T(:)=0.
+!
+ DO JKT=1,NFRCLT
+ TFRCLT(JKT)= ZFRCLT(JKT)
+ XSSUFL_T(JKT)=ZSSUFL_T(JKT)/XRH00OCEAN
+ XSSVFL_T(JKT)=ZSSVFL_T(JKT)/XRH00OCEAN
+ ! working in SI
+ XSSTFL_T(JKT)=ZSSTFL_T(JKT) /(3900.*XRH00OCEAN)
+ XSSOLA_T(JKT)=ZSSOLA_T(JKT) /(3900.*XRH00OCEAN)
+ END DO
+ DEALLOCATE(ZFRCLT)
+ DEALLOCATE(ZSSUFL_T)
+ DEALLOCATE(ZSSVFL_T)
+ DEALLOCATE(ZSSTFL_T)
+ DEALLOCATE(ZSSOLA_T)
+!
+!--------------------------------------------------------------------------------
+! 2.0.2 Ocean standard initialize from netcdf files
+! U,V,T,S at Z levels + Forcings at model TOP (sea surface)
+!--------------------------------------------------------------------------------
+!
+ CASE ('STANDOCE')
+!
+ XP00=XP00OCEAN
+ READ(ILUPRE,*) ZPTOP ! P_atmosphere at sfc =P top domain
+ READ(ILUPRE,*) YINFILE, YINFISF
+ WRITE(ILUOUT,FMT=*) 'Netcdf files to read:', YINFILE, YINFISF
+ ! Open file containing initial profiles
+ CALL check(nf90_open(yinfile,NF90_NOWRITE,incid), "opening NC file")
+ ! Reading dimensions and lengths
+ CALL check( nf90_inq_dimid(incid, "depth",idimid), "getting depth dimension id" )
+ CALL check( nf90_inquire_dimension(incid, idimid, len=INZ), "getting INZ " )
+ CALL check( nf90_inquire_dimension(incid, 2, len=INLONGI), "getting NLONG " )
+ CALL check( nf90_inquire_dimension(incid, 1, len=INLATI), "getting NLAT " )
+!
+ WRITE(ILUOUT,FMT=*) 'NB LEVLS READ INZ, NLONG NLAT ', INZ, INLONGI,INLATI
+ ALLOCATE(ZOC_TEMPERATURE(INLATI,INLONGI,INZ),ZOC_SALINITY(INLATI,INLONGI,INZ))
+ ALLOCATE(ZOC_U(INLATI,INLONGI,INZ),ZOC_V(INLATI,INLONGI,INZ))
+ ALLOCATE(ZOC_DEPTH(INZ))
+ WRITE(ILUOUT,FMT=*) 'NETCDF READING ==> Temp'
+ CALL check(nf90_inq_varid(incid,"temperature",ivarid), "getting temp ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_TEMPERATURE), "reading temp")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> salinity'
+ CALL check(nf90_inq_varid(incid,"salinity",ivarid), "getting salinity ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_SALINITY), "reading salinity")
+ WRITE(ILUOUT,FMT=*) 'Netcdf ==> Reading depth'
+ CALL check(nf90_inq_varid(incid,"depth",ivarid), "getting depth ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_DEPTH), "reading depth")
+ WRITE(ILUOUT,FMT=*) 'depth: max min ', MAXVAL(ZOC_DEPTH),MINVAL(ZOC_DEPTH)
+ WRITE(ILUOUT,FMT=*) 'depth 1 nz: ', ZOC_DEPTH(1),ZOC_DEPTH(INZ)
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> Currents'
+ CALL check(nf90_inq_varid(incid,"u",ivarid), "getting u ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_U), "reading u")
+ CALL check(nf90_inq_varid(incid,"v",ivarid), "getting v ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_V), "reading v")
+ CALL check(nf90_close(incid), "closing yinfile")
+ WRITE(ILUOUT,FMT=*) 'End of initial file reading'
+!
+ DO JKM=1,INZ
+ ZOC_TEMPERATURE(1,1,JKM)=ZOC_TEMPERATURE(1,1,JKM)+273.15
+ WRITE(ILUOUT,FMT=*) 'Z T(Kelvin) S(Sverdup) U V K',&
+ JKM,ZOC_DEPTH(JKM),ZOC_TEMPERATURE(1,1,JKM),ZOC_SALINITY(1,1,JKM),ZOC_U(1,1,JKM),ZOC_V(1,1,JKM), JKM
+ ENDDO
+ ! number of data levels
+ ILEVELM=INZ
+ ! Model bottom
+ ZTGROUND = ZOC_TEMPERATURE(1,1,ILEVELM)
+ ZMRGROUND = ZOC_SALINITY(1,1,ILEVELM)
+ ZZGROUND=0.
+ ! Allocate required memory
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZT(ILEVELM))
+ ALLOCATE(ZTV(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+ ! Going from the inverse model grid (data) to the normal one
+ DO JKM= 1,ILEVELM
+ ! Z axis reoriented as in the model
+ IDX = ILEVELM-JKM+1
+ ZT(JKM) = ZOC_TEMPERATURE(1,1,IDX)
+ ZMR(JKM) = ZOC_SALINITY(1,1,IDX)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ ! Z oriented in same time to have a model domain axis going
+ ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
+ ! translation/inversion
+ ZHEIGHTM(JKM) = -ZOC_DEPTH(IDX) + ZOC_DEPTH(ILEVELM)
+ WRITE(ILUOUT,FMT=*) 'End gridmodel comput: JKM IDX depth T S ZHEIGHTM', &
+ JKM,IDX,ZOC_DEPTH(IDX),ZT(JKM),ZMR(JKM),ZHEIGHTM(JKM)
+ END DO
+ ! complete ther variables
+ ZTV = ZT
+ ZTHV = ZT
+ ZRT = ZMR
+ ZTHL = ZT
+ ZTH = ZT
+ ! INIT --- U V -----
+ ILEVELU = INZ ! Same nb of levels for u,v,T,S
+ !Assume that current and temp are given at same level
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+ ZHEIGHTU=ZHEIGHTM
+ DO JKM= 1,ILEVELU
+ ! Z axis reoriented as in the model
+ IDX = ILEVELU-JKM+1
+ ZU(JKM) = ZOC_U(1,1,IDX)
+ ZV(JKM) = ZOC_V(1,1,IDX)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ ! Z oriented in same time to have a model domain axis going
+ ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
+ END DO
!
-!* 2.1 STANDARD case : ZGROUND, PGROUND, TGROUND, TDGROUND
+ DEALLOCATE(ZOC_TEMPERATURE)
+ DEALLOCATE(ZOC_SALINITY)
+ DEALLOCATE(ZOC_U)
+ DEALLOCATE(ZOC_V)
+ DEALLOCATE(ZOC_DEPTH)
+!
+ ! Reading/initializing surface forcings
+!
+ WRITE(ILUOUT,FMT=*) 'netcdf sfc forcings file to be read:',yinfisf
+ ! Open of sfc forcing file
+ CALL check(nf90_open(yinfisf,NF90_NOWRITE,incid), "opening NC file")
+ ! Reading dimension and length
+ CALL check( nf90_inq_dimid(incid,"t",idimid), "getting time dimension id" )
+ CALL check( nf90_inquire_dimension(incid, idimid, len=idimlen), "getting idimlen " )
+!
+ WRITE(ILUOUT,FMT=*) 'nb sfc-forcing time idimlen=',idimlen
+ ALLOCATE(ZOC_LE(idimlen))
+ ALLOCATE(ZOC_H(idimlen))
+ ALLOCATE(ZOC_SW_DOWN(idimlen))
+ ALLOCATE(ZOC_SW_UP(idimlen))
+ ALLOCATE(ZOC_LW_DOWN(idimlen))
+ ALLOCATE(ZOC_LW_UP(idimlen))
+ ALLOCATE(ZOC_TAUX(idimlen))
+ ALLOCATE(ZOC_TAUY(idimlen))
+!
+ WRITE(ILUOUT,FMT=*)'Netcdf Reading ==> LE'
+ CALL check(nf90_inq_varid(incid,"LE",ivarid), "getting LE ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_LE), "reading LE flux")
+ WRITE(ILUOUT,FMT=*)'Netcdf Reading ==> H'
+ CALL check(nf90_inq_varid(incid,"H",ivarid), "getting H ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_H), "reading H flux")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> SW_DOWN'
+ CALL check(nf90_inq_varid(incid,"SW_DOWN",ivarid), "getting SW_DOWN ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_SW_DOWN), "reading SW_DOWN")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> SW_UP'
+ CALL check(nf90_inq_varid(incid,"SW_UP",ivarid), "getting SW_UP ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_SW_UP), "reading SW_UP")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> LW_DOWN'
+ CALL check(nf90_inq_varid(incid,"LW_DOWN",ivarid), "getting LW_DOWN ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_LW_DOWN), "reading LW_DOWN")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> LW_UP'
+ CALL check(nf90_inq_varid(incid,"LW_UP",ivarid), "getting LW_UP ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_LW_UP), "reading LW_UP")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> TAUX'
+ CALL check(nf90_inq_varid(incid,"TAUX",ivarid), "getting TAUX ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_TAUX), "reading TAUX")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> TAUY'
+ CALL check(nf90_inq_varid(incid,"TAUY",ivarid), "getting TAUY ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_TAUY), "reading TAUY")
+ CALL check(nf90_close(incid), "closing yinfifs")
+!
+ WRITE(ILUOUT,FMT=*) ' Forcing-Number LE H SW_down SW_up LW_down LW_up TauX TauY'
+ DO JKM = 1, idimlen
+ WRITE(ILUOUT,FMT=*) JKM, ZOC_LE(JKM), ZOC_H(JKM),ZOC_SW_DOWN(JKM),ZOC_SW_UP(JKM),&
+ ZOC_LW_DOWN(JKM),ZOC_LW_UP(JKM),ZOC_TAUX(JKM),ZOC_TAUY(JKM)
+ ENDDO
+ ! IFRCLT FORCINGS at sea surface
+ IFRCLT=idimlen
+ ALLOCATE(ZFRCLT(IFRCLT))
+ ALLOCATE(ZSSUFL_T(IFRCLT)); ZSSUFL_T = 0.0
+ ALLOCATE(ZSSVFL_T(IFRCLT)); ZSSVFL_T = 0.0
+ ALLOCATE(ZSSTFL_T(IFRCLT)); ZSSTFL_T = 0.0
+ ALLOCATE(ZSSOLA_T(IFRCLT)); ZSSOLA_T = 0.0
+ DO JKT=1,IFRCLT
+ ! Initial file for CINDY-DYNAMO: all fluxes correspond to the absolute value (>0)
+ ! modele ocean: axe z dirigé du bas vers la sfc de l'océan
+ ! => flux dirigé vers le haut (positif ocean vers l'atmopshere i.e. bas vers le haut)
+ ZSSOLA_T(JKT)=ZOC_SW_DOWN(JKT)-ZOC_SW_UP(JKT)
+ ZSSTFL_T(JKT)=(ZOC_LW_DOWN(JKT)-ZOC_LW_UP(JKT)-ZOC_LE(JKT)-ZOC_H(JKT))
+ ! assume that Tau given on file is along Ox
+ ! rho_air UW_air = rho_ocean UW_ocean= N/m2
+ ! uw_ocean
+ ZSSUFL_T(JKT)=ZOC_TAUX(JKT)
+ ZSSVFL_T(JKT)=ZOC_TAUY(JKT)
+ WRITE(ILUOUT,FMT=*) 'Forcing Nb Sol NSol UW_oc VW',&
+ JKT,ZSSOLA_T(JKT),ZSSTFL_T(JKT),ZSSUFL_T(JKT),ZSSVFL_T(JKT)
+ ENDDO
+ ! Allocate and Writing the corresponding variables in module MODD_OCEAN_FRC
+ NFRCLT=IFRCLT
+ ! value to read later on file ?
+ NINFRT=600
+ ALLOCATE(TFRCLT(NFRCLT))
+ ALLOCATE(XSSUFL_T(NFRCLT));XSSUFL_T(:)=0.
+ ALLOCATE(XSSVFL_T(NFRCLT));XSSVFL_T(:)=0.
+ ALLOCATE(XSSTFL_T(NFRCLT));XSSTFL_T(:)=0.
+ ALLOCATE(XSSOLA_T(NFRCLT));XSSOLA_T(:)=0.
+ ! on passe en unités SI, signe, etc pour le modele ocean
+ ! W/m2 => SI : /(CP_mer * rho_mer)
+ ! a revoir dans tt le code pour mettre de svaleurs plus exactes
+ DO JKT=1,NFRCLT
+ TFRCLT(JKT)= ZFRCLT(JKT)
+ XSSUFL_T(JKT)=ZSSUFL_T(JKT)/XRH00OCEAN
+ XSSVFL_T(JKT)=ZSSVFL_T(JKT)/XRH00OCEAN
+ XSSTFL_T(JKT)=ZSSTFL_T(JKT) /(3900.*XRH00OCEAN)
+ XSSOLA_T(JKT)=ZSSOLA_T(JKT) /(3900.*XRH00OCEAN)
+ END DO
+ DEALLOCATE(ZFRCLT)
+ DEALLOCATE(ZSSUFL_T)
+ DEALLOCATE(ZSSVFL_T)
+ DEALLOCATE(ZSSTFL_T)
+ DEALLOCATE(ZSSOLA_T)
+ DEALLOCATE(ZOC_LE)
+ DEALLOCATE(ZOC_H)
+ DEALLOCATE(ZOC_SW_DOWN)
+ DEALLOCATE(ZOC_SW_UP)
+ DEALLOCATE(ZOC_LW_DOWN)
+ DEALLOCATE(ZOC_LW_UP)
+ DEALLOCATE(ZOC_TAUX)
+ DEALLOCATE(ZOC_TAUY)
+ ! END OCEAN STANDARD
+!
+!
+!* 2.1 ATMOSPHERIC STANDARD case : ZGROUND, PGROUND, TGROUND, TDGROUND
! (Pressure, dd, ff) ,
! (Pressure, T, Td)
!
@@ -448,8 +813,7 @@ SELECT CASE(YKIND)
ALLOCATE(ZHEIGHTM(ILEVELM)) ! Allocate memory for needed
ALLOCATE(ZTHV(ILEVELM)) ! arrays
ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZTV(ILEVELM)) ! Allocate memory for intermediate
- ! arrays
+ ALLOCATE(ZTV(ILEVELM)) ! Allocate memory for intermediate arrays
ALLOCATE(ZTHL(ILEVELM))
ALLOCATE(ZRT(ILEVELM))
!
@@ -1203,20 +1567,36 @@ END DO
ALLOCATE(ZEXNFLUX(IKU))
ALLOCATE(ZEXNMASS(IKU))
ALLOCATE(ZPRESS(IKU))
+ALLOCATE(ZPREFLUX(IKU))
ALLOCATE(ZFRAC_ICE(IKU))
ALLOCATE(ZRSATW(IKU))
ALLOCATE(ZRSATI(IKU))
ALLOCATE(ZMRT(IKU))
ZMRT=ZMRM+ZMRCM+ZMRIM
-ZEXNSURF=(ZPGROUND/XP00)**(XRD/XCPD)
ZTHVM=ZTHLM
-DO JLOOP=1,20 ! loop for pression
- CALL COMPUTE_EXNER_FROM_GROUND(ZTHVM,ZZMASS_PROFILE(:),ZEXNSURF,ZEXNFLUX,ZEXNMASS)
- ZPRESS(:)=XP00*(ZEXNMASS(:))**(XCPD/XRD)
- CALL TH_R_FROM_THL_RT_1D('T',ZFRAC_ICE,ZPRESS,ZTHLM,ZMRT,ZTHM,ZMRM,ZMRCM,ZMRIM, &
- ZRSATW, ZRSATI)
- ZTHVM(:)=ZTHM(:)*(1.+XRV/XRD*ZMRM(:))/(1.+(ZMRM(:)+ZMRIM(:)+ZMRCM(:)))
-ENDDO
+!
+IF (LOCEAN) THEN
+ ZRHODM(:)=XRH00OCEAN*(1.-XALPHAOC*(ZTHLM(:) - XTH00OCEAN)&
+ +XBETAOC* (ZMRM(:) - XSA00OCEAN))
+ ZPREFLUX(IKU)=ZPTOP
+ DO JK=IKU-1,2,-1
+ ZPREFLUX(JK) = ZPREFLUX(JK+1) + XG*ZRHODM(JK)*(ZZFLUX_PROFILE(JK+1)-ZZFLUX_PROFILE(JK))
+ END DO
+ ZPGROUND=ZPREFLUX(2)
+ WRITE(ILUOUT,FMT=*)'ZPGROUND i.e. Pressure at ocean domain bottom',ZPGROUND
+ ZTHM=ZTHVM
+ELSE
+! Atmospheric case
+ ZEXNSURF=(ZPGROUND/XP00)**(XRD/XCPD)
+ DO JLOOP=1,20 ! loop for pression
+ CALL COMPUTE_EXNER_FROM_GROUND(ZTHVM,ZZMASS_PROFILE(:),ZEXNSURF,ZEXNFLUX,ZEXNMASS)
+ ZPRESS(:)=XP00*(ZEXNMASS(:))**(XCPD/XRD)
+ CALL TH_R_FROM_THL_RT_1D('T',ZFRAC_ICE,ZPRESS,ZTHLM,ZMRT,ZTHM,ZMRM,ZMRCM,ZMRIM, &
+ ZRSATW, ZRSATI)
+ ZTHVM(:)=ZTHM(:)*(1.+XRV/XRD*ZMRM(:))/(1.+(ZMRM(:)+ZMRIM(:)+ZMRCM(:)))
+ ENDDO
+ENDIF
+!
DEALLOCATE(ZEXNFLUX)
DEALLOCATE(ZEXNMASS)
DEALLOCATE(ZPRESS)
@@ -1224,7 +1604,6 @@ DEALLOCATE(ZFRAC_ICE)
DEALLOCATE(ZRSATW)
DEALLOCATE(ZRSATI)
DEALLOCATE(ZMRT)
-
!-------------------------------------------------------------------------------
!
!* 4. COMPUTE FIELDS ON THE MODEL GRID (WITH OROGRAPHY)
@@ -1234,6 +1613,20 @@ CALL SET_MASS(TPFILE,GPROFILE_IN_PROC, ZZFLUX_PROFILE, &
ZTHVM,ZMRM,ZUW,ZVW,OSHIFT,OBOUSS,PJ,HFUNU,HFUNV, &
PMRCM=ZMRCM,PMRIM=ZMRIM,PCORIOZ=PCORIOZ)
!
+DEALLOCATE(ZPREFLUX)
+DEALLOCATE(ZHEIGHTM)
+DEALLOCATE(ZTHV)
+DEALLOCATE(ZMR)
+DEALLOCATE(ZTHL)
!-------------------------------------------------------------------------------
+CONTAINS
+ SUBROUTINE CHECK( ISTATUS, YLOC )
+ INTEGER(KIND=CDFINT), INTENT(IN) :: ISTATUS
+ CHARACTER(LEN=*), INTENT(IN) :: YLOC
+
+ IF( ISTATUS /= NF90_NOERR ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'IO', 'SET_RSOU', 'error at ' // Trim( yloc) // ': ' // NF90_STRERROR( ISTATUS ) )
+ END IF
+ END SUBROUTINE check
!
END SUBROUTINE SET_RSOU
diff --git a/src/MNH/shallow_mf.f90 b/src/MNH/shallow_mf.f90
index 26b53e19d7778582162b2f6d076be2f350d2e890..2ae315ad50a14bfbde7b9d63aa515abfd3646b0a 100644
--- a/src/MNH/shallow_mf.f90
+++ b/src/MNH/shallow_mf.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -169,7 +169,7 @@ END MODULE MODI_SHALLOW_MF
!! Q.Rodier 01/2019 : support RM17 mixing length
!! R.Honnert 1/2019 : remove SURF
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! R.Honnert 04/2021: remove HRIO and BOUT schemes
+! R. Honnert 04/2021: remove HRIO and BOUT schemes
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/MNH/sources_neg_correct.f90 b/src/MNH/sources_neg_correct.f90
index 2c40ecb995dbb6da35e1ae155d5722193fc01145..0ceaf5a547bb575c707c704c613770f9ab0a43cd 100644
--- a/src/MNH/sources_neg_correct.f90
+++ b/src/MNH/sources_neg_correct.f90
@@ -28,7 +28,7 @@ use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudg
tbudgets
use modd_cst, only: xci, xcl, xcpd, xcpv, xlstt, xlvtt, xp00, xrd, xtt
use modd_nsv, only: nsv_c2r2beg, nsv_c2r2end, nsv_lima_beg, nsv_lima_end, nsv_lima_nc, nsv_lima_nr, nsv_lima_ni
-use modd_param_lima, only: lcold_lima => lcold, lrain_lima => lrain, lwarm_lima => lwarm, &
+use modd_param_lima, only: lcold_lima => lcold, lrain_lima => lrain, lspro_lima => lspro, lwarm_lima => lwarm, &
xctmin_lima => xctmin, xrtmin_lima => xrtmin
use mode_budget, only: Budget_store_init, Budget_store_end
@@ -52,6 +52,7 @@ integer :: ji, jj, jk
integer :: jr
integer :: jrmax
integer :: jsv
+integer :: jlimaend
real, dimension(:, :, :), allocatable :: zt, zexn, zlv, zls, zcph, zcor
if ( krr == 0 ) return
@@ -285,7 +286,9 @@ CLOUD: select case ( hcloud )
end if
end if
- prsvs(:, :, :, nsv_lima_beg : nsv_lima_end) = Max( 0.0, prsvs(:, :, :, nsv_lima_beg : nsv_lima_end) )
+ jlimaend=nsv_lima_end
+ if ( lspro_lima ) jlimaend=jlimaend-1
+ prsvs(:, :, :, nsv_lima_beg : jlimaend) = Max( 0.0, prsvs(:, :, :, nsv_lima_beg : jlimaend) )
end select CLOUD
diff --git a/src/MNH/spawn_field2.f90 b/src/MNH/spawn_field2.f90
index e5fc2c18b42527182dc7a5625af2b5edeb003ee1..44aa7c3ce0835e7c48c58e373e25a9c06ff8c636 100644
--- a/src/MNH/spawn_field2.f90
+++ b/src/MNH/spawn_field2.f90
@@ -155,6 +155,7 @@ END MODULE MODI_SPAWN_FIELD2
!! Modification 05/03/2018 (J.Escobar) bypass gridnesting special case KD(X/Y)RATIO == 1 not parallelized
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
+!! B. Vie 06/2020 Add prognostic supersaturation for LIMA
! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
!-------------------------------------------------------------------------------
!
@@ -934,6 +935,10 @@ IF (PRESENT(TPSONFILE)) THEN
IF (JSV .EQ. NSV_LIMA_HOM_HAZE) THEN
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(5))//'T'
END IF
+ ! Supersaturation
+ IF (JSV .EQ. NSV_LIMA_SPRO) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(5))//'T'
+ END IF
! time t
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
CALL IO_Field_read(TPSONFILE,TZFIELD,ZWORK3D,IRESP)
diff --git a/src/MNH/spawn_model2.f90 b/src/MNH/spawn_model2.f90
index 82c8f1ecac1eb09d844ef9c48dd3e30a7b0e3d5e..3d1e9382c36c785c3095dbee84634861f2ce60ae 100644
--- a/src/MNH/spawn_model2.f90
+++ b/src/MNH/spawn_model2.f90
@@ -200,6 +200,7 @@ END MODULE MODI_SPAWN_MODEL2
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
! P. Wautelet 24/03/2021: bugfix: allocate XLSRVM, XINPAP and XACPAP to zero size when not needed
+!! 03/2021 (JL Redelsperger) Ocean model case
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -1379,8 +1380,13 @@ ENDIF
ZTIME1 = ZTIME2
!
ALLOCATE(ZRHOD(IIU,IJU,IKU))
-ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
- /(XRD*ZTHVT(:,:,:)*(1.+ZSUMRT(:,:,:)))
+!
+IF (LOCEAN) THEN
+ ZRHOD(:,:,:)=XRH00OCEAN*(1.-XALPHAOC*(ZTHVT(:,:,:)-XTH00OCEAN)+XBETAOC*(XRT(:,:,:,1)-XSA00OCEAN))
+ELSE
+ ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
+ /(XRD*ZTHVT(:,:,:)*(1.+ZSUMRT(:,:,:)))
+ENDIF
!$20140709
CALL MPPDB_CHECK3D(ZRHOD,"SPAWN_MOD2:ZRHOD",PRECISION)
CALL MPPDB_CHECK3D(XPABST,"SPAWN_MOD2:XPABST",PRECISION)
@@ -1525,6 +1531,7 @@ IF (NVERB >= 5) THEN
WRITE(ILUOUT,*) 'SPAWN_MODEL2: NVERB=',NVERB
WRITE(ILUOUT,*) 'SPAWN_MODEL2: XLON0,XLAT0,XBETA=',XLON0,XLAT0,XBETA
WRITE(ILUOUT,*) 'SPAWN_MODEL2: LCARTESIAN=',LCARTESIAN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: LOCEAN,LCOUPLES=',LOCEAN,LCOUPLES
IF(LCARTESIAN) THEN
WRITE(ILUOUT,*) 'SPAWN_MODEL2: No map projection used.'
ELSE
diff --git a/src/MNH/spawning.f90 b/src/MNH/spawning.f90
index 2a6fafdf72898138004ab73feef23302c6335403..850f27d65fa12a6993d2faededb4cead0288f306 100644
--- a/src/MNH/spawning.f90
+++ b/src/MNH/spawning.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-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.
@@ -192,8 +192,12 @@ CALL INIT_NMLVAR
CALL POSNAM(ILUSPA,'NAM_SPAWN_SURF',GFOUND)
IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_SPAWN_SURF)
CALL UPDATE_MODD_FROM_NMLVAR
-CALL POSNAM(ILUSPA,'NAM_BLANKn',GFOUND)
-IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_BLANKn)
+CALL POSNAM(ILUSPA,'NAM_BLANKN',GFOUND)
+CALL INIT_NAM_BLANKn
+IF (GFOUND) THEN
+ READ(UNIT=ILUSPA,NML=NAM_BLANKn)
+ CALL UPDATE_NAM_BLANKn
+END IF
CALL POSNAM(ILUSPA,'NAM_CONFZ',GFOUND)
IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_CONFZ)
CALL POSNAM(ILUSPA,'NAM_CONF_SPAWN',GFOUND)
diff --git a/src/MNH/station_reader.f90 b/src/MNH/station_reader.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e6f9647bc1e99616f331f2e44fd454470fe174da
--- /dev/null
+++ b/src/MNH/station_reader.f90
@@ -0,0 +1,153 @@
+!MNH_LIC Copyright 2020-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.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_STATION_READER
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE READ_CSV_STATION(HFILE,TPSTATION,OCARTESIAN)
+ USE MODD_STATION_n
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(STATION), INTENT(OUT) :: TPSTATION ! stored blade data
+ LOGICAL, INTENT(IN) :: OCARTESIAN
+END SUBROUTINE READ_CSV_STATION
+!
+END INTERFACE
+!
+END MODULE MODI_STATION_READER
+!-------------------------------------------------------------------
+!
+!!**** *EOL_READER* -
+!!
+!! PURPOSE
+!! -------
+!! Prescribe probes through a CSV file
+!!
+!! AUTHOR
+!! ------
+!! E. Jézéquel *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! 03/2020 Original
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE READ_CSV_STATION(HFILE,TPSTATION,OCARTESIAN)
+USE MODD_ALLSTATION_n
+USE MODD_STATION_n
+USE MODD_PARAMETERS
+USE MODD_TYPE_STATION
+USE MODI_INI_SURFSTATION_n
+
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(STATION), INTENT(INOUT) :: TPSTATION ! dummy stored
+LOGICAL, INTENT(IN) :: OCARTESIAN
+!
+INTEGER :: INBLINE ! Nb of line in csv file
+!
+CHARACTER(LEN=80) :: YERROR
+CHARACTER(LEN=400) :: YSTRING
+INTEGER :: ILU ! logical unit of the file
+!
+
+! Open file
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted')
+! Count lines
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+!* analyses if the record has been written in French convention
+ CALL FRENCH_TO_ENGLISH(YSTRING) ! analyse de convention fr ou eng
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+ IF (INBLINE == 0) THEN
+ YERROR = 'Data not found in file : '//TRIM(HFILE)
+ PRINT*, YERROR
+ ELSE
+ ! Save number of station
+ NUMBSTAT = INBLINE - 1
+ !
+ ! Allocation des tableaux
+ ALLOCATE(TPSTATION%LAT(NUMBSTAT))
+ ALLOCATE(TPSTATION%LON(NUMBSTAT))
+ ALLOCATE(TPSTATION%X(NUMBSTAT))
+ ALLOCATE(TPSTATION%Y(NUMBSTAT))
+ ALLOCATE(TPSTATION%Z(NUMBSTAT))
+ ALLOCATE(TPSTATION%K(NUMBSTAT))
+ !ALLOCATE(TPSTATION%STEP(NUMBSTAT))
+ ALLOCATE(TPSTATION%NAME(NUMBSTAT))
+ ALLOCATE(TPSTATION%TYPE(NUMBSTAT))
+
+ TPSTATION%LON = XUNDEF
+ TPSTATION%LAT = XUNDEF
+ TPSTATION%Z = XUNDEF
+ TPSTATION%K = XUNDEF
+ TPSTATION%X = XUNDEF
+ TPSTATION%Y = XUNDEF
+ TPSTATION%NAME = " "
+ TPSTATION%TYPE = " "
+ ! Nouvelle lecture
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Lecture du header
+ !
+ ! Save the data
+ IF (OCARTESIAN) THEN
+ INBLINE = 1
+ DO INBLINE=1, NUMBSTAT
+ READ(ILU,FMT='(A400)') YSTRING
+ READ(YSTRING,*) TPSTATION%NAME(INBLINE),TPSTATION%TYPE(INBLINE),&
+ TPSTATION%X(INBLINE), TPSTATION%Y(INBLINE), TPSTATION%Z(INBLINE)!,&
+ END DO
+ REWIND(ILU)
+ CLOSE(ILU)
+ RETURN
+ ELSE
+ INBLINE = 1
+ DO INBLINE=1, NUMBSTAT
+ READ(ILU,FMT='(A400)') YSTRING
+ READ(YSTRING,*) TPSTATION%NAME(INBLINE), TPSTATION%TYPE(INBLINE),&
+ TPSTATION%LAT(INBLINE), TPSTATION%LON(INBLINE), TPSTATION%Z(INBLINE)!,&
+ END DO
+ REWIND(ILU)
+ CLOSE(ILU)
+ RETURN
+ END IF
+ END IF
+!
+END SUBROUTINE READ_CSV_STATION
+!#########################################################
+SUBROUTINE FRENCH_TO_ENGLISH(HSTRING)
+CHARACTER(LEN=400), INTENT(INOUT) :: HSTRING ! csv record
+INTEGER :: JL
+LOGICAL :: GFRENCH
+!
+GFRENCH = .FALSE.
+!* analyses if the record has been written in French convention
+! French convention (separator is ; decimal symbol is ,)
+! or English convention (separator is , decimal symbol is .)
+DO JL=1,400
+ IF (HSTRING(JL:JL)==';') GFRENCH=.TRUE.
+END DO
+!
+! If French convention is used in the file, transforms it in English convention
+IF (GFRENCH) THEN
+ DO JL=1,400
+ IF (HSTRING(JL:JL)==',') HSTRING(JL:JL)='.'
+ IF (HSTRING(JL:JL)==';') HSTRING(JL:JL)=','
+ END DO
+END IF
+!
+END SUBROUTINE FRENCH_TO_ENGLISH
+
diff --git a/src/MNH/th_r_from_thl_rt_1d.f90 b/src/MNH/th_r_from_thl_rt_1d.f90
index fcec2372fd5ff3a140c04b04df94a31073645167..e4ba92f8a9d8f7ca88e5411bfaadd73c1d8023fa 100644
--- a/src/MNH/th_r_from_thl_rt_1d.f90
+++ b/src/MNH/th_r_from_thl_rt_1d.f90
@@ -1,3 +1,8 @@
+!MNH_LIC Copyright 2006-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.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_TH_R_FROM_THL_RT_1D
! ###############################
@@ -67,7 +72,8 @@ REAL, DIMENSION(:), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturati
! ------------
!
USE MODI_COMPUTE_FRAC_ICE
-USE MODD_CST !, ONLY: XP00, XRD, XCPD, XCPV, XCL, XCI, XLVTT, XTT, XLSTT
+USE MODD_CST
+USE MODD_DYN_n, ONLY : LOCEAN
USE MODE_THERMO
!
IMPLICIT NONE
@@ -131,8 +137,11 @@ PTH(:)=PTHL(:)+ZLVOCPEXN(:)*PRL(:)+ZLSOCPEXN(:)*PRI(:)
! ---------
DO II=1,JITER
- ZT(:)=PTH(:)*ZEXN(:)
-
+ IF (LOCEAN) THEN
+ ZT=PTH
+ ELSE
+ ZT(:)=PTH(:)*ZEXN(:)
+ END IF
!Computation of liquid/ice fractions
PFRAC_ICE(:) = 0.
WHERE(PRL(:)+PRI(:) > 1.E-20)
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index d569258fe885d9eda14c752b56c487d0e792e57a..228241e2ce6e40965f1766ef2b8396210a08c4c9 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -345,6 +345,7 @@ END MODULE MODI_TURB
! P. Wautelet + Benoit Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
! R. Honnert/V. Masson 02/2021: new mixing length in the grey zone
+! J.L. Redelsperger 03/2021: add Ocean LES case
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -358,12 +359,14 @@ use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbud
USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
+USE MODD_DYN_n, ONLY : LOCEAN
use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_NSV
USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_PARAM_LIMA
+USE MODD_TURB_n, ONLY: XCADAP
!
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
@@ -392,6 +395,9 @@ USE MODI_ETHETA
!
USE MODI_SECOND_MNH
!
+USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_LS, XIBM_XMUT
+USE MODI_IBM_MIXINGLENGTH
+!
IMPLICIT NONE
!
!
@@ -469,6 +475,7 @@ REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coeff
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
! PRT(:,:,:,1) is the conservative mixing ratio
+!
! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
! TKE dissipation
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
@@ -546,7 +553,6 @@ REAL :: ZL0 ! Max. Mixing Length in Blakadar formula
REAL :: ZALPHA ! work coefficient :
! - proportionnality constant between Dz/2 and
! ! BL89 mixing length near the surface
- ! - and coefficient to reduce DELT in ADAP
!
REAL :: ZTIME1, ZTIME2
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZTT,ZEXNE,ZLV,ZLS,ZCPH,ZCOR
@@ -639,7 +645,11 @@ END DO
!
!* 2.2 Exner function at t
!
-ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
+IF (LOCEAN) THEN
+ ZEXN(:,:,:) = 1.
+ELSE
+ ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
+END IF
!
!* 2.3 dissipative heating coeff a t
!
@@ -779,8 +789,7 @@ SELECT CASE (HTURBLEN)
! For LES grid meshes, this is equivalent to Deardorff : the base mixing lentgh is the horizontal grid mesh,
! and it is limited by a stability-based length (RM17), as was done in Deardorff length (but taking into account shear as well)
! For grid meshes in the grey zone, then this is the smaller of the two.
- ZALPHA=0.50
- PLEM = MIN(PLEM,ZALPHA*ZLMW)
+ PLEM = MIN(PLEM,XCADAP*ZLMW)
!
!* 3.4 Delta mixing length
! -------------------
@@ -844,12 +853,22 @@ IF (ORMC01) THEN
CALL RMC01(HTURBLEN,KKA,KKU,KKL,PZZ,PDXX,PDYY,PDZZ,PDIRCOSZW,PSBL_DEPTH,ZLMO,PLEM,ZLEPS)
END IF
!
+!RMC01 is only applied on RM17 in ADAP
+IF (HTURBLEN=='ADAP') ZLEPS = MIN(ZLEPS,ZLMW*XCADAP)
+!
!* 3.8 Mixing length in external points (used if HTURBDIM="3DIM")
! ----------------------------------------------------------
!
IF (HTURBDIM=="3DIM") THEN
CALL UPDATE_LM(HLBCX,HLBCY,PLEM,ZLEPS)
END IF
+!
+!* 3.9 Mixing length correction if immersed walls
+! ------------------------------------------
+!
+IF (LIBM) THEN
+ CALL IBM_MIXINGLENGTH(PLEM,ZLEPS,XIBM_XMUT,XIBM_LS(:,:,:,1),PTKET)
+ENDIF
!----------------------------------------------------------------------------
!
!* 4. GO INTO THE AXES FOLLOWING THE SURFACE
@@ -1499,15 +1518,26 @@ IF (.NOT. ORMC01) THEN
!
DO JJ=1,SIZE(PUT,2)
DO JI=1,SIZE(PUT,1)
- DO JK=IKTB,IKTE
- ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))&
- -PZZ(JI,JJ,IKB)) *PDIRCOSZW(JI,JJ)
- IF ( PLM(JI,JJ,JK)>ZD) THEN
- PLM(JI,JJ,JK)=ZD
- ELSE
- EXIT
- ENDIF
- END DO
+ IF (LOCEAN) THEN
+ DO JK=IKTE,IKTB,-1
+ ZD=ZALPHA*(PZZ(JI,JJ,IKTE+1)-PZZ(JI,JJ,JK))
+ IF ( PLM(JI,JJ,JK)>ZD) THEN
+ PLM(JI,JJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ELSE
+ DO JK=IKTB,IKTE
+ ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))&
+ -PZZ(JI,JJ,IKB)) *PDIRCOSZW(JI,JJ)
+ IF ( PLM(JI,JJ,JK)>ZD) THEN
+ PLM(JI,JJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ENDIF
END DO
END DO
END IF
@@ -1574,7 +1604,6 @@ END IF
ZETHETA(:,:,:) = ETHETA(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZATHETA,PSRCT)
ZEMOIST(:,:,:) = EMOIST(KRR,KRRI,PTHLT,PRT,ZLOCPEXNM,ZAMOIST,PSRCT)
!
-! For dry simulations
IF (KRR>0) THEN
DO JK = IKTB+1,IKTE-1
DO JJ=1,SIZE(PUT,2)
@@ -1583,8 +1612,12 @@ IF (KRR>0) THEN
(PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
ZDRTDZ(JI,JJ,JK) = 0.5*((PRT(JI,JJ,JK+KKL,1)-PRT(JI,JJ,JK ,1))/PDZZ(JI,JJ,JK+KKL)+ &
(PRT(JI,JJ,JK ,1)-PRT(JI,JJ,JK-KKL,1))/PDZZ(JI,JJ,JK ))
- ZVAR=XG/PTHVREF(JI,JJ,JK)* &
+ IF (LOCEAN) THEN
+ ZVAR=XG*(XALPHAOC*ZDTHLDZ(JI,JJ,JK)-XBETAOC*ZDRTDZ(JI,JJ,JK))
+ ELSE
+ ZVAR=XG/PTHVREF(JI,JJ,JK)* &
(ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)+ZEMOIST(JI,JJ,JK)*ZDRTDZ(JI,JJ,JK))
+ END IF
!
IF (ZVAR>0.) THEN
PLM(JI,JJ,JK)=MAX(XMNH_EPSILON,MIN(PLM(JI,JJ,JK), &
@@ -1593,14 +1626,18 @@ IF (KRR>0) THEN
END DO
END DO
END DO
-ELSE
+ELSE! For dry atmos or unsalted ocean runs
DO JK = IKTB+1,IKTE-1
DO JJ=1,SIZE(PUT,2)
DO JI=1,SIZE(PUT,1)
ZDTHLDZ(JI,JJ,JK)= 0.5*((PTHLT(JI,JJ,JK+KKL)-PTHLT(JI,JJ,JK ))/PDZZ(JI,JJ,JK+KKL)+ &
(PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
- ZVAR=XG/PTHVREF(JI,JJ,JK)*ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)
- !
+ IF (LOCEAN) THEN
+ ZVAR= XG*XALPHAOC*ZDTHLDZ(JI,JJ,JK)
+ ELSE
+ ZVAR= XG/PTHVREF(JI,JJ,JK)*ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)
+ END IF
+!
IF (ZVAR>0.) THEN
PLM(JI,JJ,JK)=MAX(XMNH_EPSILON,MIN(PLM(JI,JJ,JK), &
0.76* SQRT(PTKET(JI,JJ,JK)/ZVAR)))
@@ -1618,8 +1655,12 @@ ELSE
ZDRTDZ(:,:,IKB)=0
ENDIF
!
-ZWORK2D(:,:)=XG/PTHVREF(:,:,IKB)* &
- (ZETHETA(:,:,IKB)*ZDTHLDZ(:,:,IKB)+ZEMOIST(:,:,IKB)*ZDRTDZ(:,:,IKB))
+IF (LOCEAN) THEN
+ ZWORK2D(:,:)=XG*(XALPHAOC*ZDTHLDZ(:,:,IKB)-XBETAOC*ZDRTDZ(:,:,IKB))
+ELSE
+ ZWORK2D(:,:)=XG/PTHVREF(:,:,IKB)* &
+ (ZETHETA(:,:,IKB)*ZDTHLDZ(:,:,IKB)+ZEMOIST(:,:,IKB)*ZDRTDZ(:,:,IKB))
+END IF
WHERE(ZWORK2D(:,:)>0.)
PLM(:,:,IKB)=MAX(XMNH_EPSILON,MIN( PLM(:,:,IKB), &
0.76* SQRT(PTKET(:,:,IKB)/ZWORK2D(:,:))))
@@ -1632,15 +1673,26 @@ IF (.NOT. ORMC01) THEN
!
DO JJ=1,SIZE(PUT,2)
DO JI=1,SIZE(PUT,1)
- DO JK=IKTB,IKTE
- ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))-PZZ(JI,JJ,IKB)) &
- *PDIRCOSZW(JI,JJ)
- IF ( PLM(JI,JJ,JK)>ZD) THEN
- PLM(JI,JJ,JK)=ZD
- ELSE
- EXIT
- ENDIF
- END DO
+ IF (LOCEAN) THEN
+ DO JK=IKTE,IKTB,-1
+ ZD=ZALPHA*(PZZ(JI,JJ,IKTE+1)-PZZ(JI,JJ,JK))
+ IF ( PLM(JI,JJ,JK)>ZD) THEN
+ PLM(JI,JJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ELSE
+ DO JK=IKTB,IKTE
+ ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))-PZZ(JI,JJ,IKB)) &
+ *PDIRCOSZW(JI,JJ)
+ IF ( PLM(JI,JJ,JK)>ZD) THEN
+ PLM(JI,JJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ENDIF
END DO
END DO
END IF
diff --git a/src/MNH/turb_ver.f90 b/src/MNH/turb_ver.f90
index fce78c562131d968b5d3d307a70f25d06c226716..4117d8191eb9def704b654e606eba90307fe65ec 100644
--- a/src/MNH/turb_ver.f90
+++ b/src/MNH/turb_ver.f90
@@ -311,6 +311,7 @@ END MODULE MODI_TURB_VER
!! 10/2012 (J.Escobar) Bypass PGI bug , redefine some allocatable array inplace of automatic
!! 08/2014 (J.Escobar) Bypass PGI memory leak bug , replace IF statement with IF THEN ENDIF
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! JL Redelsperger 03/2021 : add Ocean LES case
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -318,6 +319,7 @@ END MODULE MODI_TURB_VER
!
USE MODD_CST
USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
@@ -463,9 +465,9 @@ REAL, ALLOCATABLE, DIMENSION(:,:,:) :: &
!!$REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3),NSV) :: &
REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: &
ZPSI_SV, & ! Prandtl number for scalars
- ZREDS1, & ! 1D Redeslperger number R_sv
- ZRED2THS, & ! 3D Redeslperger number R*2_thsv
- ZRED2RS ! 3D Redeslperger number R*2_rsv
+ ZREDS1, & ! 1D Redelsperger number R_sv
+ ZRED2THS, & ! 3D Redelsperger number R*2_thsv
+ ZRED2RS ! 3D Redelsperger number R*2_rsv
!
LOGICAL :: GUSERV ! flag to use water vapor
INTEGER :: IKB,IKE ! index value for the Beginning
@@ -509,7 +511,6 @@ ALLOCATE ( &
!
IKB=KKA+JPVEXT_TURB*KKL
IKE=KKU-JPVEXT_TURB*KKL
-
!
!
! 3D Redelsperger numbers
@@ -529,7 +530,11 @@ CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_FLX, &
!
! Buoyancy coefficient
!
-ZBETA = XG/PTHVREF
+IF (LOCEAN) THEN
+ ZBETA = XG*XALPHAOC
+ELSE
+ ZBETA = XG/PTHVREF
+END IF
!
! Square root of Tke
!
diff --git a/src/MNH/turb_ver_dyn_flux.f90 b/src/MNH/turb_ver_dyn_flux.f90
index 10a40478b7dd7ba01fc2191d1646c78631448743..51bc4e7e1b868799b038e1e56b089bd2cb88ae22 100644
--- a/src/MNH/turb_ver_dyn_flux.f90
+++ b/src/MNH/turb_ver_dyn_flux.f90
@@ -280,6 +280,7 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Q. Rodier 17/01/2019 : cleaning : remove cyclic conditions on DP and ZA
+!! JL Redelsperger 03/2021 : Add Ocean & O-A Autocoupling LES Cases
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -288,11 +289,15 @@ END MODULE MODI_TURB_VER_DYN_FLUX
USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_NSV
+USE MODD_OCEANH
USE MODD_PARAMETERS
+USE MODD_REF, ONLY : LCOUPLES
+USE MODD_TURB_n
!
!
USE MODI_GRADIENT_U
@@ -459,25 +464,48 @@ ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) &
! average this flux to be located at the U,W vorticity point
ZCOEFS(:,:,1:1)=MXM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
!
-! compute the explicit tangential flux at the W point
-ZSOURCE(:,:,IKB) = &
- PTAU11M(:,:) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
- -PTAU12M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
- -PTAU33M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
!
-! add the vertical part or the surface flux at the U,W vorticity point
-
-ZSOURCE(:,:,IKB:IKB) = &
- ( MXM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
- + MXM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+! ZSOURCE= FLUX /DZ
+IF (LOCEAN) THEN ! OCEAN MODEL ONLY
+ ! Sfx flux assumed to be in SI & at vorticity point
+ IF (LCOUPLES) THEN
+ ZSOURCE(:,:,IKE:IKE) = XSSUFL_C(:,:,1:1)/PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)))
+ ELSE
+ ZSOURCE(:,:,IKE) = XSSUFL(:,:)
+ ZSOURCE(:,:,IKE:IKE) = ZSOURCE (:,:,IKE:IKE) /PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)) )
+ ENDIF
+ !No flux at the ocean domain bottom
+ ZSOURCE(:,:,IKB) = 0.
+ ZSOURCE(:,:,IKTB+1:IKTE-1) = 0
+!
+ELSE !ATMOS MODEL ONLY
+ IF (LCOUPLES) THEN
+ ZSOURCE(:,:,IKB:IKB) = XSSUFL_C(:,:,1:1)/PDZZ(:,:,IKB:IKB) &
+ * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
+ ELSE
+ ! compute the explicit tangential flux at the W point
+ ZSOURCE(:,:,IKB) = &
+ PTAU11M(:,:) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
+ -PTAU12M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
+ -PTAU33M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
+!
+ ! add the vertical part or the surface flux at the U,W vorticity point
+!
+ ZSOURCE(:,:,IKB:IKB) = &
+ ( MXM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
+ + MXM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
*ZUSLOPEM(:,:,1:1) &
-ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
*ZVSLOPEM(:,:,1:1) ) &
- - ZCOEFS(:,:,1:1) * PUM(:,:,IKB:IKB) * PIMPL &
- ) * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
+ - ZCOEFS(:,:,1:1) * PUM(:,:,IKB:IKB) * PIMPL &
+ ) * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
+ ENDIF
!
-ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
-ZSOURCE(:,:,IKE) = 0.
+ ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
+ ZSOURCE(:,:,IKE) = 0.
+ENDIF !end ocean or atmosphere cases
!
! Obtention of the split U at t+ deltat
!
@@ -504,6 +532,12 @@ ZFLXZ(:,:,IKB:IKB) = MXM(PDZZ(:,:,IKB:IKB)) * &
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+IF (LOCEAN) THEN !ocean model at phys sfc (ocean domain top)
+ ZFLXZ(:,:,IKE:IKE) = MXM(PDZZ(:,:,IKE:IKE)) * &
+ ZSOURCE(:,:,IKE:IKE) &
+ / 0.5 / ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)) )
+ ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
+END IF
!
IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
! stores the U wind component vertical flux
@@ -533,7 +567,15 @@ PDP(:,:,:) = - MZF( MXF ( ZFLXZ * GZ_U_UW(PUM,PDZZ) ) )
PDP(:,:,IKB:IKB) = - MXF ( &
ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PUM(:,:,IKB+KKL:IKB+KKL)-PUM(:,:,IKB:IKB)) &
/ MXM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
- )
+ )
+!
+IF (LOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
+ PDP(:,:,IKE:IKE) = - MXF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * (PUM(:,:,IKE:IKE)-PUM(:,:,IKE-KKL:IKE-KKL)) &
+ / MXM(PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ )
+END IF
!
! Storage in the LES configuration
!
@@ -552,8 +594,12 @@ END IF
!
IF(HTURBDIM=='3DIM') THEN
! Compute the source for the W wind component
- ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
! used to compute the W source at the ground
+ ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
+ IF (LOCEAN) THEN
+ ZFLXZ(:,:,KKU) = 2 * ZFLXZ(:,:,IKE) - ZFLXZ(:,:,IKE-KKL) ! extrapolation
+ END IF
+
!
IF (.NOT. LFLAT) THEN
PRWS(:,:,:)= PRWS &
@@ -583,6 +629,21 @@ IF(HTURBDIM=='3DIM') THEN
) / (0.5*(PDXX(:,:,IKB+KKL:IKB+KKL)+PDXX(:,:,IKB:IKB))) &
)
!
+IF (LOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
+ ZA(:,:,IKE:IKE) = - MXF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * &
+ ( DXM( PWM(:,:,IKE-KKL:IKE-KKL) ) &
+ -MXM( (PWM(:,:,IKE-2*KKL:IKE-2*KKL )-PWM(:,:,IKE-KKL:IKE-KKL)) &
+ /(PDZZ(:,:,IKE-2*KKL:IKE-2*KKL)+PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ +(PWM(:,:,IKE-KKL:IKE-KKL)-PWM(:,:,IKE:IKE )) &
+ /(PDZZ(:,:,IKE-KKL:IKE-KKL)+PDZZ(:,:,IKE:IKE )) &
+ ) &
+ * PDZX(:,:,IKE-KKL:IKE-KKL) &
+ ) / (0.5*(PDXX(:,:,IKE-KKL:IKE-KKL)+PDXX(:,:,IKE:IKE))) &
+ )
+END IF
+ !
PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
!
! Storage in the LES configuration
@@ -636,24 +697,44 @@ ZCOEFS(:,:,1)= ZCOEFFLXU(:,:,1) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) &
! average this flux to be located at the V,W vorticity point
ZCOEFS(:,:,1:1)=MYM(ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB) )
!
-! compute the explicit tangential flux at the W point
-ZSOURCE(:,:,IKB) = &
- PTAU11M(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
- +PTAU12M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) &
- -PTAU33M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
-!
-! add the vertical part or the surface flux at the V,W vorticity point
-ZSOURCE(:,:,IKB:IKB) = &
- ( MYM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
- + MYM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZUSLOPEM(:,:,1:1) &
- +ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZVSLOPEM(:,:,1:1) ) &
- - ZCOEFS(:,:,1:1) * PVM(:,:,IKB:IKB) * PIMPL &
- ) * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
-!
+IF (LOCEAN) THEN ! Ocean case
+ IF (LCOUPLES) THEN
+ ZSOURCE(:,:,IKE:IKE) = XSSVFL_C(:,:,1:1)/PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
+ ELSE
+ ZSOURCE(:,:,IKE) = XSSVFL(:,:)
+ ZSOURCE(:,:,IKE:IKE) = ZSOURCE(:,:,IKE:IKE)/PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
+ END IF
+ !No flux at the ocean domain bottom
+ ZSOURCE(:,:,IKB) = 0.
+ELSE ! Atmos case
+ IF (.NOT.LCOUPLES) THEN ! only atmosp without coupling
+ ! compute the explicit tangential flux at the W point
+ ZSOURCE(:,:,IKB) = &
+ PTAU11M(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
+ +PTAU12M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) &
+ -PTAU33M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
+!
+ ! add the vertical part or the surface flux at the V,W vorticity point
+ ZSOURCE(:,:,IKB:IKB) = &
+ ( MYM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
+ + MYM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+ *ZUSLOPEM(:,:,1:1) &
+ +ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+ *ZVSLOPEM(:,:,1:1) ) &
+ - ZCOEFS(:,:,1:1) * PVM(:,:,IKB:IKB) * PIMPL &
+ ) * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
+!
+ ELSE !atmosphere when coupling
+ ! input flux assumed to be in SI and at vorticity point
+ ZSOURCE(:,:,IKB:IKB) = -XSSVFL_C(:,:,1:1)/(1.*PDZZ(:,:,IKB:IKB)) &
+ * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
+ ENDIF
+ !No flux at the atmosphere top
+ ZSOURCE(:,:,IKE) = 0.
+ENDIF ! End of Ocean or Atmospher Cases
ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
-ZSOURCE(:,:,IKE) = 0.
!
! Obtention of the split V at t+ deltat
CALL TRIDIAG_WIND(KKA,KKU,KKL,PVM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
@@ -679,6 +760,13 @@ ZFLXZ(:,:,IKB:IKB) = MYM(PDZZ(:,:,IKB:IKB)) * &
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!
+IF (LOCEAN) THEN
+ ZFLXZ(:,:,IKE:IKE) = MYM(PDZZ(:,:,IKE:IKE)) * &
+ ZSOURCE(:,:,IKE:IKE) &
+ / 0.5 / ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
+ ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
+END IF
+!
IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
! stores the V wind component vertical flux
TZFIELD%CMNHNAME = 'VW_VFLX'
@@ -710,6 +798,14 @@ ZFLXZ(:,:,IKB+KKL:IKB+KKL) * (PVM(:,:,IKB+KKL:IKB+KKL)-PVM(:,:,IKB:IKB)) &
/ MYM(PDZZ(:,:,IKB+KKL:IKB+KKL)) &
)
!
+IF (LOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
+ ZA(:,:,IKE:IKE) = - MYF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * (PVM(:,:,IKE:IKE)-PVM(:,:,IKE-KKL:IKE-KKL)) &
+ / MYM(PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ )
+END IF
+!
PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
!
! Storage in the LES configuration
@@ -729,6 +825,9 @@ END IF
IF(HTURBDIM=='3DIM') THEN
! Compute the source for the W wind component
ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
+ IF (LOCEAN) THEN
+ ZFLXZ(:,:,KKU) = 2 * ZFLXZ(:,:,IKE) - ZFLXZ(:,:,IKE-KKL) ! extrapolation
+ END IF
!
IF (.NOT. L2D) THEN
IF (.NOT. LFLAT) THEN
@@ -759,6 +858,20 @@ IF(HTURBDIM=='3DIM') THEN
) / (0.5*(PDYY(:,:,IKB+KKL:IKB+KKL)+PDYY(:,:,IKB:IKB))) &
)
!
+ IF (LOCEAN) THEN
+ ZA(:,:,IKE:IKE) = - MYF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * &
+ ( DYM( PWM(:,:,IKE-KKL:IKE-KKL) ) &
+ -MYM( (PWM(:,:,IKE-2*KKL:IKE-2*KKL)-PWM(:,:,IKE-KKL:IKE-KKL)) &
+ /(PDZZ(:,:,IKE-2*KKL:IKE-2*KKL)+PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ +(PWM(:,:,IKE-KKL:IKE-KKL)-PWM(:,:,IKE:IKE )) &
+ /(PDZZ(:,:,IKE-KKL:IKE-KKL)+PDZZ(:,:,IKE:IKE )) &
+ ) &
+ * PDZY(:,:,IKE-KKL:IKE-KKL) &
+ ) / (0.5*(PDYY(:,:,IKE-KKL:IKE-KKL)+PDYY(:,:,IKE:IKE))) &
+ )
+ END IF
+!
PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
!
END IF
diff --git a/src/MNH/turb_ver_thermo_flux.f90 b/src/MNH/turb_ver_thermo_flux.f90
index 80825e315814042a0c25a11789f9e41e575ebe87..cf539984e7751f862a6251a3e80b048274740073 100644
--- a/src/MNH/turb_ver_thermo_flux.f90
+++ b/src/MNH/turb_ver_thermo_flux.f90
@@ -323,6 +323,14 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! 2012-02 (Y. Seity) add possibility to run with reversed
!! vertical levels
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 2021 (D. Ricard) last version of HGRAD turbulence scheme
+!! Leronard terms instead of Reynolds terms
+!! applied to vertical fluxes of r_np and Thl
+!! for implicit version of turbulence scheme
+!! corrections and cleaning
+!! June 2020 (B. Vie) Patch preventing negative rc and ri in 2.3 and 3.3
+!! JL Redelsperger : 03/2021: Ocean and Autocoupling O-A LES Cases
+!! Sfc flux shape for LDEEPOC Case
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -331,15 +339,27 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
USE MODD_CST
USE MODD_CTURB
use modd_field, only: tfielddata, TYPEREAL
+USE MODD_GRID_n, ONLY: XZS, XXHAT, XYHAT
USE MODD_IO, ONLY: TFILEDATA
+USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
USE MODD_PARAMETERS
+USE MODD_TURB_n, ONLY: LHGRAD, XCOEFHGRADTHL, XCOEFHGRADRM, XALTHGRAD, XCLDTHOLD
USE MODD_CONF
USE MODD_LES
+USE MODD_DIM_n
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_OCEANH
+USE MODD_REF, ONLY: LCOUPLES
+USE MODD_TURB_n
+USE MODD_FRC
!
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
USE MODI_GRADIENT_M
+USE MODI_GRADIENT_UV
+USE MODI_GRADIENT_UW
+USE MODI_GRADIENT_VW
USE MODI_SHUMAN
USE MODI_TRIDIAG
USE MODI_LES_MEAN_SUBGRID
@@ -351,6 +371,8 @@ USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_PRANDTL
!
USE MODI_SECOND_MNH
+USE MODE_ll
+USE MODE_GATHER_ll
!
IMPLICIT NONE
!
@@ -452,14 +474,47 @@ REAL, DIMENSION(SIZE(PTHLM,1),SIZE(PTHLM,2),SIZE(PTHLM,3)) :: &
ZF, & ! Flux in dTh/dt =-dF/dz (evaluated at t-1)(or rt instead of Th)
ZDFDDTDZ, & ! dF/d(dTh/dz)
ZDFDDRDZ, & ! dF/d(dr/dz)
- Z3RDMOMENT ! 3 order term in flux or variance equation
+ Z3RDMOMENT,& ! 3 order term in flux or variance equation
+ ZF_NEW, &
+ ZRWTHL, &
+ ZRWRNP, &
+ ZCLD_THOLD
+!
+REAL,DIMENSION(SIZE(XZS,1),SIZE(XZS,2),KKU) :: ZALT
+!
INTEGER :: IKB,IKE ! I index values for the Beginning and End
! mass points of the domain in the 3 direct.
INTEGER :: IKT ! array size in k direction
INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
+INTEGER :: JI, JJ ! loop indexes
!
-REAL :: ZTIME1, ZTIME2
!
+INTEGER :: IIB,IJB ! Lower bounds of the physical
+ ! sub-domain in x and y directions
+INTEGER :: IIE,IJE ! Upper bounds of the physical
+ ! sub-domain in x and y directions
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll ! Position x in the conformal
+ ! plane (array on the complete domain)
+REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT_ll ! Position y in the conformal
+ ! plane (array on the complete domain)
+!
+!
+CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
+CHARACTER (LEN=LEN_HREC) :: YRECFM ! Name of the desired field in LFIFM file
+!
+REAL :: ZTIME1, ZTIME2
+REAL :: ZDELTAX
+REAL :: ZXBEG,ZXEND,ZYBEG,ZYEND ! Forcing size for ocean deep convection
+REAL, DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) :: ZDIST ! distance
+ ! from the center of the cooling
+REAL :: ZFLPROV
+INTEGER :: JKM ! vertical index loop
+INTEGER :: JSW
+REAL :: ZSWA ! index for time flux interpolation
+!
+INTEGER :: IIU, IJU
+INTEGER :: IRESP
INTEGER :: JK
LOGICAL :: GUSERV ! flag to use water
LOGICAL :: GFTH2 ! flag to use w'th'2
@@ -472,6 +527,36 @@ TYPE(TFIELDDATA) :: TZFIELD
!
!* 1. PRELIMINARIES
! -------------
+! Size for a given proc & a given model
+IIU=SIZE(PTHLM,1)
+IJU=SIZE(PTHLM,2)
+!
+!! Compute Shape of sfc flux for Oceanic Deep Conv Case
+!
+IF (LOCEAN .AND. LDEEPOC) THEN
+ !* COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS
+ ALLOCATE(ZXHAT_ll(NIMAX_ll+2*JPHEXT),ZYHAT_ll(NJMAX_ll+2*JPHEXT))
+ !compute ZXHAT_ll = position in the (0:Lx) domain 1 (Lx=Size of domain1 )
+ !compute XXHAT_ll = position in the (L0_subproc,Lx_subproc) domain for the current subproc
+ ! L0_subproc as referenced in the full domain 1
+ CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,IRESP)
+ CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,IRESP)
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ DO JJ = IJB,IJE
+ DO JI = IIB,IIE
+ ZDIST(JI,JJ) = SQRT( &
+ (( (XXHAT(JI)+XXHAT(JI+1))*0.5 - XCENTX_OC ) / XRADX_OC)**2 + &
+ (( (XYHAT(JJ)+XYHAT(JJ+1))*0.5 - XCENTY_OC ) / XRADY_OC)**2 &
+ )
+ END DO
+ END DO
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF ( ZDIST(JI,JJ) > 1.) XSSTFL(JI,JJ)=0.
+ END DO
+ END DO
+END IF !END DEEP OCEAN CONV CASE
!
IKT =SIZE(PTHLM,3)
IKTE =IKT-JPVEXT_TURB
@@ -486,6 +571,18 @@ GUSERV = (KRR/=0)
!
ZKEFF(:,:,:) = MZM( PLM(:,:,:) * SQRT(PTKEM(:,:,:)) )
!
+! define a cloud mask with ri and rc (used after with a threshold) for Leonard terms
+!
+IF(LHGRAD) THEN
+ IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ ZCLD_THOLD(:,:,:) = PRM(:,:,:,2) + PRM(:,:,:,4)
+ ELSE
+ ZCLD_THOLD(:,:,:) = PRM(:,:,:,2)
+ END IF
+ END IF
+END IF
+!
! Flags for 3rd order quantities
!
GFTH2 = .FALSE.
@@ -513,7 +610,16 @@ END IF
!
ZF (:,:,:) = -XCSHF*PPHI3*ZKEFF*DZM(PTHLM)/PDZZ
ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF*D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV)
-
+!
+IF (LHGRAD) THEN
+ ! Compute the Leonard terms for thl
+ ZDELTAX= XXHAT(3) - XXHAT(2)
+ ZF_NEW (:,:,:)= XCOEFHGRADTHL*ZDELTAX*ZDELTAX/12.0*( &
+ MXF(GX_W_UW(PWM(:,:,:), XDXX, XDZZ, XDZX))&
+ *MZM(GX_M_M(PTHLM(:,:,:),XDXX,XDZZ,XDZX)) &
+ + MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY)) &
+ *MZM(GY_M_M(PTHLM(:,:,:),XDYY,XDZZ,XDZY)) )
+END IF
!
! Effect of 3rd order terms in temperature flux (at flux point)
!
@@ -560,29 +666,57 @@ IF (GFTHR) THEN
ZDFDDTDZ = ZDFDDTDZ + D_M3_WTH_WTHR_O_DDTDZ(Z3RDMOMENT,PREDTH1,&
& PREDR1,PD,PBLL_O_E,PETHETA) * MZM(PFTHR)
END IF
+! compute interface flux
+IF (LCOUPLES) THEN ! Autocoupling O-A LES
+ IF (LOCEAN) THEN ! ocean model in coupled case
+ ZF(:,:,IKE) = (XSSTFL_C(:,:,1)+XSSRFL_C(:,:,1)) &
+ *0.5* ( 1. + PRHODJ(:,:,KKU)/PRHODJ(:,:,IKE) )
+ ELSE ! atmosph model in coupled case
+ ZF(:,:,IKB) = XSSTFL_C(:,:,1) &
+ *0.5* ( 1. + PRHODJ(:,:,KKA)/PRHODJ(:,:,IKB) )
+ ENDIF
+!
+ELSE ! No coupling O and A cases
+ ! atmosp bottom
+ !*In 3D, a part of the flux goes vertically,
+ ! and another goes horizontally (in presence of slopes)
+ !*In 1D, part of energy released in horizontal flux is taken into account in the vertical part
+ IF (HTURBDIM=='3DIM') THEN
+ ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
+ * PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ ELSE
+ ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
+ / PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ END IF
!
-!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
-! (in presence of slopes)
-!* in 1DIM case, the part of energy released in horizontal flux
-! is taken into account in the vertical part
-!
-IF (HTURBDIM=='3DIM') THEN
- ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- * PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
-ELSE
- ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
-END IF
+ IF (LOCEAN) THEN
+ ZF(:,:,IKE) = XSSTFL(:,:) *0.5*(1. + PRHODJ(:,:,KKU) / PRHODJ(:,:,IKE))
+ ELSE !end ocean case (in nocoupled case)
+ ! atmos top
+ ZF(:,:,IKE)=0.
+ END IF
+END IF !end no coupled cases
!
! Compute the split conservative potential temperature at t+deltat
CALL TRIDIAG_THERMO(KKA,KKU,KKL,PTHLM,ZF,ZDFDDTDZ,PTSTEP,PIMPL,PDZZ,&
PRHODJ,PTHLP)
!
! Compute the equivalent tendency for the conservative potential temperature
-PRTHLS(:,:,:)= PRTHLS(:,:,:) + &
- PRHODJ(:,:,:)*(PTHLP(:,:,:)-PTHLM(:,:,:))/PTSTEP
+!
+ZRWTHL(:,:,:)= PRHODJ(:,:,:)*(PTHLP(:,:,:)-PTHLM(:,:,:))/PTSTEP
+! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
+IF (LHGRAD) THEN
+ DO JK=1,KKU
+ ZALT(:,:,JK) = PZZ(:,:,JK)-XZS(:,:)
+ END DO
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD) .AND. ( ZALT(:,:,:) >= XALTHGRAD) )
+ ZRWTHL(:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:))*ZF_NEW(:,:,:),XDZZ)
+ END WHERE
+END IF
+!
+PRTHLS(:,:,:)= PRTHLS(:,:,:) + ZRWTHL(:,:,:)
!
!* 2.2 Partial Thermal Production
!
@@ -590,17 +724,33 @@ PRTHLS(:,:,:)= PRTHLS(:,:,:) + &
!
ZFLXZ(:,:,:) = ZF &
+ PIMPL * ZDFDDTDZ * DZM(PTHLP - PTHLM) / PDZZ
+! replace the flux by the Leonard terms
+IF (LHGRAD) THEN
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD) .AND. ( ZALT(:,:,:) >= XALTHGRAD) )
+ ZFLXZ(:,:,:) = ZF_NEW(:,:,:)
+ END WHERE
+END IF
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+IF (LOCEAN) THEN
+ ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
+END IF
!
- DO JK=IKTB+1,IKTE-1
- PWTH(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
- END DO
- PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
- PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
+DO JK=IKTB+1,IKTE-1
+ PWTH(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
+END DO
+!
+PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
+!
+IF (LOCEAN) THEN
+ PWTH(:,:,IKE)=0.5*(ZFLXZ(:,:,IKE)+ZFLXZ(:,:,IKE+KKL))
+ PWTH(:,:,KKA)=0.
+ PWTH(:,:,KKU)=ZFLXZ(:,:,KKU)
+ELSE
PWTH(:,:,IKE)=PWTH(:,:,IKE-KKL)
-
-
+ PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
+END IF
+!
IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
! stores the conservative potential temperature vertical flux
TZFIELD%CMNHNAME = 'THW_FLX'
@@ -617,32 +767,40 @@ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
END IF
!
! Contribution of the conservative temperature flux to the buoyancy flux
-IF (KRR /= 0) THEN
- PTP(:,:,:) = PBETA * MZF( MZM(PETHETA) * ZFLXZ )
- PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
- 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
+IF (LOCEAN) THEN
+ PTP(:,:,:)= XG*XALPHAOC * MZF(ZFLXZ )
ELSE
- PTP(:,:,:)= PBETA * MZF( ZFLXZ )
-END IF
+ IF (KRR /= 0) THEN
+ PTP(:,:,:) = PBETA * MZF( MZM(PETHETA) * ZFLXZ )
+ PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
+ 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
+ ELSE
+ PTP(:,:,:)= PBETA * MZF( ZFLXZ )
+ END IF
+END IF
!
! Buoyancy flux at flux points
!
PWTHV = MZM(PETHETA) * ZFLXZ
PWTHV(:,:,IKB) = PETHETA(:,:,IKB) * ZFLXZ(:,:,IKB)
!
+IF (LOCEAN) THEN
+ ! temperature contribution to Buy flux
+ PWTHV(:,:,IKE) = PETHETA(:,:,IKE) * ZFLXZ(:,:,IKE)
+END IF
!* 2.3 Partial vertical divergence of the < Rc w > flux
!
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- DZF( MZM( PRHODJ*PATHETA*2.*PSRCM )*ZFLXZ/PDZZ ) &
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ) &
*(1.0-PFRAC_ICE(:,:,:))
PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
- DZF( MZM( PRHODJ*PATHETA*2.*PSRCM )*ZFLXZ/PDZZ ) &
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ) &
*PFRAC_ICE(:,:,:)
ELSE
PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- DZF( MZM( PRHODJ*PATHETA*2.*PSRCM )*ZFLXZ/PDZZ )
+ PRHODJ*PATHETA*2.*PSRCM*DZF(ZFLXZ/PDZZ)
END IF
END IF
!
@@ -693,6 +851,16 @@ IF (KRR /= 0) THEN
ZF (:,:,:) = -XCSHF*PPSI3*ZKEFF*DZM(PRM(:,:,:,1))/PDZZ
ZDFDDRDZ(:,:,:) = -XCSHF*ZKEFF*D_PSI3DRDZ_O_DDRDZ(PPSI3,PREDR1,PREDTH1,PRED2R3,PRED2THR3,HTURBDIM,GUSERV)
!
+ ! Compute Leonard Terms for Cloud mixing ratio
+ IF (LHGRAD) THEN
+ ZDELTAX= XXHAT(3) - XXHAT(2)
+ ZF_NEW (:,:,:)= XCOEFHGRADRM*ZDELTAX*ZDELTAX/12.0*( &
+ MXF(GX_W_UW(PWM(:,:,:), XDXX, XDZZ, XDZX)) &
+ *MZM(GX_M_M(PRM(:,:,:,1),XDXX,XDZZ,XDZX)) &
+ +MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY)) &
+ *MZM(GY_M_M(PRM(:,:,:,1),XDYY,XDZZ,XDZY)) )
+ END IF
+ !
! Effect of 3rd order terms in temperature flux (at flux point)
!
! d(w'2r')/dz
@@ -739,28 +907,61 @@ IF (KRR /= 0) THEN
& PREDTH1,PD,PBLL_O_E,PEMOIST) * MZM(PFTHR)
END IF
!
- !* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
- ! (in presence of slopes)
- !* in 1DIM case, the part of energy released in horizontal flux
- ! is taken into account in the vertical part
- !
- IF (HTURBDIM=='3DIM') THEN
- ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
- * PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- ELSE
- ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
- / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
- END IF
+ ! compute interface flux
+ IF (LCOUPLES) THEN ! coupling NH O-A
+ IF (LOCEAN) THEN ! ocean model in coupled case
+ ! evap effect on salinity to be added later !!!
+ ZF(:,:,IKE) = 0.
+ ELSE ! atmosph model in coupled case
+ ZF(:,:,IKB) = 0.
+ ! AJOUTER FLUX EVAP SUR MODELE ATMOS
+ ENDIF
!
+ ELSE ! No coupling NH OA case
+ ! atmosp bottom
+ !* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
+ ! (in presence of slopes)
+ !* in 1DIM case, the part of energy released in horizontal flux
+ ! is taken into account in the vertical part
+ !
+ IF (HTURBDIM=='3DIM') THEN
+ ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
+ * PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ ELSE
+ ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
+ / PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ END IF
+ !
+ IF (LOCEAN) THEN
+ ! General ocean case
+ ! salinity/evap effect to be added later !!!!!
+ ZF(:,:,IKE) = 0.
+ ELSE !end ocean case (in nocoupled case)
+ ! atmos top
+ ZF(:,:,IKE)=0.
+ END IF
+ END IF!end no coupled cases
! Compute the split conservative potential temperature at t+deltat
CALL TRIDIAG_THERMO(KKA,KKU,KKL,PRM(:,:,:,1),ZF,ZDFDDRDZ,PTSTEP,PIMPL,&
PDZZ,PRHODJ,PRP)
!
! Compute the equivalent tendency for the conservative mixing ratio
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRHODJ(:,:,:) * &
- (PRP(:,:,:)-PRM(:,:,:,1))/PTSTEP
+ !
+ ZRWRNP (:,:,:) = PRHODJ(:,:,:)*(PRP(:,:,:)-PRM(:,:,:,1))/PTSTEP
+ !
+ ! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
+ IF (LHGRAD) THEN
+ DO JK=1,KKU
+ ZALT(:,:,JK) = PZZ(:,:,JK)-XZS(:,:)
+ END DO
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD ) .AND. ( ZALT(:,:,:) >= XALTHGRAD ) )
+ ZRWRNP (:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:))*ZF_NEW(:,:,:),XDZZ)
+ END WHERE
+ END IF
+ !
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + ZRWRNP (:,:,:)
!
!* 3.2 Complete thermal production
!
@@ -769,6 +970,13 @@ IF (KRR /= 0) THEN
ZFLXZ(:,:,:) = ZF &
+ PIMPL * ZDFDDRDZ * DZM(PRP - PRM(:,:,:,1)) / PDZZ
!
+ ! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
+ IF (LHGRAD) THEN
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD ) .AND. ( ZALT(:,:,:) >= XALTHGRAD ) )
+ ZFLXZ(:,:,:) = ZF_NEW(:,:,:)
+ END WHERE
+ END IF
+ !
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!
DO JK=IKTB+1,IKTE-1
@@ -795,29 +1003,36 @@ IF (KRR /= 0) THEN
END IF
!
! Contribution of the conservative water flux to the Buoyancy flux
- ZA(:,:,:) = PBETA * MZF( MZM(PEMOIST) * ZFLXZ )
- ZA(:,:,IKB) = PBETA(:,:,IKB) * PEMOIST(:,:,IKB) * &
- 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
- PTP(:,:,:) = PTP(:,:,:) + ZA(:,:,:)
+ IF (LOCEAN) THEN
+ ZA(:,:,:)= -XG*XBETAOC * MZF(ZFLXZ )
+ ELSE
+ ZA(:,:,:) = PBETA * MZF( MZM(PEMOIST) * ZFLXZ )
+ ZA(:,:,IKB) = PBETA(:,:,IKB) * PEMOIST(:,:,IKB) * &
+ 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
+ PTP(:,:,:) = PTP(:,:,:) + ZA(:,:,:)
+ END IF
!
! Buoyancy flux at flux points
!
PWTHV = PWTHV + MZM(PEMOIST) * ZFLXZ
PWTHV(:,:,IKB) = PWTHV(:,:,IKB) + PEMOIST(:,:,IKB) * ZFLXZ(:,:,IKB)
+ IF (LOCEAN) THEN
+ PWTHV(:,:,IKE) = PWTHV(:,:,IKE) + PEMOIST(:,:,IKE)* ZFLXZ(:,:,IKE)
+ END IF
!
!* 3.3 Complete vertical divergence of the < Rc w > flux
!
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- DZF( MZM( PRHODJ*PAMOIST*2.*PSRCM )*ZFLXZ/PDZZ ) &
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ ) &
*(1.0-PFRAC_ICE(:,:,:))
PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
- DZF( MZM( PRHODJ*PAMOIST*2.*PSRCM )*ZFLXZ/PDZZ ) &
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ ) &
*PFRAC_ICE(:,:,:)
ELSE
PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- DZF( MZM( PRHODJ*PAMOIST*2.*PSRCM )*ZFLXZ/PDZZ )
+ PRHODJ*PAMOIST*2.*PSRCM*DZF(ZFLXZ/PDZZ )
END IF
END IF
!
@@ -886,6 +1101,9 @@ IF ( ((OTURB_FLX .AND. tpfile%lopened) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
END IF
!
END IF !end of <w Rc>
+IF (LOCEAN.AND.LDEEPOC) THEN
+ DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
+END IF
!
!----------------------------------------------------------------------------
END SUBROUTINE TURB_VER_THERMO_FLUX
diff --git a/src/MNH/update_nsv.f90 b/src/MNH/update_nsv.f90
index 6d5f9fdd0977068e6b0b0f5f3c98d7b709ecae50..c706bfe90fb70043a98770e68a2ab27e486a7745 100644
--- a/src/MNH/update_nsv.f90
+++ b/src/MNH/update_nsv.f90
@@ -87,6 +87,7 @@ NSV_LIMA_IFN_FREE = NSV_LIMA_IFN_FREE_A(KMI)
NSV_LIMA_IFN_NUCL = NSV_LIMA_IFN_NUCL_A(KMI)
NSV_LIMA_IMM_NUCL = NSV_LIMA_IMM_NUCL_A(KMI)
NSV_LIMA_HOM_HAZE = NSV_LIMA_HOM_HAZE_A(KMI)
+NSV_LIMA_SPRO = NSV_LIMA_SPRO_A(KMI)
!
NSV_ELEC = NSV_ELEC_A(KMI)
NSV_ELECBEG = NSV_ELECBEG_A(KMI)
diff --git a/src/MNH/ver_int_thermo.f90 b/src/MNH/ver_int_thermo.f90
index 1d3424a943e422cf37b2ec52dd4651470c25a108..6be5b55a95870bb49b471dc9c686dd0529088234 100644
--- a/src/MNH/ver_int_thermo.f90
+++ b/src/MNH/ver_int_thermo.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -136,6 +136,7 @@ END MODULE MODI_VER_INT_THERMO
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 22/02/2019: replace Hollerith edit descriptor (deleted from Fortran 95 standard)
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! Jean-Luc Redelsperger 03/2021 OCEAN LES case
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -145,6 +146,7 @@ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT, ONLY: TLUOUT0
@@ -343,38 +345,42 @@ CALL MPPDB_CHECK3D(ZPMHPOHP_SH,"ver_int_thermo2a::ZPMHPOHP_SH",PRECISION)
!* 3.1 Computation of the shift profile
! --------------------------------
!
-ZTHVCLIMGR=3.5E-3 ! K/m
-CALL FREE_ATM_PROFILE(TPFILE,PTHV_MX,PZMASS_MX,PZS_LS,PZSMT_LS,ZTHVCLIMGR,ZTHV_FREE,ZZ_FREE)
-CALL MPPDB_CHECK3D(ZTHV_FREE,"VER_INT_THERMO:ZTHV_FREE",PRECISION)
+IF (LOCEAN) THEN
+ ZTHV_SH(:,:,:) = PTHV_MX(:,:,:)
+ELSE
+ ZTHVCLIMGR=3.5E-3 ! K/m
+ CALL FREE_ATM_PROFILE(TPFILE,PTHV_MX,PZMASS_MX,PZS_LS,PZSMT_LS,ZTHVCLIMGR,ZTHV_FREE,ZZ_FREE)
+ CALL MPPDB_CHECK3D(ZTHV_FREE,"VER_INT_THERMO:ZTHV_FREE",PRECISION)
!
!* 3.2 Computation of the value of thetav on the shifted grid
! ------------------------------------------------------
!
-CALL COEF_VER_INTERP_LIN(ZZ_FREE(:,:,:),PZMASS_MX(:,:,:))
-ZTHV_FREE_MX(:,:,:)=VER_INTERP_LIN(ZTHV_FREE(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"VER_INT_THERMO:ZTHV_FREE_MX",PRECISION)
+ CALL COEF_VER_INTERP_LIN(ZZ_FREE(:,:,:),PZMASS_MX(:,:,:))
+ ZTHV_FREE_MX(:,:,:)=VER_INTERP_LIN(ZTHV_FREE(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+ CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"VER_INT_THERMO:ZTHV_FREE_MX",PRECISION)
!
-!20131113 add update_halo here
-CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"ver_int_thermo3a::ZTHV_FREE_MX",PRECISION)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTHV_FREE_MX, 'VER_INT_THERMO::ZTHV_FREE_MX' )
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!20131112 check3d
-CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"ver_int_thermo2a::ZTHV_FREE_MX",PRECISION)
+ !20131113 add update_halo here
+ CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"ver_int_thermo3a::ZTHV_FREE_MX",PRECISION)
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTHV_FREE_MX, 'VER_INT_THERMO::ZTHV_FREE_MX' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131112 check3d
+ CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"ver_int_thermo2a::ZTHV_FREE_MX",PRECISION)
!
-CALL COEF_VER_INTERP_LIN(ZZ_FREE(:,:,:),ZZMASS_SH(:,:,:))
-ZTHV_FREE_SH(:,:,:)=VER_INTERP_LIN(ZTHV_FREE(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"VER_INT_THERMO:ZTHV_FREE_SH",PRECISION)
+ CALL COEF_VER_INTERP_LIN(ZZ_FREE(:,:,:),ZZMASS_SH(:,:,:))
+ ZTHV_FREE_SH(:,:,:)=VER_INTERP_LIN(ZTHV_FREE(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+ CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"VER_INT_THERMO:ZTHV_FREE_SH",PRECISION)
!
-!20131113 add update_halo here
-CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"ver_int_thermo3a::ZTHV_FREE_SH",PRECISION)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTHV_FREE_SH, 'VER_INT_THERMO::ZTHV_FREE_SH' )
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!20131112 check3d
-CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"ver_int_thermo2a::ZTHV_FREE_SH",PRECISION)
-!
-ZTHV_SH(:,:,:) = PTHV_MX(:,:,:) - ZTHV_FREE_MX(:,:,:) + ZTHV_FREE_SH(:,:,:)
+ !20131113 add update_halo here
+ CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"ver_int_thermo3a::ZTHV_FREE_SH",PRECISION)
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTHV_FREE_SH, 'VER_INT_THERMO::ZTHV_FREE_SH' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131112 check3d
+ CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"ver_int_thermo2a::ZTHV_FREE_SH",PRECISION)
+!
+ ZTHV_SH(:,:,:) = PTHV_MX(:,:,:) - ZTHV_FREE_MX(:,:,:) + ZTHV_FREE_SH(:,:,:)
+END IF
!
!20131113 add update_halo here
CALL MPPDB_CHECK3D(ZTHV_SH,"ver_int_thermo3a::ZTHV_SH",PRECISION)
@@ -393,29 +399,37 @@ CALL MPPDB_CHECK3D(ZTHV_SH,"ver_int_thermo2a::ZTHV_SH",PRECISION)
!* 4.1 Computation of relative humidity on the mixed grid
! --------------------------------------------------
!
-ZRV_MX(:,:,:)=MAX(PR_MX(:,:,:,1),1.E-10)
-ZTH_MX(:,:,:)=PTHV_MX(:,:,:)*(1.+WATER_SUM(PR_MX(:,:,:,:)))/(1.+XRV/XRD*ZRV_MX(:,:,:))
-!
-!20131113 add update_halo here
-CALL MPPDB_CHECK3D(ZTH_MX,"ver_int_thermo4a::ZTH_MX",PRECISION)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTH_MX, 'VER_INT_THERMO::ZTH_MX' )
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!20131112 check3d
-CALL MPPDB_CHECK3D(ZTH_MX,"ver_int_thermo4b::ZTH_MX",PRECISION)
+IF (LOCEAN) THEN
+ ZRV_MX(:,:,:) = PR_MX(:,:,:,1)
+ ZTH_MX(:,:,:) = PTHV_MX(:,:,:)
+ ZT_MX(:,:,:) = ZTH_MX(:,:,:)
+ ZES_MX(:,:,:) = SM_FOES(ZT_MX(:,:,:))
+ ZHU_MX(:,:,:) = 1.E-10
+ELSE
+ ZRV_MX(:,:,:)=MAX(PR_MX(:,:,:,1),1.E-10)
+ ZTH_MX(:,:,:)=PTHV_MX(:,:,:)*(1.+WATER_SUM(PR_MX(:,:,:,:)))/(1.+XRV/XRD*ZRV_MX(:,:,:))
!
-ZT_MX(:,:,:)=ZTH_MX(:,:,:)*ZEXNMASS_MX(:,:,:)
+ !20131113 add update_halo here
+ CALL MPPDB_CHECK3D(ZTH_MX,"ver_int_thermo4a::ZTH_MX",PRECISION)
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTH_MX, 'VER_INT_THERMO::ZTH_MX' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131112 check3d
+ CALL MPPDB_CHECK3D(ZTH_MX,"ver_int_thermo4b::ZTH_MX",PRECISION)
!
-!20131113 add update_halo here
-CALL MPPDB_CHECK3D(ZT_MX,"ver_int_thermo4a::ZT_MX",PRECISION)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZT_MX, 'VER_INT_THERMO::ZT_MX' )
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!20131112 check3d
-CALL MPPDB_CHECK3D(ZT_MX,"ver_int_thermo4b::ZT_MX",PRECISION)
+ ZT_MX(:,:,:)=ZTH_MX(:,:,:)*ZEXNMASS_MX(:,:,:)
!
-ZES_MX(:,:,:)=SM_FOES(ZT_MX(:,:,:))
-ZHU_MX(:,:,:)=100.*ZP_MX(:,:,:)/(XRD/XRV/ZRV_MX(:,:,:)+1.)/ZES_MX(:,:,:)
+ !20131113 add update_halo here
+ CALL MPPDB_CHECK3D(ZT_MX,"ver_int_thermo4a::ZT_MX",PRECISION)
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZT_MX, 'VER_INT_THERMO::ZT_MX' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131112 check3d
+ CALL MPPDB_CHECK3D(ZT_MX,"ver_int_thermo4b::ZT_MX",PRECISION)
+!
+ ZES_MX(:,:,:)=SM_FOES(ZT_MX(:,:,:))
+ ZHU_MX(:,:,:)=100.*ZP_MX(:,:,:)/(XRD/XRV/ZRV_MX(:,:,:)+1.)/ZES_MX(:,:,:)
+END IF
!
!20131113 add update_halo here
CALL MPPDB_CHECK3D(ZHU_MX,"ver_int_thermo4a::ZHU_MX",PRECISION)
@@ -549,17 +563,22 @@ END DO
CALL COMPUTE_EXNER_FROM_TOP(PTHV,XZZ,PEXNTOP2D,ZHEXN,ZHEXNMASS)
ZP(:,:,:) = PPMHP(:,:,:) + XP00 * ZHEXNMASS(:,:,:) ** (XCPD/XRD)
!
-!20131113 add update_halo here
-!CALL MPPDB_CHECK3D(ZP,"ver_int_thermo6a::ZP",PRECISION)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZP, 'VER_INT_THERMO::ZP' )
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-!20131112 check3d
-CALL MPPDB_CHECK3D(ZP,"ver_int_thermo6b::ZP",PRECISION)
-!
-PR(:,:,:,1)=SM_PMR_HU(ZP(:,:,:), &
- PTHV(:,:,:)*(ZP(:,:,:)/XP00)**(XRD/XCPD), &
- ZHU(:,:,:),PR(:,:,:,:),KITERMAX=100)
+IF (LOCEAN) THEN
+ !no interpolation for salinity
+ PR(:,:,:,1)=PR_MX(:,:,:,1)
+ELSE
+ !20131113 add update_halo here
+ !CALL MPPDB_CHECK3D(ZP,"ver_int_thermo6a::ZP",PRECISION)
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZP, 'VER_INT_THERMO::ZP' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131112 check3d
+ CALL MPPDB_CHECK3D(ZP,"ver_int_thermo6b::ZP",PRECISION)
+!
+ PR(:,:,:,1)=SM_PMR_HU(ZP(:,:,:), &
+ PTHV(:,:,:)*(ZP(:,:,:)/XP00)**(XRD/XCPD), &
+ ZHU(:,:,:),PR(:,:,:,:),KITERMAX=100)
+END IF
CALL ADD3DFIELD_ll( TZFIELDS_ll, PR(:,:,:,1), 'VER_INT_THERMO::PR(:,:,:,1)' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
diff --git a/src/MNH/viscosity.f90 b/src/MNH/viscosity.f90
index 711824444a53790ce8fd53934b8edf633a011d16..4a9607c8cd1a382362c1308ed60fd33cf28120b5 100644
--- a/src/MNH/viscosity.f90
+++ b/src/MNH/viscosity.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -92,6 +92,7 @@ SUBROUTINE VISCOSITY(HLBCX, HLBCY, KRR, KSV, PNU, PPRANDTL, &
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 08/11/2019: corrected wrong budget name VISC_BU_RU -> VISC_BU_RTH
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! T. Nagel 02/2021: add adhesion condition in case of an IBM-obstacle at the domain top boundary
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -261,6 +262,8 @@ IF (OVISC_UVW) THEN
ZY1 = MXF(PUT)
IF (ODRAG) THEN
ZY1(:,:,1) = PDRAG * ZY1(:,:,2)
+!!Add adhesion condition in case of an IBM-obstacle at the domain top boundary
+! ZY1(:,:,IKU) = PDRAG * ZY1(:,:,IKE)
ENDIF
!
!
diff --git a/src/MNH/write_aircraft_balloon.f90 b/src/MNH/write_aircraft_balloon.f90
index afa5d56114652c4c2e204caf81a39b70f46c8e4d..a48117c835fa54237c162f999914b7f6f33ea319 100644
--- a/src/MNH/write_aircraft_balloon.f90
+++ b/src/MNH/write_aircraft_balloon.f90
@@ -465,6 +465,7 @@ IF (SIZE(TPFLYER%SV,2)>=1) THEN
YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(4))//INDICE//'T'
ENDIF
IF (JSV .EQ. NSV_LIMA_HOM_HAZE) YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(5))//'T'
+ IF (JSV .EQ. NSV_LIMA_SPRO) YTITLE(JPROC)=TRIM(CLIMA_WARM_NAMES(5))//'T'
ZWORK6 (1,1,1,:,1,JPROC) = TPFLYER%SV(:,JSV)
END DO
! electrical scalar variables
diff --git a/src/MNH/write_desfmn.f90 b/src/MNH/write_desfmn.f90
index c01d74a29d2327fdbba21ef72936691caef8a8cf..fb24c9bae47e3b7140e3a266768cffe9a5216841 100644
--- a/src/MNH/write_desfmn.f90
+++ b/src/MNH/write_desfmn.f90
@@ -144,6 +144,8 @@ END MODULE MODI_WRITE_DESFM_n
!! 02/2018 Q.Libois ECRAD
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Modification V. Vionnet 07/2017 add blowing snow variables
+!! Modification F.Auguste 02/2021 add IBM
+!! E.Jezequel 02/2021 add stations read from CSV file
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -201,6 +203,10 @@ USE MODD_FOREFIRE_n, ONLY : FFCOUPLING
#endif
USE MODN_BLOWSNOW_n
USE MODN_BLOWSNOW
+USE MODN_IBM_PARAM_n
+USE MODN_RECYCL_PARAM_n
+USE MODD_IBM_LSF, ONLY: LIBM_LSF
+USE MODN_STATION_n
!
IMPLICIT NONE
!
@@ -307,6 +313,20 @@ ELSE !return to namelist meaning of LHORELAX_SV
END IF
WRITE(UNIT=ILUSEG,NML=NAM_DYNn)
!
+IF (LIBM_LSF) THEN
+ !
+ CALL INIT_NAM_IBM_PARAMn
+ !
+ WRITE(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
+ !
+ IF (CPROGRAM/='MESONH') THEN
+ LIBM = .FALSE.
+ LIBM_TROUBLE = .FALSE.
+ CIBM_ADV = 'NOTHIN'
+ END IF
+ !
+END IF
+!
CALL INIT_NAM_ADVn
WRITE(UNIT=ILUSEG,NML=NAM_ADVn)
IF (CPROGRAM/='MESONH') THEN
@@ -369,6 +389,9 @@ CALL INIT_NAM_BLOWSNOWn
IF(LBLOWSNOW) WRITE(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
IF(LBLOWSNOW) WRITE(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
!
+CALL INIT_NAM_STATIONn
+IF(LSTATION) WRITE(UNIT=ILUSEG,NML=NAM_STATIONn)
+!
IF(LDUST) WRITE(UNIT=ILUSEG,NML=NAM_DUST)
IF(LSALT) WRITE(UNIT=ILUSEG,NML=NAM_SALT)
IF(LPASPOL) WRITE(UNIT=ILUSEG,NML=NAM_PASPOL)
@@ -449,7 +472,17 @@ IF (NVERB >= 5) THEN
!
WRITE(UNIT=ILUOUT,FMT="('********** ADVECTIONn **************')")
WRITE(UNIT=ILUOUT,NML=NAM_ADVn)
-!
+ !
+ IF (LIBM_LSF) THEN
+ WRITE(UNIT=ILUOUT,FMT="('********** IBM_PARAMn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_IBM_PARAMn)
+ ENDIF
+ !
+ IF (LRECYCL) THEN
+ WRITE(UNIT=ILUOUT,FMT="('********** RECYCL_PARAMn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_RECYCL_PARAMn)
+ ENDIF
+ !
WRITE(UNIT=ILUOUT,FMT="('********** PARAMETERIZATIONSn ******')")
WRITE(UNIT=ILUOUT,NML=NAM_PARAMn)
!
diff --git a/src/MNH/write_les_budgetn.f90 b/src/MNH/write_les_budgetn.f90
index 233955badebee8cae9d1af4e349e40e95c44127d..fec25b5ea6ee41a77ebf0b8f659e8b47d5c3154b 100644
--- a/src/MNH/write_les_budgetn.f90
+++ b/src/MNH/write_les_budgetn.f90
@@ -45,13 +45,15 @@ subroutine Write_les_budget_n( tpdiafile )
!! 06/11/02 (V. Masson) new LES budgets
! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 15/10/2020: restructure Les_diachro calls to use tfield_metadata_base type
+! JL Redelsperger 03/21 modif buoyancy flix for OCEAN LES case
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
use modd_conf_n, only: luserv
-use modd_cst, only: xg
+use modd_cst, only: xg, xalphaoc
+use modd_dyn_n, only: locean
use modd_field, only: NMNHDIM_BUDGET_LES_LEVEL, NMNHDIM_BUDGET_LES_TIME, &
NMNHDIM_BUDGET_TERM, NMNHDIM_UNUSED, &
tfield_metadata_base, TYPEREAL
@@ -763,6 +765,9 @@ ELSE
ZLES_BUDGET(:,:,ILES) = XG * XLES_SUBGRID_ThlThv(:,:,1) &
/ XLES_MEAN_Th (:,:,1)
END IF
+IF (LOCEAN) THEN
+ ZLES_BUDGET(:,:,ILES) = XG * XLES_SUBGRID_ThlThv(:,:,1) *XALPHAOC
+END IF
!
!* 3.6 residual of subgrid budget
! --------------------------
diff --git a/src/MNH/write_lfifm1_for_diag.f90 b/src/MNH/write_lfifm1_for_diag.f90
index 4448d579bf7d4e31da5e0cedbb4c5eb226440a45..60240e9caf00f71d49bb49ef35d0410ceb14dfa1 100644
--- a/src/MNH/write_lfifm1_for_diag.f90
+++ b/src/MNH/write_lfifm1_for_diag.f90
@@ -145,7 +145,9 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG
! P. Wautelet 08/02/2019: minor bug: compute ZWORK36 only when needed
! S Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 18/03/2020: remove ICE2 option
+! B. Vie 06/2020 Add prognostic supersaturation for LIMA
! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
+! J.L Redelsperger 03/2021 Adding OCEAN LES Case and Autocoupled O-A LES
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -455,6 +457,8 @@ CALL IO_Field_write(TPFILE,'DTSEG',TDTSEG)
!
CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN)
CALL IO_Field_write(TPFILE,'LBOUSS', LBOUSS)
+CALL IO_Field_write(TPFILE,'LOCEAN', LOCEAN)
+CALL IO_Field_write(TPFILE,'LCOUPLES', LCOUPLES)
!
IF (LCARTESIAN .AND. LWIND_ZM) THEN
LWIND_ZM=.FALSE.
@@ -462,9 +466,15 @@ IF (LCARTESIAN .AND. LWIND_ZM) THEN
END IF
!* 1.4 Reference state variables :
!
-CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
-CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
-CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
+IF (LCOUPLES.AND.LOCEAN) THEN
+ CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZO)
+ CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZO)
+ CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOPO)
+ELSE
+ CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
+ CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
+ CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
+END IF
!
CALL IO_Field_write(TPFILE,'RHODREF',XRHODREF)
CALL IO_Field_write(TPFILE,'THVREF', XTHVREF)
@@ -1162,6 +1172,11 @@ IF (LLIMA_DIAG) THEN
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(5))//'T'
END IF
!
+! Supersaturation
+ IF (JSV .EQ. NSV_LIMA_SPRO) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_CONC(5))//'T'
+ END IF
+ !
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
ZWORK31(:,:,:)=XSVT(:,:,:,JSV)*1.E-6*XRHODREF(:,:,:)
CALL IO_Field_write(TPFILE,TZFIELD,ZWORK31)
diff --git a/src/MNH/write_lfifm1_for_diag_supp.f90 b/src/MNH/write_lfifm1_for_diag_supp.f90
index 8bec988c742f330982d1e2dfe456820856cba45a..72b614ae57b534f0399a0ad289fd92898c7eecad 100644
--- a/src/MNH/write_lfifm1_for_diag_supp.f90
+++ b/src/MNH/write_lfifm1_for_diag_supp.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-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.
@@ -89,6 +89,7 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!! J.-P. Chaboureau 01/2018 add coarse graining
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! J.-P. Chaboureau 07/2018 bug fix on XEMIS when calling CALL_RTTOVxx
+!! J.-P. Chaboureau 09/04/2021 add the call to RTTOV13
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -154,6 +155,9 @@ USE MODI_CALL_RTTOV8
#ifdef MNH_RTTOV_11
USE MODI_CALL_RTTOV11
#endif
+#ifdef MNH_RTTOV_13
+USE MODI_CALL_RTTOV13
+#endif
USE MODI_RADTR_SATEL
USE MODI_UV_TO_ZONAL_AND_MERID
!
@@ -841,7 +845,7 @@ END IF
! Vertical Sounder (RTTOV) code
!
IF (NRTTOVINFO(1,1) /= NUNDEF) THEN
- PRINT*,'YOU ASK FOR BRIGHTNESS TEMPERATURE COMPUTED by RTTOV code'
+! PRINT*,'YOU ASK FOR BRIGHTNESS TEMPERATURE COMPUTED BY THE RTTOV CODE'
#ifdef MNH_RTTOV_8
CALL CALL_RTTOV8(NDLON, NFLEV, NSTATM, XEMIS(:,:,1), XTSRAD, XSTATM, XTHT, XRT, &
XPABST, XZZ, XMFCONV, XCLDFR, XUT(:,:,IKB), XVT(:,:,IKB), &
@@ -852,9 +856,15 @@ IF (NRTTOVINFO(1,1) /= NUNDEF) THEN
XPABST, XZZ, XMFCONV, XCLDFR, XUT(:,:,IKB), XVT(:,:,IKB), &
LUSERI, NRTTOVINFO, TPFILE )
#else
+#ifdef MNH_RTTOV_13
+ CALL CALL_RTTOV13(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, &
+ XPABST, XZZ, XMFCONV, XCLDFR, XUT(:,:,IKB), XVT(:,:,IKB), &
+ LUSERI, NRTTOVINFO, TPFILE )
+#else
PRINT *, "RTTOV LIBRARY NOT AVAILABLE = ###CALL_RTTOV####"
#endif
#endif
+#endif
END IF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 11e3dc1298e5368a6836277ff1586b754886a24a..ea08bd41d0a36e803f2afda33d7fa63f8d75a317 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -173,8 +173,13 @@ END MODULE MODI_WRITE_LFIFM_n
! S. Bielli 02/2019: Sea salt: significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Tulet 02/2020: correction for dust and sea salts
+!! B. Vie 06/2020 Add prognostic supersaturation for LIMA
+! PA. Joulin 12/2020: add wind turbine outputs
+! F. Auguste 02/2021: add IBM
+! T. Nagel 02/2021: add turbulence recycling
! P. Wautelet 10/03/2021: use scalar variable names for dust and salt
! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
+! J.L. Redelsperger 03/2021: add OCEAN and auto-coupled O-A LES cases
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -183,7 +188,7 @@ END MODULE MODI_WRITE_LFIFM_n
USE MODD_DIM_n
USE MODD_CONF
USE MODD_CONF_n
-use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEINT, TYPEREAL
+use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEINT, TYPELOG, TYPEREAL
USE MODD_GRID
USE MODD_GRID_n
USE MODD_TIME
@@ -226,6 +231,7 @@ USE MODD_HURR_FIELD_n
USE MODD_PREP_REAL, ONLY: CDUMMY_2D, XDUMMY_2D
USE MODD_DUST
USE MODD_SALT
+USE MODD_OCEANH
USE MODD_PASPOL
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
@@ -276,6 +282,15 @@ USE MODD_ADVFRC_n ! Modif PP ADV FRC
USE MODD_RELFRC_n
!
USE MODD_PARAM_C2R2
+!
+USE MODD_EOL_MAIN
+USE MODD_EOL_SHARED_IO
+USE MODD_EOL_ADNR
+USE MODD_EOL_ALM
+!
+USE MODD_RECYCL_PARAM_n
+USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_LS
+USE MODD_IBM_LSF, ONLY: LIBM_LSF
!
IMPLICIT NONE
!
@@ -423,11 +438,24 @@ CALL IO_Field_write(TPFILE,'L2D', L2D)
CALL IO_Field_write(TPFILE,'PACK', LPACK)
CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN)
CALL IO_Field_write(TPFILE,'LBOUSS', LBOUSS)
+CALL IO_Field_write(TPFILE,'LOCEAN', LOCEAN)
+CALL IO_Field_write(TPFILE,'LCOUPLES', LCOUPLES)
!
CALL IO_Field_write(TPFILE,'SURF', CSURF)
CALL IO_Field_write(TPFILE,'CPL_AROME',LCPL_AROME)
CALL IO_Field_write(TPFILE,'COUPLING', LCOUPLING)
!
+TZFIELD%CMNHNAME = 'RECYCLING'
+TZFIELD%CLONGNAME = 'RECYCLING'
+TZFIELD%CSTDNAME = ''
+TZFIELD%CUNITS = ''
+TZFIELD%CDIR = '--'
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPELOG
+TZFIELD%NDIMS = 0
+TZFIELD%LTIMEDEP = .FALSE.
+CALL IO_Field_write(TPFILE,TZFIELD,LRECYCL)
+!
!* 1.4 Prognostic variables :
!
!
@@ -461,6 +489,201 @@ IF ( (CUVW_ADV_SCHEME == 'CEN4TH') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN
CALL IO_Field_write(TPFILE,'DWM',XDWM)
END IF
!
+IF (LIBM .OR. LIBM_LSF) THEN
+ !
+ TZFIELD%CMNHNAME = 'LSFP'
+ TZFIELD%CLONGNAME = 'LSFP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'Level Set Function at mass node'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XIBM_LS(:,:,:,1))
+ !
+ENDIF
+!
+IF (LRECYCL) THEN
+ !
+ TZFIELD%CMNHNAME = 'RCOUNT'
+ TZFIELD%CLONGNAME = 'RCOUNT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = '--'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEINT
+ TZFIELD%NDIMS = 0
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'Incremental counter for averaging purpose'
+ CALL IO_Field_write(TPFILE,TZFIELD,NR_COUNT)
+ !
+ IF (LRECYCLW) THEN
+ TZFIELD%CMNHNAME = 'URECYCLW'
+ TZFIELD%CLONGNAME = 'URECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-WEST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANW(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLW'
+ TZFIELD%CLONGNAME = 'VRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-WEST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANW(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLW'
+ TZFIELD%CLONGNAME = 'WRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-WEST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XWMEANW(:,:,:))
+ !
+ ENDIF
+ IF (LRECYCLN) THEN
+ TZFIELD%CMNHNAME = 'URECYCLN'
+ TZFIELD%CLONGNAME = 'URECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-NORTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANN(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLN'
+ TZFIELD%CLONGNAME = 'VRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-NORTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANN(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLN'
+ TZFIELD%CLONGNAME = 'WRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-NORTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XWMEANN(:,:,:))
+ !
+ ENDIF
+ IF (LRECYCLE) THEN
+ TZFIELD%CMNHNAME = 'URECYCLE'
+ TZFIELD%CLONGNAME = 'URECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-EAST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANE(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLE'
+ TZFIELD%CLONGNAME = 'VRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-EAST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANE(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLE'
+ TZFIELD%CLONGNAME = 'WRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-EAST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XWMEANE(:,:,:))
+ !
+ ENDIF
+ IF (LRECYCLS) THEN
+ TZFIELD%CMNHNAME = 'URECYCLS'
+ TZFIELD%CLONGNAME = 'URECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-SOUTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANS(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLS'
+ TZFIELD%CLONGNAME = 'VRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-SOUTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANS(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLS'
+ TZFIELD%CLONGNAME = 'WRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-SOUTH side plan for recycling purpose'
+ !
+ ENDIF
+ENDIF
+!
IF (MEAN_COUNT /= 0) THEN
!
TZFIELD%CSTDNAME = ''
@@ -491,6 +714,13 @@ IF (MEAN_COUNT /= 0) THEN
TZFIELD%CCOMMENT = 'X_Y_Z_U component of max wind'
CALL IO_Field_write(TPFILE,TZFIELD,XUM_MAX)
!
+ TZFIELD%CMNHNAME = 'UWME'
+ TZFIELD%CLONGNAME = 'UWME'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CCOMMENT = 'X_Y_Z_UW component of mean wind variance'
+ ZWORK3D = XUW_MEAN/MEAN_COUNT-(XUM_MEAN*XWM_MEAN)/MEAN_COUNT**2
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
+ !
TZFIELD%NGRID = 3
!
TZFIELD%CMNHNAME = 'VMME'
@@ -536,6 +766,13 @@ IF (MEAN_COUNT /= 0) THEN
CALL IO_Field_write(TPFILE,TZFIELD,XWM_MAX)
!
TZFIELD%NGRID = 1
+!
+ TZFIELD%CMNHNAME = 'CMME'
+ TZFIELD%CLONGNAME = 'CMME'
+ TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CCOMMENT = 'mean Passive scalar'
+ ZWORK3D = XSVT_MEAN/MEAN_COUNT
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'THMME'
TZFIELD%CLONGNAME = 'THMME'
@@ -771,6 +1008,11 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(5))//'T'
END IF
!
+! Supersaturation
+ IF (JSV .EQ. NSV_LIMA_SPRO) THEN
+ TZFIELD%CMNHNAME = TRIM(CLIMA_WARM_NAMES(5))//'T'
+ END IF
+ !
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
!
@@ -1330,9 +1572,15 @@ END IF
!
!* 1.5 Reference state variables :
!
-CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
-CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
-CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
+IF (LCOUPLES.AND.LOCEAN) THEN
+ CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZO)
+ CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZO)
+ CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOPO)
+ELSE
+ CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
+ CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
+ CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
+END IF
!
!
!* 1.6 Tendencies
@@ -1711,8 +1959,63 @@ IF(LBLOWSNOW) THEN
END IF
ENDIF
!
-!* 1.11 Forcing variables
+!* 1.11 Ocean LES variables
+!
+IF ((.NOT.LCOUPLES).AND.LOCEAN) THEN
+ CALL IO_Field_write(TPFILE,'NFRCLT',NFRCLT)
+ CALL IO_Field_write(TPFILE,'NINFRT',NINFRT)
+ !
+ TZFIELD%CMNHNAME = 'SSUFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSUFL'
+ TZFIELD%CUNITS = 'kg m-1 s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc stress along U to force ocean LES'
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ CALL IO_Field_write(TPFILE,TZFIELD,XSSUFL_T(:))
+ !
+ TZFIELD%CMNHNAME = 'SSVFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSVFL'
+ TZFIELD%CUNITS = 'kg m-1 s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc stress along V to force ocean LES'
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ CALL IO_Field_write(TPFILE,TZFIELD,XSSVFL_T(:))
+ !
+ TZFIELD%CMNHNAME = 'SSTFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSTFL'
+ TZFIELD%CUNITS = 'kg m3 K m s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc total heat flux to force ocean LES'
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ CALL IO_Field_write(TPFILE,TZFIELD,XSSTFL_T(:))
+ !
+ TZFIELD%CMNHNAME = 'SSOLA_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSOLA'
+ TZFIELD%CUNITS = 'kg m3 K m s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc solar flux to force ocean LES'
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ CALL IO_Field_write(TPFILE,TZFIELD,XSSOLA_T(:))
+ !
+END IF ! ocean sfc forcing end
!
+!* 1.12 Forcing variables
!
IF (LFORCING) THEN
!
@@ -1998,7 +2301,7 @@ IF ( L2D_REL_FRC ) THEN
ENDDO
ENDIF
!
-!* 1.11bis Eddy Fluxes variables ! Modif PP
+!* 1.13 Eddy Fluxes variables ! Modif PP
!
IF ( LTH_FLX ) THEN
CALL IO_Field_write(TPFILE,'VT_FLX',XVTH_FLUX_M)
@@ -2007,13 +2310,13 @@ END IF
!
IF ( LUV_FLX) CALL IO_Field_write(TPFILE,'VU_FLX',XVU_FLUX_M)
!
-!* 1.12 Balloon variables
+!* 1.14 Balloon variables
!
!
IF (LFLYER) CALL WRITE_BALLOON_n(TPFILE)
!
!
-!* 1.13 Filtered variables for hurricane initialization
+!* 1.15 Filtered variables for hurricane initialization
!
!
IF ( CPROGRAM=='REAL ' ) THEN
@@ -2058,7 +2361,7 @@ IF ( CPROGRAM=='REAL ' ) THEN
!
END IF
!
-!* 1.14 Dummy variables in PREP_REAL_CASE
+!* 1.16 Dummy variables in PREP_REAL_CASE
!
IF (ALLOCATED(CDUMMY_2D)) THEN
TZFIELD%CSTDNAME = ''
@@ -2079,6 +2382,200 @@ IF ( CPROGRAM=='REAL ' ) THEN
!
END IF
!
+!* 1.17 Wind turbine variables
+!
+! i) Main
+!
+IF (LMAIN_EOL .AND. IMI == NMODEL_EOL) THEN
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CUNITS = 'N'
+!
+ TZFIELD%CMNHNAME = 'FX_RG'
+ TZFIELD%CLONGNAME = 'FX_RG'
+ TZFIELD%CCOMMENT = 'X-component field of aerodynamic force (wind->rotor) in global frame (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFX_RG)
+!
+ TZFIELD%CMNHNAME = 'FY_RG'
+ TZFIELD%CLONGNAME = 'FY_RG'
+ TZFIELD%CCOMMENT = 'Y-component field of aerodynamic force (wind->rotor) in global frame (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFY_RG)
+!
+ TZFIELD%CMNHNAME = 'FZ_RG'
+ TZFIELD%CLONGNAME = 'FZ_RG'
+ TZFIELD%CCOMMENT = 'Z-component field of aerodynamic force (wind->rotor) in global frame (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFZ_RG)
+!
+ TZFIELD%CMNHNAME = 'FX_SMR_RG'
+ TZFIELD%CLONGNAME = 'FX_SMR_RG'
+ TZFIELD%CCOMMENT = 'X-component field of smeared aerodynamic force (wind->rotor) in global frame (N)'
+ TZFIELD%CCOMMENT = ''
+ CALL IO_Field_write(TPFILE,TZFIELD,XFX_SMR_RG)
+!
+ TZFIELD%CMNHNAME = 'FY_SMR_RG'
+ TZFIELD%CLONGNAME = 'FY_SMR_RG'
+ TZFIELD%CCOMMENT = 'Y-component field of smeared aerodynamic force (wind->rotor) in global frame (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFY_SMR_RG)
+!
+ TZFIELD%CMNHNAME = 'FZ_SMR_RG'
+ TZFIELD%CLONGNAME = 'FZ_SMR_RG'
+ TZFIELD%CCOMMENT = 'Z-component field of smeared aerodynamic force (wind->rotor) in global frame (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFZ_SMR_RG)
+!
+SELECT CASE(CMETH_EOL)
+!
+! ii) Actuator Disk without Rotation model
+!
+ CASE('ADNR') ! Actuator Disc Non-Rotating
+!
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%CDIR = '--'
+ TZFIELD%CUNITS = '1'
+!
+ TZFIELD%CMNHNAME = 'A_INDU'
+ TZFIELD%CLONGNAME = 'INDUCTION_FACTOR'
+ TZFIELD%CCOMMENT = 'Induction factor (1)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XA_INDU)
+!
+ TZFIELD%CMNHNAME = 'CT_D'
+ TZFIELD%CLONGNAME = 'CTHRUST_D'
+ TZFIELD%CCOMMENT = 'Thrust coefficient at disk (1), &
+ used with wind speed at disk'
+ CALL IO_Field_write(TPFILE,TZFIELD,XCT_D)
+!
+ TZFIELD%CMNHNAME = 'THRUT'
+ TZFIELD%CLONGNAME = 'THRUSTT_EOL'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID instantaneous thrust of the wind turbines (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHRUT)
+!
+ IF (MEAN_COUNT /= 0) THEN
+
+ TZFIELD%CMNHNAME = 'THRUMME'
+ TZFIELD%CLONGNAME = 'MEAN_THRUST_EOL'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID mean thrust of the wind turbines (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHRU_SUM/MEAN_COUNT)
+!
+ END IF
+! iii) Actuator Line Model
+!
+ CASE('ALM') ! Actuator Line Method
+!
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%CDIR = '--'
+!
+ TZFIELD%NDIMS = 1
+!
+ TZFIELD%CMNHNAME = 'THRUT'
+ TZFIELD%CLONGNAME = 'THRUSTT_EOL'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID instantaneous thrust (N) of wind turbines'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHRUT)
+!
+ TZFIELD%CMNHNAME = 'TORQT'
+ TZFIELD%CLONGNAME = 'TORQUET_EOL'
+ TZFIELD%CUNITS = 'Nm'
+ TZFIELD%CCOMMENT = 'RID instantaneous torque (Nm) of wind turbines'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTORQT)
+!
+ TZFIELD%CMNHNAME = 'POWT'
+ TZFIELD%CLONGNAME = 'POWERT_EOL'
+ TZFIELD%CUNITS = 'W'
+ TZFIELD%CCOMMENT = 'RID instantaneous power (W) of wind turbines'
+ CALL IO_Field_write(TPFILE,TZFIELD,XPOWT)
+!
+ TZFIELD%NDIMS = 3
+!
+ TZFIELD%CMNHNAME = 'ELT_RAD'
+ TZFIELD%CLONGNAME = 'ELT_RAD'
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CCOMMENT = 'RID_BID_EID radius (m) of wind turbine blade elements'
+ CALL IO_Field_write(TPFILE,TZFIELD,XELT_RAD)
+!
+ TZFIELD%CMNHNAME = 'AOA'
+ TZFIELD%CLONGNAME = 'ANGLE OF ATTACK'
+ TZFIELD%CUNITS = 'rad'
+ TZFIELD%CCOMMENT = 'RID_BID_EID instantaneous angle of attack (rad)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XAOA_GLB)
+!
+ TZFIELD%CMNHNAME = 'FLIFT'
+ TZFIELD%CLONGNAME = 'LIFT FORCE'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID_BID_EID instantaneous lift (N) in relative frame'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFLIFT_GLB)
+!
+ TZFIELD%CMNHNAME = 'FDRAG'
+ TZFIELD%CLONGNAME = 'DRAG FORCE'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID_BID_EID instantaneous drag (N) in relative frame'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFDRAG_GLB)
+!
+ TZFIELD%NDIMS = 4
+!
+ TZFIELD%CMNHNAME = 'FAERO_RE'
+ TZFIELD%CLONGNAME = 'AERODYNAMIC FORCE RE'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID_BID_EID_XYZ instantaneous forces (N) in RE'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFAERO_RE_GLB)
+!
+ TZFIELD%CMNHNAME = 'FAERO_RG'
+ TZFIELD%CLONGNAME = 'AERODYNAMIC FORCE RG'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID_BID_EID_XYZ instantaneous forces (N) in RG'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFAERO_RG_GLB)
+!
+ IF (MEAN_COUNT /= 0) THEN
+!
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%CDIR = '--'
+!
+ TZFIELD%NDIMS = 1
+!
+ TZFIELD%CMNHNAME = 'THRUMME'
+ TZFIELD%CLONGNAME = 'MEAN_THRUST_EOL'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID mean thrust of the wind turbines (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHRU_SUM/MEAN_COUNT)
+!
+ TZFIELD%CMNHNAME = 'TORQMME'
+ TZFIELD%CLONGNAME = 'MEAN_TORQUE_EOL'
+ TZFIELD%CUNITS = 'Nm'
+ TZFIELD%CCOMMENT = 'RID mean torque of the wind turbines (Nm)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTORQ_SUM/MEAN_COUNT)
+!
+ TZFIELD%CMNHNAME = 'POWMME'
+ TZFIELD%CLONGNAME = 'MEAN_POWER_EOL'
+ TZFIELD%CUNITS = 'W'
+ TZFIELD%CCOMMENT = 'RID mean power of the wind turbines (W)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XPOW_SUM/MEAN_COUNT)
+!
+ TZFIELD%NDIMS = 3
+!
+ TZFIELD%CMNHNAME = 'AOAMME'
+ TZFIELD%CLONGNAME = 'MEAN_ANGLE_OF_ATTACK'
+ TZFIELD%CUNITS = 'rad'
+ TZFIELD%CCOMMENT = 'RID_BID_EID mean angle of attack (rad)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XAOA_SUM/MEAN_COUNT)
+!
+ TZFIELD%NDIMS = 4
+!
+ TZFIELD%CMNHNAME = 'FAEROMME_RE'
+ TZFIELD%CLONGNAME = 'MEAN_AERODYNAMIC_FORCE_RE'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID_BID_EID_XYZ mean forces (N) in RE'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFAERO_RE_SUM/MEAN_COUNT)
+!
+ END IF
+!
+ END SELECT
+END IF
!
DEALLOCATE(ZWORK2D,ZWORK3D)
!
diff --git a/src/MNH/write_profilern.f90 b/src/MNH/write_profilern.f90
index da881113ce3a4ddab6f0904deef266114b15edab..16a433d17e545a4c0d6d1ca3489ccdd040eecbf2 100644
--- a/src/MNH/write_profilern.f90
+++ b/src/MNH/write_profilern.f90
@@ -493,6 +493,7 @@ IF (SIZE(TPROFILER%SV,4)>=1) THEN
YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(4))//INDICE//'T'
ENDIF
IF (JSV .EQ. NSV_LIMA_HOM_HAZE) YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(5))//'T'
+ IF (JSV .EQ. NSV_LIMA_SPRO) YTITLE(JPROC)=TRIM(CLIMA_WARM_NAMES(5))//'T'
ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
END DO
diff --git a/src/MNH/write_stationn.f90 b/src/MNH/write_stationn.f90
index 1254fa13337a42e1e6532aeaa91f66c2f0ca1511..7934d9f400638166ba241ad91dd3e099d1378f54 100644
--- a/src/MNH/write_stationn.f90
+++ b/src/MNH/write_stationn.f90
@@ -81,7 +81,7 @@ USE MODD_LG, ONLY: CLGNAMES
USE MODD_LUNIT
USE MODD_NSV
USE MODD_PARAMETERS
-USE MODD_PARAM_n, ONLY: CRAD
+USE MODD_PARAM_n, ONLY: CRAD, CSURF
USE MODD_PASPOL
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
USE MODD_SALT, ONLY: CSALTNAMES, LSALT, NMODE_SLT
@@ -157,15 +157,19 @@ type(tfield_metadata_base), dimension(:), allocatable :: tzfields
IF (TSTATION%X(II)==XUNDEF) RETURN
IF (TSTATION%Y(II)==XUNDEF) RETURN
!
-IPROC = 8 + SIZE(TSTATION%R,3) + SIZE(TSTATION%SV,3)
+IPROC = 6 + SIZE(TSTATION%R,3) + SIZE(TSTATION%SV,3)
+IF (TSTATION%X(II)==XUNDEF) IPROC = IPROC + 2
IF (SIZE(TSTATION%TKE )>0) IPROC = IPROC + 1
-IF (LDIAG_IN_RUN) IPROC = IPROC + 17
+IF (LDIAG_IN_RUN) THEN
+ IF(CSURF=="EXTE") IPROC = IPROC + 10
+ IF(CRAD/="NONE") IPROC = IPROC + 7
+END IF
IF (LORILAM) IPROC = IPROC + JPMODE*(3+NSOA+NCARB+NSP)
IF (LDUST) IPROC = IPROC + NMODE_DST*3
IF (LSALT) IPROC = IPROC + NMODE_SLT*3
-IF (SIZE(TSTATION%TSRAD)>0) IPROC = IPROC + 1
-IF (SIZE(TSTATION%SFCO2,1)>0) IPROC = IPROC +1
+IF (ANY(TSTATION%TSRAD(:,:)/=XUNDEF)) IPROC = IPROC + 1
+IF (ANY(TSTATION%SFCO2(:,:)/=XUNDEF)) IPROC = IPROC + 1
!
ALLOCATE (ZWORK6(1,1,1,SIZE(tstation%tpdates),1,IPROC))
ALLOCATE (YCOMMENT(IPROC))
@@ -187,21 +191,15 @@ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZS(II)
!
JPROC = JPROC + 1
YTITLE (JPROC) = 'P'
-YUNIT (JPROC) = 'Pascal'
+YUNIT (JPROC) = 'Pa'
YCOMMENT (JPROC) = 'Pressure'
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%P(:,II)
!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'LON'
-YUNIT (JPROC) = 'degree'
-YCOMMENT (JPROC) = 'Longitude'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LON(II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'LAT'
-YUNIT (JPROC) = 'degree'
-YCOMMENT (JPROC) = 'Latitude'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LAT(II)
+!JPROC = JPROC + 1
+!YTITLE (JPROC) = 'Z'
+!YUNIT (JPROC) = 'm'
+!YCOMMENT (JPROC) = 'Z Pos'
+!ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Z(II)
!
IF (LCARTESIAN) THEN
JPROC = JPROC + 1
@@ -215,21 +213,45 @@ IF (LCARTESIAN) THEN
YUNIT (JPROC) = 'm'
YCOMMENT (JPROC) = 'Y Pos'
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Y(II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'U'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = 'Axial velocity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'V'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = 'Transversal velocity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER(:,II)
+ELSE
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'LON'
+ YUNIT (JPROC) = 'degree'
+ YCOMMENT (JPROC) = 'Longitude'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LON(II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'LAT'
+ YUNIT (JPROC) = 'degree'
+ YCOMMENT (JPROC) = 'Latitude'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LAT(II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'ZON_WIND'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = 'Zonal wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'MER_WIND'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = 'Meridional wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER(:,II)
ENDIF
!
JPROC = JPROC + 1
-YTITLE (JPROC) = 'ZON_WIND'
-YUNIT (JPROC) = 'm s-1'
-YCOMMENT (JPROC) = 'Zonal wind'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON(:,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'MER_WIND'
-YUNIT (JPROC) = 'm s-1'
-YCOMMENT (JPROC) = 'Meridional wind'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER(:,II)
-!
-JPROC = JPROC + 1
YTITLE (JPROC) = 'W'
YUNIT (JPROC) = 'm s-1'
YCOMMENT (JPROC) = 'Air vertical speed'
@@ -242,60 +264,67 @@ YCOMMENT (JPROC) = 'Potential temperature'
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%TH(:,II)
!
IF (LDIAG_IN_RUN) THEN
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'T2m'
- YUNIT (JPROC) = 'K'
- YCOMMENT (JPROC) = '2-m temperature'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%T2M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'Q2m'
- YUNIT (JPROC) = 'kg kg-1'
- YCOMMENT (JPROC) = '2-m humidity'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Q2M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'HU2m'
- YUNIT (JPROC) = 'percent'
- YCOMMENT (JPROC) = '2-m relative humidity'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%HU2M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'zon10m'
- YUNIT (JPROC) = 'm s-1'
- YCOMMENT (JPROC) = '10-m zonal wind'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON10M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'mer10m'
- YUNIT (JPROC) = 'm s-1'
- YCOMMENT (JPROC) = '10-m meridian wind'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER10M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'RN'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Net radiation'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%RN(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'H'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Sensible heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%H(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'LE'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Total Latent heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LE(:,II)
-!
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'G'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Storage heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%GFLUX(:,II)
- !
+ IF (CSURF=="EXTE") THEN
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'T2m'
+ YUNIT (JPROC) = 'K'
+ YCOMMENT (JPROC) = '2-m temperature'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%T2M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'Q2m'
+ YUNIT (JPROC) = 'kg kg-1'
+ YCOMMENT (JPROC) = '2-m humidity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Q2M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'HU2m'
+ YUNIT (JPROC) = 'percent'
+ YCOMMENT (JPROC) = '2-m relative humidity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%HU2M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'zon10m'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = '10-m zonal wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON10M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'mer10m'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = '10-m meridian wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER10M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'RN'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Net radiation'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%RN(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'H'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Sensible heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%H(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'LE'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Total Latent heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LE(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'G'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Storage heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%GFLUX(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'LEI'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Solid Latent heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LEI(:,II)
+ END IF
IF (CRAD /= 'NONE') THEN
JPROC = JPROC + 1
YTITLE (JPROC) = 'SWD'
@@ -340,11 +369,6 @@ IF (LDIAG_IN_RUN) THEN
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%DSTAOD(:,II)
!
END IF
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'LEI'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Solid Latent heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LEI(:,II)
ENDIF
!
DO JRR=1,SIZE(TSTATION%R,3)
@@ -696,7 +720,7 @@ ENDIF
DEALLOCATE (ZN0,ZRG,ZSIG)
END IF
-IF (SIZE(TSTATION%TSRAD,1)>0) THEN
+IF (ANY(TSTATION%TSRAD(:,:)/=XUNDEF)) THEN
JPROC = JPROC+1
YTITLE (JPROC) = 'Tsrad'
YUNIT (JPROC) = 'K'
@@ -704,7 +728,7 @@ IF (SIZE(TSTATION%TSRAD,1)>0) THEN
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%TSRAD(:,II)
END IF
!
-IF (SIZE(TSTATION%SFCO2,1)>0) THEN
+IF (ANY(TSTATION%SFCO2(:,:)/=XUNDEF)) THEN
JPROC = JPROC+1
YTITLE (JPROC) = 'SFCO2'
YUNIT (JPROC) = 'mg m-2 s-1'
diff --git a/src/Makefile b/src/Makefile
index 51dc9e3b157e921db3b884df713ced5410b1597f..03c5d4492c4f7bc0cba2db78ed82a3ad46a152ae 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+#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.
@@ -177,7 +177,11 @@ DEP_ALL_USER = $(sort $(filter-out $(IGNORE_DEP_USER) ,$(DEP_USER)) )
.PHONY : all objdirmaster libmaster bibmaster objmaster progmaster
.PHONY : installmaster cleanlibmaster cleanmaster cleanobjmaster cleanprogmaster
+ifeq "$(MNH_GRIBAPI)" "yes"
all : gribapi progmaster
+else
+all : eccodes_lib progmaster
+endif
objdirmaster : $(OBJDIR_MASTER)/.dummy
@@ -196,7 +200,11 @@ ifeq "$(VER_OASIS)" "OASISAUTO"
depmaster : oasis
endif
+ifeq "$(MNH_GRIBAPI)" "yes"
depmaster : gribapi
+else
+depmaster : eccodes_lib
+endif
filedepallmaster : $(DEP_ALL_MASTER)
find $(OBJDIR_MASTER) -follow -name "*.D" > $(OBJDIR_MASTER)/filemaster
@@ -288,35 +296,6 @@ installuser :
cleanproguser :
test -d $(OBJDIR_USER) && cd $(OBJDIR_USER) && rm -f $(PROG_LIST)
-
-##########################################################
-# #
-# EXTRA LIB : GRIBEX #
-# #
-##########################################################
-ifneq "$(findstring 64,$(shell uname -m))" ""
-A64=A64
-endif
-#$(LIB_GRIBEX) : libmaster
-$(LIB_GRIBEX) :
-ifneq "$(ARCH)" "SX8"
- - [ ! -d $(DIR_GRIBEX)_$(ARCH) ] && cp -Rp $(DIR_GRIBEX) $(DIR_GRIBEX)_$(ARCH)
- cd $(DIR_GRIBEX)_$(ARCH) && $(MAKE) -j 1 ARCH=$(TARGET_GRIBEX) R64=$(R64_GRIBEX) CNAME=$(CNAME_GRIBEX) A64=$(A64)
-else
-ifneq "$(findstring brodie,$(shell uname -n))" ""
-#brodie
- - [ ! -d $(DIR_GRIBEX)_$(ARCH) ] && mkdir -p ${workdir}/$(DIR_GRIBEX)_$(ARCH) \
- && ln -s ${workdir}/$(DIR_GRIBEX)_$(ARCH) $(DIR_GRIBEX)_$(ARCH)
- cp /home/rech/mnh/rmnh007/aeronec/mesonh/binaries/libemosR64.a $(DIR_GRIBEX)_$(ARCH)/libgribexR64.a
-else
-#tori & yuki
- - [ ! -d $(DIR_GRIBEX)_$(ARCH) ] && mkdir -p $(DIR_GRIBEX)_$(ARCH)
- cp /usr/local/SX/lib/libgribex.a $(DIR_GRIBEX)_$(ARCH)/libgribexR64.a
-endif
-endif
-
-gribex_clean :
- - [ -d $(DIR_GRIBEX)_$(ARCH) ] && rm -fr $(DIR_GRIBEX)_$(ARCH)
##########################################################
# #
# EXTRA LIB : GRIBAPI #
@@ -326,13 +305,31 @@ ifneq "$(findstring 64,$(shell uname -m))" ""
A64=A64
endif
gribapi : $(GRIBAPI_INC)
-$(GRIBAPI_INC) :
+$(GRIBAPI_INC) :
cd ${DIR_GRIBAPI} && ./configure --disable-shared --disable-jpeg --prefix=${GRIBAPI_PATH} CC="$(CC)" \
FC="$(FC)" FCFLAGS="$(GRIB_FLAGS)" ${GRIBAPI_CONF} && $(MAKE) -j 1 clean && \
$(MAKE) -j 1 && $(MAKE) -j 1 install && $(MAKE) -j 1 clean
gribapi_clean :
- - [ -d ${GRIBAPI_PATH} ] && rm -fr ${GRIBAPI_PATH}
+ - [ -d ${GRIBAPI_PATH} ] && rm -fr ${GRIBAPI_PATH}
+##########################################################
+# #
+# EXTRA LIB : ecCodes #
+# #
+##########################################################
+eccodes_lib : $(ECCODES_MOD)
+$(ECCODES_MOD) :
+ - [ ! -d $(DIR_ECCODES_BUILD) ] && mkdir -p $(DIR_ECCODES_BUILD)
+ cd ${DIR_ECCODES_BUILD} && \
+ cmake ${DIR_ECCODES_SRC} -DCMAKE_INSTALL_PREFIX=${DIR_ECCODES_INSTALL} -DBUILD_SHARED_LIBS=OFF \
+ -DENABLE_NETCDF=OFF -DENABLE_JPG=OFF -DENABLE_PYTHON=OFF -DENABLE_EXAMPLES=OFF \
+ -DCMAKE_Fortran_COMPILER=$(FC) -DCMAKE_C_COMPILER=$(CC) \
+ -DCMAKE_Fortran_FLAGS=$(ECCODES_FFLAGS) -DCMAKE_C_FLAGS=$(ECCODES_CFLAGS) && \
+ $(MAKE) && $(MAKE) install && $(MAKE) clean
+
+eccodes_lib_clean :
+ - [ -d ${DIR_ECCODES_BUILD} ] && rm -fr ${DIR_ECCODES_BUILD}
+ - [ -d ${DIR_ECCODES_INSTALL} ] && rm -fr ${DIR_ECCODES_INSTALL}
##########################################################
# #
# EXTRA LIB : NETCDF #
@@ -417,7 +414,7 @@ endif
##########################################################
ifdef PROG_LIST
-prog : lib $(LIB_GRIBEX)
+prog : lib
@$(MAKE) -I$(B)$(OBJDIR) DEP=YES $(PROG_LIST)
install : $(patsubst %,%-${ARCH_XYZ},$(PROG_LIST))
@@ -427,7 +424,7 @@ $(PROG_LIST) : OBJ_PROG=$(shell find $(PROG_DIR) -follow -type f -name "spll_*.f
| xargs grep -l -E -i "^[[:space:]]*program *$@" | sed -e 's/\.f.*/.o/g' | head -1 \
| xargs basename | xargs -I{} find $(PROG_DIR) -follow -name {} -print | head -1 )
-$(PROG_LIST) : $(LIB_MNH) $(LIB_GRIBEX)
+$(PROG_LIST) : $(LIB_MNH)
# echo OBJ_PROG=$(OBJ_PROG)
$(F90) $(LDFLAGS) -o $(OBJDIR)/$@ $(OBJ_PROG) $(LIB_MNH) $(LIBS)
@@ -511,7 +508,7 @@ endif
cleanuser :
test -d $(OBJDIR_USER) && rm -fr $(OBJDIR_USER)
-clean : examplesclean gribex_clean
+clean : examplesclean eccodes_lib_clean
rm -fr $(OBJDIR_ROOT)
cleanprog :
cd $(OBJDIR_ROOT) ; rm -f $(PROG_LIST)
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index 6c397c8646b31f54249993aa52decfba6e2b450f..016e8ce5fd41f2de176a029279a37479c1265eb5 100644
--- a/src/Makefile.MESONH.mk
+++ b/src/Makefile.MESONH.mk
@@ -115,6 +115,14 @@ CPPFLAGS += $(CPPFLAGS_SURCOUCHE)
#ARCH_XYZ := $(ARCH_XYZ)-$(VER_SURCOUCHE)
endif
##########################################################
+# Source MINPACK #
+##########################################################
+DIR_MINPACK += LIB/minpack
+#
+ifdef DIR_MINPACK
+DIR_MASTER += $(DIR_MINPACK)
+endif
+##########################################################
# Source RAD #
##########################################################
# PRE_BUG TEST !!!
@@ -199,6 +207,18 @@ VPATH += $(RTTOV_PATH)/mod
CPPFLAGS += $(CPPFLAGS_RTTOV)
CPPFLAGS_MNH += -DMNH_RTTOV_11=MNH_RTTOV_11
endif
+ifeq "$(VER_RTTOV)" "13.0"
+DIR_RTTOV=${SRC_MESONH}/src/LIB/RTTOV-${VER_RTTOV}
+RTTOV_PATH=${DIR_RTTOV}
+#
+INC_RTTOV ?= -I${RTTOV_PATH}/include -I${RTTOV_PATH}/mod
+LIB_RTTOV ?= -L${RTTOV_PATH}/lib -lrttov13_coef_io -lrttov13_hdf -lrttov13_mw_scatt -lrttov13_brdf_atlas -lrttov13_main
+INC += $(INC_RTTOV)
+LIBS += $(LIB_RTTOV)
+VPATH += $(RTTOV_PATH)/mod
+CPPFLAGS += $(CPPFLAGS_RTTOV)
+CPPFLAGS_MNH += -DMNH_RTTOV_13=MNH_RTTOV_13
+endif
endif
##########################################################
# Source MEGAN #
@@ -414,31 +434,15 @@ INC += $(INC_MPI)
LIBS += $(LIB_MPI)
endif
-
ARCH_XYZ := $(ARCH_XYZ)-$(VER_MPI)
-##########################################################
-# Librairie GRIBEX #
-##########################################################
-#ifneq "$(ARCH)" "BG"
-# Gribex bypass on BG for the moment
-#DIR_GRIBEX += LIB/GRIBEX
-#endif
-#
-#ifdef DIR_GRIBEX
-#LIB_GRIBEX = $(DIR_GRIBEX)_$(ARCH)/libgribexR64.a
-#LIBS += $(LIB_GRIBEX)
-#R64_GRIBEX=R64
-#endif
+
##########################################################
# Librairie GRIBAPI #
##########################################################
-#ifneq "$(ARCH)" "BG"
-# Gribapi bypass on BG for the moment
+ifeq "$(MNH_GRIBAPI)" "yes"
DIR_GRIBAPI?=${SRC_MESONH}/src/LIB/grib_api-${VERSION_GRIBAPI}
GRIBAPI_PATH?=${OBJDIR_MASTER}/GRIBAPI-${VERSION_GRIBAPI}
-#GRIBAPI_PATH?=${DIR_GRIBAPI}-${ARCH}${MNH_INT}
GRIBAPI_INC?=${GRIBAPI_PATH}/include/grib_api.mod
-#endif
#
ifdef DIR_GRIBAPI
INC_GRIBAPI ?= -I${GRIBAPI_PATH}/include
@@ -448,6 +452,25 @@ LIBS += $(LIB_GRIBAPI)
VPATH += $(GRIBAPI_PATH)/include
R64_GRIBAPI=R64
endif
+endif
+
+##########################################################
+# ecCodes library #
+##########################################################
+ifneq "$(MNH_GRIBAPI)" "yes"
+DIR_ECCODES_SRC?=${SRC_MESONH}/src/LIB/eccodes-${VERSION_ECCODES}-Source
+DIR_ECCODES_BUILD?=${OBJDIR_MASTER}/build_eccodes-${VERSION_ECCODES}
+DIR_ECCODES_INSTALL?=${OBJDIR_MASTER}/ECCODES-${VERSION_ECCODES}
+ECCODES_MOD?=${DIR_ECCODES_INSTALL}/include/grib_api.mod
+#
+ifdef DIR_ECCODES_SRC
+INC_ECCODES ?= -I${DIR_ECCODES_INSTALL}/include
+LIB_ECCODES ?= -L${DIR_ECCODES_INSTALL}/lib -L${DIR_ECCODES_INSTALL}/lib64 -leccodes_f90 -leccodes
+INC += $(INC_ECCODES)
+LIBS += $(LIB_ECCODES)
+VPATH += $(DIR_ECCODES_INSTALL)/include
+endif
+endif
##########################################################
# Librairie OASIS #
@@ -499,7 +522,7 @@ CDF_PATH?=${OBJDIR_MASTER}/NETCDF-${VERSION_CDFF}
CDF_MOD?=${CDF_PATH}/include/netcdf.mod
#
INC_NETCDF ?= -I${CDF_PATH}/include
-LIB_NETCDF ?= -L${CDF_PATH}/lib -L${CDF_PATH}/lib64 -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lsz -laec -lz -ldl
+LIB_NETCDF ?= -L${CDF_PATH}/lib -L${CDF_PATH}/lib64 -lnetcdff -lnetcdf -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -lsz -laec -lz -ldl
#
INC += $(INC_NETCDF)
LIBS += $(LIB_NETCDF)
diff --git a/src/Rules.AIX64.mk b/src/Rules.AIX64.mk
index 88f2cd2c44ff17b19cc462471bb6782fc9f26caa..5f750fdcd0834593bf318df7f3003f1c19a90732 100644
--- a/src/Rules.AIX64.mk
+++ b/src/Rules.AIX64.mk
@@ -86,13 +86,6 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DAMAX1=MAX -DMNH -DSFX_MNH
#
-# Gribex flags
-#
-#TARGET_GRIBEX=rs6000
-TARGET_GRIBEX=ibm_power4
-CNAME_GRIBEX=""
-#A64=A64
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
@@ -113,6 +106,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.BG.mk b/src/Rules.BG.mk
index 802ddba3f7f955457b6ddfa05aabae93819a2f9b..7f4261c7599a8580df10c866f1e855bba192675c 100644
--- a/src/Rules.BG.mk
+++ b/src/Rules.BG.mk
@@ -97,13 +97,6 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DAMAX1=MAX -DMNH -DSFX_MNH
#
-# Gribex flags
-#
-#TARGET_GRIBEX=rs6000
-TARGET_GRIBEX=ibm_power4
-CNAME_GRIBEX=""
-#A64=A64
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
@@ -124,6 +117,12 @@ MNH_IOLFI=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.BGQ.mk b/src/Rules.BGQ.mk
index 3500dde671ff1e89a01392f2cb39c08d382afa96..1fd0a07bd041649c96d941cd91a50b58d5063364 100644
--- a/src/Rules.BGQ.mk
+++ b/src/Rules.BGQ.mk
@@ -121,7 +121,6 @@ F77FLAGS = $(OPT) -qfixed
FX90 = $(F90)
FX90FLAGS = $(OPT) -qfixed
#
-# compiler & flags for compilation of grib_api
# for reproductibility need : -qfloat=nomaf
#
FC = mpixlf95_r
@@ -154,15 +153,6 @@ INC += -I${GA_ROOT}/include
LIBS += -L${GA_ROOT}/lib -larmci -lga -lgfortran
endif
#
-# Gribex flags
-#
-#TARGET_GRIBEX=rs6000
-TARGET_GRIBEX=ibm_power4
-CNAME_GRIBEX=""
-#A64=A64
-# Gribapi flags
-GRIBAPI_CONF= --host=powerpc64-bgq-linux
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
@@ -183,6 +173,12 @@ MNH_IOLFI=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXNAGfor.mk b/src/Rules.LXNAGfor.mk
index 5ccc4a7b119565743b50c83396ae497c971bb9f9..f623af39cfc550ed248e92cb7a5085f10f3255c4 100644
--- a/src/Rules.LXNAGfor.mk
+++ b/src/Rules.LXNAGfor.mk
@@ -73,12 +73,6 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DSFX_MNH
-#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=_nagfor
-GRIB_FLAGS = -dusty -kind=byte
#
# Netcdf/HDF5 flags
#
@@ -105,6 +99,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXarm.mk b/src/Rules.LXarm.mk
index 64f5e01dbbb001cda375b04f96d94a0d9b5ae111..5ae81163a76f5575199c1553a04821c1ddd95abe 100644
--- a/src/Rules.LXarm.mk
+++ b/src/Rules.LXarm.mk
@@ -94,11 +94,6 @@ INC += -I${GA_ROOT}/include
LIBS += -L${GA_ROOT}/lib -larmci -lga
endif
#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=_gfortran
-#
# Netcdf/HDF5 flags
#
HDF_CONF= CFLAGS=-std=c99
@@ -127,6 +122,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXcray.mk b/src/Rules.LXcray.mk
index 20b92e599d0254d5891df8ee4b814659b52009cf..8b5a2ec2e28d06909c75cd99c88f3a866b9f7707 100644
--- a/src/Rules.LXcray.mk
+++ b/src/Rules.LXcray.mk
@@ -90,16 +90,6 @@ CPPFLAGS_SURCOUCHE += -DMNH_GA
INC += -I${GA_ROOT}/include
LIBS += -L${GA_ROOT}/lib -larmci -lga -lgfortran
endif
-#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=_gfortran
-#
-# GRIB_API
-#
-GRIBAPI_CONF="FCFLAGS= -em -ef "
-
#
# LIBTOOLS flags
#
@@ -121,6 +111,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXg95.mk b/src/Rules.LXg95.mk
index 8b3da6758987ccf17f9800b37b764e685eda92e9..305f9f56c94423a95e415dce2fb5939f4ee24470 100644
--- a/src/Rules.LXg95.mk
+++ b/src/Rules.LXg95.mk
@@ -67,11 +67,6 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DAINT=INT -DAMOD=MOD -DMNH -DSFX_MNH
#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=g95
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
@@ -92,6 +87,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXgfortran.mk b/src/Rules.LXgfortran.mk
index d4e628326b63b2a0ea2910fc46899dbbc18538a4..73839121f600b5bf5ff025c40f66e2e3789a9dc6 100644
--- a/src/Rules.LXgfortran.mk
+++ b/src/Rules.LXgfortran.mk
@@ -86,11 +86,6 @@ INC += -I${GA_ROOT}/include
LIBS += -L${GA_ROOT}/lib -larmci -lga
endif
#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=_gfortran
-#
# Netcdf/HDF5 flags
#
HDF_CONF= CFLAGS=-std=c99
@@ -121,15 +116,23 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
#
# Force -fallow-argument-mismatch option for gcc >= 10.1
# Necessary because some subroutines may be called with different datatypes
# Known list: MPI_Allgatherv,MPI_Allreduce,MPI_Bcast,MPI_Bsend,MPI_Gather,MPI_Gatherv,MPI_Recv,LEPOLY,EXTRACT_BBUFF,FILL_BBUFF
-# + gribapi + netCDF-fortran < 4.5.3
+# + ecCodes + netCDF-fortran < 4.5.3
#
ifeq ($(shell test $(GFV) -ge 1010 ; echo $$?),0)
OPT_BASE += -fallow-argument-mismatch
GRIB_FLAGS += -fallow-argument-mismatch
+NETCDF_SUPPFLAGS += -fallow-argument-mismatch
+ECCODES_FFLAGS += -fallow-argument-mismatch
endif
##########################################################
# #
diff --git a/src/Rules.LXifort.mk b/src/Rules.LXifort.mk
index 41d28547b5d3d70030bf351c349fe56b93f2f788..b7f8e24bdb1236b64d9c9ed0346b2a463f8066b9 100644
--- a/src/Rules.LXifort.mk
+++ b/src/Rules.LXifort.mk
@@ -166,7 +166,7 @@ FX90FLAGS = $(OPT)
# -132
#
#LDFLAGS = -Wl,-noinhibit-exec -Wl,-warn-once $(PAR)
-LDFLAGS = -Wl,-warn-once $(PAR) -Wl,-rpath=$(LD_LIBRARY_PATH) $(OPT_BASE)
+LDFLAGS = -Wl,--allow-multiple-definition -Wl,-warn-once $(PAR) -Wl,-rpath=$(LD_LIBRARY_PATH) $(OPT_BASE)
#
# preprocessing flags
#
@@ -183,11 +183,6 @@ INC += -I${GA_ROOT}/include
LIBS += -L${GA_ROOT}/lib -lga -larmci
endif
#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=ifort
-#
# Netcdf/HDF5 flags
#
HDF_CONF= CFLAGS=-std=c99
@@ -216,6 +211,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXpathf95.mk b/src/Rules.LXpathf95.mk
index 22f984d5d374f41563fbe69ed19f4a695b0ee381..932b438aae162bf04a54b30433af09a957c17c3a 100644
--- a/src/Rules.LXpathf95.mk
+++ b/src/Rules.LXpathf95.mk
@@ -47,11 +47,6 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX
CPPFLAGS_MNH = -DAINT=INT -DAMOD=MOD -DMNH -DSFX_MNH
#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=pathf95
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
@@ -72,6 +67,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXpgi.mk b/src/Rules.LXpgi.mk
index 697a802cd349074ee574a4f077b88c85c5537036..efdb4569fafc0d0b45838c52e27c735aaf164554 100644
--- a/src/Rules.LXpgi.mk
+++ b/src/Rules.LXpgi.mk
@@ -101,11 +101,6 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DMNH_PGI -DSFX_MNH
-#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=_pgf77
#
# LIBTOOLS flags
#
@@ -127,6 +122,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.SX8.mk b/src/Rules.SX8.mk
index 332661185c2da308649408401d3aca97a00d324b..79e63f46c80122ec97fcb3072079381431c731b1 100644
--- a/src/Rules.SX8.mk
+++ b/src/Rules.SX8.mk
@@ -89,12 +89,6 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DMNH_SX5 -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DSFX_MNH
#
-# Gribex flags
-#
-#ARCH_GRIBEX=NEC
-TARGET_GRIBEX=NEC
-CNAME_GRIBEX=sxmpif90
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
@@ -115,6 +109,12 @@ MNH_IOLFI=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/SURFEX/hor_extrapol_surf.F90 b/src/SURFEX/hor_extrapol_surf.F90
index b47bc6db477a314b5f97db587540d882c5263cc0..82b5ed92e4781a1d413627aaed3d4b7754c73739 100644
--- a/src/SURFEX/hor_extrapol_surf.F90
+++ b/src/SURFEX/hor_extrapol_surf.F90
@@ -37,6 +37,7 @@
!! Original 01/12/98
!! V. Masson 01/2004 extrapolation in latitude and longitude
!! M. Jidane 11/2013 add OpenMP directives
+!! Q. Rodier 06/2021 avoid abort for interpolation of ALL(PFIELD)=XUNDEF with ECOSG
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -417,7 +418,7 @@ IF (ALLOCATED(ZLO)) DEALLOCATE(ZLO)
DEALLOCATE(ZTLONMIN,ZTLONMAX,ZTLATMIN,ZTLATMAX)
!
DO JL=1,INL
- IF (ANY(PFIELD(:,JL)==XUNDEF .AND. OINTERP(:))) THEN
+ IF (ANY(PFIELD(:,JL)==XUNDEF .AND. OINTERP(:)) .AND. (.NOT. ALL(PFIELD(:,JL)==XUNDEF))) THEN
WRITE(*,*) 'LAYER ',JL,': NO EXTRAPOLATION : INCREASE YOUR HALO_PREP IN NAM_PREP_SURF_ATM'
CALL ABOR1_SFX('NO EXTRAPOLATION : INCREASE YOUR HALO_PREP IN NAM_PREP_SURF_ATM')
ENDIF
diff --git a/src/SURFEX/modd_write_surf_atm.F90 b/src/SURFEX/modd_write_surf_atm.F90
index 31c48a452edf32f0e75a88fb76b5d413d5323377..8e29a9834d9d85a47e5b2c8ff44ac8774739b194 100644
--- a/src/SURFEX/modd_write_surf_atm.F90
+++ b/src/SURFEX/modd_write_surf_atm.F90
@@ -46,7 +46,8 @@ LOGICAL :: LNAM_TEB_WRITTEN = .TRUE.
LOGICAL :: LNAM_WATFLUX_WRITTEN = .TRUE.
!
LOGICAL :: LFIRST_WRITE = .TRUE.
-LOGICAL, DIMENSION(50000) :: LNOWRITE
+INTEGER, PARAMETER :: NSIZE_LNOWRITE = 80000
+LOGICAL, DIMENSION(NSIZE_LNOWRITE) :: LNOWRITE
INTEGER :: NCPT_WRITE = 0
!
LOGICAL :: LSPLIT_PATCH = .TRUE.
diff --git a/src/SURFEX/test_record_len.F90 b/src/SURFEX/test_record_len.F90
index 6714e20bf95f1c03bc18aaa945c4a84ec04b9661..c3113beff770d942741c6d2cd44b7806a522fe2e 100644
--- a/src/SURFEX/test_record_len.F90
+++ b/src/SURFEX/test_record_len.F90
@@ -20,7 +20,7 @@ USE MODD_XIOS, ONLY : LXIOS, LXIOS_DEF_CLOSED
USE XIOS, ONLY : XIOS_IS_VALID_FIELD, XIOS_FIELD_IS_ACTIVE
#endif
!
-USE MODD_WRITE_SURF_ATM, ONLY : LFIRST_WRITE, LNOWRITE, NCPT_WRITE
+USE MODD_WRITE_SURF_ATM, ONLY : LFIRST_WRITE, LNOWRITE, NCPT_WRITE, NSIZE_LNOWRITE
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
USE PARKIND1 ,ONLY : JPRB
@@ -48,6 +48,13 @@ IF (TRIM(HREC)=="time".OR.TRIM(HREC)=="longitude".OR.TRIM(HREC)=="latitude") THE
ENDIF
!
NCPT_WRITE = NCPT_WRITE + 1
+IF (NCPT_WRITE > NSIZE_LNOWRITE) THEN
+ WRITE(ILUOUT,*) '--------------------------------------'
+ WRITE(ILUOUT,*) 'Error when writing a field'
+ WRITE(ILUOUT,*) 'No more room available in LNOWRITE table'
+ WRITE(ILUOUT,*) 'Please increase its size in modd_write_surf_atm'
+ CALL ABOR1_SFX('TEST_RECORD_LEN: LNOWRITE table is full')
+ENDIF
!
IF (LFIRST_WRITE) THEN
!
diff --git a/src/configure b/src/configure
index a09a94c9e7ce0318079f6ce455cf2456b8247838..fd3e433cb9c4837b0996769c0d68120b0417dfb6 100755
--- a/src/configure
+++ b/src/configure
@@ -1,7 +1,7 @@
#!/bin/bash
#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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
#set -x
#set -e
@@ -18,6 +18,8 @@ export VERSION_CDFC=${VERSION_CDFC:-"4.7.4"}
export VERSION_CDFCXX=${VERSION_CDFCXX:-"4.3.1"}
export VERSION_CDFF=${VERSION_CDFF:-"4.5.3"}
export VERSION_GRIBAPI=${VERSION_GRIBAPI:-"1.26.0-Source"}
+export VERSION_ECCODES=${VERSION_ECCODES:-"2.18.0"}
+export ECCODES_DEFINITION_PATH=${ECCODES_DEFINITION_PATH:${SRC_MESONH}/src/LIB/eccodes-${VERSION_ECCODES}"/definitions/"}
export MNH_INT=${MNH_INT:-"4"}
export LFI_INT=${LFI_INT:-8}
export MNH_REAL=${MNH_REAL:-"8"}
@@ -175,6 +177,7 @@ export ARMCI_SHR_BUF_METHOD=COPY
module purge
module load intel/2019.5.281
module load openmpi/intel/4.0.2.2
+module load cmake/3.15.4
unset CC CXX
"}
;;
@@ -550,9 +553,13 @@ if [ "x${MNH_MEGAN}" == "x1" ] ; then
( cd $LOCAL/src/LIB ; [ ! -d MEGAN ] && tar xvfz megan.tar.gz )
fi
#
-# Install GRIBAPI
+# Install GRIBAPI or ecCodes
#
-cd $LOCAL/src/LIB ; [ ! -d grib_api-${VERSION_GRIBAPI} ] && [ -f grib_api-${VERSION_GRIBAPI}.tar.gz ] && gunzip -c grib_api-${VERSION_GRIBAPI}.tar.gz |tar -xvf -
+if [ "x${MNH_GRIBAPI}" == "xyes" ] ; then
+( cd $LOCAL/src/LIB ; [ ! -d grib_api-${VERSION_GRIBAPI} ] && [ -f grib_api-${VERSION_GRIBAPI}.tar.gz ] && gunzip -c grib_api-${VERSION_GRIBAPI}.tar.gz |tar -xvf - )
+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
##########################################################
# #
# RESUME #
diff --git a/src/job_make_mesonh_BGQ b/src/job_make_mesonh_BGQ
index de9517f32dd279d686c4d1afa0991079a7662cc4..a8e332a69e6e87ee81f4b79577fe18034eb014b2 100755
--- a/src/job_make_mesonh_BGQ
+++ b/src/job_make_mesonh_BGQ
@@ -1,8 +1,8 @@
-#MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC Copyright 1994-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
-#=========== Global directives ===========
+
# @ shell = /bin/bash
# Nom du travail LoadLeveler
# @ job_name = Sortie_MakeMesonh
@@ -10,21 +10,7 @@
# @ output = $(job_name).$(step_name).$(jobid)
# Fichier de sortie d'erreur du travail
# @ error = $(job_name).$(step_name).$(jobid)
-
-#=========== Step 1 directives ===========
-# ======= CompIlation step of grib_api ========
-# @ step_name = make_gribapi
-# @ job_type = serial
-# Temps CPU max. en seconde (d'un processus)
-# @ wall_clock_limit = 3600
-# @ queue
-
-#=========== Step 2 directives ===========
-#============= CompIlation step of MESONH =============
-# @ step_name = make_mesonh
# @ job_type = serial
-# @ dependency = (make_gribapi == 0)
-# (submit only if previous step completed without error)
# @ wall_clock_limit = 9000
# @ queue
@@ -36,29 +22,6 @@ cd $LOADL_STEP_INITDIR
. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-5-0-MPIAUTO-O2NAN
-case $LOADL_STEP_NAME in
-
-#=========== Step 1 directives ===========
-#======= CompIlation step of grib_api ========
-make_gribapi )
-
-#time gmake gribapi_clean
-time gmake gribapi
-
-;;
-
-#=========== Step 2 directives ===========
-#============= CompIlation step of MESONH =============
-make_mesonh )
-
time gmake -j8
time gmake -j8
time gmake installmaster
-
-;;
-#=================================================
-esac
-
-
-
-
diff --git a/src/job_make_mesonh_IBM_sp6_vargas b/src/job_make_mesonh_IBM_sp6_vargas
index 991b70ff4868927d8c4f173879784e40260312cf..b5f606d6381285d09b9b62a66944331ad329b758 100755
--- a/src/job_make_mesonh_IBM_sp6_vargas
+++ b/src/job_make_mesonh_IBM_sp6_vargas
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC Copyright 1994-2020 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
# Temps CPU max. en seconde (d'un processus)
# @ wall_clock_limit = 7200
@@ -26,7 +26,6 @@ cd $LOADL_STEP_INITDIR
. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-5-0-MPIAUTO-O2
-time gmake -j1 gribapi
time gmake -r -j8
time gmake installmaster