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/002_3Drelief/003_python/plot_002_3DRelief.py b/MY_RUN/KTEST/002_3Drelief/003_python/plot_002_3DRelief.py
index 079e324052720e530282675cb68dbaad869336eb..6f57fae700bef1f17d9783d15172b05175cf3e73 100644
--- a/MY_RUN/KTEST/002_3Drelief/003_python/plot_002_3DRelief.py
+++ b/MY_RUN/KTEST/002_3Drelief/003_python/plot_002_3DRelief.py
@@ -10,7 +10,6 @@ mpl.use('Agg')
from read_MNHfile import read_netcdf
from Panel_Plot import PanelPlot
from misc_functions import comp_altitude2DVar
-import cartopy.crs as ccrs
import os
os.system('rm -f tempgraph*')
@@ -21,8 +20,7 @@ path=""
LnameFiles = ['REL3D.1.EXP01.002.nc']
-Dvar_input = {
-'f1':['ZS', 'UT', 'WT','ni_u','nj_u','level','ZTOP', 'ni','nj','level_w','time']}
+Dvar_input = {'f1':['ZS', 'UT', 'WT','ni_u','nj_u','level','ZTOP', 'ni','nj','level_w','time']}
# Read the variables in the files
Dvar = {}
@@ -53,7 +51,6 @@ Lstep = [0.25, 0.1]
Lstepticks = Lstep
Lcolormap = ['gist_rainbow_r']*len(Lplot)
Ltime = [Dvar['f1']['time']]*len(Lplot)
-Lprojection = [ccrs.PlateCarree()]*len(Lplot)
fig1 = Panel1.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel,
orog=orog, Lylim=Lylim, colorbar=True, Ltime=Ltime)
diff --git a/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py b/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py
index 2a607c828d7eff707b7bb5d75f8a68be83f5ff0a..ea59e343330e5dfc43a383bb976da141751a6705 100644
--- a/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py
+++ b/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py
@@ -6,15 +6,13 @@ Creation : 07/01/2021
Last modifications
"""
-
import matplotlib as mpl
mpl.use('Agg')
from read_MNHfile import read_netcdf
from Panel_Plot import PanelPlot
-from misc_functions import comp_altitude2DVar, windvec_verti_proj, mean_operator
+from misc_functions import comp_altitude2DVar, mean_operator
import cartopy.crs as ccrs
import numpy as np
-import math
import copy
import os
@@ -22,8 +20,6 @@ os.system('rm -f tempgraph*')
#
# User's parameter / Namelist
#
-path=""
-
LnameFiles = ['REUNI.1.00A20.004dia.nc', 'REUNI.1.00A20.004.nc']
Dvar_input = {
@@ -32,7 +28,7 @@ Dvar_input = {
# Read the variables in the files
Dvar = {}
-Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
+Dvar = read_netcdf(LnameFiles, Dvar_input, path="", removeHALO=True)
################################################################
######### PANEL 1 # Horizontal cross-section
@@ -40,7 +36,7 @@ Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
Panel1 = PanelPlot(2,2, [20,20],'004_Reunion horizontal sections')
Dvar['f1']['WIND'] = np.sqrt(Dvar['f1']['UT']**2 + Dvar['f1']['VT']**2)
-Lplot = [ Dvar['f1']['ZS'][:,:], Dvar['f1']['WIND'][0,:,:], Dvar['f1']['ALT_THETA'][0,:,:], Dvar['f1']['ALT_PRESSURE'][0,:,:]]
+Lplot = [ Dvar['f1']['ZS'][:,:], Dvar['f1']['WIND'][0,:,:], Dvar['f1']['ALT_THETA'][:,:], Dvar['f1']['ALT_PRESSURE'][:,:]]
LaxeX = [Dvar['f1']['longitude']]*len(Lplot)
LaxeY = [Dvar['f1']['latitude']]*len(Lplot)
@@ -79,8 +75,6 @@ Lscale = [400]*len(Lplot1)
fig2 = Panel1.pvector(Lxx=LaxeX, Lyy=LaxeY, Llevel=Llvl, Lvar1=Lplot1, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep,
Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lproj=Lprojection, Lid_overlap=[2,6], ax=fig1.axes, Lscale=Lscale)
-
-
################################################################
######### PANEL 2 # Vertical cross-section
###############################################################
@@ -141,4 +135,4 @@ Lcolor=['lightgray']
fig4 = Panel2.pvector(Lxx=LaxeX, Lyy=LaxeZ, Lvar1=Lplot1, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep,
Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[6], ax=fig3.axes, Lscale=Lscale, Lylim=Lylim, Lxlim=Lxlim, Lcolor=Lcolor)
-Panel2.save_graph(2,fig4)
+Panel2.save_graph(2,fig4)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/005_ARM/003_python/plot_005_ARM.py b/MY_RUN/KTEST/005_ARM/003_python/plot_005_ARM.py
index 7427083f029f7a175f234f47b3bed95fa23a28a2..46764697097f879f0c99455ba9a268a071b76511 100644
--- a/MY_RUN/KTEST/005_ARM/003_python/plot_005_ARM.py
+++ b/MY_RUN/KTEST/005_ARM/003_python/plot_005_ARM.py
@@ -17,28 +17,29 @@ os.system('rm -f tempgraph*')
# User's parameter / Namelist
#
path=""
-
LnameFiles = ['ARM__.1.CEN4T.000.nc' ]
+LG_LES = '/LES_budgets/Cartesian/Not_time_averaged/Not_normalized/cart/'
Dvar_input = {
-'f1':['MEAN_TH','MEAN_U','MEAN_V','MEAN_RC','MEAN_RR',
- 'SBG_TKE','SBG_WTHL','SBG_WRT',
- 'THLUP_MF','RTUP_MF','RVUP_MF','RCUP_MF','RIUP_MF','WUP_MF',
- 'MAFLX_MF','DETR_MF','ENTR_MF','FRCUP_MF','THVUP_MF','WTHL_MF',
- 'WRT_MF','WTHV_MF','WU_MF','WV_MF',
+'f1':[(LG_LES,'MEAN_TH') , (LG_LES,'MEAN_U') , (LG_LES,'MEAN_V') , (LG_LES,'MEAN_RC'), (LG_LES,'MEAN_RR'),
+ (LG_LES,'SBG_TKE') , (LG_LES,'SBG_WTHL'), (LG_LES,'SBG_WRT'),
+ (LG_LES,'THLUP_MF'), (LG_LES,'RTUP_MF') , (LG_LES,'RVUP_MF'), (LG_LES,'RCUP_MF'), (LG_LES,'RIUP_MF'), (LG_LES,'WUP_MF'),
+ (LG_LES,'MAFLX_MF'), (LG_LES,'DETR_MF') , (LG_LES,'ENTR_MF'), (LG_LES,'FRCUP_MF'), (LG_LES,'THVUP_MF'), (LG_LES,'WTHL_MF'),
+ (LG_LES,'WRT_MF') , (LG_LES,'WTHV_MF') , (LG_LES,'WU_MF') , (LG_LES,'WV_MF'),
'level_les','time_les']
}
# Read the variables in the files
Dvar = {}
-Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=False)
+Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=False, get_data_only=True)
################################################################
######### PANEL 1
###############################################################
Panel1 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
-Lplot = [Dvar['f1']['MEAN_TH'],Dvar['f1']['MEAN_U'], Dvar['f1']['MEAN_V'], Dvar['f1']['MEAN_RC'], Dvar['f1']['MEAN_RR'],Dvar['f1']['SBG_TKE'],]
+Lplot = [Dvar['f1'][(LG_LES,'MEAN_TH')],Dvar['f1'][(LG_LES,'MEAN_U')], Dvar['f1'][(LG_LES,'MEAN_V')],
+ Dvar['f1'][(LG_LES,'MEAN_RC')], Dvar['f1'][(LG_LES,'MEAN_RR')],Dvar['f1'][(LG_LES,'SBG_TKE')]]
LaxeX = [Dvar['f1']['time_les']/3600.]*len(Lplot)
LaxeZ = [Dvar['f1']['level_les']]*len(Lplot)
Ltitle = ['Mean potential temperature TH', 'Mean U', 'Mean V', 'Mean cloud mixing ratio RC', 'Mean precipitation RR', 'Subgrid TKE']
@@ -57,7 +58,6 @@ LaddWhite = [False, False, True, True,True, True]
fig1 = Panel1.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
LaddWhite_cm=LaddWhite, Lylim=Lylim)
-
Panel1.save_graph(1,fig1)
################################################################
@@ -65,7 +65,8 @@ Panel1.save_graph(1,fig1)
###############################################################
Panel2 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
-Lplot = [Dvar['f1']['SBG_WTHL'], Dvar['f1']['SBG_WRT'], Dvar['f1']['THLUP_MF'], Dvar['f1']['RTUP_MF'], Dvar['f1']['RVUP_MF'], Dvar['f1']['RCUP_MF']]
+Lplot = [Dvar['f1'][(LG_LES,'SBG_WTHL')], Dvar['f1'][(LG_LES,'SBG_WRT')], Dvar['f1'][(LG_LES,'THLUP_MF')],
+ Dvar['f1'][(LG_LES,'RTUP_MF')], Dvar['f1'][(LG_LES,'RVUP_MF')], Dvar['f1'][(LG_LES,'RCUP_MF')]]
LaxeX = [Dvar['f1']['time_les']/3600.]*len(Lplot)
LaxeZ = [Dvar['f1']['level_les']]*len(Lplot)
Ltitle = ['Subgrid vertical liquid potential temp. flux', 'Subgrid vertical RT flux',
@@ -85,7 +86,6 @@ LaddWhite = [False, False, False, False, False, False]
fig2 = Panel2.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
LaddWhite_cm=LaddWhite, Lylim=Lylim)
-
Panel2.save_graph(2,fig2)
################################################################
@@ -93,7 +93,8 @@ Panel2.save_graph(2,fig2)
###############################################################
Panel3 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
-Lplot = [Dvar['f1']['RIUP_MF'], Dvar['f1']['WUP_MF'], Dvar['f1']['MAFLX_MF'], Dvar['f1']['DETR_MF'], Dvar['f1']['ENTR_MF'], Dvar['f1']['FRCUP_MF']]
+Lplot = [Dvar['f1'][(LG_LES,'RIUP_MF')], Dvar['f1'][(LG_LES,'WUP_MF')], Dvar['f1'][(LG_LES,'MAFLX_MF')],
+ Dvar['f1'][(LG_LES,'DETR_MF')], Dvar['f1'][(LG_LES,'ENTR_MF')], Dvar['f1'][(LG_LES,'FRCUP_MF')]]
LaxeX = [Dvar['f1']['time_les']/3600.]*len(Lplot)
LaxeZ = [Dvar['f1']['level_les']]*len(Lplot)
Ltitle = ['Updraft ice mixing ratio', 'Updraft vertical velocity',
@@ -113,16 +114,15 @@ LaddWhite = [True]*len(Lplot)
fig3 = Panel3.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
LaddWhite_cm=LaddWhite, Lylim=Lylim)
-
Panel3.save_graph(3,fig3)
-
################################################################
######### PANEL 4
###############################################################
Panel4 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
-Lplot = [Dvar['f1']['THVUP_MF'], Dvar['f1']['WTHL_MF'], Dvar['f1']['WRT_MF'], Dvar['f1']['WTHV_MF'], Dvar['f1']['WU_MF'], Dvar['f1']['WV_MF']]
+Lplot = [Dvar['f1'][(LG_LES,'THVUP_MF')], Dvar['f1'][(LG_LES,'WTHL_MF')], Dvar['f1'][(LG_LES,'WRT_MF')],
+ Dvar['f1'][(LG_LES,'WTHV_MF')], Dvar['f1'][(LG_LES,'WU_MF')], Dvar['f1'][(LG_LES,'WV_MF')]]
LaxeX = [Dvar['f1']['time_les']/3600.]*len(Lplot)
LaxeZ = [Dvar['f1']['level_les']]*len(Lplot)
Ltitle = ['Updraft virtual potential temperature', 'Subgrid WTHL flux from Mass-Flux scheme',
@@ -142,5 +142,4 @@ LaddWhite = [False, False, True, False, False, False]
fig4 = Panel4.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
LaddWhite_cm=LaddWhite, Lylim=Lylim)
-
-Panel4.save_graph(4,fig4)
+Panel4.save_graph(4,fig4)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/005_ARM/004_ncl/clean_ncl b/MY_RUN/KTEST/005_ARM/004_ncl/clean_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..12eeedc8e2098dd3b9af358058400b0dc719d700
--- /dev/null
+++ b/MY_RUN/KTEST/005_ARM/004_ncl/clean_ncl
@@ -0,0 +1,2 @@
+#!/bin/bash
+rm -f ARM__.1.CEN4T.000* *.png
diff --git a/MY_RUN/KTEST/005_ARM/004_ncl/plot_arm.ncl b/MY_RUN/KTEST/005_ARM/004_ncl/plot_arm.ncl
new file mode 100644
index 0000000000000000000000000000000000000000..77b79867f4133f56b2c3c5cc8c1743a285598eaa
--- /dev/null
+++ b/MY_RUN/KTEST/005_ARM/004_ncl/plot_arm.ncl
@@ -0,0 +1,512 @@
+;================================================;
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/contributed.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/wrf/WRFUserARW.ncl"
+; ================================================;
+;================================================;
+begin
+;=================================================;
+; open file and read in data
+;=================================================;
+ fichier1 = addfile("ARM__.1.CEN4T.000.nc", "r")
+;==================================================;
+; Open the workstation
+;==================================================;
+ type = "png"
+ wks = gsn_open_wks(type,"visu_ARM")
+;=================================================;
+; lecture des différents champs
+;=================================================;
+kmax=100
+zhat = fichier1->ZHAT(:) ; ZHAT
+; Unstagger zhat (from grid 4 to 1)
+ nzh=new(kmax,double)
+ do k=0,kmax-2
+ nzh(k)=(zhat(k)+zhat(k+1))/2.
+ end do
+ nzh(kmax-1)=2*zhat(kmax-1)-zhat(kmax-2)
+TIME=new((/180/),double)
+TIME(0)=300
+do j=1,179
+ TIME(j)=TIME(j-1)+300
+end do
+
+group_LES_budgets = fichier1=>LES_budgets/Cartesian/Not_time_averaged/Not_normalized/cart
+
+vname="SBG_TKE"
+SBGTKE = group_LES_budgets->$vname$(:,:)
+SBGTKE@long_name="SBG_TKE"
+SBGTKE!1="nzh"
+SBGTKE!0="TIME"
+SBG_TKE=transpose(SBGTKE)
+
+vname="MEAN_TH"
+MEANTH = group_LES_budgets->$vname$(:,:) ; MEAN_TH
+MEANTH@long_name="MEAN_TH"
+MEANTH@units="K"
+MEANTH!1="nzh"
+MEANTH!0="TIME"
+MEAN_TH=transpose(MEANTH)
+
+vname="MEAN_U"
+MEANU = group_LES_budgets->$vname$(:,:)
+MEANU!1="nzh"
+MEANU!0="TIME"
+MEAN_U=transpose(MEANU)
+MEAN_U@long_name="MEAN_U"
+
+vname="MEAN_V"
+MEANV = group_LES_budgets->$vname$(:,:)
+MEANV!1="nzh"
+MEANV!0="TIME"
+MEAN_V=transpose(MEANV)
+MEAN_V@long_name="MEAN_V"
+
+vname="MEAN_RC"
+MEANRC = group_LES_budgets->$vname$(:,:)
+MEANRC!1="nzh"
+MEANRC!0="TIME"
+MEAN_RC=transpose(MEANRC)
+MEAN_RC@long_name="MEAN_RC"
+
+vname="MEAN_RR"
+MEANRR = group_LES_budgets->$vname$(:,:)
+MEANRR!1="nzh"
+MEANRR!0="TIME"
+MEAN_RR=transpose(MEANRR)
+MEAN_RR@long_name="MEAN_RR"
+
+vname="SBG_WTHL"
+SBGWTHL = group_LES_budgets->$vname$(:,:)
+SBGWTHL!1="nzh"
+SBGWTHL!0="TIME"
+SBG_WTHL=transpose(SBGWTHL)
+SBG_WTHL@long_name="SBG_WTHL"
+
+vname="SBG_WRT"
+SBGWRT = group_LES_budgets->$vname$(:,:)
+SBGWRT!1="nzh"
+SBGWRT!0="TIME"
+SBG_WRT=transpose(SBGWRT)
+SBG_WRT@long_name="SBG_WRT"
+
+
+vname="THLUP_MF"
+ THLUPMF= group_LES_budgets->$vname$(:,:)
+THLUPMF!1="nzh"
+THLUPMF!0="TIME"
+THLUP_MF=transpose(THLUPMF)
+THLUP_MF@long_name="THLUP_MF"
+
+vname="RTUP_MF"
+RTUPMF = group_LES_budgets->$vname$(:,:)
+RTUPMF!1="nzh"
+RTUPMF!0="TIME"
+RTUP_MF=transpose(RTUPMF)
+RTUP_MF@long_name="RTUP_MF"
+
+vname="RVUP_MF"
+RVUPMF = group_LES_budgets->$vname$(:,:)
+RVUPMF!1="nzh"
+RVUPMF!0="TIME"
+RVUP_MF=transpose(RVUPMF)
+RVUP_MF@long_name="RVUP_MF"
+
+vname="RCUP_MF"
+RCUPMF = group_LES_budgets->$vname$(:,:)
+RCUPMF!1="nzh"
+RCUPMF!0="TIME"
+RCUP_MF=transpose(RCUPMF)
+RCUP_MF@long_name="RCUP_MF"
+
+vname="RIUP_MF"
+RIUPMF = group_LES_budgets->$vname$(:,:)
+RIUPMF!1="nzh"
+RIUPMF!0="TIME"
+RIUP_MF=transpose(RIUPMF)
+RIUP_MF@long_name="RIUP_MF"
+
+vname="WUP_MF"
+WUPMF = group_LES_budgets->$vname$(:,:)
+WUPMF!1="nzh"
+WUPMF!0="TIME"
+WUP_MF=transpose(WUPMF)
+WUP_MF@long_name="WUP_MF"
+
+vname="MAFLX_MF"
+MAFLXMF = group_LES_budgets->$vname$(:,:)
+MAFLXMF!1="nzh"
+MAFLXMF!0="TIME"
+MAFLX_MF=transpose(MAFLXMF)
+MAFLX_MF@long_name="MAFLX_MF"
+
+vname="DETR_MF"
+DETRMF = group_LES_budgets->$vname$(:,:)
+DETRMF!1="nzh"
+DETRMF!0="TIME"
+DETR_MF=transpose(DETRMF)
+DETR_MF@long_name="DETR_MF"
+
+vname="ENTR_MF"
+ENTRMF = group_LES_budgets->$vname$(:,:)
+ENTRMF!1="nzh"
+ENTRMF!0="TIME"
+ENTR_MF=transpose(ENTRMF)
+ENTR_MF@long_name="ENTR_MF"
+
+vname="FRCUP_MF"
+FRCUPMF = group_LES_budgets->$vname$(:,:)
+FRCUPMF!1="nzh"
+FRCUPMF!0="TIME"
+FRCUP_MF=transpose(FRCUPMF)
+FRCUP_MF@long_name="FRCUP_MF"
+
+vname="THVUP_MF"
+THVUPMF = group_LES_budgets->$vname$(:,:)
+THVUPMF!1="nzh"
+THVUPMF!0="TIME"
+THVUP_MF=transpose(THVUPMF)
+THVUP_MF@long_name="THVUP_MF"
+
+vname="WTHL_MF"
+WTHLMF = group_LES_budgets->$vname$(:,:)
+WTHLMF!1="nzh"
+WTHLMF!0="TIME"
+WTHL_MF=transpose(WTHLMF)
+WTHL_MF@long_name="WTHL_MF"
+
+vname="WRT_MF"
+WRTMF = group_LES_budgets->$vname$(:,:)
+WRTMF!1="nzh"
+WRTMF!0="TIME"
+WRT_MF=transpose(WRTMF)
+WRT_MF@long_name="WRT_MF"
+
+
+vname="WTHV_MF"
+WTHVMF = group_LES_budgets->$vname$(:,:)
+WTHVMF!1="nzh"
+WTHVMF!0="TIME"
+WTHV_MF=transpose(WTHVMF)
+WTHV_MF@long_name="WTHV_MF"
+
+
+vname="WU_MF"
+WUMF = group_LES_budgets->$vname$(:,:)
+WUMF!1="nzh"
+WUMF!0="TIME"
+WU_MF=transpose(WUMF)
+WU_MF@long_name="WU_MF"
+
+
+vname="WV_MF"
+WVMF = group_LES_budgets->$vname$(:,:)
+WVMF!1="nzh"
+WVMF!0="TIME"
+WV_MF=transpose(WVMF)
+WV_MF@long_name="WV_MF"
+
+;=================================================;
+; Altitude des niveaux modèles
+;=================================================;
+; Unstagger zhat (from grid 4 to 1)
+ nzh=new(kmax,double)
+ do k=0,kmax-2
+ nzh(k)=(zhat(k)+zhat(k+1))/2.
+ end do
+ nzh(kmax-1)=2*zhat(kmax-1)-zhat(kmax-2)
+;=================================================;
+; Set some other basic resources
+;=================================================;
+ resmap = True
+ resmap@gsnFrame = False
+ resmap@gsnDraw = False
+ resmap@gsnMaximize = True
+ resmap@gsnPaperOrientation = "portrait"
+ resmap@gsnSpreadColors = True ; use full range of colormap
+ resmap@tiYAxisString =" "
+ resmap@cnFillOn = True ; turn on color fill
+ resmap@cnLinesOn = False ; turn off contour lines
+ ;resmap@tmXBLabelStride = 2 ; to reduce the number of labels on xaxis
+ ;resmap@lbLabelStride = 2. ; to reduce the number of labels on labelbar
+ resmap@sfYArray = nzh(0:76)
+ resmap@sfXArray = TIME
+ resmap@tmXBTickSpacingF = 10800.
+ resmap@tmXBMode = "Explicit"
+ resmap@tmXBValues = (/10800,21600,32400,43200,54000/)
+ resmap@tmXBLabels =(/3,6,9,12,15/)
+resmap@tiXAxisPosition="Left"
+resmap@tiXAxisFontHeightF=0.015
+;=================================================;
+; TRACE
+;=================================================;
+ gsn_define_colormap(wks,"rainbow") ; Choose colormap
+ colors = gsn_retrieve_colormap(wks) ; retrieve color map for editing
+ colors(2,:) = (/ 1, 1, 1 /) ; replace the first color with white color (les deux premières sont background /foreground donc c'est bien la 2 qu'il faut changer)
+ gsn_define_colormap(wks,colors) ; redefine colormap to workstation, color map now includes a gray
+
+
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.25
+opts@cnMinLevelValF=0
+opts@cnMaxLevelValF=2.5
+
+plot = gsn_csm_contour(wks,SBG_TKE(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=1
+opts@cnMinLevelValF=298
+opts@cnMaxLevelValF=316
+
+plot = gsn_csm_contour(wks,MEAN_TH(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.5
+opts@cnMinLevelValF=3
+opts@cnMaxLevelValF=11
+
+plot = gsn_csm_contour(wks,MEAN_U(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.2
+opts@cnMinLevelValF=0.
+opts@cnMaxLevelValF=3.2
+
+plot = gsn_csm_contour(wks,MEAN_V(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.00001
+opts@cnMinLevelValF=0
+opts@cnMaxLevelValF=0.0002
+
+plot = gsn_csm_contour(wks,MEAN_RC(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.000001
+opts@cnMinLevelValF=0
+opts@cnMaxLevelValF=0.00002
+
+plot = gsn_csm_contour(wks,MEAN_RR(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.02
+opts@cnMinLevelValF=-0.3
+opts@cnMaxLevelValF=0.12
+
+plot = gsn_csm_contour(wks,SBG_WTHL(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.00005
+opts@cnMinLevelValF=-0.0001
+opts@cnMaxLevelValF=0.0004
+
+plot = gsn_csm_contour(wks,SBG_WRT(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=1
+opts@cnMinLevelValF=301
+opts@cnMaxLevelValF=318
+
+plot = gsn_csm_contour(wks,THLUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.001
+opts@cnMinLevelValF=0.0035
+opts@cnMaxLevelValF=0.017
+plot = gsn_csm_contour(wks,RTUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.001
+opts@cnMinLevelValF=0.001
+opts@cnMaxLevelValF=0.017
+
+plot = gsn_csm_contour(wks,RVUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.00025
+opts@cnMinLevelValF=0.00025
+opts@cnMaxLevelValF=0.00425
+
+plot = gsn_csm_contour(wks,RCUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "AutomaticLevels"
+plot = gsn_csm_contour(wks,RIUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.25
+opts@cnMinLevelValF=0.250
+opts@cnMaxLevelValF=5.5
+
+plot = gsn_csm_contour(wks,WUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.02
+opts@cnMinLevelValF=0.02
+opts@cnMaxLevelValF=0.32
+
+plot = gsn_csm_contour(wks,MAFLX_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.025
+opts@cnMinLevelValF=0.025
+opts@cnMaxLevelValF=0.45
+
+plot = gsn_csm_contour(wks,DETR_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.00025
+opts@cnMinLevelValF=0.00025
+opts@cnMaxLevelValF=0.005
+
+plot = gsn_csm_contour(wks,ENTR_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.01
+opts@cnMinLevelValF=0.01
+opts@cnMaxLevelValF=0.16
+
+plot = gsn_csm_contour(wks,FRCUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=1
+opts@cnMinLevelValF=303
+opts@cnMaxLevelValF=319
+
+plot = gsn_csm_contour(wks,THVUP_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.005
+opts@cnMinLevelValF=-0.075
+opts@cnMaxLevelValF=0.055
+
+plot = gsn_csm_contour(wks,WTHL_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.00001
+opts@cnMinLevelValF=0.00001
+opts@cnMaxLevelValF=0.00019
+
+plot = gsn_csm_contour(wks,WRT_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.005
+opts@cnMinLevelValF=-0.016
+opts@cnMaxLevelValF=0.075
+plot = gsn_csm_contour(wks,WTHV_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.005
+opts@cnMinLevelValF=-0.120
+opts@cnMaxLevelValF=-0.005
+
+plot = gsn_csm_contour(wks,WU_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+opts=resmap
+opts@cnLevelSelectionMode = "ManualLevels"
+opts@cnLevelSpacingF=0.004
+opts@cnMinLevelValF=-0.024
+opts@cnMaxLevelValF=0.048
+plot = gsn_csm_contour(wks,WV_MF(0:76,:),opts)
+draw(plot)
+frame(wks)
+delete(opts)
+
+end
diff --git a/MY_RUN/KTEST/005_ARM/004_ncl/run_ncl b/MY_RUN/KTEST/005_ARM/004_ncl/run_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..7fa36570be699763a33bdad50638a95b35f01eb7
--- /dev/null
+++ b/MY_RUN/KTEST/005_ARM/004_ncl/run_ncl
@@ -0,0 +1,37 @@
+#!/bin/bash
+#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+#MNH_LIC for details. version 1.
+set -x
+
+ln -sf ../002_mesonh/ARM__.1.CEN4T.000.* .
+
+rm -f visu_ARM.*.png
+
+ncl plot_arm.ncl
+${POSTRUN} display visu_ARM.000001.png
+${POSTRUN} display visu_ARM.000002.png
+${POSTRUN} display visu_ARM.000003.png
+${POSTRUN} display visu_ARM.000004.png
+${POSTRUN} display visu_ARM.000005.png
+${POSTRUN} display visu_ARM.000006.png
+${POSTRUN} display visu_ARM.000007.png
+${POSTRUN} display visu_ARM.000008.png
+${POSTRUN} display visu_ARM.000009.png
+${POSTRUN} display visu_ARM.000010.png
+${POSTRUN} display visu_ARM.000011.png
+${POSTRUN} display visu_ARM.000012.png
+${POSTRUN} display visu_ARM.000013.png
+${POSTRUN} display visu_ARM.000014.png
+${POSTRUN} display visu_ARM.000015.png
+${POSTRUN} display visu_ARM.000016.png
+${POSTRUN} display visu_ARM.000017.png
+${POSTRUN} display visu_ARM.000018.png
+${POSTRUN} display visu_ARM.000019.png
+${POSTRUN} display visu_ARM.000020.png
+${POSTRUN} display visu_ARM.000021.png
+${POSTRUN} display visu_ARM.000022.png
+${POSTRUN} display visu_ARM.000023.png
+${POSTRUN} display visu_ARM.000024.png
+exit 0
diff --git a/MY_RUN/KTEST/005_ARM/Makefile b/MY_RUN/KTEST/005_ARM/Makefile
index ea3b47d02c482ebfd287cf86e058ea1f156a6b8c..e9802cb77dfeb5f17cc60876cc4024efe8a6c41f 100644
--- a/MY_RUN/KTEST/005_ARM/Makefile
+++ b/MY_RUN/KTEST/005_ARM/Makefile
@@ -1,9 +1,15 @@
all:
cd 001_prep_ideal && run_prep_ideal_case_xyz
cd 002_mesonh && run_mesonh_xyz
+ ifneq "$(MNH_PYTHON)" "NO"
cd 003_python && run_python
+ endif
+ cd 004_ncl && run_ncl
clean:
cd 001_prep_ideal && clean_prep_ideal_case_xyz
cd 002_mesonh && clean_mesonh_xyz
+ ifneq "$(MNH_PYTHON)" "NO"
cd 003_python && clean_python
+ endif
+ cd 004_ncl && clean_ncl
diff --git a/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py b/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py
index 7e32b6b951b437dcba03357de097726a2bd5d985..9bc7193671db8a65ad0364bbd55d7a4b4ea65fb5 100644
--- a/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py
+++ b/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py
@@ -32,7 +32,7 @@ Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
################################################################
######### PANEL 1
###############################################################
-Panel1 = PanelPlot(2,2, [20,20],'007_janvier domaine 1 16JAN.1.12B18.001dg.nc')
+Panel1 = PanelPlot(2,2, [20,20],'007_janvier domaine 1 16JAN.1.12B18.001dg.nc', minmaxpad=1.05)
Lplot = [ Dvar['f1']['ZS'],Dvar['f1']['THT850HPA'], Dvar['f1']['MRV700HPA'],Dvar['f1']['ALT_PRESSURE']]
lon = [Dvar['f1']['longitude']]*len(Lplot)
@@ -73,7 +73,7 @@ Panel1.save_graph(1,fig2)
################################################################
######### PANEL 2
###############################################################
-Panel2 = PanelPlot(2,2, [20,20],'007_janvier domaine 2 16JAN.1.12B18.001dg.nc')
+Panel2 = PanelPlot(2,2, [20,20],'007_janvier domaine 2 16JAN.1.12B18.001dg.nc', minmaxpad=1.05)
Lplot = [ Dvar['f2']['ZS'],Dvar['f2']['THT850HPA'], Dvar['f2']['MRV700HPA'],Dvar['f2']['ALT_PRESSURE']]
lon = [Dvar['f2']['longitude']]*len(Lplot)
diff --git a/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py b/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py
index d271fe993d8733a11387ff34e6ebd728f36d6e3c..3f792a31363a78a8d5db2c9e5163afa1597afc82 100644
--- a/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py
+++ b/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py
@@ -1,6 +1,5 @@
#!/usr/bin/env python3
"""
-
@author: Quentin Rodier
Creation : 07/01/2021
@@ -36,7 +35,7 @@ Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
################################################################
######### PANEL 1
###############################################################
-Panel1 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01)
+Panel1 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, lateralminmaxpad=0.9)
Lplot = [ Dvar['f1']['INPRR'], Dvar['f1']['ACPRR'], Dvar['f1']['PABST'],Dvar['f2']['ALT_CLOUD'],Dvar['f2']['ALT_CLOUD'] ]
@@ -92,7 +91,7 @@ Panel1.save_graph(1,fig2)
###############################################################
Panel2 = PanelPlot(2,2, [20,20],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, colorbaraspect=40, labelcolorbarpad = 13)
-# Interpoler COT','O3T Ã 3000 et 5000m avec une moyenne sur2 niveaux
+# Interpoler COT','O3T Ã 3000 et 5000m avec une moyenne sur 2 niveaux
Dvar['f1']['COT3000m'] = (Dvar['f1']['COT'][6,:,:] + Dvar['f1']['COT'][5,:,:])/2.0
Dvar['f1']['O3T3000m'] = (Dvar['f1']['O3T'][6,:,:] + Dvar['f1']['O3T'][5,:,:])/2.0
Dvar['f1']['COT5000m'] = (Dvar['f1']['COT'][10,:,:] + Dvar['f1']['COT'][9,:,:])/2.0
@@ -131,7 +130,6 @@ Dvar['f1']['UM'] = tomass.MXM(Dvar['f1']['UT'])
Dvar['f1']['VM'] = tomass.MYM(Dvar['f1']['VT'])
Dvar['f1']['WM'] = tomass.MZM(Dvar['f1']['WT'])
-
angle_sec1, RVT_sec1, axe_m1 = oblique_proj(Dvar['f1']['RVT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
WIND_proj = windvec_verti_proj(Dvar['f1']['UM'], Dvar['f1']['VM'], Dvar['f1']['level'], angle_sec1)
angle_sec1, WIND_sec1, axe_m1 = oblique_proj(WIND_proj, Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
@@ -161,7 +159,6 @@ fig3 = Panel3.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lyl
Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
Ltime=Ltime, Lpltype=Lpltype, LaddWhite_cm=LaddWhite)
-
Lplot1 = [ WIND_sec1]
Lplot2 = [ WT_sec1]
Ltitle = ['Wind']
@@ -174,7 +171,6 @@ Lscale = [200]*len(Lplot)
fig4 = Panel3.pvector(Lxx=LaxeX, Lyy=LaxeZ, Lvar1=Lplot1, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep,
Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[0], ax=fig3.axes, Lscale=Lscale)
-
Lplot = [RRT_sec1]
LaxeX = [axe_m1]
LaxeZ = [Dvar['f1']['level']]
@@ -196,7 +192,6 @@ LaddWhite = [True]*len(Lplot)
fig5 = Panel3.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
Lstep=Lstep, Lstepticks=Lstepticks, LcolorLine=LcolorLine, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
Ltime=Ltime, Lpltype=Lpltype, LaddWhite_cm=LaddWhite, ax=fig4.axes,Lid_overlap=[2],colorbar=False)
-
Panel3.save_graph(3,fig5)
################################################################
@@ -292,4 +287,4 @@ fig8 = Panel5.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lyl
Lstep=Lstep, Lstepticks=Lstepticks, LcolorLine=LcolorLine, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
Lpltype=Lpltype, ax=fig7.axes,Lid_overlap=[0, 2, 4, 6, 8, 10, 12, 14, 16],colorbar=False)
-Panel5.save_graph(5,fig8)
+Panel5.save_graph(5,fig8)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py b/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py
index 7448f10d0b38061642aacbb934f40796745cc745..2116f12329b9163e64761721f006b0e9e06efd1f 100644
--- a/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py
+++ b/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py
@@ -9,7 +9,7 @@ import matplotlib as mpl
mpl.use('Agg')
from read_MNHfile import read_netcdf
from Panel_Plot import PanelPlot
-from misc_functions import mean_operator, convert_date
+from misc_functions import mean_operator
import cartopy.crs as ccrs
import numpy as np
import os
@@ -21,8 +21,7 @@ os.system('rm -f tempgraph*')
path=""
LnameFiles = ['DUST7.1.SEG02.004.nc']
-Dvar_input = {
-'f1':['ZS', 'UT','VT', 'WT','THT',
+Dvar_input = {'f1':['ZS', 'UT','VT', 'WT','THT',
'DSTM03T','DSTM33T','DSTM02T','DSTM32T','DSTM01T','DSTM31T','F_DST001P1','F_DST002P1','F_DST003P1',
'latitude','longitude','level',
'INPRR','ACPRR','PABST','RCT','RVT','RRT','LSTHM']}
@@ -30,6 +29,7 @@ Dvar_input = {
# Read the variables in the files
Dvar = {}
Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
+
################################################################
######### PANEL 1
###############################################################
@@ -74,6 +74,7 @@ fig2 = Panel1.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Llevel=Llvl, Lvar2=Lplot2,
Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[0], ax=fig1.axes, Lscale=Lscale)
Panel1.save_graph(1,fig2)
+
################################################################
######### PANEL 2
###############################################################
@@ -97,6 +98,7 @@ fig3 = Panel2.psectionH(lon=lon, lat=lat, Lvar=Lplot, Llevel=Llvl, Lxlab=Lxlab,
Ltime=Ltime, LaddWhite_cm=LaddWhite, Lproj=Lprojection, ax=[])
Panel2.save_graph(2,fig3)
+
################################################################
######### PANEL 3
###############################################################
@@ -119,4 +121,4 @@ fig4 = Panel3.psectionH(lon=lon, lat=lat, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab,
Lstep=[], Lstepticks=[], Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel,Lcarte=Lcarte,
Ltime=Ltime, LaddWhite_cm=LaddWhite, Lproj=Lprojection, ax=[])
-Panel3.save_graph(3,fig4)
+Panel3.save_graph(3,fig4)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/014_LIMA/003_ncl/clean_ncl b/MY_RUN/KTEST/014_LIMA/003_ncl/clean_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..ef83c16a5de17b683dd873050ef83dedfa0a005d
--- /dev/null
+++ b/MY_RUN/KTEST/014_LIMA/003_ncl/clean_ncl
@@ -0,0 +1,2 @@
+#!/bin/bash
+rm -f *.nc *.png
diff --git a/MY_RUN/KTEST/014_LIMA/003_ncl/plot_LIMA.ncl b/MY_RUN/KTEST/014_LIMA/003_ncl/plot_LIMA.ncl
new file mode 100644
index 0000000000000000000000000000000000000000..753a1d2ec97a0c960d674b36dea14f611165c718
--- /dev/null
+++ b/MY_RUN/KTEST/014_LIMA/003_ncl/plot_LIMA.ncl
@@ -0,0 +1,126 @@
+;================================================;
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_code.ncl"
+load "$NCARG_ROOT/lib/ncarg/nclscripts/csm/gsn_csm.ncl"
+; ================================================;
+;================================================;
+begin
+;=================================================;
+; open file and read in data
+;=================================================;
+ fichier1 = addfile("XPREF.1.SEG01.000.nc", "r")
+;==================================================;
+; Open the workstation
+;==================================================;
+ type = "png"
+ wks = gsn_open_wks(type,"visu_LIMA")
+;=================================================;
+; lecture des différents champs
+;=================================================;
+
+group_Budgets = fichier1=>Budgets
+group_RI = group_Budgets=>RI
+group_RS = group_Budgets=>RS
+group_RG = group_Budgets=>RG
+group_CICE = group_Budgets=>CICE
+group_CIFNFREE01 = group_Budgets=>CIFNFREE01
+group_CIFNNUCL01 = group_Budgets=>CIFNNUCL01
+
+
+vname = "AVEF"
+RI= group_RI->$vname$(0,:,0,:)
+RI@long_name="ice water content"
+RI@units="g/kg"
+
+NI= group_CICE->$vname$(0,:,0,:)
+NI@long_name="ice concentration"
+NI@units="/kg"
+
+RS= group_RS->$vname$(0,:,0,:)
+RS@long_name="snow water content"
+RS@units="g/kg"
+
+RG= group_RG->$vname$(0,:,0,:)
+RG@long_name="graupel water content"
+RG@units="g/kg"
+
+N_IFN_FREE= group_CIFNFREE01->$vname$(0,:,0,:)
+N_IFN_FREE@long_name="concentration of free IFN"
+N_IFN_FREE@units="/kg"
+
+N_IFN_NUCL= group_CIFNNUCL01->$vname$(0,:,0,:)
+N_IFN_NUCL@long_name="concentration of nucleated IFN"
+N_IFN_NUCL@units="/kg"
+
+
+zhat = fichier1->ZHAT(1:50)
+xhat = fichier1->XHAT(1:180)
+zs = fichier1->ZS(1:180) ; ZS
+
+xconf=conform(RI,xhat(0:179),1)
+
+;=================================================;
+; Altitude des niveaux modèles
+;=================================================;
+; Unstagger zhat (from grid 4 to 1)
+ nzh=new(50,double)
+ do k=0,48
+ nzh(k)=(zhat(k)+zhat(k+1))/2.
+ end do
+ nzh(49)=2*zhat(49)-zhat(48)
+
+; Create z (altitude des niveaux modèle)
+ z=new((/50,180/),double)
+ zcoef=new(180,double)
+ zcoef=1.-zs/nzh(49)
+
+ do i=0,179
+ z(:,i) = nzh*zcoef(i)+zs(i)
+ end do
+;=================================================;
+; Set some other basic resources
+;=================================================;
+ resmap = True
+ resmap@gsnFrame = False
+ resmap@gsnDraw = False
+ resmap@gsnMaximize = True
+ resmap@gsnPaperOrientation = "portrait"
+ resmap@gsnSpreadColors = True ; use full range of colormap
+ resmap@tiYAxisString =" "
+ resmap@cnFillOn = True ; turn on color fill
+ resmap@cnLinesOn = False ; turn off contour lines
+
+ resmap@tiXAxisPosition="Left"
+ resmap@tiXAxisFontHeightF=0.015
+; resmap@gsnSpreadColorStart = 0 ; force la première couleur en blanc(= couleur 0 de la palette)
+ resmap@sfYArray = z ; 2D
+ resmap@sfXArray = xconf ; 2D
+ resmap@trGridType = "TriangularMesh"
+;=================================================;
+; TRACE
+;=================================================;
+ gsn_define_colormap(wks,"rainbow") ; Choose colormap
+ res=resmap
+ res@cnLevelSelectionMode = "AutomaticLevels"
+ plot = gsn_csm_contour(wks,RI(:,:),res)
+ draw(plot)
+ frame(wks)
+
+ plot2 = gsn_csm_contour(wks,NI(:,:),res)
+ draw(plot2)
+ frame(wks)
+
+ plot3 = gsn_csm_contour(wks,RS(:,:),res)
+ draw(plot3)
+ frame(wks)
+
+ plot4 = gsn_csm_contour(wks,RG(:,:),res)
+ draw(plot4)
+ frame(wks)
+ plot5 = gsn_csm_contour(wks,N_IFN_FREE(:,:),res)
+ draw(plot5)
+ frame(wks)
+ plot6 = gsn_csm_contour(wks,N_IFN_NUCL(:,:),res)
+ draw(plot6)
+ frame(wks)
+
+end
diff --git a/MY_RUN/KTEST/014_LIMA/003_ncl/run_ncl b/MY_RUN/KTEST/014_LIMA/003_ncl/run_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..2444be340eda2cb7a5a846cb44cd71694626e1c0
--- /dev/null
+++ b/MY_RUN/KTEST/014_LIMA/003_ncl/run_ncl
@@ -0,0 +1,20 @@
+#!/bin/bash
+#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+#MNH_LIC for details. version 1.
+set -x
+
+ln -sf ../002_mesonh/XPREF.1.SEG01.000.nc .
+
+rm -f visu_LIMA.*.png
+
+ncl plot_LIMA.ncl
+
+${POSTRUN} display visu_LIMA.000001.png
+${POSTRUN} display visu_LIMA.000002.png
+${POSTRUN} display visu_LIMA.000003.png
+${POSTRUN} display visu_LIMA.000004.png
+${POSTRUN} display visu_LIMA.000005.png
+${POSTRUN} display visu_LIMA.000006.png
+exit 0
diff --git a/MY_RUN/KTEST/014_LIMA/004_python/plot_014_LIMA.py b/MY_RUN/KTEST/014_LIMA/004_python/plot_014_LIMA.py
index b64203496df724da0109d0798a84d4b66302de4e..61f335890fa2c86098b3b9e1aeb1c33eaa038cb2 100644
--- a/MY_RUN/KTEST/014_LIMA/004_python/plot_014_LIMA.py
+++ b/MY_RUN/KTEST/014_LIMA/004_python/plot_014_LIMA.py
@@ -20,25 +20,27 @@ os.system('rm -f tempgraph*')
path=""
LnameFiles = ['XPREF.1.SEG01.000.nc' ]
-Dvar_input = {'f1':[('RI','AVEF'), ('CICE','AVEF'), ('RS','AVEF'),('RG','AVEF'), ('CIFNFREE01','AVEF'),('CIFNNUCL01','AVEF') ]}
+Dvar_input = {'f1':[('/Budgets/RI','AVEF'), ('/Budgets/CICE','AVEF'), ('/Budgets/RS','AVEF'),
+ ('/Budgets/RG','AVEF'), ('/Budgets/CIFNFREE01','AVEF'),('/Budgets/CIFNNUCL01','AVEF') ]}
Dvar_input_coord_budget = {'f1':['cart_level', 'cart_ni']}
Dvar_input_coord = {'f1':['ZS','ZTOP']}
# Read the variables in the files
Dvar, Dvar_coord_budget, Dvar_coord = {}, {}, {}
-Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=False)
-Dvar_coord_budget = read_netcdf(LnameFiles, Dvar_input_coord_budget, path=path, removeHALO=False)
+Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
+Dvar_coord_budget = read_netcdf(LnameFiles, Dvar_input_coord_budget, path=path, removeHALO=True)
Dvar_coord = read_netcdf(LnameFiles, Dvar_input_coord, path=path, removeHALO=True)
-Dvar['f1']['altitude'], Dvar['f1']['ni_2D'] = comp_altitude1DVar(Dvar['f1'][('CIFNFREE01','AVEF')], Dvar_coord['f1']['ZS'],Dvar_coord['f1']['ZTOP'], Dvar_coord_budget['f1']['cart_level'],Dvar_coord_budget['f1']['cart_ni'])
+Dvar['f1']['altitude'], Dvar['f1']['ni_2D'] = comp_altitude1DVar(Dvar['f1'][('/Budgets/CIFNNUCL01','AVEF')], Dvar_coord['f1']['ZS'],
+ Dvar_coord['f1']['ZTOP'], Dvar_coord_budget['f1']['cart_level'],Dvar_coord_budget['f1']['cart_ni'])
################################################################
######### PANEL 1
###############################################################
Panel1 = PanelPlot(2,3, [25,14],'014_LIMA', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
-Lplot = [Dvar['f1'][('RI','AVEF')],Dvar['f1'][('CICE','AVEF')], Dvar['f1'][('RS','AVEF')],
- Dvar['f1'][('RG','AVEF')],Dvar['f1'][('CIFNFREE01','AVEF')], Dvar['f1'][('CIFNNUCL01','AVEF')]]
+Lplot = [Dvar['f1'][('/Budgets/RI','AVEF')],Dvar['f1'][('/Budgets/CICE','AVEF')], Dvar['f1'][('/Budgets/RS','AVEF')],
+ Dvar['f1'][('/Budgets/RG','AVEF')],Dvar['f1'][('/Budgets/CIFNFREE01','AVEF')], Dvar['f1'][('/Budgets/CIFNNUCL01','AVEF')]]
LaxeX = [Dvar['f1']['ni_2D']]*len(Lplot)
LaxeZ = [Dvar['f1']['altitude']]*len(Lplot)
Ltitle = ['Ice water content', 'Ice concentration', 'Snow water content',
diff --git a/MY_RUN/KTEST/014_LIMA/Makefile b/MY_RUN/KTEST/014_LIMA/Makefile
index c03971716585263f5a1107ad18335ea48c7fc060..d2df0e9b7892909be537addfc14b71a2626254b3 100644
--- a/MY_RUN/KTEST/014_LIMA/Makefile
+++ b/MY_RUN/KTEST/014_LIMA/Makefile
@@ -1,6 +1,7 @@
all:
cd 001_prep_ideal_case && run_prep_ideal_case_xyz
cd 002_mesonh && run_mesonh_xyz
+ cd 003_ncl && run_ncl
ifneq "$(MNH_PYTHON)" "NO"
cd 004_python && run_python
endif
@@ -8,6 +9,7 @@ all:
clean:
cd 001_prep_ideal_case && clean_prep_ideal_case_xyz
cd 002_mesonh && clean_mesonh_xyz
+ cd 003_ncl && clean_ncl
ifneq "$(MNH_PYTHON)" "NO"
cd 004_python && clean_python
endif
diff --git a/src/LIB/Python/Panel_Plot.py b/src/LIB/Python/Panel_Plot.py
index 24134085e04ad816580a545bfb65de987ec3db8b..8e095faf07fd46b6dcd4f01df5dddca6b0b5759a 100644
--- a/src/LIB/Python/Panel_Plot.py
+++ b/src/LIB/Python/Panel_Plot.py
@@ -1,9 +1,12 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
"""
-Created on Wed Feb 24 10:49:45 2021
+MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+MNH_LIC for details. version 1.
-@author: rodierq
+@author: 07/2021 Quentin Rodier
"""
import matplotlib as mpl
mpl.use('Agg')
@@ -11,6 +14,7 @@ import matplotlib.pyplot as plt
from matplotlib import cm
from matplotlib.colors import ListedColormap
import numpy as np
+import cartopy
import cartopy.feature as cfeature
class PanelPlot():
@@ -56,8 +60,12 @@ class PanelPlot():
# Grid lines and labels
if 'PlateCarree' in str(projo):
gl = ax.gridlines(crs=self.projo, draw_labels=True, linewidth=1, color='gray')
- gl.top_labels = False
- gl.right_labels = False
+ if float(cartopy.__version__[:4]) >= 0.18:
+ gl.top_labels = False
+ gl.right_labels = False
+ else:
+ gl.xlabels_top = False
+ gl.ylabels_right = False
# Coastlines
if self.drawCoastLines and 'GeoAxes' in str(type(ax)):
@@ -188,7 +196,7 @@ class PanelPlot():
Lfacconv=[], ax=[], Lid_overlap=[], colorbar=True, orog=[], Lxlim=[], Lylim=[], Ltime=[], Lpltype=[], LaddWhite_cm=[]):
"""
Horizontal cross section plot
- Arguments :
+ Parameters :
- Lxx : List of x or y coordinate variable or time axis
- Lzz : List of z coordinates variable
- Lvar : List of variables to plot
@@ -253,7 +261,7 @@ class PanelPlot():
# Print time validity
if Ltime: self.showTimeText(self.ax, iax, str(Ltime[i]))
-
+
# Number of contours level
if not Lstep[i]: # Default value of number of steps is 20
Lstep[i] = (Lmaxval[i] - Lminval[i])/20
@@ -315,7 +323,7 @@ class PanelPlot():
Lylim=[], Ltime=[], LaxisColor=[]):
"""
XY (multiple)-lines plot
- Arguments :
+ Parameters :
- Lxx : List of variables to plot or coordinates along the X axis #TODO : ajouter Lfacconv pour les deux axes. Impact tous les cas test avec lignes X/Y
- Lyy : List of variables to plot or coordinates along the Y axis
- Lxlab : List of x-axis label
@@ -405,7 +413,7 @@ class PanelPlot():
Lid_overlap=[], colorbar=True, Ltime=[], LaddWhite_cm=[], Lpltype=[], Lcbformatlabel=[]):
"""
Horizontal cross section plot
- Arguments :
+ Parameters :
- lon : longitude 2D array
- lat : latitude 2D array
- Lvar : List of variables to plot
@@ -554,7 +562,7 @@ class PanelPlot():
Lylim=[], Lxlim=[]):
"""
Horizontal vectors lines
- Arguments :
+ Parameters :
- Lxx : List of x or y coordinate variable (lat or ni or nm)
- Lyy : List of y coordinates variable (lon or level)
- Lvar1 : List of wind-component along x/y or oblic axis (3D for hor. section, 2D for vertical section)
@@ -667,7 +675,7 @@ class PanelPlot():
Lylim=[], Lxlim=[]):
"""
Wind stream lines
- Arguments :
+ Parameters :
- Lxx : List of x or y coordinate variable (lat or ni or nm)
- Lyy : List of y coordinates variable (lon or level)
- Lvar1 : List of wind-component along x/y or oblic axis (3D for hor. section, 2D for vertical section)
@@ -768,7 +776,7 @@ class PanelPlot():
Lylim=[], Ltime=[], LaxisColor=[]):
"""
XY Histogram
- Arguments :
+ Parameters :
- Lbins : List of bins
- Lvar : List of the value for each bin
- Lxlab : List of x-axis label
diff --git a/src/LIB/Python/misc_functions.py b/src/LIB/Python/misc_functions.py
index 6b2c0932742f0d47e6607275a890f990a50226ce..aa91aa7a311dc721c17f3f28cc7a8fd4f78df5b1 100644
--- a/src/LIB/Python/misc_functions.py
+++ b/src/LIB/Python/misc_functions.py
@@ -1,9 +1,12 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
"""
-Created on Thu Feb 25 11:25:31 2021
+MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+MNH_LIC for details. version 1.
-@author: rodierq
+@author: 07/2021 Quentin Rodier
"""
import copy
from scipy.interpolate import RectBivariateSpline
@@ -11,8 +14,6 @@ import numpy as np
import math
def convert_date(datesince, time_in_sec):
- print(type(datesince))
- print(type(time_in_sec))
return str(time_in_sec) + datesince[:33]
class mean_operator():
@@ -37,103 +38,172 @@ class mean_operator():
out[k,:,:] = (var[k,:,:] + var[k+1,:,:])*0.5
return out
-def windvec_verti_proj(u, v, lvl, angle):
- """
- Compute the projected horizontal wind vector on an axis with a given angle w.r.t. the x/ni axes (West-East)
- Arguments :
- - u : U-wind component
- - v : V-wind component
- - angle (radian) of the new axe w.r.t the x/ni axes (West-East). angle = 0 for (z,x) sections, angle=pi/2 for (z,y) sections
- Returns :
- - a 3D wind component projected on the axe to be used with Panel_Plot.vector as Lvar1
- """
- out = copy.deepcopy(u)
- for k in range(len(lvl)):
- out[k,:,:] = u[k,:,:]*math.cos(angle) + v[k,:,:]*math.sin(angle)
- return out
+def windvec_verti_proj(u, v, level, angle):
+ """Compute the projected horizontal wind vector on an axis with a given angle w.r.t. the x/ni axes (West-East)
+
+ Parameters
+ ----------
+ u : array 3D
+ U-wind component
+
+ v : array 3D
+ V-wind component
+
+ level : array 1D
+ level dimension array
+
+ angle : float
+ angle (radian) of the new axe w.r.t the x/ni axes (West-East). angle = 0 for (z,x) sections, angle=pi/2 for (z,y) sections
+
+ Returns
+ -------
+
+ projected_wind : array 3D
+ a 3D wind component projected on the axe to be used with Panel_Plot.pvector as Lvar1
+ """
+ projected_wind = copy.deepcopy(u)
+ for k in range(len(level)):
+ projected_wind[k,:,:] = u[k,:,:]*math.cos(angle) + v[k,:,:]*math.sin(angle)
+ return projected_wind
def oblique_proj(var, ni, nj, lvl, i_beg, j_beg, i_end, j_end):
- """
- Compute an oblique projection of a 3D variable w.r.t. its axes
- Arguments :
- - var : 3D var to project (example THT)
- - ni : 1D x-axe of the 3D dimension
- - nj : 1D y-axe of the 3D dimension
- - level : 1D level variable (level or level_w)
- - i_beg, j_beg : coordinate of the begin point of the new axe
- - i_end, j_end : coordinate of the end point of the new axe
- Returns :
- - a 2D (z,m) variable projected on the oblique axe
- - a 1D m new axe (distance from the beggining point)
- - the angle (radian) of the new axe w.r.t the x/ni axes (West-East)
- """
- dist_seg=np.sqrt((i_end-i_beg)**2.0 + (j_end-j_beg)**2.0) # Distance de la section oblique m
- out_var = np.zeros((len(lvl),int(dist_seg)+1)) # Initialisation du nouveau champs projeté dans la coupe (z,m)
- axe_m = np.zeros(int(dist_seg)+1) #Axe des abscisses qui sera tracé selon la coupe
- axe_m_coord = [] #Coordonnées x,y des points qui composent l'axe
- axe_m_coord.append( (ni[i_beg],nj[j_beg]) ) #Le premier point est celui donné par l'utilisateur
- for m in range(int(dist_seg)): #Discrétisation selon distance de la coupe / int(distance_de_la_coupe)
- axe_m_coord.append( (axe_m_coord[0][0] + (ni[i_end]-ni[i_beg])/(int(dist_seg))*(m+1),
- axe_m_coord[0][1] + (nj[j_end]-nj[j_beg])/(int(dist_seg))*(m+1) ))
- axe_m[m+1] = np.sqrt((ni[i_beg]-axe_m_coord[m+1][0])**2 + (nj[j_beg]-axe_m_coord[m+1][1])**2)
-
- for k in range(len(lvl)):
- a=RectBivariateSpline(ni, nj,var[k,:,:],kx=1,ky=1) #Interpolation par niveau à l'ordre 1 pour éviter des valeurs négatives de champs strictement > 0
- for m in range(int(dist_seg)+1):
- out_var[k,m] = a.ev(axe_m_coord[m][0],axe_m_coord[m][1]) # La fonction ev de RectBivariate retourne la valeur la plus proche du point considéré
-
- angle_proj = math.acos((ni[i_end]-ni[i_beg])/axe_m[-1])
- return angle_proj, out_var, axe_m
+ """Compute an oblique projection of a 3D variable w.r.t. its axes
+
+ Parameters
+ ----------
+ var : array 3D
+ the 3D variable to project (e.g. THT)
+
+ ni : array 1D
+ 1D x-axis of the 3D dimension
+
+ nj : array 1D
+ 1D y-axis of the 3D dimension
+
+ level : array 1D
+ 1D z-axe of the 3D dimension
+
+ i_beg, j_beg : int
+ coordinate of the begin point of the new axe
+
+ i_end, j_end : int
+ coordinate of the end point of the new axe
+
+ Returns
+ -------
+ angle_proj : float
+ the angle (radian) of the new axe w.r.t the x/ni axes (West-East)
+
+ out_var : array 2D
+ a 2D (z,m) variable projected on the oblique axe
+
+ axe_m : array 1D
+ a 1D m new axe (distance from the beggining point)
+
+ """
+ dist_seg=np.sqrt((i_end-i_beg)**2.0 + (j_end-j_beg)**2.0) # Distance de la section oblique m
+ out_var = np.zeros((len(lvl),int(dist_seg)+1)) # Initialisation du nouveau champs projeté dans la coupe (z,m)
+ axe_m = np.zeros(int(dist_seg)+1) #Axe des abscisses qui sera tracé selon la coupe
+ axe_m_coord = [] #Coordonnées x,y des points qui composent l'axe
+ axe_m_coord.append( (ni[i_beg],nj[j_beg]) ) #Le premier point est celui donné par l'utilisateur
+ for m in range(int(dist_seg)): #Discrétisation selon distance de la coupe / int(distance_de_la_coupe)
+ axe_m_coord.append( (axe_m_coord[0][0] + (ni[i_end]-ni[i_beg])/(int(dist_seg))*(m+1),
+ axe_m_coord[0][1] + (nj[j_end]-nj[j_beg])/(int(dist_seg))*(m+1) ))
+ axe_m[m+1] = np.sqrt((ni[i_beg]-axe_m_coord[m+1][0])**2 + (nj[j_beg]-axe_m_coord[m+1][1])**2)
+
+ for k in range(len(lvl)):
+ a=RectBivariateSpline(ni, nj,var[k,:,:],kx=1,ky=1) #Interpolation par niveau à l'ordre 1 pour éviter des valeurs négatives de champs strictement > 0
+ for m in range(int(dist_seg)+1):
+ out_var[k,m] = a.ev(axe_m_coord[m][0],axe_m_coord[m][1]) # La fonction ev de RectBivariate retourne la valeur la plus proche du point considéré
+
+ angle_proj = math.acos((ni[i_end]-ni[i_beg])/axe_m[-1])
+ return angle_proj, out_var, axe_m
def comp_altitude1DVar(oneVar2D, orography, ztop, level, n_xory):
- """
- Compute and returns an altitude and x or y grid mesh variable in 2D following the topography in 1D
- To be used with 2D simulations
- Arguments :
- - oneVar2D : a random netCDF 2D var (example UT, THT)
- - orography : 1D orography (ZS)
- - ztop : scalar of the top height of the model (ZTOP)
- - level : 1D level variable (level or level_w)
- - n_xory: : 1D directionnal grid variable (ni_u, nj_u, ni_v or nj_v)
- Returns :
- - a 2D altitude variable with topography taken into account
- - a 2D directionnal variable
- """
- n_xory_2D = copy.deepcopy(oneVar2D)
- altitude = copy.deepcopy(oneVar2D)
- for i in range(len(level)):
- n_xory_2D[i,:] = n_xory
- for j in range(len(n_xory)):
+ """Compute and returns an altitude and x or y grid mesh variable in 2D following the topography in 1D
+ To be used with 2D simulations
+
+ Parameters
+ ----------
+ oneVar2D : array 2D
+ a 2D array (e.g. UT, THT)
+
+ orography : array 1D
+ 1D orography (ZS)
+
+ ztop : real
+ scalar of the top height of the model (ZTOP)
+
+ level : array 1D
+ 1D level variable (level or level_w)
+
+ n_xory : array 1D
+ 1D directionnal grid variable (ni_u, nj_u, ni_v or nj_v)
+
+ Returns
+ -------
+ altitude
+ a 2D altitude variable with topography taken into account
+
+ n_xory_2D
+ a 2D directionnal variable duplicated from n_xory
+ """
+ n_xory_2D = copy.deepcopy(oneVar2D)
+ altitude = copy.deepcopy(oneVar2D)
+
for k in range(len(level)):
- altitude[k,j] = orography[j] + level[k]*((ztop-orography[j])/ztop)
- return altitude, n_xory_2D
+ n_xory_2D[k,:] = n_xory
+ for j in range(len(n_xory)):
+ for k in range(len(level)):
+ altitude[k,j] = orography[j] + level[k]*((ztop-orography[j])/ztop)
+ return altitude, n_xory_2D
def comp_altitude2DVar(oneVar3D, orography, ztop, level, n_y, n_x):
- """
- Compute and returns an altitude and x or y grid mesh variable in 3D following the topography in 2D
- To be used with 3D simulations in cartesian coordinates
- Arguments :
- - oneVar3D : a random netCDF 3D var (example UT, THT)
- - orography : 2D orography (ZS)
- - ztop : scalar of the top height of the model (ZTOP)
- - level : 1D level variable (level or level_w)
- - n_xory: : 1D directionnal grid variable (ni_u, nj_u, ni_v or nj_v)
- Returns :
- - a 3D altitude variable with topography taken into account
- - a 3D directionnal variable
- """
- n_x3D = copy.deepcopy(oneVar3D)
- n_y3D = copy.deepcopy(oneVar3D)
- altitude = copy.deepcopy(oneVar3D)
- for i in range(len(level)):
- n_y3D[i,:] = n_y
- n_x3D[i,:] = n_x
- for i in range(oneVar3D.shape[2]):
- for j in range(oneVar3D.shape[1]):
- if ztop==0:
- altitude[:,i,j] = level[:]
- else:
- for k in range(len(level)):
- altitude[k,j,i] = orography[j,i] + level[k]*((ztop-orography[j,i])/ztop)
-
- return altitude, n_x3D, n_y3D
+ """Compute and returns an altitude and x or y grid mesh variable in 3D following the topography in 2D
+ To be used with 3D simulations
+
+ Parameters
+ ----------
+ oneVar3D : array 3D
+ a 3D array (e.g. UT, THT)
+
+ orography : array 2D
+ 2D orography (ZS)
+
+ ztop : real
+ scalar of the top height of the model (ZTOP)
+
+ level : array 1D
+ 1D level variable (level or level_w)
+
+ n_x : array 1D
+ 1D directionnal grid variable along i (ni_u, or ni_v)
+
+ n_y : array 1D
+ 1D directionnal grid variable along j (nj_u, or nj_v)
+
+ Returns
+ -------
+ altitude
+ a 3D altitude variable with topography taken into account
+
+ n_x3D
+ a 3D directionnal variable duplicated from n_x
+
+ n_y3D
+ a 3D directionnal variable duplicated from n_y
+ """
+ n_x3D = copy.deepcopy(oneVar3D)
+ n_y3D = copy.deepcopy(oneVar3D)
+ altitude = copy.deepcopy(oneVar3D)
+ for i in range(len(level)):
+ n_y3D[i,:] = n_y
+ n_x3D[i,:] = n_x
+ for i in range(oneVar3D.shape[2]):
+ for j in range(oneVar3D.shape[1]):
+ if ztop==0:
+ altitude[:,i,j] = level[:]
+ else:
+ for k in range(len(level)):
+ altitude[k,j,i] = orography[j,i] + level[k]*((ztop-orography[j,i])/ztop)
+ return altitude, n_x3D, n_y3D
\ No newline at end of file
diff --git a/src/LIB/Python/read_MNHfile.py b/src/LIB/Python/read_MNHfile.py
index 7ad0bd539810b5413023b7339b11e479f3a7d548..e9a4ce4397d923c009d93d93cb2864d7061dd8d9 100644
--- a/src/LIB/Python/read_MNHfile.py
+++ b/src/LIB/Python/read_MNHfile.py
@@ -1,287 +1,344 @@
#!/usr/bin/env python3
# -*- coding: utf-8 -*-
"""
-Created on Mon Feb 22 10:29:13 2021
+MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+MNH_LIC for details. version 1.
-@author: rodierq
+@author: 07/2021 Quentin Rodier
"""
-
import netCDF4 as nc
import numpy as np
-def read_netcdf(LnameFiles, Dvar_input, path='.', removeHALO=True):
- Dvar = {}
- for i,nameFiles in enumerate(LnameFiles):
- f_nb = 'f' + str(i+1)
- print('Reading file ' + f_nb)
- print(path + nameFiles)
- if '000' in nameFiles[-6:-3]: #time series file (diachronic)
+def read_netcdf(LnameFiles, Dvar_input, path='.', get_data_only=True, del_empty_dim=True, removeHALO=True):
+ """Read a netCDF4 Meso-NH file
+ For each file, call functions to read diachronic or synchronous file
+
+ Parameters
+ ----------
+ LnameFiles : list of str
+ list of Meso-NH netCDF4 file (diachronic or synchronous)
+
+ Dvar_input : Dict{'fileNumber' : 'var_name',('group_name','var_name')}
+ where
+ 'fileNumber' is a str corresponding to 'f' + the file number in LnameFiles (by order)
+ 'var_name' is the exact str of the netCDF4 variable name
+ ('group_name','var_name') is the exact tuple of the (sub-)groups name and the netCDF4 variable name
+ e.g. : {'f1':['ZS', 'WT','ni', 'level'],
+ 'f2':[('/LES_budgets/Cartesian/Not_time_averaged/Not_normalized/cart/',MEAN_TH'),('/Budgets/RI','AVEF')]
+ }
+
+ path : str
+ unique path of the files
+
+ get_data_only : bool, default: True
+ if True, the function returns Dvar as masked_array (only data)
+ if False, the function returns Dvar as netCDF4._netCDF4.Variable
+
+ del_empty_dim : bool, default: True
+ if get_data_only=True and del_empty_dim=True, returns Dvar as an array without dimensions with size 1 and 0
+ e.g. : an array of dimensions (time_budget, cart_level, cart_nj, cart_ni) with shape (180,1,50,1) is returned (180,50)
+
+ removeHALO : bool, default: True
+ if True, remove first and last (NHALO=1) point [1:-1] if get_data_only=True on each
+ level, level_w, ni, ni_u, ni_v, nj, nj_u, nj_v dimensions
+
+ Returns
+ -------
+ Dvar : Dict
+ Dvar[ifile]['var_name'] if the group contains only one variable
+ Dvar[ifile][('group_name','var_name')] if the group contains more than one variable
+ """
+ Dvar = {}
+ for i,nameFiles in enumerate(LnameFiles):
+ f_nb = 'f' + str(i+1)
+ print('Reading file ' + f_nb)
+ print(path + nameFiles)
theFile = nc.Dataset(path + nameFiles,'r')
- if theFile['MASDEV'][0] <= 54:
- read_TIMESfiles_54(theFile, f_nb, Dvar_input, Dvar)
- else : # 55 groups variables
- read_TIMESfiles_55(theFile, f_nb, Dvar_input, Dvar, removeHALO)
+ Dvar[f_nb] = {}
+ if '000' in nameFiles[-6:-3]:
+ if theFile['MASDEV'][0] <= 54:
+ raise TypeError('The python lib is available for MNH >= 5.5')
+ else:
+ Dvar[f_nb] = read_TIMESfiles_55(theFile, Dvar_input[f_nb], Dvar[f_nb], get_data_only, del_empty_dim, removeHALO)
+ else:
+ Dvar[f_nb]= read_BACKUPfile(theFile, Dvar_input[f_nb], Dvar[f_nb], get_data_only, del_empty_dim, removeHALO)
theFile.close()
- else:
- read_BACKUPfile(nameFiles, f_nb, Dvar_input, Dvar, path=path, removeHALO=removeHALO)
- return Dvar #Return the dic of [files][variables]
-
-def read_BACKUPfile(nameF, ifile, Dvar_input, Dvar_output, path='.', removeHALO=True):
- theFile = nc.Dataset(path + nameF,'r')
- Dvar_output[ifile] = {} #initialize dic for each files
-
- # Reading date since beginning of the model run
- Dvar_output[ifile]['time'] = theFile.variables['time'][0]
- Dvar_output[ifile]['date'] = nc.num2date(Dvar_output[ifile]['time'],units=theFile.variables['time'].units, calendar = theFile.variables['time'].calendar)
+ return Dvar
- for var in Dvar_input[ifile]: #For each files
- # Read variables
- n_dim = theFile.variables[var].ndim
- name_dim = theFile.variables[var].dimensions
+def read_var(theFile, Dvar, var_name, get_data_only=True, del_empty_dim=True, removeHALO=True):
+ """Read a netCDF4 variable
+
+ Parameters
+ ----------
+ theFile : netCDF4._netCDF4.Dataset
+ a Meso-NH diachronic netCDF4 file
+
+ var_name : str
+ a Meso-NH netCDF4 variable name
+
+ get_data_only : bool, default: True
+ if True, the function returns Dvar as masked_array (only data)
+ if False, the function returns Dvar as netCDF4._netCDF4.Variable
- if (n_dim ==0) or (n_dim == 1 and 'time' in name_dim): #Scalaires or Variable time
- Dvar_output[ifile][var] = theFile.variables[var][0].data
- else:
+ del_empty_dim : bool, default: True
+ if get_data_only=True and del_empty_dim=True, returns Dvar as an array without dimensions with size 1 and 0
+ e.g. : an array of dimensions (time_budget, cart_level, cart_nj, cart_ni) with shape (180,1,50,1) is returned (180,50)
+
+ removeHALO : bool, default: True
+ if True, remove first and last (NHALO=1) point [1:-1] if get_data_only=True on each
+ level, level_w, ni, ni_u, ni_v, nj, nj_u, nj_v dimensions
+
+ Returns
+ -------
+ Dvar : Dict
+ Dvar['var_name'] if the group contains only one variable
+ Dvar[('group_name','var_name')] if the group contains more than one variable
+ """
+ try:
+ var_dim = theFile.variables[var_name].ndim
+ var_dim_name = theFile.variables[var_name].dimensions
+ except:
+ raise KeyError("Group and variable name not found in the file, check the group/variable name with ncdump -h YourMNHFile.000.nc. You asked for variable : " + var_name)
+
+ if not get_data_only:
+ Dvar[var_name] = theFile.variables[var_name]
+ else:
+ if var_dim == 0:
+ Dvar[var_name] = theFile.variables[var_name][0].data
+ elif var_dim == 1:
+ Dvar[var_name] = theFile.variables[var_name][:]
+ elif var_dim == 2:
+ Dvar[var_name] = theFile.variables[var_name][:,:]
+ elif var_dim == 3:
+ Dvar[var_name] = theFile.variables[var_name][:,:,:]
+ elif var_dim == 4:
+ Dvar[var_name] = theFile.variables[var_name][:,:,:,:]
+ elif var_dim == 5:
+ Dvar[var_name] = theFile.variables[var_name][:,:,:,:,:]
+ elif var_dim == 6:
+ Dvar[var_name] = theFile.variables[var_name][:,:,:,:,:,:]
+ elif var_dim == 7:
+ Dvar[var_name] = theFile.variables[var_name][:,:,:,:,:,:,:]
if removeHALO:
- if n_dim == 1:
- Dvar_output[ifile][var] = theFile.variables[var][1:-1] #Variables 1D
- elif n_dim == 2:
- if theFile.variables[var].shape[0] == 1 and 'size' in name_dim[1]: #Variables 2D with the second dimension not a coordinate (--> list of strings : chemicals)
- Dvar_output[ifile][var] = theFile.variables[var][0,:] #Variables 2D
- elif theFile.variables[var].shape[0] == 1: #Variables 2D with first dim = 0
- Dvar_output[ifile][var] = theFile.variables[var][0,1:-1] #Variables 2D
- else:
- Dvar_output[ifile][var] = theFile.variables[var][1:-1,1:-1] #Variables 2D
- elif n_dim == 5: #Variables time, sizeXX, level, nj, ni (ex: chemical budgets in 3D)
- Dvar_output[ifile][var] = theFile.variables[var][0, :, 1:-1,:1:-1,1:-1]
- elif n_dim == 4 and 'time' in name_dim and ('level' in name_dim or 'level_w' in name_dim): # time,z,y,x
- if theFile.variables[var].shape[1] == 1: #Variables 4D time,z,y,x with time=0 z=0
- Dvar_output[ifile][var] = theFile.variables[var][0,0,1:-1,1:-1] #Variables 2D y/x
- elif theFile.variables[var].shape[2] == 1: #Variable 2D (0,zz,0,xx)
- Dvar_output[ifile][var] = theFile.variables[var][0,1:-1,0,1:-1] #Variables 2D z/y
- elif theFile.variables[var].shape[3] == 1: #Variable 2D (0,zz,yy,0)
- Dvar_output[ifile][var] = theFile.variables[var][0,1:-1,1:-1,0] #Variables 2D z/x
- ## ATTENTION VARIABLE 1D codé en 4D non faite
- else: #Variable 3D simple
- Dvar_output[ifile][var] = theFile.variables[var][0,1:-1,1:-1,1:-1] #Variables time + 3D
- elif n_dim == 4 and 'time' in name_dim and 'level' not in name_dim and 'level_w' not in name_dim: # time,nb_something,y,x
- Dvar_output[ifile][var] = theFile.variables[var][0,:,1:-1,1:-1] #Variables 2D y/x
- elif n_dim == 3 and 'time' in name_dim: # time, y, x
- Dvar_output[ifile][var] = theFile.variables[var][0,1:-1,1:-1]
- else :
- Dvar_output[ifile][var] = theFile.variables[var][1:-1,1:-1,1:-1] #Variables 3D
- else:
- if n_dim == 1:
- Dvar_output[ifile][var] = theFile.variables[var][:] #Variables 1D
- elif n_dim == 2:
- if theFile.variables[var].shape[0] == 1 and 'size' in name_dim[1]: #Variables 2D with the second dimension not a coordinate (--> list of strings : chemicals)
- Dvar_output[ifile][var] = theFile.variables[var][0,:] #Variables 2D
- elif theFile.variables[var].shape[0] == 1: #Variables 2D with first dim = 0
- Dvar_output[ifile][var] = theFile.variables[var][0,:] #Variables 2D
- else:
- Dvar_output[ifile][var] = theFile.variables[var][:,:] #Variables 2D
- elif n_dim == 5: #Variables time, sizeXX, level, nj, ni (ex: chemical budgets in 3D)
- Dvar_output[ifile][var] = theFile.variables[var][0,:,:,:,:]
- elif n_dim == 4: # time,z,y,x
- if theFile.variables[var].shape[1] == 1: #Variables 4D time,z,y,x with time=0 z=0
- Dvar_output[ifile][var] = theFile.variables[var][0,0,:,:] #Variables 2D y/x
- elif theFile.variables[var].shape[2] == 1: #Variable 2D (0,zz,0,xx)
- Dvar_output[ifile][var] = theFile.variables[var][0,:,0,:] #Variables 2D z/y
- elif theFile.variables[var].shape[3] == 1: #Variable 2D (0,zz,yy,0)
- Dvar_output[ifile][var] = theFile.variables[var][0,:,:,0] #Variables 2D z/x
- ## ATTENTION VARIABLE 1D codé en 4D non faite
- else: #Variable 3D simple
- Dvar_output[ifile][var] = theFile.variables[var][0,:,:,:] #Variables time + 3D
- elif n_dim ==3 and name_dim in var.dimensions: # time, y, x
- Dvar_output[ifile][var] = theFile.variables[var][0,:,:]
- else:
- Dvar_output[ifile][var] = theFile.variables[var][:,:,:] #Variables 3D
- # For all variables except scalars, change Fill_Value to NaN
- Dvar_output[ifile][var]= np.where(Dvar_output[ifile][var] != -99999.0, Dvar_output[ifile][var], np.nan)
- Dvar_output[ifile][var]= np.where(Dvar_output[ifile][var] != 999.0, Dvar_output[ifile][var], np.nan)
-
- theFile.close()
- return Dvar_output #Return the dic of [files][variables]
-
-def read_TIMESfiles_54(theFile, ifile, Dvar_input, Dvar_output):
- Dvar_output[ifile] = {} #initialize dic for each files
+ for i in range(8):
+ try:
+ if var_dim_name[i]=='level' or var_dim_name[i]=='level_w' or \
+ var_dim_name[i]=='ni' or var_dim_name[i]=='ni_u' or var_dim_name[i]=='ni_v' or \
+ var_dim_name[i]=='nj' or var_dim_name[i]=='nj_u' or var_dim_name[i]=='nj_v':
+ if var_dim != 0:
+ Dvar[var_name] = removetheHALO(i+1, Dvar[var_name])
+ except:
+ break
+ if del_empty_dim:
+ Ldimtosqueeze=[]
+ var_shape = theFile.variables[var_name].shape
+ for i in range(8):
+ try:
+ if var_shape[i]==1: Ldimtosqueeze.append(i)
+ except IndexError:
+ break
+ Ldimtosqueeze=tuple(Ldimtosqueeze)
+ Dvar[var_name] = np.squeeze(Dvar[var_name], axis=Ldimtosqueeze)
+
+ return Dvar
- # Level variable is automatically read without the Halo
- Dvar_output[ifile]['level'] = theFile.variables['level'][1:-1]
+def read_from_group(theFile, Dvar, group_name, var_name, get_data_only=True, del_empty_dim=True,removeHALO=True):
+ """Read a variable from a netCDF4 group
- # Time variable is automatically read (time since begging of the run) from the 1st variable of the asked variable to read
- suffix, name_first_var = remove_PROC(Dvar_input[ifile][0])
- try: # It is possible that there is only one value (one time) in the .000 file, as such time series are not suitable and the following line can't be executed. The time variable is then not written
- increment = theFile.variables[name_first_var+'___DATIM'][1,-1] - theFile.variables[name_first_var+'___DATIM'][0,-1] #-1 is the last entry of the date (current UTC time in seconds)
- length_time = theFile.variables[name_first_var+'___DATIM'].shape[0]
- Dvar_output[ifile]['time'] = np.arange(increment,increment*(length_time+1),increment)
+ Parameters
+ ----------
+ theFile : netCDF4._netCDF4.Dataset
+ a Meso-NH diachronic netCDF4 file
+
+ group_name : str
+ a Meso-NH netCDF4 group name
+
+ var_name : str
+ a Meso-NH netCDF4 variable name
+
+ get_data_only : bool, default: True
+ if True, the function returns Dvar as masked_array (only data)
+ if False, the function returns Dvar as netCDF4._netCDF4.Variable
+
+ del_empty_dim : bool, default: True
+ if get_data_only=True and del_empty_dim=True, returns Dvar as an array without dimensions with size 1 and 0
+ e.g. : an array of dimensions (time_budget, cart_level, cart_nj, cart_ni) with shape (180,1,50,1) is returned (180,50)
+
+ removeHALO : bool, default: True
+ if True, remove first and last (NHALO=1) point [1:-1] if get_data_only=True on each
+ level, level_w, ni, ni_u, ni_v, nj, nj_u, nj_v dimensions
+
+ Returns
+ -------
+ Dvar : Dict
+ Dvar['var_name'] if the group contains only one variable
+ Dvar[('group_name','var_name')] if the group contains more than one variable
+ """
+ try:
+ var_dim = theFile[group_name].variables[var_name].ndim
+ var_dim_name = theFile[group_name].variables[var_name].dimensions
except:
- pass
+ raise KeyError("Group and variable name not found in the file, check the group/variable name with ncdump -h YourMNHFile.000.nc. You asked for group/variable : " + group_name + var_name)
- for var in Dvar_input[ifile]: #For each files
- suffix, var_name = remove_PROC(var)
- n_dim = theFile.variables[var].ndim
- name_dim = theFile.variables[var].dimensions
+ if not get_data_only:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name]
+ else:
+ if var_dim == 0:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][0].data
+ if var_dim == 1:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:]
+ elif var_dim == 2:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:]
+ elif var_dim == 3:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:]
+ elif var_dim == 4:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:]
+ elif var_dim == 5:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:,:]
+ elif var_dim == 6:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:,:,:]
+ elif var_dim == 7:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:,:,:,:]
+ if removeHALO:
+ for i in range(8):
+ try:
+ if var_dim_name[i]=='level' or var_dim_name[i]=='level_w' or \
+ var_dim_name[i]=='ni' or var_dim_name[i]=='ni_u' or var_dim_name[i]=='ni_v' or \
+ var_dim_name[i]=='nj' or var_dim_name[i]=='nj_u' or var_dim_name[i]=='nj_v':
+ if var_dim != 0:
+ Dvar[var_name] = removetheHALO(i+1, Dvar[var_name])
+ except:
+ break
+ if del_empty_dim:
+ Ldimtosqueeze=[]
+ var_shape = Dvar[(group_name,var_name)].shape
+ for i in range(8):
+ try:
+ if var_shape[i]==1: Ldimtosqueeze.append(i)
+ except IndexError:
+ break
+ Ldimtosqueeze=tuple(Ldimtosqueeze)
+ Dvar[(group_name,var_name)] = np.squeeze(Dvar[(group_name,var_name)], axis=Ldimtosqueeze)
+
+ # LES budget needs to be transposed to use psection functions without specifying .T each time
+ if 'LES_budgets' in group_name:
+ Dvar[(group_name,var_name)] = Dvar[(group_name,var_name)].T
+ return Dvar
- # First, test if the variable is a dimension/coordinate variable
- if (n_dim ==0): # Scalaires variable
- Dvar_output[ifile][var] = theFile.variables[var][0].data
- pass
- elif n_dim == 1:
- Dvar_output[ifile][var_name] = theFile.variables[var][1:-1] # By default, the Halo is always removed because is not in the other variables in any .000 variable
- pass
- elif n_dim == 2:
- Lsize1 = list_size1(n_dim, name_dim)
- if Lsize1 == [True, False]: Dvar_output[ifile][var_name] = theFile.variables[var][0,1:-1]
- pass
+def read_BACKUPfile(theFile, Dvar_input, Dvar, get_data_only=True, del_empty_dim=True, removeHALO=True):
+ """Read variables from Meso-NH MASDEV >= 5.5.0 synchronous file
+ For all variables in Dvar_input of one file, call functions to read the variable of the group+variable
+
+ Parameters
+ ----------
+ theFile : netCDF4._netCDF4.Dataset
+ a Meso-NH diachronic netCDF4 file
- Lsize1 = list_size1(n_dim, name_dim)
- if Lsize1 == [True, False, False, True, True]: Dvar_output[ifile][var_name] = theFile.variables[var][0,:,:,0,0].T # Need to be transposed here
- if Lsize1 == [True, True, False, True, False]: Dvar_output[ifile][var_name] = theFile.variables[var][0,0,:,0,:]
-
- return Dvar_output #Return the dic of [files][variables]
+ Dvar_input : Dict{'var_name',('group_name','var_name')}
+ with
+ 'var_name' is the exact str of the netCDF4 variable name
+ ('group_name','var_name') is the exact tuple of the (sub-)groups name and the netCDF4 variable name
+ e.g. : {'f1':['ZS', 'WT','ni', 'level'],
+ 'f2':[('/LES_budgets/Cartesian/Not_time_averaged/Not_normalized/cart/',MEAN_TH'),('/Budgets/RI','AVEF')]
+ }
+
+ get_data_only: bool, default: True
+ if True, the function returns Dvar as masked_array (only data)
+ if False, the function returns Dvar as netCDF4._netCDF4.Variable
+
+ del_empty_dim: bool, default: True
+ if get_data_only=True and del_empty_dim=True, returns Dvar as masked_array without dimensions with size 1 and 0
+ e.g. : an array of dimensions (time_budget, cart_level, cart_nj, cart_ni) with shape (180,1,50,1) is returned (180,50)
+
+ Returns
+ -------
+ Dvar : Dict
+ Dvar['var_name'] if the group contains only one variable
+ Dvar[('group_name','var_name')] if the group contains more than one variable
+ """
+ # Reading date since beginning of the model run
+ Dvar['time'] = theFile.variables['time'][0]
+ Dvar['date'] = nc.num2date(Dvar['time'],units=theFile.variables['time'].units, calendar = theFile.variables['time'].calendar)
+
+ for var in Dvar_input:
+ if type(var) == tuple:
+ Dvar = read_from_group(theFile, Dvar, var[0], var[1], get_data_only, del_empty_dim, removeHALO)
+ else:
+ Dvar = read_var(theFile, Dvar, var, get_data_only, del_empty_dim, removeHALO)
+
+ # For all variables except scalars, change Fill_Value to NaN
+ Dvar[var]= np.where(Dvar[var] != -99999.0, Dvar[var], np.nan)
+ Dvar[var]= np.where(Dvar[var] != 999.0, Dvar[var], np.nan)
+ return Dvar
-def read_TIMESfiles_55(theFile, ifile, Dvar_input, Dvar_output, removeHALO=False):
- """
- Read variables from MNH MASDEV >= 5.5.0
- Parameters :
- - Dvar_input : dictionnary of {file : var}. var can be either
- - a string = the variable name
- - or a tuple of ('group_name','var_name')
- If the variable desired is in a group_name and the group_name is not specified, it is assumed group_name = variable_name
- except for specific variable as (cart, neb, clear, cs1, cs2, cs3) type
- Return :
- Dvar_output : dictionnary of Dvar_output[ifile][variables or tuple (group,variables) if the user specified a tuple]
- """
- Dvar_output[ifile] = {} #initialize dic for each files
- def read_var(theFile, Dvar_output, var):
- suffix, var_name = remove_PROC(var)
- try: # NetCDF4 Variables
- n_dim = theFile.variables[var_name].ndim
- # First, test if the variable is a dimension/coordinate variable
- if (n_dim ==0): # Scalaires variable
- Dvar_output[var_name] = theFile.variables[var_name][0].data
- else:
- if(removeHALO):
- if n_dim == 1:
- Dvar_output[var_name] = theFile.variables[var_name][1:-1]
- elif n_dim == 2:
- Dvar_output[var_name] = theFile.variables[var_name][1:-1,1:-1]
- else:
- raise NameError("Lecture des variables de dimension sup a 2 pas encore implementees pour fichiers .000")
- else:
- if n_dim == 1:
- Dvar_output[var_name] = theFile.variables[var_name][:]
- elif n_dim == 2:
- Dvar_output[var_name] = theFile.variables[var_name][:,:]
- else:
- raise NameError("Lecture des variables de dimension sup a 2 pas encore implementees pour fichiers .000")
- except KeyError: # NetCDF4 Group not specified by the user
- if '(cart)' in var_name or '(neb)' in var_name or '(clear)' in var_name or '(cs1)' in var_name or '(cs2)' in var_name or '(cs3)' in var_name or 'AVEF' in suffix or 'INIF' in suffix or 'ENDF' in suffix:
- # If users specify the complete variable name with averaging type
- group_name = get_group_from_varname(var_name)
- else:
- group_name = var_name
- read_from_group(theFile, Dvar_output, group_name, var)
- return Dvar_output
+def read_TIMESfiles_55(theFile, Dvar_input, Dvar, get_data_only=True, del_empty_dim=True, removeHALO=True):
+ """Read variables from Meso-NH MASDEV >= 5.5.0 diachronic file
+ For all variables in Dvar_input of one file, call functions to read the variable of the group+variable
- def read_from_group(theFile, Dvar_output, group_name, var):
- """
- Read variables from MNH MASDEV >= 5.5.0
- Parameters :
- - var : the variable name
- - group_name : the group name
- Return :
- Dvar_output : dictionnary of :
- - Dvar_output[ifile]['var_name'] if the group contains only one variable
- - Dvar_output[ifile][('group_name','var_name'] if the group contains more than one variable
- """
- if '___' in var:
- suffix, var_name = remove_PROC(var)
- else:
- suffix = var
- var_name = var
- if group_name == 'TSERIES' or group_name =='AVION': #always 1D
- Dvar_output[(group_name,var)] = theFile.groups[group_name].variables[var][:]
- elif group_name == 'ZTSERIES' or group_name =='AVIONZ': #always 2D
- Dvar_output[(group_name,var)] = theFile.groups[group_name].variables[var][:,:].T
- elif 'XTSERIES' in group_name: #always 2D
- Dvar_output[(group_name,var)] = theFile.groups[group_name].variables[var][:,:].T
- elif theFile.groups[group_name].type == 'TLES' : # LES type
- try: #By default, most variables read are 2D cart and user does not specify it in the variable name
- whites = ' '*(17 - len('(cart)') - len(var_name))
- Dvar_output[var] = theFile.groups[var].variables[var + whites + '(cart)'][:,:].T
- except:
- try: #Variable 3D sv,time_les, level_les
- Dvar_output[var] = theFile.groups[group_name].variables[var][:,:,:]
- except:
- try: #Variable 2D with type of variable specified (cart, neb, clear, cs1, cs2, cs3)
- Dvar_output[var] = theFile.groups[group_name].variables[var][:,:].T
- except ValueError: # Variable 1D
- Dvar_output[var] = theFile.groups[group_name].variables[var][:]
- elif theFile.groups[group_name].type == 'CART': # Budget CART type
- shapeVar = theFile.groups[group_name].variables[suffix].shape
- Ltosqueeze=[] # Build a tuple with the number of the axis which are 0 dimensions to be removed by np.squeeze
- if shapeVar[0]==1: Ltosqueeze.append(0)
- if shapeVar[1]==1: Ltosqueeze.append(1)
- if shapeVar[2]==1: Ltosqueeze.append(2)
- if shapeVar[3]==1: Ltosqueeze.append(3)
- Ltosqueeze=tuple(Ltosqueeze)
- if len(theFile.groups[group_name].variables.keys()) > 1: # If more than one variable in the group
- Dvar_output[(group_name,var)] = np.squeeze(theFile.groups[group_name].variables[suffix][:,:,:,:], axis=Ltosqueeze)
- else:
- Dvar_output[group_name] = np.squeeze(theFile.groups[group_name].variables[suffix][:,:,:,:], axis=Ltosqueeze)
- elif theFile.groups[group_name].type == 'MASK': # Budget MASK type
- shapeVar = theFile.groups[group_name].variables[suffix].shape
- Ltosqueeze=[] # Build a tuple with the number of the axis which are 0 dimensions to be removed by np.squeeze
- if shapeVar[0]==1: Ltosqueeze.append(0)
- if shapeVar[1]==1: Ltosqueeze.append(1)
- if shapeVar[2]==1: Ltosqueeze.append(2)
- Ltosqueeze=tuple(Ltosqueeze)
- if len(theFile.groups[group_name].variables.keys()) > 1: # If more than one variable in the group
- Dvar_output[(group_name,var)] = np.squeeze(theFile.groups[group_name].variables[suffix][:,:,:], axis=Ltosqueeze).T
- else:
- Dvar_output[group_name] = np.squeeze(theFile.groups[group_name].variables[suffix][:,:,:], axis=Ltosqueeze).T
- else:
- raise NameError("Type de groups variables not implemented in read_MNHfile.py")
- return Dvar_output
- for var in Dvar_input[ifile]: #For each var
+ Parameters
+ ----------
+ theFile : netCDF4._netCDF4.Dataset
+ a Meso-NH diachronic netCDF4 file
+
+ Dvar_input : Dict{'var_name',('group_name','var_name')}
+ with
+ 'var_name' is the exact str of the netCDF4 variable name
+ ('group_name','var_name') is the exact tuple of the (sub-)groups name and the netCDF4 variable name
+ e.g. : {'f1':['ZS', 'WT','ni', 'level'],
+ 'f2':[('/LES_budgets/Cartesian/Not_time_averaged/Not_normalized/cart/',MEAN_TH'),('/Budgets/RI','AVEF')]
+ }
+
+ get_data_only: bool, default: True
+ if True, the function returns Dvar as masked_array (only data)
+ if False, the function returns Dvar as netCDF4._netCDF4.Variable
+
+ del_empty_dim: bool, default: True
+ if get_data_only=True and del_empty_dim=True, returns Dvar as masked_array without dimensions with size 1 and 0
+ e.g. : an array of dimensions (time_budget, cart_level, cart_nj, cart_ni) with shape (180,1,50,1) is returned (180,50)
+
+ Returns
+ -------
+ Dvar : Dict
+ Dvar[ifile]['var_name'] if the group contains only one variable
+ Dvar[ifile][('group_name','var_name')] if the group contains more than one variable
+ """
+ for var in Dvar_input:
+ print(var)
if type(var) == tuple:
- Dvar_output[ifile] = read_from_group(theFile, Dvar_output[ifile], var[0], var[1])
+ Dvar = read_from_group(theFile, Dvar, var[0], var[1], get_data_only, del_empty_dim, removeHALO)
else:
- Dvar_output[ifile] = read_var(theFile, Dvar_output[ifile], var)
-
- return Dvar_output #Return the dic of [files][variables]
+ Dvar = read_var(theFile, Dvar, var, get_data_only, del_empty_dim, removeHALO)
+ return Dvar
-def list_size1(n_dim, named_dim):
- Lsize1 = []
- for i in range(n_dim):
- if 'size1' == named_dim[i]:
- Lsize1.append(True)
- else:
- Lsize1.append(False)
- return Lsize1
+def removetheHALO(idim, var):
+ """Remove a NHALO=1 point [1:-1] at a given dimension idim of a variable var
-def remove_PROC(var):
- if '___PROC' in var:
- var_name = var[:-8]
- suffix = "" # No need of suffix for MNHVERSION < 550 (suffix is for NetCDF4 group)
- elif '___ENDF' in var or '___INIF' in var or '___AVEF' in var:
- var_name = var[:-7]
- suffix = var[-4:]
- else:
- var_name = var
- suffix = ''
- return suffix, var_name
-
-def get_group_from_varname(var):
- group_name=''
- if '___ENDF' in var or '___INIF' in var or '___AVEF' in var: #Variable CART
- suff, group_name = remove_PROC(var)
- else: #Variable with whites in names ex: 'MEAN_TH (cart)'
- for i in range(len(var)):
- if var[i] != ' ':
- group_name+=var[i]
- else: # As soon as the caracter is a blank, the group variable is set
- break
- return group_name
+ Parameters
+ ----------
+ idim: int
+ the dimension over which remove the first and last point
+
+ var: array
+ a Meso-NH netCDF4 variable name
+
+ Returns
+ -------
+ var : array
+ """
+ if idim == 1:
+ var = var[1:-1]
+ elif idim == 2:
+ var = var[:,1:-1]
+ elif idim == 3:
+ var = var[:,:,1:-1]
+ elif idim == 4:
+ var = var[:,:,:,1:-1]
+ elif idim == 5:
+ var = var[:,:,:,:,1:-1]
+ elif idim == 6:
+ var = var[:,:,:,:,:,1:-1]
+ elif idim == 7:
+ var = var[:,:,:,:,:,:,1:-1]
+ return var
\ No newline at end of file
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index d3a1e491f775888a9ca30da15c2290be8e44fabe..363f282eb9f96565a7d59f6bfad5c0cb492cae2b 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -14,7 +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
+! JL Redelsperger 03/2021: add variables for Ocean LES and auto-coupled version
!-----------------------------------------------------------------
module mode_field
@@ -1297,7 +1297,7 @@ IDX = IDX+1
!
IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
TFIELDLIST(IDX)%CMNHNAME = 'PHIT'
-TFIELDLIST(IDX)%CSTDNAME = 'reduced pressure'
+TFIELDLIST(IDX)%CSTDNAME = ''
TFIELDLIST(IDX)%CLONGNAME = 'PHIT'
TFIELDLIST(IDX)%CUNITS = 'Pa'
TFIELDLIST(IDX)%CDIR = 'XY'
@@ -3494,9 +3494,9 @@ IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
TFIELDLIST(IDX)%CMNHNAME = 'NFRCLT'
TFIELDLIST(IDX)%CSTDNAME = ''
TFIELDLIST(IDX)%CLONGNAME = 'NFRCLT'
-TFIELDLIST(IDX)%CUNITS = 'nb entier de forc'
+TFIELDLIST(IDX)%CUNITS = '1'
TFIELDLIST(IDX)%CDIR = '--'
-TFIELDLIST(IDX)%CCOMMENT = 'nb de flux sfc forcant LES ocean'
+TFIELDLIST(IDX)%CCOMMENT = 'number of sea surface forcings + 1'
TFIELDLIST(IDX)%NGRID = 0
TFIELDLIST(IDX)%NTYPE = TYPEINT
TFIELDLIST(IDX)%NDIMS = 0
@@ -3506,9 +3506,9 @@ IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
TFIELDLIST(IDX)%CMNHNAME = 'NINFRT'
TFIELDLIST(IDX)%CSTDNAME = ''
TFIELDLIST(IDX)%CLONGNAME = 'NINFRT'
-TFIELDLIST(IDX)%CUNITS = 'nb entier de forc'
+TFIELDLIST(IDX)%CUNITS = 's'
TFIELDLIST(IDX)%CDIR = '--'
-TFIELDLIST(IDX)%CCOMMENT = 'nb de flux sfc forcant LES ocean'
+TFIELDLIST(IDX)%CCOMMENT = 'Interval in seconds between forcings'
TFIELDLIST(IDX)%NGRID = 0
TFIELDLIST(IDX)%NTYPE = TYPEINT
TFIELDLIST(IDX)%NDIMS = 0
@@ -3859,7 +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('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
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index 10ced03147ebf0d9bb2732f10b50a360e404a136..b48a37b2649d4d8ae06964e24a736db43439cbaf 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
@@ -397,7 +397,7 @@ subroutine IO_Field_create( tpfile, tpfield )
#endif
case ( 4 ) NDIMS
- if ( tzfield%ntype /= TYPEREAL ) then
+ if ( All( tzfield%ntype /= [ TYPEINT, TYPEREAL ] ) ) then
call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_create', Trim( tpfile%cname ) // ': ' &
// Trim( tzfield%cmnhname ) // ': invalid ntype for 4D field' )
return
diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
index f6d21f935b2095cfd24eed2a48e0a08a71839510..9804348f8da7ba0f62912a75ce4861e77c93b6b6 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
@@ -17,6 +17,8 @@
! P. Wautelet 26/11/2020: IO_Vdims_fill_nc4: support for empty kshape
! P. Wautelet 08/12/2020: add nbutotwrite
! P. Wautelet 18/03/2021: workaround for an intel compiler bug
+! P. Wautelet 04/05/2021: improve IO_Vdims_fill_nc4 if l2d and lpack
+! P. Wautelet 27/05/2021: improve IO_Mnhname_clean to autocorrect names to be CF compliant
!-----------------------------------------------------------------
#ifdef MNH_IOCDF4
module mode_io_tools_nc4
@@ -437,26 +439,29 @@ integer, intent(in) :: kidx !Position of the dimension in the li
character(len=*), intent(in) :: hdimname !Name of the dimension
integer, intent(in) :: klen !Length of the dimension
+character(len=Len(hdimname)) :: ydimname_clean
integer(kind=CDFINT) :: istatus
+call IO_Mnhname_clean( hdimname, ydimname_clean )
+
if ( .not.Associated( tpfile%tncdims ) ) &
call Print_msg( NVERB_FATAL, 'IO', 'IO_Add_dim_nc4', 'tncdims not associated for ' // Trim( tpfile%cname ) )
if ( kidx < 1 .or. kidx > Size( tpfile%tncdims%tdims ) ) &
- call Print_msg( NVERB_FATAL, 'IO', 'IO_Add_dim_nc4', 'index out of range for dimension ' // Trim( hdimname ) // &
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Add_dim_nc4', 'index out of range for dimension ' // Trim( ydimname_clean ) // &
' of file ' //Trim( tpfile%cname ) )
if ( tpfile%tncdims%tdims(kidx)%nlen /= -1 .or. tpfile%tncdims%tdims(kidx)%nid /= -1 ) &
- call Print_msg( NVERB_WARNING, 'IO', 'IO_Add_dim_nc4', 'dimension ' // Trim( hdimname ) // &
+ call Print_msg( NVERB_WARNING, 'IO', 'IO_Add_dim_nc4', 'dimension ' // Trim( ydimname_clean ) // &
' already defined for file ' //Trim( tpfile%cname ) )
-tpfile%tncdims%tdims(kidx)%cname = hdimname
+tpfile%tncdims%tdims(kidx)%cname = ydimname_clean
tpfile%tncdims%tdims(kidx)%nlen = Int( klen, kind = CDFINT )
-istatus = NF90_DEF_DIM( tpfile%nncid, Trim( hdimname ), Int( klen, kind = CDFINT ), tpfile%tncdims%tdims(kidx)%nid )
+istatus = NF90_DEF_DIM( tpfile%nncid, Trim( ydimname_clean ), Int( klen, kind = CDFINT ), tpfile%tncdims%tdims(kidx)%nid )
if ( istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'IO_Add_dim_nc4', 'NF90_DEF_DIM', Trim( hdimname ) )
+ call IO_Err_handle_nc4( istatus, 'IO_Add_dim_nc4', 'NF90_DEF_DIM', Trim( ydimname_clean ) )
end subroutine IO_Add_dim_nc4
@@ -479,6 +484,7 @@ SUBROUTINE IO_Vdims_fill_nc4(TPFILE, TPFIELD, KSHAPE, KVDIMS)
use NETCDF, only: NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION
+use modd_conf, only: l2d, lpack
use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_COMPLEX, &
NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NI_U, NMNHDIM_NJ_U, NMNHDIM_NI_V, NMNHDIM_NJ_V, &
NMNHDIM_LEVEL, NMNHDIM_LEVEL_W, NMNHDIM_TIME, &
@@ -505,6 +511,7 @@ INTEGER(KIND=CDFINT),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KVDIMS
CHARACTER(LEN=32) :: YINT
CHARACTER(LEN=2) :: YDIR
character(len=:), allocatable :: ydimname
+integer :: idimn
INTEGER :: IGRID
integer :: iidx
integer :: iresp
@@ -607,8 +614,15 @@ else !ndimlist not provided
kvdims(1) = tpfile%tncdims%tdims(iidx)%nid
end if
else if ( ji == 2 ) then
- if ( ydir == 'XY' .and. kshape(2) == tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,2) )%nlen ) then
- kvdims(2) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,2) )%nid
+ !If lpack and l2d, the J dimension is not used.
+ !Therefore, in that case, the second dimension for a 'XY' field corresponds to the K dimension.
+ if ( lpack .and. l2d ) then
+ idimn = 3
+ else
+ idimn = 2
+ end if
+ if ( ydir == 'XY' .and. kshape(2) == tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,idimn) )%nlen ) then
+ kvdims(2) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,idimn) )%nid
else
call IO_Dim_find_create_nc4( tpfile, kshape(2), iidx )
kvdims(2) = tpfile%tncdims%tdims(iidx)%nid
@@ -642,7 +656,8 @@ integer(kind=CDFINT), intent(in) :: klen
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HDIMNAME
integer, intent(out) :: kidx !Position of the dimension in the dimension array
-character(len=16) :: ysuffix
+character(len=:), allocatable :: ydimname_clean
+character(len=16) :: ysuffix
integer :: inewsize
integer :: ji
integer(kind=CDFINT) :: istatus
@@ -651,10 +666,12 @@ type(tdimnc), dimension(:), allocatable :: tzncdims
kidx = -1
+if ( Present( hdimname ) ) call IO_Mnhname_clean( hdimname, ydimname_clean )
+
do ji = 1, Size( tpfile%tncdims%tdims )
if ( tpfile%tncdims%tdims(ji)%nlen == klen ) then
if ( Present( hdimname ) ) then
- if ( hdimname == Trim( tpfile%tncdims%tdims(ji)%cname ) ) then
+ if ( ydimname_clean == Trim( tpfile%tncdims%tdims(ji)%cname ) ) then
kidx = ji
exit
end if
@@ -669,9 +686,9 @@ if ( kidx == - 1 ) then
!Check if already exist with the provided name (if so => error)
if ( Present( hdimname ) ) then
do ji = 1, Size( tpfile%tncdims%tdims )
- if ( hdimname == Trim( tpfile%tncdims%tdims(ji)%cname ) ) &
+ if ( ydimname_clean == Trim( tpfile%tncdims%tdims(ji)%cname ) ) &
call Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_find_create_nc4', 'dimension ' &
- // Trim( hdimname ) // ' already exist but with a different size' )
+ // Trim( ydimname_clean ) // ' already exist but with a different size' )
end do
end if
@@ -681,7 +698,7 @@ if ( kidx == - 1 ) then
tzncdims(1 : inewsize - 1) = tpfile%tncdims%tdims(:)
if ( Present( hdimname ) ) then
- tzncdims(inewsize)%cname = Trim( hdimname )
+ tzncdims(inewsize)%cname = Trim( ydimname_clean )
else
Write( ysuffix, '( i0 )' ) klen
tzncdims(inewsize)%cname = 'size' // Trim( ysuffix )
@@ -822,31 +839,75 @@ end if
end subroutine IO_Err_handle_nc4
-SUBROUTINE IO_Mnhname_clean(HINNAME,HOUTNAME)
- CHARACTER(LEN=*),INTENT(IN) :: HINNAME
- CHARACTER(LEN=*),INTENT(OUT) :: HOUTNAME
-
+subroutine IO_Mnhname_clean( hinname, houtname )
+ ! Try to autocorrect hinname to be CF compliant
! NetCDF var names can't contain '%' nor '.'
- ! CF convention allows only letters, digits and underscores
- HOUTNAME = str_replace(HINNAME, '%', '__')
- HOUTNAME = str_replace(HOUTNAME, '.', '___')
-END SUBROUTINE
+ ! CF convention allows only letters, digits and underscores for variable, dimension, attribute and group names
+ ! and they should begin with a letter
+ character(len=*), intent(in) :: hinname
+ character(len=*), intent(out) :: houtname
+ character(len=:), allocatable :: yresult
+ integer :: ipos
-FUNCTION str_replace(hstr, hold, hnew)
-CHARACTER(LEN=*) :: hstr, hold, hnew
-CHARACTER(LEN=LEN_TRIM(hstr)+MAX(0,LEN(hnew)-LEN(hold))) :: str_replace
+ if ( Len_trim( hinname ) == 0 ) then
+ houtname = ''
+ return
+ end if
-INTEGER :: pos
+ ipos = Scan( Trim( hinname), 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz' )
+ if ( ipos == 0 ) then
+ call Print_msg( NVERB_WARNING, 'IO', 'IO_Mnhname_clean', 'name (' // Trim( hinname) // &
+ ') must begin with a letter to conform to CF convention' )
+ end if
-pos = INDEX(hstr,hold)
-IF (pos /= 0) THEN
- str_replace = hstr(1:pos-1)//hnew//hstr(pos+LEN(hold):)
-ELSE
- str_replace = hstr
-END IF
+ ipos = Verify( Trim( hinname), 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_' )
+ if ( ipos > 0 ) then
+ yresult = Str_replace( hinname, '%', '__' )
+ yresult = Str_replace( yresult, '.', '___' )
+ yresult = Str_replace( yresult, '-', '_' )
+ yresult = Str_replace( yresult, '*', 'star' )
+ yresult = Str_replace( Trim( yresult ), ' ', '_' ) !Trim to prevent problem with spaces at the end of the string
+
+ !Chek corrected name
+ ipos = Verify( Trim( yresult ), 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_' )
+
+ if ( ipos == 0 ) then
+ call Print_msg( NVERB_INFO, 'IO', 'IO_Mnhname_clean', "Renaming to comply with CF convention: '" &
+ // Trim( hinname ) // "' -> '" // Trim( yresult ) // "'" )
+ else
+ call Print_msg( NVERB_WARNING, 'IO', 'IO_Mnhname_clean', "Renaming to comply with CF convention FAILED: '" &
+ // Trim( hinname ) // "' -> '" // Trim( yresult ) // "'" )
+ end if
+ else
+ yresult = Trim( hinname )
+ end if
+
+ houtname = Trim( yresult )
+
+ if ( Len_trim( yresult ) > Len( houtname ) ) &
+ call Print_msg( NVERB_WARNING, 'IO', 'IO_Mnhname_clean', &
+ 'houtname has been truncated (' // Trim( houtname) // '->' // Trim( yresult ) // ')' )
+
+end subroutine
+
+
+recursive function Str_replace( hstr, hold, hnew ) result( hout )
+character(len=*), intent(in) :: hstr, hold, hnew
+
+character(len=:), allocatable :: hout
+
+integer :: ipos
+
+ipos = Index( hstr, hold )
+if ( ipos > 0 ) then
+ hout = hstr(1 : ipos - 1) // hnew // hstr( ipos + Len( hold ) : )
+ if ( ipos < Len_trim( hstr ) ) hout = Str_replace( hout, hold, hnew )
+else
+ hout = hstr
+end if
-END FUNCTION str_replace
+end function Str_replace
end module mode_io_tools_nc4
diff --git a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
index a52005298762aa03c0acdd382f424a9a9d0b7a37..cc24abb6fb9727634dcf7b04dfc413c34ba28049 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
@@ -296,7 +296,7 @@ IF (.NOT.GISCOORD) THEN
IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','coordinates')
DEALLOCATE(YCOORDS)
ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_write_nc4','coordinates not implemented for variable ' &
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_write_nc4','coordinates not implemented for variable ' &
//TRIM(TPFIELD%CMNHNAME))
END IF
ELSE
@@ -2279,11 +2279,19 @@ subroutine Write_flyer_time_coord( tpflyer )
use NETCDF
use modd_aircraft_balloon
- use modd_parameters, only: XUNDEF
+ use modd_parameters, only: NBUNAMELGTMAX, XUNDEF
+
+ use mode_io_tools_nc4, only: IO_Mnhname_clean
+
+ use modi_aircraft_balloon, only: Aircraft_balloon_longtype_get
type(flyer), intent(in) :: tpflyer
+ character(len=NBUNAMELGTMAX) :: ytype
+ character(len=NBUNAMELGTMAX) :: ytype_clean
integer :: istatus
+ integer(kind=CDFINT) :: icatid
+ integer(kind=CDFINT) :: isubcatid
integer(kind=CDFINT) :: idimid
type(tdimnc), pointer :: tzdim
@@ -2291,39 +2299,30 @@ subroutine Write_flyer_time_coord( tpflyer )
if ( tpflyer%nmodel == imi .and. Count( tpflyer%x /= XUNDEF) > 1 ) then
Allocate( tzdim )
-
- !Group with flyer title
- istatus = NF90_INQ_NCID( tpfile%nncid, Trim( tpflyer%title ), incid )
+ istatus = NF90_INQ_NCID( tpfile%nncid, 'Flyers', icatid )
if ( istatus /= NF90_NOERR ) then
call Print_msg( NVERB_ERROR, 'IO', 'Write_flyer_time_coord', &
- Trim( tpfile%cname ) // ': group '// Trim( tpflyer%title ) // ' not found' )
+ Trim( tpfile%cname ) // ': group Flyers not found' )
end if
- istatus = NF90_INQ_DIMID( incid, 'time_flyer', idimid )
+ call Aircraft_balloon_longtype_get( tpflyer, ytype )
+ call IO_Mnhname_clean( ytype, ytype_clean )
+ istatus = NF90_INQ_NCID( icatid, Trim( ytype_clean ), isubcatid )
if ( istatus /= NF90_NOERR ) then
call Print_msg( NVERB_ERROR, 'IO', 'Write_flyer_time_coord', &
- Trim( tpfile%cname ) // ': group ' // Trim( tpflyer%title ) // ' time_flyer dimension not found' )
+ Trim( tpfile%cname ) // ': group ' // Trim( ytype_clean ) // ' not found' )
end if
- tzdim%cname = 'time_flyer'
- istatus = NF90_INQUIRE_DIMENSION( incid, idimid, len = tzdim%nlen )
- tzdim%nid = idimid
-
- !Remark: incid is used in Write_time_coord
- call Write_time_coord( tzdim, 'time axis for flyer', tpflyer%tpdates )
-
-
- !Group with flyer title suffixed by Z
- istatus = NF90_INQ_NCID( tpfile%nncid, Trim( tpflyer%title ) // 'Z' , incid )
+ istatus = NF90_INQ_NCID( isubcatid, Trim( tpflyer%title ), incid )
if ( istatus /= NF90_NOERR ) then
call Print_msg( NVERB_ERROR, 'IO', 'Write_flyer_time_coord', &
- Trim( tpfile%cname ) // ': group '// Trim( tpflyer%title ) // 'z not found' )
+ Trim( tpfile%cname ) // ': group '// Trim( tpflyer%title ) // ' not found' )
end if
istatus = NF90_INQ_DIMID( incid, 'time_flyer', idimid )
if ( istatus /= NF90_NOERR ) then
call Print_msg( NVERB_ERROR, 'IO', 'Write_flyer_time_coord', &
- Trim( tpfile%cname ) // ': group ' // Trim( tpflyer%title ) // 'Z time_flyer dimension not found' )
+ Trim( tpfile%cname ) // ': group ' // Trim( tpflyer%title ) // ' time_flyer dimension not found' )
end if
tzdim%cname = 'time_flyer'
@@ -2331,8 +2330,7 @@ subroutine Write_flyer_time_coord( tpflyer )
tzdim%nid = idimid
!Remark: incid is used in Write_time_coord
- call Write_time_coord( tzdim, 'time axis for flyer', tpflyer %tpdates )
-
+ call Write_time_coord( tzdim, 'time axis for flyer', tpflyer%tpdates )
Deallocate( tzdim )
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
index 23019391d088349762496f61b62354856bcbe93c..0d7ae1ab637917c6745e8806f07b65a619e2eb98 100644
--- a/src/MNH/addfluctuations.f90
+++ b/src/MNH/addfluctuations.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/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 850a0956cba76f891d8e9702f960c123085b029a..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,8 +163,7 @@ USE MODD_TYPE_DATE, ONLY: DATE_TIME
USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
USE MODD_PARAMETERS
-USE MODD_IBM_PARAM_n, ONLY: LIBM,XIBM_LS,XIBM_EPSI
-USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+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
diff --git a/src/MNH/advecuvw_rk.f90 b/src/MNH/advecuvw_rk.f90
index 133a1861df707d117c3b46529adc03ec4f478c86..c9f6bda99fcf356b580674276ba5d6becaa307e7 100644
--- a/src/MNH/advecuvw_rk.f90
+++ b/src/MNH/advecuvw_rk.f90
@@ -114,9 +114,9 @@ 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_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 MODD_SUB_MODEL_n, ONLY: XT_IBM_FORC
!
USE MODE_ll
USE MODE_MPPDB
@@ -203,8 +203,8 @@ 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)
@@ -327,7 +327,10 @@ 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))
-ALLOCATE(ZIBM(SIZE(PUT,1),SIZE(PUT,2),SIZE(PWT,3), 3)) ; ZIBM = 1.
+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
@@ -344,7 +347,7 @@ PRWS_ADV = 0.
!-------------------------------------------------------------------------------
!
!* 2. Wind guess before RK loop
-! -------------------------
+! --------------------------------
!
ZUT = PU
ZVT = PV
@@ -367,26 +370,26 @@ ZRWS = 0.
!-------------------------------------------------------------------------------
!
!* 3. BEGINNING of Runge-Kutta loop
-! -----------------------------
+! ------------------------------------
!
- 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)
+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' )
+!
+ 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, &
@@ -405,30 +408,30 @@ ZRWS = 0.
PRUCT, PRVCT, PRWCT, &
ZIBM(:,:,:,1), ZIBM(:,:,:,2), ZIBM(:,:,:,3) ,&
TZHALO2MT_ll )
- ENDIF
+ ENDIF
IF (HUVW_ADV_SCHEME=='CEN4TH') THEN
CALL ADVECUVW_2ND (ZUT, ZVT, ZWT, PRUCT, PRVCT, PRWCT, &
ZIBM(:,:,:,1), ZIBM(:,:,:,2), ZIBM(:,:,:,3))
- ENDIF
+ 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)
+ 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)
+ 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 (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
+ 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
@@ -437,43 +440,61 @@ ZRWS = 0.
CALL SECOND_MNH(ZTIME2)
XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
ENDIF
-!
+!
IF ( JS /= ISPL ) THEN
!
- ZUT = PU
- ZVT = PV
- ZWT = PW
+ ZUT = PU
+ ZVT = PV
+ ZWT = PW
!
- DO JI = 1, JS
!
! Intermediate guesses inside the RK loop
!
- 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
-!
- 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) * ZIBM(:,:,:,1)
- PRVS_ADV(:,:,:) = PRVS_ADV(:,:,:) + ZBUTS(JI) * ZRVS(:,:,:,JI) * ZIBM(:,:,:,2)
- PRWS_ADV(:,:,:) = PRWS_ADV(:,:,:) + ZBUTS(JI) * ZRWS(:,:,:,JI) * ZIBM(:,:,:,3)
- 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, ZIBM)
CALL CLEANLIST_ll(TZFIELDMT_ll)
CALL DEL_HALO2_ll(TZHALO2MT_ll)
!-------------------------------------------------------------------------------
diff --git a/src/MNH/aircraft_balloon.f90 b/src/MNH/aircraft_balloon.f90
index 5e48b0481a0bdb7d3aea970c82dd1e593c45cde3..153d76fe61b3174ea15d8e7546a8acf6cc4ddc74 100644
--- a/src/MNH/aircraft_balloon.f90
+++ b/src/MNH/aircraft_balloon.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################
@@ -41,6 +41,13 @@ REAL, DIMENSION(:,:),INTENT(IN) :: PSEA
!
END SUBROUTINE AIRCRAFT_BALLOON
!
+SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET( TPFLYER, HLONGTYPE )
+ USE MODD_AIRCRAFT_BALLOON, ONLY: FLYER
+
+ TYPE(FLYER), INTENT(IN) :: TPFLYER
+ CHARACTER(LEN=*), INTENT(OUT) :: HLONGTYPE
+END SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET
+
END INTERFACE
!
END MODULE MODI_AIRCRAFT_BALLOON
@@ -337,3 +344,34 @@ ENDIF
!----------------------------------------------------------------------------
!
END SUBROUTINE AIRCRAFT_BALLOON
+
+
+SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET( TPFLYER, HLONGTYPE )
+USE MODD_AIRCRAFT_BALLOON, ONLY: FLYER
+
+USE MODE_MSG
+
+TYPE(FLYER), INTENT(IN) :: TPFLYER
+CHARACTER(LEN=*), INTENT(OUT) :: HLONGTYPE
+
+character(len=:), allocatable :: ytype
+
+if ( Trim( TPFLYER%TYPE ) == 'AIRCRA' ) then
+ ytype = 'Aircrafts'
+else if ( Trim( TPFLYER%TYPE ) == 'RADIOS' ) then
+ ytype = 'Radiosonde_balloons'
+else if ( Trim( TPFLYER%TYPE ) == 'ISODEN' ) then
+ ytype = 'Isodensity_balloons'
+else if ( Trim( TPFLYER%TYPE ) == 'CVBALL' ) then
+ ytype = 'Constant_volume_balloons'
+else
+ call Print_msg( NVERB_ERROR, 'GEN', 'AIRCRAFT_BALLOON_LONGTYPE_GET', 'unknown category for flyer ' // Trim( tpflyer%title ) )
+ ytype = 'Unknown'
+end if
+
+if ( Len_trim( ytype ) > Len( HLONGTYPE ) ) &
+ call Print_msg( NVERB_WARNING, 'GEN', 'AIRCRAFT_BALLOON_LONGTYPE_GET', &
+ 'HLONGTYPE truncated for flyer ' // Trim( tpflyer%title ) )
+HLONGTYPE = Trim( ytype )
+
+END SUBROUTINE AIRCRAFT_BALLOON_LONGTYPE_GET
diff --git a/src/MNH/bl89.f90 b/src/MNH/bl89.f90
index 665e76c1a09bf6a94d63cd18bcd512937ea835ec..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
! ################
@@ -79,11 +75,11 @@ END MODULE MODI_BL89
!* 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_DYN_n, ONLY : LOCEAN
use modd_precision, only: MNHREAL
!
!
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/budget_flags.f90 b/src/MNH/budget_flags.f90
index 1d14d21ad01763042a9bb54f29f9d1fa6722ffca..ba8cdde35ed366b879cf9eaa0b87b721d7e84bca 100644
--- a/src/MNH/budget_flags.f90
+++ b/src/MNH/budget_flags.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.
@@ -96,7 +96,7 @@ LBUDGET_U = (LBU_ENABLE .AND. LBU_RU ) .OR. (LLES_CALL .OR. LCHECK )
LBUDGET_V = (LBU_ENABLE .AND. LBU_RV ) .OR. (LLES_CALL .OR. LCHECK )
LBUDGET_W = (LBU_ENABLE .AND. LBU_RW ) .OR. (LLES_CALL .OR. LCHECK )
LBUDGET_TH = (LBU_ENABLE .AND. LBU_RTH ) .OR. (LLES_CALL .OR. LCHECK )
-LBUDGET_TKE= ( (LBU_ENABLE .AND. LBU_RTKE) .OR. (LLES_CALL .OR. LCHECK ) ) .AND. CTURB /= 'NONE'
+LBUDGET_TKE= ( (LBU_ENABLE .AND. LBU_RTKE) .OR. (LLES_CALL .OR. LCHECK ) ) .AND. CTURB == 'TKEL'
LBUDGET_RV = ( (LBU_ENABLE .AND. LBU_RRV ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERV) ) .AND. NRR >= 1
LBUDGET_RC = ( (LBU_ENABLE .AND. LBU_RRC ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERC) ) .AND. NRR >= 2
LBUDGET_RR = ( (LBU_ENABLE .AND. LBU_RRR ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERR) ) .AND. NRR >= 3
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/ch_monitorn.f90 b/src/MNH/ch_monitorn.f90
index d1ac4a1a677008440dbdc542935e1b083af2a00c..6e817aa0f12bc2c3c1aba44cdd08c812eabc000e 100644
--- a/src/MNH/ch_monitorn.f90
+++ b/src/MNH/ch_monitorn.f90
@@ -609,10 +609,15 @@ ZDTSOLVER = PTSTEP / NCH_SUBSTEPS
!
IF (LORILAM) THEN
ALLOCATE( ZSVT(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)) )
-
- DO JSV = 1, SIZE(XSVT,4)
- ZSVT(:,:,:,JSV) = XRSVS(:,:,:,JSV) *PTSTEP / XRHODJ(:,:,:)
- END DO
+ IF (CPROGRAM /='DIAG ') THEN
+ DO JSV = 1, SIZE(XSVT,4)
+ ZSVT(:,:,:,JSV) = XRSVS(:,:,:,JSV) *PTSTEP / XRHODJ(:,:,:)
+ END DO
+ ELSE
+ DO JSV = 1, SIZE(XSVT,4)
+ ZSVT(:,:,:,JSV) = XSVT(:,:,:,JSV)
+ END DO
+ END IF
ZSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND) = MAX(ZSVT(:,:,:,NSV_CHEMBEG:NSV_CHEMEND), XMNH_TINY)
ZSVT(:,:,:,NSV_AERBEG:NSV_AEREND) = MAX(ZSVT(:,:,:,NSV_AERBEG:NSV_AEREND), XMNH_TINY)
!
@@ -640,9 +645,7 @@ SELECT CASE (CCH_TDISCRETIZATION)
END SELECT
!
!
-IF (CPROGRAM=='DIAG ') THEN
- IF (LEN_TRIM(CSPEC_BU_DIAG)/=0.OR.LEN_TRIM(CSPEC_DIAG)/=0) GSPLIT=.FALSE. ! Modif. for DIAG
-END IF
+IF (CPROGRAM=='DIAG ') GSPLIT=.FALSE. ! Modif. for DIAG
!
!
!* 1.6 allocate tables
diff --git a/src/MNH/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 ac901dc3eb9971b4f0b037dafcf88c7133227359..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.
diff --git a/src/MNH/compute_mf_cloud_bigaus.f90 b/src/MNH/compute_mf_cloud_bigaus.f90
index 1ca60edd9af672c7a08f3af25381a82f9df76421..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-2021 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
! ###################################
diff --git a/src/MNH/compute_press_from_oceanbot.f90 b/src/MNH/compute_press_from_oceanbot.f90
index 86fe83d26a4061f4247523cb208e2d7012248acb..56c8f6b6e48442061e3278906a0641f7f935b942 100644
--- a/src/MNH/compute_press_from_oceanbot.f90
+++ b/src/MNH/compute_press_from_oceanbot.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################################
@@ -77,20 +77,14 @@ END MODULE MODI_COMPUTE_PRESS_FROM_OCEANBOT3D
!! EXTERNAL
!! --------
!!
-!! function FMLOOK :to retrieve a logical unit number associated with a file
!!
!! 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
- !! Module MODD_PARAMETERS
-!! JPVEXT,JPHEXT
+!! XG : gravity constant
+!! Module MODD_PARAMETERS
+!! JPVEXT
!!
!! REFERENCE
!! ---------
@@ -187,7 +181,6 @@ END SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D
!! MODIFICATIONS
!! -------------
!! Original 06/03/96
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/MNH/compute_press_from_oceansfc.f90 b/src/MNH/compute_press_from_oceansfc.f90
index ba8f86c200a06f7b3b879acaaceafca30e9b700c..d9ec184431ff06f994644c61d5acd7203bac6eaf 100644
--- a/src/MNH/compute_press_from_oceansfc.f90
+++ b/src/MNH/compute_press_from_oceansfc.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/condensation.f90 b/src/MNH/condensation.f90
index a21ed2793ec5d611b9768d2e05bf391ebbb0eae7..ec60d40671691d994a02f4b1f4981f4cc70c06aa 100644
--- a/src/MNH/condensation.f90
+++ b/src/MNH/condensation.f90
@@ -1,7 +1,8 @@
-!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
! ########################
@@ -23,21 +24,14 @@ INTEGER, INTENT(IN) :: KJE ! value of the last point
INTEGER, INTENT(IN) :: KKB ! value of the first point in z
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
+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)
@@ -46,6 +40,12 @@ 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
@@ -135,8 +135,12 @@ 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 :
@@ -152,21 +156,14 @@ INTEGER, INTENT(IN) :: KJE ! value of the last point
INTEGER, INTENT(IN) :: KKB ! value of the first point in z
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
+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)
@@ -175,6 +172,7 @@ 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 ! 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
@@ -182,6 +180,13 @@ 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 :
@@ -498,12 +503,9 @@ DO JK=IKTB,IKTE
PSIGRC(JI,JJ,JK) = PSIGRC(JI,JJ,JK)* MIN( 3. , MAX(1.,1.-ZQ1) )
ELSEIF(HLAMBDA3=='NONE') THEN
ELSE
- WRITE(*,*) ' STOP'
- WRITE(*,*) ' INVALID VALUE FOR HLAMBDA3:', HLAMBDA3
- CALL ABORT
- STOP
+ call Print_msg( NVERB_FATAL, 'GEN', 'CONDENSATION', 'invalid value for HLAMBDA3: ' // TRIM( HLAMBDA3 ) )
ENDIF
-
+
END DO
END DO
END DO
diff --git a/src/MNH/deallocate_model1.f90 b/src/MNH/deallocate_model1.f90
index 3de1fbb81d862a92d0bd10bb77ab57bd32273173..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,10 +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
-! 04/2020 S. Riette, XHL* fields
+! S. Riette 04/2020: XHL* fields
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -106,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
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 8d7e1474045dd1ad77cbc0514ea9bb08ea2a6d58..cba4613595bd3934761d3e9d015871396668fdf3 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -88,14 +88,15 @@ 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
!!
!! Module MODD_FRC :
!!
!! LGEOST_UV_FRC,LGEOST_TH_FRC,LTEND_THRV_FRC
-!! LVERT_MOTION_FRC,LRELAX_THRV_FRC,LRELAX_UV_FRC,XRELAX_TIME_FRC
+!! LVERT_MOTION_FRC,LRELAX_THRV_FRC,LRELAX_UV_FRC,LRELAX_UVMEAN_FRC,
+!! XRELAX_TIME_FRC
!! XRELAX_HEIGHT_FRC,CRELAX_HEIGHT_TYPE,LTRANS,XUTRANS,XVTRANS,
!! LPGROUND_FRC
!!
@@ -208,12 +209,16 @@ 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
-!! 02/2021 (F.Auguste,T.Nagel) add IBM defaults parameters
-!! 02/2021 (T.Nagel) add turbulence recycling defaults parameters
+! 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
-! 05/2021 D. Ricard add the contribution of Leonard terms in the turbulence scheme
-!! JL Redelsperger 06/2021 add parameters allowing to active idealized oceanic convection
+! 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)
+! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC
+! Q. Rodier 07/2021: modify XPOND=1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -268,21 +273,22 @@ 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, 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_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
!
@@ -497,7 +503,7 @@ NLBLY(:) = 1
XCPHASE = 20.
XCPHASE_PBL = 0.
XCARPKMAX = XUNDEF
-XPOND = 0.2
+XPOND = 1.0
!
!-------------------------------------------------------------------------------
!
@@ -589,16 +595,16 @@ LTECOUTPTS = .FALSE.
!* 10.e SET DEFAULT VALUES FOR MODD_ALLSTATION_n :
! ----------------------------------
!
-NNUMB_STAT = 0
+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"
+CNAME_STAT(:) = ''
+CTYPE_STAT(:) = ''
+CFILE_STAT = 'NO_INPUT_CSV'
LDIAG_RESULTS = .FALSE.
!
!-------------------------------------------------------------------------------
@@ -815,6 +821,7 @@ IF (KMI == 1) THEN
LVERT_MOTION_FRC = .FALSE.
LRELAX_THRV_FRC = .FALSE.
LRELAX_UV_FRC = .FALSE.
+ LRELAX_UVMEAN_FRC = .FALSE.
XRELAX_TIME_FRC = 10800.
XRELAX_HEIGHT_FRC = 0.
CRELAX_HEIGHT_TYPE = "FIXE"
@@ -920,7 +927,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
!
!-------------------------------------------------------------------------------
@@ -980,8 +987,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.
@@ -1014,7 +1023,7 @@ IF (KMI == 1) THEN
LHHONI = .FALSE.
LCOLD = .TRUE.
LNUCL = .TRUE.
- LSEDI = .FALSE.
+ LSEDI = .TRUE.
LSNOW = .TRUE.
LHAIL = .FALSE.
CPRISTINE_ICE_LIMA = 'PLAT'
@@ -1371,25 +1380,25 @@ ENDIF
!* 32. SET DEFAULT VALUES FOR MODD_RECYCL_PARAMn
! --------------------------------------
!
- LRECYCL = .FALSE.
- LRECYCLN = .FALSE.
- LRECYCLW = .FALSE.
- LRECYCLE = .FALSE.
- LRECYCLS = .FALSE.
- XDRECYCLN = 0.
+ LRECYCL = .FALSE.
+ LRECYCLN = .FALSE.
+ LRECYCLW = .FALSE.
+ LRECYCLE = .FALSE.
+ LRECYCLS = .FALSE.
+ XDRECYCLN = 0.
XARECYCLN = 0.
- XDRECYCLW = 0.
+ XDRECYCLW = 0.
XARECYCLW = 0.
- XDRECYCLS = 0.
+ XDRECYCLS = 0.
XARECYCLS = 0.
- XDRECYCLE = 0.
+ XDRECYCLE = 0.
XARECYCLE = 0.
- XTMOY = 0.
- XTMOYCOUNT = 0.
- XNUMBELT = 28.
- XRCOEFF = 0.2
- XTBVTOP = 500.
- XTBVBOT = 300.
+ 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 f592e5205520b06147b8a117dab3c6f4b1d9bca7..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
! #########################
diff --git a/src/MNH/dyn_sources.f90 b/src/MNH/dyn_sources.f90
index e79ff37a97716739a3be8b48dddd54c033bc5c9a..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,7 @@ 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 MODD_DYN_n, ONLY: LOCEAN
!
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_MPPDB
diff --git a/src/MNH/emoist.f90 b/src/MNH/emoist.f90
index 99a5e1ce0b994bdc27aa85e86b93a75ad21b1ea0..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
!#################
diff --git a/src/MNH/eol_adnr.f90 b/src/MNH/eol_adnr.f90
index 79ae8a7ad9441ba200cf9036d2bc27accbe2841a..b47d14fa35958b0c86f7a2337f566a928cfae078 100644
--- a/src/MNH/eol_adnr.f90
+++ b/src/MNH/eol_adnr.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
! #######################
diff --git a/src/MNH/eol_alm.f90 b/src/MNH/eol_alm.f90
index 585dd2d5c5ba8bb8e886aa9fc6b6a3afb017cd7b..6dc910246b490c4ad23ad58b3233bb75e4fe07f9 100644
--- a/src/MNH/eol_alm.f90
+++ b/src/MNH/eol_alm.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
! #######################
@@ -279,7 +280,6 @@ IF (.NOT.LTIMESPLIT) THEN
! If time step too high : abort
IF (PTSTEP > ZMAXTSTEP) THEN
CALL EOL_WTCFL_ERROR(ZMAXTSTEP)
- STOP
! If time step ok, continue
ELSE
INBSUBCOUNT = 1
diff --git a/src/MNH/eol_debugger.f90 b/src/MNH/eol_debugger.f90
index 0f9f21802f65b9737e5dc6c8d8286a17fb4c0424..86e38b3e19fca5ad7f6094707ac7d3b1f15531f8 100644
--- a/src/MNH/eol_debugger.f90
+++ b/src/MNH/eol_debugger.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
! #######################
diff --git a/src/MNH/eol_error.f90 b/src/MNH/eol_error.f90
index 06f8f6fae83d2b3510d2da94242caabf2d009622..c6c221f9f4a5ba6818a6a8242084a253b3ba518d 100644
--- a/src/MNH/eol_error.f90
+++ b/src/MNH/eol_error.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
! #######################
@@ -67,17 +68,11 @@ USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODE_IO_FILE, ONLY: IO_File_close
USE MODE_MSG
!
-CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
-!
-WRITE(TLUOUT%NLU,*) ''
-WRITE(TLUOUT%NLU,'(A)') &
- ' EOL Initialization error. Program aborted.'
-WRITE(TLUOUT%NLU,'(A,A,A)') &
- ' File "', TRIM(HFILE), '" not found in directory.'
-WRITE(TLUOUT%NLU,*) ''
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
!
-CALL IO_File_close(TLUOUT)
-CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_CSVNOTFOUND_ERROR', 'CSV file for wind turbine missing' )
+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
!#########################################################
@@ -93,17 +88,14 @@ USE MODE_MSG
CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
INTEGER, INTENT(IN) :: KNBLINE ! number of lines
!
-WRITE(TLUOUT%NLU,*) ''
-WRITE(TLUOUT%NLU,'(A)') &
- ' EOL Initialization error. Program aborted.'
-WRITE(TLUOUT%NLU,'(I2,A,A,A)') &
- KNBLINE, ' line have been read in file: ', TRIM(HFILE), '.'
-WRITE(TLUOUT%NLU,'(A)') &
- ' At least 2 should be there: header + data.'
-WRITE(TLUOUT%NLU,*) ''
+CHARACTER(LEN=8) :: YLINES
!
-CALL IO_File_close(TLUOUT)
-CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_CSVEMPTY_ERROR', 'CSV file for wind turbine missing data' )
+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
!#########################################################
@@ -118,17 +110,10 @@ USE MODE_MSG
CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
CHARACTER(LEN=*), INTENT(IN) :: HVAR ! missing data
!
-WRITE(TLUOUT%NLU,*) ''
-WRITE(TLUOUT%NLU,'(A)') &
- ' EOL Initialization error. Program aborted.'
-WRITE(TLUOUT%NLU,'(A,A,A)') &
- ' I am looking for the characteristics of ', TRIM(HVAR), '.'
-WRITE(TLUOUT%NLU,'(A,A)') &
- ' But I cannot find them in file: ', TRIM(HFILE)
-WRITE(TLUOUT%NLU,*) ''
-!
-CALL IO_File_close(TLUOUT)
-CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_AIRFOILNOTFOUND_ERROR', 'File for Airfol missing' )
+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
!#########################################################
@@ -140,23 +125,17 @@ 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
+REAL, INTENT(IN) :: PMAXTSTEP ! maximum acceptable time-step
+!
+CHARACTER(LEN=10) :: YMAXTSTEP
!
-WRITE(TLUOUT%NLU,*) ''
-WRITE(TLUOUT%NLU,'(A)') &
- 'Sorry but I had to stop the simulation. '
-WRITE(TLUOUT%NLU,'(A)') &
- 'The time step XTSTEP is too large: '
-WRITE(TLUOUT%NLU,'(A)') &
- 'the blades can jump over one or several cells. '
-WRITE(TLUOUT%NLU,'(A)') &
- 'Please, turn on the time-splitting method (LTIMESPLIT=.TRUE.), '
-WRITE(TLUOUT%NLU,'(A,F10.8,A)') &
- 'or decrease XTSTEP to a value lower than ', PMAXTSTEP, ' sec.'
-WRITE(TLUOUT%NLU,*) ''
-!
-CALL IO_File_close(TLUOUT)
-CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_WTCFL_ERROR', 'WRONG TIME-STEP with wind turbine' )
+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
!#########################################################
@@ -171,21 +150,16 @@ USE MODD_EOL_SHARED_IO, ONLY: CBLADE_CSVDATA
!
REAL, INTENT(IN) :: PDELTARAD ! hals section width
!
-WRITE(TLUOUT%NLU,*) ''
-WRITE(TLUOUT%NLU,'(A)') &
- ' EOL Initialization error. Program aborted.'
-WRITE(TLUOUT%NLU,'(A,F4.2,A)') &
- 'A blade element center position is set to ', PDELTARAD, '.'
-WRITE(TLUOUT%NLU,'(A)') &
- 'As a blade element center, it has to be set in ]0%;100%[. '
-WRITE(TLUOUT%NLU,'(A,A,A)') &
- 'Please, check your blade data in ', TRIM(CBLADE_CSVDATA), ','
-WRITE(TLUOUT%NLU,'(A)') &
-'and make sure it is element centers (not nodes) along the blade.'
-WRITE(TLUOUT%NLU,*) ''
-!
-CALL IO_File_close(TLUOUT)
-CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_BLADEDATA_ERROR', 'ERROR IN BLADE DATA' )
+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
index fd257b3f6f5235c4b38e600cbc08014ffa9c9871..e3232fac5db801dfafbd5ba8e5b4168660d4327a 100644
--- a/src/MNH/eol_kine_alm.f90
+++ b/src/MNH/eol_kine_alm.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
@@ -77,8 +78,8 @@ 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_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
!
@@ -91,6 +92,7 @@ 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
!
!
!---------------------------------------------------------------
@@ -98,7 +100,7 @@ INTEGER :: INB_TELT, INB_NELT ! Total n
!* 1. PRELIMINARIES
! -------------
!
-!* 1.1 Some usefull integers
+!* 1.1 Some useful integers
INB_WT = TFARM%NNB_TURBINES
INB_B = TTURBINE%NNB_BLADES
INB_TELT = 2
@@ -110,7 +112,7 @@ ZTIME = TDTCUR%xtime+(KTSUBCOUNT)*PTSUBSTEP
!
!* 1.3 Tecplotfile : opening + headers
IF (LTECOUTPTS) THEN
- CALL OPEN_TECOUT(45, KTCOUNT, KTSUBCOUNT)
+ CALL OPEN_TECOUT(ITECOUT, KTCOUNT, KTSUBCOUNT)
END IF
!
!
@@ -152,7 +154,7 @@ DO JROT=1, INB_WT
!* T.4 Print in tecplot file
IF (LTECOUTPTS) THEN
DO JTELT=1, INB_TELT
- CALL PRINT_TECOUT(45, XPOS_TELT_RG(JROT,JTELT,:))
+ CALL PRINT_TECOUT(ITECOUT, XPOS_TELT_RG(JROT,JTELT,:))
END DO
END IF
!
@@ -192,7 +194,7 @@ DO JROT=1, INB_WT
!* N.4 Print in tecplot file
IF (LTECOUTPTS) THEN
DO JNELT=1, INB_NELT
- CALL PRINT_TECOUT(45, XPOS_NELT_RG(JROT,JNELT,:))
+ CALL PRINT_TECOUT(ITECOUT, XPOS_NELT_RG(JROT,JNELT,:))
END DO
END IF
!
@@ -222,7 +224,7 @@ DO JROT=1, INB_WT
!
!* H.4 Print in tecplot file
IF (LTECOUTPTS) THEN
- CALL PRINT_TECOUT(45, XPOS_HUB_RG(JROT,:))
+ CALL PRINT_TECOUT(ITECOUT, XPOS_HUB_RG(JROT,:))
END IF
!
!
@@ -252,7 +254,7 @@ DO JROT=1, INB_WT
!
!* B.4 Print in tecplot file
IF (LTECOUTPTS) THEN
- CALL PRINT_TECOUT(45, XPOS_BLA_RG(JROT,JBLA,:))
+ CALL PRINT_TECOUT(ITECOUT, XPOS_BLA_RG(JROT,JBLA,:))
END IF
!
!
@@ -294,7 +296,7 @@ DO JROT=1, INB_WT
!
!* E.4 Print in tecplot file
IF (LTECOUTPTS) THEN
- CALL PRINT_TECOUT(45, XPOS_ELT_RG(JROT,JBLA,JBELT,:))
+ CALL PRINT_TECOUT(ITECOUT, XPOS_ELT_RG(JROT,JBLA,JBELT,:))
END IF
!
! ---- Leading Edge and Trailing Edge ----
@@ -317,8 +319,8 @@ DO JROT=1, INB_WT
ZPOS_ELTTE_RE(:))
!* LE.2 Print in tecplot file
- CALL PRINT_TECOUT(45, ZPOS_ELTLE_RG(:))
- CALL PRINT_TECOUT(45, ZPOS_ELTTE_RG(:))
+ CALL PRINT_TECOUT(ITECOUT, ZPOS_ELTLE_RG(:))
+ CALL PRINT_TECOUT(ITECOUT, ZPOS_ELTTE_RG(:))
END IF
!
!
@@ -328,7 +330,7 @@ END DO ! Rotor loop
!
! Closing tec file
IF (LTECOUTPTS) THEN
- CLOSE(45)
+ CLOSE(ITECOUT)
END IF
!
END SUBROUTINE EOL_KINE_ALM
diff --git a/src/MNH/eol_main.f90 b/src/MNH/eol_main.f90
index caa29e4d775d544a9efc70f40e4caf8958af5144..6b0633c1dec3746119312794abaa4b75c4a16fed 100644
--- a/src/MNH/eol_main.f90
+++ b/src/MNH/eol_main.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
! #######################
diff --git a/src/MNH/eol_maths.f90 b/src/MNH/eol_maths.f90
index 6d2d659cca7b35c038041916281939854b3179ff..4ef3b31c8df42edddad34759060fe62503c7b4e1 100644
--- a/src/MNH/eol_maths.f90
+++ b/src/MNH/eol_maths.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-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 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
! #######################
diff --git a/src/MNH/eol_printer.f90 b/src/MNH/eol_printer.f90
index c8b33e32ce1a107dfcb8eb03ce00342fa2425669..b4fe7281673df7ba6b9000ed4353c7430db48423 100644
--- a/src/MNH/eol_printer.f90
+++ b/src/MNH/eol_printer.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
! #########################
@@ -282,7 +283,7 @@ USE MODD_EOL_ALM, ONLY:TFARM,TTURBINE,TBLADE
!
IMPLICIT NONE
!
-INTEGER, INTENT(IN) :: KFILE ! File index
+INTEGER, INTENT(OUT) :: KFILE ! File index
INTEGER, INTENT(IN) :: KTCOUNT ! Time step index
INTEGER, INTENT(IN) :: KTSUBCOUNT ! Subtime step index
!
@@ -295,7 +296,7 @@ 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 usefull in next updates
+! Hard coded variables, but they will be useful in next updates
INB_TELT = 2
INB_NELT = 2
!
@@ -303,7 +304,7 @@ 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( KFILE, file=HFILE, form="FORMATTED")
+OPEN( NEWUNIT=KFILE, file=HFILE, form="FORMATTED")
!
! Tecplot Header
WRITE(KFILE,*) 'TITLE="Wind Turbines Points"'
diff --git a/src/MNH/eol_reader.f90 b/src/MNH/eol_reader.f90
index 9dfa91fbf2531ad8cc505eca26da39f0c923cb77..8d5ecc6cfea05ea462138d0f8472d23083e0d7ce 100644
--- a/src/MNH/eol_reader.f90
+++ b/src/MNH/eol_reader.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-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 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
! #######################
@@ -10,47 +11,41 @@ INTERFACE
!
! ADNR
!
-SUBROUTINE READ_CSVDATA_FARM_ADNR(KLUNAM,HFILE,TPFARM)
+SUBROUTINE READ_CSVDATA_FARM_ADNR(HFILE,TPFARM)
USE MODD_EOL_ADNR, ONLY: FARM
- INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
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(KLUNAM,HFILE,TPTURBINE)
+SUBROUTINE READ_CSVDATA_TURBINE_ADNR(HFILE,TPTURBINE)
USE MODD_EOL_ADNR, ONLY : TURBINE
- INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
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(KLUNAM,HFILE,TPFARM)
+SUBROUTINE READ_CSVDATA_FARM_ALM(HFILE,TPFARM)
USE MODD_EOL_ALM, ONLY: FARM
- INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
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(KLUNAM,HFILE,TPTURBINE)
+SUBROUTINE READ_CSVDATA_TURBINE_ALM(HFILE,TPTURBINE)
USE MODD_EOL_ALM, ONLY : TURBINE
- INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
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(KLUNAM,HFILE,TPTURBINE,TPBLADE)
+SUBROUTINE READ_CSVDATA_BLADE_ALM(HFILE,TPTURBINE,TPBLADE)
USE MODD_EOL_ALM, ONLY : TURBINE, BLADE
- INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
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(KLUNAM,HFILE,TPBLADE,TPAIRFOIL)
+SUBROUTINE READ_CSVDATA_AIRFOIL_ALM(HFILE,TPBLADE,TPAIRFOIL)
USE MODD_EOL_ALM, ONLY : BLADE, AIRFOIL
- INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
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
@@ -96,19 +91,19 @@ END MODULE MODI_EOL_READER
!!---------------------------------------------------------------
!
!#########################################################
-SUBROUTINE READ_CSVDATA_FARM_ADNR(KLUNAM,HFILE,TPFARM)
+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
!
-INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
-CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+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
@@ -125,12 +120,12 @@ IF (.NOT.GEXIST) THEN
END IF
!
! Opening the file
-OPEN(UNIT=KLUNAM,FILE=HFILE, FORM='formatted', STATUS='OLD')
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
! Counting number of line
-REWIND(KLUNAM)
+REWIND(ILU)
INBLINE=0
DO
- READ(KLUNAM,END=101,FMT='(A400)') YSTRING
+ READ(ILU,END=101,FMT='(A400)') YSTRING
IF (LEN_TRIM(YSTRING) > 0) THEN
INBLINE = INBLINE + 1
END IF
@@ -139,7 +134,6 @@ END DO
101 CONTINUE
IF (INBLINE < 2) THEN
CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
- STOP
ELSE
! Saving number of wind turbine
TPFARM%NNB_TURBINES = INBLINE - 1
@@ -149,18 +143,18 @@ ELSE
ALLOCATE(TPFARM%XCT_INF(TPFARM%NNB_TURBINES))
!
! New read
- REWIND(KLUNAM)
- READ(KLUNAM,FMT='(A400)') YSTRING ! Header reading
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
!
! Saving data
DO INBLINE=1, TPFARM%NNB_TURBINES
- READ(KLUNAM,FMT='(A400)') YSTRING
+ 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(KLUNAM)
+ CLOSE(ILU)
RETURN
END IF
!
@@ -168,19 +162,19 @@ END SUBROUTINE READ_CSVDATA_FARM_ADNR
!#########################################################
!
!#########################################################
-SUBROUTINE READ_CSVDATA_TURBINE_ADNR(KLUNAM,HFILE,TPTURBINE)
+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
!
-INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
-CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+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
@@ -196,13 +190,13 @@ IF (.NOT.GEXIST) THEN
END IF
!
! Opening
-OPEN(UNIT=KLUNAM,FILE=HFILE, FORM='formatted', STATUS='OLD')
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
!
! Counting number of line
-REWIND(KLUNAM)
+REWIND(ILU)
INBLINE=0
DO
- READ(KLUNAM,END=101,FMT='(A400)') YSTRING
+ READ(ILU,END=101,FMT='(A400)') YSTRING
IF (LEN_TRIM(YSTRING) > 0) THEN
INBLINE = INBLINE + 1
END IF
@@ -211,38 +205,37 @@ END DO
101 CONTINUE
IF (INBLINE /= 2) THEN
CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
- STOP
ELSE
- REWIND(KLUNAM)
- READ(KLUNAM,FMT='(A400)') YSTRING ! Header reading
- READ(KLUNAM,FMT='(A400)') YSTRING ! Reading next line
+ 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(KLUNAM) ! Rembobinage, plutôt 2 fois qu'1 !
+ REWIND(ILU) ! Rembobinage, plutôt 2 fois qu'1 !
RETURN
- CLOSE(KLUNAM)
+ CLOSE(ILU)
END IF
!
END SUBROUTINE READ_CSVDATA_TURBINE_ADNR
!#########################################################
!
!#########################################################
-SUBROUTINE READ_CSVDATA_FARM_ALM(KLUNAM,HFILE,TPFARM)
+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
!
-INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
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
@@ -261,12 +254,12 @@ IF (.NOT.GEXIST) THEN
END IF
!
! Opening the file
-OPEN(UNIT=KLUNAM,FILE=HFILE, FORM='formatted', STATUS='OLD')
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
! Counting number of line
-REWIND(KLUNAM)
+REWIND(ILU)
INBLINE=0
DO
- READ(KLUNAM,END=101,FMT='(A400)') YSTRING
+ READ(ILU,END=101,FMT='(A400)') YSTRING
IF (LEN_TRIM(YSTRING) > 0) THEN
INBLINE = INBLINE + 1
END IF
@@ -275,7 +268,6 @@ END DO
101 CONTINUE
IF (INBLINE < 2) THEN
CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
- STOP
ELSE
! Saving number of wind turbine
TPFARM%NNB_TURBINES = INBLINE - 1
@@ -287,12 +279,12 @@ ELSE
ALLOCATE(TPFARM%XBLA_PITCH(TPFARM%NNB_TURBINES))
!
! New read
- REWIND(KLUNAM)
- READ(KLUNAM,FMT='(A400)') YSTRING ! Header reading
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
!
! Saving data
DO INBLINE=1, TPFARM%NNB_TURBINES
- READ(KLUNAM,FMT='(A400)') YSTRING
+ 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
@@ -300,7 +292,7 @@ ELSE
TPFARM%XNAC_YAW(INBLINE) = ZYAW
TPFARM%XBLA_PITCH(INBLINE) = ZPITCH
END DO
- CLOSE(KLUNAM)
+ CLOSE(ILU)
RETURN
END IF
!
@@ -308,19 +300,19 @@ END SUBROUTINE READ_CSVDATA_FARM_ALM
!#########################################################
!
!#########################################################
-SUBROUTINE READ_CSVDATA_TURBINE_ALM(KLUNAM,HFILE,TPTURBINE)
+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
!
-INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
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
@@ -340,13 +332,13 @@ IF (.NOT.GEXIST) THEN
END IF
!
! Opening
-OPEN(UNIT=KLUNAM,FILE=HFILE, FORM='formatted', STATUS='OLD')
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
!
! Counting number of line
-REWIND(KLUNAM)
+REWIND(ILU)
INBLINE=0
DO
- READ(KLUNAM,END=101,FMT='(A400)') YSTRING
+ READ(ILU,END=101,FMT='(A400)') YSTRING
IF (LEN_TRIM(YSTRING) > 0) THEN
INBLINE = INBLINE + 1
END IF
@@ -355,11 +347,10 @@ END DO
101 CONTINUE
IF (INBLINE /= 2) THEN
CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
- STOP
ELSE
- REWIND(KLUNAM)
- READ(KLUNAM,FMT='(A400)') YSTRING ! Header reading
- READ(KLUNAM,FMT='(A400)') YSTRING ! Reading next line
+ 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, &
@@ -371,28 +362,28 @@ ELSE
TPTURBINE%XR_MAX = ZR_MAX
TPTURBINE%XNAC_TILT = ZNAC_TILT
TPTURBINE%XH_DEPORT = ZHUB_DEPORT
- REWIND(KLUNAM)
+ REWIND(ILU)
RETURN
- CLOSE(KLUNAM)
+ CLOSE(ILU)
END IF
!
END SUBROUTINE READ_CSVDATA_TURBINE_ALM
!#########################################################
!
!#########################################################
-SUBROUTINE READ_CSVDATA_BLADE_ALM(KLUNAM,HFILE,TPTURBINE,TPBLADE)
+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
!
-INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
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
!
@@ -410,12 +401,12 @@ IF (.NOT.GEXIST) THEN
END IF
!
! Ouverture
-OPEN(UNIT=KLUNAM,FILE=HFILE, FORM='formatted', STATUS='OLD')
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
! Counting number of line
-REWIND(KLUNAM)
+REWIND(ILU)
INBLINE=0
DO
- READ(KLUNAM,END=101,FMT='(A400)') YSTRING
+ READ(ILU,END=101,FMT='(A400)') YSTRING
IF (LEN_TRIM(YSTRING) > 0) THEN
INBLINE = INBLINE + 1
END IF
@@ -424,7 +415,6 @@ END DO
101 CONTINUE
IF (INBLINE < 2) THEN
CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
- STOP
ELSE
TPBLADE%NNB_BLAELT = NNB_BLAELT
! Saving number of data
@@ -435,12 +425,12 @@ ELSE
ALLOCATE(TPBLADE%CAIRFOIL(TPBLADE%NNB_BLADAT))
!
! New read
- REWIND(KLUNAM)
- READ(KLUNAM,FMT='(A400)') YSTRING ! Header reading
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
!
! Saving data
DO INBLINE=1, TPBLADE%NNB_BLADAT
- READ(KLUNAM,FMT='(A400)') YSTRING
+ READ(ILU,FMT='(A400)') YSTRING
READ(YSTRING,*) ZCENTER, ZCHORD, ZTWIST, YAIRFOIL ! Reading data
IF ((ZCENTER<=0.0) .OR. (ZCENTER>= 1.0)) THEN
! Checking data
@@ -454,7 +444,7 @@ ELSE
TPBLADE%CAIRFOIL(INBLINE) = YAIRFOIL
END IF
END DO
- CLOSE(KLUNAM)
+ CLOSE(ILU)
RETURN
END IF
!
@@ -462,19 +452,19 @@ END SUBROUTINE READ_CSVDATA_BLADE_ALM
!#########################################################
!
!#########################################################
-SUBROUTINE READ_CSVDATA_AIRFOIL_ALM(KLUNAM,HFILE,TPBLADE,TPAIRFOIL)
+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
!
-INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
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
@@ -500,7 +490,7 @@ IF (.NOT.GEXIST) THEN
END IF
!
! Ouverture
-OPEN(UNIT=KLUNAM,FILE=HFILE, FORM='formatted', STATUS='OLD')
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
!
! 1. Counting number of differents airfoils along the blade and selection :
!
@@ -529,17 +519,17 @@ ALLOCATE(TPAIRFOIL(INBAIRFOIL))
!
DO IA = 1, INBAIRFOIL
! Array allocation
- CALL HOW_MANY_LINES_OF(KLUNAM,HFILE,YAIRFOIL(IA),INBDATA)
+ 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(KLUNAM)
+ REWIND(ILU)
INBLINE = 0
DO
- READ(KLUNAM,END=101,FMT='(A400)') YSTRING ! Header
+ READ(ILU,END=101,FMT='(A400)') YSTRING ! Header
!* reads the string
IF (LEN_TRIM(YSTRING)>0) THEN
READ(YSTRING,FMT=*) YREAD_NAME
@@ -556,7 +546,7 @@ DO IA = 1, INBAIRFOIL
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(KLUNAM) ! .. so it is the end of the data ..
+ REWIND(ILU) ! .. so it is the end of the data ..
EXIT ! .. and we can exit :)
END IF
END IF
@@ -564,11 +554,10 @@ DO IA = 1, INBAIRFOIL
END DO
END DO
!
-CLOSE(KLUNAM)
+CLOSE(ILU)
101 CONTINUE
IF (INBLINE == 0) THEN
CALL EOL_AIRFOILNOTFOUND_ERROR(HFILE,YAIRFOIL(IA))
- STOP
END IF
END SUBROUTINE READ_CSVDATA_AIRFOIL_ALM
!#########################################################
@@ -609,7 +598,6 @@ END DO
101 CONTINUE
IF (KLINE == 0) THEN
CALL EOL_AIRFOILNOTFOUND_ERROR(HFILE,HNAME)
- STOP
END IF
END SUBROUTINE HOW_MANY_LINES_OF
!#########################################################
@@ -624,6 +612,8 @@ FUNCTION GET_AIRFOIL_ID(TPTURBINE,TPBLADE,TPAIRFOIL,PRADIUS)
!
USE MODD_EOL_ALM, ONLY : TURBINE, BLADE, AIRFOIL
!
+USE MODE_MSG
+!
IMPLICIT NONE
!
TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
@@ -632,6 +622,8 @@ 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
@@ -639,9 +631,11 @@ REAL, DIMENSION(SIZE(TPBLADE%XRAD)) :: ZDELTARAD ! 2*ZDELTARAD = sectio
!
! Checking data
IF ((PRADIUS < TPTURBINE%XR_MIN) .OR. (PRADIUS > TPTURBINE%XR_MAX)) THEN
- PRINT*, 'The studied radius R = ', PRADIUS, ' is out of blade range : [', &
- TPTURBINE%XR_MIN, ';', TPTURBINE%XR_MAX, ']'
- RETURN
+ 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
diff --git a/src/MNH/eol_smear.f90 b/src/MNH/eol_smear.f90
index 00ca039d0e365ab854320d0ec29f72310c7f5336..95f12caecbf6b51173890922a0ed08f0f1db25a9 100644
--- a/src/MNH/eol_smear.f90
+++ b/src/MNH/eol_smear.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-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 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
! #######################
diff --git a/src/MNH/etheta.f90 b/src/MNH/etheta.f90
index 37f39873d08a4a5a37e032642d0ec36752909676..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
!#################
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/forcing.f90 b/src/MNH/forcing.f90
index 062cd4afa4cd7221157c6e5e550a96145bc38730..04a4a91cd280cb170667db196631e49d3b3d9d88 100644
--- a/src/MNH/forcing.f90
+++ b/src/MNH/forcing.f90
@@ -149,6 +149,7 @@ END MODULE MODI_FORCING
! use overloaded comparison operator for date_time
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC : relaxation applied to the horizontal avg. wind (for LES)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -169,9 +170,13 @@ USE MODD_TIME
!
use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_DATETIME
+USE MODE_GATHER_ll
USE MODE_MSG
+USE MODE_ll
+USE MODE_REPRO_SUM
!
USE MODI_GET_HALO
+USE MODI_LES_MEAN_ll
USE MODI_SHUMAN
USE MODI_UPSTREAM_Z
!
@@ -209,6 +214,9 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ
!* 0.2 Declarations of local variables
!
INTEGER :: IIU, IJU, IKU ! dimensions
+INTEGER :: IIB,IJB,IIE,IJE ! physical domain dimensions
+INTEGER :: IKB, IKE !
+INTEGER :: IIMAX_ll,IJMAX_ll
INTEGER, SAVE :: JSX ! saved loop index
INTEGER :: JI, JJ, JK, JL, JXP! loop indexes
!
@@ -248,11 +256,18 @@ INTEGER :: IRESP ! Return code of FM-routines
!
LOGICAL,DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: GRELAX_MASK_FRC
!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUMEAN, ZVMEAN
+REAL :: ZTEMPU, ZTEMPV
+!
!----------------------------------------------------------------------------
!
IIU=SIZE(PUT,1)
IJU=SIZE(PUT,2)
IKU=SIZE(PUT,3)
+IKE = SIZE(PUT,3) - JPVEXT
+IKB = 1 + JPVEXT
+CALL GET_INDICE_ll( IIB,IJB,IIE,IJE)
+CALL GET_GLOBALDIMS_ll ( IIMAX_ll,IJMAX_ll)
!
ILUOUT0 = TLUOUT0%NLU
@@ -479,6 +494,8 @@ ALLOCATE(ZDUF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
ALLOCATE(ZDVF(SIZE(PVT,1),SIZE(PVT,2),SIZE(PVT,3)))
ALLOCATE(ZTENDUF(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
ALLOCATE(ZTENDVF(SIZE(PVT,1),SIZE(PVT,2),SIZE(PVT,3)))
+ALLOCATE(ZUMEAN(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
+ALLOCATE(ZVMEAN(SIZE(PVT,1),SIZE(PVT,2),SIZE(PVT,3)))
!
IF (LFLAT) THEN
!
@@ -782,7 +799,7 @@ PVFRC_PAST(:,:,:) = ZVF(:,:,:)
!
!* 4.4 integration of the thermal, moisture and wind relaxation
!
-IF( LRELAX_THRV_FRC .OR. LRELAX_UV_FRC ) THEN
+IF( LRELAX_THRV_FRC .OR. LRELAX_UV_FRC .OR. LRELAX_UVMEAN_FRC) THEN
!
ZDZZ(:,:,:) = DZM(MZF(PZZ(:,:,:)))
ZDZZ(:,:,IKU) = PZZ(:,:,IKU) - PZZ(:,:,IKU-1)
@@ -837,6 +854,25 @@ IF( LRELAX_THRV_FRC .OR. LRELAX_UV_FRC ) THEN
END WHERE
!
END IF
+!
+ IF ( LRELAX_UVMEAN_FRC ) THEN
+ DO JK=IKB,IKE
+ ZTEMPU=SUM_DD_R2_ll(PUT(IIB:IIE,IJB:IJE,JK))/REAL(IIMAX_ll*IJMAX_ll)
+ ZUMEAN(:,:,JK) = ZTEMPU
+ ZTEMPV=SUM_DD_R2_ll(PVT(IIB:IIE,IJB:IJE,JK))/REAL(IIMAX_ll*IJMAX_ll)
+ ZVMEAN(:,:,JK) = ZTEMPV
+ END DO
+!
+! apply UV relaxation on the horizontal-average value of UV
+!
+ WHERE( GRELAX_MASK_FRC )
+ PRUS(:,:,:) = PRUS(:,:,:) - MXM(PRHODJ(:,:,:))*(ZUMEAN(:,:,:)-ZUF(:,:,:)) &
+ / XRELAX_TIME_FRC
+ PRVS(:,:,:) = PRVS(:,:,:) - MYM(PRHODJ(:,:,:))*(ZVMEAN(:,:,:)-ZVF(:,:,:)) &
+ / XRELAX_TIME_FRC
+ END WHERE
+!
+ END IF
!
END IF
!
@@ -891,6 +927,8 @@ DEALLOCATE(ZDZZ)
DEALLOCATE(ZRWCF)
DEALLOCATE(ZDUF)
DEALLOCATE(ZDVF)
+DEALLOCATE(ZUMEAN)
+DEALLOCATE(ZVMEAN)
!
!----------------------------------------------------------------------------
!
diff --git a/src/MNH/goto_model_wrapper.f90 b/src/MNH/goto_model_wrapper.f90
index 0a5bb9704d5698fd1768635ebc90ccb3015215ff..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,8 +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
-!! 02/21 (F.Auguste) add IBM
-!! 02/21 (T.Nagel) add turbulence recycling
+! F. Auguste 02/21: add IBM
+! T. Nagel 02/21: add turbulence recycling
!-----------------------------------------------------------------
MODULE MODI_GOTO_MODEL_WRAPPER
@@ -32,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
@@ -79,58 +86,36 @@ 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_ALLSTATION_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
!
-USE MODD_RECYCL_PARAM_n
-USE MODD_IBM_PARAM_n
-USE MODD_IBM_LSF
!
IMPLICIT NONE
!
diff --git a/src/MNH/gravity.f90 b/src/MNH/gravity.f90
index 27c8c3461514a02d0757bafaf6e5b7044bf1b447..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.
@@ -108,12 +108,12 @@ END MODULE MODI_GRAVITY
!
USE MODD_CONF
USE MODD_CST
-USE MODD_REF
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 :
@@ -146,43 +146,42 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
!
IF( .NOT.L1D ) THEN ! no buoyancy for 1D case
!
- IF (LOCEAN) THEN !ocean case
+ 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) &
+ 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
+ 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 )
- END IF
+ 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
index 81c90dc500246dd829d17aacabbcdf13b15780ba..67fa85cf88f7c1861cdcc33b10ff35f7766bbe11 100644
--- a/src/MNH/ibm_0Dint.f90
+++ b/src/MNH/ibm_0Dint.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_1Dint.f90 b/src/MNH/ibm_1Dint.f90
index f4522ae5f2b55e74f8568b8de897d49d3d6c021a..7c986e9ef375612292014cc9c3083b91f314972a 100644
--- a/src/MNH/ibm_1Dint.f90
+++ b/src/MNH/ibm_1Dint.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_3Dint.f90 b/src/MNH/ibm_3Dint.f90
index f57eec1afbb3175a912784d09702790ad85fd9e4..f055a64bae3cccff938f8ea009867a4f058b4ba2 100644
--- a/src/MNH/ibm_3Dint.f90
+++ b/src/MNH/ibm_3Dint.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_affectp.f90 b/src/MNH/ibm_affectp.f90
index 6d6f8ea3fb88fb46fb90bc339ab598efe87ebedf..b0c998744f7971f296e01b421b8f959ed890136d 100644
--- a/src/MNH/ibm_affectp.f90
+++ b/src/MNH/ibm_affectp.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_affectv.f90 b/src/MNH/ibm_affectv.f90
index fb751fb4c38f112aacabaf3ab35269ef575e6857..1a5711e10bf7388cb89e7c965f4b657e51f52a1e 100644
--- a/src/MNH/ibm_affectv.f90
+++ b/src/MNH/ibm_affectv.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_balance.f90 b/src/MNH/ibm_balance.f90
index 80e1ed14a913ed943148f1ba1b452c78f1cfc81e..2256cd097bc547fd789da11f5fc85507a808242d 100644
--- a/src/MNH/ibm_balance.f90
+++ b/src/MNH/ibm_balance.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_detect.f90 b/src/MNH/ibm_detect.f90
index 6b80f7598c5046edc75eca376b1367a1a270d587..ca4530964ff6f617309a5df187c9c689cbf73d53 100644
--- a/src/MNH/ibm_detect.f90
+++ b/src/MNH/ibm_detect.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_forcing.f90 b/src/MNH/ibm_forcing.f90
index 4014b9905fff763b4407750b6fec7b3ac677ff23..435df5ecf40d34496d93db727f57046ff656bd77 100644
--- a/src/MNH/ibm_forcing.f90
+++ b/src/MNH/ibm_forcing.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_forcing_adv.f90 b/src/MNH/ibm_forcing_adv.f90
index 8bb60d142ba5132d78c2f36563b8c5991cd3e097..b7692031e773aa1fd7441264c9af62e8934fcffe 100644
--- a/src/MNH/ibm_forcing_adv.f90
+++ b/src/MNH/ibm_forcing_adv.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_forcing_tr.f90 b/src/MNH/ibm_forcing_tr.f90
index 25e68b339ced4e6c4be1481e113e64a0f87d7f75..832217ea17adedd6c605b76ae372074927ad365e 100644
--- a/src/MNH/ibm_forcing_tr.f90
+++ b/src/MNH/ibm_forcing_tr.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
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
index d84c60e78d77b484efa9f51f951ff237e37860c2..e08be780d96d538d079536dc127c04074e860dd8 100644
--- a/src/MNH/ibm_idealee.f90
+++ b/src/MNH/ibm_idealee.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_idealrp.f90 b/src/MNH/ibm_idealrp.f90
index 5abc9cda19400cbe5efeac29dc0e6ce785a29d06..a67bb5fd2a5095ed294c0ec9a67bc547dc0e0273 100644
--- a/src/MNH/ibm_idealrp.f90
+++ b/src/MNH/ibm_idealrp.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_init.f90 b/src/MNH/ibm_init.f90
index c5b826eeca761b3fa4a53680abcbb2673bcfa00f..3918438ba423b0037191fb61a1c303ce35ffc324 100644
--- a/src/MNH/ibm_init.f90
+++ b/src/MNH/ibm_init.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_init_ls.f90 b/src/MNH/ibm_init_ls.f90
index 4ccc7dfda6d88eb56b1918e0f3369a1544cbf3f3..2d881e1fd564803d1d7f786993fa5efc2fe14042 100644
--- a/src/MNH/ibm_init_ls.f90
+++ b/src/MNH/ibm_init_ls.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_interpos.f90 b/src/MNH/ibm_interpos.f90
index 13c15531d58d9e60dbd6e984b058f5ec58a09cef..b124e08ef30cc57b09a7fa080d58ce9f43bf84a4 100644
--- a/src/MNH/ibm_interpos.f90
+++ b/src/MNH/ibm_interpos.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_interpos2.f90 b/src/MNH/ibm_interpos2.f90
index a0f0a5a714e1b872cf2710a456cad30e1ed36ab2..fb2b003b6e976411ac0e0578bcdf4e354625e964 100644
--- a/src/MNH/ibm_interpos2.f90
+++ b/src/MNH/ibm_interpos2.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_locatcorn.f90 b/src/MNH/ibm_locatcorn.f90
index 5d2cff3a75b9d75c64aac9b915f0f00ca5869c40..95eeb7acc1ac48bc738ba5b8bcb1ff267fe85b90 100644
--- a/src/MNH/ibm_locatcorn.f90
+++ b/src/MNH/ibm_locatcorn.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_mixinglength.f90 b/src/MNH/ibm_mixinglength.f90
index 3e4377a57c6e0e7ec1cbf59bad83f133828d040a..14bb0dd89b6effcd7d00516aea80b62a9b222b78 100644
--- a/src/MNH/ibm_mixinglength.f90
+++ b/src/MNH/ibm_mixinglength.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_prep_ls.f90 b/src/MNH/ibm_prep_ls.f90
index 22ba92cc5ff47af569358b01d21ad1c7924d32cb..bb3ae049b3716b925ea93dbcaca6877ab669290b 100644
--- a/src/MNH/ibm_prep_ls.f90
+++ b/src/MNH/ibm_prep_ls.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
@@ -37,10 +38,27 @@ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
!
! METHOD
! ------
- !**** Three main steps
- ! - read input ASCII files
- ! - Types of topography:
- ! IDEA : idealized obstacles (x,y coordinates)
+ !**** 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
! --------
@@ -52,14 +70,17 @@ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
!
! 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)].
!
- ! AUTHOR
+ ! AUTHORS
! ------
- ! Franck Auguste (CERFACS-AE)
+ ! Franck Auguste (CERFACS-AE), Tim Nagel (Météo-France)
!
! MODIFICATIONS
! -------------
- ! Original 01/01/2019
+ ! Original 01/06/2021
!
!------------------------------------------------------------------------------
!
@@ -86,6 +107,7 @@ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
! interface
USE MODI_SHUMAN
USE MODI_GDIV
+ USE MODI_IBM_GENERLS
USE MODI_IBM_IDEALRP
USE MODI_IBM_IDEALEE
!
@@ -93,6 +115,7 @@ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
USE MODD_CST
USE MODD_GRID_n
USE MODE_GRIDPROJ
+ USE MODE_MSG
!
IMPLICIT NONE
!
@@ -100,55 +123,30 @@ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
!
! 0.1 declarations of arguments
!
- LOGICAL ,INTENT(IN) :: OIBM ! flag for immersed boundary method
- CHARACTER(LEN=4) ,INTENT(IN) :: HIBM_TYPE ! switch generalized/idealised object
- REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions
+ 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,KII,KJJ
+ 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 :: JI2,JJ2,JK2,JI3,JJ3,JK3
- INTEGER :: JIM1,JIP1,JIM2,JIP2,JIM4,JIP4
- INTEGER :: JJM1,JJP1,JJM2,JJP2,JJM4,JJP4
- INTEGER :: JI2_MIN,JI2_MAX,JJ2_MIN,JJ2_MAX
- INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE,ILOOP,JLOOP,KLOOP
- INTEGER :: IGRIB,IIBM_LEVEL,KIBM_LEVEL,IIBM_MIDDLE,KIBM_LEVEL2
- INTEGER :: KIII,KJJJ,KIIM1,KIIP1,KJJM1,KJJP1
- 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
+ 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
- REAL, DIMENSION(:,:), ALLOCATABLE :: NORM_FACES,NORM_FACES2
+ 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
- REAL :: XXX,YYY,ZZZ
- INTEGER :: IRESPIBMREAL,ILUIBMREAL ! reading/writing ASCII files
- REAL, DIMENSION(:,:,:) , ALLOCATABLE :: ZSURF,ZINDI,ZTMP2,ZTMP3 ! SSF and ISF functions + temporary arrays
- REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMP,ZPHI ! temporary arrays
- REAL :: ZLAT,ZLON,ZHEI,ZIBM_HEI ! lat/lon/z coordinates
- INTEGER :: KNUM,KBOR,KIBM_BATMIN,KIBM_BATMAX ! index of buildings (BATI, REAL)
- CHARACTER(LEN=10) :: YHCOUNT1 ! reading/writing ASCII files
- CHARACTER(LEN=24) :: YHCOUNT2
- LOGICAL :: GHCOUNT3
- REAL :: ZXX,ZYY,ZXM2,ZYM2,ZII,ZJJ ! temporary values
- REAL :: ZMAX1,ZMAX2,ZMAX3
- REAL :: IIMAX,IJMAX,IKMAX
- REAL :: ZXX1,ZYY1,ZZZ1,ZXX2,ZYY2,ZZZ2
- REAL :: ZTES1,ZTES2,ZTES3,ZTES4,ZDIS,ZHIGH,ZHORI
- REAL :: ZLATMIN,ZLATMAX,ZLONMIN,ZLONMAX,ZXM2MIN,ZXM2MAX, ZYM2MIN, ZYM2MAX
- REAL :: SIGN1,SIGN2,SIGN3,SIGN4,ZHEI2
- REAL :: ZX1,ZY1,ZX2,ZY2,ZIND
TYPE(LIST_ll), POINTER :: TZFIELDS_ll
INTEGER :: IINFO_ll
- LOGICAL :: LCAEP,LAZF
CHARACTER(LEN=12) :: HFILEGENE, HFILEIDEA
CHARACTER(LEN=100) :: YSTRING,YSTRING2
INTEGER :: NS1,NS2,NS3,NS4,NS5,NS6
@@ -158,12 +156,22 @@ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
!------------------------------------------------------------------------------
!
! 0.3 Allocation
- ILUIBMIDEA = 43
+ 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
!
!------------------------------------------------------------------------------
!
@@ -171,6 +179,9 @@ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
! ----------------
!
! 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:
@@ -179,9 +190,173 @@ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
! ( NUMB_SURF is the objects number in each type)
!
!
- IF ((HIBM_TYPE=='IDEA')) THEN
+ !--------------------------------
+ !--------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(ILUIBMIDEA , FILE= HFILEIDEA , IOSTAT=IRESPIBMIDEA , FORM='FORMATTED' , &
+ 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
@@ -216,16 +391,41 @@ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
! -------------
!
! Computations of volumic fraction (VF) and Level Set function (LS) for all kinds of initialization
- ! idealized shape => construction of VF/LS function using analytical
+ ! 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=='IDEA')) then
+ 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
index a2e98ba088c8f9444a896847456dc440960bff6d..96144123454422ed14e94f1ae592098171937ca9 100644
--- a/src/MNH/ibm_smooth_ls.f90
+++ b/src/MNH/ibm_smooth_ls.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_valuecorn.f90 b/src/MNH/ibm_valuecorn.f90
index ebab4f11e73eae4ae226acf369841f08df1bf1cd..9c201a0d50be93337def827b15108f4e7e7f6dbb 100644
--- a/src/MNH/ibm_valuecorn.f90
+++ b/src/MNH/ibm_valuecorn.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_valuemat1.f90 b/src/MNH/ibm_valuemat1.f90
index e985b7975a861660f2d9836d13f014224a848171..8082f12c8db0e2907fd7f581f15aeec321ac6ac7 100644
--- a/src/MNH/ibm_valuemat1.f90
+++ b/src/MNH/ibm_valuemat1.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_valuemat2.f90 b/src/MNH/ibm_valuemat2.f90
index ba46ba9a89d566a1fdb895d6c95367ca55020b8f..1120cfc0d543818a0310ae6c28b95ab0d563a347 100644
--- a/src/MNH/ibm_valuemat2.f90
+++ b/src/MNH/ibm_valuemat2.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ibm_volume.f90 b/src/MNH/ibm_volume.f90
index 51d47f44309713a76f890f13c87d2afdfd0fe555..af4012a42b9cba352d527c22179f6de698ff59dc 100644
--- a/src/MNH/ibm_volume.f90
+++ b/src/MNH/ibm_volume.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/ice4_compute_pdf.f90 b/src/MNH/ice4_compute_pdf.f90
index a6fa358a8cb04cfe1d3f987dcab6565261008a77..bc465eb65ef522324dea8c19d986f578bdab5518 100644
--- a/src/MNH/ice4_compute_pdf.f90
+++ b/src/MNH/ice4_compute_pdf.f90
@@ -1,7 +1,8 @@
-!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_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
@@ -25,10 +26,10 @@ 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(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(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
@@ -81,10 +82,10 @@ 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(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(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
@@ -315,8 +316,7 @@ ELSEIF(HSUBG_AUCV_RI=='ADJU') THEN
ENDWHERE
ELSE
!wrong HSUBG_AUCV_RI case
- CALL ABORT
- STOP '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)
diff --git a/src/MNH/ice4_fast_rg.f90 b/src/MNH/ice4_fast_rg.f90
index 5059a108a259e28360f70be6d943b59b83b6ba09..b84dda857e7a679561f062eabbe0570f7fc22408 100644
--- a/src/MNH/ice4_fast_rg.f90
+++ b/src/MNH/ice4_fast_rg.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.
diff --git a/src/MNH/ice4_fast_rh.f90 b/src/MNH/ice4_fast_rh.f90
index 2731fb398c7b9f5ecadc5a92b5acb2c9e6ea7382..fcac937485414ba29fd691cb0774a32cb3ea4a3c 100644
--- a/src/MNH/ice4_fast_rh.f90
+++ b/src/MNH/ice4_fast_rh.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.
diff --git a/src/MNH/ice4_fast_ri.f90 b/src/MNH/ice4_fast_ri.f90
index 469b6cf3d867e05bb62931c5f8151c9c43094de6..bbe45f579d904a4eb0ec8bba282b81fe8835501d 100644
--- a/src/MNH/ice4_fast_ri.f90
+++ b/src/MNH/ice4_fast_ri.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.
diff --git a/src/MNH/ice4_fast_rs.f90 b/src/MNH/ice4_fast_rs.f90
index cd7511c532591270cf2979fe4e43c5c33bb026ec..6d71c7b61b8188969aa488a3b22d65ad15d7cc26 100644
--- a/src/MNH/ice4_fast_rs.f90
+++ b/src/MNH/ice4_fast_rs.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.
diff --git a/src/MNH/ice4_nucleation.f90 b/src/MNH/ice4_nucleation.f90
index 9eadc1d2911ef3f5570baec4cffa052bb89c8d5c..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, &
diff --git a/src/MNH/ice4_nucleation_wrapper.f90 b/src/MNH/ice4_nucleation_wrapper.f90
index 37b8fb8b676a3ee09dd9097945b722aa972e8b5d..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.
diff --git a/src/MNH/ice4_rainfr_vert.f90 b/src/MNH/ice4_rainfr_vert.f90
index 620c732cad2d58cc1ca310ad0dedbd6f39110b59..6e817fe769601c4347a4e5fecc692bfe0ba17cc3 100644
--- a/src/MNH/ice4_rainfr_vert.f90
+++ b/src/MNH/ice4_rainfr_vert.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_RAINFR_VERT
INTERFACE
SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR, PRS, PRG, PRH)
diff --git a/src/MNH/ice4_rimltc.f90 b/src/MNH/ice4_rimltc.f90
index ef1fb80828d47a6931454ddf83c391b585ccc36e..fc4e129862254befe7e652f40780aedbee481759 100644
--- a/src/MNH/ice4_rimltc.f90
+++ b/src/MNH/ice4_rimltc.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_RIMLTC
INTERFACE
SUBROUTINE ICE4_RIMLTC(KSIZE, LDSOFT, PCOMPUTE, &
diff --git a/src/MNH/ice4_rrhong.f90 b/src/MNH/ice4_rrhong.f90
index f12048030e18332d777b18858aa08a6ec2270378..da26489475b841ca17b8fcd1d286bacc4aeafd38 100644
--- a/src/MNH/ice4_rrhong.f90
+++ b/src/MNH/ice4_rrhong.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_RRHONG
INTERFACE
SUBROUTINE ICE4_RRHONG(KSIZE, LDSOFT, PCOMPUTE, &
diff --git a/src/MNH/ice4_rsrimcg_old.f90 b/src/MNH/ice4_rsrimcg_old.f90
index 1aa9afff0eab2e2132d987bea9b87434af768470..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.
diff --git a/src/MNH/ice4_sedimentation_split.f90 b/src/MNH/ice4_sedimentation_split.f90
index 62b21dfbdfb9e2da0060d0f8e3d1e5e9d4498269..cb0a147d070b865e8e9391bacf7ef143c3727311 100644
--- a/src/MNH/ice4_sedimentation_split.f90
+++ b/src/MNH/ice4_sedimentation_split.f90
@@ -35,8 +35,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
@@ -112,8 +112,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_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 f9bb0c08ad0817a83b7227672bbf63ce34041513..15d0cd78e495cb255015fb6ed29fbfdb5361c748 100644
--- a/src/MNH/ice4_slow.f90
+++ b/src/MNH/ice4_slow.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_SLOW
INTERFACE
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, HSUBG_AUCV_RI, PCOMPUTE, PRHODREF, PT,&
+SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT,&
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT,&
&PLBDAS, PLBDAG,&
@@ -14,7 +15,6 @@ SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, HSUBG_AUCV_RI, PCOMPUTE, PRHODREF, PT,&
IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
@@ -46,7 +46,7 @@ REAL, DIMENSION(KSIZE), INTENT(INOUT) :: PA_RG
END SUBROUTINE ICE4_SLOW
END INTERFACE
END MODULE MODI_ICE4_SLOW
-SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, HSUBG_AUCV_RI, PCOMPUTE, PRHODREF, PT, &
+SUBROUTINE ICE4_SLOW(KSIZE, LDSOFT, PCOMPUTE, PRHODREF, PT, &
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT, &
&PLBDAS, PLBDAG, &
@@ -81,7 +81,6 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: LDSOFT
-CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI
REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(KSIZE), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(KSIZE), INTENT(IN) :: PT ! Temperature
diff --git a/src/MNH/ice4_tendencies.f90 b/src/MNH/ice4_tendencies.f90
index f5c2121fb08cf94254d59ffc79eb749d97bbf5e4..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.
@@ -32,7 +32,7 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KSIZE, KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
INTEGER, INTENT(IN) :: KRR
LOGICAL, INTENT(IN) :: ODSOFT
-REAL, DIMENSION(KSIZE), INTENT(IN) :: PCOMPUTE
+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
@@ -179,10 +179,10 @@ 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,XEPSILO
+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
-USE MODD_PARAM_ICE, ONLY : CSNOWRIMING
!
USE MODI_ICE4_COMPUTE_PDF
USE MODI_ICE4_FAST_RG
@@ -500,7 +500,7 @@ IF(KSIZE>0) THEN
ENDIF
!
!
-CALL ICE4_SLOW(KSIZE, ODSOFT, HSUBG_AUCV_RI, PCOMPUTE, PRHODREF, ZT, &
+CALL ICE4_SLOW(KSIZE, ODSOFT, PCOMPUTE, PRHODREF, ZT, &
&PSSI, PLVFACT, PLSFACT, &
&ZRVT, ZRCT, ZRIT, ZRST, ZRGT, &
&ZLBDAS, ZLBDAG, &
diff --git a/src/MNH/ice4_warm.f90 b/src/MNH/ice4_warm.f90
index ff37bc325319d32a4b030184c6a8005819f30c51..aa61b1dac3ee676c3ec2ecca6d2af30c1ec9b8a5 100644
--- a/src/MNH/ice4_warm.f90
+++ b/src/MNH/ice4_warm.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.
diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index fa66ddbaa93b2a6e6fdb70b036ef258feba37dff..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.
@@ -10,13 +10,14 @@
INTERFACE
!
SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
- HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF,&
+ HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF, &
PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PRHODREF, 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
@@ -24,15 +25,15 @@ 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=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=80), INTENT(IN) :: HSUBG_MF_PDF
+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
@@ -47,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
!
@@ -174,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
!-------------------------------------------------------------------------------
!
@@ -206,15 +206,15 @@ 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=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=80), INTENT(IN) :: HSUBG_MF_PDF
+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
diff --git a/src/MNH/ice_adjust_elec.f90 b/src/MNH/ice_adjust_elec.f90
index 9c4d20e41aa2adfca005c10528ae0e6bc9594d86..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
@@ -630,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 f5d18a90b6e7153f96825f34716bb2ce6716f22a..3152cb6e5e17022fc128393ad806dff7b7a08fa6 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -41,51 +41,51 @@ end if
nbudgets = NBUDGET_SV1 - 1 + nsv
allocate( tbudgets( nbudgets ) )
-tbudgets(NBUDGET_U)%cname = "BU_RU"
+tbudgets(NBUDGET_U)%cname = "UU"
tbudgets(NBUDGET_U)%ccomment = "Budget for U"
tbudgets(NBUDGET_U)%nid = NBUDGET_U
-tbudgets(NBUDGET_V)%cname = "BU_RV"
+tbudgets(NBUDGET_V)%cname = "VV"
tbudgets(NBUDGET_V)%ccomment = "Budget for V"
tbudgets(NBUDGET_V)%nid = NBUDGET_V
-tbudgets(NBUDGET_W)%cname = "BU_RW"
+tbudgets(NBUDGET_W)%cname = "WW"
tbudgets(NBUDGET_W)%ccomment = "Budget for W"
tbudgets(NBUDGET_W)%nid = NBUDGET_W
-tbudgets(NBUDGET_TH)%cname = "BU_RTH"
+tbudgets(NBUDGET_TH)%cname = "TH"
tbudgets(NBUDGET_TH)%ccomment = "Budget for potential temperature"
tbudgets(NBUDGET_TH)%nid = NBUDGET_TH
-tbudgets(NBUDGET_TKE)%cname = "BU_RTKE"
+tbudgets(NBUDGET_TKE)%cname = "TK"
tbudgets(NBUDGET_TKE)%ccomment = "Budget for turbulent kinetic energy"
tbudgets(NBUDGET_TKE)%nid = NBUDGET_TKE
-tbudgets(NBUDGET_RV)%cname = "BU_RRV"
+tbudgets(NBUDGET_RV)%cname = "RV"
tbudgets(NBUDGET_RV)%ccomment = "Budget for water vapor mixing ratio"
tbudgets(NBUDGET_RV)%nid = NBUDGET_RV
-tbudgets(NBUDGET_RC)%cname = "BU_RRC"
+tbudgets(NBUDGET_RC)%cname = "RC"
tbudgets(NBUDGET_RC)%ccomment = "Budget for cloud water mixing ratio"
tbudgets(NBUDGET_RC)%nid = NBUDGET_RC
-tbudgets(NBUDGET_RR)%cname = "BU_RRR"
+tbudgets(NBUDGET_RR)%cname = "RR"
tbudgets(NBUDGET_RR)%ccomment = "Budget for rain water mixing ratio"
tbudgets(NBUDGET_RR)%nid = NBUDGET_RR
-tbudgets(NBUDGET_RI)%cname = "BU_RRI"
+tbudgets(NBUDGET_RI)%cname = "RI"
tbudgets(NBUDGET_RI)%ccomment = "Budget for cloud ice mixing ratio"
tbudgets(NBUDGET_RI)%nid = NBUDGET_RI
-tbudgets(NBUDGET_RS)%cname = "BU_RRS"
+tbudgets(NBUDGET_RS)%cname = "RS"
tbudgets(NBUDGET_RS)%ccomment = "Budget for snow/aggregate mixing ratio"
tbudgets(NBUDGET_RS)%nid = NBUDGET_RS
-tbudgets(NBUDGET_RG)%cname = "BU_RRG"
+tbudgets(NBUDGET_RG)%cname = "RG"
tbudgets(NBUDGET_RG)%ccomment = "Budget for graupel mixing ratio"
tbudgets(NBUDGET_RG)%nid = NBUDGET_RG
-tbudgets(NBUDGET_RH)%cname = "BU_RRH"
+tbudgets(NBUDGET_RH)%cname = "RH"
tbudgets(NBUDGET_RH)%ccomment = "Budget for hail mixing ratio"
tbudgets(NBUDGET_RH)%nid = NBUDGET_RH
@@ -175,7 +175,7 @@ end subroutine Budget_preallocate
!! C.Lac 01/07/11 Add vegetation drag
!! P. Peyrille, M. Tomasini : include in the forcing term the 2D forcing
!! terms in term 2DFRC search for modif PP . but Not very clean!
-!! C .Lac 27/05/14 add negative corrections for chemical species
+!! C .Lac 27/05/14 add negativity corrections for chemical species
!! C.Lac 29/01/15 Correction for NSV_USER
!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
!! C.Lac 04/12/15 Correction for LSUPSAT
@@ -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, LOCEAN
+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,13 +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_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
@@ -817,7 +818,7 @@ if ( lbu_rw ) then
tbudgets(NBUDGET_W)%trhodj%cstdname = ''
tbudgets(NBUDGET_W)%trhodj%clongname = 'RhodJZ'
tbudgets(NBUDGET_W)%trhodj%cunits = 'kg'
- tbudgets(NBUDGET_W)%trhodj%ccomment = 'RhodJ for momentum along Y axis'
+ tbudgets(NBUDGET_W)%trhodj%ccomment = 'RhodJ for momentum along Z axis'
tbudgets(NBUDGET_W)%trhodj%ngrid = 4
tbudgets(NBUDGET_W)%trhodj%ntype = TYPEREAL
tbudgets(NBUDGET_W)%trhodj%ndims = 3
@@ -1044,7 +1045,7 @@ if ( lbu_rth ) then
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'NETUR'
- tzsource%clongname = 'negative correction induced by turbulence'
+ tzsource%clongname = 'negativity correction induced by turbulence'
tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
@@ -1066,7 +1067,7 @@ if ( lbu_rth ) then
tzsource%cmnhname = 'OCEAN'
tzsource%clongname = 'radiative tendency due to SW penetrating ocean'
- tzsource%lavailable = LOCEAN .AND. (.NOT. LCOUPLES)
+ tzsource%lavailable = locean .and. (.not. lcouples)
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'ADV'
@@ -1075,13 +1076,13 @@ if ( lbu_rth ) then
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'NEADV'
- tzsource%clongname = 'negative correction induced by advection'
+ tzsource%clongname = 'negativity correction induced by advection'
tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
+ tzsource%clongname = 'negativity correction'
tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
@@ -1094,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 ) )
@@ -1156,7 +1158,7 @@ if ( lbu_rth ) then
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'IMLT'
- tzsource%clongname = 'ice melting'
+ tzsource%clongname = 'melting of ice'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
@@ -1166,13 +1168,13 @@ if ( lbu_rth ) then
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'RIM'
- tzsource%clongname = 'riming of cloud droplets'
+ tzsource%clongname = 'riming of cloud water'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
.or. hcloud(1:3) == 'ICE'
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain'
+ tzsource%clongname = 'accretion of rain on aggregates'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit &
.or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrain_lima ) ) ) &
.or. hcloud(1:3) == 'ICE'
@@ -1232,13 +1234,14 @@ if ( lbu_rth ) then
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'ADJU'
- tzsource%clongname = 'adjustment before'
+ tzsource%clongname = 'adjustment to saturation'
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%cmnhname = 'DEPI'
tzsource%clongname = '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_TH), tzsource )
tzsource%cmnhname = 'COND'
@@ -1247,7 +1250,7 @@ if ( lbu_rth ) then
call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
tzsource%cmnhname = 'NECON'
- tzsource%clongname = 'negative correction induced by condensation'
+ tzsource%clongname = 'negativity correction induced by condensation'
tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
.and. celec == 'NONE'
@@ -1328,27 +1331,27 @@ if ( lbu_rtke ) then
tzsource%cmnhname = 'DP'
tzsource%clongname = 'dynamic production'
- tzsource%lavailable = hturb == 'TKEL'
+ tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
tzsource%cmnhname = 'TP'
tzsource%clongname = 'thermal production'
- tzsource%lavailable = hturb == 'TKEL'
+ tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
tzsource%cmnhname = 'DISS'
tzsource%clongname = 'dissipation of TKE'
- tzsource%lavailable = hturb == 'TKEL'
+ tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
tzsource%cmnhname = 'TR'
tzsource%clongname = 'turbulent transport'
- tzsource%lavailable = hturb == 'TKEL'
+ tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
tzsource%cmnhname = 'ADV'
tzsource%clongname = 'total advection'
- tzsource%lavailable = hturb == 'TKEL'
+ tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
@@ -1431,7 +1434,7 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
tzsource%cmnhname = 'REL'
tzsource%clongname = 'relaxation'
- tzsource%lavailable = ohorelax_rv .or. ove_relax
+ tzsource%lavailable = ohorelax_rv
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
tzsource%cmnhname = 'DCONV'
@@ -1450,7 +1453,7 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
tzsource%cmnhname = 'NETUR'
- tzsource%clongname = 'negative correction induced by turbulence'
+ tzsource%clongname = 'negativity correction induced by turbulence'
tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
@@ -1476,13 +1479,13 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
tzsource%cmnhname = 'NEADV'
- tzsource%clongname = 'negative correction induced by advection'
+ tzsource%clongname = 'negativity correction induced by advection'
tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
+ tzsource%clongname = 'negativity correction'
tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
@@ -1490,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 ) )
@@ -1533,7 +1537,7 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
tzsource%cmnhname = 'ADJU'
- tzsource%clongname = 'adjustment before'
+ tzsource%clongname = 'adjustment to saturation'
tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
@@ -1547,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%cmnhname = 'DEPI'
tzsource%clongname = '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_RV), tzsource )
tzsource%cmnhname = 'CORR2'
@@ -1558,7 +1563,7 @@ if ( tbudgets(NBUDGET_RV)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
tzsource%cmnhname = 'NECON'
- tzsource%clongname = 'negative correction induced by condensation'
+ tzsource%clongname = 'negativity correction induced by condensation'
tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
.and. celec == 'NONE'
@@ -1657,7 +1662,7 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
tzsource%cmnhname = 'NETUR'
- tzsource%clongname = 'negative correction induced by turbulence'
+ tzsource%clongname = 'negativity correction induced by turbulence'
tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
@@ -1673,21 +1678,22 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
tzsource%cmnhname = 'NEADV'
- tzsource%clongname = 'negative correction induced by advection'
+ tzsource%clongname = 'negativity correction induced by advection'
tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
+ tzsource%clongname = 'negativity correction'
tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
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'
@@ -1714,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 )
@@ -1744,7 +1751,7 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
tzsource%cmnhname = 'ACCR'
- tzsource%clongname = 'accretion'
+ tzsource%clongname = 'accretion of cloud droplets'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) &
.or. hcloud == 'KESS' &
.or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
@@ -1763,7 +1770,7 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
tzsource%cmnhname = 'IMLT'
- tzsource%clongname = 'ice melting'
+ tzsource%clongname = 'melting of ice'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE'
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
@@ -1817,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 )
@@ -1833,7 +1840,7 @@ if ( tbudgets(NBUDGET_RC)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
tzsource%cmnhname = 'NECON'
- tzsource%clongname = 'negative correction induced by condensation'
+ tzsource%clongname = 'negativity correction induced by condensation'
tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
.and. celec == 'NONE'
@@ -1908,7 +1915,7 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
tzsource%cmnhname = 'NETUR'
- tzsource%clongname = 'negative correction induced by turbulence'
+ tzsource%clongname = 'negativity correction induced by turbulence'
tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
@@ -1923,21 +1930,22 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
tzsource%cmnhname = 'NEADV'
- tzsource%clongname = 'negative correction induced by advection'
+ tzsource%clongname = 'negativity correction induced by advection'
tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
+ tzsource%clongname = 'negativity correction'
tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
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'
@@ -1950,12 +1958,12 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
tzsource%cmnhname = 'R2C1'
- tzsource%clongname = 'rain to cloud after sedimentation'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit .and. lwarm_lima .and. lrain_lima
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
tzsource%cmnhname = 'AUTO'
- tzsource%clongname = 'autoconversion into rain drops'
+ tzsource%clongname = 'autoconversion into rain'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) &
.or. hcloud == 'KESS' &
.or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
@@ -1988,7 +1996,7 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain water on aggregates'
+ tzsource%clongname = 'accretion of rain on aggregates'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima &
.and. lsnow_lima .and. lrain_lima) ) ) &
.or. hcloud(1:3) == 'ICE'
@@ -2000,7 +2008,7 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
tzsource%cmnhname = 'CFRZ'
- tzsource%clongname = 'conversion freezing of rain drops'
+ tzsource%clongname = 'conversion freezing of rain'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima) ) ) &
.or. hcloud(1:3) == 'ICE'
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
@@ -2059,7 +2067,7 @@ if ( tbudgets(NBUDGET_RR)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
tzsource%cmnhname = 'NECON'
- tzsource%clongname = 'negative correction induced by condensation'
+ tzsource%clongname = 'negativity correction induced by condensation'
tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
.and. celec == 'NONE'
@@ -2149,8 +2157,8 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'NETUR'
- tzsource%clongname = 'negative correction induced by turbulence'
- tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' )
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' )
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'VISC'
@@ -2164,25 +2172,24 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'NEADV'
- tzsource%clongname = 'negative correction induced by advection'
- tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
- tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
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'
- tzsource%clongname = 'adjustment before on ice'
+ tzsource%clongname = 'adjustment to saturation'
tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. ladj_before .and. celec == 'NONE'
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
@@ -2218,7 +2225,7 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'HONC'
- tzsource%clongname = 'droplet homogeneous nucleation'
+ tzsource%clongname = 'droplet homogeneous freezing'
tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima ) )
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
@@ -2243,7 +2250,7 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'IMLT'
- tzsource%clongname = 'ice melting'
+ tzsource%clongname = 'melting of ice'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima ) ) ) .or. hcloud(1:3) == 'ICE'
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
@@ -2258,7 +2265,7 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'CFRZ'
- tzsource%clongname = 'conversion freezing of rain drops'
+ tzsource%clongname = 'conversion freezing of rain'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
.or. hcloud(1:3) == 'ICE'
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
@@ -2297,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'
@@ -2308,10 +2316,8 @@ if ( tbudgets(NBUDGET_RI)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
tzsource%cmnhname = 'NECON'
- tzsource%clongname = 'negative correction induced by condensation'
- tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
- .and. celec == 'NONE'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
@@ -2383,7 +2389,7 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
! tzsource%cmnhname = 'NETUR'
-! tzsource%clongname = 'negative correction induced by turbulence'
+! tzsource%clongname = 'negativity correction induced by turbulence'
! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
! call Budget_source_add( tbudgets(NBUDGET_RS), tzsource nneturrs )
@@ -2399,21 +2405,20 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
tzsource%cmnhname = 'NEADV'
- tzsource%clongname = 'negative correction induced by advection'
- tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
- tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
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'
@@ -2459,7 +2464,7 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain water'
+ tzsource%clongname = 'accretion of rain on snow'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima &
.and. lsnow_lima .and. lrain_lima) ) ) &
.or. hcloud(1:3) == 'ICE'
@@ -2496,10 +2501,8 @@ if ( tbudgets(NBUDGET_RS)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
tzsource%cmnhname = 'NECON'
- tzsource%clongname = 'negative correction induced by condensation'
- tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
- .and. celec == 'NONE'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
@@ -2571,7 +2574,7 @@ if ( tbudgets(NBUDGET_RG)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
! tzsource%cmnhname = 'NETUR'
-! tzsource%clongname = 'negative correction induced by turbulence'
+! tzsource%clongname = 'negativity correction induced by turbulence'
! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
! call Budget_source_add( tbudgets(NBUDGET_RG), tzsource nneturrg )
@@ -2587,15 +2590,13 @@ if ( tbudgets(NBUDGET_RG)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
tzsource%cmnhname = 'NEADV'
- tzsource%clongname = 'negative correction induced by advection'
- tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
- tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA'
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
tzsource%cmnhname = 'CORR'
@@ -2632,7 +2633,7 @@ if ( tbudgets(NBUDGET_RG)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'rain accretion on graupel'
+ tzsource%clongname = 'accretion of rain on graupel'
tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima &
.and. lsnow_lima .and. lrain_lima) ) ) &
.or. hcloud(1:3) == 'ICE'
@@ -2701,7 +2702,7 @@ if ( tbudgets(NBUDGET_RG)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
tzsource%cmnhname = 'NECON'
- tzsource%clongname = 'negative correction induced by condensation'
+ tzsource%clongname = 'negativity correction induced by condensation'
tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
.or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
.and. celec == 'NONE'
@@ -2728,7 +2729,7 @@ if ( tbudgets(NBUDGET_RH)%lenabled ) then
tbudgets(NBUDGET_RH)%tsources(:)%ngroup = 0
- tzsource%ccomment = 'Budget of graupel mixing ratio'
+ tzsource%ccomment = 'Budget of hail mixing ratio'
tzsource%ngrid = 1
tzsource%cunits = 'kg kg-1'
@@ -2776,7 +2777,7 @@ if ( tbudgets(NBUDGET_RH)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
! tzsource%cmnhname = 'NETUR'
-! tzsource%clongname = 'negative correction induced by turbulence'
+! tzsource%clongname = 'negativity correction induced by turbulence'
! tzsource%lavailable = hturb == 'TKEL' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' &
! .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' )
! call Budget_source_add( tbudgets(NBUDGET_RH), tzsource nneturrh )
@@ -2792,15 +2793,13 @@ if ( tbudgets(NBUDGET_RH)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
tzsource%cmnhname = 'NEADV'
- tzsource%clongname = 'negative correction induced by advection'
- tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
- tzsource%lavailable = hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
tzsource%cmnhname = 'SEDI'
@@ -2857,10 +2856,8 @@ if ( tbudgets(NBUDGET_RH)%lenabled ) then
call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
tzsource%cmnhname = 'NECON'
- tzsource%clongname = 'negative correction induced by condensation'
- tzsource%lavailable = ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' &
- .or. hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) &
- .and. celec == 'NONE'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
@@ -2969,7 +2966,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEGA2'
- tzsource%clongname = 'negative correction'
+ tzsource%clongname = 'negativity correction'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -2983,22 +2980,22 @@ SV_BUDGETS: do jsv = 1, ksv
! Source terms in common for all C2R2/KHKO budgets
tzsource%cmnhname = 'NETUR'
- tzsource%clongname = 'negative correction induced by turbulence'
+ tzsource%clongname = 'negativity correction induced by turbulence'
tzsource%lavailable = hturb == 'TKEL'
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEADV'
- tzsource%clongname = 'negative correction induced by advection'
+ tzsource%clongname = 'negativity correction induced by advection'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
+ tzsource%clongname = 'negativity correction'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NECON'
- tzsource%clongname = 'negative correction induced by condensation'
+ tzsource%clongname = 'negativity correction induced by condensation'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3037,7 +3034,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'ACCR'
- tzsource%clongname = 'accretion'
+ tzsource%clongname = 'accretion of cloud droplets'
tzsource%lavailable = lrain_c2r2
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3098,41 +3095,43 @@ 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 = 'negative 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 = 'negative 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 = 'negative 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 = 'negative 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
SV_LIMA: if ( jsv == nsv_lima_nc ) then
! Cloud droplets concentration
- tzsource%cmnhname = 'DEPOTR'
- tzsource%clongname = 'tree droplet deposition'
- 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
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ 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 = 'SEDI'
tzsource%clongname = 'sedimentation'
tzsource%lavailable = lwarm_lima .and. lsedc_lima
@@ -3150,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'
@@ -3160,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'
@@ -3169,7 +3168,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'ACCR'
- tzsource%clongname = 'accretion'
+ tzsource%clongname = 'accretion of cloud droplets'
tzsource%lavailable = lptsplit .or. ( lwarm_lima .and. lrain_lima )
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3179,12 +3178,12 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'HONC'
- tzsource%clongname = 'droplet homogeneous nucleation'
+ tzsource%clongname = 'droplet homogeneous freezing'
tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima )
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'IMLT'
- tzsource%clongname = 'ice melting'
+ tzsource%clongname = 'melting of ice'
tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima )
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3215,21 +3214,21 @@ SV_BUDGETS: do jsv = 1, ksv
tzsource%cmnhname = 'CORR2'
tzsource%clongname = 'supplementary correction inside LIMA splitting'
- tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ tzsource%lavailable = lptsplit
call Budget_source_add( tbudgets(ibudget), tzsource )
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'
@@ -3267,7 +3266,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain water'
+ tzsource%clongname = 'accretion of rain on aggregates'
tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima .and. lrain_lima )
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3302,13 +3301,13 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'HMLT'
- tzsource%clongname = 'hail melting'
+ tzsource%clongname = 'melting of hail'
tzsource%lavailable = .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'CORR2'
tzsource%clongname = 'supplementary correction inside LIMA splitting'
- tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ tzsource%lavailable = lptsplit
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3316,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'
@@ -3339,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'
@@ -3362,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'
@@ -3394,7 +3393,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'HONC'
- tzsource%clongname = 'droplet homogeneous nucleation'
+ tzsource%clongname = 'droplet homogeneous freezing'
tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima )
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3414,7 +3413,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'IMLT'
- tzsource%clongname = 'ice melting'
+ tzsource%clongname = 'melting of ice'
tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima )
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3450,12 +3449,12 @@ 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'
tzsource%clongname = 'supplementary correction inside LIMA splitting'
- tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ tzsource%lavailable = lptsplit
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3468,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'
@@ -3491,13 +3490,13 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'IMLT'
- tzsource%clongname = 'ice melting'
+ tzsource%clongname = 'melting of ice'
tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima )
call Budget_source_add( tbudgets(ibudget), tzsource )
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 )
@@ -3510,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 )
@@ -3518,18 +3517,25 @@ SV_BUDGETS: do jsv = 1, ksv
! Homogeneous freezing of CCN
tzsource%cmnhname = 'HONH'
tzsource%clongname = 'haze homogeneous nucleation'
- tzsource%lavailable = lcold_lima .and. lnucl_lima .and. &
- ( ( .not.lptsplit .and. ( ( lhhoni_lima .and. nmod_ccn >= 1 ) .or. lwarm_lima ) ) &
- .or. ( lptsplit .and. ( lhhoni_lima .and. nmod_ccn >= 1 ) ) )
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. &
+ ( ( lhhoni_lima .and. nmod_ccn >= 1 ) .or. ( .not.lptsplit .and. lwarm_lima ) )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ 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
+ end if SV_LIMA
else if ( jsv >= nsv_elecbeg .and. jsv <= nsv_elecend ) then SV_VAR
! Electricity case
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
+ tzsource%clongname = 'negativity correction'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3561,13 +3567,13 @@ 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 )
tzsource%cmnhname = 'NEUT'
- tzsource%clongname = 'NEUT'
+ tzsource%clongname = 'neutralization'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3585,7 +3591,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'ACCR'
- tzsource%clongname = 'accretion'
+ tzsource%clongname = 'accretion of cloud droplets'
tzsource%lavailable = lwarm_ice
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3615,7 +3621,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'IMLT'
- tzsource%clongname = 'ice melting'
+ tzsource%clongname = 'melting of ice'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3629,13 +3635,13 @@ 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 )
tzsource%cmnhname = 'NEUT'
- tzsource%clongname = 'NEUT'
+ tzsource%clongname = 'neutralization'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3653,7 +3659,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'ACCR'
- tzsource%clongname = 'accretion'
+ tzsource%clongname = 'accretion of cloud droplets'
tzsource%lavailable = lwarm_ice
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3663,7 +3669,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain water'
+ tzsource%clongname = 'accretion of rain on aggregates'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3703,7 +3709,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEUT'
- tzsource%clongname = 'NEUT'
+ tzsource%clongname = 'neutralization'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3745,7 +3751,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'IMLT'
- tzsource%clongname = 'ice melting'
+ tzsource%clongname = 'melting of ice'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3764,13 +3770,13 @@ 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 )
tzsource%cmnhname = 'NEUT'
- tzsource%clongname = 'NEUT'
+ tzsource%clongname = 'neutralization'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3798,7 +3804,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain water'
+ tzsource%clongname = 'accretion of rain on snow'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3833,7 +3839,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEUT'
- tzsource%clongname = 'NEUT'
+ tzsource%clongname = 'neutralization'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3856,7 +3862,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'ACC'
- tzsource%clongname = 'accretion of rain water'
+ tzsource%clongname = 'accretion of rain on graupel'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3901,7 +3907,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEUT'
- tzsource%clongname = 'NEUT'
+ tzsource%clongname = 'neutralization'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3930,7 +3936,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEUT'
- tzsource%clongname = 'NEUT'
+ tzsource%clongname = 'neutralization'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -3962,13 +3968,13 @@ 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 )
tzsource%cmnhname = 'NEUT'
- tzsource%clongname = 'NEUT'
+ tzsource%clongname = 'neutralization'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -4004,7 +4010,7 @@ SV_BUDGETS: do jsv = 1, ksv
call Budget_source_add( tbudgets(ibudget), tzsource )
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
+ tzsource%clongname = 'negativity correction'
tzsource%lavailable = .true.
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -4016,7 +4022,7 @@ SV_BUDGETS: do jsv = 1, ksv
else if ( jsv >= nsv_aerbeg .and. jsv <= nsv_aerend ) then SV_VAR
!Chemical aerosol case
tzsource%cmnhname = 'NEGA'
- tzsource%clongname = 'negative correction'
+ tzsource%clongname = 'negativity correction'
tzsource%lavailable = lorilam
call Budget_source_add( tbudgets(ibudget), tzsource )
@@ -4589,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 6c266aac10677013c673f9ea6db4aaff4096c59e..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.
!-----------------------------------------------------------------
! ###################
@@ -113,7 +113,7 @@ XG = 9.80665
! -------------------
!
! Ocean model cst same as in 1D/CMO SURFEX
-! values used in init_cst to overwrite XP00 and XTH00
+! values used in ini_cst to overwrite XP00 and XTH00
XRH00OCEAN =1024.
XTH00OCEAN = 286.65
XSA00OCEAN= 32.6
diff --git a/src/MNH/ini_eol_adnr.f90 b/src/MNH/ini_eol_adnr.f90
index 9dad33be28eb442336d8517fcd0cb08e2b08d04a..9e069eed9e0fb5d1578c5831423efbeb0c2828f8 100644
--- a/src/MNH/ini_eol_adnr.f90
+++ b/src/MNH/ini_eol_adnr.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -98,11 +98,11 @@ INTEGER :: ILUOUT ! Output listing file
!
!* 1.1 Wind farm data
!
-CALL READ_CSVDATA_FARM_ADNR(40,TRIM(CFARM_CSVDATA),TFARM)
+CALL READ_CSVDATA_FARM_ADNR(TRIM(CFARM_CSVDATA),TFARM)
!
!* 1.2 Wind turbine data
!
-CALL READ_CSVDATA_TURBINE_ADNR(41,TRIM(CTURBINE_CSVDATA),TTURBINE)
+CALL READ_CSVDATA_TURBINE_ADNR(TRIM(CTURBINE_CSVDATA),TTURBINE)
!
!
!-------------------------------------------------------------------
diff --git a/src/MNH/ini_eol_alm.f90 b/src/MNH/ini_eol_alm.f90
index 73b4001fde46ed9866b31543af58906e6f7091c2..41938d789ae7c876168bdf7c62004aa320eb2615 100644
--- a/src/MNH/ini_eol_alm.f90
+++ b/src/MNH/ini_eol_alm.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -158,19 +158,19 @@ INTEGER :: IINFO ! code info return
!
!* 1.1 Wind farm data
!
-CALL READ_CSVDATA_FARM_ALM(40,TRIM(CFARM_CSVDATA),TFARM)
+CALL READ_CSVDATA_FARM_ALM(TRIM(CFARM_CSVDATA),TFARM)
!
!* 1.2 Wind turbine data
!
-CALL READ_CSVDATA_TURBINE_ALM(41,TRIM(CTURBINE_CSVDATA),TTURBINE)
+CALL READ_CSVDATA_TURBINE_ALM(TRIM(CTURBINE_CSVDATA),TTURBINE)
!
!* 1.3 Blade data
!
-CALL READ_CSVDATA_BLADE_ALM(42,TRIM(CBLADE_CSVDATA),TTURBINE,TBLADE)
+CALL READ_CSVDATA_BLADE_ALM(TRIM(CBLADE_CSVDATA),TTURBINE,TBLADE)
!
!* 1.4 Airfoil data
!
-CALL READ_CSVDATA_AIRFOIL_ALM(43,TRIM(CAIRFOIL_CSVDATA),TBLADE,TAIRFOIL)
+CALL READ_CSVDATA_AIRFOIL_ALM(TRIM(CAIRFOIL_CSVDATA),TBLADE,TAIRFOIL)
!
!
!-------------------------------------------------------------------
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 43e160cac437e6fe60e8033e3b9978e008cc2610..32ddfbb8847adcfe2cbe1887368abee74b2370b9 100644
--- a/src/MNH/ini_mean_field.f90
+++ b/src/MNH/ini_mean_field.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2021 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.
!-----------------------------------------------------------------
! ##########################
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 31e10ae5c8856cb18c0f19049c170cc063cb9a1a..f45f479b7815d30043928905a0ba116ef4019c17 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.f90
@@ -306,7 +306,6 @@ USE MODD_2D_FRC
USE MODD_ADVFRC_n
USE MODD_ADV_n
use MODD_AEROSET, only: POLYTAU, POLYSSA, POLYG
-USE MODD_ALLSTATION_n
USE MODD_ARGSLIST_ll, only: LIST_ll
USE MODD_BIKHARDT_n
USE MODD_BLOWSNOW
@@ -355,7 +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_LS, XIBM_IEPS
+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
@@ -395,7 +394,6 @@ use MODD_SALT_OPT_LKT, only: NMAX_RADIUS_LKT_SALT=>NMAX_RADIUS_LKT, NMAX_SI
USE MODD_SERIES, only: LSERIES
USE MODD_SHADOWS_n
USE MODD_STAND_ATM, only: XSTROATM, XSMLSATM, XSMLWATM, XSPOSATM, XSPOWATM
-USE MODD_STATION_n
USE MODD_TIME
USE MODD_TIME_n
USE MODD_TURB_CLOUD, only: NMODEL_CLOUD, CTURBLEN_CLOUD,XCEI
@@ -573,6 +571,12 @@ IF (CCLOUD == 'LIMA') THEN
LHORELAX_SVC1R3=LHORELAX_SVLIMA
END IF
!
+! UPDATE CONSTANTS FOR OCEAN MODEL
+IF (LOCEAN) THEN
+ XP00=XP00OCEAN
+ XTH00=XTH00OCEAN
+END IF
+!
!
NULLIFY(TZINITHALO2D_ll)
NULLIFY(TZINITHALO3D_ll)
@@ -717,7 +721,7 @@ CALL UPDATE_NSV(KMI)
!
IF (LRECYCL) THEN
!
- R_COUNT = 0
+ NR_COUNT = 0
!
ALLOCATE(XUMEANW(IJU,IKU,INT(XNUMBELT))) ; XUMEANW = 0.0
ALLOCATE(XVMEANW(IJU,IKU,INT(XNUMBELT))) ; XVMEANW = 0.0
@@ -732,6 +736,20 @@ IF (LRECYCL) THEN
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
!
!
@@ -781,12 +799,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))
@@ -836,20 +856,42 @@ 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
-ALLOCATE(ZIBM_LS(IIU,IJU,IKU)) ; ZIBM_LS = 0.0
-ALLOCATE(XIBM_XMUT(IIU,IJU,IKU)); XIBM_XMUT = 0.0
-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
+
+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))
@@ -978,8 +1020,8 @@ ALLOCATE(XDZZ(IIU,IJU,IKU))
!
!* 3.3 Modules MODD_REF and MODD_REF_n
!
-! different reference state for O and A models
-! POur le moment meme etat de ref O et A
+! 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))
@@ -1861,11 +1903,12 @@ IF (CCLOUD=='LIMA') CALL INIT_AEROSOL_PROPERTIES
! --------------------------------
!
CALL MPPDB_CHECK3D(XUT,"INI_MODEL_N-before read_field::XUT",PRECISION)
-CALL READ_FIELD(KMI,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, &
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 49932a2494dab21ec0048fb1f6f6c81090bfcef5..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.
diff --git a/src/MNH/ini_posprofilern.f90 b/src/MNH/ini_posprofilern.f90
index 21894be24fba16d29538814eda120b48e9894bcc..7d5a3cd0df45721c88374309b73a19e9a79c2e70 100644
--- a/src/MNH/ini_posprofilern.f90
+++ b/src/MNH/ini_posprofilern.f90
@@ -65,6 +65,7 @@ END MODULE MODI_INI_POSPROFILER_n
!! C.Lac 10/2016 Add visibility diagnostic
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! M.Taufour : modify RARE for hydrometeors containing ice and add bright band calculation for RARE
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -173,7 +174,11 @@ ALLOCATE(TPROFILER%THV (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%RHOD (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%VISI (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%VISIKUN(ISTORE,IKU,NUMBPROFILER))
-ALLOCATE(TPROFILER%RARE (ISTORE,IKU,NUMBPROFILER))
+ALLOCATE(TPROFILER%CRARE (ISTORE,IKU,NUMBPROFILER))
+ALLOCATE(TPROFILER%CRARE_ATT (ISTORE,IKU,NUMBPROFILER))
+ALLOCATE(TPROFILER%LWCZ (ISTORE,IKU,NUMBPROFILER))
+ALLOCATE(TPROFILER%IWCZ (ISTORE,IKU,NUMBPROFILER))
+ALLOCATE(TPROFILER%CIZ (ISTORE,IKU,NUMBPROFILER))
ALLOCATE(TPROFILER%R (ISTORE,IKU,NUMBPROFILER,KRR))
ALLOCATE(TPROFILER%SV (ISTORE,IKU,NUMBPROFILER,KSV))
ALLOCATE(TPROFILER%AER (ISTORE,IKU,NUMBPROFILER,NAER))
@@ -216,7 +221,11 @@ TPROFILER%THV = XUNDEF
TPROFILER%RHOD = XUNDEF
TPROFILER%VISI = XUNDEF
TPROFILER%VISIKUN = XUNDEF
-TPROFILER%RARE = XUNDEF
+TPROFILER%CRARE = XUNDEF
+TPROFILER%CRARE_ATT = XUNDEF
+TPROFILER%LWCZ = XUNDEF
+TPROFILER%IWCZ = XUNDEF
+TPROFILER%CIZ = XUNDEF
TPROFILER%IWV = XUNDEF
TPROFILER%ZTD = XUNDEF
TPROFILER%ZWD = XUNDEF
diff --git a/src/MNH/ini_segn.f90 b/src/MNH/ini_segn.f90
index b852d82f0f227c7b6c6217967fd71af257636fb3..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,7 +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_n, ONLY : LOCEAN
USE MODD_DYN
USE MODD_IO, ONLY: NVERB_FATAL, NVERB_WARNING, TFILE_OUTPUTLISTING, TFILEDATA
USE MODD_LUNIT
@@ -441,7 +441,8 @@ 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)
+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, &
diff --git a/src/MNH/ini_seriesn.f90 b/src/MNH/ini_seriesn.f90
index dbb0030186716cf329c841a8027b1773de9dfe54..45bdbdcca4945fcc696de676559089056cc5ec4c 100644
--- a/src/MNH/ini_seriesn.f90
+++ b/src/MNH/ini_seriesn.f90
@@ -1,4 +1,4 @@
-!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.
@@ -43,7 +43,7 @@
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 12/04/2019: use standard measurement units
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-!
+! P. Wautelet 05/05/2021: add CSMASK1/2/3 variables
!-------------------------------------------------------------------------------
!
!* 0. Declaration
@@ -88,6 +88,7 @@ INTEGER :: IIDIM1 ! I size of the slice
INTEGER :: JJ,JI ! loop indices
INTEGER :: ISB1,ISB2,ISB3
INTEGER :: ISER
+CHARACTER (LEN=4), DIMENSION(3) :: YMASK
CHARACTER (LEN=5), DIMENSION(3) :: YSUF
INTEGER :: ILUOUT ! Logical unit number for output-listing
INTEGER :: IRESP ! Return code of FM-routines
@@ -258,6 +259,9 @@ ALLOCATE( CSTITLE3 (NSTEMP_SERIE3) )
ALLOCATE( CSUNIT1 (NSTEMP_SERIE1) )
ALLOCATE( CSUNIT2 (NSTEMP_SERIE2) )
ALLOCATE( CSUNIT3 (NSTEMP_SERIE3) )
+ALLOCATE( CSMASK1 (NSTEMP_SERIE1) )
+ALLOCATE( CSMASK2 (NSTEMP_SERIE2) )
+! ALLOCATE( CSMASK3 (NSTEMP_SERIE3) )
ALLOCATE( NSGRIDD1 (NSTEMP_SERIE1) )
ALLOCATE( NSGRIDD2 (NSTEMP_SERIE2) )
ALLOCATE( NSGRIDD3 (NSTEMP_SERIE3) )
@@ -304,6 +308,10 @@ IF (LMASKLANDSEA) ISER=3
YSUF(1)='-GLOB'
YSUF(2)='-LAND'
YSUF(3)='-SEA '
+
+YMASK(1) = 'GLOB'
+YMASK(2) = 'LAND'
+YMASK(3) = 'SEA'
!
!* 2.1 Temporal series t
! -----------------
@@ -319,38 +327,38 @@ ISB1=0
DO JI=1,ISER
! total surface explicit precipitations
IF (SIZE(XINPRR)/=0) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='INPRT'//YSUF(JI) ; CSUNIT1(ISB1)='mm day-1'
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='ACPRT'//YSUF(JI) ; CSUNIT1(ISB1)='mm'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='INPRT'//YSUF(JI) ; CSUNIT1(ISB1)='mm day-1' ; CSMASK1(ISB1) = YMASK(JI)
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='ACPRT'//YSUF(JI) ; CSUNIT1(ISB1)='mm' ; CSMASK1(ISB1) = YMASK(JI)
END IF
! Mixing ratios
IF (LUSERV) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RVT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RVT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2' ; CSMASK1(ISB1) = YMASK(JI)
END IF
IF (LUSERC) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RCT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RCT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2' ; CSMASK1(ISB1) = YMASK(JI)
END IF
IF (LUSERR) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RRT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RRT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2' ; CSMASK1(ISB1) = YMASK(JI)
ENDIF
IF (LUSERI) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RIT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RIT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2' ; CSMASK1(ISB1) = YMASK(JI)
END IF
IF (LUSERS) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RST'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RST'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2' ; CSMASK1(ISB1) = YMASK(JI)
END IF
IF (LUSERG) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RGT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RGT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2' ; CSMASK1(ISB1) = YMASK(JI)
END IF
IF (LUSERH) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='RHT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='RHT'//YSUF(JI) ; CSUNIT1(ISB1)='kg m-2' ; CSMASK1(ISB1) = YMASK(JI)
END IF
! SURFACE FIELDS
IF (LSURF) THEN
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='TS_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='K'
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='T_MNW_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='K'
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='T_BOT_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='K'
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='CT_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='1'
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='HML_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='m'
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='TS_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='K' ; CSMASK1(ISB1) = YMASK(JI)
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='T_MNW_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='K' ; CSMASK1(ISB1) = YMASK(JI)
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='T_BOT_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='K' ; CSMASK1(ISB1) = YMASK(JI)
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='CT_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='1' ; CSMASK1(ISB1) = YMASK(JI)
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='HML_WATER'//YSUF(JI) ; CSUNIT1(ISB1)='m' ; CSMASK1(ISB1) = YMASK(JI)
ENDIF
! end SURFACE FIELDS
END DO
@@ -358,9 +366,9 @@ END DO
IF (LWMINMAX) THEN
DO JI=1,ISER
! Max of vertical speed
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='WMAX'//YSUF(JI) ; CSUNIT1(ISB1)='m s-1' ; NSGRIDD1(ISB1)=4
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='WMAX'//YSUF(JI) ; CSUNIT1(ISB1)='m s-1' ; NSGRIDD1(ISB1)=4 ; CSMASK1(ISB1) = YMASK(JI)
! Min of vertical speed
- ISB1=ISB1+1 ; CSTITLE1(ISB1)='WMIN'//YSUF(JI) ; CSUNIT1(ISB1)='m s-1' ; NSGRIDD1(ISB1)=4
+ ISB1=ISB1+1 ; CSTITLE1(ISB1)='WMIN'//YSUF(JI) ; CSUNIT1(ISB1)='m s-1' ; NSGRIDD1(ISB1)=4 ; CSMASK1(ISB1) = YMASK(JI)
END DO
END IF
!
@@ -384,29 +392,29 @@ NSGRIDD2(:)=1
ISB2=0
DO JI=1,ISER
! Vertical velocity
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='WT'//YSUF(JI) ; CSUNIT2(ISB2)='m s-1' ; NSGRIDD2(ISB2)=4
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='WT'//YSUF(JI) ; CSUNIT2(ISB2)='m s-1' ; CSMASK2(ISB2) = YMASK(JI) ; NSGRIDD2(ISB2)=4
! Potential temperature
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='THT'//YSUF(JI) ; CSUNIT2(ISB2)='K'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='THT'//YSUF(JI) ; CSUNIT2(ISB2)='K' ; CSMASK2(ISB2) = YMASK(JI)
! Pressure
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='PABST'//YSUF(JI) ; CSUNIT2(ISB2)='Pa'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='PABST'//YSUF(JI) ; CSUNIT2(ISB2)='Pa' ; CSMASK2(ISB2) = YMASK(JI)
! Mixing ratios
IF (LUSERV) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RVT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RVT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1' ; CSMASK2(ISB2) = YMASK(JI)
END IF
IF (LUSERC) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RCT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RCT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1' ; CSMASK2(ISB2) = YMASK(JI)
END IF
IF (LUSERR) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RRT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RRT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1' ; CSMASK2(ISB2) = YMASK(JI)
END IF
IF (LUSERI) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RIT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RIT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1' ; CSMASK2(ISB2) = YMASK(JI)
END IF
IF (LUSERS) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RST'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RST'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1' ; CSMASK2(ISB2) = YMASK(JI)
END IF
IF (LUSERG) THEN
- ISB2=ISB2+1 ; CSTITLE2(ISB2)='RGT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1'
+ ISB2=ISB2+1 ; CSTITLE2(ISB2)='RGT'//YSUF(JI) ; CSUNIT2(ISB2)='kg kg-1' ; CSMASK2(ISB2) = YMASK(JI)
END IF
END DO
!
diff --git a/src/MNH/ini_sizen.f90 b/src/MNH/ini_sizen.f90
index caad447cacd9e7ecdeab6d7253e5b16c52dfcf29..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.
@@ -165,12 +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
+ 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 c113b737757516b2772304c7f26396a3796c2dff..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
! #######################
@@ -72,9 +67,9 @@
! ------------
!
USE MODD_ALLSTATION_n
+USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_PARAMETERS
-!USE MODN_STATION_n
-USE MODD_CONF, ONLY: LCARTESIAN
+!
USE MODI_STATION_READER
!
!
@@ -141,7 +136,7 @@ ELSE
!
!* 2. CSV DATA
!
- CALL READ_CSV_STATION(90,CFILE_STAT,TSTATION,LCARTESIAN)
+ CALL READ_CSV_STATION(CFILE_STAT,TSTATION,LCARTESIAN)
TSTATION%STEP = XSTEP_STAT
END IF
diff --git a/src/MNH/ini_surfstationn.f90 b/src/MNH/ini_surfstationn.f90
index bd426e204e99fb394b3c6320ee8292dc60916192..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.
@@ -67,26 +67,26 @@ END MODULE MODI_INI_SURFSTATION_n
!! A. Lemonsu 19/11/2002
! 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
+! 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_ALLSTATION_n
USE MODD_STATION_n
USE MODD_TYPE_DATE
USE MODD_VAR_ll, ONLY: IP
-USE MODD_NESTING
!
USE MODE_GATHER_ll
USE MODE_GRIDPROJ
@@ -94,7 +94,6 @@ USE MODE_ll
USE MODE_MSG
!
USE MODI_INI_STATION_N
-!USE MODN_STATION_n
!
IMPLICIT NONE
!
@@ -165,7 +164,7 @@ END SUBROUTINE DEFAULT_STATION_n
SUBROUTINE ALLOCATE_STATION_n(TSTATION,KMI)
!
TYPE(STATION), INTENT(INOUT) :: TSTATION !
-INTEGER :: KMI ! Model Index
+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' )
diff --git a/src/MNH/ini_tke_eps.f90 b/src/MNH/ini_tke_eps.f90
index 5bdd3d5755ae688cf9d4de32d04a0d9f1844fd28..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.
@@ -90,14 +90,15 @@ END MODULE MODI_INI_TKE_EPS
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CTURB, ONLY : XLINI, XCED, XCMFS, XTKEMIN, XCSHF
-USE MODD_CST, ONLY : XG, XRD, XRV, XALPHAOC
-USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_DYN_n, ONLY : LOCEAN
+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, ONLY : DZF, MXF, MYF, MZM
USE MODE_ll
-USE MODD_ARGSLIST_ll,ONLY : LIST_ll
+!
+USE MODI_SHUMAN, ONLY: DZF, MXF, MYF, MZM
!
IMPLICIT NONE
!
@@ -151,19 +152,19 @@ IF (HGETTKET == 'INIT' ) THEN
!
! determines TKE
! 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
+ 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 e275487920bccbf19c22ec93e4dc0e1b880f9279..d2d7b194949ee3f1a8c7829c3022d5e439134462 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,15 +76,13 @@
!* 0. DECLARATIONS
! ------------
USE MODD_CONF
-USE MODD_CST, ONLY:XP00,XTH00,XP00OCEAN,XTH00OCEAN
-USE MODD_DYN_n, ONLY: CPRESOPT,NITR,LOCEAN ! only for spawning purpose
+USE MODD_DYN_n, ONLY: CPRESOPT, NITR ! only for spawning purpose
USE MODD_IO, ONLY: TFILE_OUTPUTLISTING, TPTR2FILE
USE MODD_LBC_n, ONLY: CLBCX,CLBCY ! only for spawning purpose
USE MODD_LUNIT
USE MODD_LUNIT_n
USE MODD_MNH_SURFEX_n
USE MODD_PARAMETERS
-USE MODD_REF
!
use mode_field, only: Alloc_field_scalars, Fieldlist_goto_model
USE MODE_IO_FILE, ONLY: IO_File_open
@@ -182,13 +180,6 @@ END IF
!
IF (CPROGRAM=='DIAG') CALL RESET_EXSEG()
!
-! UPDATE CONSTANTS FOR OCEAN MODEL
-DO JMI=1,JPMODELMAX
- IF (LOCEAN) THEN
- XP00=XP00OCEAN
- XTH00=XTH00OCEAN
- END IF
-END DO
!-------------------------------------------------------------------------------
!
!
diff --git a/src/MNH/lesn.f90 b/src/MNH/lesn.f90
index aca09170f137177acc0c2a77d5394c067a7f302d..129929246495bee84d57526e482a17fc9b4e52b7 100644
--- a/src/MNH/lesn.f90
+++ b/src/MNH/lesn.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.
@@ -1250,6 +1250,7 @@ LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: OMASK ! 2D mask for computations
! 0.2 declaration of local variables
!
INTEGER :: JSV ! scalar variables counter
+INTEGER :: JI
INTEGER :: JK ! vertical loop counter
INTEGER :: JPDF ! pdf counter
!
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..bd98d503c551fc74862ea85aeb1a80795beea2ce 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,7 +518,7 @@ 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, &
@@ -488,58 +526,114 @@ IF (LCOLD .AND. LWARM) THEN
END IF
!
IF (LWARM .AND. LRAIN) THEN
- CALL LIMA_DROPLETS_SELF_COLLECTION (LDCOMPUTE, &
- PRHODREF, &
- PCCT, ZLBDC3, &
- P_CC_SELF, &
- PA_CC )
+ 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_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 )
!
- 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 )
+ 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 bc4b216721af44735825835eefa96024370bef0a..048eb689dfa04f798b16e555bb6b220e896b3484 100644
--- a/src/MNH/mean_field.f90
+++ b/src/MNH/mean_field.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2021 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,7 +10,7 @@
!
INTERFACE
- SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST,PSVT)
+ 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
@@ -23,9 +23,9 @@ END INTERFACE
END MODULE MODI_MEAN_FIELD
!
-! #######################################################
- SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST,PSVT)
-! #######################################################
+! #################################################################
+ SUBROUTINE MEAN_FIELD( PUT, PVT, PWT, PTHT, PTKET, PPABST, PSVT )
+! #################################################################
!
!!**** *MEAN_FIELD * -
!!
diff --git a/src/MNH/modd_allstationn.f90 b/src/MNH/modd_allstationn.f90
index 2b1d9d37c79a14ce86c3d9d50713cccc0301d636..c31413b78a08bf8ea7480265110dcc58331bdff4 100644
--- a/src/MNH/modd_allstationn.f90
+++ b/src/MNH/modd_allstationn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ############################
@@ -35,9 +35,10 @@
! ------------
!
!
-USE MODD_TYPE_STATION
-USE MODD_STATION_n
USE MODD_PARAMETERS, ONLY: JPMODELMAX
+USE MODD_STATION_n
+USE MODD_TYPE_STATION
+
IMPLICIT NONE
TYPE ALLSTATION_t
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_budget.f90 b/src/MNH/modd_budget.f90
index 44a3cfff0e0cdd4c5a930be3631aadba593c9ef9..7442dfd3e0184598cd4ee7687456a5e31b900e5b 100644
--- a/src/MNH/modd_budget.f90
+++ b/src/MNH/modd_budget.f90
@@ -78,6 +78,27 @@ integer, parameter :: NBUDGET_RG = 11 ! Reference number for budget of RhoJrg a
integer, parameter :: NBUDGET_RH = 12 ! Reference number for budget of RhoJrh and/or LES budgets with rh
integer, parameter :: NBUDGET_SV1 = 13 ! Reference number for 1st budget of RhoJsv and/or LES budgets with sv
+integer, parameter :: NMAXLEVELS = 7
+integer, parameter :: NLVL_ROOT = 0
+integer, parameter :: NLVL_CATEGORY = 1
+integer, parameter :: NLVL_SUBCATEGORY = 2
+integer, parameter :: NLVL_GROUP = 3
+integer, parameter :: NLVL_SHAPE = 4
+integer, parameter :: NLVL_TIMEAVG = 5
+integer, parameter :: NLVL_NORM = 6
+integer, parameter :: NLVL_MASK = 7
+
+#ifdef MNH_IOCDF4
+character(len=*), dimension(NMAXLEVELS), parameter :: CNCGROUPNAMES = [ &
+ 'category ', & !Name of the different type of groups/levels in the netCDF file
+ 'subcategory', &
+ 'group ', &
+ 'shape ', &
+ 'timeavg ', &
+ 'norm ', &
+ 'mask ' ]
+#endif
+
integer :: nbudgets ! Number of budget categories
@@ -104,16 +125,16 @@ type, extends( tfield_metadata_base ) :: tburhodata
end type tburhodata
type :: tbudiachrometadata
- character(len=NBUNAMELGTMAX) :: cgroupname = 'not set'
- character(len=NBUNAMELGTMAX) :: cname = 'not set'
- character(len=NCOMMENTLGTMAX) :: ccomment = 'not set'
- character(len=NBUNAMELGTMAX) :: ctype = 'not set'
- character(len=NBUNAMELGTMAX) :: ccategory = 'not set' !budget, LES, aircraft, balloon, series, station, profiler
- character(len=NBUNAMELGTMAX) :: cshape = 'not set' !Shape of the domain (mask, cartesian, vertical profile, point)
- logical :: lmobile = .false. !Is the domain moving? (ie for aircrafts and balloons)
+ character(len=NBUNAMELGTMAX), dimension(NMAXLEVELS) :: clevels = '' !Name of the different groups/levels in the netCDF file
+ character(len=NCOMMENTLGTMAX), dimension(NMAXLEVELS) :: ccomments ='' !Comments for the different groups/levels in the netCDF file
+ character(len=1) :: cdirection = '' !Used for 2pt correlation and spectrum
+ logical :: lmobile = .false. !Is the domain moving? (ie for aircrafts and balloons)
logical :: licompress = .false.
logical :: ljcompress = .false.
logical :: lkcompress = .false.
+ logical :: ltcompress = .false. ! true if values are time averaged (can be on multiple time periods)
+ logical :: lnorm = .false. ! true if values are normalized
+ logical, dimension(NMAXLEVELS) :: lleveluse = .false.
integer :: nil = -1 !Cartesian box boundaries in physical domain coordinates
integer :: nih = -1
integer :: njl = -1
diff --git a/src/MNH/modd_cst.f90 b/src/MNH/modd_cst.f90
index 6832448e4008da354f7372b48bd03b6225af5a99..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
! ###############
@@ -64,7 +59,7 @@ REAL,SAVE :: XRADIUS,XOMEGA ! Earth radius, earth rotation
REAL,SAVE :: XG ! Gravity constant
!
REAL,SAVE :: XP00 ! Reference pressure
-REAL,SAVE :: XP00OCEAN ! Reference pressurefor ocean model
+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
diff --git a/src/MNH/modd_dynn.f90 b/src/MNH/modd_dynn.f90
index 60d8cfc76f9bea08cd3737a559ae18ddd371f3d5..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.
!-----------------------------------------------------------------
! #################
@@ -56,7 +56,7 @@ TYPE DYN_t
!
INTEGER :: NSTOP ! Number of time step
REAL :: XTSTEP ! Time step
- LOGICAL :: LOCEAN
+ LOGICAL :: LOCEAN
!
!++++++++++++++++++++++++++++++++++
!PART USED BY THE PRESSURE SOLVER
diff --git a/src/MNH/modd_eol_adnr.f90 b/src/MNH/modd_eol_adnr.f90
index b2342570938d9508292e7a7003fa01bd90094cf4..d0aa66e3efa2cc0de33cfe908e086d2620e982bf 100644
--- a/src/MNH/modd_eol_adnr.f90
+++ b/src/MNH/modd_eol_adnr.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/modd_eol_alm.f90 b/src/MNH/modd_eol_alm.f90
index 187b4b88ab04dc43106261871fec6741d2f86753..c04f0cb538ec0d35b16b0cb2ceb5a005401dfa81 100644
--- a/src/MNH/modd_eol_alm.f90
+++ b/src/MNH/modd_eol_alm.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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
diff --git a/src/MNH/modd_eol_kine_alm.f90 b/src/MNH/modd_eol_kine_alm.f90
index a78e65673fcdecc58787112cd9f0ebc5b590638b..84f45c055592e1eaaba34b43d067ffab3b2feb8b 100644
--- a/src/MNH/modd_eol_kine_alm.f90
+++ b/src/MNH/modd_eol_kine_alm.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-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.
+!-----------------------------------------------------------------
!!
!! #####################
MODULE MODD_EOL_KINE_ALM
diff --git a/src/MNH/modd_eol_main.f90 b/src/MNH/modd_eol_main.f90
index 69d7baa1e0b4c2a100abcaafabf10eb98e9c58b9..671d1602adf0e24accb6095af65e27c5f3013e3f 100644
--- a/src/MNH/modd_eol_main.f90
+++ b/src/MNH/modd_eol_main.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/modd_eol_shared_io.f90 b/src/MNH/modd_eol_shared_io.f90
index 2838aa92ce355b9cc1ba51ab40b8ccce9cd67ec0..6132fb28f19890e2f30b56539b55735b70f26be6 100644
--- a/src/MNH/modd_eol_shared_io.f90
+++ b/src/MNH/modd_eol_shared_io.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90
index 3b75c92ecbe1330d283d24e1579d24c121415ab7..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,8 +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
-! 04/2020 S. Riette HighLow cloud
-!! 02/2021 (T.Nagel) Add fields for turbulence recycling
+! S. Riette 04/2020: highLow cloud
+! T. Nagel 02/2021: add fields for turbulence recycling
!!
!-------------------------------------------------------------------------------
!
@@ -90,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)
@@ -201,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
@@ -253,7 +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
+!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
diff --git a/src/MNH/modd_frc.f90 b/src/MNH/modd_frc.f90
index 1e4b6c7ff5b91c4440abf45ce1f5b9e2bfe29281..91994b803da64a835311586ea0b9d46bf31edfc7 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.
@@ -17,9 +17,9 @@
! and the translation speed of the domain of simulation.
! The following control parameters are used by FORCING:
! - LGEOST_UV_FRC and LGEOST_TH_FRC
-! - LTEND_THRV_FRC
+! - LTEND_THRV_FRC and LTEND_UV_FRC
! - LVERT_MOTION_FRC
-! - LRELAX_THRV_FRC and LRELAX_UV_FRC using:
+! - LRELAX_THRV_FRC, LRELAX_UV_FRC and LRELAX_UVMEAN_FRC using:
! XRELAX_TIME_FRC, XRELAX_HEIGHT_FRC and CRELAX_HEIGHT_TYPE
! - LTRANS
!!
@@ -46,6 +46,7 @@
!! 01/2004 V. Masson surface externalization: removes SST forcing
!! 09/2017 Q.Rodier add LTEND_UV_FRC
!! 03/2021 JL Redelsperger Parameters defining sfc forcing shape for idealized ocean case
+!! 06/2021 F. Couvreux add LRELAX_UVMEAN_FRC
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -88,7 +89,8 @@ LOGICAL, SAVE :: LTEND_UV_FRC ! enables tendency forcing of the wind
LOGICAL, SAVE :: LVERT_MOTION_FRC ! enables prescribed a forced vertical
! transport for all prognostic variables
LOGICAL, SAVE :: LRELAX_THRV_FRC ! enables temp. and humidity relaxation
-LOGICAL, SAVE :: LRELAX_UV_FRC ! enables horizontal wind relaxation
+LOGICAL, SAVE :: LRELAX_UV_FRC ! enables horizontal wind relaxation applied to the full wind field
+LOGICAL, SAVE :: LRELAX_UVMEAN_FRC ! enables horizontal wind relaxation applied to the horiz. avg. wind
!
REAL, SAVE :: XRELAX_TIME_FRC ! e-folding time for relaxation
REAL, SAVE :: XRELAX_HEIGHT_FRC ! height below which relaxation
diff --git a/src/MNH/modd_getn.f90 b/src/MNH/modd_getn.f90
index 282172d1d98fb6898f0c27698f5e7c6d5bb53860..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
! #################
diff --git a/src/MNH/modd_ibm_lsf.f90 b/src/MNH/modd_ibm_lsf.f90
index 94f899a7ff572ca9ffda7fb6877c41ea1a91f48a..27dfa7d21e5d01cfca424c965a94f4ef6b070afa 100644
--- a/src/MNH/modd_ibm_lsf.f90
+++ b/src/MNH/modd_ibm_lsf.f90
@@ -1,8 +1,9 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
! #######################
diff --git a/src/MNH/modd_ibm_paramn.f90 b/src/MNH/modd_ibm_paramn.f90
index 87899fe69c4297d53698508bd7be261c43aff4ff..642abc204a3d1a3a68f20e35eb4e4840cfe9e276 100644
--- a/src/MNH/modd_ibm_paramn.f90
+++ b/src/MNH/modd_ibm_paramn.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/modd_mean_fieldn.f90 b/src/MNH/modd_mean_fieldn.f90
index bfe8f66e3a3300ff875fe31c343ed6cf6aab81a5..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
! ###################
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
index f53e2063ebba8c04c39d0d32e51137c3234839d9..e9936173ec35b1d57c9884cd19cd98774c9d0334 100644
--- a/src/MNH/modd_oceanh.f90
+++ b/src/MNH/modd_oceanh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -29,7 +29,7 @@
!
!* 0. DECLARATIONS
! ------------
- !
+!
USE MODD_TYPE_DATE
!
IMPLICIT NONE
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
index 9e13056f602f06ee5d76f9805d4218c1772548f1..bfc4d7b3e7d1c7c605b745dc00316ea44705f280 100644
--- a/src/MNH/modd_recycl_paramn.f90
+++ b/src/MNH/modd_recycl_paramn.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
@@ -46,7 +47,7 @@ REAL :: XDRECYCLN,XDRECYCLW,XDRECYCLE,XDRECYCLS, &
XARECYCLN,XARECYCLW,XARECYCLE,XARECYCLS, &
XTMOY,XTMOYCOUNT,XNUMBELT,XRCOEFF,XTBVTOP,XTBVBOT
-INTEGER :: R_COUNT
+INTEGER :: NR_COUNT
REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANW=>NULL()
REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANW=>NULL()
REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANW=>NULL()
@@ -100,7 +101,7 @@ REAL, DIMENSION(:,:,:),POINTER :: XWMEANS=>NULL()
-INTEGER ,POINTER :: R_COUNT =>NULL()
+INTEGER ,POINTER :: NR_COUNT =>NULL()
REAL, DIMENSION(:,:,:) ,POINTER :: XTBV=>NULL()
CONTAINS
@@ -159,7 +160,7 @@ XUMEANS=>RECYCL_MODEL(KTO)%XUMEANS
XVMEANS=>RECYCL_MODEL(KTO)%XVMEANS
XWMEANS=>RECYCL_MODEL(KTO)%XWMEANS
-R_COUNT=>RECYCL_MODEL(KTO)%R_COUNT
+NR_COUNT=>RECYCL_MODEL(KTO)%NR_COUNT
END SUBROUTINE RECYCL_GOTO_MODEL
diff --git a/src/MNH/modd_ref.f90 b/src/MNH/modd_ref.f90
index 206898425df34d55fb0f8a0f1120fe7f0b327132..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.
!-----------------------------------------------------------------
! ###############
diff --git a/src/MNH/modd_seriesn.f90 b/src/MNH/modd_seriesn.f90
index 03ab9f206df8701771193cbe8960cec8394ee320..b407ae675e0c28458fbc50ca03bcce61e273d138 100644
--- a/src/MNH/modd_seriesn.f90
+++ b/src/MNH/modd_seriesn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-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.
@@ -33,6 +33,7 @@
!! Oct. 10,1998 (Lafore) adaptation of Diagnostics
!! to the sequential nesting version
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 05/05/2021: add CSMASK1/2/3 variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -79,6 +80,9 @@ TYPE SERIES_t
! associated with the 1st group
CHARACTER(LEN=100),DIMENSION(:),POINTER :: CSUNIT2=>NULL() ! with the 2nd
CHARACTER(LEN=100),DIMENSION(:),POINTER :: CSUNIT3=>NULL() ! with the 3rd
+ CHARACTER(LEN=4), DIMENSION(:),POINTER :: CSMASK1=>NULL()
+ CHARACTER(LEN=4), DIMENSION(:),POINTER :: CSMASK2=>NULL()
+! CHARACTER(LEN=4), DIMENSION(:),POINTER :: CSMASK3=>NULL()
INTEGER , DIMENSION(:) ,POINTER :: NSGRIDD1=>NULL() !grid indicator for the 1st serie
INTEGER , DIMENSION(:) ,POINTER :: NSGRIDD2=>NULL() ! for the 2nd
INTEGER , DIMENSION(:) ,POINTER :: NSGRIDD3=>NULL() ! for the 3rd
@@ -135,6 +139,9 @@ CHARACTER(LEN=100),DIMENSION(:),POINTER :: CSTITLE3=>NULL()
CHARACTER(LEN=100),DIMENSION(:),POINTER :: CSUNIT1=>NULL()
CHARACTER(LEN=100),DIMENSION(:),POINTER :: CSUNIT2=>NULL()
CHARACTER(LEN=100),DIMENSION(:),POINTER :: CSUNIT3=>NULL()
+CHARACTER(LEN=4), DIMENSION(:),POINTER :: CSMASK1=>NULL()
+CHARACTER(LEN=4), DIMENSION(:),POINTER :: CSMASK2=>NULL()
+! CHARACTER(LEN=4), DIMENSION(:),POINTER :: CSMASK3=>NULL()
INTEGER , DIMENSION(:) ,POINTER :: NSGRIDD1=>NULL()
INTEGER , DIMENSION(:) ,POINTER :: NSGRIDD2=>NULL()
INTEGER , DIMENSION(:) ,POINTER :: NSGRIDD3=>NULL()
@@ -181,6 +188,9 @@ SERIES_MODEL(KFROM)%CSTITLE3=>CSTITLE3
SERIES_MODEL(KFROM)%CSUNIT1=>CSUNIT1
SERIES_MODEL(KFROM)%CSUNIT2=>CSUNIT2
SERIES_MODEL(KFROM)%CSUNIT3=>CSUNIT3
+SERIES_MODEL(KFROM)%CSMASK1=>CSMASK1
+SERIES_MODEL(KFROM)%CSMASK2=>CSMASK2
+! SERIES_MODEL(KFROM)%CSMASK3=>CSMASK3
SERIES_MODEL(KFROM)%NSGRIDD1=>NSGRIDD1
SERIES_MODEL(KFROM)%NSGRIDD2=>NSGRIDD2
SERIES_MODEL(KFROM)%NSGRIDD3=>NSGRIDD3
@@ -220,6 +230,9 @@ CSTITLE3=>SERIES_MODEL(KTO)%CSTITLE3
CSUNIT1=>SERIES_MODEL(KTO)%CSUNIT1
CSUNIT2=>SERIES_MODEL(KTO)%CSUNIT2
CSUNIT3=>SERIES_MODEL(KTO)%CSUNIT3
+CSMASK1=>SERIES_MODEL(KTO)%CSMASK1
+CSMASK2=>SERIES_MODEL(KTO)%CSMASK2
+! CSMASK3=>SERIES_MODEL(KTO)%CSMASK3
NSGRIDD1=>SERIES_MODEL(KTO)%NSGRIDD1
NSGRIDD2=>SERIES_MODEL(KTO)%NSGRIDD2
NSGRIDD3=>SERIES_MODEL(KTO)%NSGRIDD3
diff --git a/src/MNH/modd_turbn.f90 b/src/MNH/modd_turbn.f90
index 5b938a6bdec96d14a3135984b12337506f22c753..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.
!-----------------------------------------------------------------
! ##################
diff --git a/src/MNH/modd_type_profiler.f90 b/src/MNH/modd_type_profiler.f90
index ed00d4799ed5d79f395ebd3a92331bece8b1269e..64cd438eeb9774a852cb89895a4942e7fdea910e 100644
--- a/src/MNH/modd_type_profiler.f90
+++ b/src/MNH/modd_type_profiler.f90
@@ -31,6 +31,7 @@
!! Original 15/01/02
!! C.Lac 10/2016 Add visibility diagnostic
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! M.Taufour 07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -76,7 +77,11 @@ REAL, DIMENSION(:,:,:), POINTER :: TH=>NULL() ! th(n)
REAL, DIMENSION(:,:,:), POINTER :: THV=>NULL() ! thv(n)
REAL, DIMENSION(:,:,:), POINTER :: VISI=>NULL() ! VISI(n)
REAL, DIMENSION(:,:,:), POINTER :: VISIKUN=>NULL() ! VISI KUNKEL(n)
-REAL, DIMENSION(:,:,:), POINTER :: RARE=>NULL() ! radar reflectivity (n)
+REAL, DIMENSION(:,:,:), POINTER :: CRARE=>NULL() ! radar reflectivity (n)
+REAL, DIMENSION(:,:,:), POINTER :: CRARE_ATT=>NULL() ! radar attenuated reflectivity (n)
+REAL, DIMENSION(:,:,:), POINTER :: CIZ=>NULL() ! Ice number concentration ICE3 (n)
+REAL, DIMENSION(:,:,:), POINTER :: LWCZ=>NULL() ! liquid water content (n)
+REAL, DIMENSION(:,:,:), POINTER :: IWCZ=>NULL() ! ice water content (n)
REAL, DIMENSION(:,:,:), POINTER :: RHOD=>NULL() ! density of dry air/moist air
REAL, DIMENSION(:,:,:,:), POINTER :: R=>NULL() ! r*(n)
REAL, DIMENSION(:,:,:,:), POINTER :: SV=>NULL() ! Sv*(n)
diff --git a/src/MNH/mode_les_diachro.f90 b/src/MNH/mode_les_diachro.f90
index 27764a382b7ad500d65dfde90516e50bcbb897df..1aeec63c152b37e0cd52545de59ca5bbbccd8b5a 100644
--- a/src/MNH/mode_les_diachro.f90
+++ b/src/MNH/mode_les_diachro.f90
@@ -17,7 +17,8 @@
MODULE MODE_LES_DIACHRO
!#######################
-use modd_budget, only: tbudiachrometadata
+use modd_budget, only: NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK, &
+ tbudiachrometadata
use modd_les_n, only: tles_dates, xles_times
use modd_lunit
@@ -748,9 +749,9 @@ end if
end subroutine Les_diachro_2D
-!##################################################################################
-subroutine Les_diachro_3D( tpdiafile, tpfield, odoavg, odonorm, pfield, hsuffixes )
-!##################################################################################
+!##########################################################################################
+subroutine Les_diachro_3D( tpdiafile, tpfield, odoavg, odonorm, pfield, hsuffixes, hmasks )
+!##########################################################################################
use modd_field, only: NMNHDIM_BUDGET_LES_LEVEL, NMNHDIM_BUDGET_LES_MASK, NMNHDIM_BUDGET_LES_SV, &
NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_TERM, NMNHDIM_UNUSED, &
@@ -763,6 +764,7 @@ logical, intent(in) :: odoavg ! Compute an
logical, intent(in) :: odonorm ! Compute and store normalized field
real, dimension(:,:,:), intent(in) :: pfield ! Data array
character(len=*), dimension(:), optional, intent(in) :: hsuffixes
+character(len=*), dimension(:), optional, intent(in) :: hmasks
type(tfield_metadata_base) :: tzfield
@@ -779,9 +781,23 @@ if ( Any( tzfield%ndimlist(4:) /= NMNHDIM_UNUSED ) ) then
tzfield%ndimlist(4:) = NMNHDIM_UNUSED
end if
-if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_LEVEL &
- .and. tzfield%ndimlist(2) == NMNHDIM_BUDGET_LES_TIME &
- .and. ( tzfield%ndimlist(3) == NMNHDIM_BUDGET_LES_MASK .or.tzfield%ndimlist(3) == NMNHDIM_BUDGET_TERM ) ) then
+if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_LEVEL &
+ .and. tzfield%ndimlist(2) == NMNHDIM_BUDGET_LES_TIME &
+ .and. tzfield%ndimlist(3) == NMNHDIM_BUDGET_LES_MASK ) then
+ if ( .not. Present( hmasks ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_3D', &
+ 'optional dummy argument hmasks is needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( Size( hmasks ) /= Size( pfield, 3) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_3D', 'wrong size for hmasks (' // Trim( tzfield%cmnhname ) // ')' )
+
+ tzfield%ndimlist(4) = NMNHDIM_UNUSED
+ call Les_diachro_common( tpdiafile, tzfield, &
+ reshape( pfield, [ size( pfield, 1 ), size( pfield, 2 ), size( pfield, 3 ), 1 ] ), &
+ odoavg, odonorm, hmasks = hmasks )
+else if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_LEVEL &
+ .and. tzfield%ndimlist(2) == NMNHDIM_BUDGET_LES_TIME &
+ .and. tzfield%ndimlist(3) == NMNHDIM_BUDGET_TERM ) then
if ( .not. Present( hsuffixes ) ) &
call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_3D', &
'optional dummy argument hsuffixes is needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
@@ -792,7 +808,7 @@ if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_LEVEL
tzfield%ndimlist(4) = NMNHDIM_UNUSED
call Les_diachro_common( tpdiafile, tzfield, &
reshape( pfield, [ size( pfield, 1 ), size( pfield, 2 ), size( pfield, 3 ), 1 ] ), &
- odoavg, odonorm, hsuffixes )
+ odoavg, odonorm, hsuffixes = hsuffixes )
else if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_LEVEL &
.and. tzfield%ndimlist(2) == NMNHDIM_BUDGET_LES_TIME &
.and. tzfield%ndimlist(3) == NMNHDIM_BUDGET_LES_SV ) then
@@ -800,6 +816,10 @@ else if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_LEVEL &
call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_3D', &
'optional dummy argument hsuffixes is not needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+ if ( Present( hmasks ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_3D', &
+ 'optional dummy argument hmasks is not needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+
tzfield%ndimlist(4) = tzfield%ndimlist(3)
tzfield%ndimlist(3) = NMNHDIM_UNUSED
call Les_diachro_common( tpdiafile, tzfield, &
@@ -812,9 +832,9 @@ end if
end subroutine Les_diachro_3D
-!##################################################################################
-subroutine Les_diachro_4D( tpdiafile, tpfield, odoavg, odonorm, pfield, hsuffixes )
-!##################################################################################
+!##########################################################################################
+subroutine Les_diachro_4D( tpdiafile, tpfield, odoavg, odonorm, pfield, hsuffixes, hmasks )
+!##########################################################################################
use modd_field, only: NMNHDIM_BUDGET_LES_LEVEL, NMNHDIM_BUDGET_LES_MASK, NMNHDIM_BUDGET_LES_SV, &
NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_TERM, NMNHDIM_UNUSED, &
@@ -827,6 +847,7 @@ logical, intent(in) :: odoavg ! Compute
logical, intent(in) :: odonorm ! Compute and store normalized field
real, dimension(:,:,:,:), intent(in) :: pfield ! Data array
character(len=*), dimension(:), optional, intent(in) :: hsuffixes
+character(len=*), dimension(:), optional, intent(in) :: hmasks
type(tfield_metadata_base) :: tzfield
@@ -843,10 +864,22 @@ if ( Any( tzfield%ndimlist(5:) /= NMNHDIM_UNUSED ) ) then
tzfield%ndimlist(5:) = NMNHDIM_UNUSED
end if
-if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_LEVEL &
- .and. tzfield%ndimlist(2) == NMNHDIM_BUDGET_LES_TIME &
- .and. ( tzfield%ndimlist(3) == NMNHDIM_BUDGET_LES_MASK .or.tzfield%ndimlist(3) == NMNHDIM_BUDGET_TERM ) &
- .and. tzfield%ndimlist(4) == NMNHDIM_BUDGET_LES_SV ) then
+if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_LEVEL&
+ .and. tzfield%ndimlist(2) == NMNHDIM_BUDGET_LES_TIME &
+ .and. tzfield%ndimlist(3) == NMNHDIM_BUDGET_LES_MASK &
+ .and. tzfield%ndimlist(4) == NMNHDIM_BUDGET_LES_SV ) then
+ if ( .not. Present( hmasks ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', &
+ 'optional dummy argument hmasks is needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( Size( hmasks ) /= Size( pfield, 3) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_4D', 'wrong size for hmasks (' // Trim( tzfield%cmnhname ) // ')' )
+
+ call Les_diachro_common( tpdiafile, tzfield, pfield, odoavg, odonorm, hmasks = hmasks )
+else if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_LEVEL &
+ .and. tzfield%ndimlist(2) == NMNHDIM_BUDGET_LES_TIME &
+ .and. tzfield%ndimlist(3) == NMNHDIM_BUDGET_TERM &
+ .and. tzfield%ndimlist(4) == NMNHDIM_BUDGET_LES_SV ) then
if ( .not. Present( hsuffixes ) ) &
call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', &
'optional dummy argument hsuffixes is needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
@@ -854,7 +887,7 @@ if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_LEVEL
if ( Size( hsuffixes ) /= Size( pfield, 3) ) &
call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_4D', 'wrong size for hsuffixes (' // Trim( tzfield%cmnhname ) // ')' )
- call Les_diachro_common( tpdiafile, tzfield, pfield, odoavg, odonorm, hsuffixes )
+ call Les_diachro_common( tpdiafile, tzfield, pfield, odoavg, odonorm, hsuffixes= hsuffixes )
else
call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', &
'ndimlist configuration not yet implemented for ' // Trim( tzfield%cmnhname ) )
@@ -862,9 +895,9 @@ end if
end subroutine Les_diachro_4D
-!#######################################################################################
-subroutine Les_diachro_common( tpdiafile, tpfield, pfield, odoavg, odonorm, hsuffixes )
-!#######################################################################################
+!##############################################################################################
+subroutine Les_diachro_common( tpdiafile, tpfield, pfield, odoavg, odonorm, hsuffixes, hmasks )
+!##############################################################################################
use modd_field, only: tfield_metadata_base
use modd_io, only: tfiledata
@@ -881,14 +914,14 @@ real, dimension(:,:,:,:), intent(in) :: pfield
logical, intent(in) :: odoavg ! Compute and store time average
logical, intent(in) :: odonorm ! Compute and store normalized field
character(len=*), dimension(:), optional, intent(in) :: hsuffixes
+character(len=*), dimension(:), optional, intent(in) :: hmasks
character(len=100), dimension(:), allocatable :: ycomment ! Comment string
character(len=100), dimension(:), allocatable :: ytitle ! Title
-integer :: iavg
integer :: iles_k ! Number of vertical levels
integer :: iil, iih, ijl, ijh, ikl, ikh ! Cartesian area relatively to the
! entire domain
-integer :: jk ! Vertical loop counter
+integer :: jp ! Process loop counter
real, dimension(:,:,:), allocatable :: ztrajz ! x and y are not used for LES
type(tfield_metadata_base), dimension(:), allocatable :: tzfields
!------------------------------------------------------------------------------
@@ -909,9 +942,18 @@ ikl = nles_levels(1)
ikh = nles_levels(iles_k)
if ( Present( hsuffixes ) ) then
+ if ( Present( hmasks ) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_common', 'hsuffixes and hmasks optional arguments may not be present ' // &
+ 'at the same time (' // Trim( tpfield%cmnhname ) // ')' )
if ( Size( hsuffixes ) /= Size( pfield, 3) ) &
call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_common', 'wrong size for hsuffixes (' // Trim( tpfield%cmnhname ) // ')' )
- ycomment(:) = Trim( tpfield%ccomment(:) ) // hsuffixes(:)
+ ycomment(:) = Trim( tpfield%ccomment(:) ) // ' ' // hsuffixes(:)
+else if ( Present( hmasks ) ) then
+ if ( Size( hmasks ) /= Size( pfield, 3) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_common', 'wrong size for hmasks (' // Trim( tpfield%cmnhname ) // ')' )
+ do jp = 1, Size( ycomment )
+ ycomment(jp) = Trim( tpfield%ccomment(:) ) // ' (' // Trim( hmasks(jp) ) // ')'
+ end do
else
ycomment(:) = tpfield%ccomment(:)
end if
@@ -927,7 +969,8 @@ contains
subroutine Les_diachro_common_intern( oavg, onorm )
!#######################################################################################
-use modd_field, only: NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_LES_AVG_TIME, NMNHDIM_BUDGET_LES_SV, NMNHDIM_UNUSED
+use modd_field, only: NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_LES_AVG_TIME, NMNHDIM_BUDGET_LES_MASK, &
+ NMNHDIM_BUDGET_LES_SV, NMNHDIM_UNUSED
use modd_les, only: nles_current_times
use mode_write_diachro, only: Write_diachro
@@ -935,9 +978,9 @@ use mode_write_diachro, only: Write_diachro
logical, intent(in) :: oavg
logical, intent(in) :: onorm
-character(len=10) :: ygroup ! Group title
integer :: iresp ! Return code
integer :: ji
+integer :: jk ! Vertical loop counter
integer :: jp ! Process loop counter
integer :: jsv ! Scalar loop counter
logical :: gsv
@@ -970,32 +1013,14 @@ else
zfield(:, :, :, :) = pfield(:, :, :, :)
end if
-! Time average
+! Time average (physical units remain unchanged)
iresp = 0
if ( oavg ) call Les_time_avg_4d( zfield, tzdates, iresp )
-if ( oavg ) then
- if ( onorm ) then
- ygroup = 'H_' // tpfield%cmnhname
- tzbudiachro%ccomment = Trim( tpfield%ccomment ) // ' (normalized and time averaged)'
- else
- ygroup = 'A_' // tpfield%cmnhname
- tzbudiachro%ccomment = Trim( tpfield%ccomment ) // ' (time averaged)'
- end if
-else
- if ( onorm ) then
- ygroup = 'E_' // tpfield%cmnhname
- tzbudiachro%ccomment = Trim( tpfield%ccomment ) // ' (normalized)'
- else
- ygroup = tpfield%cmnhname
- tzbudiachro%ccomment = Trim( tpfield%ccomment )
- end if
-endif
-
if ( Present( hsuffixes ) ) then
- ytitle(:) = ygroup // hsuffixes(:)
+ ytitle(:) = Trim( tpfield%cmnhname ) // '_' // hsuffixes(:)
else
- ytitle(:) = ygroup
+ ytitle(:) = tpfield%cmnhname
endif
! Write the profile
@@ -1024,25 +1049,91 @@ if ( iresp == 0 .and. any( zfield /= XUNDEF ) ) then
tzfields(:)%clongname = ytitle(:)
tzfields(:)%ccomment = ycomment(:)
- tzbudiachro%cgroupname = ygroup
- tzbudiachro%cname = ygroup
- !tzbudiachro%ccomment = DONE BEFORE
-! tzbudiachro%ctype = 'SSOL'
- tzbudiachro%ctype = 'TLES' !T for trajectory (used in Write_diachro_lfi to add trajectory terms)
- tzbudiachro%ccategory = 'LES'
- tzbudiachro%cshape = 'cartesian'
+ tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+ tzbudiachro%clevels (NLVL_CATEGORY) = 'LES_budgets'
+ tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different LES budgets'
+
+ tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .false.
+ tzbudiachro%clevels (NLVL_SUBCATEGORY) = ''
+ tzbudiachro%ccomments(NLVL_SUBCATEGORY) = ''
+
+ tzbudiachro%lleveluse(NLVL_GROUP) = .false.
+ tzbudiachro%clevels (NLVL_GROUP) = ''
+ tzbudiachro%ccomments(NLVL_GROUP) = ''
+
+ tzbudiachro%lleveluse(NLVL_SHAPE) = .true.
+ tzbudiachro%clevels (NLVL_SHAPE) = 'Cartesian'
+ tzbudiachro%ccomments(NLVL_SHAPE) = 'Cartesian domain'
+
+ tzbudiachro%lleveluse(NLVL_TIMEAVG) = .true.
+ if ( oavg ) then
+ tzbudiachro%clevels (NLVL_TIMEAVG) = 'Time_averaged'
+ tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are time averaged'
+ else
+ tzbudiachro%clevels (NLVL_TIMEAVG) = 'Not_time_averaged'
+ tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are not time averaged'
+ end if
+
+ tzbudiachro%lleveluse(NLVL_NORM) = .true.
+ if ( onorm ) then
+ tzbudiachro%clevels (NLVL_NORM) = 'Normalized'
+ !Type of normalization is stored in the attribute "normalization" in Write_diachro
+ tzbudiachro%ccomments(NLVL_NORM) = 'Values are normalized'
+ else
+ tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+ tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+ end if
+
+ !lleveluse true also if no mask dimension to allow all fields to be in the same level/place in the file
+ !(especially if the 2 situation arise in the run)
+ tzbudiachro%lleveluse(NLVL_MASK) = .true.
+ if ( tzfields(1)%ndimlist(6) == NMNHDIM_BUDGET_LES_MASK ) then
+! tzbudiachro%clevels (NLVL_MASK) = DONE AFTER
+! tzbudiachro%ccomments(NLVL_MASK) = DONE AFTER
+ else
+ tzbudiachro%clevels (NLVL_MASK) = ''
+ tzbudiachro%ccomments(NLVL_MASK) = ''
+ end if
+
tzbudiachro%lmobile = .false.
- tzbudiachro%licompress = .false.
- tzbudiachro%ljcompress = .false.
+ tzbudiachro%licompress = .true.
+ tzbudiachro%ljcompress = .true.
tzbudiachro%lkcompress = .false.
+ tzbudiachro%ltcompress = oavg
+ tzbudiachro%lnorm = onorm
tzbudiachro%nil = iil
tzbudiachro%nih = iih
tzbudiachro%njl = ijl
tzbudiachro%njh = ijh
+ !nkl and nkh values have no real meaning here except if all levels from ikl to ikh are used (and are correctly ordered)
+ !and if xles_altitudes is not used
+ !These values are not written in the netCDF files
+ !These values are written in the LFI files. They are kept for backward compatibility (and not set to default values)
tzbudiachro%nkl = ikl
tzbudiachro%nkh = ikh
- call Write_diachro( tpdiafile, tzbudiachro, tzfields, tzdates, zwork6 )
+ if ( tzfields(1)%ndimlist(6) == NMNHDIM_BUDGET_LES_MASK ) then
+ tzfields(:)%ndimlist(6) = NMNHDIM_UNUSED
+
+ ! Loop on the different masks
+ ! Do not provide all tzfields once because they can be stored in different HDF groups (based on masks)
+ do jp = 1, Size( hmasks )
+ tzfields(jp)%clongname = Trim( ytitle(jp) ) // ' (' // Trim( hmasks(jp) ) // ')'
+ tzfields(jp)%ndims = tzfields(jp)%ndims - 1
+
+ tzbudiachro%clevels(NLVL_MASK) = hmasks(jp)
+ tzbudiachro%ccomments(NLVL_MASK) = ''
+
+ call Write_diachro( tpdiafile, tzbudiachro, [ tzfields(jp) ], tzdates, zwork6(:,:,:,:,:,jp:jp) )
+ end do
+ else
+ !Set to the same value ('cart') than for the fields with no mask in Write_les_n
+ !to put the fields in the same position of the netCDF file
+ tzbudiachro%clevels(NLVL_MASK) = 'cart'
+
+ call Write_diachro( tpdiafile, tzbudiachro, tzfields, tzdates, zwork6 )
+ end if
+
end if
!-------------------------------------------------------------------------------
@@ -1128,6 +1219,11 @@ type(tfield_metadata_base) :: tzfield
allocate( tzdates( NLES_CURRENT_TIMES ) )
tzdates(:) = tles_dates(:)
+iil = nles_current_iinf
+iih = nles_current_isup
+ijl = nles_current_jinf
+ijh = nles_current_jsup
+
ikl = 1
ikh = nspectra_k
@@ -1137,11 +1233,6 @@ tzfield = tpfield
if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_2PTS_NI ) then
Allocate( zwork6(Size( pfield, 1 ), 1, nspectra_k, nles_current_times, 1, 1) )
- iil = nles_current_iinf
- iih = nles_current_isup
- ijl = 1
- ijh = 1
-
do jt = 1, Size( pfield, 3 )
do jk = 1, Size( pfield, 2 )
zwork6(:, 1, jk, jt, 1, 1) = pfield (:, jk, jt)
@@ -1161,11 +1252,6 @@ if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_2PTS_NI ) then
else if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_2PTS_NJ ) then
Allocate( zwork6(1, Size( pfield, 1 ), nspectra_k, nles_current_times, 1, 1) )
- iil = 1
- iih = 1
- ijl = nles_current_jinf
- ijh = nles_current_jsup
-
do jt = 1, Size( pfield, 3 )
do jk = 1, Size( pfield, 2 )
zwork6(1, :, jk, jt, 1, 1) = pfield (:, jk, jt)
@@ -1191,7 +1277,7 @@ tzfield%cmnhname = ygroup
tzfield%clongname = ygroup
tzfield%ccomment = ycomment(:)
-!* time average
+!* time average (physical units remain unchanged)
iresp = 0
if ( gavg ) then
call Les_time_avg( zwork6, tzdates, iresp )
@@ -1202,24 +1288,60 @@ if ( gavg ) then
end do
end if
-tzbudiachro%cgroupname = ygroup
-tzbudiachro%cname = ygroup
-if ( .not. gavg ) then
- tzbudiachro%ccomment = tzfield%ccomment
+tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+tzbudiachro%clevels (NLVL_CATEGORY) = 'LES_budgets'
+tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different LES budgets'
+
+tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .false.
+tzbudiachro%clevels (NLVL_SUBCATEGORY) = ''
+tzbudiachro%ccomments(NLVL_SUBCATEGORY) = ''
+
+tzbudiachro%lleveluse(NLVL_GROUP) = .false.
+tzbudiachro%clevels (NLVL_GROUP) = ''
+tzbudiachro%ccomments(NLVL_GROUP) = ''
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .true.
+tzbudiachro%clevels (NLVL_SHAPE) = 'Two_point_correlation'
+tzbudiachro%ccomments(NLVL_SHAPE) = ''
+
+tzbudiachro%lleveluse(NLVL_TIMEAVG) = .true.
+if ( gavg ) then
+ tzbudiachro%clevels (NLVL_TIMEAVG) = 'Time_averaged'
+ tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are time averaged'
+else
+ tzbudiachro%clevels (NLVL_TIMEAVG) = 'Not_time_averaged'
+ tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are not time averaged'
+end if
+
+tzbudiachro%lleveluse(NLVL_NORM) = .true.
+tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+
+tzbudiachro%lleveluse(NLVL_MASK) = .false.
+tzbudiachro%clevels (NLVL_MASK) = ''
+tzbudiachro%ccomments(NLVL_MASK) = ''
+
+if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_2PTS_NI ) then
+ tzbudiachro%cdirection = 'I'
else
- tzbudiachro%ccomment = Trim( tzfield%ccomment ) // ' (time averaged)'
+ tzbudiachro%cdirection = 'J'
end if
-tzbudiachro%ctype = 'SPXY'
-tzbudiachro%ccategory = 'LES'
-tzbudiachro%cshape = 'spectrum'
tzbudiachro%lmobile = .false.
+!i/j/k compression has no meaning here as it is 2-point correlations
+!These values are not written in the netCDF files
+!These values are written in the LFI files. They are kept for backward compatibility with these values
tzbudiachro%licompress = .false.
tzbudiachro%ljcompress = .false.
tzbudiachro%lkcompress = .false.
+tzbudiachro%ltcompress = gavg
+tzbudiachro%lnorm = .false.
tzbudiachro%nil = iil
tzbudiachro%nih = iih
tzbudiachro%njl = ijl
tzbudiachro%njh = ijh
+!nkl and nkh values have no real meaning here
+!These values are not written in the netCDF files
+!These values are written in the LFI files. They are kept for backward compatibility (and not set to default values)
tzbudiachro%nkl = ikl
tzbudiachro%nkh = ikh
@@ -1295,6 +1417,11 @@ type(tfield_metadata_base) :: tzfield
allocate( tzdates( nles_current_times ) )
tzdates(:) = tles_dates(:)
+iil = nles_current_iinf
+iih = nles_current_isup
+ijl = nles_current_jinf
+ijh = nles_current_jsup
+
ikl = 1
ikh = nspectra_k
@@ -1307,11 +1434,6 @@ tzfield = tpfield
if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_SPEC_NI ) then
Allocate( zwork6(Size( pspectra, 1 ), 1, nspectra_k, nles_current_times, 2, 1) )
- iil = nles_current_iinf
- iih = nles_current_isup
- ijl = 1
- ijh = 1
-
do jt = 1, Size( pspectra, 4 )
do jk = 1, Size( pspectra, 3 )
zwork6(:, 1, jk, jt, 1, 1) = pspectra (:, 1, jk, jt)
@@ -1332,11 +1454,6 @@ if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_SPEC_NI ) then
else if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_SPEC_NJ ) then
Allocate( zwork6( 1, Size( pspectra, 1 ), nspectra_k, nles_current_times, 2, 1 ) )
- iil = 1
- iih = 1
- ijl = nles_current_jinf
- ijh = nles_current_jsup
-
do jt = 1, Size( pspectra, 4 )
do jk = 1, Size( pspectra, 3 )
zwork6(1, :, jk, jt, 1, 1) = pspectra (:, 1, jk, jt)
@@ -1362,48 +1479,117 @@ tzfield%cmnhname = ygroup
tzfield%clongname = ygroup
tzfield%ccomment = ycomment(:)
-tzbudiachro%cgroupname = ygroup
-tzbudiachro%cname = ygroup
-tzbudiachro%ccomment = tzfield%ccomment
-tzbudiachro%ctype = 'SPXY'
-tzbudiachro%ccategory = 'LES'
-tzbudiachro%cshape = 'spectrum'
+tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+tzbudiachro%clevels (NLVL_CATEGORY) = 'LES_budgets'
+tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different LES budgets'
+
+tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .false.
+tzbudiachro%clevels (NLVL_SUBCATEGORY) = ''
+tzbudiachro%ccomments(NLVL_SUBCATEGORY) = ''
+
+tzbudiachro%lleveluse(NLVL_GROUP) = .false.
+tzbudiachro%clevels (NLVL_GROUP) = ''
+tzbudiachro%ccomments(NLVL_GROUP) = ''
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .true.
+tzbudiachro%clevels (NLVL_SHAPE) = 'Spectrum'
+tzbudiachro%ccomments(NLVL_SHAPE) = ''
+
+tzbudiachro%lleveluse(NLVL_TIMEAVG) = .true.
+tzbudiachro%clevels (NLVL_TIMEAVG) = 'Not_time_averaged'
+tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are not time averaged'
+
+tzbudiachro%lleveluse(NLVL_NORM) = .true.
+tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+
+tzbudiachro%lleveluse(NLVL_MASK) = .false.
+tzbudiachro%clevels (NLVL_MASK) = ''
+tzbudiachro%ccomments(NLVL_MASK) = ''
+
+if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_SPEC_NI ) then
+ tzbudiachro%cdirection = 'I'
+else
+ tzbudiachro%cdirection = 'J'
+end if
tzbudiachro%lmobile = .false.
+!i/j/k compression has no meaning here as it is spectrum
+!These values are not written in the netCDF files
+!These values are written in the LFI files. They are kept for backward compatibility with these values
tzbudiachro%licompress = .false.
tzbudiachro%ljcompress = .false.
tzbudiachro%lkcompress = .false.
+tzbudiachro%ltcompress = .false.
+tzbudiachro%lnorm = .false.
tzbudiachro%nil = iil
tzbudiachro%nih = iih
tzbudiachro%njl = ijl
tzbudiachro%njh = ijh
+!nkl and nkh values have no real meaning here
+!These values are not written in the netCDF files
+!These values are written in the LFI files. They are kept for backward compatibility (and not set to default values)
tzbudiachro%nkl = ikl
tzbudiachro%nkh = ikh
call Write_diachro( tpdiafile, tzbudiachro, [ tzfield ], tzdates, zwork6 )
!
-!* time average
+!* time average (physical units remain unchanged)
!
iresp = 0
call Les_time_avg( zwork6, tzdates, iresp )
-ygroup = 'T_' // ygroup
do ji = 1, NMNHMAXDIMS
if ( tzfield%ndimlist(ji) == NMNHDIM_BUDGET_LES_TIME ) tzfield%ndimlist(ji) = NMNHDIM_BUDGET_LES_AVG_TIME
end do
-tzbudiachro%cgroupname = ygroup
-tzbudiachro%cname = ygroup
-tzbudiachro%ccomment = Trim( tzfield%ccomment ) // ' (time averaged)'
-tzbudiachro%ctype = 'SPXY'
-tzbudiachro%ccategory = 'LES'
-tzbudiachro%cshape = 'spectrum'
+tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+tzbudiachro%clevels (NLVL_CATEGORY) = 'LES_budgets'
+tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different LES budgets'
+
+tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .false.
+tzbudiachro%clevels (NLVL_SUBCATEGORY) = ''
+tzbudiachro%ccomments(NLVL_SUBCATEGORY) = ''
+
+tzbudiachro%lleveluse(NLVL_GROUP) = .false.
+tzbudiachro%clevels (NLVL_GROUP) = ''
+tzbudiachro%ccomments(NLVL_GROUP) = ''
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .true.
+tzbudiachro%clevels (NLVL_SHAPE) = 'Spectrum'
+tzbudiachro%ccomments(NLVL_SHAPE) = ''
+
+tzbudiachro%lleveluse(NLVL_TIMEAVG) = .true.
+tzbudiachro%clevels (NLVL_TIMEAVG) = 'Time_averaged'
+tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are time averaged'
+
+tzbudiachro%lleveluse(NLVL_NORM) = .true.
+tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+
+tzbudiachro%lleveluse(NLVL_MASK) = .false.
+tzbudiachro%clevels (NLVL_MASK) = ''
+tzbudiachro%ccomments(NLVL_MASK) = ''
+
+if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_SPEC_NI ) then
+ tzbudiachro%cdirection = 'I'
+else
+ tzbudiachro%cdirection = 'J'
+end if
tzbudiachro%lmobile = .false.
+!i/j/k compression has no meaning here as it is spectrum
+!These values are not written in the netCDF files
+!These values are written in the LFI files. They are kept for backward compatibility with these values
tzbudiachro%licompress = .false.
tzbudiachro%ljcompress = .false.
tzbudiachro%lkcompress = .false.
+tzbudiachro%ltcompress = .true.
+tzbudiachro%lnorm = .false.
tzbudiachro%nil = iil
tzbudiachro%nih = iih
tzbudiachro%njl = ijl
tzbudiachro%njh = ijh
+!nkl and nkh values have no real meaning here
+!These values are not written in the netCDF files
+!These values are written in the LFI files. They are kept for backward compatibility (and not set to default values)
tzbudiachro%nkl = ikl
tzbudiachro%nkh = ikh
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index 91b86154ebc81cc6916f2c245bb57367683a7ae0..238c707f92a83d883cbb2f98e311fb3f3c3fe4da 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -270,8 +270,8 @@ END MODULE MODI_MODEL_n
! 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)
+! 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
@@ -314,7 +314,7 @@ USE MODD_FRC_n
USE MODD_GET_n
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODD_GRID_n
-USE MODD_IBM_PARAM_n !, ONLY : LIBM, LIBM_TROUBLE, CIBM_ADV, XT_IBM_FORC, XIBM_LS
+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,15 +342,14 @@ USE MODD_PARAM_LIMA, ONLY: MSEDC => LSEDC, MWARM => LWARM, MRAIN => LRAIN, &
XRTMIN_LIMA=>XRTMIN, MACTTKE=>LACTTKE
USE MODD_PARAM_MFSHALL_n
USE MODD_PARAM_n
-USE MODD_PASPOL, ONLY : LPASPOL
USE MODD_PAST_FIELD_n
USE MODD_PRECIP_n
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
-USE MODD_REF
+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
@@ -2123,7 +2122,7 @@ IF (LPROFILER) &
CALL PROFILER_n(XTSTEP, &
XXHAT, XYHAT, XZZ,XRHODREF, &
XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST, &
- XAER, XCLDFR, XCIT)
+ XAER, XCLDFR, XCIT,PSEA=ZSEA(:,:))
!
!
CALL SECOND_MNH2(ZTIME2)
diff --git a/src/MNH/modn_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 43d1f326be9763663dde2b5a225918b87fb757e3..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
@@ -112,7 +110,7 @@ CHARACTER(LEN=5),SAVE :: CPRESOPT
INTEGER ,SAVE :: NITR
LOGICAL ,SAVE :: LITRADJ
LOGICAL ,SAVE :: LRES
-LOGICAL ,SAVE :: LOCEAN
+LOGICAL ,SAVE :: LOCEAN
REAL ,SAVE :: XRES
REAL ,SAVE :: XRELAX
LOGICAL, SAVE :: LHORELAX_UVWTH
diff --git a/src/MNH/modn_eol.f90 b/src/MNH/modn_eol.f90
index e9ded370931082c900a32f6f206af3130519129d..c232ce3baf7cedf3a0e8fffa4204b7a46a8a3dca 100644
--- a/src/MNH/modn_eol.f90
+++ b/src/MNH/modn_eol.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
!!
!! #####################
MODULE MODN_EOL
diff --git a/src/MNH/modn_eol_adnr.f90 b/src/MNH/modn_eol_adnr.f90
index b5767e37f73d97e98cde58d91dbe7cfe15d90b70..3e3c77cec046bd2bf1754362f815d0b06df362d4 100644
--- a/src/MNH/modn_eol_adnr.f90
+++ b/src/MNH/modn_eol_adnr.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/modn_eol_alm.f90 b/src/MNH/modn_eol_alm.f90
index c7aa7e613f39b540d1d713d3998e21be74de39b4..54f7a389bda529ce0ea80fac0fd6ff62124d4b18 100644
--- a/src/MNH/modn_eol_alm.f90
+++ b/src/MNH/modn_eol_alm.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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
diff --git a/src/MNH/modn_frc.f90 b/src/MNH/modn_frc.f90
index 50577a0e77e5344617a74c9923a86779f4ad434b..42e04d16e941a48f3483e5e49a5666dd7c0ef953 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
! ###############
@@ -19,9 +14,9 @@
! This module contains the following control parameters are used
! by FORCING:
! - LGEOST_UV_FRC and LGEOST_TH_FRC
-! - LTEND_THRV_FRC
-! - LVERT_MOTION_FRC
-! - LRELAX_THRV_FRC and LRELAX_UV_FRC using:
+! - LTEND_THRV_FRC and LTEND_UV_FRC
+! - LVERT_MOTION_FRC
+! - LRELAX_THRV_FRC, LRELAX_UV_FRC and LRELAX_UVMEAN_FRC using:
! XRELAX_TIME_FRC, XRELAX_HEIGHT_FRC and CRELAX_HEIGHT_TYPE
! - LTRANS
! XUTRANS, XVTRANS
@@ -48,6 +43,7 @@
!! add SST and surf pressure forcing
!! 06/2003 (V. Masson) removes SST forcing (externalisation of surface)
!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 06/2021 F.Couvreux add LRELAX_UVMEAN_FRC
!-------------------------------------------------------------------------------
USE MODD_FRC
!
@@ -60,6 +56,7 @@ NAMELIST /NAM_FRC/ LGEOST_UV_FRC , &
LVERT_MOTION_FRC , &
LRELAX_THRV_FRC , &
LRELAX_UV_FRC , &
+ LRELAX_UVMEAN_FRC , &
XRELAX_TIME_FRC , &
XRELAX_HEIGHT_FRC , &
CRELAX_HEIGHT_TYPE , &
diff --git a/src/MNH/modn_ibm_paramn.f90 b/src/MNH/modn_ibm_paramn.f90
index 33fcce52f5d8102d5f1739cf0e5ebb8cfe14eeae..a17e89362b9ae1945f9f5a7670ab7f7af82e9b28 100644
--- a/src/MNH/modn_ibm_paramn.f90
+++ b/src/MNH/modn_ibm_paramn.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/modn_nesting.f90 b/src/MNH/modn_nesting.f90
index f7c12be2aa19db9db935d420c161d3746d1f0174..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
! ###################
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
index 8689091addeaa41455f5142db0ff32efc5f14ae1..fbe4cf57671ac025b45799a14c88e53458838c80 100644
--- a/src/MNH/modn_recycl_paramn.f90
+++ b/src/MNH/modn_recycl_paramn.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/modn_stationn.f90 b/src/MNH/modn_stationn.f90
index 5abbe7c92c81a651353976372e70e9ba1b68375f..6715b3c645ea69132add98d2d21a4371fd3fd78c 100644
--- a/src/MNH/modn_stationn.f90
+++ b/src/MNH/modn_stationn.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
diff --git a/src/MNH/modn_turbn.f90 b/src/MNH/modn_turbn.f90
index 952412dbecf3384c8be245b0561f1447719cd0e6..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
! ###################
diff --git a/src/MNH/nhoa_coupln.f90 b/src/MNH/nhoa_coupln.f90
index 78810dea127ab5c4a7752bbbfcaf6ebecb719931..f8ea30639b021065de23652e151303524f0644f4 100644
--- a/src/MNH/nhoa_coupln.f90
+++ b/src/MNH/nhoa_coupln.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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/one_wayn.f90 b/src/MNH/one_wayn.f90
index 07ce225e37fe62abba178b9a61959628efac9a87..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,7 +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_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, &
@@ -140,7 +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, ONLY: LCOUPLES
USE MODD_REF_n, only: XRHODJ, XRHODREF, XRVREF, XTHVREF
!
use mode_bikhardt
@@ -807,7 +807,7 @@ DEALLOCATE(ZWORK)
DEALLOCATE(ZCOEFLIN_LBXM_RED,ZCOEFLIN_LBYM_RED,IKLIN_LBXM_RED,IKLIN_LBYM_RED)
!
!------------------------------------------------------------------------------
-ENDIF ! END LCOUPLES couplage
+ENDIF ! END LCOUPLES coupling
!
CALL GOTO_MODEL(KMI)
!
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 c89380368cc5d84eb2e496438906c323c576648a..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
! #################
@@ -117,16 +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_DYN_n, ONLY : LOCEAN
-USE MODD_REF, ONLY : LBOUSS
+USE MODD_REF, ONLY: LBOUSS
!
USE MODE_ll
-!JUAN
USE MODE_REPRO_SUM
-!JUAN
-USE MODD_IBM_PARAM_n, ONLY : XIBM_LS, LIBM, XIBM_EPSI
-!
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -383,18 +376,17 @@ ELSEIF( CEQNSYS == 'LHE' ) THEN
ZMASSGUESS = SUM_DD_R2_ll(ZMASSGUESS_2D)
ZWATERMASST = SUM_DD_R2_ll(ZWATERMASST_2D)
!
-!
-! 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
-!
+ ! 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 cd03bfadb96b61bccd7d906fa7738a79dc4069cf..327f252f01893ae368664c04eb59d6faffe9bb3c 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -234,9 +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
-!! 02/2021 F.Auguste: add IBM
-!! 03/2021: JL Redelsperger Add the SW flux penetration for Ocean model case
+! 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
@@ -271,7 +271,7 @@ USE MODD_FRC
USE MODD_FRC_n
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IBM_PARAM_n, ONLY: XIBM_LS, LIBM, XIBM_EPSI
+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
@@ -299,8 +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_REF, ONLY : LCOUPLES
+USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_REF, ONLY: LCOUPLES
USE MODD_REF_n
USE MODD_SALT
USE MODD_SHADOWS_n
diff --git a/src/MNH/prandtl.f90 b/src/MNH/prandtl.f90
index fa9aade6145431a2df5e5d5f8e366481b9c4575a..fbfe0a7621714cebb151faee288c99338a4a555b 100644
--- a/src/MNH/prandtl.f90
+++ b/src/MNH/prandtl.f90
@@ -196,9 +196,9 @@ END MODULE MODI_PRANDTL
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
-USE MODD_DYN_n, ONLY : LOCEAN
+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
diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90
index ffae04e797d279e43e196855fdbd4ea54cb72e46..3e5ea35b14a4343165833fcc22e6f09c9d624be0 100644
--- a/src/MNH/prep_ideal_case.f90
+++ b/src/MNH/prep_ideal_case.f90
@@ -318,7 +318,7 @@
! 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
+! 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
!-------------------------------------------------------------------------------
@@ -333,8 +333,8 @@ USE MODD_CONF
USE MODD_CST
USE MODD_GRID
USE MODD_GRID_n
-USE MODD_IBM_LSF, ONLY: LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
-USE MODD_IBM_PARAM_n, ONLY : XIBM_LS
+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
@@ -1373,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' )
@@ -1667,12 +1667,12 @@ IF (CIDEAL == 'RSOU') THEN
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
+ 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)
@@ -1739,7 +1739,7 @@ IF (LIBM_LSF) THEN
! 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 terrain')
+ 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))
diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90
index d60b32e48fc9308e97812251a8dcf5029ddbc07d..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,16 +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
+! T.Nagel 02/2021: add IBM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -403,8 +409,8 @@ USE MODD_GR_FIELD_n
USE MODD_GRID
USE MODD_GRID_n
USE MODD_HURR_CONF
-USE MODD_IBM_LSF, ONLY: LIBM_LSF,CIBM_TYPE, NIBM_SMOOTH,XIBM_SMOOTH
-USE MODD_IBM_PARAM_n
+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
@@ -446,6 +452,7 @@ 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
@@ -455,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
@@ -471,6 +479,7 @@ USE MODI_WRITE_LFIFM_n
!
USE MODN_CONF, ONLY: JPHEXT , NHALO
USE MODN_CONFZ
+USE MODN_PARAM_LIMA
!
IMPLICIT NONE
!
@@ -481,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
@@ -581,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
!
@@ -621,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)
!
@@ -757,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)
@@ -895,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
!
@@ -983,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
!
@@ -1027,15 +1057,15 @@ ZDIAG = ZDIAG + ZTIME2 - ZTIME1
!* 16. INITIALIZE LEVELSET FOR IBM
! ---------------------------
!
-CALL GET_DIM_EXT_ll('B',NIU,NJU)
-NKU=NKMAX+2*JPVEXT
-!
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)
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 23c74074db140ad39a6145cf95b1a7d7657ec246..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.
@@ -233,7 +233,7 @@ USE MODD_CST
USE MODD_CONF
USE MODD_DYN_n, ONLY: LRES, XRES,LOCEAN
USE MODD_FIELD_n, ONLY: XPHIT
-USE MODD_IBM_PARAM_n, ONLY : XIBM_LS,XIBM_SU,LIBM,NIBM_ITR,XIBM_EPSI
+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
diff --git a/src/MNH/profilern.f90 b/src/MNH/profilern.f90
index 05f09d32850add426ffe5d97336c3388b6da86f2..f91695cd03a4bc5a6bfd7fc3e806daed877a3ea7 100644
--- a/src/MNH/profilern.f90
+++ b/src/MNH/profilern.f90
@@ -12,7 +12,7 @@ INTERFACE
SUBROUTINE PROFILER_n(PTSTEP, &
PXHAT, PYHAT, PZ,PRHODREF, &
PU, PV, PW, PTH, PR, PSV, PTKE, &
- PTS,PP, PAER, PCLDFR, PCIT)
+ PTS,PP, PAER, PCLDFR, PCIT,PSEA)
!
REAL, INTENT(IN) :: PTSTEP ! time step
REAL, DIMENSION(:), INTENT(IN) :: PXHAT ! x coordinate
@@ -31,6 +31,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! pressure
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PAER ! aerosol extinction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! ice concentration
+REAL, DIMENSION(:,:),INTENT(IN) :: PSEA ! for radar
!
!-------------------------------------------------------------------------------
!
@@ -44,7 +45,7 @@ END MODULE MODI_PROFILER_n
SUBROUTINE PROFILER_n(PTSTEP, &
PXHAT, PYHAT, PZ,PRHODREF, &
PU, PV, PW, PTH, PR, PSV, PTKE, &
- PTS, PP, PAER, PCLDFR, PCIT)
+ PTS, PP, PAER, PCLDFR, PCIT, PSEA)
! ########################################################
!
!
@@ -83,7 +84,7 @@ END MODULE MODI_PROFILER_n
!! March,28, 2018 (P. Wautelet) replace TEMPORAL_DIST by DATETIME_DISTANCE
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
-!
+! M.Taufour 07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -107,6 +108,31 @@ USE MODI_GPS_ZENITH_GRID
USE MODI_LIDAR
USE MODI_RADAR_RAIN_ICE
USE MODI_WATER_SUM
+USE MODE_FGAU, ONLY : GAULAG
+USE MODE_FSCATTER, ONLY: QEPSW,QEPSI,BHMIE,MOMG,MG
+USE MODD_PARAM_LIMA, ONLY: XALPHAR_L=>XALPHAR,XNUR_L=>XNUR,XALPHAS_L=>XALPHAS,XNUS_L=>XNUS,&
+ XALPHAG_L=>XALPHAG,XNUG_L=>XNUG, XALPHAI_L=>XALPHAI,XNUI_L=>XNUI,&
+ XRTMIN_L=>XRTMIN,XALPHAC_L=>XALPHAC,XNUC_L=>XNUC
+USE MODD_PARAM_LIMA_COLD, ONLY: XDI_L=>XDI,XLBEXI_L=>XLBEXI,XLBI_L=>XLBI,XAI_L=>XAI,XBI_L=>XBI,XC_I_L=>XC_I,&
+ XLBEXS_L=>XLBEXS,XLBS_L=>XLBS,XCCS_L=>XCCS,&
+ XAS_L=>XAS,XBS_L=>XBS,XCXS_L=>XCXS
+USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L=>XCCG,&
+ XAG_L=>XAG,XBG_L=>XBG,XCXG_L=>XCXG,XCG_L=>XCG
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBEXR_L=>XLBEXR,XLBR_L=>XLBR,XBR_L=>XBR,XAR_L=>XAR,&
+ XBC_L=>XBC,XAC_L=>XAC
+USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XLBEXR_I=>XLBEXR,&
+ XLBR_I=>XLBR,XCCR_I=>XCCR,XBR_I=>XBR,XAR_I=>XAR,&
+ XALPHAC_I=>XALPHAC,XNUC_I=>XNUC,&
+ XLBC_I=>XLBC,XBC_I=>XBC,XAC_I=>XAC,&
+ XALPHAC2_I=>XALPHAC2,XNUC2_I=>XNUC2,&
+ XALPHAS_I=>XALPHAS,XNUS_I=>XNUS,XLBEXS_I=>XLBEXS,&
+ XLBS_I=>XLBS,XCCS_I=>XCCS,XAS_I=>XAS,XBS_I=>XBS,XCXS_I=>XCXS,&
+ XALPHAG_I=>XALPHAG,XNUG_I=>XNUG,XDG_I=>XDG,XLBEXG_I=>XLBEXG,&
+ XLBG_I=>XLBG,XCCG_I=>XCCG,XAG_I=>XAG,XBG_I=>XBG,XCXG_I=>XCXG,XCG_I=>XCG,&
+ XALPHAI_I=>XALPHAI,XNUI_I=>XNUI,XDI_I=>XDI,XLBEXI_I=>XLBEXI,&
+ XLBI_I=>XLBI,XAI_I=>XAI,XBI_I=>XBI,XC_I_I=>XC_I,&
+ XRTMIN_I=>XRTMIN,XCONC_LAND,XCONC_SEA
+!
!
IMPLICIT NONE
!
@@ -131,6 +157,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PP ! pressure
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PAER ! aerosol extinction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! cloud fraction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! ice concentration
+REAL, DIMENSION(:,:),INTENT(IN) :: PSEA ! for radar
!
!-------------------------------------------------------------------------------
!
@@ -195,10 +222,33 @@ INTEGER :: I ! loop for stations
!
REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2)) :: ZZTD,ZZHD,ZZWD
REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZTEMP,ZRARE,ZTHV,ZTEMPV
-REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZWORK32,ZWORK33,ZWORK34,ZCIT
+REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZWORK32,ZWORK33,ZWORK34
REAL,DIMENSION(SIZE(PTH,1),SIZE(PTH,2),SIZE(PTH,3)) :: ZVISI,ZVISIKUN
REAL :: ZK1,ZK2,ZK3 ! k1, k2 and K3 atmospheric refractivity constants
REAL :: ZRDSRV ! XRD/XRV
+!
+! specific to cloud radar
+INTEGER :: JLOOP,JLOOP2 ! loop counter
+REAL, DIMENSION(SIZE(PR,3)) :: ZTEMPZ! vertical profile of temperature
+REAL, DIMENSION(SIZE(PR,3)) :: ZRHODREFZ ! vertical profile of dry air density of the reference state
+REAL, DIMENSION(SIZE(PR,3)) :: ZCIT ! pristine ice concentration
+REAL, DIMENSION(SIZE(PR,3)) :: ZCCI,ZCCR,ZCCC ! ICE,RAIN CLOUD concentration (LIMA)
+REAL, DIMENSION(SIZE(PR,1),SIZE(PR,2),SIZE(PR,3)) :: ZR
+REAL, DIMENSION(SIZE(PR,3),SIZE(PR,4)+1) :: ZRZ ! vertical profile of hydrometeor mixing ratios
+REAL :: ZA,ZB,ZCC,ZCX,ZALPHA,ZNU,ZLB,ZLBEX,ZRHOHYD,XLAM_CRAD ! generic microphysical parameters
+INTEGER :: JJ ! loop counter for quadrature
+COMPLEX :: QMW,QMI,QM,QB,QEPSIW,QEPSWI ! dielectric parameter
+REAL :: ZAETOT,ZAETMP,ZREFLOC,ZQSCA,ZQBACK,ZQEXT ! temporary scattering parameters
+REAL,DIMENSION(:),ALLOCATABLE :: ZAELOC,ZZMZ ! temporary arrays
+INTEGER :: JPTS_GAULAG=9 ! number of points for Gauss-Laguerre quadrature
+REAL :: ZLBDA ! slope distribution parameter
+REAL :: ZFRAC_ICE ! ice water fraction
+REAL :: ZDELTA_EQUIV ! mass-equivalent Gauss-Laguerre point
+REAL :: ZFW ! liquid fraction
+REAL :: ZFPW ! weight for mixed-phase reflectivity
+REAL,DIMENSION(:),ALLOCATABLE :: ZX,ZW ! Gauss-Laguerre points and weights
+REAL,DIMENSION(:),ALLOCATABLE :: ZRTMIN ! local values for XRTMIN
+LOGICAL :: GCALC
!----------------------------------------------------------------------------
!
!* 2. PRELIMINARIES
@@ -211,6 +261,8 @@ ZK1 = 0.776 ! K/Pa
ZK2 = 0.704 ! K/Pa
ZK3 = 3739. ! K2/Pa
ZRDSRV=XRD/XRV
+!
+XLAM_CRAD = 3.154E-3 ! (in m) <=> 95.04 GHz = Rasta cloud radar frequency
!* 2.1 Indices
! -------
!
@@ -364,8 +416,6 @@ END IF
! --------------
!
ZTEMP(:,:,:)=PTH(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
-IF (CCLOUD(1:3)=="ICE") CALL RADAR_RAIN_ICE (PR, PCIT, PRHODREF, ZTEMP, ZRARE, ZWORK32, &
- ZWORK33, ZWORK34 )
! Theta_v
ZTHV(:,:,:) = PTH(:,:,:) / (1.+WATER_SUM(PR(:,:,:,:)))*(1.+PR(:,:,:,1)/ZRDSRV)
! virtual temperature
@@ -373,8 +423,9 @@ ZTEMPV(:,:,:)=ZTHV(:,:,:)*(PP(:,:,:)/ XP00) **(XRD/XCPD)
CALL GPS_ZENITH_GRID(PR(:,:,:,1),ZTEMP,PP,ZZTD,ZZHD,ZZWD)
! Kunkel formulation
IF (SIZE(PR,4) >= 2) THEN
+ ZVISIKUN(:,:,:) = 10E5 !default value
WHERE ( PR(:,:,:,2) /=0 )
- ZVISIKUN(:,:,:) =0.027/(PR(:,:,:,2)*PRHODREF(:,:,:))**0.88
+ ZVISIKUN(:,:,:) =0.027/(10**(-8)+(PR(:,:,:,2)/(1+PR(:,:,:,2))*PRHODREF(:,:,:)*1000))**0.88
END WHERE
END IF
! Gultepe formulation
@@ -476,7 +527,268 @@ IF (GSTORE) THEN
TPROFILER%VISIKUN(IN,:,I) = PROFILER_INTERP(ZVISIKUN)
TPROFILER%ZZ (IN,:,I) = ZZ(:)
TPROFILER%RHOD(IN,:,I) = ZRHOD(:)
- IF (SIZE(PR,4) == 6) TPROFILER%RARE(IN,:,I) = PROFILER_INTERP(ZRARE)
+ TPROFILER%CIZ(IN,:,I) = PROFILER_INTERP(PCIT)
+! add RARE
+ ! initialization CRARE and CRARE_ATT + LWC and IWC
+ TPROFILER%CRARE(IN,:,I) = 0.
+ TPROFILER%CRARE_ATT(IN,:,I) = 0.
+ TPROFILER%LWCZ (IN,:,I) = 0.
+ TPROFILER%IWCZ (IN,:,I) = 0.
+ IF (CCLOUD=="LIMA" .OR. CCLOUD=="ICE3" ) THEN ! only for ICE3 and LIMA
+ TPROFILER%LWCZ (IN,:,I) = PROFILER_INTERP((PR(:,:,:,2)+PR(:,:,:,3))*PRHODREF(:,:,:))
+ TPROFILER%IWCZ (IN,:,I) = PROFILER_INTERP((PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6))*PRHODREF(:,:,:))
+ ZTEMPZ(:)=PROFILER_INTERP(ZTEMP(:,:,:))
+ ZRHODREFZ(:)=PROFILER_INTERP(PRHODREF(:,:,:))
+ ZCIT(:)=PROFILER_INTERP(PCIT(:,:,:))
+ IF (CCLOUD=="LIMA") THEN
+ ZCCI(:)=PROFILER_INTERP(PSV(:,:,:,NSV_LIMA_NI))
+ ZCCR(:)=PROFILER_INTERP(PSV(:,:,:,NSV_LIMA_NR))
+ ZCCC(:)=PROFILER_INTERP(PSV(:,:,:,NSV_LIMA_NC))
+ ENDIF
+ DO JLOOP=3,6
+ ZRZ(:,JLOOP)=PROFILER_INTERP(PR(:,:,:,JLOOP))
+ END DO
+ DO JK=1,IKU
+ ZRZ(JK,2)=PROFILER_INTERP_2D(PR(:,:,JK,2)*PSEA(:,:)) ! becomes cloud mixing ratio over sea
+ ZRZ(JK,7)=PROFILER_INTERP_2D(PR(:,:,JK,2)*(1.-PSEA(:,:))) ! becomes cloud mixing ratio over land
+ END DO
+ ALLOCATE(ZAELOC(IKU))
+ !
+ ZAELOC(:)=0.
+ ! initialization of quadrature points and weights
+ ALLOCATE(ZX(JPTS_GAULAG),ZW(JPTS_GAULAG))
+ CALL GAULAG(JPTS_GAULAG,ZX,ZW) ! for integration over diameters
+ ! initialize minimum values
+ ALLOCATE(ZRTMIN(SIZE(PR,4)+1))
+ IF (CCLOUD == 'LIMA') THEN
+ ZRTMIN(2)=XRTMIN_L(2) ! cloud water over sea
+ ZRTMIN(3)=XRTMIN_L(3)
+ ZRTMIN(4)=XRTMIN_L(4)
+ ZRTMIN(5)=1E-10
+ ZRTMIN(6)=XRTMIN_L(6)
+ ZRTMIN(7)=XRTMIN_L(2) ! cloud water over land
+ ELSE
+ ZRTMIN(2)=XRTMIN_I(2) ! cloud water over sea
+ ZRTMIN(3)=XRTMIN_I(3)
+ ZRTMIN(4)=XRTMIN_I(4)
+ ZRTMIN(5)=1E-10
+ ZRTMIN(6)=XRTMIN_I(6)
+ ZRTMIN(7)=XRTMIN_I(2) ! cloud water over land
+ ENDIF
+ ! compute cloud radar reflectivity from vertical profiles of temperature
+ ! and mixing ratios
+ DO JK=1,IKU
+ QMW=SQRT(QEPSW(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
+ QMI=SQRT(QEPSI(ZTEMPZ(JK),XLIGHTSPEED/XLAM_CRAD))
+ DO JLOOP=2,7
+ IF (CCLOUD == 'LIMA') THEN
+ GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCCI(JK)>0.).AND.&
+ (JLOOP.NE.3.OR.ZCCR(JK)>0.).AND.((JLOOP.NE.2.AND.JLOOP.NE.7).OR.ZCCC(JK)>0.))
+ ELSE
+ GCALC=(ZRZ(JK,JLOOP)>ZRTMIN(JLOOP).AND.(JLOOP.NE.4.OR.ZCIT(JK)>0.))
+ ENDIF
+ IF(GCALC) THEN
+ SELECT CASE(JLOOP)
+ CASE(2) ! cloud water over sea
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAC_L
+ ZB=XBC_L
+ ZCC=ZCCC(JK)*ZRHODREFZ(JK)
+ ZCX=0.
+ ZALPHA=XALPHAC_L
+ ZNU=XNUC_L
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
+ ELSE
+ ZA=XAC_I
+ ZB=XBC_I
+ ZCC=XCONC_SEA
+ ZCX=0.
+ ZALPHA=XALPHAC2_I
+ ZNU=XNUC2_I
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
+ ENDIF
+ CASE(3) ! rain water
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAR_L
+ ZB=XBR_L
+ ZCC=ZCCR(JK)*ZRHODREFZ(JK)
+ ZCX=0.
+ ZALPHA=XALPHAR_L
+ ZNU=XNUR_L
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
+ ELSE
+ ZA=XAR_I
+ ZB=XBR_I
+ ZCC=XCCR_I
+ ZCX=-1.
+ ZALPHA=XALPHAR_I
+ ZNU=XNUR_I
+ ZLB=XLBR_I
+ ZLBEX=XLBEXR_I
+ ENDIF
+ CASE(4) ! pristine ice
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAI_L
+ ZB=XBI_L
+ ZCC=ZCCI(JK)*ZRHODREFZ(JK)
+ ZCX=0.
+ ZALPHA=XALPHAI_L
+ ZNU=XNUI_L
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX) ! because ZCC not included in XLBI
+ ZFW=0
+ ELSE
+ ZA=XAI_I
+ ZB=XBI_I
+ ZCC=ZCIT(JK)
+ ZCX=0.
+ ZALPHA=XALPHAI_I
+ ZNU=XNUI_I
+ ZLBEX=XLBEXI_I
+ ZLB=XLBI_I*ZCC**(-ZLBEX) ! because ZCC not included in XLBI
+ ZFW=0
+ ENDIF
+ CASE(5) ! snow
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAS_L
+ ZB=XBS_L
+ ZCC=XCCS_L
+ ZCX=XCXS_L
+ ZALPHA=XALPHAS_L
+ ZNU=XNUS_L
+ ZLB=XLBS_L
+ ZLBEX=XLBEXS_L
+ ZFW=0
+ ELSE
+ ZA=XAS_I
+ ZB=XBS_I
+ ZCC=XCCS_I
+ ZCX=XCXS_I
+ ZALPHA=XALPHAS_I
+ ZNU=XNUS_I
+ ZLB=XLBS_I
+ ZLBEX=XLBEXS_I
+ ZFW=0
+ ENDIF
+ CASE(6) ! graupel
+ !If temperature between -10 and 10B0C and Mr and Mg over min
+ !threshold: melting graupel
+ ! with liquid water fraction Fw=Mr/(Mr+Mg) else dry graupel
+ ! (Fw=0)
+ IF( ZTEMPZ(JK) > XTT-10 .AND. ZTEMPZ(JK) < XTT+10 &
+ .AND. ZRZ(JK,3) > ZRTMIN(3) ) THEN
+ ZFW=ZRZ(JK,3)/(ZRZ(JK,3)+ZRZ(JK,JLOOP))
+ ELSE
+ ZFW=0
+ ENDIF
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAG_L
+ ZB=XBG_L
+ ZCC=XCCG_L
+ ZCX=XCXG_L
+ ZALPHA=XALPHAG_L
+ ZNU=XNUG_L
+ ZLB=XLBG_L
+ ZLBEX=XLBEXG_L
+ ELSE
+ ZA=XAG_I
+ ZB=XBG_I
+ ZCC=XCCG_I
+ ZCX=XCXG_I
+ ZALPHA=XALPHAG_I
+ ZNU=XNUG_I
+ ZLB=XLBG_I
+ ZLBEX=XLBEXG_I
+ ENDIF
+ CASE(7) ! cloud water over land
+ IF (CCLOUD == 'LIMA') THEN
+ ZA=XAC_L
+ ZB=XBC_L
+ ZCC=ZCCC(JK)*ZRHODREFZ(JK)
+ ZCX=0.
+ ZALPHA=XALPHAC_L
+ ZNU=XNUC_L
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
+ ELSE
+ ZA=XAC_I
+ ZB=XBC_I
+ ZCC=XCONC_LAND
+ ZCX=0.
+ ZALPHA=XALPHAC_I
+ ZNU=XNUC_I
+ ZLBEX=1.0/(ZCX-ZB)
+ ZLB=( ZA*ZCC*MOMG(ZALPHA,ZNU,ZB) )**(-ZLBEX)
+ ENDIF
+ END SELECT
+ ZLBDA=ZLB*(ZRHODREFZ(JK)*ZRZ(JK,JLOOP))**ZLBEX
+ ZREFLOC=0.
+ ZAETMP=0.
+ DO JJ=1,JPTS_GAULAG ! Gauss-Laguerre quadrature
+ ZDELTA_EQUIV=ZX(JJ)**(1./ZALPHA)/ZLBDA
+ SELECT CASE(JLOOP)
+ CASE(2,3,7)
+ QM=QMW
+ CASE(4,5,6)
+ ! pristine ice, snow, dry graupel
+ ZRHOHYD=MIN(6.*ZA*ZDELTA_EQUIV**(ZB-3.)/XPI,.92*XRHOLW)
+ QM=sqrt(MG(QMI**2,CMPLX(1,0),ZRHOHYD/.92/XRHOLW))
+ ! water inclusions in ice in air
+ QEPSWI=MG(QMW**2,QM**2,ZFW)
+ ! ice in air inclusions in water
+ QEPSIW=MG(QM**2,QMW**2,1.-ZFW)
+ !MG weighted rule (Matrosov 2008)
+ IF(ZFW .LT. 0.37) THEN
+ ZFPW=0
+ ELSE IF(ZFW .GT. 0.63) THEN
+ ZFPW=1
+ ELSE
+ ZFPW=(ZFW-0.37)/(0.63-0.37)
+ ENDIF
+ QM=sqrt(QEPSWI*(1.-ZFPW)+QEPSIW*ZFPW)
+ END SELECT
+ CALL BHMIE(XPI/XLAM_CRAD*ZDELTA_EQUIV,QM,ZQEXT,ZQSCA,ZQBACK)
+ ZREFLOC=ZREFLOC+ZQBACK*ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
+ ZAETMP =ZAETMP +ZQEXT *ZX(JJ)**(ZNU-1)*ZDELTA_EQUIV**2*ZW(JJ)
+ END DO
+ ZREFLOC=ZREFLOC*(XLAM_CRAD/XPI)**4*ZCC*ZLBDA**ZCX/(4.*GAMMA(ZNU)*.93)
+ ZAETMP=ZAETMP * XPI *ZCC*ZLBDA**ZCX/(4.*GAMMA(ZNU))
+ TPROFILER%CRARE(IN,JK,I)=TPROFILER%CRARE(IN,JK,I)+ZREFLOC
+ ZAELOC(JK)=ZAELOC(JK)+ZAETMP
+ END IF
+ END DO
+ END DO
+ ! apply attenuation
+ ALLOCATE(ZZMZ(IKU))
+ ZZMZ = ZZ(:) ! PROFILER_INTERP(ZZM(:,:,:))
+! ZZMZ(1)=ZZM_STAT
+ ! zenith
+ ZAETOT=1.
+ DO JK = 2,IKU
+ ! attenuation from ZAELOC(JK) and ZAELOC(JK-1)
+ ZAETOT=ZAETOT*EXP(-(ZAELOC(JK-1)+ZAELOC(JK))*(ZZMZ(JK)-ZZMZ(JK-1)))
+ TPROFILER%CRARE_ATT(IN,JK,I)=TPROFILER%CRARE(IN,JK,I)*ZAETOT
+ END DO
+! TPROFILER%ZZ (IN,:,I) = ZZMZ(:)
+ DEALLOCATE(ZZMZ,ZAELOC)
+ ! m^3 bmm^6/m^3 bdBZ
+ WHERE(TPROFILER%CRARE(IN,:,I)>0)
+ TPROFILER%CRARE(IN,:,I)=10.*LOG10(1.E18*TPROFILER%CRARE(IN,:,I))
+ ELSEWHERE
+ TPROFILER%CRARE(IN,:,I)=XUNDEF
+ END WHERE
+ WHERE(TPROFILER%CRARE_ATT(IN,:,I)>0)
+ TPROFILER%CRARE_ATT(IN,:,I)=10.*LOG10(1.E18*TPROFILER%CRARE_ATT(IN,:,I))
+ ELSEWHERE
+ TPROFILER%CRARE_ATT(IN,:,I)=XUNDEF
+ END WHERE
+ DEALLOCATE(ZX,ZW,ZRTMIN)
+ END IF ! end LOOP ICE3
+! end add RARE
+!!
IF (.NOT. L1D) THEN
TPROFILER%P (IN,:,I) = PROFILER_INTERP(PP(II(I):II(I)+1,IJ(I):IJ(I)+1,:))
ELSE
@@ -566,7 +878,9 @@ IF (GSTORE) THEN
CALL DISTRIBUTE_PROFILER(TPROFILER%VISI(IN,JK,I))
CALL DISTRIBUTE_PROFILER(TPROFILER%VISIKUN(IN,JK,I))
CALL DISTRIBUTE_PROFILER(TPROFILER%RHOD(IN,JK,I))
- CALL DISTRIBUTE_PROFILER(TPROFILER%RARE(IN,JK,I))
+ CALL DISTRIBUTE_PROFILER(TPROFILER%CRARE(IN,JK,I))
+ CALL DISTRIBUTE_PROFILER(TPROFILER%CRARE_ATT(IN,JK,I))
+ CALL DISTRIBUTE_PROFILER(TPROFILER%CIZ(IN,JK,I))
CALL DISTRIBUTE_PROFILER(TPROFILER%IWV(IN,I))
CALL DISTRIBUTE_PROFILER(TPROFILER%ZTD(IN,I))
CALL DISTRIBUTE_PROFILER(TPROFILER%ZHD(IN,I))
diff --git a/src/MNH/prognos_lima.f90 b/src/MNH/prognos_lima.f90
new file mode 100644
index 0000000000000000000000000000000000000000..64834850299bea38e862fe05238081fc5dac9b1a
--- /dev/null
+++ b/src/MNH/prognos_lima.f90
@@ -0,0 +1,393 @@
+!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)
+!
+PS0=MAX(PS0,-0.98)
+!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 4ab81c45c12bf4cfde9030df9730bbf779096637..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,7 +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
-!! 02/21 F.Auguste : add IBM
+! F. Auguste 02/21: add IBM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/MNH/rad_bound.f90 b/src/MNH/rad_bound.f90
index a52f823a01647b3c7b9a9771e4c7d4e0e09515d6..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
!####################
@@ -164,13 +160,13 @@ 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 MODD_RECYCL_PARAM_n
+!
+USE MODI_CPHASE_PROFILE
!
IMPLICIT NONE
!
@@ -262,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
!
@@ -295,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,:,:)+PFLUCTUNW*XRCOEFF
+ 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,:,:)+PFLUCTUNW*XRCOEFF ! 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
!
! ============================================================
@@ -330,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
!
@@ -364,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,:,:)+PFLUCTUNE*XRCOEFF
+ 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,:,:)+PFLUCTUNE*XRCOEFF
+ 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
!
! ============================================================
@@ -401,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
!
@@ -432,12 +444,20 @@ SELECT CASE ( HLBCY(1) )
IF ( SIZE(PLBYVS,1) == 0 ) THEN
ZLBEV (:,:) = 0.
ZLBGV (:,:) = PLBYVM(:,JPHEXT+1,:) - PLBYVM(:,JPHEXT,:)
- ZLBYV(:,:) = PLBYVM(:,JPHEXT,:)+PFLUCTVNS*XRCOEFF
+ 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,:)+PFLUCTVNS*XRCOEFF
+ IF ( LRECYCL ) THEN
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PTSTEP * PLBYVS(:,JPHEXT,:) + PFLUCTVNS * XRCOEFF
+ ELSE
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PTSTEP * PLBYVS(:,JPHEXT,:)
+ END IF
END IF
!
! ============================================================
@@ -467,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
!
@@ -500,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,:)+PFLUCTVNN*XRCOEFF
+ 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,:)+PFLUCTVNN*XRCOEFF
+ 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 b22d8031330c82462f7a1c5c4f2960ce7846e9c1..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.
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index a9bfe910472e0eab776f7a1717ae70b447dd877e..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,8 +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(:,:,:), &
- PRSS(:,:,:)*0., PRGS(:,:,:)*0.)
+ 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
diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index ac0a25a26470089a88c7b43e6ef8601bbf6b673c..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.
@@ -72,15 +72,15 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. s
REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRGS ! Graupel m.r. source
!
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRC! Cloud instant precip
+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(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PSIGS ! Sigma_s at t
+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
@@ -338,15 +338,15 @@ REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. sou
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(KIT,KJT), INTENT(OUT) :: PINPRC! Cloud instant precip
+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(KIT,KJT), INTENT(OUT) :: PINDEP ! Cloud instant deposition
+REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud instant deposition
REAL, DIMENSION(KIT,KJT,KKT), INTENT(OUT) :: PRAINFR
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PSIGS ! Sigma_s at t
+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
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 6bd9e3a56a598647f69b7aa413e0d270b849d9ef..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.
@@ -724,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 af4579ccace40b2827fe59bc5ef44c76970a15b3..a8c847c3f280ae1e4f7e1a27561252b676a3c574 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.f90
@@ -324,13 +324,11 @@ USE MODD_FOREFIRE
#endif
USE MODD_GET_n
USE MODD_GR_FIELD_n
-!USE MODD_IBM_PARAM_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_NSV,NSV_USER_n=>NSV_USER
USE MODD_PARAMETERS
USE MODD_PASPOL
-!USE MODD_RECYCL_PARAM_n
USE MODD_SALT
USE MODD_VAR_ll, ONLY: NPROC
USE MODD_VISCOSITY
@@ -387,7 +385,8 @@ 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
@@ -1257,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.'
@@ -2357,15 +2363,24 @@ IF ( LFORCING ) THEN
WRITE(ILUOUT,FMT=*) 'YOU CHOSE A TEMPERATURE AND HUMIDITY RELAXATION'
WRITE(ILUOUT,FMT=*) 'TOGETHER WITH TENDENCY OR GEOSTROPHIC FORCING'
WRITE(ILUOUT,FMT=*) &
- 'YOU MIGHT CHECK YOUR SWITCHES: LRELAX_THRV_FRC, LTEND_THRV_FRC, AND'
+ 'YOU MIGHT CHECK YOUR SWITCHES: LRELAX_THRV_FRC, LTEND_THRV_FRC, AND'
WRITE(ILUOUT,FMT=*) 'LGEOST_TH_FRC'
END IF
!
- IF ( LRELAX_UV_FRC .AND. LGEOST_UV_FRC ) THEN
+ IF ( LRELAX_UV_FRC .AND. LRELAX_UVMEAN_FRC) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU MUST CHOOSE BETWEEN A RELAXATION APPLIED TO'
+ WRITE(ILUOUT,FMT=*) 'THE 3D FULL WIND FIELD (LRELAX_UV_FRC) OR'
+ WRITE(ILUOUT,FMT=*) 'THE HORIZONTAL MEAN WIND (LRELAX_UVMEAN_FRC)'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+ END IF
+!
+ IF ( (LRELAX_UV_FRC .OR. LRELAX_UVMEAN_FRC) .AND. LGEOST_UV_FRC ) THEN
WRITE(UNIT=ILUOUT,FMT=9003) KMI
WRITE(ILUOUT,FMT=*) 'YOU MUST NOT USE A WIND RELAXATION'
WRITE(ILUOUT,FMT=*) 'TOGETHER WITH A GEOSTROPHIC FORCING'
- WRITE(ILUOUT,FMT=*) 'CHECK SWITCHES: LRELAX_UV_FRC, LGEOST_UV_FRC'
+ WRITE(ILUOUT,FMT=*) 'CHECK SWITCHES: LRELAX_UV_FRC, LRELAX_UVMEAN_FRC, LGEOST_UV_FRC'
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
END IF
diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90
index e699bf02adbdbeb963970813fad79a9d30bdde82..1f8d4b3cab8e98abd0698ec2c34249c956ec75ba 100644
--- a/src/MNH/read_field.f90
+++ b/src/MNH/read_field.f90
@@ -9,7 +9,7 @@
!
INTERFACE
!
- SUBROUTINE READ_FIELD(KOCMI,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, &
@@ -37,8 +37,9 @@ 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,KOCMI
+INTEGER, INTENT(IN) :: KIU, KJU, KKU
! array sizes in x, y and z directions
!
CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
@@ -131,7 +132,7 @@ END INTERFACE
END MODULE MODI_READ_FIELD
!
! ########################################################################
- SUBROUTINE READ_FIELD(KOCEMI,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, &
@@ -251,6 +252,7 @@ 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
+!! 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
@@ -270,14 +272,14 @@ USE MODD_CONF_n
USE MODD_CST
USE MODD_CTURB
USE MODD_DUST
-USE MODD_DYN_n, ONLY : LOCEAN
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
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_IBM_PARAM_n, ONLY: LIBM
USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LATZ_EDFLX
@@ -291,11 +293,11 @@ 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_REF, ONLY: LCOUPLES
USE MODD_SALT
USE MODD_TIME ! for type DATE_TIME
!
@@ -313,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,KOCEMI
+INTEGER, INTENT(IN) :: KIU, KJU, KKU
! array sizes in x, y and z directions
!
CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
@@ -627,7 +630,7 @@ IF (LIBM .AND. CPROGRAM=='MESONH') THEN
TZFIELD%CMNHNAME = 'XMUT'
TZFIELD%CLONGNAME = 'XMUT'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm2.s-1'
+ TZFIELD%CUNITS = 'm2 s-1'
TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -638,37 +641,39 @@ IF (LIBM .AND. CPROGRAM=='MESONH') THEN
!
ENDIF
!
-ZLRECYCL=.FALSE.
TZFIELD%CMNHNAME = 'RECYCLING'
TZFIELD%CLONGNAME = 'RECYCLING'
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = ''
-TZFIELD%CDIR = ''
+TZFIELD%CDIR = '--'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPELOG
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_read(TPINIFILE,TZFIELD,ZLRECYCL)
+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 = 'XY'
+ TZFIELD%CDIR = '--'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_read(TPINIFILE,TZFIELD,R_COUNT)
+ CALL IO_Field_read(TPINIFILE,TZFIELD,NR_COUNT)
!
- IF (R_COUNT .NE. 0) THEN
+ IF (NR_COUNT .NE. 0) THEN
IF (LRECYCLW) THEN
TZFIELD%CMNHNAME = 'URECYCLW'
TZFIELD%CLONGNAME = 'URECYCLW'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 2
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -678,8 +683,8 @@ IF (ZLRECYCL) THEN
TZFIELD%CMNHNAME = 'VRECYCLW'
TZFIELD%CLONGNAME = 'VRECYCLW'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 3
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -689,8 +694,8 @@ IF (ZLRECYCL) THEN
TZFIELD%CMNHNAME = 'WRECYCLW'
TZFIELD%CLONGNAME = 'WRECYCLW'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 4
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -702,8 +707,8 @@ IF (ZLRECYCL) THEN
TZFIELD%CMNHNAME = 'URECYCLN'
TZFIELD%CLONGNAME = 'URECYCLN'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 2
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -713,8 +718,8 @@ IF (ZLRECYCL) THEN
TZFIELD%CMNHNAME = 'VRECYCLN'
TZFIELD%CLONGNAME = 'VRECYCLN'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 3
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -724,8 +729,8 @@ IF (ZLRECYCL) THEN
TZFIELD%CMNHNAME = 'WRECYCLN'
TZFIELD%CLONGNAME = 'WRECYCLN'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 4
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -737,8 +742,8 @@ IF (ZLRECYCL) THEN
TZFIELD%CMNHNAME = 'URECYCLE'
TZFIELD%CLONGNAME = 'URECYCLE'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 2
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -748,8 +753,8 @@ IF (ZLRECYCL) THEN
TZFIELD%CMNHNAME = 'VRECYCLE'
TZFIELD%CLONGNAME = 'VRECYCLE'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 3
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -759,8 +764,8 @@ IF (ZLRECYCL) THEN
TZFIELD%CMNHNAME = 'WRECYCLE'
TZFIELD%CLONGNAME = 'WRECYCLE'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 4
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -772,8 +777,8 @@ IF (ZLRECYCL) THEN
TZFIELD%CMNHNAME = 'URECYCLS'
TZFIELD%CLONGNAME = 'URECYCLS'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 2
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -783,8 +788,8 @@ IF (ZLRECYCL) THEN
TZFIELD%CMNHNAME = 'VRECYCLS'
TZFIELD%CLONGNAME = 'VRECYCLS'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 3
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -794,8 +799,8 @@ IF (ZLRECYCL) THEN
TZFIELD%CMNHNAME = 'WRECYCLS'
TZFIELD%CLONGNAME = 'WRECYCLS'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 4
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -943,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))
diff --git a/src/MNH/read_ver_grid.f90 b/src/MNH/read_ver_grid.f90
index 4f92115b0100a85455b620f0f88c7bb5f3fe463d..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.
diff --git a/src/MNH/recycl_fluc.f90 b/src/MNH/recycl_fluc.f90
index f4153f58c53b26754fa7d7dd7bdae006998a0685..2ee5471c1cbaf789bda33b71efde9b70cdb644e8 100644
--- a/src/MNH/recycl_fluc.f90
+++ b/src/MNH/recycl_fluc.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################
@@ -9,11 +9,11 @@
!
INTERFACE
!
-SUBROUTINE RECYCL_FLUC (PPTABU,PPTABV,PPTABW,PTHT,PDZZ,OR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS, &
+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) :: OR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS
+ 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
@@ -27,7 +27,7 @@ END MODULE MODI_RECYCL_FLUC
!
!
! ####################################
- SUBROUTINE RECYCL_FLUC (PPTABU,PPTABV,PPTABW,PTHT,PDZZ,OR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS, &
+ 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 )
@@ -99,7 +99,6 @@ USE MODI_GRADIENT_W
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODE_GRIDPROJ
-USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_REF
USE MODD_LATZ_EDFLX
!
@@ -110,7 +109,7 @@ IMPLICIT NONE
!------------------------------------------------------------------------------
!
! 0.1 declarations of arguments
- INTEGER ,INTENT(IN) :: OR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS
+ 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
@@ -216,13 +215,13 @@ IF (LRECYCLW) THEN
!
! *** Mean and fluctuations calculation
!
- IF(OR_COUNT.LE.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0) THEN
- ICOUNT=OR_COUNT/XTMOYCOUNT
+ 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(OR_COUNT.GT.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ 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)
@@ -244,7 +243,7 @@ IF (LRECYCLW) THEN
ENDIF
ENDDO
ENDDO
- IF(R_COUNT.GT.XTMOY) THEN
+ 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))
@@ -291,13 +290,13 @@ IF (LRECYCLN) THEN
!
! *** Mean and fluctuations calculation
!
- IF(OR_COUNT.LE.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0) THEN
- ICOUNT=OR_COUNT/XTMOYCOUNT
+ 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(OR_COUNT.GT.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ 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)
@@ -320,7 +319,7 @@ IF (LRECYCLN) THEN
ENDIF
ENDDO
ENDDO
- IF(R_COUNT.GT.XTMOY) THEN
+ 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))
@@ -367,13 +366,13 @@ IF (LRECYCLE) THEN
!
! *** Mean and fluctuations calculation
!
- IF(OR_COUNT.LE.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0) THEN
- ICOUNT=OR_COUNT/XTMOYCOUNT
+ 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(OR_COUNT.GT.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ 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)
@@ -395,7 +394,7 @@ IF (LRECYCLE) THEN
ENDIF
ENDDO
ENDDO
- IF(R_COUNT.GT.XTMOY) THEN
+ 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))
@@ -442,13 +441,13 @@ IF (LRECYCLS) THEN
!
! *** Mean and fluctuations calculation
!
- IF(OR_COUNT.LE.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0) THEN
- ICOUNT=OR_COUNT/XTMOYCOUNT
+ 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(OR_COUNT.GT.XTMOY.AND.MOD(OR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ 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)
@@ -470,7 +469,7 @@ IF (LRECYCLS) THEN
ENDIF
ENDDO
ENDDO
- IF(R_COUNT.GT.XTMOY) THEN
+ 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))
diff --git a/src/MNH/recycling.f90 b/src/MNH/recycling.f90
index 5e71b84303a8bdc17967af912385a5f979ad6fe2..9734eebc00e2f5bc16e8e923bfdc04cba2f120e7 100644
--- a/src/MNH/recycling.f90
+++ b/src/MNH/recycling.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################
@@ -141,23 +141,16 @@ ILUOUT = TLUOUT%NLU
!
!Moving averaged parameter verification
IF (PTCOUNT==1 .AND. INT(XTMOY)/INT(XTMOYCOUNT) /= INT(XNUMBELT)) THEN
- WRITE(ILUOUT,FMT=*)
- WRITE(ILUOUT,FMT=*) ' ERROR : XTMOY/XTMOYCOUNT must be equal to XNUMBELT'
- WRITE(ILUOUT,FMT=*) ' Please change the above parameters accordingly in NAM_RECYCL_PARAMn'
- WRITE(ILUOUT,FMT=*)
- WRITE(ILUOUT,FMT=*) '###############'
- WRITE(ILUOUT,FMT=*) ' MESONH STOP'
- WRITE(ILUOUT,FMT=*) '###############'
- WRITE(ILUOUT,FMT=*)
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RECYCLING','XTMOY/XTMOYCOUNT must be equal to XNUMBELT')
+ 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
- R_COUNT = R_COUNT
+ NR_COUNT = NR_COUNT
ELSE
- R_COUNT = R_COUNT +1
- !IF (IP==1) WRITE(*,*)'RCOUNT: ', R_COUNT
+ NR_COUNT = NR_COUNT +1
+ !IF (IP==1) WRITE(*,*)'RCOUNT: ', NR_COUNT
ENDIF
IF (LRECYCLW) THEN
@@ -181,9 +174,9 @@ ENDIF
PMINS = 1+JPHEXT+JJDIST!
ENDIF
- CALL RECYCL_FLUC (XUT,XVT,XWT,XTHT,XDZZ,R_COUNT,PTCOUNT,PMINW,PMINN,PMINE,PMINS,&
- PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN,&
- PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS )
+ 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
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 9de88ea5bcb7cab7aa9721b8c239f8e184c6fe2a..30616e6c57314d97e5f5e032bf5f4b6e77d89c87 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -271,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
@@ -281,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
@@ -296,8 +296,7 @@ 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
@@ -312,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
@@ -473,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
!
!------------------------------------------------------------------------------
!
@@ -796,7 +800,7 @@ SELECT CASE ( HCLOUD )
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
- 'CDEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ 'DEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
PTSTEP, PSIGQSAT, &
PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
ZEXN, PCF_MF, PRC_MF, PRI_MF, &
@@ -894,7 +898,7 @@ SELECT CASE ( HCLOUD )
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
- 'CDEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ 'DEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
PTSTEP, PSIGQSAT, &
PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
ZEXN, PCF_MF, PRC_MF, PRI_MF, &
@@ -935,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, &
@@ -964,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 22408fdc282d82461f1f57a711cdca15d1b17dac..31f00cb4dda81f39600edc8f0560ac6b91e7ed37 100644
--- a/src/MNH/set_cstn.f90
+++ b/src/MNH/set_cstn.f90
@@ -170,7 +170,7 @@ END MODULE MODI_SET_CSTN
!
USE MODD_CONF
USE MODD_CST
-USE MODD_DYN_n, ONLY : LOCEAN
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
diff --git a/src/MNH/set_mass.f90 b/src/MNH/set_mass.f90
index 6e6b816ed92609944d16415c63f3bbeccc3176f5..4563a4c6d85559ec5ec5a334bd5c3efdb7f4c3a0 100644
--- a/src/MNH/set_mass.f90
+++ b/src/MNH/set_mass.f90
@@ -473,7 +473,7 @@ 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, &
+ 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)
@@ -482,7 +482,7 @@ ELSE
!No interpolation for ocean case (no bathimetry)
! Interpolation of theta and r in atmos case
!
- IF (SIZE(ZTHV3D_MX,3) > 3) THEN
+ 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)
@@ -572,6 +572,9 @@ 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)
diff --git a/src/MNH/set_perturb.f90 b/src/MNH/set_perturb.f90
index ead3d16e74e5bfb12696e98a17ffebd7e60dfcd6..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.
@@ -257,7 +257,7 @@ IF (LOCEAN) THEN
INOISB=NKWH
INOISE=IKE
ELSE
- INOISB=2
+ INOISB=IKB
INOISE=NKWH
ENDIF
!-------------------------------------------------------------------------------
diff --git a/src/MNH/set_ref.f90 b/src/MNH/set_ref.f90
index 462e9cba2983cd604340ddcbabdec5d203c369fd..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.
@@ -157,11 +157,11 @@ END MODULE MODI_SET_REF
! ------------
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
-USE MODD_DYN_n, ONLY : LOCEAN
!
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
diff --git a/src/MNH/set_rsou.f90 b/src/MNH/set_rsou.f90
index a2b57438a2150966e54b831092e46c9c7e0c724f..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.
@@ -252,7 +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
+! JL Redelsperger 01/2021: Ocean LES cases added
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -261,11 +261,11 @@ END MODULE MODI_SET_RSOU
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
-USE MODD_DYN_n, ONLY : LOCEAN
+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_LUNIT_n, ONLY: TLUOUT
USE MODD_IO, ONLY: TFILEDATA
USE MODD_NETCDF
USE MODD_OCEANH
@@ -381,18 +381,18 @@ REAL :: ZRDSCPD,ZRADSDG, & ! Rd/Cpd, Pi/180.,
ZRVSRD,ZRDSRV, & ! Rv/Rd, Rd/Rv
ZPTOP ! Pressure at domain top
LOGICAL :: GUSERC ! use of input data cloud
-INTEGER :: IIB, IIE, IJB, IJE,IKB,IKE
+INTEGER :: IIB, IIE, IJB, IJE
INTEGER :: IXOR_ll, IYOR_ll
INTEGER :: IINFO_ll
LOGICAL :: GPROFILE_IN_PROC ! T : initialization profile is in current processor
-CHARACTER(LEN=100) :: YMSG
!
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) ::ZZS_LS
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) ::ZZFLUX_MX,ZZMASS_MX ! mixed grid
!-------------------------------------------------------------------------------
! For standard ocean version, reading external files
-CHARACTER(LEN=256) :: infile,infisf ! files to be read
-INTEGER :: NZ,NLATI,NLONGI,IDX,ITIME,ncid,varid,ndimp,ntcindy
+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
@@ -581,47 +581,47 @@ SELECT CASE(YKIND)
CASE ('STANDOCE')
!
XP00=XP00OCEAN
- READ(ILUPRE,*) ZPTOP ! P_atmosphere at sfc =P top domain
- READ(ILUPRE,*) INFILE,INFISF
- WRITE(ILUOUT,FMT=*) 'Netcdf files to read:',INFILE,INFISF
+ 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(infile,NF90_NOWRITE,ncid), "opening NC file")
+ CALL check(nf90_open(yinfile,NF90_NOWRITE,incid), "opening NC file")
! Reading dimensions and lengths
- CALL check( nf90_inq_dimid(ncid, "depth",ndimp), "getting depth dimension id" )
- CALL check( nf90_inquire_dimension(ncid, ndimp, len=NZ), "getting NZ " )
- CALL check( nf90_inquire_dimension(ncid, 2, len=NLONGI), "getting NLONG " )
- CALL check( nf90_inquire_dimension(ncid, 1, len=NLATI), "getting NLAT " )
+ 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 NZ, NLONG NLAT ', NZ, NLONGI,NLATI
- ALLOCATE(ZOC_TEMPERATURE(NLATI,NLONGI,NZ),ZOC_SALINITY(NLATI,NLONGI,NZ))
- ALLOCATE(ZOC_U(NLATI,NLONGI,NZ),ZOC_V(NLATI,NLONGI,NZ))
- ALLOCATE(ZOC_DEPTH(NZ))
+ 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(ncid,"temperature",varid), "getting temp varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_TEMPERATURE), "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(ncid,"salinity",varid), "getting salinity varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_SALINITY), "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(ncid,"depth",varid), "getting depth varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_DEPTH), "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(NZ)
+ WRITE(ILUOUT,FMT=*) 'depth 1 nz: ', ZOC_DEPTH(1),ZOC_DEPTH(INZ)
WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> Currents'
- CALL check(nf90_inq_varid(ncid,"u",varid), "getting u varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_U), "reading u")
- CALL check(nf90_inq_varid(ncid,"v",varid), "getting v varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_V), "reading v")
- CALL check(nf90_close(ncid), "closing infile")
+ 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,NZ
+ 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=NZ
+ ILEVELM=INZ
! Model bottom
ZTGROUND = ZOC_TEMPERATURE(1,1,ILEVELM)
ZMRGROUND = ZOC_SALINITY(1,1,ILEVELM)
@@ -655,7 +655,7 @@ SELECT CASE(YKIND)
ZTHL = ZT
ZTH = ZT
! INIT --- U V -----
- ILEVELU=nz ! Same nb of levels for u,v,T,S
+ 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))
@@ -678,56 +678,56 @@ SELECT CASE(YKIND)
!
! Reading/initializing surface forcings
!
- WRITE(ILUOUT,FMT=*) 'netcdf sfc forcings file to be read:',infisf
+ WRITE(ILUOUT,FMT=*) 'netcdf sfc forcings file to be read:',yinfisf
! Open of sfc forcing file
- CALL check(nf90_open(infisf,NF90_NOWRITE,ncid), "opening NC file")
+ CALL check(nf90_open(yinfisf,NF90_NOWRITE,incid), "opening NC file")
! Reading dimension and length
- CALL check( nf90_inq_dimid(ncid,"t",ndimp), "getting time dimension id" )
- CALL check( nf90_inquire_dimension(ncid, ndimp, len=ntcindy), "getting ntcindy " )
-!
- WRITE(ILUOUT,FMT=*) 'nb sfc-forcing time ntcindy=',ntcindy
- ALLOCATE(ZOC_LE(ntcindy))
- ALLOCATE(ZOC_H(ntcindy))
- ALLOCATE(ZOC_SW_DOWN(ntcindy))
- ALLOCATE(ZOC_SW_UP(ntcindy))
- ALLOCATE(ZOC_LW_DOWN(ntcindy))
- ALLOCATE(ZOC_LW_UP(ntcindy))
- ALLOCATE(ZOC_TAUX(ntcindy))
- ALLOCATE(ZOC_TAUY(ntcindy))
+ 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(ncid,"LE",varid), "getting LE varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_LE), "reading LE flux")
+ 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(ncid,"H",varid), "getting H varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_H), "reading H flux")
+ 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(ncid,"SW_DOWN",varid), "getting SW_DOWN varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_SW_DOWN), "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(ncid,"SW_UP",varid), "getting SW_UP varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_SW_UP), "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(ncid,"LW_DOWN",varid), "getting LW_DOWN varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_LW_DOWN), "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(ncid,"LW_UP",varid), "getting LW_UP varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_LW_UP), "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(ncid,"TAUX",varid), "getting TAUX varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_TAUX), "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(ncid,"TAUY",varid), "getting TAUY varid")
- CALL check(nf90_get_var(ncid,varid,ZOC_TAUY), "reading TAUY")
- CALL check(nf90_close(ncid), "closing infisfS")
+ 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,NTCINDY
+ 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=NTCINDY
+ IFRCLT=idimlen
ALLOCATE(ZFRCLT(IFRCLT))
ALLOCATE(ZSSUFL_T(IFRCLT)); ZSSUFL_T = 0.0
ALLOCATE(ZSSVFL_T(IFRCLT)); ZSSVFL_T = 0.0
@@ -1620,12 +1620,12 @@ DEALLOCATE(ZMR)
DEALLOCATE(ZTHL)
!-------------------------------------------------------------------------------
CONTAINS
- SUBROUTINE CHECK(STATUS,LOC)
- INTEGER, INTENT(IN) :: STATUS
- CHARACTER(LEN=*), INTENT(IN) :: LOC
- IF(STATUS /= NF90_NOERR) THEN
- WRITE(ILUOUT,FMT=*) "Error at ", LOC
- WRITE(ILUOUT,FMT=*) NF90_STRERROR(STATUS)
+ 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
!
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..81d49856c651454e06a50734e65120171de54dca 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 :: isv_lima_end
real, dimension(:, :, :), allocatable :: zt, zexn, zlv, zls, zcph, zcor
if ( krr == 0 ) return
@@ -59,6 +60,15 @@ if ( krr == 0 ) return
if ( hbudname /= 'NEADV' .and. hbudname /= 'NECON' .and. hbudname /= 'NEGA' .and. hbudname /= 'NETUR' ) &
call Print_msg( NVERB_WARNING, 'GEN', 'Sources_neg_correct', 'budget '//hbudname//' not yet tested' )
+if ( hcloud == 'LIMA' ) then
+ ! The negativity correction does not apply to the SPRO (supersaturation) variable which may be naturally negative
+ if ( lspro_lima ) then
+ isv_lima_end = nsv_lima_end - 1
+ else
+ isv_lima_end = nsv_lima_end
+ end if
+end if
+
if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
if ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. &
hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then
@@ -84,7 +94,7 @@ if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
end do
end if
if ( lbudget_sv .and. hcloud == 'LIMA' ) then
- do ji = nsv_lima_beg, nsv_lima_end
+ do ji = nsv_lima_beg, isv_lima_end
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
end do
end if
@@ -110,7 +120,7 @@ else !NECON + NEGA
end do
end if
if ( lbudget_sv .and. hcloud == 'LIMA' ) then
- do ji = nsv_lima_beg, nsv_lima_end
+ do ji = nsv_lima_beg, isv_lima_end
call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
end do
end if
@@ -285,7 +295,7 @@ 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) )
+ prsvs(:, :, :, nsv_lima_beg : isv_lima_end) = Max( 0.0, prsvs(:, :, :, nsv_lima_beg : isv_lima_end) )
end select CLOUD
@@ -315,7 +325,7 @@ if ( hbudname /= 'NECON' .and. hbudname /= 'NEGA' ) then
end do
end if
if ( lbudget_sv .and. hcloud == 'LIMA' ) then
- do ji = nsv_lima_beg, nsv_lima_end
+ do ji = nsv_lima_beg, isv_lima_end
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
end do
end if
@@ -338,7 +348,7 @@ else !NECON + NEGA
end do
end if
if ( lbudget_sv .and. hcloud == 'LIMA' ) then
- do ji = nsv_lima_beg, nsv_lima_end
+ do ji = nsv_lima_beg, isv_lima_end
call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
end do
end if
diff --git a/src/MNH/spawn_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 3d1e9382c36c785c3095dbee84634861f2ce60ae..7d286b6eefcd54cd57468413da56fb828b8fdbba 100644
--- a/src/MNH/spawn_model2.f90
+++ b/src/MNH/spawn_model2.f90
@@ -590,15 +590,15 @@ CSCONV = 'NONE' ! shallow convection will have to be restarted
!
! cas LIMA
!
-IF (HCLOUD=='LIMA') THEN
- CCLOUD='LIMA'
- NMOD_CCN=3
- LSCAV=.FALSE.
- LAERO_MASS=.FALSE.
- NMOD_IFN=2
- NMOD_IMM=1
- LHHONI=.FALSE.
-ENDIF
+!IF (HCLOUD=='LIMA') THEN
+! CCLOUD='LIMA'
+! NMOD_CCN=3
+! LSCAV=.FALSE.
+! LAERO_MASS=.FALSE.
+! NMOD_IFN=2
+! NMOD_IMM=1
+! LHHONI=.FALSE.
+!ENDIF
!
CALL INI_NSV(2) ! NSV* are set equal for model 2 and model 1.
! NSV is set to the total number of SV for model 2
diff --git a/src/MNH/spawning.f90 b/src/MNH/spawning.f90
index 290e199ba663757116c0c3cd17cf6cf3e6711610..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.
diff --git a/src/MNH/station_reader.f90 b/src/MNH/station_reader.f90
index 611cb4f601b073656f0a0925bc3b3fc0cd306df0..e6f9647bc1e99616f331f2e44fd454470fe174da 100644
--- a/src/MNH/station_reader.f90
+++ b/src/MNH/station_reader.f90
@@ -1,20 +1,16 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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(KLUNAM,HFILE,TPSTATION,OCARTESIAN)
- USE MODD_ALLSTATION_n
+SUBROUTINE READ_CSV_STATION(HFILE,TPSTATION,OCARTESIAN)
USE MODD_STATION_n
- USE MODD_PARAMETERS
- USE MODD_TYPE_STATION
- USE MODI_INI_SURFSTATION_n
- INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
TYPE(STATION), INTENT(OUT) :: TPSTATION ! stored blade data
LOGICAL, INTENT(IN) :: OCARTESIAN
@@ -42,7 +38,7 @@ END MODULE MODI_STATION_READER
!!---------------------------------------------------------------
!
!#########################################################
-SUBROUTINE READ_CSV_STATION(KLUNAM,HFILE,TPSTATION,OCARTESIAN)
+SUBROUTINE READ_CSV_STATION(HFILE,TPSTATION,OCARTESIAN)
USE MODD_ALLSTATION_n
USE MODD_STATION_n
USE MODD_PARAMETERS
@@ -50,24 +46,24 @@ USE MODD_TYPE_STATION
USE MODI_INI_SURFSTATION_n
!
-INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
-CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+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
+CHARACTER(LEN=400) :: YSTRING
+INTEGER :: ILU ! logical unit of the file
!
! Open file
-OPEN(UNIT=KLUNAM,FILE=HFILE, FORM='formatted')
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted')
! Count lines
-REWIND(KLUNAM)
+REWIND(ILU)
INBLINE=0
DO
- READ(KLUNAM,END=101,FMT='(A400)') YSTRING
+ 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
@@ -103,29 +99,29 @@ END DO
TPSTATION%NAME = " "
TPSTATION%TYPE = " "
! Nouvelle lecture
- REWIND(KLUNAM)
- READ(KLUNAM,FMT='(A400)') YSTRING ! Lecture du header
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Lecture du header
!
! Save the data
IF (OCARTESIAN) THEN
INBLINE = 1
DO INBLINE=1, NUMBSTAT
- READ(KLUNAM,FMT='(A400)') YSTRING
+ 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(KLUNAM)
- CLOSE(KLUNAM)
+ REWIND(ILU)
+ CLOSE(ILU)
RETURN
ELSE
INBLINE = 1
DO INBLINE=1, NUMBSTAT
- READ(KLUNAM,FMT='(A400)') YSTRING
+ 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(KLUNAM)
- CLOSE(KLUNAM)
+ REWIND(ILU)
+ CLOSE(ILU)
RETURN
END IF
END IF
diff --git a/src/MNH/th_r_from_thl_rt_1d.f90 b/src/MNH/th_r_from_thl_rt_1d.f90
index 6149852c13b350153f94245a4a6bcb5b4df969d4..e4ba92f8a9d8f7ca88e5411bfaadd73c1d8023fa 100644
--- a/src/MNH/th_r_from_thl_rt_1d.f90
+++ b/src/MNH/th_r_from_thl_rt_1d.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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
! ###############################
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index 0074628147dd16a5e56f3fff71188cbffd4ee656..228241e2ce6e40965f1766ef2b8396210a08c4c9 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.f90
@@ -345,7 +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
+! J.L. Redelsperger 03/2021: add Ocean LES case
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -366,7 +366,6 @@ USE MODD_LES
USE MODD_NSV
USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
USE MODD_PARAM_LIMA
-USE MODD_REF
USE MODD_TURB_n, ONLY: XCADAP
!
USE MODI_GRADIENT_M
@@ -396,7 +395,7 @@ USE MODI_ETHETA
!
USE MODI_SECOND_MNH
!
-USE MODD_IBM_PARAM_n, ONLY : LIBM, XIBM_LS, XIBM_XMUT
+USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_LS, XIBM_XMUT
USE MODI_IBM_MIXINGLENGTH
!
IMPLICIT NONE
diff --git a/src/MNH/turb_ver.f90 b/src/MNH/turb_ver.f90
index ddd97f1470d3cccd5ce56dae4b2006b823a18b97..4117d8191eb9def704b654e606eba90307fe65ec 100644
--- a/src/MNH/turb_ver.f90
+++ b/src/MNH/turb_ver.f90
@@ -319,7 +319,7 @@ END MODULE MODI_TURB_VER
!
USE MODD_CST
USE MODD_CTURB
-USE MODD_DYN_n, ONLY : LOCEAN
+USE MODD_DYN_n, ONLY: LOCEAN
use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
diff --git a/src/MNH/turb_ver_dyn_flux.f90 b/src/MNH/turb_ver_dyn_flux.f90
index 7d5983a0408da4bd324bb689a00a25db9ee6c2e7..51bc4e7e1b868799b038e1e56b089bd2cb88ae22 100644
--- a/src/MNH/turb_ver_dyn_flux.f90
+++ b/src/MNH/turb_ver_dyn_flux.f90
@@ -289,7 +289,7 @@ END MODULE MODI_TURB_VER_DYN_FLUX
USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
-USE MODD_DYN_n, ONLY : LOCEAN
+USE MODD_DYN_n, ONLY: LOCEAN
use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
@@ -709,7 +709,7 @@ IF (LOCEAN) THEN ! Ocean case
!No flux at the ocean domain bottom
ZSOURCE(:,:,IKB) = 0.
ELSE ! Atmos case
- IF (.NOT.LCOUPLES) THEN ! only atmosp sans couplage
+ IF (.NOT.LCOUPLES) THEN ! only atmosp without coupling
! compute the explicit tangential flux at the W point
ZSOURCE(:,:,IKB) = &
PTAU11M(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
@@ -726,8 +726,8 @@ ELSE ! Atmos case
- ZCOEFS(:,:,1:1) * PVM(:,:,IKB:IKB) * PIMPL &
) * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
!
- ELSE !atmosphere quand couplage
- ! flux en input supposé etre en SI et en point de voticité
+ 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
diff --git a/src/MNH/turb_ver_thermo_flux.f90 b/src/MNH/turb_ver_thermo_flux.f90
index c9187c7190a8d8b72c779a14015db3a4b195c35b..cf539984e7751f862a6251a3e80b048274740073 100644
--- a/src/MNH/turb_ver_thermo_flux.f90
+++ b/src/MNH/turb_ver_thermo_flux.f90
@@ -328,6 +328,7 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! 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
!!--------------------------------------------------------------------------
@@ -338,17 +339,17 @@ 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_GRID_n, ONLY: XZS, XXHAT, XYHAT
USE MODD_IO, ONLY: TFILEDATA
-USE MODD_METRICS_n
+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_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_DYN_n, ONLY: LOCEAN
USE MODD_OCEANH
-USE MODD_REF, ONLY : LCOUPLES
+USE MODD_REF, ONLY: LCOUPLES
USE MODD_TURB_n
USE MODD_FRC
!
@@ -792,14 +793,14 @@ END IF
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
!
@@ -1024,14 +1025,14 @@ IF (KRR /= 0) THEN
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
!
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 7ec9f531dfe76f77385a65aded9d65e877339198..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.
@@ -146,7 +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_DYN_n, ONLY: LOCEAN
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT, ONLY: TLUOUT0
diff --git a/src/MNH/viscosity.f90 b/src/MNH/viscosity.f90
index 586327fad22fb00d877159e4e671f5c33b20a7d2..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,7 +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
-! 02/21 (T.Nagel) Add adhesion condition in case of an IBM-obstacle at the domain top boundary
+! T. Nagel 02/2021: add adhesion condition in case of an IBM-obstacle at the domain top boundary
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
diff --git a/src/MNH/write_aircraft_balloon.f90 b/src/MNH/write_aircraft_balloon.f90
index 993ce2f91077560b34f1509d56bbf6b637145d2b..a48117c835fa54237c162f999914b7f6f33ea319 100644
--- a/src/MNH/write_aircraft_balloon.f90
+++ b/src/MNH/write_aircraft_balloon.f90
@@ -176,10 +176,13 @@ CONTAINS
!
SUBROUTINE FLYER_DIACHRO(TPFLYER)
-use modd_budget, only: tbudiachrometadata
+use modd_budget, only: NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK, &
+ tbudiachrometadata
use modd_field, only: NMNHDIM_LEVEL, NMNHDIM_FLYER_PROC, NMNHDIM_FLYER_TIME, NMNHDIM_UNUSED, &
tfield_metadata_base, TYPEREAL
+use modi_aircraft_balloon, only: Aircraft_balloon_longtype_get
+
TYPE(FLYER), INTENT(IN) :: TPFLYER
!
!* 0.2 declaration of local variables for diachro
@@ -253,7 +256,7 @@ ALLOCATE (IGRIDZ (IPROCZ))
IGRID = 1
YGROUP = TPFLYER%TITLE
IGRIDZ = 1
-YGROUPZ = TRIM(TPFLYER%TITLE)//"Z"
+YGROUPZ = TPFLYER%TITLE
!
!----------------------------------------------------------------------------
JPROC = 0
@@ -462,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
@@ -852,27 +856,44 @@ tzfields(:)%ndimlist(4) = NMNHDIM_FLYER_TIME
tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(6) = NMNHDIM_FLYER_PROC
-tzbudiachro%cgroupname = ygroup
-tzbudiachro%cname = ygroup
-tzbudiachro%ccomment = 'Values at position of flyer ' // Trim( tpflyer%title )
-tzbudiachro%ctype = 'RSPL'
-if ( Trim( tpflyer%type ) == 'AIRCRA' ) then
- tzbudiachro%ccategory = 'aircraft'
-else if ( Trim( tpflyer%type ) == 'RADIOS' ) then
- tzbudiachro%ccategory = 'radiosonde balloon'
-else if ( Trim( tpflyer%type ) == 'ISODEN' ) then
- tzbudiachro%ccategory = 'iso-density balloon'
-else if ( Trim( tpflyer%type ) == 'CVBALL' ) then
- tzbudiachro%ccategory = 'constant volume balloon'
-else
- call Print_msg( NVERB_ERROR, 'IO', 'WRITE_AIRCRAFT_BALLOON', 'unknown category for flyer ' // Trim( tpflyer%title ) )
- tzbudiachro%ccategory = 'unknown'
-end if
-tzbudiachro%cshape = 'point'
+tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+tzbudiachro%clevels (NLVL_CATEGORY) = 'Flyers'
+tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different flyers (aircrafts and balloons)'
+
+tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .true.
+call Aircraft_balloon_longtype_get( tpflyer, tzbudiachro%clevels(NLVL_SUBCATEGORY) )
+tzbudiachro%ccomments(NLVL_SUBCATEGORY) = 'Level for the flyers of type: ' // Trim( tzbudiachro%clevels(NLVL_SUBCATEGORY) )
+
+tzbudiachro%lleveluse(NLVL_GROUP) = .true.
+tzbudiachro%clevels (NLVL_GROUP) = Trim( ygroup )
+tzbudiachro%ccomments(NLVL_GROUP) = 'Values for flyer ' // Trim( tpflyer%title )
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .true.
+tzbudiachro%clevels (NLVL_SHAPE) = 'Point'
+tzbudiachro%ccomments(NLVL_SHAPE) = 'Values at position of flyer ' // Trim( tpflyer%title )
+
+tzbudiachro%lleveluse(NLVL_TIMEAVG) = .false.
+tzbudiachro%clevels (NLVL_TIMEAVG) = ''
+tzbudiachro%ccomments(NLVL_TIMEAVG) = ''
+
+tzbudiachro%lleveluse(NLVL_NORM) = .false.
+tzbudiachro%clevels (NLVL_NORM) = ''
+tzbudiachro%ccomments(NLVL_NORM) = ''
+
+tzbudiachro%lleveluse(NLVL_MASK) = .false.
+tzbudiachro%clevels (NLVL_MASK) = ''
+tzbudiachro%ccomments(NLVL_MASK) = ''
+
tzbudiachro%lmobile = .true.
+!Compression does not make sense here
! tzbudiachro%licompress = NOT SET (default values)
! tzbudiachro%ljcompress = NOT SET (default values)
! tzbudiachro%lkcompress = NOT SET (default values)
+tzbudiachro%ltcompress = .false.
+tzbudiachro%lnorm = .false.
+!Boundaries in physical domain does not make sense here (but flyer position does)
+!These values are not written in the netCDF files
+!These values are written in the LFI files
! tzbudiachro%nil = NOT SET (default values)
! tzbudiachro%nih = NOT SET (default values)
! tzbudiachro%njl = NOT SET (default values)
@@ -902,20 +923,53 @@ tzfields(:)%ndimlist(4) = NMNHDIM_FLYER_TIME
tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(6) = NMNHDIM_FLYER_PROC
-tzbudiachro%cgroupname = ygroupz
-tzbudiachro%cname = ygroupz
-tzbudiachro%ccomment = 'Vertical profiles at position of flyer ' // Trim( tpflyer%title )
-tzbudiachro%ctype = 'CART'
-! tzbudiachro%ccategory = !unchanged
-tzbudiachro%cshape = 'vertical profile'
+tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+tzbudiachro%clevels (NLVL_CATEGORY) = 'Flyers'
+tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different flyers (aircrafts and balloons)'
+
+tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .true.
+call Aircraft_balloon_longtype_get( tpflyer, tzbudiachro%clevels(NLVL_SUBCATEGORY) )
+tzbudiachro%ccomments(NLVL_SUBCATEGORY) = 'Level for the flyers of type: ' // Trim( tzbudiachro%clevels(NLVL_SUBCATEGORY) )
+
+tzbudiachro%lleveluse(NLVL_GROUP) = .true.
+tzbudiachro%clevels (NLVL_GROUP) = Trim( ygroupz )
+tzbudiachro%ccomments(NLVL_GROUP) = 'Values for flyer ' // Trim( tpflyer%title )
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .true.
+tzbudiachro%clevels (NLVL_SHAPE) = 'Vertical_profile'
+tzbudiachro%ccomments(NLVL_SHAPE) = 'Vertical profiles at position of flyer ' // Trim( tpflyer%title )
+
+tzbudiachro%lleveluse(NLVL_TIMEAVG) = .false.
+tzbudiachro%clevels (NLVL_TIMEAVG) = 'Not_time_averaged'
+tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are not time averaged'
+
+tzbudiachro%lleveluse(NLVL_NORM) = .false.
+tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+
+tzbudiachro%lleveluse(NLVL_MASK) = .false.
+tzbudiachro%clevels (NLVL_MASK) = ''
+tzbudiachro%ccomments(NLVL_MASK) = ''
+
tzbudiachro%lmobile = .true.
+!Compression does not make sense here
+!Keep these values for backward compatibility of LFI files
tzbudiachro%licompress = .true.
tzbudiachro%ljcompress = .true.
tzbudiachro%lkcompress = .false.
+tzbudiachro%ltcompress = .false.
+tzbudiachro%lnorm = .false.
+!Horizontal boundaries in physical domain does not make sense here (but flyer position does)
+!These values are not written in the netCDF files
+!These values are written in the LFI files. They are kept for backward compatibility (and not set to default values)
tzbudiachro%nil = 1
tzbudiachro%nih = 1
tzbudiachro%njl = 1
tzbudiachro%njh = 1
+!1->iku includes non-physical levels (IKU=NKMAX+2*JPVEXT)
+!This does not conform to documentation (limits are in the physical domain)
+!These values are not written in the netCDF files
+!These values are written in the LFI files. They are kept for backward compatibility (and not set to default values)
tzbudiachro%nkl = 1
tzbudiachro%nkh = iku
diff --git a/src/MNH/write_budget.f90 b/src/MNH/write_budget.f90
index be4f2d5a2d56ce97923cd3cf146b6b3a04ba3816..767541ad935a58606ffd9de97aaddc47c1fe836c 100644
--- a/src/MNH/write_budget.f90
+++ b/src/MNH/write_budget.f90
@@ -46,6 +46,8 @@ private
public :: Write_budget
+character(len=*), parameter :: CMASK_VARNAME = 'MASKS'
+
contains
!#########################################################
@@ -103,7 +105,7 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
tbudgets, tburhodj
use modd_field, only: NMNHDIM_ONE, NMNHDIM_NI, NMNHDIM_NJ, &
NMNHDIM_BUDGET_TIME, NMNHDIM_BUDGET_MASK_NBUMASK, NMNHDIM_UNUSED, &
- tfielddata, TYPEREAL
+ tfielddata, TYPEINT, TYPEREAL
use modd_io, only: tfiledata
use modd_lunit_n, only: tluout
use modd_parameters, only: NMNHNAMELGTMAX
@@ -272,14 +274,14 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
tzfile = tpdiafile
tzfile%cformat = 'NETCDF4'
- tzfield%cmnhname = 'MASKS'
+ tzfield%cmnhname = CMASK_VARNAME
tzfield%cstdname = ''
tzfield%clongname = Trim( tzfield%cmnhname )
tzfield%cunits = '1'
tzfield%cdir = 'XY'
tzfield%ccomment = 'Masks for budget areas'
tzfield%ngrid = 1
- tzfield%ntype = TYPEREAL
+ tzfield%ntype = TYPEINT
tzfield%ndims = 4
tzfield%ltimedep = .false. !The time dependance is in the NMNHDIM_BUDGET_TIME dimension
tzfield%ndimlist(1) = NMNHDIM_NI
@@ -294,7 +296,7 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
!Write the data (partial write of the field with the given offset)
call IO_Field_write( tzfile, tzfield, nbusurf(:,:,:,:), koffset= [ 0, 0, 0, ( nbutshift - 1 ) * nbusubwrite ] )
- if ( nbutshift == 1 ) call Menu_diachro( tzfile, 'MASKS' )
+ if ( nbutshift == 1 ) call Menu_diachro( tzfile, CMASK_VARNAME )
end if
!
END SELECT
@@ -306,22 +308,22 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
!* RU budgets
!
IF (LBU_RU) THEN
- call Store_one_budget_rho( tpdiafile, tzdates, tbudgets(NBUDGET_U)%trhodj, NBUDGET_U, gnocompress, zrhodjn )
- call Store_one_budget ( tpdiafile, tzdates, tbudgets(NBUDGET_U), zrhodjn, gnocompress, ptstep )
+ call Store_one_budget_rho( tpdiafile, tzdates, tbudgets(NBUDGET_U)%trhodj, gnocompress, zrhodjn )
+ call Store_one_budget ( tpdiafile, tzdates, tbudgets(NBUDGET_U), zrhodjn, gnocompress, ptstep )
END IF
!
!* RV budgets
!
IF (LBU_RV) THEN
- call Store_one_budget_rho( tpdiafile, tzdates, tbudgets(NBUDGET_V)%trhodj, NBUDGET_V, gnocompress, zrhodjn )
- call Store_one_budget ( tpdiafile, tzdates, tbudgets(NBUDGET_V), zrhodjn, gnocompress, ptstep )
+ call Store_one_budget_rho( tpdiafile, tzdates, tbudgets(NBUDGET_V)%trhodj, gnocompress, zrhodjn )
+ call Store_one_budget ( tpdiafile, tzdates, tbudgets(NBUDGET_V), zrhodjn, gnocompress, ptstep )
END IF
!
!* RW budgets
!
IF (LBU_RW) THEN
- call Store_one_budget_rho( tpdiafile, tzdates, tbudgets(NBUDGET_W)%trhodj, NBUDGET_W, gnocompress, zrhodjn )
- call Store_one_budget ( tpdiafile, tzdates, tbudgets(NBUDGET_W), zrhodjn, gnocompress, ptstep )
+ call Store_one_budget_rho( tpdiafile, tzdates, tbudgets(NBUDGET_W)%trhodj, gnocompress, zrhodjn )
+ call Store_one_budget ( tpdiafile, tzdates, tbudgets(NBUDGET_W), zrhodjn, gnocompress, ptstep )
END IF
!
!* RHODJ storage for Scalars
@@ -329,7 +331,7 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
IF (LBU_RTH .OR. LBU_RTKE .OR. LBU_RRV .OR. LBU_RRC .OR. LBU_RRR .OR. &
LBU_RRI .OR. LBU_RRS .OR. LBU_RRG .OR. LBU_RRH .OR. LBU_RSV ) THEN
if ( .not. associated( tburhodj ) ) call Print_msg( NVERB_FATAL, 'BUD', 'Write_budget', 'tburhodj not associated' )
- call Store_one_budget_rho( tpdiafile, tzdates, tburhodj, NBUDGET_RHO, gnocompress, zrhodjn )
+ call Store_one_budget_rho( tpdiafile, tzdates, tburhodj, gnocompress, zrhodjn )
ENDIF
!
!* RTH budget
@@ -398,14 +400,14 @@ subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
end subroutine Write_budget
-subroutine Store_one_budget_rho( tpdiafile, tpdates, tprhodj, kp, knocompress, prhodjn )
- use modd_budget, only: cbutype, &
- lbu_icp, lbu_jcp, lbu_kcp, &
- nbuil, nbuih, nbujl, nbujh, nbukl, nbukh, &
- nbuimax, nbuimax_ll, nbujmax, nbujmax_ll, nbukmax, nbutshift, &
- nbumask, nbusubwrite, &
- tbudiachrometadata, tburhodata, &
- NBUDGET_RHO, NBUDGET_U, NBUDGET_V, NBUDGET_W
+subroutine Store_one_budget_rho( tpdiafile, tpdates, tprhodj, knocompress, prhodjn )
+ use modd_budget, only: cbutype, &
+ lbu_icp, lbu_jcp, lbu_kcp, &
+ nbuil, nbuih, nbujl, nbujh, nbukl, nbukh, &
+ nbuimax, nbuimax_ll, nbujmax, nbujmax_ll, nbukmax, nbutshift, &
+ nbumask, nbusubwrite, &
+ NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK, &
+ tbudiachrometadata, tburhodata
use modd_field, only: NMNHDIM_BUDGET_CART_NI, NMNHDIM_BUDGET_CART_NJ, NMNHDIM_BUDGET_CART_NI_U, &
NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NI_V, NMNHDIM_BUDGET_CART_NJ_V, &
NMNHDIM_BUDGET_CART_LEVEL, NMNHDIM_BUDGET_CART_LEVEL_W, &
@@ -428,12 +430,10 @@ subroutine Store_one_budget_rho( tpdiafile, tpdates, tprhodj, kp, knocompress, p
type(tfiledata), intent(in) :: tpdiafile ! file to write
type(date_time), dimension(:), intent(in) :: tpdates
type(tburhodata), intent(in) :: tprhodj ! rhodj datastructure
- integer, intent(in) :: kp ! reference number of budget
logical, intent(in) :: knocompress ! compression for the cart option
real, dimension(:,:,:,:,:,:), allocatable, intent(out) :: prhodjn
character(len=4) :: ybutype
- character(len=:), allocatable :: ygroup_name
type(tbudiachrometadata) :: tzbudiachro
type(tburhodata) :: tzfield
@@ -466,23 +466,6 @@ subroutine Store_one_budget_rho( tpdiafile, tpdates, tprhodj, kp, knocompress, p
call Print_msg( NVERB_ERROR, 'BUD', 'Store_one_budget_rho', 'unknown CBUTYPE' )
end select
- select case( kp )
- case( NBUDGET_RHO )
- ygroup_name = 'RJS'
-
- case( NBUDGET_U )
- ygroup_name = 'RJX'
-
- case( NBUDGET_V )
- ygroup_name = 'RJY'
-
- case( NBUDGET_W )
- ygroup_name = 'RJZ'
-
- case default
- call Print_msg( NVERB_ERROR, 'BUD', 'Store_one_budget_rho', 'unknown budget type' )
- end select
-
!Copy all fields from tprhodj
tzfield = tprhodj
@@ -555,20 +538,58 @@ subroutine Store_one_budget_rho( tpdiafile, tpdates, tprhodj, kp, knocompress, p
tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
end if
- tzbudiachro%cgroupname = ygroup_name
- tzbudiachro%cname = tprhodj%cmnhname
- tzbudiachro%ccomment = tprhodj%ccomment
- tzbudiachro%ctype = ybutype
- tzbudiachro%ccategory = 'budget'
+ tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+ tzbudiachro%clevels (NLVL_CATEGORY) = 'Budgets'
+ tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different budgets'
+
+ tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .false.
+ tzbudiachro%clevels (NLVL_SUBCATEGORY) = ''
+ tzbudiachro%ccomments(NLVL_SUBCATEGORY) = ''
+
+ tzbudiachro%lleveluse(NLVL_GROUP) = .true.
+ tzbudiachro%clevels (NLVL_GROUP) = 'RhodJ'
+ tzbudiachro%ccomments(NLVL_GROUP) = 'mass of dry air contained in the mesh cells'
+
+ tzbudiachro%lleveluse(NLVL_SHAPE) = .false.
+ if ( ybutype == 'CART' ) then
+ tzbudiachro%clevels (NLVL_SHAPE) = 'Cartesian'
+ tzbudiachro%ccomments(NLVL_SHAPE) = 'cartesian domain'
+ else
+ tzbudiachro%clevels (NLVL_SHAPE) = 'Mask'
+ tzbudiachro%ccomments(NLVL_SHAPE) = 'masked domain'
+ end if
+
+ tzbudiachro%lleveluse(NLVL_TIMEAVG) = .false.
+ tzbudiachro%clevels (NLVL_TIMEAVG) = 'Time_averaged'
+ tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are time averaged'
+
+ tzbudiachro%lleveluse(NLVL_NORM) = .false.
+ tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+ tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+
+ tzbudiachro%lleveluse(NLVL_MASK) = .false.
+ if ( ybutype == 'MASK' ) then
+ tzbudiachro%clevels (NLVL_MASK) = CMASK_VARNAME
+ tzbudiachro%ccomments(NLVL_MASK) = ''
+ else
+ tzbudiachro%clevels (NLVL_MASK) = ''
+ tzbudiachro%ccomments(NLVL_MASK) = ''
+ end if
+
if ( ybutype == 'CART' ) then
- tzbudiachro%cshape = 'cartesian'
+ tzbudiachro%lmobile = .false.
else
- tzbudiachro%cshape = 'mask'
+ !Masks are updated at each timestep (therefore the studied domains change during execution)
+ tzbudiachro%lmobile = .true.
end if
- tzbudiachro%lmobile = .false.
tzbudiachro%licompress = lbu_icp
tzbudiachro%ljcompress = lbu_jcp
tzbudiachro%lkcompress = lbu_kcp
+ tzbudiachro%ltcompress = .true. !Data is temporally averaged
+ tzbudiachro%lnorm = .false.
+ !Boundaries in physical domain does not make sense here if 'MASK'
+ !In that case, these values are not written in the netCDF files
+ !But they are always written in the LFI files. They are kept (in the MASK case) for backward compatibility.
tzbudiachro%nil = nbuil
tzbudiachro%nih = nbuih
tzbudiachro%njl = nbujl
@@ -589,6 +610,7 @@ subroutine Store_one_budget( tpdiafile, tpdates, tpbudget, prhodjn, knocompress,
nbumask, nbusubwrite, &
NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_TKE, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, &
NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK, &
tbudgetdata, tbudiachrometadata, tbugroupdata
use modd_field, only: NMNHDIM_BUDGET_CART_NI, NMNHDIM_BUDGET_CART_NJ, NMNHDIM_BUDGET_CART_NI_U, &
NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NI_V, NMNHDIM_BUDGET_CART_NJ_V, &
@@ -619,7 +641,6 @@ subroutine Store_one_budget( tpdiafile, tpdates, tpbudget, prhodjn, knocompress,
real, intent(in) :: ptstep ! time step
character(len=4) :: ybutype
- character(len=:), allocatable :: ygroup_name
integer :: igroups
integer :: jproc
integer :: jsv
@@ -682,52 +703,6 @@ subroutine Store_one_budget( tpdiafile, tpdates, tpbudget, prhodjn, knocompress,
deallocate(zconvert)
- jsv = -1
- select case( tpbudget%nid )
- case ( NBUDGET_U )
- ygroup_name = 'UU'
-
- case ( NBUDGET_V )
- ygroup_name = 'VV'
-
- case ( NBUDGET_W )
- ygroup_name = 'WW'
-
- case ( NBUDGET_TH )
- ygroup_name = 'TH'
-
- case ( NBUDGET_TKE )
- ygroup_name = 'TK'
-
- case ( NBUDGET_RV )
- ygroup_name = 'RV'
-
- case ( NBUDGET_RC )
- ygroup_name = 'RC'
-
- case ( NBUDGET_RR )
- ygroup_name = 'RR'
-
- case ( NBUDGET_RI )
- ygroup_name = 'RI'
-
- case ( NBUDGET_RS )
- ygroup_name = 'RS'
-
- case ( NBUDGET_RG )
- ygroup_name = 'RG'
-
- case ( NBUDGET_RH )
- ygroup_name = 'RH'
-
- case ( NBUDGET_SV1 : )
- jsv = tpbudget%nid - NBUDGET_SV1 + 1
- ygroup_name = csvnames(jsv)
-
- case default
- call Print_msg( NVERB_ERROR, 'BUD', 'Store_one_budget', 'unknown budget type' )
- end select
-
allocate( tzfields( igroups ) )
!Copy all fields from tpbudget%tgroups
@@ -808,26 +783,71 @@ subroutine Store_one_budget( tpdiafile, tpdates, tpbudget, prhodjn, knocompress,
end if
end do
- tzbudiachro%cgroupname = ygroup_name
- tzbudiachro%cname = tpbudget%cname
- tzbudiachro%ccomment = tpbudget%ccomment
- tzbudiachro%ctype = ybutype
- tzbudiachro%ccategory = 'budget'
+ tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+ tzbudiachro%clevels (NLVL_CATEGORY) = 'Budgets'
+ tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different budgets'
+
+ tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .false.
+ tzbudiachro%clevels (NLVL_SUBCATEGORY) = ''
+ tzbudiachro%ccomments(NLVL_SUBCATEGORY) = ''
+
+ tzbudiachro%lleveluse(NLVL_GROUP) = .true.
+ tzbudiachro%clevels (NLVL_GROUP) = Trim( tpbudget%cname )
+ tzbudiachro%ccomments(NLVL_GROUP) = Trim( tpbudget%ccomment )
+
+ tzbudiachro%lleveluse(NLVL_SHAPE) = .false.
+ if ( ybutype == 'CART' ) then
+ tzbudiachro%clevels (NLVL_SHAPE) = 'Cartesian'
+ tzbudiachro%ccomments(NLVL_SHAPE) = 'Cartesian domain'
+ else
+ tzbudiachro%clevels (NLVL_SHAPE) = 'Mask'
+ tzbudiachro%ccomments(NLVL_SHAPE) = 'Masked domain'
+ end if
+
+ tzbudiachro%lleveluse(NLVL_TIMEAVG) = .false.
+ tzbudiachro%clevels (NLVL_TIMEAVG) = 'Time_averaged'
+ tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are time averaged'
+
+ tzbudiachro%lleveluse(NLVL_NORM) = .false.
+ tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+ tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+
+ tzbudiachro%lleveluse(NLVL_MASK) = .false.
+ if ( ybutype == 'MASK' ) then
+ tzbudiachro%clevels (NLVL_MASK) = CMASK_VARNAME
+ tzbudiachro%ccomments(NLVL_MASK) = ''
+ else
+ tzbudiachro%clevels (NLVL_MASK) = ''
+ tzbudiachro%ccomments(NLVL_MASK) = ''
+ end if
+
if ( ybutype == 'CART' ) then
- tzbudiachro%cshape = 'cartesian'
+ tzbudiachro%lmobile = .false.
else
- tzbudiachro%cshape = 'mask'
+ !Masks are updated at each timestep (therefore the studied domains change during execution)
+ tzbudiachro%lmobile = .true.
end if
- tzbudiachro%lmobile = .false.
tzbudiachro%licompress = lbu_icp
tzbudiachro%ljcompress = lbu_jcp
tzbudiachro%lkcompress = lbu_kcp
+ !Remark: ltcompress should be false for INIF and ENDF fields
+ ! but if set to false these fields should be separated and stored somewhere else
+ tzbudiachro%ltcompress = .true. !Data is temporally averaged
+ tzbudiachro%lnorm = .false.
+ !Boundaries in physical domain does not make sense here if 'MASK'
+ !In that case, these values are not written in the netCDF files
+ !But they are always written in the LFI files. They are kept (in the MASK case) for backward compatibility.
tzbudiachro%nil = nbuil
tzbudiachro%nih = nbuih
tzbudiachro%njl = nbujl
tzbudiachro%njh = nbujh
tzbudiachro%nkl = nbukl
tzbudiachro%nkh = nbukh
+ if ( tpbudget%nid > NBUDGET_SV1 ) then
+ jsv = tpbudget%nid - NBUDGET_SV1 + 1
+ else
+ jsv = -1
+ end if
tzbudiachro%nsv = jsv
call Write_diachro( tpdiafile, tzbudiachro, tzfields, tpdates, zworkt, osplit = .true. )
diff --git a/src/MNH/write_diachro.f90 b/src/MNH/write_diachro.f90
index 485909a62c4103ad9b3ada8e0f027453d1e58e45..de060fcd60dce31ab3852296d6d139355b05f2ed 100644
--- a/src/MNH/write_diachro.f90
+++ b/src/MNH/write_diachro.f90
@@ -13,6 +13,9 @@ private
public :: Write_diachro
+interface Att_write
+ procedure Att_write_c0, Att_write_i0, Att_write_x0
+end interface
contains
! #################################################################
@@ -139,7 +142,7 @@ end subroutine Write_diachro
subroutine Write_diachro_lfi( tpdiafile, tpbudiachro, tpfields, tpdates, pvar, tpflyer )
use modd_aircraft_balloon, only: flyer
-use modd_budget, only: nbumask, nbutshift, nbusubwrite, tbudiachrometadata
+use modd_budget, only: NLVL_CATEGORY, NLVL_GROUP, NLVL_SHAPE, nbumask, nbutshift, nbusubwrite, tbudiachrometadata
use modd_field, only: NMNHDIM_ONE, NMNHDIM_UNKNOWN, NMNHDIM_FLYER_TIME, NMNHDIM_NOTLISTED, NMNHDIM_UNUSED, &
TYPECHAR, TYPEINT, TYPEREAL, &
tfield_metadata_base, tfielddata
@@ -168,6 +171,8 @@ integer, parameter :: LFITITLELGT = 100
integer, parameter :: LFIUNITLGT = 100
integer, parameter :: LFICOMMENTLGT = 100
+character(len=:), allocatable :: ycategory
+character(len=:), allocatable :: yshape
character(len=:), allocatable :: ytype
CHARACTER(LEN=20) :: YCOMMENT
CHARACTER(LEN=3) :: YJ
@@ -185,6 +190,7 @@ INTEGER :: IIMASK, IJMASK, IKMASK, ITMASK, INMASK, IPMASK
INTEGER :: IIMAX_ll, IJMAX_ll ! size of the physical global domain
integer :: ji
INTEGER,DIMENSION(:),ALLOCATABLE :: ITABCHAR
+logical :: gdistributed
real, dimension(:,:), allocatable :: ztimes
real, dimension(:,:), allocatable :: zdatime
real, dimension(:,:,:), allocatable :: ztrajz
@@ -202,37 +208,135 @@ ijh = tpbudiachro%njh
ikl = tpbudiachro%nkl
ikh = tpbudiachro%nkh
+ycategory = Trim( tpbudiachro%clevels(NLVL_CATEGORY) )
+yshape = Trim( tpbudiachro%clevels(NLVL_SHAPE) )
+
+!For backward compatibility of LFI files
+if ( tpbudiachro%cdirection == 'I' ) then
+ ijl = 1
+ ijh = 1
+else if ( tpbudiachro%cdirection == 'J' ) then
+ iil = 1
+ iih = 1
+end if
+
!Write only in LFI files
tzfile%cformat = 'LFI'
YCOMMENT='NOTHING'
!Set ygroup to preserve backward compatibility of LFI files
-if ( Any( tpbudiachro%cgroupname == [ 'RJS', 'RJX', 'RJY', 'RJZ'] ) &
- .or. Any( tpbudiachro%cgroupname == [ 'UU', 'VV', 'WW', 'TH', 'TK', 'RV', 'RC', 'RR', 'RI', 'RS', 'RG', 'RH' ] ) &
- .or. ( tpbudiachro%cgroupname(1:2) == 'SV' .and. Len_trim( tpbudiachro%cgroupname ) == 5 ) ) then
+if ( Any( tpbudiachro%clevels(NLVL_GROUP) == [ 'UU', 'VV', 'WW', 'TH', 'TK', 'RV', 'RC', 'RR', 'RI', 'RS', 'RG', 'RH' ] ) &
+ .or. ( tpbudiachro%clevels(NLVL_GROUP)(1:2) == 'SV' .and. Len_trim( tpbudiachro%clevels(NLVL_GROUP) ) == 5 ) ) then
Allocate( character(len=9) :: ygroup )
- ygroup(:) = Trim( tpbudiachro%cgroupname )
- do ji = Len_trim( tpbudiachro%cgroupname ) + 1, 5
+ ygroup(:) = Trim( tpbudiachro%clevels(NLVL_GROUP) )
+ do ji = Len_trim( tpbudiachro%clevels(NLVL_GROUP) ) + 1, 5
ygroup(ji : ji) = '_'
end do
Write( ygroup(6:9), '( i4.4 )' ) nbutshift
+else if ( tpbudiachro%clevels(NLVL_GROUP) == 'RhodJ' ) then
+ Allocate( character(len=9) :: ygroup )
+
+ if ( tpfields(1)%cmnhname == 'RhodJX' ) then
+ ygroup(1:3) = 'RJX'
+ else if ( tpfields(1)%cmnhname == 'RhodJY' ) then
+ ygroup(1:3) = 'RJY'
+ else if ( tpfields(1)%cmnhname == 'RhodJZ' ) then
+ ygroup(1:3) = 'RJZ'
+ else if ( tpfields(1)%cmnhname == 'RhodJS' ) then
+ ygroup(1:3) = 'RJS'
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_lfi', 'unknown variable ' // Trim( tpfields(1)%cmnhname ) // &
+ ' for group ' // Trim( tpbudiachro%clevels(NLVL_GROUP) ) )
+ end if
+
+ ygroup(4:5) = '__'
+ Write( ygroup(6:9), '( i4.4 )' ) nbutshift
else if ( tpbudiachro%nsv > 0 ) then
Allocate( character(len=9) :: ygroup )
Write( ygroup, '( "SV", i3.3, i4.4 )' ) tpbudiachro%nsv, nbutshift
else
- ygroup = Trim( tpbudiachro%cgroupname )
+ ygroup = Trim( tpbudiachro%clevels(NLVL_GROUP) )
end if
-ytype = Trim( tpbudiachro%ctype )
+!For backward compatibility
+if ( Trim( tpbudiachro%clevels(NLVL_CATEGORY) ) == 'Flyers' &
+ .and. Trim( tpbudiachro%clevels(NLVL_SHAPE) ) == 'Vertical_profile' ) then
+ ygroup = Trim( ygroup ) // 'Z'
+end if
+
+if ( Trim( tpbudiachro%clevels(NLVL_CATEGORY) ) == 'LES_budgets' &
+ .and. Trim( tpbudiachro%clevels(NLVL_SHAPE) ) == 'Cartesian' ) then
+ if ( tpbudiachro%ltcompress ) then
+ if ( tpbudiachro%lnorm ) then
+ ygroup = 'H_' // Trim( ygroup )
+ else
+ ygroup = 'A_' // Trim( ygroup )
+ end if
+ else
+ if ( tpbudiachro%lnorm ) then
+ ygroup = 'E_' // Trim( ygroup )
+ else
+ !Nothing to do
+ end if
+ end if
+ !Limit to 10 characters (backward compatibility again...)
+ if ( Len_trim( ygroup ) > 10 ) ygroup = ygroup(1:10)
+end if
+
+if ( Trim( tpbudiachro%clevels(NLVL_CATEGORY) ) == 'LES_budgets' &
+ .and. Trim( tpbudiachro%clevels(NLVL_SHAPE) ) == 'Spectrum' ) then
+ if ( tpbudiachro%ltcompress ) then
+ ygroup = 'T_' // Trim( ygroup )
+ !Limit to 10 characters (backward compatibility again...)
+ if ( Len_trim( ygroup ) > 10 ) ygroup = ygroup(1:10)
+ end if
+end if
+
+!Recompute old TYPE for backward compatibility
+if ( ycategory == 'Budgets' ) then
+ if ( yshape == 'Cartesian' ) then
+ ytype = 'CART'
+ else
+ ytype = 'MASK'
+ end if
+else if ( ycategory == 'LES_budgets' ) then
+ if ( yshape == 'Cartesian' ) then
+ ytype = 'SSOL'
+ else
+ ytype = 'SPXY'
+ end if
+else if ( ycategory == 'Flyers' ) then
+ if ( yshape == 'Point' ) then
+ ytype = 'RSPL'
+ else
+ ytype = 'CART'
+ end if
+else if ( ycategory == 'Profilers' .or. ycategory == 'Stations' ) then
+ ytype = 'CART'
+else if ( ycategory == 'Time_series' ) then
+ if ( tpbudiachro%licompress ) then
+ ytype = 'CART'
+ else
+ ytype = 'SSOL'
+ end if
+else
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_lfi', &
+ 'unknown classification for type of variable '//trim(tpfields(1)%cmnhname) )
+ ytype = 'UNKN'
+end if
II = SIZE(PVAR,1)
IJ = SIZE(PVAR,2)
-IF(YTYPE == 'CART' .AND. .NOT. tpbudiachro%licompress .AND. .NOT. tpbudiachro%ljcompress) THEN
- !for parallel execution, PVAR is distributed on several proc
+if ( ycategory == 'Budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' &
+ .and. .not. tpbudiachro%licompress .and. .not. tpbudiachro%ljcompress ) then
II=iih-iil+1
IJ=ijh-ijl+1
-ENDIF
+ gdistributed = .true.
+else
+ !By default data is already collected on the write process for budgets
+ gdistributed = .false.
+end if
IK = SIZE(PVAR,3)
IT = SIZE(PVAR,4)
IN = SIZE(PVAR,5)
@@ -247,7 +351,7 @@ IF ( PRESENT( tpflyer ) ) THEN
IKTRAJX = 1
ITTRAJX = SIZE( tpflyer%x )
INTRAJX = 1
-ELSE IF ( tpbudiachro%ctype == 'TLES' ) THEN
+ELSE IF ( ycategory == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' ) THEN
IKTRAJX = 1
ITTRAJX = 1
INTRAJX = IN
@@ -256,7 +360,7 @@ IF ( PRESENT( tpflyer ) ) THEN
IKTRAJY = 1
ITTRAJY = SIZE( tpflyer%y )
INTRAJY = 1
-ELSE IF ( tpbudiachro%ctype == 'TLES' ) THEN
+ELSE IF ( ycategory == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' ) THEN
IKTRAJY = 1
ITTRAJY = 1
INTRAJY = IN
@@ -265,14 +369,14 @@ IF ( PRESENT( tpflyer ) ) THEN
IKTRAJZ = 1
ITTRAJZ = SIZE( tpflyer%z )
INTRAJZ = 1
-ELSE IF ( tpbudiachro%ctype == 'TLES' ) THEN
+ELSE IF ( ycategory == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' ) THEN
IKTRAJZ = IK
ITTRAJZ = 1
INTRAJZ = IN
ENDIF
IIMASK=0; IJMASK=0; IKMASK=0; ITMASK=0; INMASK=0; IPMASK=0
-IF(YTYPE == 'MASK')THEN
+IF ( tpbudiachro%clevels(NLVL_SHAPE) == 'Mask' ) THEN
! MASK is written outside this routine but the dimensions must be initialized
! the mask is defined on the extended domain
CALL GET_GLOBALDIMS_ll (IIMAX_ll,IJMAX_ll)
@@ -333,7 +437,7 @@ SELECT CASE(YTYPE)
ITABCHAR(16)=Merge( 1, 0, tpbudiachro%licompress )
ITABCHAR(17)=Merge( 1, 0, tpbudiachro%ljcompress )
ITABCHAR(18)=Merge( 1, 0, tpbudiachro%lkcompress )
- IF(YTYPE == 'MASK')THEN
+ IF( tpbudiachro%clevels(NLVL_SHAPE) == 'Mask' )THEN
! ITABCHAR(10)=1; ITABCHAR(11)=1
! ITABCHAR(13)=1; ITABCHAR(14)=1
ITABCHAR(16)=1; ITABCHAR(17)=1
@@ -445,7 +549,7 @@ DO J = 1,IP
ELSE IF(J >= 100 .AND. J < 1000) THEN
WRITE(YJ,'(I3)')J
ENDIF
- IF(YTYPE == 'CART' .AND. .NOT. tpbudiachro%licompress .AND. .NOT. tpbudiachro%ljcompress) THEN
+ IF ( gdistributed ) THEN
TZFIELD%CMNHNAME = TRIM(ygroup)//'.PROC'//YJ
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -528,7 +632,7 @@ IF(PRESENT(tpflyer))THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
CALL IO_Field_write(tzfile,TZFIELD, Reshape( tpflyer%x, [1, Size( tpflyer%x), 1] ) )
-ELSE IF ( tpbudiachro%ctype == 'TLES' ) THEN
+ELSE IF ( ycategory == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' ) THEN
TZFIELD%CMNHNAME = TRIM(ygroup)//'.TRAJX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(ygroup)//'.TRAJX'
@@ -540,9 +644,9 @@ ELSE IF ( tpbudiachro%ctype == 'TLES' ) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
!TRAJX is given in extended domain coordinates (=> +jphext) for backward compatibility
- CALL IO_Field_write(tzfile,TZFIELD, Reshape( &
+ CALL IO_Field_write(tzfile,TZFIELD, Real( Reshape( &
Spread( source = ( nles_current_iinf + nles_current_isup) / 2 + jphext, dim = 1, ncopies = IN ), &
- [1, 1, IN] ) )
+ [1, 1, IN] ) ) )
ENDIF
!
! 9eme enregistrement TRAJY
@@ -559,7 +663,7 @@ IF(PRESENT(tpflyer))THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
CALL IO_Field_write(tzfile,TZFIELD, Reshape( tpflyer%y, [1, Size( tpflyer%y), 1] ) )
-ELSE IF ( tpbudiachro%ctype == 'TLES' ) THEN
+ELSE IF ( ycategory == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' ) THEN
TZFIELD%CMNHNAME = TRIM(ygroup)//'.TRAJY'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(ygroup)//'.TRAJY'
@@ -571,9 +675,9 @@ ELSE IF ( tpbudiachro%ctype == 'TLES' ) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
!TRAJY is given in extended domain coordinates (=> +jphext) for backward compatibility
- CALL IO_Field_write(tzfile,TZFIELD, Reshape( &
+ CALL IO_Field_write(tzfile,TZFIELD, Real( Reshape( &
Spread( source = ( nles_current_jinf + nles_current_jsup) / 2 + jphext, dim = 1, ncopies = IN ), &
- [1, 1, IN] ) )
+ [1, 1, IN] ) ) )
ENDIF
!
! 10eme enregistrement TRAJZ
@@ -590,7 +694,7 @@ IF(PRESENT(tpflyer))THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
CALL IO_Field_write(tzfile,TZFIELD, Reshape( tpflyer%z, [1, Size( tpflyer%z), 1] ) )
-ELSE IF ( tpbudiachro%ctype == 'TLES' ) THEN
+ELSE IF ( ycategory == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' ) THEN
TZFIELD%CMNHNAME = TRIM(ygroup)//'.TRAJZ'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(ygroup)//'.TRAJZ'
@@ -656,16 +760,18 @@ end subroutine Write_diachro_lfi
!-----------------------------------------------------------------------------
subroutine Write_diachro_nc4( tpdiafile, tpbudiachro, tpfields, pvar, osplit, tpflyer )
-use NETCDF, only: NF90_DEF_DIM, NF90_DEF_GRP, NF90_DEF_VAR, NF90_INQ_NCID, NF90_PUT_ATT, NF90_PUT_VAR, &
- NF90_GLOBAL, NF90_NOERR, NF90_STRERROR
+use NETCDF, only: NF90_DEF_DIM, NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION, NF90_NOERR
use modd_aircraft_balloon, only: flyer
-use modd_budget, only: nbutshift, nbusubwrite, tbudiachrometadata
+use modd_budget, only: CNCGROUPNAMES, &
+ NMAXLEVELS, NLVL_ROOT, NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, &
+ NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK, &
+ nbutshift, nbusubwrite, tbudiachrometadata
use modd_conf, only: lcartesian
use modd_field
use modd_io, only: isp, tfiledata
-use modd_les, only: nles_masks
-use modd_parameters, only: jphext
+use modd_les, only: cbl_height_def, cles_norm_type, nles_masks, xles_temp_sampling
+use modd_parameters, only: jphext, NBUNAMELGTMAX, NCOMMENTLGTMAX
use modd_precision, only: CDFINT, MNHREAL_NF90
use modd_type_date, only: date_time
@@ -679,33 +785,38 @@ real, dimension(:,:,:,:,:,:), intent(in) :: pva
logical, intent(in), optional :: osplit
type(flyer), intent(in), optional :: tpflyer
-character(len=:), allocatable :: ygroup
-character(len=:), allocatable :: ytype
+character(len=:), allocatable :: ycategory
+character(len=:), allocatable :: ylevelname
+character(len=:), allocatable :: ylevels
+character(len=:), allocatable :: yshape
character(len=:), allocatable :: ystdnameprefix
-integer :: iil, iih, ijl, ijh, ikl, ikh
-integer :: idims
-integer :: icount
-integer :: icorr
-integer :: ji
-integer :: jp
-integer(kind=CDFINT) :: isavencid
-integer(kind=CDFINT) :: idimid
-integer(kind=CDFINT) :: igrpid
-integer(kind=CDFINT) :: istatus
-logical :: gdistributed
-logical :: ggroupdefined
-logical :: gsplit
-type(tfielddata) :: tzfield
-type(tfiledata) :: tzfile
-
-ytype = Trim( tpbudiachro%ctype )
+integer :: iil, iih, ijl, ijh, ikl, ikh
+integer :: idims
+integer :: icount
+integer :: icorr
+integer :: ji
+integer :: jl
+integer :: jp
+integer(kind=CDFINT) :: idimid
+integer(kind=CDFINT) :: ilen
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: ilevelid
+integer(kind=CDFINT), dimension(0:NMAXLEVELS) :: ilevelids ! ids of the different groups/levels in the netCDF file
+logical :: gdistributed
+logical :: gsplit
+logical(kind=CDFINT), dimension(0:NMAXLEVELS) :: gleveldefined ! Are the different groups/levels already defined in the netCDF file
+type(tfielddata) :: tzfield
+type(tfiledata) :: tzfile
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Write_diachro_nc4', 'called' )
tzfile = tpdiafile
!Write only in netCDF files
tzfile%cformat = 'NETCDF4'
-ygroup = tpbudiachro%cgroupname
+ycategory = Trim( tpbudiachro%clevels(NLVL_CATEGORY) )
+yshape = Trim( tpbudiachro%clevels(NLVL_SHAPE) )
iil = tpbudiachro%nil
iih = tpbudiachro%nih
@@ -714,14 +825,8 @@ ijh = tpbudiachro%njh
ikl = tpbudiachro%nkl
ikh = tpbudiachro%nkh
-if ( trim ( ytype ) == 'CART' .or. trim ( ytype ) == 'MASK' .or. trim ( ytype ) == 'SPXY') then
- if ( iil < 0 .or. iih < 0 .or. ijl < 0 .or. ijh < 0 .or. ikl < 0 .or. ikh < 0 ) then
- call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
- 'nil, nih, njl, njh, nkl or nkh not set in tpbudiachro for variable ' // Trim( tpfields(1)%cmnhname ) )
- end if
-end if
-
-if ( Trim( ytype ) == 'CART' .and. .not. tpbudiachro%licompress .and. .not. tpbudiachro%ljcompress ) then
+if ( ycategory == 'Budgets' .and. yshape == 'Cartesian' &
+ .and. .not. tpbudiachro%licompress .and. .not. tpbudiachro%ljcompress ) then
gdistributed = .true.
else
!By default data is already collected on the write process for budgets
@@ -735,82 +840,159 @@ else
end if
MASTER: if ( isp == tzfile%nmaster_rank) then
- ggroupdefined = .false.
+ ilevelids(NLVL_ROOT) = tzfile%nncid
- istatus = NF90_INQ_NCID( tzfile%nncid, trim( ygroup ), igrpid )
- if ( istatus == NF90_NOERR ) then
- ggroupdefined = .true.
- if ( .not. gsplit ) then
- call Print_msg( NVERB_WARNING, 'IO', 'Write_diachro_nc4', trim(tzfile%cname)//': group '//trim(ygroup)//' already defined' )
- end if
- else
- istatus = NF90_DEF_GRP( tzfile%nncid, trim( ygroup ), igrpid )
- if ( istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_DEF_GRP', 'for '//trim(ygroup)//' group' )
- end if
+ gleveldefined(:) = .false.
+
+ do jl = 1, NMAXLEVELS
+ call Move_to_next_level( ilevelids(jl-1), gleveldefined(jl-1), tpbudiachro%lleveluse(jl), &
+ tpbudiachro%clevels(jl), gleveldefined(jl), ilevelids(jl) )
+ end do
+
+ tzfile%nncid = ilevelids(NLVL_MASK)
+
+ ylevels = ''
- !Save id of the file root group ('/' group)
- isavencid = tzfile%nncid
- tzfile%nncid = igrpid
+ do jl = NMAXLEVELS, 1, -1
+ ylevels = Trim( CNCGROUPNAMES(jl) ) // ' ' // ylevels
+ if ( tpbudiachro%lleveluse(jl) ) then
+ call Att_write( tpbudiachro%clevels(jl), ilevelids(jl), 'levels', Trim( ylevels ) )
+ ylevels = ''
+ end if
+ end do
- if ( .not. ggroupdefined ) then
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'name', Trim( tpbudiachro%cname ) )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'name for '//trim(ygroup)//' group' )
+ if ( .not. gleveldefined(NLVL_CATEGORY) ) then
+ ylevelname = tpbudiachro%clevels(NLVL_CATEGORY)
+ ilevelid = ilevelids (NLVL_CATEGORY)
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'comment', Trim( tpbudiachro%ccomment ) )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'comment for '//trim(ygroup)//' group' )
+ call Att_write( ylevelname, ilevelid, 'category', ylevelname )
+ if ( tpbudiachro%lleveluse(NLVL_CATEGORY) .and. Len_trim( tpbudiachro%ccomments(NLVL_CATEGORY) ) > 0 ) &
+ call Att_write( ylevelname, ilevelid, 'comment', tpbudiachro%ccomments(NLVL_CATEGORY) )
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'type', trim( ytype ) )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'type for '//trim(ygroup)//' group' )
+ if ( ycategory == 'LES_budgets' ) &
+ call Att_write( ylevelname, ilevelid, 'temporal_sampling_frequency', xles_temp_sampling )
+ end if
- if ( trim ( ytype ) == 'CART' .or. trim ( ytype ) == 'MASK' .or. trim ( ytype ) == 'SPXY') then
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'min x index in physical domain', iil )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'min x index for '//trim(ygroup)//' group' )
+ if ( .not. gleveldefined(NLVL_SUBCATEGORY) ) then
+ ylevelname = tpbudiachro%clevels(NLVL_SUBCATEGORY)
+ ilevelid = ilevelids (NLVL_SUBCATEGORY)
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'max x index in physical domain', iih )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'max x index for '//trim(ygroup)//' group' )
+ call Att_write( ylevelname, ilevelid, 'subcategory', ylevelname )
+ if ( tpbudiachro%lleveluse(NLVL_SUBCATEGORY) .and. Len_trim( tpbudiachro%ccomments(NLVL_SUBCATEGORY) ) > 0 ) &
+ call Att_write( ylevelname, ilevelid, 'comment', tpbudiachro%ccomments(NLVL_SUBCATEGORY) )
+ end if
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'min y index in physical domain', ijl )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'min y index for '//trim(ygroup)//' group' )
+ if ( .not. gleveldefined(NLVL_GROUP) ) then
+ ylevelname = tpbudiachro%clevels(NLVL_GROUP)
+ ilevelid = ilevelids (NLVL_GROUP)
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'max y index in physical domain', ijh )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'max y index for '//trim(ygroup)//' group' )
+ call Att_write( ylevelname, ilevelid, 'group', ylevelname )
+ if ( tpbudiachro%lleveluse(NLVL_GROUP) .and. Len_trim( tpbudiachro%ccomments(NLVL_GROUP) ) > 0 ) &
+ call Att_write( ylevelname, ilevelid, 'comment', tpbudiachro%ccomments(NLVL_GROUP) )
+ end if
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'min z index in physical domain', ikl )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'min z index for '//trim(ygroup)//' group' )
+ if ( .not. gleveldefined(NLVL_SHAPE) ) then
+ ylevelname = tpbudiachro%clevels(NLVL_SHAPE)
+ ilevelid = ilevelids (NLVL_SHAPE)
+
+ call Att_write( ylevelname, ilevelid, 'shape', ylevelname )
+ if ( tpbudiachro%lleveluse(NLVL_SHAPE) .and. Len_trim( tpbudiachro%ccomments(NLVL_SHAPE) ) > 0 ) &
+ call Att_write( ylevelname, ilevelid, 'comment', tpbudiachro%ccomments(NLVL_SHAPE) )
+
+ call Att_write( ylevelname, ilevelid, 'moving', Merge( 'yes', 'no ', tpbudiachro%lmobile ) )
+
+ if ( ( ycategory == 'Budgets' .and. yshape == 'Cartesian' ) &
+ .or. ycategory == 'LES_budgets' &
+ .or. tpbudiachro%clevels(NLVL_GROUP) == 'TSERIES' &
+ .or. tpbudiachro%clevels(NLVL_GROUP) == 'ZTSERIES' &
+ .or. tpbudiachro%clevels(NLVL_GROUP)(1:8) == 'XTSERIES' ) then
+ call Att_write( ylevelname, ilevelid, 'min_I_index_in_physical_domain', iil )
+ call Att_write( ylevelname, ilevelid, 'max_I_index_in_physical_domain', iih )
+ call Att_write( ylevelname, ilevelid, 'min_J_index_in_physical_domain', ijl )
+ call Att_write( ylevelname, ilevelid, 'max_J_index_in_physical_domain', ijh )
+ end if
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'max z index in physical domain', ikh )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'max z index for '//trim(ygroup)//' group' )
+ if ( ( ycategory == 'Budgets' .and. yshape == 'Cartesian' ) &
+ .or. tpbudiachro%clevels(NLVL_GROUP) == 'TSERIES' &
+ .or. tpbudiachro%clevels(NLVL_GROUP) == 'ZTSERIES' &
+ .or. tpbudiachro%clevels(NLVL_GROUP)(1:8) == 'XTSERIES' ) then
+ !Disabled for LES_budgets because no real meaning on that case (vertical levels are stored in the level_les variable)
+ call Att_write( ylevelname, ilevelid, 'min_K_index_in_physical_domain', ikl )
+ call Att_write( ylevelname, ilevelid, 'max_K_index_in_physical_domain', ikh )
end if
- if ( trim ( ytype ) == 'CART' ) then
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'averaged on x dimension', Merge( 1, 0, tpbudiachro%licompress ) )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'averaged on x dimension '//trim(ygroup)//' group' )
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'averaged on y dimension', Merge( 1, 0, tpbudiachro%ljcompress ) )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'averaged on y dimension '//trim(ygroup)//' group' )
+ if ( ( ycategory == 'Budgets' .and. yshape == 'Cartesian' ) &
+ .or. ( ycategory == 'LES_budgets' .and. yshape == 'Cartesian' ) &
+ .or. tpbudiachro%clevels(NLVL_GROUP) == 'TSERIES' &
+ .or. tpbudiachro%clevels(NLVL_GROUP) == 'ZTSERIES' &
+ .or. tpbudiachro%clevels(NLVL_GROUP)(1:8) == 'XTSERIES' ) then
+ call Att_write( ylevelname, ilevelid, &
+ 'averaged_in_the_I_direction', Merge( 'yes', 'no ', tpbudiachro%licompress ) )
+ call Att_write( ylevelname, ilevelid, &
+ 'averaged_in_the_J_direction', Merge( 'yes', 'no ', tpbudiachro%ljcompress ) )
+ call Att_write( ylevelname, ilevelid, &
+ 'averaged_in_the_K_direction', Merge( 'yes', 'no ', tpbudiachro%lkcompress ) )
end if
+ end if
+
+ if ( .not. gleveldefined(NLVL_TIMEAVG) ) then
+ ylevelname = tpbudiachro%clevels(NLVL_TIMEAVG)
+ ilevelid = ilevelids (NLVL_TIMEAVG)
+
+ if ( tpbudiachro%lleveluse(NLVL_TIMEAVG) .and. Len_trim( tpbudiachro%ccomments(NLVL_TIMEAVG) ) > 0 ) &
+ call Att_write( ylevelname, ilevelid, 'comment', tpbudiachro%ccomments(NLVL_TIMEAVG) )
+
+ call Att_write( ylevelname, ilevelid, 'time_averaged', Merge( 'yes', 'no ', tpbudiachro%ltcompress ) )
+ end if
- if ( trim ( ytype ) == 'CART' .or. trim ( ytype ) == 'MASK' .or. trim ( ytype ) == 'SPXY') then
- istatus = NF90_PUT_ATT( igrpid, NF90_GLOBAL, 'averaged on z dimension', Merge( 1, 0, tpbudiachro%lkcompress ) )
- if (istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', 'averaged on z dimension '//trim(ygroup)//' group' )
+ if ( .not. gleveldefined(NLVL_NORM) ) then
+ ylevelname = tpbudiachro%clevels(NLVL_NORM)
+ ilevelid = ilevelids (NLVL_NORM)
+
+ if ( tpbudiachro%lleveluse(NLVL_NORM) .and. Len_trim( tpbudiachro%ccomments(NLVL_NORM) ) > 0 ) &
+ call Att_write( ylevelname, ilevelid, 'comment', tpbudiachro%ccomments(NLVL_NORM) )
+
+ call Att_write( ylevelname, ilevelid, 'normalized', Merge( 'yes', 'no ', tpbudiachro%lnorm ) )
+
+ if ( ycategory == 'LES_budgets' .and. yshape == 'Cartesian' ) then
+ if ( tpbudiachro%lnorm ) then
+ if ( cles_norm_type == 'NONE' ) then
+ call Att_write( ylevelname, ilevelid, 'normalization', 'none' )
+ else if ( cles_norm_type == 'CONV' ) then
+ call Att_write( ylevelname, ilevelid, 'normalization', 'convective' )
+ ! cbl_height_def determines how the boundary layer height is computed, which is used in this normalization
+ call Att_write( ylevelname, ilevelid, 'definition_of_boundary_layer_height', cbl_height_def )
+ else if ( cles_norm_type == 'EKMA' ) then
+ call Att_write( ylevelname, ilevelid, 'normalization', 'Ekman' )
+ ! cbl_height_def determines how the boundary layer height is computed, which is used in this normalization
+ call Att_write( ylevelname, ilevelid, 'definition_of_boundary_layer_height', cbl_height_def )
+ else if ( cles_norm_type == 'MOBU' ) then
+ call Att_write( ylevelname, ilevelid, 'normalization', 'Monin-Obukhov' )
+ else
+ call Print_msg( NVERB_WARNING, 'IO', 'Write_diachro_nc4', Trim( tzfile%cname ) // &
+ ': group ' // Trim( tpbudiachro%clevels(NLVL_GROUP) ) // ': unknown normalization' )
+ call Att_write( ylevelname, ilevelid, 'normalization', 'unknown' )
+ end if
+ else
+ call Att_write( ylevelname, ilevelid, 'normalization', 'none' )
+ end if
end if
end if
-end if MASTER
+ if ( .not. gleveldefined(NLVL_MASK) ) then
+ ylevelname = tpbudiachro%clevels(NLVL_MASK)
+ ilevelid = ilevelids (NLVL_MASK)
+ call Att_write( ylevelname, ilevelid, 'mask', ylevelname )
+ if ( tpbudiachro%lleveluse(NLVL_MASK) .and. Len_trim( tpbudiachro%ccomments(NLVL_MASK) ) > 0 ) &
+ call Att_write( ylevelname, ilevelid, 'comment', tpbudiachro%ccomments(NLVL_MASK) )
+
+ if ( ycategory == 'Budgets' .and. yshape == 'Mask' ) &
+ call Att_write( ylevelname, ilevelid, 'masks_are_stored_in_variable', tpbudiachro%clevels(NLVL_MASK) )
+ end if
+
+end if MASTER
!Determine the number of dimensions and do some verifications
do jp = 1, Size( tpfields )
@@ -848,12 +1030,12 @@ do jp = 2, Size( tpfields )
end do
end do
-!Check that if 'CART' and no horizontal compression, parameters are as expected
-if ( ytype == 'CART' .and. .not. tpbudiachro%licompress .and. .not. tpbudiachro%ljcompress ) then
+!Check that if cartesian and no horizontal compression, parameters are as expected
+if ( yshape == 'Cartesian' .and. .not. tpbudiachro%licompress .and. .not. tpbudiachro%ljcompress ) then
icorr = Merge( 1, 0, tpbudiachro%lkcompress )
if ( ( idims + icorr ) /= 3 .and. ( idims + icorr ) /= 4 ) then
- call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', &
- 'unexpected number of dimensions for CART without horizontal compression for variable ' &
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', &
+ 'unexpected number of dimensions for cartesian shape without horizontal compression for variable ' &
// Trim( tpfields(1)%cmnhname ) )
end if
@@ -866,7 +1048,7 @@ if ( ytype == 'CART' .and. .not. tpbudiachro%licompress .and. .not. tpbudiachro%
.or. ( .not. tpbudiachro%lkcompress &
.and. tpfields(1)%ndimlist(3) /= NMNHDIM_BUDGET_CART_LEVEL &
.and. tpfields(1)%ndimlist(3) /= NMNHDIM_BUDGET_CART_LEVEL_W ) &
- .or. ( idims == 4 .and. tpfields(1)%ndimlist(6) /= NMNHDIM_BUDGET_NGROUPS ) ) then
+ .or. ( ( idims + icorr ) == 4 .and. tpfields(1)%ndimlist(6) /= NMNHDIM_BUDGET_NGROUPS ) ) then
call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', &
'unexpected dimensions for CART without horizontal compression for variable ' &
// Trim( tpfields(1)%cmnhname ) )
@@ -877,40 +1059,41 @@ end if
select case ( idims )
case (0)
!Remark: [ integer:: ] is a constructor for a zero-size array of integers, [] is not allowed (type can not be determined)
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ integer:: ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ integer:: ], gsplit, gdistributed )
case (1)
- if ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME .or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) then
+ if ( Any ( tpfields(1)%ndimlist(4) == [ NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_LES_AVG_TIME, NMNHDIM_SERIES_TIME ] ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 4 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 4 ], gsplit, gdistributed )
else if ( Any( tpfields(1)%ndimlist(1) == [ NMNHDIM_NI, NMNHDIM_NI_U, NMNHDIM_NI_V, NMNHDIM_BUDGET_CART_NI, &
NMNHDIM_BUDGET_CART_NI_U, NMNHDIM_BUDGET_CART_NI_V ] ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 1 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 1 ], gsplit, gdistributed )
else if ( Any( tpfields(1)%ndimlist(2) == [ NMNHDIM_NJ, NMNHDIM_NJ_U, NMNHDIM_NJ_V, NMNHDIM_BUDGET_CART_NJ, &
NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NJ_V ] ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 2 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 2 ], gsplit, gdistributed )
else if ( Any( tpfields(1)%ndimlist(3) == [ NMNHDIM_LEVEL, NMNHDIM_LEVEL_W, &
NMNHDIM_BUDGET_CART_LEVEL, NMNHDIM_BUDGET_CART_LEVEL_W ] ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 3 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 3 ], gsplit, gdistributed )
else if ( tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
do ji = 1, Size( pvar, 6 )
!Remark: [ integer:: ] is a constructor for a zero-size array of integers, [] is not allowed (type can not be determined)
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ integer:: ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ integer:: ], &
+ gsplit, gdistributed )
end do
else
call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
- 'case not yet implemented (variable '//trim(tpfields(1)%cmnhname)//')' )
+ 'case not yet implemented (1D variable '//trim(tpfields(1)%cmnhname)//')' )
end if
@@ -922,7 +1105,7 @@ select case ( idims )
NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NJ_V ] ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 1, 2 ], gsplit, gdistributed, &
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 1, 2 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
else if ( Any( tpfields(1)%ndimlist(1) == [ NMNHDIM_NI, NMNHDIM_NI_U, NMNHDIM_NI_V, NMNHDIM_BUDGET_CART_NI, &
NMNHDIM_BUDGET_CART_NI_U, NMNHDIM_BUDGET_CART_NI_V ] ) &
@@ -930,72 +1113,94 @@ select case ( idims )
NMNHDIM_BUDGET_CART_LEVEL, NMNHDIM_BUDGET_CART_LEVEL_W ] ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 1, 3 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 1, 3 ], gsplit, gdistributed )
else if ( Any( tpfields(1)%ndimlist(2) == [ NMNHDIM_NJ, NMNHDIM_NJ_U, NMNHDIM_NJ_V, NMNHDIM_BUDGET_CART_NJ, &
NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NJ_V ] ) &
.and. Any( tpfields(1)%ndimlist(3) == [ NMNHDIM_LEVEL, NMNHDIM_LEVEL_W, &
NMNHDIM_BUDGET_CART_LEVEL, NMNHDIM_BUDGET_CART_LEVEL_W ] ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 2, 3 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 2, 3 ], gsplit, gdistributed )
else if ( Any( tpfields(1)%ndimlist(1) == [ NMNHDIM_BUDGET_CART_NI, NMNHDIM_BUDGET_CART_NI_U, NMNHDIM_BUDGET_CART_NI_V ] ) &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 1 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 1 ], gsplit, gdistributed )
end do
else if ( Any( tpfields(1)%ndimlist(2) == [ NMNHDIM_BUDGET_CART_NJ, NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NJ_V ] ) &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 2 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 2 ], gsplit, gdistributed )
end do
else if ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_LES_LEVEL &
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 3, 4 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 3, 4 ], gsplit, gdistributed )
else if ( Any( tpfields(1)%ndimlist(3) == [ NMNHDIM_BUDGET_CART_LEVEL, NMNHDIM_BUDGET_CART_LEVEL_W ] ) &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 3 ], gsplit, gdistributed )
end do
else if ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_TIME .and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_MASK_NBUMASK ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 4, 5 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 4, 5 ], gsplit, gdistributed )
else if ( ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_LES_SV ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 4, 5 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 4, 5 ], gsplit, gdistributed )
else if ( tpfields(1)%ndimlist(4) == NMNHDIM_FLYER_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_FLYER_PROC ) then
!Correspond to FLYER_DIACHRO
!Create local time dimension
if ( isp == tzfile%nmaster_rank) then
- istatus = NF90_DEF_DIM( igrpid, 'time_flyer', Int( Size( pvar, 4), kind = CDFINT ), idimid )
- if ( istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_DEF_DIM', Trim( tpfields(1)%cmnhname ) )
+ istatus = NF90_INQ_DIMID( ilevelids(NLVL_GROUP), 'time_flyer', idimid )
+ if ( istatus == NF90_NOERR ) then
+ !Dimension already exists, check that it is not changed
+ istatus = NF90_INQUIRE_DIMENSION( ilevelids(NLVL_GROUP), idimid, len = ilen )
+ if ( ilen /= Int( Size( pvar, 4), kind = CDFINT ) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', 'time_flyer dimension has changed' )
+ else
+ !Dimension does not exist yet, create it
+ istatus = NF90_DEF_DIM( ilevelids(NLVL_GROUP), 'time_flyer', Int( Size( pvar, 4), kind = CDFINT ), idimid )
+ if ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_DEF_DIM', Trim( tpfields(1)%cmnhname ) )
+ end if
end if
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 4 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 4 ], gsplit, gdistributed )
end do
else if ( tpfields(1)%ndimlist(4) == NMNHDIM_SERIES_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_SERIES_PROC ) then
!Correspond to WRITE_SERIES_n
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 4 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 4 ], gsplit, gdistributed )
+ end do
+ else if ( ( tpfields(1)%ndimlist(3) == NMNHDIM_SERIES_LEVEL .or. tpfields(1)%ndimlist(3) == NMNHDIM_SERIES_LEVEL_W ) &
+ .and. tpfields(1)%ndimlist(4) == NMNHDIM_SERIES_TIME ) then
+ !Correspond to WRITE_SERIES_n
+ if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
+ 'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar(:,:,:,:,:,:), [ 3, 4 ], gsplit, gdistributed )
+ else if ( tpfields(1)%ndimlist(4) == NMNHDIM_STATION_TIME &
+ .and. tpfields(1)%ndimlist(6) == NMNHDIM_STATION_PROC ) then
+ !Correspond to WRITE_STATION_n
+ ! Loop on the processes
+ do ji = 1, Size( pvar, 6 )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 4 ], gsplit, gdistributed )
end do
else
call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
- 'case not yet implemented (variable '//trim(tpfields(1)%cmnhname)//')' )
+ 'case not yet implemented (2D variable '//trim(tpfields(1)%cmnhname)//')' )
end if
@@ -1009,15 +1214,15 @@ select case ( idims )
NMNHDIM_BUDGET_CART_LEVEL, NMNHDIM_BUDGET_CART_LEVEL_W ] ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 1, 2, 3 ], gsplit, gdistributed, &
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 1, 2, 3 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
else if ( Any(tpfields(1)%ndimlist(1) == [ NMNHDIM_BUDGET_CART_NI, NMNHDIM_BUDGET_CART_NI_U, NMNHDIM_BUDGET_CART_NI_V ]) &
.and. Any(tpfields(1)%ndimlist(2) == [ NMNHDIM_BUDGET_CART_NJ, NMNHDIM_BUDGET_CART_NJ_U, NMNHDIM_BUDGET_CART_NJ_V ]) &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 1, 2 ], gsplit, gdistributed, &
- iil, iih, ijl, ijh, ikl, ikh )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 1, 2 ], &
+ gsplit, gdistributed, iil, iih, ijl, ijh, ikl, ikh )
end do
else if ( Any ( tpfields(1)%ndimlist(1) == [ NMNHDIM_BUDGET_CART_NI, NMNHDIM_BUDGET_CART_NI_U, &
NMNHDIM_BUDGET_CART_NI_V ] ) &
@@ -1025,7 +1230,7 @@ select case ( idims )
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 1, 3 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 1, 3 ], gsplit, gdistributed )
end do
else if ( Any ( tpfields(1)%ndimlist(2) == [ NMNHDIM_BUDGET_CART_NJ, NMNHDIM_BUDGET_CART_NJ_U, &
NMNHDIM_BUDGET_CART_NJ_V ] ) &
@@ -1033,7 +1238,7 @@ select case ( idims )
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 2, 3 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 2, 3 ], gsplit, gdistributed )
end do
else if ( ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_MASK_LEVEL &
.or. tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_MASK_LEVEL_W ) &
@@ -1042,7 +1247,7 @@ select case ( idims )
!Correspond to Store_one_budget_rho (MASK)
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 3, 4, 5 ], gsplit, gdistributed, &
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 3, 4, 5 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
else if ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_LES_LEVEL &
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
@@ -1055,7 +1260,7 @@ select case ( idims )
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
end do
else if ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_LES_LEVEL &
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
@@ -1063,7 +1268,7 @@ select case ( idims )
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_TERM ) then
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
end do
else if ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_LES_LEVEL &
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
@@ -1071,7 +1276,7 @@ select case ( idims )
.and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_LES_SV ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 3, 4, 5 ], gsplit, gdistributed, &
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 3, 4, 5 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
else if ( tpfields(1)%ndimlist(1) == NMNHDIM_SPECTRA_2PTS_NI &
.and. tpfields(1)%ndimlist(3) == NMNHDIM_SPECTRA_LEVEL &
@@ -1079,7 +1284,7 @@ select case ( idims )
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 1, 3, 4 ], gsplit, gdistributed, &
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 1, 3, 4 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
else if ( tpfields(1)%ndimlist(2) == NMNHDIM_SPECTRA_2PTS_NJ &
.and. tpfields(1)%ndimlist(3) == NMNHDIM_SPECTRA_LEVEL &
@@ -1087,7 +1292,7 @@ select case ( idims )
.or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) ) then
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 2, 3, 4 ], gsplit, gdistributed, &
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 2, 3, 4 ], gsplit, gdistributed, &
iil, iih, ijl, ijh, ikl, ikh )
else if ( ( tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL .or. tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL_W ) &
.and. tpfields(1)%ndimlist(4) == NMNHDIM_FLYER_TIME &
@@ -1095,14 +1300,23 @@ select case ( idims )
!Correspond to FLYER_DIACHRO
!Create local time dimension
if ( isp == tzfile%nmaster_rank) then
- istatus = NF90_DEF_DIM( igrpid, 'time_flyer', Int( Size( pvar, 4), kind = CDFINT ), idimid )
- if ( istatus /= NF90_NOERR ) &
- call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_DEF_DIM', Trim( tpfields(1)%cmnhname ) )
+ istatus = NF90_INQ_DIMID( ilevelids(NLVL_GROUP), 'time_flyer', idimid )
+ if ( istatus == NF90_NOERR ) then
+ !Dimension already exists, check that it is not changed
+ istatus = NF90_INQUIRE_DIMENSION( ilevelids(NLVL_GROUP), idimid, len = ilen )
+ if ( ilen /= Int( Size( pvar, 4), kind = CDFINT ) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', 'time_flyer dimension has changed' )
+ else
+ !Dimension does not exist yet, create it
+ istatus = NF90_DEF_DIM( ilevelids(NLVL_GROUP), 'time_flyer', Int( Size( pvar, 4), kind = CDFINT ), idimid )
+ if ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_DEF_DIM', Trim( tpfields(1)%cmnhname ) )
+ end if
end if
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
end do
else if ( ( tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL .or. tpfields(1)%ndimlist(3) == NMNHDIM_LEVEL_W ) &
.and. tpfields(1)%ndimlist(4) == NMNHDIM_PROFILER_TIME &
@@ -1110,7 +1324,7 @@ select case ( idims )
!Correspond to PROFILER_DIACHRO_n
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
end do
else if ( ( tpfields(1)%ndimlist(3) == NMNHDIM_SERIES_LEVEL .or. tpfields(1)%ndimlist(3) == NMNHDIM_SERIES_LEVEL_W ) &
.and. tpfields(1)%ndimlist(4) == NMNHDIM_SERIES_TIME &
@@ -1118,7 +1332,7 @@ select case ( idims )
!Correspond to PROFILER_DIACHRO_n
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 3, 4 ], gsplit, gdistributed )
end do
else if ( ( tpfields(1)%ndimlist(1) == NMNHDIM_NI .or. tpfields(1)%ndimlist(1) == NMNHDIM_NI_U ) &
.and. tpfields(1)%ndimlist(4) == NMNHDIM_SERIES_TIME &
@@ -1126,25 +1340,25 @@ select case ( idims )
!Correspond to PROFILER_DIACHRO_n
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 1, 4 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 1, 4 ], gsplit, gdistributed )
end do
else if ( ( tpfields(1)%ndimlist(2) == NMNHDIM_NJ .or. tpfields(1)%ndimlist(2) == NMNHDIM_NJ_U ) &
.and. tpfields(1)%ndimlist(4) == NMNHDIM_SERIES_TIME &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_SERIES_PROC ) then
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 2, 4 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 2, 4 ], gsplit, gdistributed )
end do
else if ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_TIME &
.and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_MASK_NBUMASK &
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 4, 5 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 4, 5 ], gsplit, gdistributed )
end do
else
call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
- 'case not yet implemented (variable '//trim(tpfields(1)%cmnhname)//')' )
+ 'case not yet implemented (3D variable '//trim(tpfields(1)%cmnhname)//')' )
end if
case (4)
@@ -1156,8 +1370,8 @@ select case ( idims )
!Correspond to Store_one_budget (CART)
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 1, 2, 3 ], gsplit, gdistributed, &
- iil, iih, ijl, ijh, ikl, ikh )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 1, 2, 3 ], &
+ gsplit, gdistributed, iil, iih, ijl, ijh, ikl, ikh )
end do
elseif ( ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_MASK_LEVEL &
.or. tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_MASK_LEVEL_W ) &
@@ -1167,8 +1381,8 @@ select case ( idims )
!Correspond to Store_one_budget (MASK)
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4, 5 ], gsplit, gdistributed, &
- iil, iih, ijl, ijh, ikl, ikh )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 3, 4, 5 ], &
+ gsplit, gdistributed, iil, iih, ijl, ijh, ikl, ikh )
end do
else if ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_LES_LEVEL &
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
@@ -1182,8 +1396,8 @@ select case ( idims )
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4, 5 ], gsplit, gdistributed, &
- iil, iih, ijl, ijh, ikl, ikh )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 3, 4, 5 ], &
+ gsplit, gdistributed, iil, iih, ijl, ijh, ikl, ikh )
end do
else if ( tpfields(1)%ndimlist(3) == NMNHDIM_BUDGET_LES_LEVEL &
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
@@ -1192,8 +1406,8 @@ select case ( idims )
.and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_TERM ) then
! Loop on the processes
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 3, 4, 5 ], gsplit, gdistributed, &
- iil, iih, ijl, ijh, ikl, ikh )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 3, 4, 5 ], &
+ gsplit, gdistributed, iil, iih, ijl, ijh, ikl, ikh )
end do
else if ( tpfields(1)%ndimlist(1) == NMNHDIM_SPECTRA_SPEC_NI &
.and. tpfields(1)%ndimlist(3) == NMNHDIM_SPECTRA_LEVEL &
@@ -1203,7 +1417,7 @@ select case ( idims )
!Correspond to LES_DIACHRO_SPEC
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 1, 3, 4, 5 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 1, 3, 4, 5 ], gsplit, gdistributed )
else if ( tpfields(1)%ndimlist(2) == NMNHDIM_SPECTRA_SPEC_NJ &
.and. tpfields(1)%ndimlist(3) == NMNHDIM_SPECTRA_LEVEL &
.and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
@@ -1212,10 +1426,10 @@ select case ( idims )
!Correspond to LES_DIACHRO_SPEC
if ( Size( tpfields ) /= 1 ) call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
'wrong size of tpfields (variable '//trim(tpfields(1)%cmnhname)//')' )
- call Diachro_one_field_write_nc4( tzfile, tpfields(1), ytype, pvar, [ 2, 3, 4, 5 ], gsplit, gdistributed )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(1), pvar, [ 2, 3, 4, 5 ], gsplit, gdistributed )
else
call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
- 'case not yet implemented (variable '//trim(tpfields(1)%cmnhname)//')' )
+ 'case not yet implemented (4D variable '//trim(tpfields(1)%cmnhname)//')' )
end if
! case (5)
@@ -1224,7 +1438,7 @@ select case ( idims )
case default
do ji = 1, Size( pvar, 6 )
- call Diachro_one_field_write_nc4( tzfile, tpfields(ji), ytype, pvar(:,:,:,:,:,ji:ji), [ 1, 2, 3, 4, 5 ], &
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 1, 2, 3, 4, 5 ], &
gsplit, gdistributed )
end do
@@ -1260,19 +1474,12 @@ if ( Present( tpflyer ) ) then
call IO_Field_write( tzfile, tzfield, tpflyer%y )
end if
-
-
-
-
-!
-
-!Restore id of the file root group ('/' group)
-tzfile%nncid = isavencid
-
end subroutine Write_diachro_nc4
-subroutine Diachro_one_field_write_nc4( tpfile, tpfield, htype, pvar, kdims, osplit, odistributed, kil, kih, kjl, kjh, kkl, kkh )
-use modd_budget, only: nbutshift, nbusubwrite
+
+subroutine Diachro_one_field_write_nc4( tpfile, tpbudiachro, tpfield, pvar, kdims, osplit, odistributed, &
+ kil, kih, kjl, kjh, kkl, kkh )
+use modd_budget, only: NLVL_CATEGORY, NLVL_GROUP, NLVL_SHAPE, nbutshift, nbusubwrite, tbudiachrometadata
use modd_field, only: tfielddata, tfield_metadata_base
use modd_io, only: isp, tfiledata
use modd_parameters, only: jphext
@@ -1280,8 +1487,8 @@ use modd_parameters, only: jphext
use mode_io_field_write, only: IO_Field_create, IO_Field_write, IO_Field_write_box
type(tfiledata), intent(in) :: tpfile !File to write
+type(tbudiachrometadata), intent(in) :: tpbudiachro
class(tfield_metadata_base), intent(in) :: tpfield
-character(len=*), intent(in) :: htype
real, dimension(:,:,:,:,:,:), intent(in) :: pvar
integer, dimension(:), intent(in) :: kdims !List of indices of dimensions to use
logical, intent(in) :: osplit
@@ -1307,13 +1514,13 @@ type(tfielddata) :: tzfield
idims = Size( kdims )
if ( odistributed ) then
- if ( idims /= 2 .and. idims /= 3 ) &
+ if ( idims /= 2 .and. idims /= 3 ) &
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'odistributed=.true. not allowed for dims/=3, field: ' //Trim( tzfield%cmnhname ) )
- if ( htype /= 'CART' ) &
- call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
- 'odistributed=.true. not allowed for htype/=CART, field: ' //Trim( tzfield%cmnhname ) )
+ if ( tpbudiachro%clevels(NLVL_SHAPE) /= 'Cartesian' ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
+ 'odistributed=.true. not allowed for shape/=cartesian, field: ' //Trim( tzfield%cmnhname ) )
end if
if ( osplit ) then
@@ -1321,9 +1528,9 @@ if ( osplit ) then
call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
'osplit=.true. not allowed for dims>3, field: ' //Trim( tzfield%cmnhname ) )
- if ( htype /= 'CART' .and. htype /= 'MASK' ) &
- call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
- 'osplit=.true. not allowed for htype/=CART and /=MASK, field: ' //Trim( tzfield%cmnhname ) )
+ if ( tpbudiachro%clevels(NLVL_CATEGORY) /= 'Budgets' ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
+ 'osplit=.true. not allowed for category/=budget, field: ' //Trim( tzfield%cmnhname ) )
end if
Allocate( isizes(idims) )
@@ -1581,6 +1788,207 @@ if ( osplit ) then
end if
end subroutine Prepare_diachro_write
+
+
+subroutine Att_write_c0( hlevel, kgrpid, hattname, hdata )
+use NETCDF, only: NF90_GET_ATT, NF90_INQUIRE_ATTRIBUTE, NF90_PUT_ATT, NF90_CHAR, NF90_GLOBAL, NF90_NOERR
+
+use modd_precision, only: CDFINT
+
+use mode_io_tools_nc4, only: IO_Err_handle_nc4, IO_Mnhname_clean
+
+character(len=*), intent(in) :: hlevel
+integer(kind=CDFINT), intent(in) :: kgrpid
+character(len=*), intent(in) :: hattname
+character(len=*), intent(in) :: hdata
+
+character(len=Len(hattname)) :: yattname
+character(len=:), allocatable :: yatt
+integer(kind=CDFINT) :: ilen
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: itype
+
+call IO_Mnhname_clean( hattname, yattname )
+
+istatus = NF90_INQUIRE_ATTRIBUTE( kgrpid, NF90_GLOBAL, yattname, xtype = itype, len = ilen )
+if (istatus == NF90_NOERR ) then
+ call Print_msg( NVERB_DEBUG, 'IO', 'Write_diachro_nc4', 'attribute ' // yattname // ' already exists for ' // Trim( hlevel ) )
+
+ if ( itype /= NF90_CHAR ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', 'type for attribute ' // yattname // &
+ ' has changed for ' // Trim( hlevel ) )
+ return
+ end if
+
+ Allocate( character(len=ilen) :: yatt )
+ istatus = NF90_GET_ATT( kgrpid, NF90_GLOBAL, yattname, yatt )
+ if ( yatt == Trim( hdata ) ) then
+ call Print_msg( NVERB_DEBUG, 'IO', 'Write_diachro_nc4', 'attribute ' // yattname // ' is unchanged for ' // Trim( hlevel ) )
+ !If unchanged, no need to write it again => return
+ return
+ else
+ cmnhmsg(1) = 'attribute ' // yattname // ' has changed for ' // Trim( hlevel )
+ cmnhmsg(2) = yatt // ' -> ' // Trim( hdata )
+ call Print_msg( NVERB_WARNING, 'IO', 'Write_diachro_nc4' )
+ end if
+
+end if
+
+istatus = NF90_PUT_ATT( kgrpid, NF90_GLOBAL, yattname, Trim( hdata ) )
+if (istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', Trim( yattname ) // ' for '// Trim( hlevel ) // ' group' )
+
+end subroutine Att_write_c0
+
+
+subroutine Att_write_i0( hlevel, kgrpid, hattname, kdata )
+use NETCDF, only: NF90_GET_ATT, NF90_INQUIRE_ATTRIBUTE, NF90_PUT_ATT, NF90_GLOBAL, NF90_NOERR
+
+use modd_precision, only: CDFINT, MNHINT_NF90
+
+use mode_io_tools_nc4, only: IO_Err_handle_nc4, IO_Mnhname_clean
+
+character(len=*), intent(in) :: hlevel
+integer(kind=CDFINT), intent(in) :: kgrpid
+character(len=*), intent(in) :: hattname
+integer, intent(in) :: kdata
+
+character(len=Len(hattname)) :: yattname
+integer :: iatt
+integer(kind=CDFINT) :: ilen
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: itype
+
+call IO_Mnhname_clean( hattname, yattname )
+
+istatus = NF90_INQUIRE_ATTRIBUTE( kgrpid, NF90_GLOBAL, yattname, xtype = itype, len = ilen )
+if (istatus == NF90_NOERR ) then
+ call Print_msg( NVERB_DEBUG, 'IO', 'Write_diachro_nc4', 'attribute ' // yattname // ' already exists for ' // Trim( hlevel ) )
+
+ if ( itype /= MNHINT_NF90 ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', 'type for attribute ' // yattname // &
+ ' has changed for ' // Trim( hlevel ) )
+ return
+ end if
+
+ if ( ilen /= 1 ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', 'size of attribute ' // yattname // &
+ ' has changed for ' // Trim( hlevel ) )
+ return
+ end if
+
+ istatus = NF90_GET_ATT( kgrpid, NF90_GLOBAL, yattname, iatt )
+ if ( iatt == kdata ) then
+ call Print_msg( NVERB_DEBUG, 'IO', 'Write_diachro_nc4', 'attribute ' // yattname // ' is unchanged for ' // Trim( hlevel ) )
+ !If unchanged, no need to write it again => return
+ return
+ else
+ cmnhmsg(1) = 'attribute ' // yattname // ' has changed for ' // Trim( hlevel )
+ Write( cmnhmsg(2), '( I0, " -> ", I0 )' ) iatt, kdata
+ call Print_msg( NVERB_WARNING, 'IO', 'Write_diachro_nc4' )
+ end if
+
+end if
+
+istatus = NF90_PUT_ATT( kgrpid, NF90_GLOBAL, yattname, kdata )
+if (istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', Trim( yattname ) // ' for '// Trim( hlevel ) // ' group' )
+
+end subroutine Att_write_i0
+
+
+subroutine Att_write_x0( hlevel, kgrpid, hattname, pdata )
+use NETCDF, only: NF90_GET_ATT, NF90_INQUIRE_ATTRIBUTE, NF90_PUT_ATT, NF90_GLOBAL, NF90_NOERR
+
+use modd_precision, only: CDFINT, MNHREAL_NF90
+
+use mode_io_tools_nc4, only: IO_Err_handle_nc4, IO_Mnhname_clean
+
+character(len=*), intent(in) :: hlevel
+integer(kind=CDFINT), intent(in) :: kgrpid
+character(len=*), intent(in) :: hattname
+real, intent(in) :: pdata
+
+character(len=Len(hattname)) :: yattname
+integer(kind=CDFINT) :: ilen
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: itype
+real :: zatt
+
+call IO_Mnhname_clean( hattname, yattname )
+
+istatus = NF90_INQUIRE_ATTRIBUTE( kgrpid, NF90_GLOBAL, yattname, xtype = itype, len = ilen )
+if (istatus == NF90_NOERR ) then
+ call Print_msg( NVERB_DEBUG, 'IO', 'Write_diachro_nc4', 'attribute ' // yattname // ' already exists for ' // Trim( hlevel ) )
+
+ if ( itype /= MNHREAL_NF90 ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', 'type for attribute ' // yattname // &
+ ' has changed for ' // Trim( hlevel ) )
+ return
+ end if
+
+ if ( ilen /= 1 ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', 'size of attribute ' // yattname // &
+ ' has changed for ' // Trim( hlevel ) )
+ return
+ end if
+
+ istatus = NF90_GET_ATT( kgrpid, NF90_GLOBAL, yattname, zatt )
+ if ( zatt == pdata ) then
+ call Print_msg( NVERB_DEBUG, 'IO', 'Write_diachro_nc4', 'attribute ' // yattname // ' is unchanged for ' // Trim( hlevel ) )
+ !If unchanged, no need to write it again => return
+ return
+ else
+ cmnhmsg(1) = 'attribute ' // yattname // ' has changed for ' // Trim( hlevel )
+ Write( cmnhmsg(2), '( F15.7, " -> ", F15.7 )' ) zatt, pdata
+ call Print_msg( NVERB_WARNING, 'IO', 'Write_diachro_nc4' )
+ end if
+
+end if
+
+istatus = NF90_PUT_ATT( kgrpid, NF90_GLOBAL, yattname, pdata )
+if (istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'Write_diachro_nc4', 'NF90_PUT_ATT', Trim( yattname ) // ' for '// Trim( hlevel ) // ' group' )
+
+end subroutine Att_write_x0
+
+
+subroutine Move_to_next_level( kpreviouslevelid, gpreviousleveldefined, oleveluse, hlevelname, gleveldefined, klevelid )
+use NETCDF, only: NF90_DEF_GRP, NF90_INQ_NCID, NF90_NOERR
+
+use modd_precision, only: CDFINT
+
+use mode_io_tools_nc4, only: IO_Err_handle_nc4, IO_Mnhname_clean
+
+integer(kind=CDFINT), intent(in) :: kpreviouslevelid
+logical, intent(in) :: gpreviousleveldefined
+logical, intent(in) :: oleveluse
+! character(len=*), intent(inout) :: hlevelname
+character(len=*), intent(in) :: hlevelname
+logical, intent(out) :: gleveldefined
+integer(kind=CDFINT), intent(out) :: klevelid
+
+character(len=Len(hlevelname)) :: ylevelname
+integer(kind=CDFINT) :: istatus
+
+call IO_Mnhname_clean( hlevelname, ylevelname )
+
+if ( oleveluse ) then
+ istatus = NF90_INQ_NCID( kpreviouslevelid, Trim( ylevelname ), klevelid )
+ if ( istatus == NF90_NOERR ) then
+ gleveldefined = .true.
+ else
+ gleveldefined = .false.
+ istatus = NF90_DEF_GRP( kpreviouslevelid, Trim( ylevelname ), klevelid )
+ if ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'Move_to_next_level', 'NF90_DEF_GRP', 'for ' // Trim( ylevelname ) )
+ end if
+else
+ gleveldefined = gpreviousleveldefined
+ klevelid = kpreviouslevelid
+end if
+
+end subroutine Move_to_next_level
#endif
end module mode_write_diachro
diff --git a/src/MNH/write_les_budgetn.f90 b/src/MNH/write_les_budgetn.f90
index a27560c73f1df8c904ef9c7a4d906a321c54f962..fec25b5ea6ee41a77ebf0b8f659e8b47d5c3154b 100644
--- a/src/MNH/write_les_budgetn.f90
+++ b/src/MNH/write_les_budgetn.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.
@@ -52,8 +52,8 @@ subroutine Write_les_budget_n( tpdiafile )
! ------------
use modd_conf_n, only: luserv
-use modd_cst, only: xg, XALPHAOC
-USE MODD_DYN_n, ONLY : LOCEAN
+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
@@ -131,7 +131,7 @@ gdonorm = Trim( cles_norm_type ) /= 'NONE'
!* 1. total (resolved+subgrid) kinetic energy budget
! ------------------------------------
!
-YGROUP= 'BU_KE '
+YGROUP= 'BU_KE'
ILES=0
ILES_STA=ILES
!
@@ -139,7 +139,7 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TEND'
+YSUBTITLE(ILES) = 'SBG_TEND'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_TEND)
!
@@ -148,7 +148,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_TEND)
! ---------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YSUBTITLE(ILES) = 'SBG_DP_M'
!
ZLES_BUDGET(:,:,ILES)= - XLES_SUBGRID_WU (:,:,1) * XLES_MEAN_DUDZ(:,:,1) &
- XLES_SUBGRID_WV (:,:,1) * XLES_MEAN_DVDZ(:,:,1) &
@@ -158,7 +158,7 @@ ZLES_BUDGET(:,:,ILES)= - XLES_SUBGRID_WU (:,:,1) * XLES_MEAN_DUDZ(:,:,1) &
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YSUBTITLE(ILES) = 'SBG_DP_R'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_DP) - ZLES_BUDGET(:,:,2)
!
@@ -169,7 +169,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_DP) - ZLES_BUDGET(:,:,2)
!
IF ( ANY(XLES_BU_SBG_TKE(:,:,NLES_ADVM)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG ADVM'
+YSUBTITLE(ILES) = 'SBG_ADVM'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_ADVM)
END IF
@@ -180,7 +180,7 @@ END IF
!
IF ( ANY(XLES_BU_SBG_TKE(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG FORC'
+YSUBTITLE(ILES) = 'SBG_FORC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_FORC)
END IF
@@ -190,7 +190,7 @@ END IF
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TR '
+YSUBTITLE(ILES) = 'SBG_TR'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_TR)
!
@@ -199,7 +199,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_TR)
! -----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG ADVR'
+YSUBTITLE(ILES) = 'SBG_ADVR'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_ADVR)
!
@@ -209,7 +209,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_ADVR)
!
IF ( ANY(XLES_BU_SBG_TKE(:,:,NLES_PRES)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG PRES'
+YSUBTITLE(ILES) = 'SBG_PRES'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_PRES)
END IF
@@ -219,7 +219,7 @@ END IF
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TP'
+YSUBTITLE(ILES) = 'SBG_TP'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_TP)
!
@@ -228,7 +228,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_TP)
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS'
+YSUBTITLE(ILES) = 'SBG_DISS'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_DISS)
!
@@ -238,7 +238,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_DISS)
!
IF ( ANY(XLES_BU_SBG_TKE(:,:,NLES_DIFF)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG NUMD'
+YSUBTITLE(ILES) = 'SBG_NUMD'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_DIFF)
END IF
@@ -248,7 +248,7 @@ END IF
!
IF ( ANY(XLES_BU_SBG_TKE(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RELA'
+YSUBTITLE(ILES) = 'SBG_RELA'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_RELA)
END IF
@@ -258,7 +258,7 @@ END IF
!
IF ( ANY(XLES_BU_SBG_TKE(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG NEST'
+YSUBTITLE(ILES) = 'SBG_NEST'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_NEST)
END IF
@@ -269,7 +269,7 @@ END IF
!
IF ( ANY(XLES_BU_SBG_TKE(:,:,NLES_MISC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG MISC'
+YSUBTITLE(ILES) = 'SBG_MISC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_MISC)
END IF
@@ -279,7 +279,7 @@ END IF
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YSUBTITLE(ILES) = 'SBG_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -292,7 +292,7 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YSUBTITLE(ILES) = 'RES_TEND'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_TEND)
!
@@ -302,7 +302,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_TEND)
!
IF ( ANY(XLES_BU_RES_KE(:,:,NLES_ADVM)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES ADV '
+YSUBTITLE(ILES) = 'RES_ADV'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Ke(:,:,NLES_ADVM)
END IF
@@ -313,7 +313,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_KE(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YSUBTITLE(ILES) = 'RES_FORC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Ke(:,:,NLES_FORC)
END IF
@@ -323,7 +323,7 @@ END IF
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YSUBTITLE(ILES) = 'RES_DP'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Ke(:,:,NLES_DP)
!
@@ -332,7 +332,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Ke(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YSUBTITLE(ILES) = 'RES_TR'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_TR)
!
@@ -342,7 +342,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_TR)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES PRES'
+YSUBTITLE(ILES) = 'RES_PRES'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_PRES)
!
@@ -351,7 +351,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_PRES)
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TP '
+YSUBTITLE(ILES) = 'RES_TP'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_GRAV)
!
@@ -360,7 +360,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_GRAV)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YSUBTITLE(ILES) = 'RES_SBGT'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_VTURB) + XLES_BU_RES_KE(:,:,NLES_HTURB)
!
@@ -369,7 +369,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_VTURB) + XLES_BU_RES_KE(:,:,NLES
!
IF ( ANY(XLES_BU_RES_KE(:,:,NLES_COR)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES CORI'
+YSUBTITLE(ILES) = 'RES_CORI'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_COR)
END IF
@@ -379,7 +379,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_KE(:,:,NLES_DIFF)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NUMD'
+YSUBTITLE(ILES) = 'RES_NUMD'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_DIFF)
END IF
@@ -389,7 +389,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_KE(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YSUBTITLE(ILES) = 'RES_RELA'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_RELA)
END IF
@@ -399,7 +399,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_KE(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YSUBTITLE(ILES) = 'RES_NEST'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_NEST)
END IF
@@ -411,7 +411,7 @@ END IF
IF ( ANY( XLES_BU_RES_KE(:,:,NLES_MISC) &
+XLES_BU_RES_KE(:,:,NLES_CURV) /= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES MISC'
+YSUBTITLE(ILES) = 'RES_MISC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_MISC) &
+ XLES_BU_RES_KE(:,:,NLES_CURV)
@@ -421,7 +421,7 @@ END IF
! ------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YSUBTITLE(ILES) = 'RES_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -438,7 +438,7 @@ tzfield%clongname = ygroup
tzfield%ccomment = 'resolved KE budget'
tzfield%cunits = 'm2 s-3'
-call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), ysubtitle(:iles) )
+call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), hsuffixes = ysubtitle(:iles) )
!-------------------------------------------------------------------------------
!
@@ -446,7 +446,7 @@ call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles),
!* 2. temperature variance budget
! ---------------------------
!
-YGROUP= 'BU_THL2 '
+YGROUP= 'BU_THL2'
ILES=0
!
ILES_STA=ILES
@@ -455,7 +455,7 @@ ILES_STA=ILES
! ----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YSUBTITLE(ILES) = 'SBG_DP_M'
ILES_P1=ILES
!
ZLES_BUDGET(:,:,ILES)= - 2. * XLES_SUBGRID_WThl(:,:,1) * XLES_MEAN_dThldz(:,:,1)
@@ -466,7 +466,7 @@ ZLES_BUDGET(:,:,ILES)= - 2. * XLES_SUBGRID_WThl(:,:,1) * XLES_MEAN_dThldz(:,:,1)
!
IF ( ANY(XLES_SUBGRID_WThl2(:,:,1)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TR '
+YSUBTITLE(ILES) = 'SBG_TR'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES) = - ( XLES_SUBGRID_WThl2 (JK+1,:,1) &
@@ -483,7 +483,7 @@ END IF
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YSUBTITLE(ILES) = 'SBG_DP_R'
ILES_P2=ILES
!
ZLES_BUDGET(:,:,ILES)= - 2. * XLES_RES_ddxa_Thl_SBG_UaThl(:,:,1) &
@@ -494,7 +494,7 @@ ZLES_BUDGET(:,:,ILES)= - 2. * XLES_RES_ddxa_Thl_SBG_UaThl(:,:,1) &
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS '
+YSUBTITLE(ILES) = 'SBG_DISS'
!
ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_Thl2(:,:,1)
!
@@ -503,7 +503,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_Thl2(:,:,1)
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YSUBTITLE(ILES) = 'SBG_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -516,7 +516,7 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YSUBTITLE(ILES) = 'RES_TEND'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_TEND)
!
@@ -526,7 +526,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_TEND)
!
IF ( ANY(XLES_BU_RES_Thl2(:,:,NLES_ADVM)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES ADV '
+YSUBTITLE(ILES) = 'RES_ADV'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_ADVM)
END IF
@@ -537,7 +537,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_Thl2(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YSUBTITLE(ILES) = 'RES_FORC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_FORC)
END IF
@@ -547,7 +547,7 @@ END IF
! ----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YSUBTITLE(ILES) = 'RES_DP'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_DP)
@@ -556,7 +556,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YSUBTITLE(ILES) = 'RES_TR'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_TR)
!
@@ -565,7 +565,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_TR)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YSUBTITLE(ILES) = 'RES_SBGT'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_VTURB) + XLES_BU_RES_Thl2(:,:,NLES_HTURB)
!
@@ -574,7 +574,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_VTURB) + XLES_BU_RES_Thl2(:,:,
!
IF ( ANY(XLES_BU_RES_Thl2(:,:,NLES_DIFF)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NUMD'
+YSUBTITLE(ILES) = 'RES_NUMD'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_DIFF)
END IF
@@ -584,7 +584,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_Thl2(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YSUBTITLE(ILES) = 'RES_RELA'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_RELA)
END IF
@@ -594,7 +594,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_Thl2(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YSUBTITLE(ILES) = 'RES_NEST'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_NEST)
END IF
@@ -607,7 +607,7 @@ IF ( ANY( XLES_BU_RES_Thl2(:,:,NLES_MISC) &
+XLES_BU_RES_Thl2(:,:,NLES_MICR) &
+ XLES_BU_RES_Thl2(:,:,NLES_PREF) /= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES MISC'
+YSUBTITLE(ILES) = 'RES_MISC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_MISC) &
+ XLES_BU_RES_Thl2(:,:,NLES_RAD ) &
@@ -620,7 +620,7 @@ END IF
! ---------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YSUBTITLE(ILES) = 'RES_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -631,7 +631,7 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YSUBTITLE(ILES) = 'NSG_TEND'
!
ZLES_BUDGET(:,:,ILES) = 0.
IF (NLES_TIMES>2) THEN
@@ -650,7 +650,7 @@ END IF
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YSUBTITLE(ILES) = 'NSG_ADVM'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= -XLES_MEAN_W(JK,:,1) &
@@ -667,7 +667,7 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YSUBTITLE(ILES) = 'NSG_ADVR'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - ( XLES_RES_W_SBG_Thl2 (JK+1,:,1) &
@@ -690,14 +690,14 @@ tzfield%clongname = ygroup
tzfield%ccomment = 'thetal variance budget'
tzfield%cunits = 'K2 s-1'
-call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), ysubtitle(:iles) )
+call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), hsuffixes = ysubtitle(:iles) )
!-------------------------------------------------------------------------------
!
!* 3. temperature flux budget
! ---------------------
!
-YGROUP= 'BU_WTHL '
+YGROUP= 'BU_WTHL'
ILES=0
!
ILES_STA=ILES
@@ -706,7 +706,7 @@ ILES_STA=ILES
! -----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YSUBTITLE(ILES) = 'SBG_DP_M'
ILES_P1=ILES
!
ZLES_BUDGET(:,:,ILES) = - XLES_SUBGRID_W2(:,:,1) * XLES_MEAN_dThldz(:,:,1)
@@ -716,7 +716,7 @@ ZLES_BUDGET(:,:,ILES) = - XLES_SUBGRID_W2(:,:,1) * XLES_MEAN_dThldz(:,:,1)
! -------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YSUBTITLE(ILES) = 'SBG_DP_R'
!
ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddz_Thl_SBG_W2(:,:,1) &
- ZLES_BUDGET(:,:,ILES_P1)
@@ -727,7 +727,7 @@ ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddz_Thl_SBG_W2(:,:,1) &
!
IF ( ANY(XLES_SUBGRID_W2Thl(:,:,1)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TR '
+YSUBTITLE(ILES) = 'SBG_TR'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES) = - ( XLES_SUBGRID_W2Thl (JK+1,:,1) &
@@ -746,7 +746,7 @@ END IF
!
IF ( ANY(XLES_SUBGRID_ThlPz(:,:,1)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG PRES'
+YSUBTITLE(ILES) = 'SBG_PRES'
!
ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_ThlPz(:,:,1)
END IF
@@ -756,7 +756,7 @@ END IF
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TP '
+YSUBTITLE(ILES) = 'SBG_TP'
!
IF (LUSERV) THEN
ZLES_BUDGET(:,:,ILEs) = XG * XLES_SUBGRID_ThlThv(:,:,1) &
@@ -773,7 +773,7 @@ END IF
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YSUBTITLE(ILES) = 'SBG_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -786,7 +786,7 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YSUBTITLE(ILES) = 'RES_TEND'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_TEND)
!
@@ -795,7 +795,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_TEND)
!
IF ( ANY(XLES_BU_RES_WThl(:,:,NLES_ADVM)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES ADV '
+YSUBTITLE(ILES) = 'RES_ADV'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_ADVM)
END IF
@@ -805,7 +805,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WThl(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YSUBTITLE(ILES) = 'RES_FORC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_FORC)
END IF
@@ -815,7 +815,7 @@ END IF
! ----------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YSUBTITLE(ILES) = 'RES_DP'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_DP)
!
@@ -823,7 +823,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YSUBTITLE(ILES) = 'RES_TR'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_TR)
!
@@ -832,7 +832,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_TR)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES PRES'
+YSUBTITLE(ILES) = 'RES_PRES'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_PRES)
!
@@ -841,7 +841,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_PRES)
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TP '
+YSUBTITLE(ILES) = 'RES_TP'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_GRAV)
!
@@ -850,7 +850,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_GRAV)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YSUBTITLE(ILES) = 'RES_SBGT'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_VTURB) + XLES_BU_RES_WThl(:,:,NLES_HTURB)
!
@@ -859,7 +859,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_VTURB) + XLES_BU_RES_WThl(:,:,
!
IF ( ANY(XLES_BU_RES_WThl(:,:,NLES_COR)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES CORI'
+YSUBTITLE(ILES) = 'RES_CORI'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_COR)
END IF
@@ -869,7 +869,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WThl(:,:,NLES_DIFF)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NUMD'
+YSUBTITLE(ILES) = 'RES_NUMD'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_DIFF)
END IF
@@ -879,7 +879,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WThl(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YSUBTITLE(ILES) = 'RES_RELA'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_RELA)
END IF
@@ -889,7 +889,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WThl(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YSUBTITLE(ILES) = 'RES_NEST'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_NEST)
END IF
@@ -903,7 +903,7 @@ IF ( ANY( XLES_BU_RES_WThl(:,:,NLES_MISC) &
+XLES_BU_RES_WThl(:,:,NLES_PREF) &
+XLES_BU_RES_WThl(:,:,NLES_CURV) /= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES MISC'
+YSUBTITLE(ILES) = 'RES_MISC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_MISC) &
+ XLES_BU_RES_WThl(:,:,NLES_RAD ) &
@@ -917,7 +917,7 @@ END IF
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YSUBTITLE(ILES) = 'RES_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -928,7 +928,7 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YSUBTITLE(ILES) = 'NSG_TEND'
!
ZLES_BUDGET(:,:,ILES) = 0.
IF (NLES_TIMES>2) THEN
@@ -949,7 +949,7 @@ END IF
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YSUBTITLE(ILES) = 'NSG_ADVM'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - XLES_MEAN_W(JK,:,1) &
@@ -966,7 +966,7 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YSUBTITLE(ILES) = 'NSG_ADVR'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - ( XLES_RES_W_SBG_WThl(JK+1,:,1) &
@@ -982,7 +982,7 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ----------------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGW'
+YSUBTITLE(ILES) = 'NSG_DPGW'
!
ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddxa_W_SBG_UaThl(:,:,1)
!
@@ -991,7 +991,7 @@ ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddxa_W_SBG_UaThl(:,:,1)
! -------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGT'
+YSUBTITLE(ILES) = 'NSG_DPGT'
!
ZLES_BUDGET(:,:,ILES)=-XLES_RES_ddxa_Thl_SBG_UaW(:,:,1) &
-ZLES_BUDGET(:,:,ILES_P1) -ZLES_BUDGET(:,:,ILES_P2)
@@ -1008,7 +1008,7 @@ tzfield%clongname = ygroup
tzfield%ccomment = 'thetal flux budget'
tzfield%cunits = 'm K s-2'
-call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), ysubtitle(:iles) )
+call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), hsuffixes = ysubtitle(:iles) )
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/write_les_rt_budgetn.f90 b/src/MNH/write_les_rt_budgetn.f90
index 595556a566827243497e934ab67194aeaf397065..e2cb0096113e8b44e841339a15fc495dd93453bd 100644
--- a/src/MNH/write_les_rt_budgetn.f90
+++ b/src/MNH/write_les_rt_budgetn.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.
@@ -125,7 +125,7 @@ gdonorm = Trim( cles_norm_type ) /= 'NONE'
! ---------------------------
!
!
-YGROUP= 'BU_RT2 '
+YGROUP= 'BU_RT2'
ILES=0
ILES_STA=ILES
!
@@ -134,7 +134,7 @@ ILES_STA=ILES
! ----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YSUBTITLE(ILES) = 'SBG_DP_M'
ILES_P1=ILES
!
ZLES_BUDGET(:,:,ILES)= - 2. * XLES_SUBGRID_WRt(:,:,1) * XLES_MEAN_dRtdz(:,:,1)
@@ -144,7 +144,7 @@ ZLES_BUDGET(:,:,ILES)= - 2. * XLES_SUBGRID_WRt(:,:,1) * XLES_MEAN_dRtdz(:,:,1)
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YSUBTITLE(ILES) = 'SBG_DP_R'
!
ZLES_BUDGET(:,:,ILES)= - 2. * XLES_RES_ddxa_Rt_SBG_UaRt(:,:,1) &
- ZLES_BUDGET(:,:,ILES_P1)
@@ -155,7 +155,7 @@ ZLES_BUDGET(:,:,ILES)= - 2. * XLES_RES_ddxa_Rt_SBG_UaRt(:,:,1) &
!
IF ( ANY(XLES_SUBGRID_WRt2(:,:,1)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TR '
+YSUBTITLE(ILES) = 'SBG_TR'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES) = - ( XLES_SUBGRID_WRt2 (JK+1,:,1) &
@@ -172,7 +172,7 @@ END IF
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS '
+YSUBTITLE(ILES) = 'SBG_DISS'
!
ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_Rt2(:,:,1)
!
@@ -181,7 +181,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_Rt2(:,:,1)
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YSUBTITLE(ILES) = 'SBG_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -194,7 +194,7 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YSUBTITLE(ILES) = 'RES_TEND'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_TEND)
!
@@ -204,7 +204,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_TEND)
!
IF ( ANY(XLES_BU_RES_Rt2(:,:,NLES_ADVM)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES ADV '
+YSUBTITLE(ILES) = 'RES_ADV'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_ADVM)
END IF
@@ -214,7 +214,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_Rt2(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YSUBTITLE(ILES) = 'RES_FORC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_FORC)
END IF
@@ -224,7 +224,7 @@ END IF
! ----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YSUBTITLE(ILES) = 'RES_DP'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_DP)
@@ -233,7 +233,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YSUBTITLE(ILES) = 'RES_TR'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_TR)
!
@@ -242,7 +242,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_TR)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YSUBTITLE(ILES) = 'RES_SBGT'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_VTURB) + XLES_BU_RES_Rt2(:,:,NLES_HTURB)
!
@@ -252,7 +252,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_VTURB) + XLES_BU_RES_Rt2(:,:,NL
!
IF ( ANY(XLES_BU_RES_Rt2(:,:,NLES_DIFF)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NUMD'
+YSUBTITLE(ILES) = 'RES_NUMD'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_DIFF)
END IF
@@ -262,7 +262,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_Rt2(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YSUBTITLE(ILES) = 'RES_RELA'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_RELA)
END IF
@@ -272,7 +272,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_Rt2(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YSUBTITLE(ILES) = 'RES_NEST'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_NEST)
END IF
@@ -283,7 +283,7 @@ END IF
IF ( ANY( XLES_BU_RES_Rt2(:,:,NLES_MISC) &
+XLES_BU_RES_Rt2(:,:,NLES_MICR)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES MISC'
+YSUBTITLE(ILES) = 'RES_MISC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_MISC) &
+ XLES_BU_RES_Rt2(:,:,NLES_MICR)
@@ -294,7 +294,7 @@ END IF
! ---------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YSUBTITLE(ILES) = 'RES_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -305,7 +305,7 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YSUBTITLE(ILES) = 'NSG_TEND'
!
ZLES_BUDGET(:,:,ILES) = 0.
IF (NLES_TIMES>2) THEN
@@ -324,7 +324,7 @@ END IF
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YSUBTITLE(ILES) = 'NSG_ADVM'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= -XLES_MEAN_W(JK,:,1) &
@@ -341,7 +341,7 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YSUBTITLE(ILES) = 'NSG_ADVR'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - ( XLES_RES_W_SBG_Rt2 (JK+1,:,1) &
@@ -363,7 +363,7 @@ tzfield%clongname = ygroup
tzfield%ccomment = 'Rt variance budget'
tzfield%cunits = 'kg2 kg-2 s-1'
-call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), ysubtitle(:iles) )
+call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), hsuffixes = ysubtitle(:iles) )
!-------------------------------------------------------------------------------
!
@@ -371,7 +371,7 @@ call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles),
! -----------------------
!
!
-YGROUP= 'BU_WRT '
+YGROUP= 'BU_WRT'
ILES=0
ILES_STA=ILES
!
@@ -379,7 +379,7 @@ ILES_STA=ILES
! -----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YSUBTITLE(ILES) = 'SBG_DP_M'
ILES_P1=ILES
!
ZLES_BUDGET(:,:,ILES) = - XLES_SUBGRID_W2(:,:,1) * XLES_MEAN_dRtdz(:,:,1)
@@ -389,7 +389,7 @@ ZLES_BUDGET(:,:,ILES) = - XLES_SUBGRID_W2(:,:,1) * XLES_MEAN_dRtdz(:,:,1)
! -------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(2) = ' SBG DP R'
+YSUBTITLE(2) = 'SBG_DP_R'
ILES_P2=ILES
!
ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddz_Rt_SBG_W2(:,:,1) &
@@ -402,7 +402,7 @@ ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddz_Rt_SBG_W2(:,:,1) &
!
IF ( ANY(XLES_SUBGRID_W2Rt(:,:,1)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TR '
+YSUBTITLE(ILES) = 'SBG_TR'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES) = - ( XLES_SUBGRID_W2Rt (JK+1,:,1) &
@@ -420,7 +420,7 @@ END IF
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG PRES'
+YSUBTITLE(ILES) = 'SBG_PRES'
!
ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_RtPz(:,:,1)
!
@@ -429,7 +429,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_RtPz(:,:,1)
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TP '
+YSUBTITLE(ILES) = 'SBG_TP'
!
ZLES_BUDGET(:,:,ILES) = XG * XLES_SUBGRID_RtThv(:,:,1) &
/ XLES_MEAN_Thv (:,:,1)
@@ -438,8 +438,9 @@ ZLES_BUDGET(:,:,ILES) = XG * XLES_SUBGRID_RtThv(:,:,1) &
!* 3.6 dissipation
! -----------
!
+!PW: not in the documentation, but set to 0 anyway
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS '
+YSUBTITLE(ILES) = 'SBG_DISS'
!
ZLES_BUDGET(:,:,ILES) = 0.
!
@@ -448,7 +449,7 @@ ZLES_BUDGET(:,:,ILES) = 0.
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YSUBTITLE(ILES) = 'SBG_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -461,7 +462,7 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YSUBTITLE(ILES) = 'RES_TEND'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_TEND)
!
@@ -470,7 +471,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_TEND)
!
IF ( ANY(XLES_BU_RES_WRt(:,:,NLES_ADVM)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES ADV '
+YSUBTITLE(ILES) = 'RES_ADV'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_ADVM)
END IF
@@ -480,7 +481,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WRt(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YSUBTITLE(ILES) = 'RES_FORC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_FORC)
END IF
@@ -489,7 +490,7 @@ END IF
! ----------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YSUBTITLE(ILES) = 'RES_DP'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_DP)
!
@@ -497,7 +498,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YSUBTITLE(ILES) = 'RES_TR'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_TR)
!
@@ -506,7 +507,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_TR)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES PRES'
+YSUBTITLE(ILES) = 'RES_PRES'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_PRES)
!
@@ -515,7 +516,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_PRES)
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TP '
+YSUBTITLE(ILES) = 'RES_TP'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_GRAV)
!
@@ -524,7 +525,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_GRAV)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YSUBTITLE(ILES) = 'RES_SBGT'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_VTURB) + XLES_BU_RES_WRt(:,:,NLES_HTURB)
!
@@ -533,7 +534,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_VTURB) + XLES_BU_RES_WRt(:,:,NL
!
IF ( ANY(XLES_BU_RES_WRt(:,:,NLES_COR)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES CORI'
+YSUBTITLE(ILES) = 'RES_CORI'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_COR)
END IF
@@ -543,7 +544,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WRt(:,:,NLES_DIFF)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NUMD'
+YSUBTITLE(ILES) = 'RES_NUMD'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_DIFF)
END IF
@@ -553,7 +554,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WRt(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YSUBTITLE(ILES) = 'RES_RELA'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_RELA)
END IF
@@ -563,7 +564,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WRt(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YSUBTITLE(ILES) = 'RES_NEST'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_NEST)
END IF
@@ -574,7 +575,7 @@ END IF
IF ( ANY( XLES_BU_RES_WRt(:,:,NLES_MISC) &
+XLES_BU_RES_WRt(:,:,NLES_MICR) /= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES MISC'
+YSUBTITLE(ILES) = 'RES_MISC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_MISC) &
+ XLES_BU_RES_WRt(:,:,NLES_MICR)
@@ -584,7 +585,7 @@ END IF
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YSUBTITLE(ILES) = 'RES_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -595,7 +596,7 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TEND'
+YSUBTITLE(ILES) = 'SBG_TEND'
!
ZLES_BUDGET(:,:,ILES) = 0.
IF (NLES_TIMES>2) THEN
@@ -616,7 +617,7 @@ END IF
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YSUBTITLE(ILES) = 'NSG_ADVM'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - XLES_MEAN_W(JK,:,1) &
@@ -633,7 +634,7 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YSUBTITLE(ILES) = 'NSG_ADVR'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - ( XLES_RES_W_SBG_WRt(JK+1,:,1) &
@@ -649,7 +650,7 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ----------------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGW'
+YSUBTITLE(ILES) = 'NSG_DPGW'
!
ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddxa_W_SBG_UaRt(:,:,1)
!
@@ -658,7 +659,7 @@ ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddxa_W_SBG_UaRt(:,:,1)
! -------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGT'
+YSUBTITLE(ILES) = 'NSG_DPGT'
!
ZLES_BUDGET(:,:,ILES)=-XLES_RES_ddxa_Rt_SBG_UaW(:,:,1) &
-ZLES_BUDGET(:,:,ILES_P1) -ZLES_BUDGET(:,:,ILES_P2)
@@ -673,7 +674,7 @@ tzfield%clongname = ygroup
tzfield%ccomment = 'Rt flux budget'
tzfield%cunits = 'm kg kg-1 s-2'
-call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), ysubtitle(:iles) )
+call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), hsuffixes = ysubtitle(:iles) )
!-------------------------------------------------------------------------------
!
@@ -681,7 +682,7 @@ call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles),
! ------------------------------------------------------------
!
!
-YGROUP= 'BU_THLR '
+YGROUP= 'BU_THLR'
ILES=0
ILES_STA=ILES
!
@@ -690,7 +691,7 @@ ILES_STA=ILES
! ----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YSUBTITLE(ILES) = 'SBG_DP_M'
ILES_P1=ILES
!
ZLES_BUDGET(:,:,ILES)=-XLES_SUBGRID_WRt (:,:,1) * XLES_MEAN_dThldz(:,:,1) &
@@ -701,7 +702,7 @@ ZLES_BUDGET(:,:,ILES)=-XLES_SUBGRID_WRt (:,:,1) * XLES_MEAN_dThldz(:,:,1) &
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YSUBTITLE(ILES) = 'SBG_DP_R'
!
ZLES_BUDGET(:,:,ILES)= - XLES_RES_ddxa_Rt_SBG_UaThl(:,:,1) &
- XLES_RES_ddxa_Thl_SBG_UaRt(:,:,1) &
@@ -713,7 +714,7 @@ ZLES_BUDGET(:,:,ILES)= - XLES_RES_ddxa_Rt_SBG_UaThl(:,:,1) &
!
IF ( ANY(XLES_SUBGRID_WThlRt(:,:,1)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TR '
+YSUBTITLE(ILES) = 'SBG_TR'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES) = - ( XLES_SUBGRID_WThlRt (JK+1,:,1) &
@@ -730,7 +731,7 @@ END IF
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS '
+YSUBTITLE(ILES) = 'SBG_DISS'
!
ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_ThlRt(:,:,1)
!
@@ -739,7 +740,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_ThlRt(:,:,1)
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YSUBTITLE(ILES) = 'SBG_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -752,7 +753,7 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YSUBTITLE(ILES) = 'RES_TEND'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_TEND)
!
@@ -762,7 +763,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_TEND)
!
IF ( ANY(XLES_BU_RES_ThlRt(:,:,NLES_ADVM)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(7) = ' RES ADV '
+YSUBTITLE(7) = 'RES_ADV'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_ADVM)
END IF
@@ -772,7 +773,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_ThlRt(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YSUBTITLE(ILES) = 'RES_FORC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_FORC)
END IF
@@ -781,7 +782,7 @@ END IF
! ----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YSUBTITLE(ILES) = 'RES_DP'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_DP)
!
@@ -789,7 +790,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YSUBTITLE(ILES) = 'RES_TR'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_TR)
!
@@ -798,7 +799,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_TR)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YSUBTITLE(ILES) = 'RES_SBGT'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_VTURB) + XLES_BU_RES_ThlRt(:,:,NLES_HTURB)
!
@@ -808,7 +809,7 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_VTURB) + XLES_BU_RES_ThlRt(:,
!
IF ( ANY(XLES_BU_RES_ThlRt(:,:,NLES_DIFF)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NUMD'
+YSUBTITLE(ILES) = 'RES_NUMD'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_DIFF)
END IF
@@ -818,7 +819,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_ThlRt(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YSUBTITLE(ILES) = 'RES_RELA'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_RELA)
END IF
@@ -828,7 +829,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_ThlRt(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YSUBTITLE(ILES) = 'RES_NEST'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_NEST)
END IF
@@ -841,7 +842,7 @@ IF ( ANY( XLES_BU_RES_ThlRt(:,:,NLES_MISC) &
+XLES_BU_RES_ThlRt(:,:,NLES_RAD ) &
+XLES_BU_RES_ThlRt(:,:,NLES_MICR) /= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES MISC'
+YSUBTITLE(ILES) = 'RES_MISC'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_MISC) &
+ XLES_BU_RES_ThlRt(:,:,NLES_PREF) &
@@ -854,7 +855,7 @@ END IF
! ---------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YSUBTITLE(ILES) = 'RES_RESI'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -865,7 +866,7 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YSUBTITLE(ILES) = 'NSG_TEND'
!
ZLES_BUDGET(:,:,ILES) = 0.
IF (NLES_TIMES>2) THEN
@@ -884,7 +885,7 @@ END IF
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YSUBTITLE(ILES) = 'NSG_ADVM'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= -XLES_MEAN_W(JK,:,1) &
@@ -901,7 +902,7 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YSUBTITLE(ILES) = 'NSG_ADVR'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - ( XLES_RES_W_SBG_ThlRt (JK+1,:,1) &
@@ -923,7 +924,7 @@ tzfield%clongname = ygroup
tzfield%ccomment = 'Thl-Rt covariance budget'
tzfield%cunits = 'K kg kg-1 s-1'
-call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), ysubtitle(:iles) )
+call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles), hsuffixes = ysubtitle(:iles) )
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/write_les_sv_budgetn.f90 b/src/MNH/write_les_sv_budgetn.f90
index e2434073f1033beb19654ff6f11380b5cb3b02fc..4bed642c49d6f57d932b4a8e5771b2bf9045b0fe 100644
--- a/src/MNH/write_les_sv_budgetn.f90
+++ b/src/MNH/write_les_sv_budgetn.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.
@@ -115,7 +115,7 @@ ZLES_BUDGET(:,:,:,:) = XUNDEF
! ----------------------------
!
!
-YGROUP='BU_SV2 '
+YGROUP='BU_SV2'
!
ILES=0
ILES_STA=ILES
@@ -124,7 +124,7 @@ ILES_STA=ILES
! ----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YSUBTITLE(ILES) = 'SBG_DP_M'
ILES_P1=ILES
!
DO JSV=1,NSV
@@ -136,7 +136,7 @@ END DO
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YSUBTITLE(ILES) = 'SBG_DP_R'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV)= - 2. * XLES_RES_ddxa_Sv_SBG_UaSv(:,:,1,JSV) &
@@ -149,7 +149,7 @@ END DO
!
IF ( ANY(XLES_SUBGRID_WSv2(:,:,1,:)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TR '
+YSUBTITLE(ILES) = 'SBG_TR'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -168,7 +168,7 @@ END IF
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS '
+YSUBTITLE(ILES) = 'SBG_DISS'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_SUBGRID_DISS_Sv2(:,:,1,JSV)
@@ -179,7 +179,7 @@ END DO
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YSUBTITLE(ILES) = 'SBG_RESI'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -194,7 +194,7 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YSUBTITLE(ILES) = 'RES_TEND'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_TEND,JSV)
@@ -205,7 +205,7 @@ END DO
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_ADVM,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES ADV '
+ YSUBTITLE(ILES) = 'RES_ADV'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_ADVM,JSV)
@@ -217,7 +217,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_FORC,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES FORC'
+ YSUBTITLE(ILES) = 'RES_FORC'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_FORC,JSV)
@@ -229,7 +229,7 @@ END IF
! ----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YSUBTITLE(ILES) = 'RES_DP'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_DP,JSV)
@@ -239,7 +239,7 @@ END DO
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YSUBTITLE(ILES) = 'RES_TR'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_TR,JSV)
@@ -250,7 +250,7 @@ END DO
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YSUBTITLE(ILES) = 'RES_SBGT'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_VTURB,JSV) &
@@ -262,7 +262,7 @@ END DO
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_DIFF,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES NUMD'
+ YSUBTITLE(ILES) = 'RES_NUMD'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_DIFF,JSV)
@@ -274,7 +274,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_RELA,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES RELA'
+ YSUBTITLE(ILES) = 'RES_RELA'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_RELA,JSV)
@@ -286,7 +286,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_NEST,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES NEST'
+ YSUBTITLE(ILES) = 'RES_NEST'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_NEST,JSV)
@@ -298,7 +298,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_MISC,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES MISC'
+ YSUBTITLE(ILES) = 'RES_MISC'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_MISC,JSV)
@@ -309,7 +309,7 @@ END IF
! ---------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YSUBTITLE(ILES) = 'RES_RESI'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -322,7 +322,7 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YSUBTITLE(ILES) = 'NSG_TEND'
!
IF (NLES_TIMES>2) THEN
DO JSV=1,NSV
@@ -343,7 +343,7 @@ END IF
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YSUBTITLE(ILES) = 'NSG_ADVM'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -361,7 +361,7 @@ END DO
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YSUBTITLE(ILES) = 'NSG_ADVR'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -399,7 +399,7 @@ tzfield%ndimlist(5:) = NMNHDIM_UNUSED
gdoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
gdonorm = trim(cles_norm_type) /= 'NONE'
-call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles, :), ysubtitle(:iles) )
+call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles, :), hsuffixes = ysubtitle(:iles) )
!-------------------------------------------------------------------------------
!
@@ -407,7 +407,7 @@ call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles,
! -----------------------
!
!
-YGROUP = 'BU_WSV '
+YGROUP = 'BU_WSV'
!
!
ILES=0
@@ -417,7 +417,7 @@ ILES_STA=ILES
! -----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YSUBTITLE(ILES) = 'SBG_DP_M'
ILES_P1=ILES
!
DO JSV=1,NSV
@@ -430,7 +430,7 @@ END DO
! -------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YSUBTITLE(ILES) = 'SBG_DP_R'
ILES_P2=ILES
!
DO JSV=1,NSV
@@ -445,7 +445,7 @@ END DO
!
IF ( ANY(XLES_SUBGRID_W2Sv(:,:,1,:)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TR '
+YSUBTITLE(ILES) = 'SBG_TR'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -464,7 +464,7 @@ END IF
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG PRES'
+YSUBTITLE(ILES) = 'SBG_PRES'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_SUBGRID_SvPz(:,:,1,JSV)
@@ -475,7 +475,7 @@ END DO
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TP '
+YSUBTITLE(ILES) = 'SBG_TP'
!
IF (LUSERV) THEN
DO JSV=1,NSV
@@ -494,7 +494,7 @@ END IF
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS '
+YSUBTITLE(ILES) = 'SBG_DISS'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -505,7 +505,7 @@ END DO
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YSUBTITLE(ILES) = 'SBG_RESI'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -520,7 +520,7 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YSUBTITLE(ILES) = 'RES_TEND'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_TEND,JSV)
@@ -531,7 +531,7 @@ END DO
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_ADVM,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES ADV '
+ YSUBTITLE(ILES) = 'RES_ADV'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_ADVM,JSV)
@@ -543,7 +543,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_FORC,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES FORC'
+ YSUBTITLE(ILES) = 'RES_FORC'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_FORC,JSV)
@@ -554,7 +554,7 @@ END IF
! ----------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YSUBTITLE(ILES) = 'RES_DP'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_DP,JSV)
@@ -564,7 +564,7 @@ END DO
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YSUBTITLE(ILES) = 'RES_TR'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_TR,JSV)
@@ -575,7 +575,7 @@ END DO
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES PRES'
+YSUBTITLE(ILES) = 'RES_PRES'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_PRES,JSV)
@@ -586,7 +586,7 @@ END DO
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TP '
+YSUBTITLE(ILES) = 'RES_TP'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_GRAV,JSV)
@@ -597,7 +597,7 @@ END DO
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YSUBTITLE(ILES) = 'RES_SBGT'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_VTURB,JSV) + XLES_BU_RES_WSv(:,:,NLES_HTURB,JSV)
@@ -608,7 +608,7 @@ END DO
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_COR,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES CORI'
+ YSUBTITLE(ILES) = 'RES_CORI'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_COR,JSV)
@@ -620,7 +620,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_DIFF,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES NUMD'
+ YSUBTITLE(ILES) = 'RES_NUMD'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_DIFF,JSV)
@@ -632,7 +632,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_RELA,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES RELA'
+ YSUBTITLE(ILES) = 'RES_RELA'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_RELA,JSV)
@@ -644,7 +644,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_NEST,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES NEST'
+ YSUBTITLE(ILES) = 'RES_NEST'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_NEST,JSV)
@@ -656,7 +656,7 @@ END IF
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_MISC,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES MISC'
+ YSUBTITLE(ILES) = 'RES_MISC'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_MISC,JSV)
@@ -667,7 +667,7 @@ END IF
! -------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YSUBTITLE(ILES) = 'RES_RESI'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -680,7 +680,7 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YSUBTITLE(ILES) = 'NSG_TEND'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -703,7 +703,7 @@ END DO
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YSUBTITLE(ILES) = 'NSG_ADVM'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -721,7 +721,7 @@ END DO
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YSUBTITLE(ILES) = 'NSG_ADVR'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -738,7 +738,7 @@ END DO
! ----------------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGW'
+YSUBTITLE(ILES) = 'NSG_DPGW'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV)=- XLES_RES_ddxa_W_SBG_UaSv(:,:,1,JSV)
@@ -749,7 +749,7 @@ END DO
! -------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGT'
+YSUBTITLE(ILES) = 'NSG_DPGT'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV)=-XLES_RES_ddxa_Sv_SBG_UaW(:,:,1,JSV) &
@@ -781,7 +781,7 @@ tzfield%ndimlist(5:) = NMNHDIM_UNUSED
gdoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
gdonorm = trim(cles_norm_type) /= 'NONE'
-call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles, :), ysubtitle(:iles) )
+call Les_diachro( tpdiafile, tzfield, gdoavg, gdonorm, zles_budget(:, :, :iles, :), hsuffixes = ysubtitle(:iles) )
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/write_lesn.f90 b/src/MNH/write_lesn.f90
index 09724ca6a50988a652edf5f748576c19a04c3c99..e971d432cbfe94e4be5c582197476ede4ad2507a 100644
--- a/src/MNH/write_lesn.f90
+++ b/src/MNH/write_lesn.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.
@@ -107,8 +107,9 @@ INTEGER :: IMASK
INTEGER :: JSV ! scalar loop counter
INTEGER :: JI ! loop counter
!
-CHARACTER(len=9), DIMENSION(NLES_MASKS) :: YSUBTITLE
+character(len=3) :: ynum
CHARACTER(len=5) :: YGROUP
+character(len=7), dimension(nles_masks) :: ymasks
!
logical :: gdoavg ! Compute and store time average
logical :: gdonorm ! Compute and store normalized field
@@ -234,32 +235,33 @@ tfield%ntype = TYPEREAL
!* 2. (z,t) profiles (all masks)
! --------------
IMASK = 1
-YSUBTITLE(IMASK) = " (cart)"
+ymasks(imask) = 'cart'
IF (LLES_NEB_MASK) THEN
IMASK=IMASK+1
- YSUBTITLE(IMASK) = " (neb)"
+ ymasks(imask) = 'neb'
IMASK=IMASK+1
- YSUBTITLE(IMASK) = " (clear)"
+ ymasks(imask) = 'clear'
END IF
IF (LLES_CORE_MASK) THEN
IMASK=IMASK+1
- YSUBTITLE(IMASK) = " (core)"
+ ymasks(imask) = 'core'
IMASK=IMASK+1
- YSUBTITLE(IMASK) = " (env)"
+ ymasks(imask) = 'env'
END IF
IF (LLES_MY_MASK) THEN
DO JI=1,NLES_MASKS_USER
IMASK=IMASK+1
- YSUBTITLE(IMASK) = " (user)"
+ Write( ynum, '( i3.3 )' ) ji
+ ymasks(imask) = 'user' // ynum
END DO
END IF
IF (LLES_CS_MASK) THEN
IMASK=IMASK+1
- YSUBTITLE(IMASK) = " (cs1)"
+ ymasks(imask) = 'cs1'
IMASK=IMASK+1
- YSUBTITLE(IMASK) = " (cs2)"
+ ymasks(imask) = 'cs2'
IMASK=IMASK+1
- YSUBTITLE(IMASK) = " (cs3)"
+ ymasks(imask) = 'cs3'
END IF
!
!* 2.0 averaging diagnostics
@@ -281,10 +283,10 @@ tfield%ndimlist(4:) = NMNHDIM_UNUSED
ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
ldonorm = .false.
-call Les_diachro_write( tpdiafile, zavg_pts_ll, 'AVG_PTS', 'number of points used for averaging', '1', ysubtitle)
-call Les_diachro_write( tpdiafile, zavg_pts_ll / zcart_pts_ll, 'AVG_PTSF', 'fraction of points used for averaging', '1', ysubtitle)
-call Les_diachro_write( tpdiafile, zund_pts_ll, 'UND_PTS', 'number of points below orography', '1', ysubtitle)
-call Les_diachro_write( tpdiafile, zund_pts_ll / zcart_pts_ll, 'UND_PTSF', 'fraction of points below orography', '1', ysubtitle)
+call Les_diachro_write( tpdiafile, zavg_pts_ll, 'AVG_PTS', 'number of points used for averaging', '1', ymasks )
+call Les_diachro_write( tpdiafile, zavg_pts_ll / zcart_pts_ll, 'AVG_PTSF', 'fraction of points used for averaging', '1', ymasks )
+call Les_diachro_write( tpdiafile, zund_pts_ll, 'UND_PTS', 'number of points below orography', '1', ymasks )
+call Les_diachro_write( tpdiafile, zund_pts_ll / zcart_pts_ll, 'UND_PTSF', 'fraction of points below orography', '1', ymasks )
DEALLOCATE(ZAVG_PTS_ll)
DEALLOCATE(ZUND_PTS_ll)
@@ -301,54 +303,54 @@ tfield%ndimlist(4:) = NMNHDIM_UNUSED
ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
ldonorm = trim(cles_norm_type) /= 'NONE'
-call Les_diachro_write( tpdiafile, XLES_MEAN_U, 'MEAN_U', 'Mean U Profile', 'm s-1', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_MEAN_V, 'MEAN_V', 'Mean V Profile', 'm s-1', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_MEAN_W, 'MEAN_W', 'Mean W Profile', 'm s-1', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_MEAN_P, 'MEAN_PRE', 'Mean pressure Profile', 'Pa', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_MEAN_DP, 'MEAN_DP', 'Mean Dyn production TKE Profile', 'm2 s-3', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_MEAN_TP, 'MEAN_TP', 'Mean Thermal production TKE Profile', 'm2 s-3', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_MEAN_TR, 'MEAN_TR', 'Mean transport production TKE Profile', 'm2 s-3', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_MEAN_DISS, 'MEAN_DISS', 'Mean Dissipation TKE Profile', 'm2 s-3', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_MEAN_LM, 'MEAN_LM', 'Mean mixing length Profile', 'm', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_MEAN_RHO, 'MEAN_RHO', 'Mean density Profile', 'kg m-3', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_MEAN_Th, 'MEAN_TH', 'Mean potential temperature Profile', 'K', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_MEAN_Mf, 'MEAN_MF', 'Mass-flux Profile', 'm s-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_U, 'MEAN_U', 'Mean U Profile', 'm s-1', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_V, 'MEAN_V', 'Mean V Profile', 'm s-1', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_W, 'MEAN_W', 'Mean W Profile', 'm s-1', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_P, 'MEAN_PRE', 'Mean pressure Profile', 'Pa', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_DP, 'MEAN_DP', 'Mean Dyn production TKE Profile', 'm2 s-3', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_TP, 'MEAN_TP', 'Mean Thermal production TKE Profile', 'm2 s-3', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_TR, 'MEAN_TR', 'Mean transport production TKE Profile', 'm2 s-3', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_DISS, 'MEAN_DISS', 'Mean Dissipation TKE Profile', 'm2 s-3', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_LM, 'MEAN_LM', 'Mean mixing length Profile', 'm', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_RHO, 'MEAN_RHO', 'Mean density Profile', 'kg m-3', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Th, 'MEAN_TH', 'Mean potential temperature Profile', 'K', ymasks )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Mf, 'MEAN_MF', 'Mass-flux Profile', 'm s-1', ymasks )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Thl, 'MEAN_THL', 'Mean liquid potential temperature Profile', 'K', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Thl, 'MEAN_THL', 'Mean liquid potential temperature Profile', 'K', ymasks )
if ( luserv ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Thv, 'MEAN_THV', 'Mean virtual potential temperature Profile', 'K', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Thv, 'MEAN_THV', 'Mean virtual potential temperature Profile', 'K', ymasks )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rt, 'MEAN_RT', 'Mean Rt Profile', 'kg kg-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rt, 'MEAN_RT', 'Mean Rt Profile', 'kg kg-1', ymasks )
if ( luserv ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rv, 'MEAN_RV', 'Mean Rv Profile', 'kg kg-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rv, 'MEAN_RV', 'Mean Rv Profile', 'kg kg-1', ymasks )
if ( luserv ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rehu, 'MEAN_REHU', 'Mean Rh Profile', 'percent', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rehu, 'MEAN_REHU', 'Mean Rh Profile', 'percent', ymasks )
if ( luserv ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Qs, 'MEAN_QS', 'Mean Qs Profile', 'kg kg-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Qs, 'MEAN_QS', 'Mean Qs Profile', 'kg kg-1', ymasks )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_KHt, 'MEAN_KHT', 'Eddy-diffusivity (temperature) Profile', 'm2 s-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_KHt, 'MEAN_KHT', 'Eddy-diffusivity (temperature) Profile', 'm2 s-1', ymasks )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_KHr, 'MEAN_KHR', 'Eddy-diffusivity (wvapor) Profile', 'm2 s-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_KHr, 'MEAN_KHR', 'Eddy-diffusivity (vapor) Profile', 'm2 s-1', ymasks )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rc, 'MEAN_RC', 'Mean Rc Profile', 'kg kg-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rc, 'MEAN_RC', 'Mean Rc Profile', 'kg kg-1', ymasks )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Cf, 'MEAN_CF', 'Mean Cf Profile', '1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Cf, 'MEAN_CF', 'Mean Cf Profile', '1', ymasks )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_INDCf, 'MEAN_INDCF', 'Mean Cf>1-6 Profile (0 or 1)', '1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_INDCf, 'MEAN_INDCF', 'Mean Cf>1-6 Profile (0 or 1)', '1', ymasks )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_INDCf2, 'MEAN_INDCF2', 'Mean Cf>1-5 Profile (0 or 1)', '1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_INDCf2, 'MEAN_INDCF2', 'Mean Cf>1-5 Profile (0 or 1)', '1', ymasks )
if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rr, 'MEAN_RR', 'Mean Rr Profile', 'kg kg-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rr, 'MEAN_RR', 'Mean Rr Profile', 'kg kg-1', ymasks )
if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_RF, 'MEAN_RF', 'Mean RF Profile', '1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_RF, 'MEAN_RF', 'Mean RF Profile', '1', ymasks )
if ( luseri ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Ri, 'MEAN_RI', 'Mean Ri Profile', 'kg kg-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Ri, 'MEAN_RI', 'Mean Ri Profile', 'kg kg-1', ymasks )
if ( lusers ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rs, 'MEAN_RS', 'Mean Rs Profile', 'kg kg-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rs, 'MEAN_RS', 'Mean Rs Profile', 'kg kg-1', ymasks )
if ( luserg ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rg, 'MEAN_RG', 'Mean Rg Profile', 'kg kg-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rg, 'MEAN_RG', 'Mean Rg Profile', 'kg kg-1', ymasks )
if ( luserh ) &
-call Les_diachro_write( tpdiafile, XLES_MEAN_Rh, 'MEAN_RH', 'Mean Rh Profile', 'kg kg-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rh, 'MEAN_RH', 'Mean Rh Profile', 'kg kg-1', ymasks )
if ( nsv > 0 ) then
tfield%ndims = 4
@@ -358,7 +360,7 @@ if ( nsv > 0 ) then
tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
tfield%ndimlist(5:) = NMNHDIM_UNUSED
- call Les_diachro_write( tpdiafile, XLES_MEAN_Sv, 'MEAN_SV', 'Mean Sv Profiles', 'kg kg-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_MEAN_Sv, 'MEAN_SV', 'Mean Sv Profiles', 'kg kg-1', ymasks )
tfield%ndims = 3
!tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
@@ -368,28 +370,28 @@ if ( nsv > 0 ) then
!tfield%ndimlist(5:) = NMNHDIM_UNUSED
end if
-call Les_diachro_write( tpdiafile, XLES_MEAN_WIND, 'MEANWIND', 'Profile of Mean Modulus of Wind', 'm s-1', ysubtitle )
-call Les_diachro_write( tpdiafile, XLES_RESOLVED_MASSFX, 'MEANMSFX', 'Total updraft mass flux', 'kg m-2 s-1', ysubtitle )
+call Les_diachro_write( tpdiafile, XLES_MEAN_WIND, 'MEANWIND', 'Profile of Mean Modulus of Wind', 'm s-1', ymasks )
+call Les_diachro_write( tpdiafile, XLES_RESOLVED_MASSFX, 'MEANMSFX', 'Total updraft mass flux', 'kg m-2 s-1', ymasks )
if ( lles_pdf ) then
- call Les_diachro_write( tpdiafile, XLES_PDF_TH, 'PDF_TH', 'Pdf potential temperature Profiles', '1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_PDF_W, 'PDF_W', 'Pdf vertical velocity Profiles', '1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_PDF_THV, 'PDF_THV', 'Pdf virtual pot. temp. Profiles', '1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_PDF_TH, 'PDF_TH', 'Pdf potential temperature Profiles', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_PDF_W, 'PDF_W', 'Pdf vertical velocity Profiles', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_PDF_THV, 'PDF_THV', 'Pdf virtual pot. temp. Profiles', '1', ymasks )
if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_PDF_RV, 'PDF_RV', 'Pdf Rv Profiles', '1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_PDF_RV, 'PDF_RV', 'Pdf Rv Profiles', '1', ymasks )
if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_PDF_RC, 'PDF_RC', 'Pdf Rc Profiles', '1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_PDF_RT, 'PDF_RT', 'Pdf Rt Profiles', '1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_PDF_THL, 'PDF_THL', 'Pdf Thl Profiles', '1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_PDF_RC, 'PDF_RC', 'Pdf Rc Profiles', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_PDF_RT, 'PDF_RT', 'Pdf Rt Profiles', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_PDF_THL, 'PDF_THL', 'Pdf Thl Profiles', '1', ymasks )
end if
if ( luserr ) &
- call Les_diachro_write( tpdiafile, XLES_PDF_RR, 'PDF_RR', 'Pdf Rr Profiles', '1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_PDF_RR, 'PDF_RR', 'Pdf Rr Profiles', '1', ymasks )
if ( luseri ) &
- call Les_diachro_write( tpdiafile, XLES_PDF_RI, 'PDF_RI', 'Pdf Ri Profiles', '1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_PDF_RI, 'PDF_RI', 'Pdf Ri Profiles', '1', ymasks )
if ( lusers ) &
- call Les_diachro_write( tpdiafile, XLES_PDF_RS, 'PDF_RS', 'Pdf Rs Profiles', '1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_PDF_RS, 'PDF_RS', 'Pdf Rs Profiles', '1', ymasks )
if ( luserg ) &
- call Les_diachro_write( tpdiafile, XLES_PDF_RG, 'PDF_RG', 'Pdf Rg Profiles', '1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_PDF_RG, 'PDF_RG', 'Pdf Rg Profiles', '1', ymasks )
end if
!
!* 2.2 resolved quantities
@@ -406,89 +408,79 @@ if ( lles_resolved ) then
tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
tfield%ndimlist(4:) = NMNHDIM_UNUSED
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_U2, 'RES_U2', 'Resolved <u2> variance', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_V2, 'RES_V2', 'Resolved <v2> variance', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2, 'RES_W2', 'Resolved <w2> variance', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UV, 'RES_UV', 'Resolved <uv> Flux', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WU, 'RES_WU', 'Resolved <wu> Flux', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WV, 'RES_WV', 'Resolved <wv> Flux', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Ke, 'RES_KE', 'Resolved TKE Profile', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_P2, 'RES_P2', 'Resolved pressure variance', 'Pa2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UP, 'RES_UPZ', 'Resolved <up> horizontal Flux', 'Pa s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VP, 'RES_VPZ', 'Resolved <vp> horizontal Flux', 'Pa s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WP, 'RES_WPZ', 'Resolved <wp> vertical Flux', 'Pa s-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_U2, 'RES_U2', 'Resolved <u2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_V2, 'RES_V2', 'Resolved <v2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2, 'RES_W2', 'Resolved <w2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UV, 'RES_UV', 'Resolved <uv> Flux', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WU, 'RES_WU', 'Resolved <wu> Flux', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WV, 'RES_WV', 'Resolved <wv> Flux', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Ke, 'RES_KE', 'Resolved TKE Profile', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_P2, 'RES_P2', 'Resolved pressure variance', 'Pa2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UP, 'RES_UPZ', 'Resolved <up> horizontal Flux', 'Pa s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VP, 'RES_VPZ', 'Resolved <vp> horizontal Flux', 'Pa s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WP, 'RES_WPZ', 'Resolved <wp> vertical Flux', 'Pa s-1', ymasks )
if ( luserv ) &
call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThThv, 'RES_THTV', &
- 'Resolved potential temperature - virtual potential temperature covariance', 'K2', ysubtitle )
+ 'Resolved potential temperature - virtual potential temperature covariance', 'K2', ymasks )
if ( luserc ) &
call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlThv, 'RES_TLTV', &
- 'Resolved liquid potential temperature - virtual potential temperature covariance', 'K2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Th2, 'RES_TH2', 'Resolved potential temperature variance', 'K2', ysubtitle )
+ 'Resolved liquid potential temperature - virtual potential temperature covariance', 'K2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Th2, 'RES_TH2', 'Resolved potential temperature variance', 'K2', ymasks )
if ( luserc ) &
call Les_diachro_write( tpdiafile, XLES_RESOLVED_Thl2, 'RES_THL2', 'Resolved liquid potential temperature variance', 'K2',&
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UTh, 'RES_UTH', 'Resolved <uth> horizontal Flux', 'm K s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VTh, 'RES_VTH', 'Resolved <vth> horizontal Flux', 'm K s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WTh, 'RES_WTH', 'Resolved <wth> vertical Flux', 'm K s-1', ysubtitle )
+ ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UTh, 'RES_UTH', 'Resolved <uth> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VTh, 'RES_VTH', 'Resolved <vth> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WTh, 'RES_WTH', 'Resolved <wth> vertical Flux', 'm K s-1', ymasks )
if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UThl, 'RES_UTHL', 'Resolved <uthl> horizontal Flux', 'm K s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VThl, 'RES_VTHL', 'Resolved <vthl> horizontal Flux', 'm K s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThl, 'RES_WTHL', 'Resolved <wthl> vertical Flux', 'm K s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rt2, 'RES_RT2', 'Resolved total water variance', 'kg2 kg-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRt, 'RES_WRT', 'Resolved <wrt> vertical Flux', 'm kg kg-1 s-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UThl, 'RES_UTHL', 'Resolved <uthl> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VThl, 'RES_VTHL', 'Resolved <vthl> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThl, 'RES_WTHL', 'Resolved <wthl> vertical Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rt2, 'RES_RT2', 'Resolved total water variance', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRt, 'RES_WRT', 'Resolved <wrt> vertical Flux', 'm kg kg-1 s-1', ymasks )
end if
if ( luserv ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UThv, 'RES_UTHV', 'Resolved <uthv> horizontal Flux', 'm K s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VThv, 'RES_VTHV', 'Resolved <vthv> horizontal Flux', 'm K s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThv, 'RES_WTHV', 'Resolved <wthv> vertical Flux', 'm K s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rv2, 'RES_RV2', 'Resolved water vapor variance', 'kg2 kg-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRv, 'RES_THRV', 'Resolved <thrv> covariance', 'K kg kg-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UThv, 'RES_UTHV', 'Resolved <uthv> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VThv, 'RES_VTHV', 'Resolved <vthv> horizontal Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThv, 'RES_WTHV', 'Resolved <wthv> vertical Flux', 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rv2, 'RES_RV2', 'Resolved water vapor variance', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRv, 'RES_THRV', 'Resolved <thrv> covariance', 'K kg kg-1', ymasks )
if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRv, 'RES_TLRV', 'Resolved <thlrv> covariance', 'K kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRv, 'RES_TVRV', 'Resolved <thvrv> covariance', 'K kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_URv, 'RES_URV', 'Resolved <urv> horizontal flux', 'm kg kg-1 s-1', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRv, 'RES_VRV', 'Resolved <vrv> horizontal flux', 'm kg kg-1 s-1', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRv, 'RES_WRV', 'Resolved <wrv> vertical flux', 'm kg kg-1 s-1', &
- ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRv, 'RES_TLRV', 'Resolved <thlrv> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRv, 'RES_TVRV', 'Resolved <thvrv> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_URv, 'RES_URV', 'Resolved <urv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRv, 'RES_VRV', 'Resolved <vrv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRv, 'RES_WRV', 'Resolved <wrv> vertical flux', 'm kg kg-1 s-1', ymasks )
end if
if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rc2, 'RES_RC2', 'Resolved cloud water variance', 'kg2 kg-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRc, 'RES_THRC', 'Resolved <thrc> covariance', 'K kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRc, 'RES_TLRC', 'Resolved <thlrc> covariance', 'K kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRc, 'RES_TVRC', 'Resolved <thvrc> covariance', 'K kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_URc, 'RES_URC', 'Resolved <urc> horizontal flux', 'm kg kg-1 s-1', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRc, 'RES_VRC', 'Resolved <vrc> horizontal flux', 'm kg kg-1 s-1', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRc, 'RES_WRC', 'Resolved <wrc> vertical flux', 'm kg kg-1 s-1', &
- ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Rc2, 'RES_RC2', 'Resolved cloud water variance', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRc, 'RES_THRC', 'Resolved <thrc> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRc, 'RES_TLRC', 'Resolved <thlrc> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRc, 'RES_TVRC', 'Resolved <thvrc> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_URc, 'RES_URC', 'Resolved <urc> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRc, 'RES_VRC', 'Resolved <vrc> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRc, 'RES_WRC', 'Resolved <wrc> vertical flux', 'm kg kg-1 s-1', ymasks )
end if
if ( luseri ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Ri2, 'RES_RI2', 'Resolved cloud ice variance', 'kg2 kg-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRi, 'RES_THRI', 'Resolved <thri> covariance', 'K kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRi, 'RES_TLRI', 'Resolved <thlri> covariance', 'K kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRi, 'RES_TVRI', 'Resolved <thvri> covariance', 'K kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_URi, 'RES_URI', 'Resolved <uri> horizontal flux', 'm kg kg-1 s-1', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRi, 'RES_VRI', 'Resolved <vri> horizontal flux', 'm kg kg-1 s-1', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRi, 'RES_WRI', 'Resolved <wri> vertical flux', 'm kg kg-1 s-1', &
- ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Ri2, 'RES_RI2', 'Resolved cloud ice variance', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThRi, 'RES_THRI', 'Resolved <thri> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlRi, 'RES_TLRI', 'Resolved <thlri> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvRi, 'RES_TVRI', 'Resolved <thvri> covariance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_URi, 'RES_URI', 'Resolved <uri> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VRi, 'RES_VRI', 'Resolved <vri> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRi, 'RES_WRI', 'Resolved <wri> vertical flux', 'm kg kg-1 s-1', ymasks )
end if
if ( luserr ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRr, 'RES_WRR', 'Resolved <wrr> vertical flux', 'm kg kg-1 s-1', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_INPRR3D, 'INPRR3D', 'Precipitation flux', 'm s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_MAX_INPRR3D, 'MAXINPR3D', 'Max Precip flux', 'm s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_EVAP3D, 'EVAP3D', 'Evaporation profile', 'kg kg-1 s-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRr, 'RES_WRR', 'Resolved <wrr> vertical flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_INPRR3D, 'INPRR3D', 'Precipitation flux', 'm s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_MAX_INPRR3D, 'MAXINPR3D', 'Max Precip flux', 'm s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_EVAP3D, 'EVAP3D', 'Evaporation profile', 'kg kg-1 s-1', ymasks )
end if
if ( nsv > 0 ) then
@@ -499,19 +491,15 @@ if ( lles_resolved ) then
tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
tfield%ndimlist(5:) = NMNHDIM_UNUSED
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_Sv2, 'RES_SV2', 'Resolved scalar variables variances', 'kg2 kg-2', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThSv, 'RES_THSV', 'Resolved <ThSv> variance', 'K kg kg-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_Sv2, 'RES_SV2', 'Resolved scalar variables variances', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThSv, 'RES_THSV', 'Resolved <ThSv> variance', 'K kg kg-1', ymasks )
if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlSv, 'RES_TLSV', 'Resolved <ThlSv> variance', 'K kg kg-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlSv, 'RES_TLSV', 'Resolved <ThlSv> variance', 'K kg kg-1', ymasks )
if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvSv, 'RES_TVSV', 'Resolved <ThvSv> variance', 'K kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_USv, 'RES_USV', 'Resolved <uSv> horizontal flux', 'm kg kg-1 s-1', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VSv, 'RES_VSV', 'Resolved <vSv> horizontal flux', 'm kg kg-1 s-1', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WSv, 'RES_WSV', 'Resolved <wSv> vertical flux', 'm kg kg-1 s-1', &
- ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThvSv, 'RES_TVSV', 'Resolved <ThvSv> variance', 'K kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_USv, 'RES_USV', 'Resolved <uSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VSv, 'RES_VSV', 'Resolved <vSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WSv, 'RES_WSV', 'Resolved <wSv> vertical flux', 'm kg kg-1 s-1', ymasks )
tfield%ndims = 3
!tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
@@ -521,37 +509,37 @@ if ( lles_resolved ) then
!tfield%ndimlist(5:) = NMNHDIM_UNUSED
end if
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_U3, 'RES_U3', 'Resolved <u3>', 'm3 s-3', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_V3, 'RES_V3', 'Resolved <v3>', 'm3 s-3', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W3, 'RES_W3', 'Resolved <w3>', 'm3 s-3', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_U4, 'RES_U4', 'Resolved <u4>', 'm4 s-4', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_V4, 'RES_V4', 'Resolved <v4>', 'm4 s-4', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W4, 'RES_W4', 'Resolved <>w4', 'm4 s-4', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_U3, 'RES_U3', 'Resolved <u3>', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_V3, 'RES_V3', 'Resolved <v3>', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W3, 'RES_W3', 'Resolved <w3>', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_U4, 'RES_U4', 'Resolved <u4>', 'm4 s-4', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_V4, 'RES_V4', 'Resolved <v4>', 'm4 s-4', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W4, 'RES_W4', 'Resolved <w4>', 'm4 s-4', ymasks )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThl2, 'RES_WTL2', 'Resolved <wThl2', 'm K2 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Thl, 'RES_W2TL', 'Resolved <w2Thl>', 'm2 K s-2', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThl2, 'RES_WTL2', 'Resolved <wThl2>', 'm K2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Thl, 'RES_W2TL', 'Resolved <w2Thl>', 'm2 K s-2', ymasks )
if ( luserv ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRv2, 'RES_WRV2', 'Resolved <wRv2>', 'm kg2 kg-2 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rv, 'RES_W2RV', 'Resolved <w2Rv>', 'm2 kg kg-1 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRt2, 'RES_WRT2', 'Resolved <wRt2>', 'm kg2 kg-2 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rt, 'RES_W2RT', 'Resolved <w2Rt>', 'm2 kg kg-1 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRv, 'RE_WTLRV', 'Resolved <wThlRv>', 'm K kg kg-1 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRt, 'RE_WTLRT', 'Resolved <wThlRt>', 'm K kg kg-1 s-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRv2, 'RES_WRV2', 'Resolved <wRv2>', 'm kg2 kg-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rv, 'RES_W2RV', 'Resolved <w2Rv>', 'm2 kg kg-1 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRt2, 'RES_WRT2', 'Resolved <wRt2>', 'm kg2 kg-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rt, 'RES_W2RT', 'Resolved <w2Rt>', 'm2 kg kg-1 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRv, 'RE_WTLRV', 'Resolved <wThlRv>', 'm K kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRt, 'RE_WTLRT', 'Resolved <wThlRt>', 'm K kg kg-1 s-1', ymasks )
end if
if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRc2, 'RES_WRC2', 'Resolved <wRc2>', 'm kg2 kg-2 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rc, 'RES_W2RC', 'Resolved <w2Rc>', 'm2 kg kg-1 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRc, 'RE_WTLRC', 'Resolved <wThlRc>', 'm K kg kg-1 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvRc, 'RE_WRVRC', 'Resolved <wRvRc>', 'm kg2 kg-2 s-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRc2, 'RES_WRC2', 'Resolved <wRc2>', 'm kg2 kg-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Rc, 'RES_W2RC', 'Resolved <w2Rc>', 'm2 kg kg-1 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRc, 'RE_WTLRC', 'Resolved <wThlRc>', 'm K kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvRc, 'RE_WRVRC', 'Resolved <wRvRc>', 'm kg2 kg-2 s-1', ymasks )
end if
if ( luseri ) then
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRi2, 'RES_WRI2', 'Resolved <wRi2>', 'm kg2 kg-2 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Ri, 'RES_W2RI', 'Resolved <w2Ri>', 'm2 kg kg-1 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRi, 'RE_WTLRI', 'Resolved <wThlRi>', 'm K kg kg-1 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvRi, 'RE_WRVRI', 'Resolved <wRvRi>', 'm kg2 kg-2 s-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRi2, 'RES_WRI2', 'Resolved <wRi2>', 'm kg2 kg-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Ri, 'RES_W2RI', 'Resolved <w2Ri>', 'm2 kg kg-1 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlRi, 'RE_WTLRI', 'Resolved <wThlRi>', 'm K kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvRi, 'RE_WRVRI', 'Resolved <wRvRi>', 'm kg2 kg-2 s-1', ymasks )
end if
if ( nsv > 0 ) then
@@ -562,11 +550,11 @@ if ( lles_resolved ) then
tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
tfield%ndimlist(5:) = NMNHDIM_UNUSED
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WSv2, 'RES_WSV2', 'Resolved <wSv2>', 'm kg2 kg-2 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Sv, 'RES_W2SV', 'Resolved <w2Sv>', 'm2 kg kg-1 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlSv, 'RE_WTLSV', 'Resolved <wThlSv>', 'm K kg kg-1 s-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WSv2, 'RES_WSV2', 'Resolved <wSv2>', 'm kg2 kg-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_W2Sv, 'RES_W2SV', 'Resolved <w2Sv>', 'm2 kg kg-1 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WThlSv, 'RE_WTLSV', 'Resolved <wThlSv>', 'm K kg kg-1 s-1', ymasks )
if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvSv, 'RE_WRVSV', 'Resolved <wRvSv>', 'm kg2 kg-2 s-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WRvSv, 'RE_WRVSV', 'Resolved <wRvSv>', 'm kg2 kg-2 s-1', ymasks )
tfield%ndims = 3
!tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
@@ -576,15 +564,15 @@ if ( lles_resolved ) then
!tfield%ndimlist(5:) = NMNHDIM_UNUSED
end if
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlPz, 'RES_TLPZ', 'Resolved <Thldp/dz>', 'K Pa m-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlPz, 'RES_TLPZ', 'Resolved <Thldp/dz>', 'K Pa m-1', ymasks )
if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_RtPz, 'RES_RTPZ', 'Resolved <Rtdp/dz>', 'kg2 kg-2 Pa m-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_RtPz, 'RES_RTPZ', 'Resolved <Rtdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
if ( luserv ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_RvPz, 'RES_RVPZ', 'Resolved <Rvdp/dz>', 'kg2 kg-2 Pa m-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_RvPz, 'RES_RVPZ', 'Resolved <Rvdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
if ( luserc ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_RcPz, 'RES_RCPZ', 'Resolved <Rcdp/dz>', 'kg2 kg-2 Pa m-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_RcPz, 'RES_RCPZ', 'Resolved <Rcdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
if ( luseri ) &
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_RiPz, 'RES_RIPZ', 'Resolved <Ridp/dz>', 'kg2 kg-2 Pa m-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_RiPz, 'RES_RIPZ', 'Resolved <Ridp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
if ( nsv > 0 ) then
tfield%ndims = 4
@@ -594,7 +582,7 @@ if ( lles_resolved ) then
tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
tfield%ndimlist(5:) = NMNHDIM_UNUSED
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_SvPz, 'RES_SVPZ', 'Resolved <Svdp/dz>', 'kg2 kg-2 Pa m-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_SvPz, 'RES_SVPZ', 'Resolved <Svdp/dz>', 'kg2 kg-2 Pa m-1', ymasks )
tfield%ndims = 3
!tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
@@ -604,9 +592,9 @@ if ( lles_resolved ) then
!tfield%ndimlist(5:) = NMNHDIM_UNUSED
end if
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_UKe, 'RES_UKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ysubtitle)
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_VKe, 'RES_VKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ysubtitle)
- call Les_diachro_write( tpdiafile, XLES_RESOLVED_WKe, 'RES_WKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ysubtitle)
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_UKe, 'RES_UKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_VKe, 'RES_VKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_WKe, 'RES_WKE', 'Resolved flux of resolved kinetic energy', 'm3 s-3', ymasks )
end if
!
!
@@ -624,73 +612,73 @@ if ( lles_subgrid ) then
tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
tfield%ndimlist(4:) = NMNHDIM_UNUSED
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_Tke, 'SBG_TKE', 'Subgrid TKE', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_U2, 'SBG_U2', 'Subgrid <u2> variance', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_V2, 'SBG_V2', 'Subgrid <v2> variance', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_W2, 'SBG_W2', 'Subgrid <w2> variance', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_UV, 'SBG_UV', 'Subgrid <uv> flux', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WU, 'SBG_WU', 'Subgrid <wu> flux', 'm2 s-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WV, 'SBG_WV', 'Subgrid <wv> flux', 'm2 s-2', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_Tke, 'SBG_TKE', 'Subgrid TKE', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_U2, 'SBG_U2', 'Subgrid <u2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_V2, 'SBG_V2', 'Subgrid <v2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_W2, 'SBG_W2', 'Subgrid <w2> variance', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_UV, 'SBG_UV', 'Subgrid <uv> flux', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WU, 'SBG_WU', 'Subgrid <wu> flux', 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WV, 'SBG_WV', 'Subgrid <wv> flux', 'm2 s-2', ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_Thl2, 'SBG_THL2', 'Subgrid liquid potential temperature variance', &
- 'K2', ysubtITLE )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_UThl, 'SBG_UTHL', 'Subgrid hor. flux of liquid potential temperature', &
- 'm K s-1', YSUBTITLE )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_VThl, 'SBG_VTHL', 'Subgrid hor. flux of liquid potential temperature', &
- 'm K s-1', YSUBTITLE )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThl, 'SBG_WTHL', 'Subgrid vert. flux of liquid potential temperature', &
- 'm K s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WP, 'SBG_WP', 'Subgrid <wp> vertical Flux', 'm Pa s-1', ysubtitle )
-
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_THLUP_MF, 'THLUP_MF', 'Subgrid <thl> of updraft', 'K', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_RTUP_MF, 'RTUP_MF', 'Subgrid <rt> of updraft', 'kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_RVUP_MF, 'RVUP_MF', 'Subgrid <rv> of updraft', 'kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_RCUP_MF, 'RCUP_MF', 'Subgrid <rc> of updraft', 'kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_RIUP_MF, 'RIUP_MF', 'Subgrid <ri> of updraft', 'kg kg-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WUP_MF, 'WUP_MF', 'Subgrid <w> of updraft', 'm s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_MASSFLUX, 'MAFLX_MF', 'Subgrid <MF> of updraft', 'kg m-2 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_DETR, 'DETR_MF', 'Subgrid <detr> of updraft', 'kg m-3 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_ENTR, 'ENTR_MF', 'Subgrid <entr> of updraft', 'kg m-3 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_FRACUP, 'FRCUP_MF', 'Subgrid <FracUp> of updraft', '1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_THVUP_MF, 'THVUP_MF', 'Subgrid <thv> of updraft', 'K', ysubtitle )
+ 'K2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_UThl, 'SBG_UTHL', 'Subgrid horizontal flux of liquid potential temperature', &
+ 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_VThl, 'SBG_VTHL', 'Subgrid horizontal flux of liquid potential temperature', &
+ 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThl, 'SBG_WTHL', 'Subgrid vertical flux of liquid potential temperature', &
+ 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WP, 'SBG_WP', 'Subgrid <wp> vertical Flux', 'm Pa s-1', ymasks )
+
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_THLUP_MF, 'THLUP_MF', 'Subgrid <thl> of updraft', 'K', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_RTUP_MF, 'RTUP_MF', 'Subgrid <rt> of updraft', 'kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_RVUP_MF, 'RVUP_MF', 'Subgrid <rv> of updraft', 'kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_RCUP_MF, 'RCUP_MF', 'Subgrid <rc> of updraft', 'kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_RIUP_MF, 'RIUP_MF', 'Subgrid <ri> of updraft', 'kg kg-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WUP_MF, 'WUP_MF', 'Subgrid <w> of updraft', 'm s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_MASSFLUX, 'MAFLX_MF', 'Subgrid <MF> of updraft', 'kg m-2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_DETR, 'DETR_MF', 'Subgrid <detr> of updraft', 'kg m-3 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_ENTR, 'ENTR_MF', 'Subgrid <entr> of updraft', 'kg m-3 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_FRACUP, 'FRCUP_MF', 'Subgrid <FracUp> of updraft', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_THVUP_MF, 'THVUP_MF', 'Subgrid <thv> of updraft', 'K', ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_WTHLMF, 'WTHL_MF', 'Subgrid <wthl> of mass flux convection scheme', &
- 'm K s-1', ysubtitle )
+ 'm K s-1', ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_WRTMF, 'WRT_MF', 'Subgrid <wrt> of mass flux convection scheme', &
- 'm kg kg-1 s-1', ysubtitle )
+ 'm kg kg-1 s-1', ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_WTHVMF, 'WTHV_MF', 'Subgrid <wthv> of mass flux convection scheme', &
- 'm K s-1', ysubtitle )
+ 'm K s-1', ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_WUMF, 'WU_MF', 'Subgrid <wu> of mass flux convection scheme', &
- 'm2 s-2', ysubtitle )
+ 'm2 s-2', ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_WVMF, 'WV_MF', 'Subgrid <wv> of mass flux convection scheme', &
- 'm2 s-2', ysubtitle )
+ 'm2 s-2', ymasks )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_PHI3, 'SBG_PHI3', 'Subgrid Phi3 function', '1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_LMix, 'SBG_LMIX', 'Subgrid Mixing Length', '1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_LDiss, 'SBG_LDIS', 'Subgrid Dissipation Length', '1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_Km, 'SBG_KM', 'Eddy diffusivity for momentum', 'm2 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_Kh, 'SBG_KH', 'Eddy diffusivity for heat', 'm2 s-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_PHI3, 'SBG_PHI3', 'Subgrid Phi3 function', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_LMix, 'SBG_LMIX', 'Subgrid Mixing Length', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_LDiss, 'SBG_LDIS', 'Subgrid Dissipation Length', '1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_Km, 'SBG_KM', 'Eddy diffusivity for momentum', 'm2 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_Kh, 'SBG_KH', 'Eddy diffusivity for heat', 'm2 s-1', ymasks )
if ( luserv ) then
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThv, 'SBG_WTHV', 'Subgrid vert. flux of liquid potential temperature', &
- 'm K s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_Rt2, 'SBG_RT2', 'Subgrid total water variance', 'kg2 kg-2', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_ThlRt, 'SBG_TLRT', 'Subgrid <thlrt> covariance', 'K kg kg-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThv, 'SBG_WTHV', 'Subgrid vertical flux of liquid potential temperature', &
+ 'm K s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_Rt2, 'SBG_RT2', 'Subgrid total water variance', 'kg2 kg-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_ThlRt, 'SBG_TLRT', 'Subgrid <thlrt> covariance', 'K kg kg-1', ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_URt, 'SBG_URT', 'Subgrid total water horizontal flux', &
- 'm kg kg-1 s-1', ysubtitle )
+ 'm kg kg-1 s-1', ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_VRt, 'SBG_VRT', 'Subgrid total water horizontal flux', &
- 'm kg kg-1 s-1', ysubtitle )
+ 'm kg kg-1 s-1', ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_WRt, 'SBG_WRT', 'Subgrid total water vertical flux', &
- 'm kg kg-1 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_PSI3, 'SBG_PSI3', 'Subgrid Psi3 function', '1', ysubtitle )
+ 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_PSI3, 'SBG_PSI3', 'Subgrid Psi3 function', '1', ymasks )
end if
if ( luserc ) then
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_Rc2, 'SBG_RC2', 'Subgrid cloud water variance', 'kg2 kg-2', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_Rc2, 'SBG_RC2', 'Subgrid cloud water variance', 'kg2 kg-2', ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_URc, 'SBG_URC', 'Subgrid cloud water horizontal flux', 'm kg kg-1 s-1', &
- ysubtitle )
+ ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_VRc, 'SBG_VRC', 'Subgrid cloud water horizontal flux', 'm kg kg-1 s-1', &
- ysubtitle )
+ ymasks )
call Les_diachro_write( tpdiafile, XLES_SUBGRID_WRc, 'SBG_WRC', 'Subgrid cloud water vertical flux', 'm kg kg-1 s-1', &
- ysubtitle )
+ ymasks )
end if
if ( nsv > 0 ) then
@@ -701,9 +689,9 @@ if ( lles_subgrid ) then
tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
tfield%ndimlist(5:) = NMNHDIM_UNUSED
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_USv, 'SBG_USV', 'Subgrid <uSv> horizontal flux', 'm kg kg-1 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_VSv, 'SBG_VSV', 'Subgrid <vSv> horizontal flux', 'm kg kg-1 s-1', ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WSv, 'SBG_WSV', 'Subgrid <wSv> vertical flux', 'm kg kg-1 s-1', ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_USv, 'SBG_USV', 'Subgrid <uSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_VSv, 'SBG_VSV', 'Subgrid <vSv> horizontal flux', 'm kg kg-1 s-1', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WSv, 'SBG_WSV', 'Subgrid <wSv> vertical flux', 'm kg kg-1 s-1', ymasks )
tfield%ndims = 3
!tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
@@ -715,16 +703,11 @@ if ( lles_subgrid ) then
end if
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_UTke, 'SBG_UTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_VTke, 'SBG_VTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WTke, 'SBG_WTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_W2Thl, 'SBG_W2TL', 'Subgrid flux of subgrid kinetic energy', 'm2 K s-2', &
- ysubtitle )
- call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThl2, 'SBG_WTL2', 'Subgrid flux of subgrid kinetic energy', 'm K2 s-1', &
- ysubtitle )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_UTke, 'SBG_UTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_VTke, 'SBG_VTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WTke, 'SBG_WTKE', 'Subgrid flux of subgrid kinetic energy', 'm3 s-3', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_W2Thl, 'SBG_W2TL', 'Subgrid flux of subgrid kinetic energy', 'm2 K s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WThl2, 'SBG_WTL2', 'Subgrid flux of subgrid kinetic energy', 'm K2 s-1', ymasks )
end if
@@ -972,14 +955,14 @@ tfield%ndimlist(3:) = NMNHDIM_UNUSED
ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
ldonorm = .false.
-call Les_diachro_write( tpdiafile, XLES_SWU, 'SWU', 'sw_up', 'W m-2' )
-call Les_diachro_write( tpdiafile, XLES_SWD, 'SWD', 'sw_down', 'W m-2' )
-call Les_diachro_write( tpdiafile, XLES_LWU, 'LWU', 'lw_up', 'W m-2' )
-call Les_diachro_write( tpdiafile, XLES_LWD, 'LWD', 'lw_down', 'W m-2' )
-call Les_diachro_write( tpdiafile, XLES_DTHRADSW, 'DTHRADSW', 'dthrad_sw', 'K s-1' )
-call Les_diachro_write( tpdiafile, XLES_DTHRADLW, 'DTHRADLW', 'dthrad_lw', 'K s-1' )
+call Les_diachro_write( tpdiafile, XLES_SWU, 'SWU', 'SW upward radiative flux', 'W m-2' )
+call Les_diachro_write( tpdiafile, XLES_SWD, 'SWD', 'SW downward radiative flux', 'W m-2' )
+call Les_diachro_write( tpdiafile, XLES_LWU, 'LWU', 'LW upward radiative flux', 'W m-2' )
+call Les_diachro_write( tpdiafile, XLES_LWD, 'LWD', 'LW downward radiative flux', 'W m-2' )
+call Les_diachro_write( tpdiafile, XLES_DTHRADSW, 'DTHRADSW', 'SW radiative temperature tendency', 'K s-1' )
+call Les_diachro_write( tpdiafile, XLES_DTHRADLW, 'DTHRADLW', 'LW radiative temperature tendency', 'K s-1' )
!writes mean_effective radius at all levels
-call Les_diachro_write( tpdiafile, XLES_RADEFF, 'RADEFF', 'mean effective radius', 'micron' )
+call Les_diachro_write( tpdiafile, XLES_RADEFF, 'RADEFF', 'Mean effective radius', 'micron' )
! !Prepare metadate (used in Les_diachro_write calls)
@@ -1005,17 +988,17 @@ if ( nsv > 0 ) then
!tfield%ndimlist(3:) = NMNHDIM_UNUSED
end if
-call Les_diachro_write( tpdiafile, XLES_USTAR, 'U*', 'Friction velocity', 'm s-1' )
-call Les_diachro_write( tpdiafile, XLES_WSTAR, 'W*', 'Convective velocity', 'm s-1' )
+call Les_diachro_write( tpdiafile, XLES_USTAR, 'Ustar', 'Friction velocity', 'm s-1' )
+call Les_diachro_write( tpdiafile, XLES_WSTAR, 'Wstar', 'Convective velocity', 'm s-1' )
call Les_diachro_write( tpdiafile, XLES_BL_HEIGHT, 'BL_H', 'Boundary Layer Height', 'm' )
call Les_diachro_write( tpdiafile, XLES_MO_LENGTH, 'L_MO', 'Monin-Obukhov length', 'm' )
-call Les_diachro_write( tpdiafile, XLES_INT_TKE, 'INT_TKE', 'Vertical integrated tke', 'm2 s-2' )
+call Les_diachro_write( tpdiafile, XLES_INT_TKE, 'INT_TKE', 'Vertical integrated TKE', 'm2 s-2' )
if ( luserc ) &
call Les_diachro_write( tpdiafile, XLES_ZCB, 'ZCB', 'Cloud base Height', 'm' )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_CFtot, 'ZCFTOT', 'Total Cloud cover', '1' )
+call Les_diachro_write( tpdiafile, XLES_CFtot, 'ZCFTOT', 'Total cloud cover (rc>1e-6)', '1' )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_CF2tot, 'ZCF2TOT', 'Total Cloud cove 2r', '1' )
+call Les_diachro_write( tpdiafile, XLES_CF2tot, 'ZCF2TOT', 'Total cloud cover (rc>1e-5)', '1' )
if ( luserc ) &
call Les_diachro_write( tpdiafile, XLES_LWP, 'LWP', 'Liquid Water path', 'kg m-2' )
if ( luserc ) &
@@ -1031,21 +1014,22 @@ call Les_diachro_write( tpdiafile, XLES_GWP, 'GWP', 'Graupel Water
if ( luserh ) &
call Les_diachro_write( tpdiafile, XLES_HWP, 'HWP', 'Hail Water path', 'kg m-2' )
if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_PRECFR, 'PREC_FRAC', 'Fract of col where rain at surface', '1' )
+call Les_diachro_write( tpdiafile, XLES_PRECFR, 'PREC_FRAC', 'Fraction of columns where rain at surface', '1' )
if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_INPRR, 'INST_PREC', 'Inst precip rate', 'mm day-1' )
+call Les_diachro_write( tpdiafile, XLES_INPRR, 'INST_PREC', 'Instantaneous precipitation rate', 'mm day-1' )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_INPRC, 'INST_SEDIM', 'Inst cloud precip rate', 'mm day-1' )
+call Les_diachro_write( tpdiafile, XLES_INPRC, 'INST_SEDIM', 'Instantaneous cloud precipitation rate', 'mm day-1' )
if ( luserc .and. ( ldeposc .or. ldepoc ) ) &
-call Les_diachro_write( tpdiafile, XLES_INDEP, 'INST_DEPOS', 'Inst cloud deposi rate', 'mm day-1' )
+call Les_diachro_write( tpdiafile, XLES_INDEP, 'INST_DEPOS', 'Instantaneous cloud deposition rate', 'mm day-1' )
if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_RAIN_INPRR, 'RAIN_PREC', 'Inst pr. rate over rainy grid cells', 'mm day-1' )
+call Les_diachro_write( tpdiafile, XLES_RAIN_INPRR, 'RAIN_PREC', 'Instantaneous precipitation rate over rainy grid cells', &
+ 'mm day-1' )
if ( luserr ) &
-call Les_diachro_write( tpdiafile, XLES_ACPRR, 'ACCU_PREC', 'Accu precip rate', 'mm' )
+call Les_diachro_write( tpdiafile, XLES_ACPRR, 'ACCU_PREC', 'Accumulated precipitation rate', 'mm' )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_ZMAXCF, 'ZMAXCF', 'Height of Cloud fraction max', 'm' )
+call Les_diachro_write( tpdiafile, XLES_ZMAXCF, 'ZMAXCF', 'Height of Cloud fraction maximum (rc>1e-6)', 'm' )
if ( luserc ) &
-call Les_diachro_write( tpdiafile, XLES_ZMAXCF2, 'ZMAXCF2', 'Height of Cloud fraction2max', 'm' )
+call Les_diachro_write( tpdiafile, XLES_ZMAXCF2, 'ZMAXCF2', 'Height of Cloud fraction maximum (rc>1e-5)', 'm' )
!-------------------------------------------------------------------------------
!
@@ -1118,12 +1102,14 @@ if ( nspectra_k > 0 ) then
call Les_diachro_2pt_write( tpdiafile, XCORRi_WRi, XCORRj_WRi, 'WRI', 'W*ri 2 points correlations', 'm kg s-1 kg-1' )
end if
+!PW: TODO: ameliorer le ygroup (tenir compte de ce qu'est la variable scalaire et pas juste son jsv!)
do jsv = 1, nsv
Write( ygroup, fmt = "( a2, i3.3 )" ) "SS", jsv
call Les_diachro_2pt_write( tpdiafile, XCORRi_SvSv(:,:,:,JSV), XCORRj_SvSv(:,:,:,JSV), ygroup, &
'Sv*Sv 2 points correlations','kg2 kg-2' )
end do
+!PW: TODO: ameliorer le ygroup (tenir compte de ce qu'est la variable scalaire et pas juste son jsv!)
do jsv = 1, nsv
Write( ygroup, fmt = "( a2, i3.3 )" ) "WS", jsv
call Les_diachro_2pt_write( tpdiafile, XCORRi_WSv(:,:,:,JSV), XCORRj_WSv(:,:,:,JSV), ygroup, &
@@ -1205,7 +1191,7 @@ end subroutine Les_diachro_write_2D
!------------------------------------------------------------------------------
-subroutine Les_diachro_write_3D( tpdiafile, pdata, hmnhname, hcomment, hunits, hsuffixes )
+subroutine Les_diachro_write_3D( tpdiafile, pdata, hmnhname, hcomment, hunits, hmasks )
use modd_io, only: tfiledata
@@ -1216,20 +1202,20 @@ real, dimension(:,:,:), intent(in) :: pdata
character(len=*), intent(in) :: hmnhname
character(len=*), intent(in) :: hcomment
character(len=*), intent(in) :: hunits
-character(len=*), dimension(:), optional, intent(in) :: hsuffixes
+character(len=*), dimension(:), optional, intent(in) :: hmasks
tfield%cmnhname = hmnhname
tfield%clongname = hmnhname
tfield%ccomment = hcomment
tfield%cunits = hunits
-call Les_diachro( tpdiafile, tfield, ldoavg, ldonorm, pdata, hsuffixes )
+call Les_diachro( tpdiafile, tfield, ldoavg, ldonorm, pdata, hmasks = hmasks )
end subroutine Les_diachro_write_3D
!------------------------------------------------------------------------------
-subroutine Les_diachro_write_4D( tpdiafile, pdata, hmnhname, hcomment, hunits, hsuffixes )
+subroutine Les_diachro_write_4D( tpdiafile, pdata, hmnhname, hcomment, hunits, hmasks )
use modd_io, only: tfiledata
@@ -1240,14 +1226,14 @@ real, dimension(:,:,:,:), intent(in) :: pdata
character(len=*), intent(in) :: hmnhname
character(len=*), intent(in) :: hcomment
character(len=*), intent(in) :: hunits
-character(len=*), dimension(:), optional, intent(in) :: hsuffixes
+character(len=*), dimension(:), optional, intent(in) :: hmasks
tfield%cmnhname = hmnhname
tfield%clongname = hmnhname
tfield%ccomment = hcomment
tfield%cunits = hunits
-call Les_diachro( tpdiafile, tfield, ldoavg, ldonorm, pdata, hsuffixes )
+call Les_diachro( tpdiafile, tfield, ldoavg, ldonorm, pdata, hmasks = hmasks )
end subroutine Les_diachro_write_4D
diff --git a/src/MNH/write_lfifm1_for_diag.f90 b/src/MNH/write_lfifm1_for_diag.f90
index 50131fea21510726da1ce8d84a5489d6f0e5f07f..60240e9caf00f71d49bb49ef35d0410ceb14dfa1 100644
--- a/src/MNH/write_lfifm1_for_diag.f90
+++ b/src/MNH/write_lfifm1_for_diag.f90
@@ -145,6 +145,7 @@ 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
!-------------------------------------------------------------------------------
@@ -1171,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 03363082cf5405f48c941abbd35769fcc40d3ca7..ea08bd41d0a36e803f2afda33d7fa63f8d75a317 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.f90
@@ -173,12 +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
+! 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
+! J.L. Redelsperger 03/2021: add OCEAN and auto-coupled O-A LES cases
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -187,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, TYPELOG
+use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEINT, TYPELOG, TYPEREAL
USE MODD_GRID
USE MODD_GRID_n
USE MODD_TIME
@@ -288,8 +289,8 @@ 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
+USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_LS
+USE MODD_IBM_LSF, ONLY: LIBM_LSF
!
IMPLICIT NONE
!
@@ -448,7 +449,7 @@ TZFIELD%CMNHNAME = 'RECYCLING'
TZFIELD%CLONGNAME = 'RECYCLING'
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = ''
-TZFIELD%CDIR = ''
+TZFIELD%CDIR = '--'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPELOG
TZFIELD%NDIMS = 0
@@ -511,20 +512,20 @@ IF (LRECYCL) THEN
TZFIELD%CLONGNAME = 'RCOUNT'
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = ''
- TZFIELD%CDIR = 'XY'
+ 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,R_COUNT)
+ 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 = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 2
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -536,8 +537,8 @@ IF (LRECYCL) THEN
TZFIELD%CMNHNAME = 'VRECYCLW'
TZFIELD%CLONGNAME = 'VRECYCLW'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 3
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -549,8 +550,8 @@ IF (LRECYCL) THEN
TZFIELD%CMNHNAME = 'WRECYCLW'
TZFIELD%CLONGNAME = 'WRECYCLW'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 4
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -564,8 +565,8 @@ IF (LRECYCL) THEN
TZFIELD%CMNHNAME = 'URECYCLN'
TZFIELD%CLONGNAME = 'URECYCLN'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 2
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -577,8 +578,8 @@ IF (LRECYCL) THEN
TZFIELD%CMNHNAME = 'VRECYCLN'
TZFIELD%CLONGNAME = 'VRECYCLN'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 3
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -590,8 +591,8 @@ IF (LRECYCL) THEN
TZFIELD%CMNHNAME = 'WRECYCLN'
TZFIELD%CLONGNAME = 'WRECYCLN'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 4
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -605,8 +606,8 @@ IF (LRECYCL) THEN
TZFIELD%CMNHNAME = 'URECYCLE'
TZFIELD%CLONGNAME = 'URECYCLE'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 2
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -618,8 +619,8 @@ IF (LRECYCL) THEN
TZFIELD%CMNHNAME = 'VRECYCLE'
TZFIELD%CLONGNAME = 'VRECYCLE'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 3
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -631,8 +632,8 @@ IF (LRECYCL) THEN
TZFIELD%CMNHNAME = 'WRECYCLE'
TZFIELD%CLONGNAME = 'WRECYCLE'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'YY'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 4
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -646,8 +647,8 @@ IF (LRECYCL) THEN
TZFIELD%CMNHNAME = 'URECYCLS'
TZFIELD%CLONGNAME = 'URECYCLS'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 2
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -659,8 +660,8 @@ IF (LRECYCL) THEN
TZFIELD%CMNHNAME = 'VRECYCLS'
TZFIELD%CLONGNAME = 'VRECYCLS'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 3
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -672,8 +673,8 @@ IF (LRECYCL) THEN
TZFIELD%CMNHNAME = 'WRECYCLS'
TZFIELD%CLONGNAME = 'WRECYCLS'
TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'm.s-1'
- TZFIELD%CDIR = 'XX'
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 4
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
@@ -768,7 +769,7 @@ IF (MEAN_COUNT /= 0) THEN
!
TZFIELD%CMNHNAME = 'CMME'
TZFIELD%CLONGNAME = 'CMME'
- TZFIELD%CUNITS = 'Kg Kg-1'
+ TZFIELD%CUNITS = 'kg kg-1'
TZFIELD%CCOMMENT = 'mean Passive scalar'
ZWORK3D = XSVT_MEAN/MEAN_COUNT
CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
@@ -1007,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))
!
@@ -1955,80 +1961,58 @@ ENDIF
!
!* 1.11 Ocean LES variables
!
- IF ((.NOT.LCOUPLES).AND.LOCEAN) THEN
-WRITE (ILUOUT,*) 'LOCEAN NFRCLT', LOCEAN,NFRCLT,XSSUFL_T(1),XSSVFL_T(2),XSSTFL_T(1),XSSOLA_T(2)
-TZFIELD%CMNHNAME = 'NFRCLT'
-TZFIELD%CSTDNAME = ''
-TZFIELD%CLONGNAME = 'NFRCLT'
-TZFIELD%CUNITS = 'number of forc'
-TZFIELD%CDIR = '--'
-TZFIELD%CCOMMENT = 'nb de flux sfc forcant LES ocean'
-TZFIELD%NGRID = 0
-TZFIELD%NTYPE = TYPEINT
-TZFIELD%NDIMS = 0
-TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPFILE,TZFIELD,NFRCLT)
-!
-TZFIELD%CMNHNAME = 'NINFRT'
-TZFIELD%CSTDNAME = ''
-TZFIELD%CLONGNAME = 'NINFRT'
-TZFIELD%CUNITS = 'interv between forc'
-TZFIELD%CDIR = '--'
-TZFIELD%CCOMMENT = 'int between flux sfc forcant LES ocean'
-TZFIELD%NGRID = 0
-TZFIELD%NTYPE = TYPEINT
-TZFIELD%NDIMS = 0
-TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPFILE,TZFIELD,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(:))
-!
+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
@@ -2406,7 +2390,7 @@ IF (LMAIN_EOL .AND. IMI == NMODEL_EOL) THEN
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
- TZFIELD%CDIR = 'XYZ'
+ TZFIELD%CDIR = 'XY'
TZFIELD%CUNITS = 'N'
!
TZFIELD%CMNHNAME = 'FX_RG'
@@ -2449,17 +2433,17 @@ SELECT CASE(CMETH_EOL)
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 1
- TZFIELD%CDIR = ''
- TZFIELD%CUNITS = '-'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CUNITS = '1'
!
TZFIELD%CMNHNAME = 'A_INDU'
TZFIELD%CLONGNAME = 'INDUCTION_FACTOR'
- TZFIELD%CCOMMENT = '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 (-), &
+ TZFIELD%CCOMMENT = 'Thrust coefficient at disk (1), &
used with wind speed at disk'
CALL IO_Field_write(TPFILE,TZFIELD,XCT_D)
!
@@ -2484,7 +2468,7 @@ SELECT CASE(CMETH_EOL)
!
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
- TZFIELD%CDIR = ''
+ TZFIELD%CDIR = '--'
!
TZFIELD%NDIMS = 1
!
@@ -2550,7 +2534,7 @@ SELECT CASE(CMETH_EOL)
!
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
- TZFIELD%CDIR = ''
+ TZFIELD%CDIR = '--'
!
TZFIELD%NDIMS = 1
!
diff --git a/src/MNH/write_profilern.f90 b/src/MNH/write_profilern.f90
index e0ed5fcfd6b4bb0d8e4117996d9d8a85f67da5e1..1a0d6af59bef2dc344b131242e4cb13661f47c8b 100644
--- a/src/MNH/write_profilern.f90
+++ b/src/MNH/write_profilern.f90
@@ -64,6 +64,7 @@ END MODULE MODI_WRITE_PROFILER_n
! P. Wautelet 09/10/2020: Write_diachro: use new datatype tpfields
! P. Wautelet 03/03/2021: budgets: add tbudiachrometadata type (useful to pass more information to Write_diachro)
! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
+! M.Taufour 07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -127,7 +128,8 @@ CONTAINS
!----------------------------------------------------------------------------
SUBROUTINE PROFILER_DIACHRO_n(TPROFILER,II)
-use modd_budget, only: tbudiachrometadata
+use modd_budget, only: NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK, &
+ tbudiachrometadata
use modd_field, only: NMNHDIM_LEVEL, NMNHDIM_PROFILER_TIME, NMNHDIM_PROFILER_PROC, NMNHDIM_UNUSED, &
tfield_metadata_base, TYPEREAL
@@ -162,7 +164,7 @@ IF (TPROFILER%X(II)==XUNDEF) RETURN
IF (TPROFILER%Y(II)==XUNDEF) RETURN
IKU = SIZE(TPROFILER%W,2) !nbre de niveaux sur la verticale SIZE(TPROFILER%W,2)
!
-IPROC = 24 + SIZE(TPROFILER%R,4) + SIZE(TPROFILER%SV,4)
+IPROC = 25 + SIZE(TPROFILER%R,4) + SIZE(TPROFILER%SV,4)
IF (LDIAG_IN_RUN) IPROC = IPROC + 15
IF (LORILAM) IPROC = IPROC + JPMODE*3
IF (LDUST) IPROC = IPROC + NMODE_DST*3
@@ -211,7 +213,13 @@ JPROC = JPROC + 1
YTITLE (JPROC) = 'RARE'
YUNIT (JPROC) = 'dBZ'
YCOMMENT (JPROC) = 'Radar reflectivity'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%RARE(:,IK,II)
+ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%CRARE(:,IK,II)
+!
+JPROC = JPROC + 1
+YTITLE (JPROC) = 'RAREatt'
+YUNIT (JPROC) = 'dBZ'
+YCOMMENT (JPROC) = 'Radar attenuated reflectivity'
+ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%CRARE_ATT(:,IK,II)
!
JPROC = JPROC + 1
YTITLE (JPROC) = 'P'
@@ -391,6 +399,7 @@ DO JRR=1,SIZE(TPROFILER%R,4)
YCOMMENT (JPROC) = 'Hail mixing ratio'
END IF
END DO
+ !
JPROC = JPROC + 1
YTITLE (JPROC) = 'Rhod'
YUNIT (JPROC) = 'kg m-3'
@@ -405,6 +414,14 @@ IF (SIZE(TPROFILER%TKE,1)>0) THEN
ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%TKE(:,IK,II)
END IF
!
+IF (SIZE(TPROFILER%CIZ,1)>0) THEN
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'CIT'
+ YUNIT (JPROC) = 'kg-3'
+ YCOMMENT(JPROC) = 'Ice concentration'
+ ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%CIZ(:,IK,II)
+END IF
+!
JPROC = JPROC + 1
YTITLE (JPROC) = 'IWV'
YUNIT (JPROC) = 'kg m-2'
@@ -492,6 +509,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
@@ -650,20 +668,53 @@ tzfields(:)%ndimlist(4) = NMNHDIM_PROFILER_TIME
tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(6) = NMNHDIM_PROFILER_PROC
-tzbudiachro%cgroupname = ygroup
-tzbudiachro%cname = ygroup
-tzbudiachro%ccomment = 'Vertical profiles at position of profiler ' // Trim( ygroup )
-tzbudiachro%ctype = 'CART'
-tzbudiachro%ccategory = 'profiler'
-tzbudiachro%cshape = 'vertical profile'
+tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+tzbudiachro%clevels (NLVL_CATEGORY) = 'Profilers'
+tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different vertical profilers'
+
+tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .false.
+tzbudiachro%clevels (NLVL_SUBCATEGORY) = ''
+tzbudiachro%ccomments(NLVL_SUBCATEGORY) = ''
+
+tzbudiachro%lleveluse(NLVL_GROUP) = .true.
+tzbudiachro%clevels (NLVL_GROUP) = ygroup
+tzbudiachro%ccomments(NLVL_GROUP) = 'Vertical profiles at position of profiler ' // Trim( ygroup )
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .false.
+tzbudiachro%clevels (NLVL_SHAPE) = 'Vertical_profile'
+tzbudiachro%ccomments(NLVL_SHAPE) = ''
+
+tzbudiachro%lleveluse(NLVL_TIMEAVG) = .false.
+tzbudiachro%clevels (NLVL_TIMEAVG) = 'Not_time_averaged'
+tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are not time averaged'
+
+tzbudiachro%lleveluse(NLVL_NORM) = .false.
+tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+
+tzbudiachro%lleveluse(NLVL_MASK) = .false.
+tzbudiachro%clevels (NLVL_MASK) = ''
+tzbudiachro%ccomments(NLVL_MASK) = ''
+
tzbudiachro%lmobile = .false.
+!Compression does not make sense here
+!Keep these values for backward compatibility of LFI files
tzbudiachro%licompress = .true.
tzbudiachro%ljcompress = .true.
tzbudiachro%lkcompress = .false.
+tzbudiachro%ltcompress = .false.
+tzbudiachro%lnorm = .false.
+!Horizontal boundaries in physical domain does not make sense here (but flyer position does)
+!These values are not written in the netCDF files
+!These values are written in the LFI files. They are kept for backward compatibility (and not set to default values)
tzbudiachro%nil = 1
tzbudiachro%nih = 1
tzbudiachro%njl = 1
tzbudiachro%njh = 1
+!1->iku includes non-physical levels (IKU=NKMAX+2*JPVEXT)
+!This does not conform to documentation (limits are in the physical domain)
+!These values are not written in the netCDF files
+!These values are written in the LFI files. They are kept for backward compatibility (and not set to default values)
tzbudiachro%nkl = 1
tzbudiachro%nkh = iku
diff --git a/src/MNH/write_seriesn.f90 b/src/MNH/write_seriesn.f90
index e0aa67be2a6e3884202bd00288f5cbff50d3594c..a1e425f39842f5fb842e9b524db845929f6549e2 100644
--- a/src/MNH/write_seriesn.f90
+++ b/src/MNH/write_seriesn.f90
@@ -69,7 +69,8 @@ END MODULE MODI_WRITE_SERIES_n
!* 0. Declaration
! --------------
!
-use modd_budget, only: tbudiachrometadata
+use modd_budget, only: NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK, &
+ tbudiachrometadata
use modd_field, only: NMNHDIM_NI, NMNHDIM_NI_U, &
NMNHDIM_SERIES_LEVEL, NMNHDIM_SERIES_LEVEL_W, NMNHDIM_SERIES_TIME, NMNHDIM_SERIES_PROC, &
NMNHDIM_UNUSED, &
@@ -95,7 +96,7 @@ TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
!
INTEGER :: IIB,IJB,IKB ! Begin of physical dimensions
INTEGER :: IIE,IJE,IKE ! End of physical dimensions
-INTEGER :: JS,JT,JJ,JI ! Loop indices
+INTEGER :: JS, JT, JJ, JI, JP ! Loop indices
INTEGER :: ISB1,ISB2
CHARACTER (LEN=2) :: YS ! String for y-slice
CHARACTER (LEN=3) :: YSL,YSH ! Strings for y-slice
@@ -251,24 +252,50 @@ tzfields(:)%cunits = csunit1(:)
tzfields(:)%ccomment = cscomment1(:)
tzfields(:)%ngrid = nsgridd1(:)
tzfields(:)%ntype = TYPEREAL
-tzfields(:)%ndims = 2
+! tzfields(:)%ndims = 2
+tzfields(:)%ndims = 1 !Set to 1 because write are done in a loop (1 write per "process")
tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(3) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(4) = NMNHDIM_SERIES_TIME
tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
-tzfields(:)%ndimlist(6) = NMNHDIM_SERIES_PROC
-
-tzbudiachro%cgroupname = 'TSERIES'
-tzbudiachro%cname = 'TSERIES'
-tzbudiachro%ccomment = 'Time series of horizontally and vertically averaged fields'
-tzbudiachro%ctype = 'CART'
-tzbudiachro%ccategory = 'time series'
-tzbudiachro%cshape = 'cartesian' !It is based on a cartesian domain (with compression in all directions)
+! tzfields(:)%ndimlist(6) = NMNHDIM_SERIES_PROC
+tzfields(:)%ndimlist(6) = NMNHDIM_UNUSED !Set to unused because write are done in a loop (1 write per "process")
+
+tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+tzbudiachro%clevels (NLVL_CATEGORY) = 'Time_series'
+tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different time series'
+
+tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .false.
+tzbudiachro%clevels (NLVL_SUBCATEGORY) = ''
+tzbudiachro%ccomments(NLVL_SUBCATEGORY) = ''
+
+tzbudiachro%lleveluse(NLVL_GROUP) = .true.
+tzbudiachro%clevels (NLVL_GROUP) = 'TSERIES'
+tzbudiachro%ccomments(NLVL_GROUP) = 'Time series of horizontally and vertically averaged fields'
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .false.
+tzbudiachro%clevels (NLVL_SHAPE) = 'Cartesian' !It is based on a cartesian domain (with compression in all directions)
+tzbudiachro%ccomments(NLVL_SHAPE) = 'Cartesian domain'
+
+tzbudiachro%lleveluse(NLVL_TIMEAVG) = .false.
+tzbudiachro%clevels (NLVL_TIMEAVG) = 'Not_time_averaged'
+tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are not time averaged'
+
+tzbudiachro%lleveluse(NLVL_NORM) = .false.
+tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+
+tzbudiachro%lleveluse(NLVL_MASK) = .true.
+! tzbudiachro%clevels (NLVL_MASK) = DONE LATER
+! tzbudiachro%ccomments(NLVL_MASK) = DONE LATER
+
tzbudiachro%lmobile = .false.
tzbudiachro%licompress = .true.
tzbudiachro%ljcompress = .true.
tzbudiachro%lkcompress = .true.
+tzbudiachro%ltcompress = .false.
+tzbudiachro%lnorm = .false.
tzbudiachro%nil = niboxl
tzbudiachro%nih = niboxh
tzbudiachro%njl = njboxl
@@ -276,8 +303,15 @@ tzbudiachro%njh = njboxh
tzbudiachro%nkl = 1
tzbudiachro%nkh = ikmax
-call Write_diachro( tpdiafile, tzbudiachro, tzfields, tpsdates(1:nsnbstept), &
- xsseries1(1:1,1:1,1:1,1:nsnbstept,1:1,:) )
+! Loop on the different masks
+! Do not provide all tzfields once because they can be stored in different HDF groups (based on masks)
+do jp = 1 , nstemp_serie1
+ tzbudiachro%clevels(NLVL_MASK) = Trim( csmask1(jp) )
+ tzbudiachro%ccomments(NLVL_MASK) = ''
+
+ call Write_diachro( tpdiafile, tzbudiachro, [ tzfields(jp) ], tpsdates(1:nsnbstept), &
+ xsseries1(1:1,1:1,1:1,1:nsnbstept,1:1,jp:jp) )
+end do
deallocate( tzfields )
!
@@ -337,7 +371,8 @@ tzfields(:)%cunits = csunit2(:)
tzfields(:)%ccomment = cscomment2(:)
tzfields(:)%ngrid = nsgridd2(:)
tzfields(:)%ntype = TYPEREAL
-tzfields(:)%ndims = 3
+! tzfields(:)%ndims = 3
+tzfields(:)%ndims = 2 !Set to 2 because write are done in a loop (1 write per "process")
tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
do ji = 1, nstemp_serie2
@@ -352,18 +387,43 @@ do ji = 1, nstemp_serie2
end do
tzfields(:)%ndimlist(4) = NMNHDIM_SERIES_TIME
tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
-tzfields(:)%ndimlist(6) = NMNHDIM_SERIES_PROC
-
-tzbudiachro%cgroupname = 'ZTSERIES'
-tzbudiachro%cname = 'ZTSERIES'
-tzbudiachro%ccomment = 'Time series of horizontally averaged vertical profile'
-tzbudiachro%ctype = 'CART'
-tzbudiachro%ccategory = 'time series'
-tzbudiachro%cshape = 'cartesian' !It is based on a cartesian domain (with horizontal compression)
+! tzfields(:)%ndimlist(6) = NMNHDIM_SERIES_PROC
+tzfields(:)%ndimlist(6) = NMNHDIM_UNUSED !Set to unused because write are done in a loop (1 write per "process")
+
+tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+tzbudiachro%clevels (NLVL_CATEGORY) = 'Time_series'
+tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different time series'
+
+tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .false.
+tzbudiachro%clevels (NLVL_SUBCATEGORY) = ''
+tzbudiachro%ccomments(NLVL_SUBCATEGORY) = ''
+
+tzbudiachro%lleveluse(NLVL_GROUP) = .true.
+tzbudiachro%clevels (NLVL_GROUP) = 'ZTSERIES'
+tzbudiachro%ccomments(NLVL_GROUP) = 'Time series of horizontally averaged vertical profile'
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .false.
+tzbudiachro%clevels (NLVL_SHAPE) = 'Cartesian' !It is based on a cartesian domain (with horizontal compression)
+tzbudiachro%ccomments(NLVL_SHAPE) = 'Cartesian domain'
+
+tzbudiachro%lleveluse(NLVL_TIMEAVG) = .false.
+tzbudiachro%clevels (NLVL_TIMEAVG) = 'Not_time_averaged'
+tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are not time averaged'
+
+tzbudiachro%lleveluse(NLVL_NORM) = .false.
+tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+
+tzbudiachro%lleveluse(NLVL_MASK) = .true.
+! tzbudiachro%clevels (NLVL_MASK) = DONE LATER
+! tzbudiachro%ccomments(NLVL_MASK) = DONE LATER
+
tzbudiachro%lmobile = .false.
tzbudiachro%licompress = .true.
tzbudiachro%ljcompress = .true.
tzbudiachro%lkcompress = .false.
+tzbudiachro%ltcompress = .false.
+tzbudiachro%lnorm = .false.
tzbudiachro%nil = niboxl
tzbudiachro%nih = niboxh
tzbudiachro%njl = njboxl
@@ -371,8 +431,15 @@ tzbudiachro%njh = njboxh
tzbudiachro%nkl = 1
tzbudiachro%nkh = ikmax
-call Write_diachro( tpdiafile, tzbudiachro, tzfields, tpsdates(1:nsnbstept), &
- xsseries2(1:1,1:1,1:ikmax,1:nsnbstept,1:1,:) )
+! Loop on the different masks
+! Do not provide all tzfields once because they can be stored in different HDF groups (based on masks)
+do jp = 1 , nstemp_serie2
+ tzbudiachro%clevels(NLVL_MASK) = csmask2(jp)
+ tzbudiachro%ccomments(NLVL_MASK) = ''
+
+ call Write_diachro( tpdiafile, tzbudiachro, [ tzfields(jp) ], tpsdates(1:nsnbstept), &
+ xsseries2(1:1,1:1,1:ikmax,1:nsnbstept,1:1,jp:jp) )
+end do
deallocate( tzfields )
!
@@ -453,16 +520,41 @@ DO JS=1,NBJSLICE
tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(6) = NMNHDIM_SERIES_PROC
- tzbudiachro%cgroupname = ygroup
- tzbudiachro%cname = ygroup
- tzbudiachro%ccomment = 'Time series of y-horizontally averaged fields at one level or vertically averaged between 2 levels'
- tzbudiachro%ctype = 'SSOL'
- tzbudiachro%ccategory = 'time series'
- tzbudiachro%cshape = 'cartesian' !It is based on a cartesian domain (with compression in 1 direction)
+ tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+ tzbudiachro%clevels (NLVL_CATEGORY) = 'Time_series'
+ tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different time series'
+
+ tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .false.
+ tzbudiachro%clevels (NLVL_SUBCATEGORY) = ''
+ tzbudiachro%ccomments(NLVL_SUBCATEGORY) = ''
+
+ tzbudiachro%lleveluse(NLVL_GROUP) = .true.
+ tzbudiachro%clevels (NLVL_GROUP) = Trim( ygroup )
+ tzbudiachro%ccomments(NLVL_GROUP) = 'Time series of y-horizontally averaged fields at one level ' // &
+ 'or vertically averaged between 2 levels'
+
+ tzbudiachro%lleveluse(NLVL_SHAPE) = .false.
+ tzbudiachro%clevels (NLVL_SHAPE) = 'Cartesian' !It is based on a cartesian domain (with compression in 1 direction)
+ tzbudiachro%ccomments(NLVL_SHAPE) = 'Cartesian domain'
+
+ tzbudiachro%lleveluse(NLVL_TIMEAVG) = .false.
+ tzbudiachro%clevels (NLVL_TIMEAVG) = 'Not_time_averaged'
+ tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are not time averaged'
+
+ tzbudiachro%lleveluse(NLVL_NORM) = .false.
+ tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+ tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+
+ tzbudiachro%lleveluse(NLVL_MASK) = .false.
+ tzbudiachro%clevels (NLVL_MASK) = ''
+ tzbudiachro%ccomments(NLVL_MASK) = ''
+
tzbudiachro%lmobile = .false.
tzbudiachro%licompress = .false.
tzbudiachro%ljcompress = .true.
tzbudiachro%lkcompress = .true.
+ tzbudiachro%ltcompress = .false.
+ tzbudiachro%lnorm = .false.
tzbudiachro%nil = 1
tzbudiachro%nih = iiu_ll
tzbudiachro%njl = 1
diff --git a/src/MNH/write_stationn.f90 b/src/MNH/write_stationn.f90
index 441ba8068ff37f15ca8521475b52466a7c35c84f..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,CSURF
+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
@@ -123,7 +123,8 @@ CONTAINS
!----------------------------------------------------------------------------
SUBROUTINE STATION_DIACHRO_n(TSTATION,II)
-use modd_field, only: NMNHDIM_STATION_TIME, NMNHDIM_STATION_PROC, NMNHDIM_UNUSED, &
+use modd_budget, only: NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK
+use modd_field, only: NMNHDIM_STATION_TIME, NMNHDIM_STATION_PROC, NMNHDIM_UNUSED, &
tfield_metadata_base, TYPEREAL
TYPE(STATION), INTENT(IN) :: TSTATION
@@ -136,7 +137,6 @@ REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZW6 ! contains temporal series t
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV, ZN0, ZSIG, ZRG
REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZPTOTA
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJX, ZTRAJY, ZTRAJZ
!
INTEGER, DIMENSION(:), ALLOCATABLE :: IGRID ! grid indicator
CHARACTER(LEN= 8) :: YGROUP ! group title
@@ -181,13 +181,6 @@ IGRID = 1
YGROUP = TSTATION%NAME(II)
JPROC = 0
!
-ALLOCATE (ZTRAJX(1,1,1))
-ALLOCATE (ZTRAJY(1,1,1))
-ALLOCATE (ZTRAJZ(1,1,1))
-!
-ZTRAJX(:,:,:)=TSTATION%X(II)
-ZTRAJY(:,:,:)=TSTATION%Y(II)
-ZTRAJZ(:,:,:)=TSTATION%Z(II)
!----------------------------------------------------------------------------
!
JPROC = JPROC + 1
@@ -198,7 +191,7 @@ 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)
!
@@ -767,16 +760,45 @@ tzfields(:)%ndimlist(4) = NMNHDIM_STATION_TIME
tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
tzfields(:)%ndimlist(6) = NMNHDIM_STATION_PROC
-tzbudiachro%cgroupname = ygroup
-tzbudiachro%cname = ygroup
-tzbudiachro%ccomment = 'Values at position of station ' // Trim( ygroup )
-tzbudiachro%ctype = 'CART'
-tzbudiachro%ccategory = 'station'
-tzbudiachro%cshape = 'point'
+tzbudiachro%lleveluse(NLVL_CATEGORY) = .true.
+tzbudiachro%clevels (NLVL_CATEGORY) = 'Stations'
+tzbudiachro%ccomments(NLVL_CATEGORY) = 'Level for the different stations'
+
+tzbudiachro%lleveluse(NLVL_SUBCATEGORY) = .false.
+tzbudiachro%clevels (NLVL_SUBCATEGORY) = ''
+tzbudiachro%ccomments(NLVL_SUBCATEGORY) = ''
+
+tzbudiachro%lleveluse(NLVL_GROUP) = .true.
+tzbudiachro%clevels (NLVL_GROUP) = ygroup
+tzbudiachro%ccomments(NLVL_GROUP) = 'Values at position of station ' // Trim( ygroup )
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .false.
+tzbudiachro%clevels (NLVL_SHAPE) = 'Point'
+tzbudiachro%ccomments(NLVL_SHAPE) = 'Values at position of station ' // Trim( ygroup )
+
+tzbudiachro%lleveluse(NLVL_TIMEAVG) = .false.
+tzbudiachro%clevels (NLVL_TIMEAVG) = 'Not_time_averaged'
+tzbudiachro%ccomments(NLVL_TIMEAVG) = 'Values are not time averaged'
+
+tzbudiachro%lleveluse(NLVL_NORM) = .false.
+tzbudiachro%clevels (NLVL_NORM) = 'Not_normalized'
+tzbudiachro%ccomments(NLVL_NORM) = 'Values are not normalized'
+
+tzbudiachro%lleveluse(NLVL_MASK) = .false.
+tzbudiachro%clevels (NLVL_MASK) = ''
+tzbudiachro%ccomments(NLVL_MASK) = ''
+
tzbudiachro%lmobile = .false.
+!Compression does not make sense here
+!Keep these values for backward compatibility of LFI files
tzbudiachro%licompress = .true.
tzbudiachro%ljcompress = .true.
tzbudiachro%lkcompress = .false.
+tzbudiachro%ltcompress = .false.
+tzbudiachro%lnorm = .false.
+!Boundaries in physical domain does not make sense here
+!These values are not written in the netCDF files
+!These values are written in the LFI files. Kept for backward compatibility of LFI files
tzbudiachro%nil = 1
tzbudiachro%nih = 1
tzbudiachro%njl = 1
@@ -785,7 +807,6 @@ tzbudiachro%nkl = 1
tzbudiachro%nkh = 1
call Write_diachro( tpdiafile, tzbudiachro, tzfields, tstation%tpdates, zw6 )
-! TODO: ajout de PTRAJX=ZTRAJX, PTRAJY=ZTRAJY, PTRAJZ=ZTRAJZ en argument en entrée de Write_diachro
deallocate( tzfields )
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index 1519c2b0854189dfe2fbce5ac1fd065d08cb92b2..753951e3c73b87a1a81c036442456d27ef400376 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 !!!
@@ -210,6 +218,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 #
@@ -513,7 +533,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.LXifort.mk b/src/Rules.LXifort.mk
index 7538eee8f843b9046e1b906aaf5bac43c61b6ac7..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
#
diff --git a/src/SURFEX/av_pgd_param.F90 b/src/SURFEX/av_pgd_param.F90
index 6e7e253844610c73d9da3a439fadcd7511c7de4e..462ee4c915bd3cd265e044dd947fb6317f573945 100644
--- a/src/SURFEX/av_pgd_param.F90
+++ b/src/SURFEX/av_pgd_param.F90
@@ -108,7 +108,7 @@ REAL, DIMENSION(SIZE(PFIELD,1)) :: ZSUM_WEIGHT_PATCH
REAL, DIMENSION(SIZE(PFIELD,1)) :: ZWORK
REAL, DIMENSION(SIZE(PFIELD,1)) :: ZDZ
!
-REAL, DIMENSION(31) :: ZCOUNT
+REAL, DIMENSION(0:31) :: ZCOUNT
INTEGER, DIMENSION(SIZE(PFIELD,1)) :: NMASK
INTEGER :: PATCH_LIST(NVEGTYPE)
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -169,7 +169,7 @@ DO JV=1,NVEGTYPE
ELSEIF (HSFTYPE=='TRE'.OR.HSFTYPE=='GRT') THEN
IF (JV==NVT_TEBD.OR.JV==NVT_BONE.OR.JV==NVT_TRBE.OR.JV==NVT_TRBD.OR.&
JV==NVT_TEBE.OR.JV==NVT_TENE.OR.JV==NVT_BOBD.OR.JV==NVT_BOND.OR.&
- JV==NVT_SHRB) ZWEIGHT(JI,JV) = PVEGTYPE(JI,JV)
+ JV==NVT_SHRB) ZWEIGHT(JI,JV) = PVEGTYPE(IMASK,JV)
ELSE
CALL ABOR1_SFX('AV_PGD_PARAM_1D: WEIGHTING FUNCTION FOR VEGTYPE NOT ALLOWED')
ENDIF
@@ -262,7 +262,7 @@ SELECT CASE (HATYPE)
IF (ALL(ZCOUNT(:)==0.)) THEN
ZWORK(JJ) = NUNDEF
ELSE
- ZWORK(JJ) = FLOAT(MAXLOC(ZCOUNT,1))
+ ZWORK(JJ) = FLOAT(MAXLOC(ZCOUNT,1)-1)
ENDIF
END DO
!
diff --git a/src/SURFEX/compute_isba_parameters.F90 b/src/SURFEX/compute_isba_parameters.F90
index 39fb20dde297f6ffc735b50a5894f885569745ea..9effc18ada86240195c54d3c1ae072ade4a17b32 100644
--- a/src/SURFEX/compute_isba_parameters.F90
+++ b/src/SURFEX/compute_isba_parameters.F90
@@ -521,8 +521,8 @@ IF (KSV /= 0) THEN
!
IF (CHI%SVI%NDSTEQ >=1) THEN
!
- ALLOCATE (DSTK%XSFDST (PK%NSIZE_P, CHI%SVI%NDSTEQ)) !Output array
- ALLOCATE (DSTK%XSFDSTM(PK%NSIZE_P, CHI%SVI%NDSTEQ)) !Output array
+ ALLOCATE (DSTK%XSFDST (KI, CHI%SVI%NDSTEQ)) !Output array
+ ALLOCATE (DSTK%XSFDSTM(KI, CHI%SVI%NDSTEQ)) !Output array
DSTK%XSFDST (:,:) = 0.
DSTK%XSFDSTM(:,:) = 0.
CALL INIT_DST(DSTK, U, HPROGRAM, PK%NSIZE_P, PK%NR_P, PK%XVEGTYPE_PATCH)
diff --git a/src/SURFEX/diag_isba_initn.F90 b/src/SURFEX/diag_isba_initn.F90
index c4716f23d7738a8f7d8adeaf35c8010f24e2e0a9..50404eda5bc44c819ef61a126b87400167352a4c 100644
--- a/src/SURFEX/diag_isba_initn.F90
+++ b/src/SURFEX/diag_isba_initn.F90
@@ -124,7 +124,7 @@ TYPE(DIAG_EVAP_ISBA_t) :: YDE
TYPE(DIAG_MISC_ISBA_t) :: YDM
TYPE(ISBA_P_t), POINTER :: PK
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
-LOGICAL :: GCUMUL, GDIM
+LOGICAL :: GCUMUL, GDIM, GDIM2
INTEGER :: JP
INTEGER :: IVERSION, IBUG
INTEGER :: IRESP ! IRESP : return-code if a problem appears
@@ -448,7 +448,9 @@ IF ( GCUMUL ) THEN
CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
CALL READ_SURF(HPROGRAM,'BUG ',IBUG,IRESP)
!
- GDIM = (IVERSION>8 .OR. IVERSION==8 .AND. IBUG>0)
+ GDIM2 = (IVERSION>8 .OR. IVERSION==8 .AND. IBUG>0)
+ GDIM = GDIM2
+ IF (GDIM2) CALL READ_SURF(HPROGRAM,'SPLIT_PATCH',GDIM,IRESP)
!
#ifdef SFX_OL
IF(DE%LWATER_BUDGET .OR. (LRESTART .AND. .NOT.DGO%LRESET_BUDGETC))THEN
diff --git a/src/SURFEX/e_budget_meb.F90 b/src/SURFEX/e_budget_meb.F90
index ffb942c2a7a178f6239b1652a877e589d94ac0c4..092705bc67ff92e59b850704b546e11aebd4d4e3 100644
--- a/src/SURFEX/e_budget_meb.F90
+++ b/src/SURFEX/e_budget_meb.F90
@@ -80,7 +80,7 @@
!! -------------
!! Original 22/01/11
!! 10/10/14 (A. Boone) Removed understory vegetation
-!!
+!! 13/09/18 (A. Boone) Add litter layer option to test-Tg computation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -92,14 +92,14 @@ USE MODD_DIAG_n, ONLY : DIAG_t
USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
!
-USE MODD_CSTS, ONLY : XLVTT, XLSTT, XTT, XCPD, XCPV, XCL, &
+USE MODD_CSTS, ONLY : XLVTT, XLSTT, XTT, XCPD, XCPV, XCL, &
XDAY, XPI, XLMTT, XRHOLW
USE MODD_SURF_ATM, ONLY : LCPL_ARP
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_SNOW_METAMO, ONLY : XSNOWDZMIN
-!
+
USE MODE_THERMOS
-USE MODE_MEB, ONLY : SFC_HEATCAP_VEG
+USE MODE_MEB, ONLY : SFC_HEATCAP_VEG, MEBLITTER_THRM
USE MODE_SNOW3L, ONLY : SNOW3LHOLD
!
USE MODI_TRIDIAG_GROUND_RM_COEFS
@@ -308,7 +308,7 @@ REAL, DIMENSION(SIZE(DMK%XSNOWDZ,1),SIZE(DMK%XSNOWDZ,2)):: ZSNOW_COEF_A, ZSNOW_C
!
REAL, DIMENSION(SIZE(DMK%XSNOWDZ,1),SIZE(DMK%XSNOWDZ,2)):: ZWHOLDMAX
!
-REAL, DIMENSION(SIZE(PD_G,1),SIZE(PD_G,2)+SIZE(DMK%XSNOWDZ,2)) :: ZD, ZT, ZHCAPZ, ZCONDZ, &
+REAL, DIMENSION(SIZE(PD_G,1),SIZE(PD_G,2)+SIZE(DMK%XSNOWDZ,2)+1) :: ZD, ZT, ZHCAPZ, ZCONDZ, &
ZCOEF_A, ZCOEF_B, ZSOURCE
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -343,8 +343,15 @@ ZSOIL_COEF_A(:,:) = 0.0
ZSOIL_COEF_B(:,:) = 0.0
ZSNOW_COEF_A(:,:) = 0.0
ZSNOW_COEF_B(:,:) = 0.0
-
-!-------------------------------------------------------------------------------
+!
+ZD(:,:) = 0.0
+ZT(:,:) = 0.0
+ZHCAPZ(:,:) = 0.0
+ZCONDZ(:,:) = 0.0
+ZSOURCE(:,:) = 0.0
+ZCOEF_A(:,:) = 0.0
+ZCOEF_B(:,:) = 0.0
+!
!
!* 1. Some variables/coefficients needed for coupling or solution
! -----------------------------------------------------------
@@ -429,7 +436,7 @@ IF(IO%CISBA == 'DIF')THEN
! quite robust. Note, this only corresponds to the snow-covered part of grid box,
! so it is more accurate as the snow fraction approaches unity.
! Starting from snowpack surface downward to base of ground:
-!
+!
JL = 1
ZD(:,JL) = DMK%XSNOWDZ(:,1)
ZT(:,JL) = ZTNO(:,1)
@@ -446,6 +453,13 @@ IF(IO%CISBA == 'DIF')THEN
ZSOURCE(JJ,JL) = DEK%XSWNET_NS(JJ)*(PTAU_N(JJ,JK-1)-PTAU_N(JJ,JK))
ENDDO
ENDDO
+ IF(IO%LMEB_LITTER)THEN
+ JL = JL + 1
+ ZD(:,JL) = PEK%XGNDLITTER(:)
+ ZT(:,JL) = PEK%XTL(:)
+ CALL MEBLITTER_THRM(PEK%XWRL,PEK%XWRLI,PEK%XGNDLITTER,ZHCAPZ(:,JL),ZCONDZ(:,JL))
+ ZSOURCE(:,JL) = 0.
+ ENDIF
JL = JL + 1
ZD(:,JL) = PD_G(:,1)
ZT(:,JL) = ZTGO(:,1)
@@ -465,8 +479,9 @@ IF(IO%CISBA == 'DIF')THEN
!
! Get coefficients from upward sweep (starting from soil base to snow surface):
!
- CALL TRIDIAG_GROUND_RM_COEFS(PTSTEP, ZD, ZT, ZHCAPZ, ZCONDZ, ZSOURCE, &
- PTDEEP_A, KK%XTDEEP, ZTCONDA_DELZ_N, ZCOEF_A, ZCOEF_B)
+ CALL TRIDIAG_GROUND_RM_COEFS(PTSTEP, ZD(:,1:JL), ZT(:,1:JL), ZHCAPZ(:,1:JL), ZCONDZ(:,1:JL), &
+ ZSOURCE(:,1:JL),PTDEEP_A, KK%XTDEEP, ZTCONDA_DELZ_N, &
+ ZCOEF_A(:,1:JL), ZCOEF_B(:,1:JL))
!
ZSNOW_COEF_A(:,2) = ZCOEF_A(:,2)
ZSNOW_COEF_B(:,2) = ZCOEF_B(:,2)
diff --git a/src/SURFEX/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/ini_var_from_data.F90 b/src/SURFEX/ini_var_from_data.F90
index 755b57888ba78c96d104fa660cd1b0c80967befa..c57f2c1a8c7f641d817d671137831236a1761aba 100644
--- a/src/SURFEX/ini_var_from_data.F90
+++ b/src/SURFEX/ini_var_from_data.F90
@@ -195,7 +195,8 @@ IF (HFTYP(1)=='DIRTYP') THEN
ELSE
- IF (.NOT.ALL(LEN_TRIM(HFNAM(:))/=0) .AND. .NOT.ALL(LEN_TRIM(HFNAM(2:))==0)) THEN
+
+ IF (.NOT.ALL(LEN_TRIM(HFNAM(:))/=0) .AND. COUNT(LEN_TRIM(HFNAM(:))/=0)>1) THEN
DO JV=1,SIZE(PFIELD,2)
IF (LEN_TRIM(HFNAM(JV))==0) THEN
DO JV2=JV-1,1,-1
diff --git a/src/SURFEX/init_surf_atmn.F90 b/src/SURFEX/init_surf_atmn.F90
index 2c6c776dc8c4efdcea39793fc739980dada1926e..3c4f61cce0138dff4b89687a262ef5e3d43826c7 100644
--- a/src/SURFEX/init_surf_atmn.F90
+++ b/src/SURFEX/init_surf_atmn.F90
@@ -404,7 +404,7 @@ ENDIF
!
CALL READ_SURF(HPROGRAM,'CH_EMIS',YSC%CHU%LCH_EMIS,IRESP)
!
-IF (YSC%CHU%LCH_EMIS) THEN
+IF ((YSC%CHU%LCH_EMIS) .AND. (YSC%CHU%LCH_SURF_EMIS)) THEN
!
IF ( IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3 ) THEN
YSC%CHU%CCH_EMIS='AGGR'
diff --git a/src/SURFEX/isba_meb.F90 b/src/SURFEX/isba_meb.F90
index 40b95a3cae7d8f72d21f3bfa0447227573e318e2..eaf29e0ff3c40ac0fc94f348fb69bbcc1a89e6b4 100644
--- a/src/SURFEX/isba_meb.F90
+++ b/src/SURFEX/isba_meb.F90
@@ -627,13 +627,15 @@ WHERE(PSW_RAD(:) > ZSWRAD_MIN) ! Sun is up...approx
!
ELSEWHERE
-! Sun is down:
-
- DK%XALBT(:) = 1.0
- ZSWUP(:) = PSW_RAD(:)
+! Sun is down: (below threshold)
+! radiation amounts quite small, so make a simple approximation here:
+
+ DK%XALBT(:) = ZALBV(:)
+ ZSWUP(:) = DK%XALBT(:)*PSW_RAD(:)
+
DEK%XSWDOWN_GN(:) = 0.
DEK%XSWNET_G(:) = 0.
- DEK%XSWNET_V(:) = 0.
+ DEK%XSWNET_V(:) = (1.-DK%XALBT(:))*PSW_RAD(:)
DEK%XSWNET_N(:) = 0.
DEK%XSWNET_NS(:) = 0.
ZTAU_N(:,SIZE(PEK%TSNOW%WSNOW,2)) = 0.
@@ -918,7 +920,7 @@ ZVEGFACT(:) = ZSIGMA_F(:)*(1.0-PPALPHAN(:)*PEK%XPSN(:))
! snowpack and part falling onto snow-free understory.
!
!
- CALL HYDRO_VEG(IO%CRAIN, PTSTEP, KK%XMUF, ZRR, DEK%XLEV_CV, DEK%XLETR_CV, &
+ CALL HYDRO_VEG(IO%CRAIN, PTSTEP, KK%XMUF, ZRR, DEK%XLEV_CV, DEK%XLETR_CV, &
ZVEGFACT, ZPSNCV, PEK%XWR, ZWRMAX, ZRRSFC, DEK%XDRIP, DEK%XRRVEG, &
PK%XLVTT )
!
@@ -930,7 +932,7 @@ ZVEGFACT(:) = ZSIGMA_F(:)*(1.0-PPALPHAN(:)*PEK%XPSN(:))
IF (PRESENT(PBLOWSNW_FLUX)) THEN
CALL SNOW3L_ISBA(IO, G, PK, PEK, DK, DEK, DMK, OMEB, HIMPLICIT_WIND, &
TPTIME, PTSTEP, PK%XVEGTYPE_PATCH, ZTGL, ZCTSFC, &
- ZSOILHCAPZ, ZSOILCONDZ(:,1), PPS, PTA, PSW_RAD, PQA, &
+ ZSOILHCAPZ, ZSOILCONDZ(:,1), PPS, PEK%XTC, DEK%XSWDOWN_GN, PEK%XQC,&
PVMOD, PLW_RAD, ZRRSFC, DEK%XSR_GN, PRHOA, ZUREF, PEXNS, &
PEXNA, PDIRCOSZW, ZZREF, ZALBG, ZD_G, ZDZG, PPEW_A_COEF, &
PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
@@ -941,7 +943,7 @@ ZVEGFACT(:) = ZSIGMA_F(:)*(1.0-PPALPHAN(:)*PEK%XPSN(:))
ELSE
CALL SNOW3L_ISBA(IO, G, PK, PEK, DK, DEK, DMK, OMEB, HIMPLICIT_WIND, &
TPTIME, PTSTEP, PK%XVEGTYPE_PATCH, ZTGL, ZCTSFC, &
- ZSOILHCAPZ, ZSOILCONDZ(:,1), PPS, PTA, PSW_RAD, PQA, &
+ ZSOILHCAPZ, ZSOILCONDZ(:,1), PPS, PEK%XTC, DEK%XSWDOWN_GN, PEK%XQC, &
PVMOD, PLW_RAD, ZRRSFC, DEK%XSR_GN, PRHOA, ZUREF, PEXNS, &
PEXNA, PDIRCOSZW, ZZREF, ZALBG, ZD_G, ZDZG, PPEW_A_COEF, &
PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, &
@@ -1641,8 +1643,11 @@ SUBROUTINE PREP_MEB_SOIL(OMEB_LITTER,PSOILHCAPZ,PSOILCONDZ,KK,PK,PEK,PD_GL,&
PDZGL,PTGL,PSOILHCAPL,PSOILCONDL,PWSATL,PWFCL,PWSFC,&
PWISFC,PCTSFC,PCT,PFROZEN1,PFROZEN1SFC)
!
-USE MODD_CSTS, ONLY : XRHOLW,XRHOLI, XCL, XCI
-USE MODD_ISBA_PAR, ONLY : XWGMIN, XOMSPH
+USE MODD_CSTS, ONLY : XRHOLW, XCL
+USE MODD_ISBA_PAR, ONLY : XWGMIN
+USE MODD_MEB_PAR, ONLY : XLITTER_HYD_Z4, XLITTER_HYD_Z5
+!
+USE MODE_MEB, ONLY : MEBLITTER_THRM
!
IMPLICIT NONE
!
@@ -1675,16 +1680,6 @@ INTEGER :: INJ, INL, JJ, JL
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
-!* 0.3 declarations of local parameters
-!
-REAL, PARAMETER :: Z1 = 45.0 !litter bulk density (kg/m3)
-REAL, PARAMETER :: Z2 = 0.1 !coeff for litter conductivity (W/(mK))
-REAL, PARAMETER :: Z3 = 0.03 !coeff for litter conductivity
-REAL, PARAMETER :: Z4 = 0.95 !litter porosity (m3/m3)
-REAL, PARAMETER :: Z5 = 0.12 !litter field capacity (m3/m3)
-!
-REAL, DIMENSION(SIZE(PEK%XWG,1)) :: ZWORK
-!
!-------------------------------------------------------------------------------
!
IF (LHOOK) CALL DR_HOOK('ISBA_MEB:PREP_MEB_SOIL',0,ZHOOK_HANDLE)
@@ -1692,14 +1687,11 @@ IF (LHOOK) CALL DR_HOOK('ISBA_MEB:PREP_MEB_SOIL',0,ZHOOK_HANDLE)
INJ = SIZE(PK%XDG,1)
INL = SIZE(PK%XDG,2)
!
-ZWORK(:) = 0.0
IF(OMEB_LITTER)THEN
PTGL(:,1) = PEK%XTL(:)
- ZWORK(:) = PEK%XWRL(:)/(XRHOLW*PEK%XGNDLITTER(:))
- PSOILHCAPL(:,1) = XOMSPH*Z1 + (XCL*XRHOLW)*ZWORK(:) + (XCI*XRHOLI/XRHOLW)*PEK%XWRLI(:)/PEK%XGNDLITTER(:)
- PSOILCONDL(:,1) = Z2 + Z3 * ZWORK(:)
- PWSATL(:,1) = Z4
- PWFCL(:,1) = Z5
+ CALL MEBLITTER_THRM(PEK%XWRL,PEK%XWRLI,PEK%XGNDLITTER,PSOILHCAPL(:,1),PSOILCONDL(:,1))
+ PWSATL(:,1) = XLITTER_HYD_Z4
+ PWFCL(:,1) = XLITTER_HYD_Z5
PD_GL(:,1) = PEK%XGNDLITTER(:)
PDZGL(:,1) = PEK%XGNDLITTER(:)
PCTSFC(:) = 1. / (PSOILHCAPL(:,1) * PEK%XGNDLITTER(:))
diff --git a/src/SURFEX/modd_meb_par.F90 b/src/SURFEX/modd_meb_par.F90
index 3a0909f7152da8b903b7a8202302002490bdd70d..17169f4c2afc11c73abb94da48ae185a344b3ac3 100644
--- a/src/SURFEX/modd_meb_par.F90
+++ b/src/SURFEX/modd_meb_par.F90
@@ -24,6 +24,8 @@
!! MODIFICATIONS
!! -------------
!! Original 09/2013
+!! 13/09/18 (A. Boone) Added Litter thermal and hydrological parameters
+!! herein
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -56,6 +58,15 @@ REAL, PARAMETER :: XSW_WGHT_VIS = 0.48
!
REAL, PARAMETER :: XSW_WGHT_NIR = 0.52
!
+! Litter thermal (THRM) and hydrological (HYD) properties
+! -------------------------------------------------------
+!
+REAL, PARAMETER :: XLITTER_THRM_Z1 = 45.00 !litter bulk density (kg/m3)
+REAL, PARAMETER :: XLITTER_THRM_Z2 = 0.10 !coeff for litter conductivity (W/(mK))
+REAL, PARAMETER :: XLITTER_THRM_Z3 = 0.03 !coeff for litter conductivity
+REAL, PARAMETER :: XLITTER_HYD_Z4 = 0.95 !litter porosity (m3/m3)
+REAL, PARAMETER :: XLITTER_HYD_Z5 = 0.12 !litter field capacity (m3/m3)
+!
!-------------------------------------------------------------------------------
!
END MODULE MODD_MEB_PAR
diff --git a/src/SURFEX/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/mode_meb.F90 b/src/SURFEX/mode_meb.F90
index 8665dd58adc64845058437da69ace5fc47b5db6f..68bb4fa2f29a69118ba992ad2c369f96e8ebba9e 100644
--- a/src/SURFEX/mode_meb.F90
+++ b/src/SURFEX/mode_meb.F90
@@ -32,6 +32,7 @@
!! MODIFICATIONS
!! -------------
!! Original 18/01/11
+!! 13/09/18 Added litter thermal computations here
!-----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -68,11 +69,224 @@ INTERFACE MEB_SHIELD_FACTOR
MODULE PROCEDURE MEB_SHIELD_FACTOR_0D
END INTERFACE
!
+INTERFACE MEBLITTER_THRM
+ MODULE PROCEDURE MEBLITTER_THRM_2D
+ MODULE PROCEDURE MEBLITTER_THRM_1D
+ MODULE PROCEDURE MEBLITTER_THRM_0D
+END INTERFACE
+!
!-------------------------------------------------------------------------------
CONTAINS
!
!####################################################################
!####################################################################
+!####################################################################
+ SUBROUTINE MEBLITTER_THRM_2D(PWRL,PWRLI,PGNDLITTER,PHCAP,PCOND)
+!
+!! PURPOSE
+!! -------
+! Calculation of litter thermal properties (based on Napoly et al., 2017)
+!
+!! REFERENCE
+!! ---------
+!! Napoly et al., 2017: GMD
+!!
+!! AUTHOR
+!! ------
+!!! A. Boone * Meteo-France/CNRS *
+!!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/09/18
+!
+!-----------------------------------------------------------------------------
+!
+USE MODD_MEB_PAR, ONLY : XLITTER_THRM_Z1, XLITTER_THRM_Z2, &
+ XLITTER_THRM_Z3
+USE MODD_ISBA_PAR, ONLY : XOMSPH
+USE MODD_CSTS, ONLY : XRHOLW, XRHOLI, XCI, XCL
+
+
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PWRL, PWRLI, PGNDLITTER
+! PWRL = litter liquid water content (kg/m2)
+! PWRLI = litter liquid water equivalent ice content (kg/m2)
+! PGNDLITTER = litter layer thickness (m)
+!
+REAL, DIMENSION(:,:), INTENT(OUT) :: PHCAP, PCOND
+! PHCAP = litter heat capacity [J/(m3 K)]
+! PCOND = litter thermal conductivity [W/(m K)]
+!
+!* 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+REAL, DIMENSION(SIZE(PGNDLITTER,1),SIZE(PGNDLITTER,2)) :: ZWORK
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_2D',0,ZHOOK_HANDLE)
+!
+ZWORK(:,:) = PWRL(:,:)/(XRHOLW*PGNDLITTER(:,:))
+!
+! Litter heat capacity:
+!
+PHCAP(:,:) = XOMSPH*XLITTER_THRM_Z1 + ( (XCL*XRHOLW)*ZWORK(:,:) + &
+ (XCI*XRHOLI/XRHOLW)*PWRLI(:,:)/PGNDLITTER(:,:) )
+!
+! Litter thermal conductivity:
+!
+PCOND(:,:) = XLITTER_THRM_Z2 + ( XLITTER_THRM_Z3 * ZWORK(:,:) )
+!
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_2D',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MEBLITTER_THRM_2D
+!####################################################################
+!####################################################################
+!####################################################################
+ SUBROUTINE MEBLITTER_THRM_1D(PWRL,PWRLI,PGNDLITTER,PHCAP,PCOND)
+!
+!! PURPOSE
+!! -------
+! Calculation of litter thermal properties (based on Napoly et al., 2017)
+!
+!! REFERENCE
+!! ---------
+!! Napoly et al., 2017: GMD
+!!
+!! AUTHOR
+!! ------
+!!! A. Boone * Meteo-France/CNRS *
+!!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/09/18
+!
+!-----------------------------------------------------------------------------
+!
+USE MODD_MEB_PAR, ONLY : XLITTER_THRM_Z1, XLITTER_THRM_Z2, &
+ XLITTER_THRM_Z3
+USE MODD_ISBA_PAR, ONLY : XOMSPH
+USE MODD_CSTS, ONLY : XRHOLW, XRHOLI, XCI, XCL
+
+
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:), INTENT(IN) :: PWRL, PWRLI, PGNDLITTER
+! PWRL = litter liquid water content (kg/m2)
+! PWRLI = litter liquid water equivalent ice content (kg/m2)
+! PGNDLITTER = litter layer thickness (m)
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PHCAP, PCOND
+! PHCAP = litter heat capacity [J/(m3 K)]
+! PCOND = litter thermal conductivity [W/(m K)]
+!
+!* 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+REAL, DIMENSION(SIZE(PGNDLITTER)) :: ZWORK
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_1D',0,ZHOOK_HANDLE)
+!
+ZWORK(:) = PWRL(:)/(XRHOLW*PGNDLITTER(:))
+!
+! Litter heat capacity:
+!
+PHCAP(:) = XOMSPH*XLITTER_THRM_Z1 + ( (XCL*XRHOLW)*ZWORK(:) + &
+ (XCI*XRHOLI/XRHOLW)*PWRLI(:)/PGNDLITTER(:) )
+!
+! Litter thermal conductivity:
+!
+PCOND(:) = XLITTER_THRM_Z2 + ( XLITTER_THRM_Z3 * ZWORK(:) )
+!
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_1D',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MEBLITTER_THRM_1D
+!####################################################################
+!####################################################################
+!####################################################################
+ SUBROUTINE MEBLITTER_THRM_0D(PWRL,PWRLI,PGNDLITTER,PHCAP,PCOND)
+!
+!! PURPOSE
+!! -------
+! Calculation of litter thermal properties (based on Napoly et al., 2017)
+!
+!! REFERENCE
+!! ---------
+!! Napoly et al., 2017: GMD
+!!
+!! AUTHOR
+!! ------
+!!! A. Boone * Meteo-France/CNRS *
+!!!
+!! MODIFICATIONS
+!! -------------
+!! Original 13/09/18
+!
+!-----------------------------------------------------------------------------
+!
+USE MODD_MEB_PAR, ONLY : XLITTER_THRM_Z1, XLITTER_THRM_Z2, &
+ XLITTER_THRM_Z3
+USE MODD_ISBA_PAR, ONLY : XOMSPH
+USE MODD_CSTS, ONLY : XRHOLW, XRHOLI, XCI, XCL
+
+
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, INTENT(IN) :: PWRL, PWRLI, PGNDLITTER
+! PWRL = litter liquid water content (kg/m2)
+! PWRLI = litter liquid water equivalent ice content (kg/m2)
+! PGNDLITTER = litter layer thickness (m)
+!
+REAL, INTENT(OUT) :: PHCAP, PCOND
+! PHCAP = litter heat capacity [J/(m3 K)]
+! PCOND = litter thermal conductivity [W/(m K)]
+!
+!* 0.2 declaration of local variables
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+REAL :: ZWORK
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_0D',0,ZHOOK_HANDLE)
+!
+ZWORK = PWRL/(XRHOLW*PGNDLITTER)
+!
+! Litter heat capacity:
+!
+PHCAP = XOMSPH*XLITTER_THRM_Z1 + (XCL*XRHOLW)*ZWORK + &
+ (XCI*XRHOLI/XRHOLW)*PWRLI/PGNDLITTER
+!
+! Litter thermal conductivity:
+!
+PCOND = XLITTER_THRM_Z2 + XLITTER_THRM_Z3 * ZWORK
+!
+IF (LHOOK) CALL DR_HOOK('MODE_MEB:MEBLITTER_THRM_0D',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE MEBLITTER_THRM_0D
+!####################################################################
+!####################################################################
!####################################################################
FUNCTION MEBPALPHAN_3D(PSNOWDEPTH,PH_VEG) RESULT(PPALPHAN)
!
diff --git a/src/SURFEX/prep_snow_extern.F90 b/src/SURFEX/prep_snow_extern.F90
index 43f669649b1f9b1dc3daab7b746c7ca1e2183104..8b69ea59c204364ce632b6e9b90efe18dc85de10 100644
--- a/src/SURFEX/prep_snow_extern.F90
+++ b/src/SURFEX/prep_snow_extern.F90
@@ -151,6 +151,12 @@ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'FULL ')
CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION_PGD,IRESP,HDIR='-')
CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX_PGD,IRESP,HDIR='-')
GOLD_NAME=(IVERSION_PGD<7 .OR. (IVERSION_PGD==7 .AND. IBUGFIX_PGD<3))
+!
+!
+!-------------------------------------------------------------------------------------
+!
+!* 2. Reading of grid
+! ---------------
!
CALL PREP_GRID_EXTERN(GCP,HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
!
@@ -160,6 +166,8 @@ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
!
CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,YMASK)
!
+IF (NRANK/=NPIO) INI = 0
+!
ALLOCATE(ZMASK(INI))
IF (IVERSION_PGD>=7) THEN
IF (YAREA(1:4)=='VEG ') THEN
@@ -199,13 +207,6 @@ END IF
!
!-------------------------------------------------------------------------------------
!
-!* 2. Reading of grid
-! ---------------
-!
-IF (NRANK/=NPIO) INI = 0
-!
-!-------------------------------------------------------------------------------------
-!
!* 4. Reading of snow data
! ---------------------
!
@@ -242,6 +243,7 @@ DO JP = 1,IPATCH
IF (NRANK==NPIO) THEN
!
SELECT CASE (HSURF(1:3))
+
CASE ('WWW')
IF (OSNOW_IDEAL) THEN
IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
@@ -260,125 +262,132 @@ DO JP = 1,IPATCH
!* 6. Albedo
! ------
!
- CASE ('ALB')
- IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
- PFIELD(:,1,JP) = TZSNOW%ALB(:)
+ CASE ('ALB')
+ IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
+ PFIELD(:,1,JP) = TZSNOW%ALB(:)
!
!-------------------------------------------------------------------------------------
!
!* 7. Total depth to snow grid
! ------------------------
!
- CASE ('DEP')
- IF (OSNOW_IDEAL) THEN
- IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
- PFIELD(:,:,JP) = TZSNOW%WSNOW(:,1:KLAYER)/TZSNOW%RHO(:,1:KLAYER)
- WHERE(TZSNOW%WSNOW(:,1:KLAYER)==XUNDEF) PFIELD(:,:,JP)=XUNDEF
- ELSE
- ALLOCATE(ZD(INI))
- ZD(:) = 0.0
- DO JL=1,TZSNOW%NLAYER
- WHERE (TZSNOW%WSNOW(:,JL)/=XUNDEF)
- ZD(:) = ZD(:) + TZSNOW%WSNOW(:,JL)/TZSNOW%RHO(:,JL)
- ENDWHERE
- END DO
- IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
- PFIELD(:,1,JP) = ZD(:)
- DEALLOCATE(ZD)
- ENDIF
+ CASE ('DEP')
+ IF (OSNOW_IDEAL) THEN
+ IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
+ PFIELD(:,:,JP) = TZSNOW%WSNOW(:,1:KLAYER)/TZSNOW%RHO(:,1:KLAYER)
+ WHERE(TZSNOW%WSNOW(:,1:KLAYER)==XUNDEF) PFIELD(:,:,JP)=XUNDEF
+ ELSE
+ ALLOCATE(ZD(INI))
+ ZD(:) = 0.0
+ DO JL=1,TZSNOW%NLAYER
+ WHERE (TZSNOW%WSNOW(:,JL)/=XUNDEF)
+ ZD(:) = ZD(:) + TZSNOW%WSNOW(:,JL)/TZSNOW%RHO(:,JL)
+ ENDWHERE
+ END DO
+ IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
+ PFIELD(:,1,JP) = ZD(:)
+ DEALLOCATE(ZD)
+ ENDIF
!
!-------------------------------------------------------------------------------------
!
!* 8. Density or heat profile
! -----------------------
!
- CASE ('RHO','HEA','SG1','SG2','HIS','AGE')
+ CASE ('RHO','HEA','SG1','SG2','HIS','AGE')
!
- SELECT CASE (TZSNOW%SCHEME)
- CASE ('D95','1-L','EBA')
- IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
- !* computes output physical variable
- IF (HSURF(1:3)=='RHO') PFIELD(:,1,JP) = TZSNOW%RHO(:,1)
- IF (HSURF(1:3)=='HEA') THEN
- IF (TZSNOW%SCHEME=='D95'.OR.TZSNOW%SCHEME=='EBA') PFIELD(:,1,JP) = XTT-2.
- IF (TZSNOW%SCHEME=='1-L') PFIELD(:,1,JP) = TZSNOW%T(:,1)
- END IF
- IF (HSURF(1:3)=='SG1') PFIELD(:,1,JP) = -20.0
- IF (HSURF(1:3)=='SG2') PFIELD(:,1,JP) = 80.0
- IF (HSURF(1:3)=='HIS') PFIELD(:,1,JP) = 0.0
- IF (HSURF(1:3)=='AGE') PFIELD(:,1,JP) = 3.0
+ SELECT CASE (TZSNOW%SCHEME)
- CASE ('3-L','CRO')
- ALLOCATE(ZFIELD(INI,TZSNOW%NLAYER))
- !* input physical variable
- IF (HSURF(1:3)=='RHO') ZFIELD(:,:) = TZSNOW%RHO (:,1:TZSNOW%NLAYER)
- IF (HSURF(1:3)=='AGE') ZFIELD(:,:) = TZSNOW%AGE(:,1:TZSNOW%NLAYER)
- IF (TZSNOW%SCHEME=='CRO')THEN
- IF (HSURF(1:3)=='SG1') ZFIELD(:,:) = TZSNOW%GRAN1(:,1:TZSNOW%NLAYER)
- IF (HSURF(1:3)=='SG2') ZFIELD(:,:) = TZSNOW%GRAN2(:,1:TZSNOW%NLAYER)
- IF (HSURF(1:3)=='HIS') ZFIELD(:,:) = TZSNOW%HIST(:,1:TZSNOW%NLAYER)
- ELSE
- IF (HSURF(1:3)=='SG1') ZFIELD(:,:) = -20.0
- IF (HSURF(1:3)=='SG2') ZFIELD(:,:) = 80.0
- IF (HSURF(1:3)=='HIS') ZFIELD(:,:) = 0.0
- ENDIF
- !
- IF ( HSURF(1:3)=='HEA') THEN
- ALLOCATE(ZHEAT(INI,TZSNOW%NLAYER))
- ZHEAT(:,:) = TZSNOW%HEAT(:,1:TZSNOW%NLAYER)
- CALL SNOW_HEAT_TO_T_WLIQ(ZHEAT,TZSNOW%RHO,ZFIELD)
- WHERE (ZFIELD>XTT.AND.ZFIELD/=XUNDEF) ZFIELD = XTT
- DEALLOCATE(ZHEAT)
- ENDIF
- !
- IF (OSNOW_IDEAL) THEN
- IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
- PFIELD(:,:,JP) = ZFIELD(:,:)
- ELSE
- !
- IF (JP<=1) ALLOCATE(PFIELD(INI,NGRID_LEVEL,IPATCH))
- !* input snow layer thickness
- ALLOCATE(ZDEPTH(INI,TZSNOW%NLAYER))
- ZDEPTH(:,:) = TZSNOW%WSNOW(:,:)/TZSNOW%RHO(:,:)
+ CASE ('D95','1-L','EBA')
+ IF (JP<=1) ALLOCATE(PFIELD(INI,1,IPATCH))
+ !* computes output physical variable
+ IF (HSURF(1:3)=='RHO') PFIELD(:,1,JP) = TZSNOW%RHO(:,1)
+ IF (HSURF(1:3)=='HEA') THEN
+ IF (TZSNOW%SCHEME=='D95'.OR.TZSNOW%SCHEME=='EBA') PFIELD(:,1,JP) = XTT-2.
+ IF (TZSNOW%SCHEME=='1-L') PFIELD(:,1,JP) = TZSNOW%T(:,1)
+ END IF
+ IF (HSURF(1:3)=='SG1') PFIELD(:,1,JP) = -20.0
+ IF (HSURF(1:3)=='SG2') PFIELD(:,1,JP) = 80.0
+ IF (HSURF(1:3)=='HIS') PFIELD(:,1,JP) = 0.0
+ IF (HSURF(1:3)=='AGE') PFIELD(:,1,JP) = 3.0
+
+ CASE ('3-L','CRO')
+ ALLOCATE(ZFIELD(INI,TZSNOW%NLAYER))
+ !* input physical variable
+ IF (HSURF(1:3)=='RHO') ZFIELD(:,:) = TZSNOW%RHO (:,1:TZSNOW%NLAYER)
+ IF (HSURF(1:3)=='AGE') ZFIELD(:,:) = TZSNOW%AGE(:,1:TZSNOW%NLAYER)
+ IF (TZSNOW%SCHEME=='CRO')THEN
+ IF (HSURF(1:3)=='SG1') ZFIELD(:,:) = TZSNOW%GRAN1(:,1:TZSNOW%NLAYER)
+ IF (HSURF(1:3)=='SG2') ZFIELD(:,:) = TZSNOW%GRAN2(:,1:TZSNOW%NLAYER)
+ IF (HSURF(1:3)=='HIS') ZFIELD(:,:) = TZSNOW%HIST(:,1:TZSNOW%NLAYER)
+ ELSE
+ IF (HSURF(1:3)=='SG1') ZFIELD(:,:) = -20.0
+ IF (HSURF(1:3)=='SG2') ZFIELD(:,:) = 80.0
+ IF (HSURF(1:3)=='HIS') ZFIELD(:,:) = 0.0
+ ENDIF
!
- !* total depth
- ALLOCATE(ZD(INI))
- ZD(:) = 0.
- DO JL=1,TZSNOW%NLAYER
- ZD(:) = ZD(:) + ZDEPTH(:,JL)
- ENDDO
+ IF ( HSURF(1:3)=='HEA') THEN
+ ALLOCATE(ZHEAT(INI,TZSNOW%NLAYER))
+ ZHEAT(:,:) = TZSNOW%HEAT(:,1:TZSNOW%NLAYER)
+ CALL SNOW_HEAT_TO_T_WLIQ(ZHEAT,TZSNOW%RHO,ZFIELD)
+ WHERE (ZFIELD>XTT.AND.ZFIELD/=XUNDEF) ZFIELD = XTT
+ DEALLOCATE(ZHEAT)
+ ENDIF
!
- !* input normalized grid
- ALLOCATE(ZGRID(INI,TZSNOW%NLAYER))
- DO JI=1,INI
- IF(ZD(JI)==0.0)THEN
- DO JL = 1,TZSNOW%NLAYER
- ZGRID(JI,JL)=REAL(JL)/REAL(TZSNOW%NLAYER)
- ENDDO
- ELSE
- DO JL = 1,TZSNOW%NLAYER
- IF(JL==1)THEN
- ZGRID(JI,JL)=ZDEPTH(JI,JL)/ ZD(JI)
- ELSE
- ZGRID(JI,JL) = ZGRID(JI,JL-1) + ZDEPTH(JI,JL)/ZD(JI)
- ENDIF
- ENDDO
- ENDIF
- ENDDO
- DEALLOCATE(ZDEPTH)
- DEALLOCATE(ZD)
- !
- ! * interpolation of profile onto fine normalized snow grid
- CALL INTERP_GRID_NAT(ZGRID(:,:),ZFIELD(:,:), &
- XGRID_SNOW(:), PFIELD(:,:,JP))
- DEALLOCATE(ZGRID)
- ENDIF
- DEALLOCATE(ZFIELD)
+ IF (OSNOW_IDEAL) THEN
+
+ IF (JP<=1) ALLOCATE(PFIELD(INI,KLAYER,IPATCH))
+ PFIELD(:,:,JP) = ZFIELD(:,:)
+
+ ELSE
+ !
+ IF (JP<=1) ALLOCATE(PFIELD(INI,NGRID_LEVEL,IPATCH))
+ !* input snow layer thickness
+ ALLOCATE(ZDEPTH(INI,TZSNOW%NLAYER))
+ ZDEPTH(:,:) = TZSNOW%WSNOW(:,:)/TZSNOW%RHO(:,:)
+ !
+ !* total depth
+ ALLOCATE(ZD(INI))
+ ZD(:) = 0.
+ DO JL=1,TZSNOW%NLAYER
+ ZD(:) = ZD(:) + ZDEPTH(:,JL)
+ ENDDO
+ !
+ !* input normalized grid
+ ALLOCATE(ZGRID(INI,TZSNOW%NLAYER))
+ DO JI=1,INI
+ IF(ZD(JI)==0.0)THEN
+ DO JL = 1,TZSNOW%NLAYER
+ ZGRID(JI,JL)=REAL(JL)/REAL(TZSNOW%NLAYER)
+ ENDDO
+ ELSE
+ DO JL = 1,TZSNOW%NLAYER
+ IF(JL==1)THEN
+ ZGRID(JI,JL)=ZDEPTH(JI,JL)/ ZD(JI)
+ ELSE
+ ZGRID(JI,JL) = ZGRID(JI,JL-1) + ZDEPTH(JI,JL)/ZD(JI)
+ ENDIF
+ ENDDO
+ ENDIF
+ ENDDO
+ DEALLOCATE(ZDEPTH)
+ DEALLOCATE(ZD)
+ !
+ ! * interpolation of profile onto fine normalized snow grid
+ CALL INTERP_GRID_NAT(ZGRID(:,:),ZFIELD(:,:),XGRID_SNOW(:), PFIELD(:,:,JP))
+ DEALLOCATE(ZGRID)
+
+ ENDIF
+ DEALLOCATE(ZFIELD)
END SELECT
- !* put field form patch to all vegtypes
+ !* put field form patch to all vegtypes
END SELECT
!
+ ELSE
+ !
+ ALLOCATE(PFIELD(0,0,0))
+ !
ENDIF
!
CALL DEALLOC_GR_SNOW(TZSNOW)
diff --git a/src/SURFEX/prep_teb_extern.F90 b/src/SURFEX/prep_teb_extern.F90
index 99da5d3b121432fde259094d8ef90ff349ad0d5a..bdcacd7a4eb6e38644e19fa4f4dcc748e420039f 100644
--- a/src/SURFEX/prep_teb_extern.F90
+++ b/src/SURFEX/prep_teb_extern.F90
@@ -128,8 +128,12 @@ IF (NRANK/=NPIO) INI = 0
CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB,HDIR='-')
!
ALLOCATE(ZMASK(INI))
-IF (IVERSION_PGD>=7.AND.GTEB) THEN
- YRECFM='FRAC_TOWN'
+IF (IVERSION_PGD>=7) THEN
+ IF (GTEB) THEN
+ YRECFM='FRAC_TOWN'
+ ELSE
+ YRECFM='FRAC_NATURE'
+ END IF
CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZMASK,IRESP,HDIR='A')
ELSE
ZMASK(:) = 1.
diff --git a/src/SURFEX/read_gr_snow.F90 b/src/SURFEX/read_gr_snow.F90
index c0d6330bc8e8ecffe1645ca6c257aeecc336a1bc..19e93845761813b7738bb2fe14425b0b11c8fc7c 100644
--- a/src/SURFEX/read_gr_snow.F90
+++ b/src/SURFEX/read_gr_snow.F90
@@ -135,7 +135,7 @@ GVERSION = (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3)
! -------------------
!
ISURFTYPE_LEN=LEN_TRIM(HSURFTYPE)
-!
+!
IF (KPATCH<=1) THEN
IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
@@ -225,8 +225,8 @@ IF (IVERSION >= 7 .AND. HSURFTYPE=='VEG'.AND.KPATCH==1) &
!-------------------------------------------------------------------------------
!
!
-!* 5. Snow reservoir
-! --------------
+!* 5. Snow reservoir and Snow density
+! -------------------------------
!
ALLOCATE(ZWORK(KLU,INPATCH))
!
@@ -243,7 +243,7 @@ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"WSNOW",HSURFTYPE,TPSNOW%WSNOW)
CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"RSNOW",HSURFTYPE,TPSNOW%RHO)
!
- !* 7. Snow temperature
+ !* 6. Snow temperature
! ----------------
!
IF (TPSNOW%SCHEME=='1-L') THEN
@@ -252,19 +252,23 @@ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
!
ENDIF
!
- !* 8. Heat content
+ !* 7. Heat content
! ------------
!
IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
!
CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"HSNOW",HSURFTYPE,TPSNOW%HEAT)
!
+ !
+ !* 8. Historical parameter
+ ! -------------------
+
IF (TPSNOW%SCHEME=='CRO') THEN
!
CALL READ_LAYERS(GVERSION,TPSNOW%NLAYER,YDIR,HPREFIX,YFMT,"SHIST",HSURFTYPE,TPSNOW%HIST)
!
- !* 9. Snow Gran1
- ! ------------
+ !* 9. Snow Gran1 and Snow Gran2
+ ! ----------------------------
!
IF (GVERSION) THEN
YFMT = "(A2,A1"//YFMT0//')'
@@ -277,10 +281,10 @@ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
!
ENDIF
!
+ !* 10. Age parameter
+ ! -------------------
+ !
IF ((TPSNOW%SCHEME=='3-L'.AND.IVERSION>=8) .OR. TPSNOW%SCHEME=='CRO') THEN
- !* 12. Age parameter
- ! -------------------
- !
IF (GVERSION) THEN
YFMT = "(A3"//YFMT0//')'
ELSE
@@ -303,8 +307,15 @@ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
!
ENDIF
!
- WRITE(YFMT,'(A5,I1,A2,I1,A1)') '(A4,A',ISURFTYPE_LEN,',A',IPAT_LEN,')'
- WRITE(YRECFM,YFMT) 'ASN_',ADJUSTL(HSURFTYPE(:LEN_TRIM(HSURFTYPE))),ADJUSTL(YPAT)
+ !* 11. Albedo
+ ! --------
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ WRITE(YFMT,'(A5,I1,A2,I1,A1)') '(A6,A',ISURFTYPE_LEN,',A',IPAT_LEN,')'
+ WRITE(YRECFM,YFMT) 'ASNOW_',ADJUSTL(HSURFTYPE(:LEN_TRIM(HSURFTYPE))),ADJUSTL(YPAT)
+ ELSE
+ WRITE(YFMT,'(A5,I1,A2,I1,A1)') '(A4,A',ISURFTYPE_LEN,',A',IPAT_LEN,')'
+ WRITE(YRECFM,YFMT) 'ASN_',ADJUSTL(HSURFTYPE(:LEN_TRIM(HSURFTYPE))),ADJUSTL(YPAT)
+ ENDIF
IF (GVERSION) YRECFM=ADJUSTL(HPREFIX//YRECFM)
IF (GDIM2) THEN
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HDIR=YDIR)
@@ -313,7 +324,6 @@ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' &
CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
CALL PACK_SAME_RANK(KMASK_P,ZWORK(:,MAX(1,KPATCH)),TPSNOW%ALB(:))
ENDIF
-! IF (KLU>0) print*,YRECFM,minval(TPSNOW%ALB(:)),maxval(TPSNOW%ALB(:))
!
ENDIF
!
diff --git a/src/SURFEX/read_isban.F90 b/src/SURFEX/read_isban.F90
index 8af417896027ac21554691310abaf94ea52071fe..a25ae69149f430380a601e404c5603dc7918f596 100644
--- a/src/SURFEX/read_isban.F90
+++ b/src/SURFEX/read_isban.F90
@@ -679,7 +679,7 @@ IF (IO%CRESPSL=='CNT') THEN
YRECFM='LIGN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
CALL MAKE_CHOICE_ARRAY(HPROGRAM, IO%NPATCH, GDIM, YRECFM, ZWORK)
DO JP = 1,IO%NPATCH
- CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XSOILCARB(:,JNLITTLEVS))
+ CALL PACK_SAME_RANK(NP%AL(JP)%NR_P,ZWORK(:,JP),NPE%AL(JP)%XLIGNIN_STRUC(:,JNLITTLEVS))
ENDDO
END DO
!
diff --git a/src/SURFEX/read_nam_pgd_isba.F90 b/src/SURFEX/read_nam_pgd_isba.F90
index 85b23f284ab955d6b17bbfc4dabb3891e2cbd93d..9b90444d55c9adcb49c0f0fe30a26b954ff204a5 100644
--- a/src/SURFEX/read_nam_pgd_isba.F90
+++ b/src/SURFEX/read_nam_pgd_isba.F90
@@ -234,7 +234,7 @@ YPERMFILETYPE = ' '
YRUNOFFBFILETYPE = ' '
YWDRAINFILETYPE = ' '
YPHFILETYPE = ' '
-YPHFILETYPE = ' '
+YFERTFILETYPE = ' '
!
LIMP_CLAY = .FALSE.
LIMP_SAND = .FALSE.
diff --git a/src/SURFEX/read_nam_pgd_isba_meb.F90 b/src/SURFEX/read_nam_pgd_isba_meb.F90
index 0cf00afaa9e7b9450dfb1548b237f8d0fdf297bc..7ccdfd3ea17cb8dc10c3d0300842d186d78f2e0a 100644
--- a/src/SURFEX/read_nam_pgd_isba_meb.F90
+++ b/src/SURFEX/read_nam_pgd_isba_meb.F90
@@ -43,7 +43,7 @@
USE MODI_OPEN_NAMELIST
USE MODI_CLOSE_NAMELIST
!
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE_ECOSG
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
!
USE MODE_POS_SURF
!
@@ -75,7 +75,7 @@ LOGICAL :: GFOUND ! flag when namelist is present
!* 0.3 Declaration of namelists
! ------------------------
!
-LOGICAL, DIMENSION(NVEGTYPE_ECOSG) :: LMEB_PATCH
+LOGICAL, DIMENSION(NVEGTYPE) :: LMEB_PATCH
LOGICAL :: LFORC_MEASURE
LOGICAL :: LMEB_LITTER
LOGICAL :: LMEB_GNDRES
diff --git a/src/SURFEX/read_pgd_isba_parn.F90 b/src/SURFEX/read_pgd_isba_parn.F90
index a54f1248d00e74112b5c94eaab5512336259f4ec..9926e7698acfecef17758b18dd9c14654fb37e2f 100644
--- a/src/SURFEX/read_pgd_isba_parn.F90
+++ b/src/SURFEX/read_pgd_isba_parn.F90
@@ -496,15 +496,17 @@ IF (.NOT.OLAND_USE) THEN
ENDIF
ENDIF
GTIME(:) = .FALSE.
- DO JT = 1,SIZE(GTIME)
- IF (JT_BEG==JT_END .AND. TPDATE_END%YEAR==TPDATE_BEG%YEAR+1) THEN
- GTIME(JT) = .TRUE.
- ELSEIF (JT_BEG<=JT_END .AND. JT>=JT_BEG .AND. JT<=JT_END) THEN
- GTIME(JT) = .TRUE.
- ELSEIF (JT_BEG>JT_END .AND. (JT>=JT_BEG .OR. JT<=JT_END)) THEN
- GTIME(JT) = .TRUE.
- ENDIF
- ENDDO
+ IF (TPDATE_END%YEAR>=TPDATE_BEG%YEAR+2) THEN ! if the run contains one whole year
+ GTIME(:) = .TRUE. ! all periods must be read
+ ELSEIF (TPDATE_END%YEAR==TPDATE_BEG%YEAR+1) THEN ! if the run passes one year
+ DO JT = 1,SIZE(GTIME)
+ IF (JT>=JT_BEG .OR. JT<=JT_END) GTIME(JT) = .TRUE. ! all periods after JT_BEG and before JT_END are read
+ ENDDO
+ ELSE ! if the run stays in one only year
+ DO JT = 1,SIZE(GTIME)
+ IF (JT>=JT_BEG .AND. JT<=JT_END) GTIME(JT) = .TRUE. ! all periods between JT_BEG and JT_END are read
+ ENDDO
+ ENDIF
!
!
IF (DTI%LDATA_VEGTYPE) THEN
diff --git a/src/SURFEX/snow3l.F90 b/src/SURFEX/snow3l.F90
index 938ae4091ff2ece19d9bd85c4a8893e066237dcc..6d6771c3fd9944015b2b56019e195974d76f3199 100644
--- a/src/SURFEX/snow3l.F90
+++ b/src/SURFEX/snow3l.F90
@@ -545,7 +545,7 @@ ZSNOWTEMPO1(:) = ZSNOWTEMP(:,1) ! save surface snow temperature before update
!
ZGRNDFLUXI(:) = ZGRNDFLUX(:)
!
- CALL SNOW3LSOLVT(OMEB,PTSTEP,XSNOWDZMIN,PSNOWDZ,ZSCOND,ZSCAP,PTG, &
+CALL SNOW3LSOLVT(OMEB,PTSTEP,XSNOWDZMIN,PSNOWDZ,ZSCOND,ZSCAP,PTG, &
PSOILCOND,PD_G,ZRADSINK,ZCT,ZTSTERM1,ZTSTERM2, &
ZPET_A_COEF_T,ZPEQ_A_COEF_T,ZPET_B_COEF_T,ZPEQ_B_COEF_T, &
ZTA_IC,ZQA_IC,ZGRNDFLUX,ZGRNDFLUXO,ZSNOWTEMP,PSNOWFLUX )
@@ -1117,8 +1117,8 @@ IF(OMEB)THEN
! Diagnose surface layer coef (should be very close/identical to ZCOEF(:,1) computed above)
- ZCOEF(:,1) = 1.0 - PSWNETSNOWS(:)/MAX(1.E-4,PSWNETSNOW(:))
-
+ ZCOEF(:,1) = (PSWNETSNOW(:)-PSWNETSNOWS(:))/MAX(1.E-4,PSW_RAD(:))
+
ELSE
! Consider 3 bands:
diff --git a/src/SURFEX/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/SURFEX/treat_field.F90 b/src/SURFEX/treat_field.F90
index 8e52f043d0a8c12454420a3a61894a7ce9f2c90f..b2d01b9aa52903e69c9aadd2e24f19f2ac29707a 100644
--- a/src/SURFEX/treat_field.F90
+++ b/src/SURFEX/treat_field.F90
@@ -491,7 +491,7 @@ SELECT CASE (HSUBROUTINE)
ELSE
- ALLOCATE(XSUMVAL(U%NSIZE_FULL,1))
+ ALLOCATE(XSUMVAL(U%NSIZE_FULL,SIZE(NSIZE,2)))
IF (HFILETYPE=='DIRECT' .AND. NPROC>1) THEN
CALL ABOR1_SFX("TREAT_FIELD: MAJ is not possible with DIRECT filetype and NPROC>1")
ELSE
diff --git a/src/SURFEX/write_diag_pgd_isban.F90 b/src/SURFEX/write_diag_pgd_isban.F90
index 70928be6bcfd4929fbbbf754e283a5bfbe6b4e7a..96417bb19f3c71c32751e2ec36ab05c108c3f79f 100644
--- a/src/SURFEX/write_diag_pgd_isban.F90
+++ b/src/SURFEX/write_diag_pgd_isban.F90
@@ -299,9 +299,9 @@ IF(IO%CISBA=='DIF')THEN
!* Root fraction for each patch
!
ALLOCATE(ZWORK1(ILU))
- DO JP = 1,IO%NPATCH
- PK => NP%AL(JP)
- DO JL=1,SIZE(PK%XROOTFRAC,2)
+ DO JL=1,SIZE(PK%XROOTFRAC,2)
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
IF (JL<10) THEN
WRITE(YRECFM,FMT='(A8,I1)') 'ROOTFRAC',JL
ELSE
diff --git a/src/SURFEX/write_field_1d_patch.F90 b/src/SURFEX/write_field_1d_patch.F90
index 2907ca95fbde04fab4b0d09c58ee902d832ee090..b398135ba5fb11c7ebca37617dad971b84b957ae 100644
--- a/src/SURFEX/write_field_1d_patch.F90
+++ b/src/SURFEX/write_field_1d_patch.F90
@@ -29,7 +29,7 @@ REAL, DIMENSION(:,:), OPTIONAL, INTENT(INOUT) :: PWORK_WR
REAL, DIMENSION(KSIZE,1) :: ZWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
CHARACTER(LEN=2) :: YPAT
-INTEGER :: IRESP
+INTEGER :: IRESP, ILEN
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_FIELD_1D_PATCH',0,ZHOOK_HANDLE)
@@ -47,6 +47,8 @@ IF (LSPLIT_PATCH) THEN
!
ELSE
!
+ ILEN = LEN_TRIM(YRECFM)
+ IF (YRECFM(ILEN:ILEN)=="_") YRECFM = ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//'P'
IF (KP/=0) THEN
PWORK_WR(:,KP) = ZWORK(:,1)
IF ( KP==SIZE(PWORK_WR,2) ) THEN
diff --git a/src/SURFEX/write_field_2d_patch.F90 b/src/SURFEX/write_field_2d_patch.F90
index f296a11cd0f930e9a90ba39ee54f90f5130b5cf6..830ff1a9a2742a6bb2485dc7913bcaa07fa1cd1a 100644
--- a/src/SURFEX/write_field_2d_patch.F90
+++ b/src/SURFEX/write_field_2d_patch.F90
@@ -33,7 +33,7 @@ REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PWORK_WR
REAL, DIMENSION(KSIZE,SIZE(PFIELD_IN,2)) :: ZWORK
CHARACTER(LEN=LEN_HREC) :: YRECFM
CHARACTER(LEN=2) :: YPAT
-INTEGER :: IRESP
+INTEGER :: IRESP, ILEN
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('WRITE_FIELD_2D_PATCH',0,ZHOOK_HANDLE)
@@ -51,6 +51,8 @@ IF (LSPLIT_PATCH) THEN
!
ELSE
!
+ ILEN = LEN_TRIM(YRECFM)
+ IF (YRECFM(ILEN:ILEN)=="_") YRECFM = ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//'P'
IF (KP/=0) THEN
PWORK_WR(:,:,KP) = ZWORK(:,:)
IF ( KP==SIZE(PWORK_WR,3) ) THEN
diff --git a/src/SURFEX/zoom_pgd_surf_atm.F90 b/src/SURFEX/zoom_pgd_surf_atm.F90
index c3be1abc61fb729cc36f1071175c6e3a83ac6bed..7d82452cce2b3e3430c0cbdd9021c77b1a670737 100644
--- a/src/SURFEX/zoom_pgd_surf_atm.F90
+++ b/src/SURFEX/zoom_pgd_surf_atm.F90
@@ -112,6 +112,7 @@ IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_SURF_ATM',0,ZHOOK_HANDLE)
CALL READ_SURF(HINIFILETYPE,'NATURE',YSC%U%CNATURE,IRESP)
CALL READ_SURF(HINIFILETYPE,'WATER', YSC%U%CWATER, IRESP)
CALL READ_SURF(HINIFILETYPE,'TOWN', YSC%U%CTOWN, IRESP)
+ CALL READ_SURF(HINIFILETYPE,'ECOSG', YSC%U%LECOSG, IRESP)
CALL READ_COVER_GARDEN(HINIFILETYPE,YSC%U%LGARDEN)
CALL INIT_READ_DATA_COVER(HPROGRAM)
CALL INI_DATA_COVER(YSC%DTCO, YSC%U)
diff --git a/src/configure b/src/configure
index e913daf31c8c0bb1484341fe9d4ea8d93fe521d1..9c617901170e15571a6073f9ab6b228ff0c650c9 100755
--- a/src/configure
+++ b/src/configure
@@ -53,6 +53,7 @@ case "$TARG" in
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
module purge
+module load cmake/3.18.0
module load intel-compilers/19.1.3
module load intel-mpi/2019.9
ulimit -s unlimited
@@ -72,6 +73,7 @@ conda activate climate_science
export MNHENV=${MNHENV:-"
ulimit -s unlimited
module purge
+module load cmake/3.16.1
module load intel/19.4 intelmpi/2019.4.243
export SLURM_CPU_BIND=none
export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
@@ -134,8 +136,9 @@ module load ncl_ncarg/6.3.0
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
module purge
-module load intel/18.0.3.222
-module load mpi/openmpi/2.0.4
+module load cmake/3.18.1
+module load intel/19.0.5.281
+module load mpi/openmpi/4.0.2
export SLURM_CPU_BIND=none
"}
;;
@@ -149,6 +152,7 @@ export SLURM_CPU_BIND=none
export VERSION_XYZ="${VERSION_XYZ}-AMD"
export MNHENV=${MNHENV:-"
module purge
+module load cmake/3.18.1
module load intel/19.0.5.281
module load mpi/openmpi/4.0.2
export SLURM_CPU_BIND=none
@@ -174,6 +178,7 @@ export ARMCI_SHR_BUF_METHOD=COPY
export NEED_TOOLS=YES
export MNHENV=${MNHENV:-"
module purge
+module load python/3.7.6
module load intel/2019.5.281
module load openmpi/intel/4.0.2.2
module load cmake/3.15.4
@@ -383,6 +388,7 @@ export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
module purge
+module load cmake/3.13.0
module load intel/20.0.015 intelmpi/20.0.015
export SLURM_CPU_BIND=none
export I_MPI_PIN_PROCESSOR_LIST=all:map=spread