diff --git a/.gitignore b/.gitignore
index f98ca394432eeae4f2ff564c0ebbdef858d0835c..30618d0f35e5395a784e85895e7f983d6e0036e2 100644
--- a/.gitignore
+++ b/.gitignore
@@ -39,7 +39,14 @@ MY_RUN/KTEST/9??_*
pub/ncl-?.?.?
pub/ncl_ncarg*/
src/dir_obj-*
+src/LIB/eccodes*
+!src/LIB/eccodes*.tar.gz
src/LIB/grib_api*
+!src/LIB/grib_api*.tar.gz
src/LIB/hdf5*
+!src/LIB/hdf5*.tar.gz
src/LIB/libaec*
+!src/LIB/libaec*.tar.gz
src/LIB/netcdf*
+!src/LIB/netcdf*.tar.gz
+
diff --git a/A-INSTALL b/A-INSTALL
index e9fcf06f82d72f0ce656fbaac3f47b67f067bbe4..1a1a6d61efc83d7bb5d825e445cd638ca14b5d49 100644
--- a/A-INSTALL
+++ b/A-INSTALL
@@ -1,8 +1,8 @@
#
# Version of PACKAGE MESONH "Open distribution"
-# PACK-MNH-V5-4-2
-# DATE : 03/04/2019
-# VERSION : MESONH MASDEV5_4 + BUG-2
+# PACK-MNH-V5-5-0
+# DATE : 20/07/2021
+# VERSION : MESONH MASDEV5_5 + BUG-0
#
# MAP
#
@@ -13,7 +13,7 @@
# III) COMPILING/INSTALLING THE MESONH PACKAGE ON YOUR LINUX COMPUTER
# IV) RUN SOME "SMALL KTEST" EXAMPLES
# V) RECOMPILING YOUR 'OWN' SOURCES ONLY
-# VI) COMPILING/INSTALLING MESONH ON GENCI & ECMWF & METEO COMPUTERS
+# VI) COMPILING/INSTALLING MESONH ON GENCI & ECMWF & METEO & CALMIP COMPUTERS
# VII) "SCANDOLLAR" = SCRIPTING YOUR OWN PROCEDURES
#
# VIII) TROUBLE-SHOOTING
@@ -28,6 +28,10 @@
# e) cleaning previous compiled version
#
#
+# NEW on MNH-55X : For conda package for graphic output in test-case examples , read
+# the 'README_MNH_CONDA' file in this (root) directory
+#
+#
^L
# 0) TWO WAYS OF DOWNLOADING MESONH
# =================================
@@ -80,14 +84,14 @@
#
# or directly
#
-# http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-4-2.tar.gz
+# http://mesonh.aero.obs-mip.fr/mesonh/dir_open/dir_MESONH/MNH-V5-5-0.tar.gz
#
-# Then untar the file "MNH-V5-4-2.tar.gz" where you want to.
+# Then untar the file "MNH-V5-5-0.tar.gz" where you want to.
# For example, in your home directory:
#
cd ~
-tar xvfz MNH-V5-4-2.tar.gz
+tar xvfz MNH-V5-5-0.tar.gz
#
# Process now to the chapter to configure the MesoNH package.
@@ -130,7 +134,7 @@ git lfs install
# only access) by following the next link:
#
-http://mesonh.aero.obs-mip.fr/mesonh54/GitSources?action=AttachFile&do=get&target=anongitmesonh.key
+http://mesonh.aero.obs-mip.fr/mesonh55/GitSources?action=AttachFile&do=get&target=anongitmesonh.key
#
# and save the file in your $HOME/.ssh/ directory.
@@ -161,68 +165,68 @@ git config --global http.sslverify false
# This is necessary to disable the certificate checks because a self-signed
# certificate was used for the LFS server.
#
-# c) Cloning the Meso-NH Source repository on the developpement branch MNH-54-branch
+# c) Cloning the Meso-NH Source repository on the developpement branch MNH-55-branch
# ----------------------------------------------------------------------------------
#
# Finally you can clone the Meso-NH Git repository with the following command:
#
-git lfs clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MNH-54-branch MNH-V5-4-2
+git lfs clone anongit@anongit_mesonh:/gitrepos/MNH-git_open_source-lfs.git -b MNH-55-branch MNH-V5-5-0
#
-# that will create the MNH-V5-4-2 directory containing a clone (copy) of the
-# Meso-NH package on the remote developpement branch MNH-54-branch
+# that will create the MNH-V5-5-0 directory containing a clone (copy) of the
+# Meso-NH package on the remote developpement branch MNH-55-branch
#
#
# d) Checking out a given version of MESONH
# -----------------------------------------
#
# Once the repository is cloned, it's better for you to checkout your own branch
-# (by default, you are on HEAD of the MNH-54-branch development branch ).
+# (by default, you are on HEAD of the MNH-55-branch development branch ).
#
-# To create your local branch corresponding to the V5-4-2 version, type:
+# To create your local branch corresponding to the V5-5-0 version, type:
#
-cd MNH-V5-4-2
-git checkout -b MYB-MNH-V5-4-2 PACK-MNH-V5-4-2
+cd MNH-V5-5-0
+git checkout -b MYB-MNH-V5-5-0 PACK-MNH-V5-5-0
#
-# MYB-MNH-V5-4-2 is the name of the local branch you created
+# MYB-MNH-V5-5-0 is the name of the local branch you created
# and
-# PACK-MNH-V5-4-2 is the remote/origin tag on which it is based.
+# PACK-MNH-V5-5-0 is the remote/origin tag on which it is based.
#
# The advantage of this way of downloading the package is that in the future
# you could check/update quickly differences with the new version of the
# package without having to download entirely the full package.
#
-# Suppose that a new version, for example "PACK-MNH-V5-4-2", is announced.
+# Suppose that a new version, for example "PACK-MNH-V5-5-1", is announced.
#
# To see the differences with your working copy, do:
#
git fetch
-git diff HEAD PACK-MNH-V5-4-2
+git diff HEAD PACK-MNH-V5-5-1
#
# To go to the new version, you can, for example, create a new local branch:
#
-git checkout -b MYB-MNH-V5-4-2 PACK-MNH-V5-4-2
+git checkout -b MYB-MNH-V5-5-1 PACK-MNH-V5-5-1
#
# At any time, you can also check for "uptodate" changes in the Git branch
-# dedicated to the MNH54 version before the official release of the "bugN+1"
+# dedicated to the MNH55 version before the official release of the "bugN+1"
# bugfix version.
#
git fetch
-git diff HEAD MNH-54-branch
+git diff HEAD MNH-55-branch
#
# And, test this development (not yet official) version by going to this branch:
#
-git checkout --track origin/MNH-54-branch
+git checkout --track origin/MNH-55-branch
#
# e) Cloning the Meso-NH Documentation repository
#
@@ -253,7 +257,7 @@ git clone anongit@anongit_mesonh:/gitrepos/MNH-DOC.git
# use the "./configure" script like this
#
-cd ~/MNH-V5-4-2/src
+cd ~/MNH-V5-5-0/src
./configure
. ../conf/profile_mesonh
@@ -304,7 +308,7 @@ export OPTLEVEL=O2 # Compile in O2, 4 times faster then DEBUG, but less
# and then source/load the new generate file
-. ../conf/profile_mesonh.LXifort.MNH-V5-4-2.MPIAUTO.O2
+. ../conf/profile_mesonh.LXifort.MNH-V5-5-0.MPIAUTO.O2
#
# REM:
@@ -329,7 +333,7 @@ export OPTLEVEL=O2 # Compile in O2, 4 times faster then DEBUG, but less
# go to the directory "src"
#
-cd ~/MNH-V5-4-2/src
+cd ~/MNH-V5-5-0/src
#
# if you have not already configured your MESONH environment
@@ -535,8 +539,8 @@ make examples
^L
#
-# VI) COMPILING/INSTALLING ON GENCI & ECMWF & METEO COMPUTERS
-# ===========================================================
+# VI) COMPILING/INSTALLING ON GENCI & ECMWF & METEO & CALMIP COMPUTERS
+# ====================================================================
#
# After downloading "exactly" like on "any standalone PC"
# run the "./configure" command :
@@ -547,51 +551,83 @@ make examples
#
# - If you do not have sufficient space in your "$HOME" directory,
# install the whole package directly on the ${WORKDIR}
+# /!\ the name of the WORKDIR differ in the differents computer center
+# read the doc , most of them manage disk space throw 'multi-projet' with only one unique login .
#
# WARNING :
# ========
# - Think to do a backup of your installation
-# - This space is no more "purged" but a "crash disk" could/will
+# - This space is no "purged" but a "crash disk" could/will
# probably occur !!!
#
cd $WORKDIR
-cd MNH-V5-4-2/src
+cd MNH-V5-5-0/src
./configure
#
# Due to limitation in time & memory on interactive connection
-# then compile the MESONH PACKAGE in batch mode with the different "job_make_mesonh*" files
+# in some computer you have to compile the MESONH PACKAGE in batch mode with the different "job_make_mesonh*" files
#
# at IDRIS :
# ---------
#
-# - On ADA ( IBM/x3750 ) with :
+# - On JEAN-ZAY ( HPE ) the compilation is only possible in interactive :
-llsubmit job_make_mesonh_IBM_ada
+cd MNH-V5-5-0/src
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIINTEL-O2
+make -j16 |& tee error$XYZ
+make installmaster
-#
-#
-# - On TURING (IBM BG/Q ) :
+# - to run the test case examples run
-llsubmit job_make_mesonh_BGQ
+sbatch -A {your_projet}@cpu job_make_examples_BullX_jeanzay
#
+#
+# at CINES on OCCIGEN (BULLX) :
+# -------------------------------------------------------
+#
+# - install the PACKAGE in your $HOME ( default 50Go of quota )
+# - Compile in interactive mode ( see IDRIS )
#
-# BACKUP : /!\ backup your work on "ergon"
+# - to run the test case examples run
+
+sbatch job_make_examples_BullX_occigen
+
#
#
-# at CINES on JADE( SGI/ICE ) , OCCIGEN not tested yet :
+# at TGCC on IRENE (BULLX) :
# -------------------------------------------------------
-#
-# - install the PACKAGE in your "/store/${USER}" directory
-# - you could compile in interactive mode
#
-# BACKUP : /!\ backup your work on "/data/${USER}"
+# At TGCC , you have two architectures accessible throw 2 differents frontals
+# but with a commun disk space , connect to :
+#
+# - ssh irene-fr : for Intel SkyLake/KNL processors
+# On Intel processors the MPI use is OPENMPI/2.0.4
+# the configure will generate a
+# profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIAUTO-O2
+#
+# - ssh irene-amd : for AMD , processors
+# On AMD processors the MPI use is OPENMPI/4.02
+# the configure will generate a
+# profile_mesonh-LXifort-R8I4-MNH-V5-5-0-AMD-MPIAUTO-O2
#
+# - install the PACKAGE in your $CCCHOME ( default 20Go of quota )
+# - Compile in interactive mode ( see IDRIS )
+#
+
+# - to run the test case examples run
+#
+# On intel Skylake
+ccc_msub job_make_examples_BullX_irene
+# On intel Knl
+ccc_msub -q knl job_make_examples_BullX_irene
+# On intel AMD
+ccc_msub job_make_examples_BullX_irene_AMD
#
# at ECMWF on cca ( CRAY/XC30 ) :
@@ -600,45 +636,32 @@ llsubmit job_make_mesonh_BGQ
# - to install MESONH go to your $PERM directory
# if you need more disk space than allowed for 'standard' user
# Ask to Dominique Lucas, look this email :
-#
-# http://mesonh.aero.obs-mip.fr/cgi-bin/mesonh_interne/mail2html.cgi?file=2009_09_24_15:31:54
+# http://mesonh.aero.obs-mip.fr/mesonh/dir_interne/dir_mail_mesonh_cnrm/dir_mail/2009_09_24_15:31:54.eml
#
# - for the compilation use :
qsub job_make_mesonh_CRAY_cca
-#
-# REM : On CRAY computer cca , the default compiler is the CRAY one = crayftn .
-# I you have trouble with this one , you could compile with the Intel/ifort one .
-# Use the ifort one do :
-
-export ARCH=LXifort
-./configure
-
-...
-
-creation du fichier --> ../conf/profile_mesonh-LXifortI4-MNH-V5-4-2-MPICRAY-O2
-
-# And for the compilation & example job , switch the ARCH variable to LXifort :
+# - to run the test case examples run
-vi job_make_mesonh_CRAY_cca(job_make_examples_CRAY_cca)
+qsub job_make_examples_CRAY_cca
-ARCH=LXifort
-#ARCH=LXcray # this is the default one
-. ../conf/profile_mesonh-${ARCH}I4-MNH-V5-4-2-MPICRAY-O2
+#
+# REM : On CRAY computer cca , I switch the default compiler to the INTEL one .
+# Some trouble with the is the CRAY one = crayftn .
#
# - At Meteo-France DSI on beaufix (or prolix)
#
# to install the whole package on your "$HOME" directory
-# untar the file "PACK-MNH-V5-4-2.tar.gz" from its location :
+# untar the file "MNH-V5-5-0.tar.gz" from its location :
cd ~
-tar xvf $MESONH/pack_MNH-V5-4-2.tar.gz
+tar xvf $MESONH/MNH-V5-5-0.tar.gz
# run the "./configure" command :
-cd MNH-V5-4-2/src
+cd MNH-V5-5-0/src
./configure
#
@@ -671,44 +694,18 @@ export VER_USER=MY_MODIF
sbatch job_make_mesonh_user_BullX
-#
-# EXAMPLES ON GENCI & ECMWF PLATFORMS & METEO COMPUTERS
-# =====================================================
-#
-# - At IDRIS
-#
-
-# on ADA
-
-llsubmit job_make_examples_IBM_ada
-
-#on TURING
-llsubmit job_make_examples_BGQ
-
-#
-# - At CINES on JADE( SGI/ICE ) :
-#
-# load ".profile_mesonh..." & set the variables :
-
-export MONORUN="mpirun -np 1"
-export MPIRUN="mpirun -np 4 "
-
-# and run with
-
-make examples
-
-#
-# - At ECMWF on cca
#
-
-llsubmit job_make_examples_CRAY_cca
-
-#
-# - At Meteo-France DSI on beaufix or prolix
+#
+# at CALMIP on OLYMPE (BULLX) :
+# -------------------------------------------------------
+#
+# - install the PACKAGE in your /tmpdir/$USER
+# - Compile in interactive mode ( see IDRIS )
#
+# - to run the test case examples run
-sbatch job_make_examples_BullX
+sbatch job_make_examples_BullX_olympe
#
# That's all for the basic INSTALLATION of the "MESONH PACKAGE"
@@ -718,7 +715,7 @@ sbatch job_make_examples_BullX
# VII) "SCANDOLLAR" = SCRIPTING YOUR OWN PROCEDURES
# ====================================================
-REM : not tested on 5-4-X version ...
+REM : not tested on 5-5-X version ...
# A small script 'scandollar' is in test in this version of MESONH.
# It will help you to build a complete chaining of an experiment.
@@ -764,7 +761,7 @@ scandollar
## OUTPUT ::
-># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-4-2/conf/post/confdollar_aeropc_default
+># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-5-0/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
@@ -786,7 +783,7 @@ scandollar 0*
## OUTPUT ::
>#
-># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-4-2/conf/post/confdollar_aeropc_default
+># read default config file :: ---> CONF_DOLLAR=/home/escj/DEV64/PACK-MNH-V5-5-0/conf/post/confdollar_aeropc_default
>#
># read user config file :: ---> CONFIG=confdollar
>#
@@ -860,22 +857,22 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use this "profile_mesonh" :
-. /home/rech/mnh/rmnh007/DEV/MNH-V5-4-2/conf/profile_mesonh-SX8-MNH-V5-4-2-MPIAUTO-O4
+. /home/rech/mnh/rmnh007/DEV/MNH-V5-5-0/conf/profile_mesonh-SX8-MNH-V5-5-0-MPIAUTO-O4
# And the examples are here ( link to my $WORKDIR in actually )
-/home/rech/mnh/rmnh007/DEV/MNH-V5-4-2/MY_RUN/KTEST/007_16janvier_scandollar
+/home/rech/mnh/rmnh007/DEV/MNH-V5-5-0/MY_RUN/KTEST/007_16janvier_scandollar
#
# On vargas
# ---------
# use this "profile_mesonh" :
-. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-4-2/conf/profile_mesonh-AIX64-MNH-V5-4-2-MPIAUTO-O2
+. /workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-5-0/conf/profile_mesonh-AIX64-MNH-V5-5-0-MPIAUTO-O2
# and examples here :
-/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-4-2/MY_RUN/KTEST/007_16janvier_scandollar
+/workgpfs/rech/mnh/rmnh007/DEV/MNH-V5-5-0/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At CINES on JADE :
@@ -883,11 +880,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
-. /work/escobar/DEV/MNH-V5-4-2/conf/profile_mesonh-LXifort-MNH-V5-4-2-MPIICE-O2
+. /work/escobar/DEV/MNH-V5-5-0/conf/profile_mesonh-LXifort-MNH-V5-5-0-MPIICE-O2
# and the exemples
-/work/escobar/DEV/MNH-V5-4-2/MY_RUN/KTEST/007_16janvier_scandollar
+/work/escobar/DEV/MNH-V5-5-0/MY_RUN/KTEST/007_16janvier_scandollar
#
# - At ECMWF on cxa :
@@ -895,11 +892,11 @@ cp -R 007_16janvier_scandollar /.../your_directory
#
# use
-. /c1a/ms_perm/au5/MNH-V5-4-2/conf/profile_mesonh-AIX64-MNH-V5-4-2-MPIAUTO-O2
+. /c1a/ms_perm/au5/MNH-V5-5-0/conf/profile_mesonh-AIX64-MNH-V5-5-0-MPIAUTO-O2
# and the examples
-/c1a/ms_perm/au5/MNH-V5-4-2/MY_RUN/KTEST/007_16janvier_scandollar
+/c1a/ms_perm/au5/MNH-V5-5-0/MY_RUN/KTEST/007_16janvier_scandollar
#
@@ -995,9 +992,42 @@ 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
+# -----------------------------------
+#
+# 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 and set HDF5_PREFIX, FFLAGS_HDF5 and LDFLAGS_HDF5 as shown below
+"
+HDF5_PREFIX = $(SRC_MESONH)/src/dir_obj${XYZ}/MASTER/NETCDF-${VERSION_CDFF}
+FFLAGS_HDF5 = -D_RTTOV_HDF $(FFLAG_MOD)$(HDF5_PREFIX)/include
+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 http://nwpsaf.eu/site/software/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
@@ -1018,7 +1048,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/LIBTOOLS/tools/lfi2cdf/src/lfi2cdf.f90 b/LIBTOOLS/tools/lfi2cdf/src/lfi2cdf.f90
index 3b757c3bc97d5f5d9b8f21bebc65bb8909973480..39bb56a69b1e50141bc39db8f2236a956355faac 100644
--- a/LIBTOOLS/tools/lfi2cdf/src/lfi2cdf.f90
+++ b/LIBTOOLS/tools/lfi2cdf/src/lfi2cdf.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -14,7 +14,7 @@ program LFI2CDF
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_TIMEZ, ONLY: TIMEZ
- USE MODE_FIELD, ONLY: INI_FIELD_LIST
+ use mode_field, only: Ini_field_list
USE MODE_IO, ONLY: IO_Init, IO_Config_set
use mode_ll
USE mode_options
@@ -96,7 +96,7 @@ program LFI2CDF
CALL OPEN_FILES(infiles, outfiles, nfiles_out, hinfile, houtfile, nbvar_infile, options, runmode)
IF (options(OPTLIST)%set) STOP
- !Set and initialize parallel variables (necessary to read splitted files)
+ !Set and initialize parallel variables (necessary to read split files)
CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
CALL SET_DAD0_ll()
CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
diff --git a/LIBTOOLS/tools/lfi2cdf/src/mode_options.f90 b/LIBTOOLS/tools/lfi2cdf/src/mode_options.f90
index e578f204cd7f11353fa6bbcc329c30456f371b44..0331b364c637fe1723ca3afe1d52bf889ab1581a 100644
--- a/LIBTOOLS/tools/lfi2cdf/src/mode_options.f90
+++ b/LIBTOOLS/tools/lfi2cdf/src/mode_options.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2015-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2015-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -8,7 +8,7 @@
! P. Wautelet 21/10/2019: add OPTDIR option to set directory for writing outfiles
!-----------------------------------------------------------------
module mode_options
- USE MODE_FIELD, ONLY: TYPEUNDEF, TYPEINT, TYPELOG, TYPEREAL, TYPECHAR, TYPEDATE
+ use modd_field, only: TYPEUNDEF, TYPEINT, TYPELOG, TYPEREAL, TYPECHAR, TYPEDATE
implicit none
diff --git a/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90 b/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
index 8dc5e9dc3d0a82e77f11381c496f99c2cf6a1cfd..5bca2401c4b91d7ce1ea9902cdcf70e017a85c74 100644
--- a/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
+++ b/LIBTOOLS/tools/lfi2cdf/src/mode_util.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -12,20 +12,23 @@
! P. Wautelet 19/09/2019: add possibility to provide a fallback file if some information are not found in the input file
! P. Wautelet 21/10/2019: add OPTDIR option to set directory for writing outfiles
! P. Wautelet 21/10/2019: if DTMOD and DTCUR not found, try to read the time coordinate
+! P. Wautelet 10/11/2020: new data structures for netCDF dimensions
!-----------------------------------------------------------------
MODULE mode_util
+ use modd_field, only: tfielddata, tfieldlist
USE MODD_IO, ONLY: TFILEDATA, TFILE_ELT
- USE MODD_NETCDF, ONLY: DIMCDF, CDFINT
+ USE MODD_NETCDF, ONLY: CDFINT, tdimnc
USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH, NMNHNAMELGTMAX
use modd_precision, only: LFIINT
- USE MODE_FIELD
+ use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_READ
USE MODE_IO_FIELD_WRITE
use mode_io_tools_nc4, only: IO_Err_handle_nc4
-
+ use mode_msg
USE mode_options
+
USE NETCDF
IMPLICIT NONE
@@ -54,7 +57,7 @@ MODULE mode_util
INTEGER,DIMENSION(MAXRAW) :: src ! List of variables used to compute the variable (needed only if calc=.true.)
INTEGER :: tgt ! Target: id of the variable that use it (calc variable)
TYPE(TFIELDDATA) :: TFIELD ! Metadata about the field
- TYPE(DIMCDF),DIMENSION(:),ALLOCATABLE :: TDIMS ! Dimensions of the field
+ TYPE(tdimnc),DIMENSION(:),ALLOCATABLE :: TDIMS ! Dimensions of the field
END TYPE workfield
LOGICAL(KIND=LFIINT), PARAMETER :: ltrue = .TRUE.
@@ -426,7 +429,7 @@ END DO
CALL IO_Dimids_guess_nc4(outfiles(idx_out)%TFILE,tpreclist(ji)%TFIELD,&
tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
!
- IF (IRESP/=0 .OR. tpreclist(ji)%TDIMS(3)%LEN==1) THEN
+ IF (IRESP/=0 .OR. tpreclist(ji)%TDIMS(3)%nlen==1) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles',tpreclist(ji)%TFIELD%CMNHNAME//': try 2D')
!Try again with 2D
tpreclist(ji)%TFIELD%NDIMS = 2
@@ -434,7 +437,7 @@ END DO
tpreclist(ji)%NSIZE,tpreclist(ji)%TDIMS,IRESP)
END IF
!
- IF (IRESP/=0 .OR. tpreclist(ji)%TDIMS(2)%LEN==1) THEN
+ IF (IRESP/=0 .OR. tpreclist(ji)%TDIMS(2)%nlen==1) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','parse_infiles',tpreclist(ji)%TFIELD%CMNHNAME//': try 1D')
!Try again with 1D
tpreclist(ji)%TFIELD%NDIMS = 1
@@ -730,7 +733,7 @@ END DO
SELECT CASE(tpreclist(ji)%TFIELD%NTYPE)
CASE (TYPEINT)
- IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%LEN
+ IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%nlen
IF (.NOT.tpreclist(ji)%calc) THEN
INSRC = 1
@@ -806,7 +809,7 @@ END DO
CASE (TYPELOG)
- IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%LEN
+ IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%nlen
tpreclist(ji)%TFIELD%LTIMEDEP = gtimedep_in(ji)
SELECT CASE(IDIMS)
@@ -830,7 +833,7 @@ END DO
CASE (TYPEREAL)
- IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%LEN
+ IDIMLEN(1:IDIMS) = tpreclist(ji)%TDIMS(1:IDIMS)%nlen
IF (.NOT.tpreclist(ji)%calc) THEN
INSRC = 1
@@ -1171,7 +1174,7 @@ END DO
istatus = NF90_INQ_VARID( infiles(1)%tfile%nncid, 'time', ivar_id )
if ( istatus == NF90_NOERR ) then
allocate( tdtcur )
- istatus = NF90_GET_VAR( infiles(1)%tfile%nncid, ivar_id, tdtcur%time )
+ istatus = NF90_GET_VAR( infiles(1)%tfile%nncid, ivar_id, tdtcur%xtime )
if ( istatus == NF90_NOERR ) then
istatus = NF90_INQUIRE_ATTRIBUTE( infiles(1)%tfile%nncid, ivar_id, 'units', len = ilen )
if ( istatus == NF90_NOERR ) then
@@ -1179,14 +1182,14 @@ END DO
istatus = NF90_GET_ATT( infiles(1)%tfile%nncid, ivar_id, 'units', yunits )
! Extract date from yunits
idx = INDEX( yunits, 'since ' )
- Read( yunits(idx+6 :idx+9 ) , '( I4.4 )' ) tdtcur%tdate%year
- Read( yunits(idx+11:idx+12 ), '( I2.2 )' ) tdtcur%tdate%month
- Read( yunits(idx+14:idx+15 ), '( I2.2 )' ) tdtcur%tdate%day
+ Read( yunits(idx+6 :idx+9 ) , '( I4.4 )' ) tdtcur%nyear
+ Read( yunits(idx+11:idx+12 ), '( I2.2 )' ) tdtcur%nmonth
+ Read( yunits(idx+14:idx+15 ), '( I2.2 )' ) tdtcur%nday
if ( .not. associated( tdtmod ) ) then
allocate( tdtmod )
tdtmod = tdtcur
- tdtmod%time = 0.
+ tdtmod%xtime = 0.
end if
gok = .true.
@@ -1591,14 +1594,14 @@ END DO
SUBROUTINE IO_Dims_fill_nc4(TPFILE,TPREC,KRESP)
USE MODD_IO, ONLY: TFILEDATA
- use mode_io_tools_nc4, only: IO_Dimcdf_get_nc4, IO_Dim_find_byname_nc4
+ use mode_io_tools_nc4, only: IO_Dim_find_create_nc4, IO_Dim_find_byname_nc4
TYPE(TFILEDATA),INTENT(IN) :: TPFILE
TYPE(workfield),INTENT(INOUT) :: TPREC
INTEGER, INTENT(OUT) :: KRESP
+ integer :: iidx
INTEGER :: JJ
- TYPE(DIMCDF),POINTER :: TZDIMPTR
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dims_fill_nc4','called')
@@ -1620,13 +1623,13 @@ END DO
CALL IO_Dim_find_byname_nc4(TPFILE,TPREC%CDIMNAMES_FILE(JJ),TPREC%TDIMS(JJ),KRESP)
!If dimension not found => create it
IF (KRESP/=0) THEN
- TZDIMPTR => IO_Dimcdf_get_nc4(TPFILE,TPREC%NDIMSIZES_FILE(JJ))
- TPREC%TDIMS(JJ) = TZDIMPTR
+ call IO_Dim_find_create_nc4( tpfile, tprec%ndimsizes_file(jj), iidx )
+ tprec%tdims(jj) = tpfile%tncdims%tdims(iidx)
KRESP = 0
END IF
- IF (TRIM(TPREC%TDIMS(JJ)%name)/='time' .AND. &
- TPREC%TDIMS(JJ)%len /= TPREC%NDIMSIZES_FILE(JJ)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_FILL_DIMS_NC4','problem with dimensions for '//TPREC%TFIELD%CMNHNAME)
+ IF (TRIM(TPREC%TDIMS(JJ)%cname)/='time' .AND. &
+ TPREC%TDIMS(JJ)%nlen /= TPREC%NDIMSIZES_FILE(JJ)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dims_fill_nc4','problem with dimensions for '//TPREC%TFIELD%CMNHNAME)
KRESP = -3
EXIT
END IF
diff --git a/MY_RUN/KTEST/001_2Drelief/003_convdia/clean_conv2dia b/MY_RUN/KTEST/001_2Drelief/003_convdia/clean_conv2dia
deleted file mode 100755
index b7471298dbe4522965b9351903c8fbf301b341e5..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/001_2Drelief/003_convdia/clean_conv2dia
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/bash
-rm -f dirconv.elim FICJD LISTING_DIA OUT_DIA pipe_name
-rm -f EXPER.1.HYD2D*
-
diff --git a/MY_RUN/KTEST/001_2Drelief/003_convdia/dir_conv2dia b/MY_RUN/KTEST/001_2Drelief/003_convdia/dir_conv2dia
deleted file mode 100644
index 5706e5c9bdc1e19643e39a8561ecd1629906e305..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/001_2Drelief/003_convdia/dir_conv2dia
+++ /dev/null
@@ -1,6 +0,0 @@
-2
-EXPER.1.HYD2D.002
-EXPER.1.HYD2D.003
-EXPER.1.HYD2D.002-3d
-n
-0
diff --git a/MY_RUN/KTEST/001_2Drelief/003_convdia/run_conv2dia b/MY_RUN/KTEST/001_2Drelief/003_convdia/run_conv2dia
deleted file mode 100755
index b9a9c88712be5b10353d9b5475711b94cfda1bcd..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/001_2Drelief/003_convdia/run_conv2dia
+++ /dev/null
@@ -1,11 +0,0 @@
-#!/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
-set -e
-ln -sf ../002_mesonh/EXPER.1.HYD2D.00?.{des,lfi,nc} .
-rm -f EXPER.1.HYD2D.002-3d.{des,lfi,nc}
-time ${POSTRUN} conv2dia < dir_conv2dia
-
diff --git a/MY_RUN/KTEST/001_2Drelief/003_python/clean_python b/MY_RUN/KTEST/001_2Drelief/003_python/clean_python
new file mode 100755
index 0000000000000000000000000000000000000000..d75604a6ad8743f9782400155bb3def9cfd69410
--- /dev/null
+++ b/MY_RUN/KTEST/001_2Drelief/003_python/clean_python
@@ -0,0 +1,4 @@
+#!/bin/bash
+rm -f *.png *.pdf *.nc
+rm -Rf __pycache__
+find . -type l -delete
diff --git a/MY_RUN/KTEST/001_2Drelief/003_python/plot_001_2DRelief.py b/MY_RUN/KTEST/001_2Drelief/003_python/plot_001_2DRelief.py
new file mode 100644
index 0000000000000000000000000000000000000000..5dcaac4da7f51863a636489e918b519ce31d95a5
--- /dev/null
+++ b/MY_RUN/KTEST/001_2Drelief/003_python/plot_001_2DRelief.py
@@ -0,0 +1,267 @@
+#!/usr/bin/env python3
+"""
+@author: Quentin Rodier
+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_altitude1DVar
+import os
+import copy
+
+os.system('rm -f tempgraph*')
+#
+# User's parameter / Namelist
+#
+path=""
+LnameFiles = ['EXPER.1.HYD2D.002.nc', 'EXPER.1.HYD2D.003.nc']
+
+Dvar_input = {
+'f1':['ZS', 'UT', 'WT', 'THT', 'RVT','LSUM','LSTHM','CFLU','CFLW','ni_u','level','ZTOP', 'ni','level_w','time'],
+'f2':['ZS', 'UT', 'WT', 'THT', 'RVT','LSUM','LSTHM','CFLU','CFLW','ni_u','level','ZTOP', 'ni', 'level_w', 'time']
+}
+
+# Read the variables in the files
+Dvar = {}
+Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
+
+# Compute altitude variable in 2D with a 1D topography
+Dvar['f1']['altitude'], Dvar['f1']['ni_u_2D'] = comp_altitude1DVar(Dvar['f1']['UT'], Dvar['f1']['ZS'],Dvar['f1']['ZTOP'], Dvar['f1']['level'],Dvar['f1']['ni_u'])
+Dvar['f1']['altitude_w'], Dvar['f1']['ni_2D'] = comp_altitude1DVar(Dvar['f1']['WT'], Dvar['f1']['ZS'],Dvar['f1']['ZTOP'], Dvar['f1']['level_w'],Dvar['f1']['ni'])
+
+orog = Dvar['f1']['ZS'][101:158]
+
+################################################################
+######### PANEL 1 & 2
+###############################################################
+Panel1 = PanelPlot(2,2, [20,20],'001_2DRelief zoomed plots')
+
+Lplot = [ Dvar['f1']['UT'][:,101:158], Dvar['f2']['UT'][:,101:158], Dvar['f1']['THT'][:,101:158], Dvar['f2']['THT'][:,101:158] ,
+ Dvar['f1']['WT'][:,101:158], Dvar['f2']['WT'][:,101:158], Dvar['f1']['RVT'][:,101:158], Dvar['f2']['RVT'][:,101:158] ]
+
+LaxeX = [Dvar['f1']['ni_u_2D'][:,101:158]]*2
+LaxeX.extend([Dvar['f1']['ni_2D'][:,101:158] for i in range(6)]) #ni for all except UT
+
+LaxeZ = [Dvar['f1']['altitude'][:,101:158]]*4
+LaxeZ.extend([Dvar['f1']['altitude_w'][:,101:158] for i in range(2)]) #altitude_w only for WT
+LaxeZ.extend([Dvar['f1']['altitude'][:,101:158] for i in range(2)])
+
+Ltitle = ['u-wind UT', 'u-wind UT', 'Potential temperature THT', 'Potential temperature THT',
+ 'Vertical velocity WT','Vertical velocity WT','Water vapor mixing ratio RVT', 'Water vapor mixing ratio RVT']
+Lcbarlabel = ['m/s', 'm/s', 'K', 'K', 'm/s','m/s','g/kg','g/kg']
+Lxlab = ['x (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,8000.1)]*len(Lplot)
+Lminval = [5.2, 5.2, 285, 285, -0.4, -0.4, 0.2, 0.2]
+Lmaxval = [12.4, 12.4, 330, 330, 0.28, 0.28, 4.0, 4.0]
+Lstep = [0.4, 0.4, 2.5, 2.5, 0.04, 0.04, 0.2, 0.2]
+Lstepticks = Lstep
+Lfacconv = [1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1000.0, 1000.0]
+Ltime = [Dvar['f1']['time'], Dvar['f2']['time']]*4
+LcolorLine = ['gist_rainbow_r']*len(Lplot)
+Lpltype = ['c']*len(Lplot)
+fig1 = Panel1.psectionV(Lxx=LaxeX[0:4], Lzz=LaxeZ[0:4], Lvar=Lplot[0:4], Lxlab=Lxlab[0:4], Lylab=Lylab[0:4], Ltitle=Ltitle[0:4],Lpltype=Lpltype,
+ Lminval=Lminval[0:4], Lmaxval=Lmaxval[0:4], Lstep=Lstep[0:4], Lstepticks=Lstepticks[0:4], LcolorLine=LcolorLine[0:4],
+ Lcbarlabel=Lcbarlabel[0:4], Lfacconv=Lfacconv[0:4], orog=orog, Lylim=Lylim[0:4], colorbar=False, Ltime=Ltime[0:4])
+
+Panel1.save_graph(1,fig1)
+
+Panel2 = PanelPlot(2,2, [20,20],'001_2DRelief zoomed plots')
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+
+fig2 = Panel2.psectionV(Lxx=LaxeX[:4], Lzz=LaxeZ[:4], Lvar=Lplot[:4], Lxlab=Lxlab[:4], Lylab=Lylab[:4], Ltitle=Ltitle[:4],
+ Lminval=Lminval[:4], Lmaxval=Lmaxval[:4], Lstep=Lstep[:4], Lstepticks=Lstepticks[:4], Lcolormap=Lcolormap[:4],
+ Lcbarlabel=Lcbarlabel[:4], Lfacconv=Lfacconv[:4], orog=orog, Lylim=Lylim[:4], colorbar=True, Ltime=Ltime[:4])
+Panel2.save_graph(2,fig2)
+
+################################################################
+######### PANEL 3 & 4
+###############################################################
+Panel3 = PanelPlot(2,2, [20,20],'001_2DRelief full domain')
+
+Lplot = [ Dvar['f1']['UT'][:,:], Dvar['f2']['UT'][:,:], Dvar['f1']['THT'][:,:], Dvar['f2']['THT'][:,:] ,
+ Dvar['f1']['WT'][:,:], Dvar['f2']['WT'][:,:], Dvar['f1']['RVT'][:,:], Dvar['f2']['RVT'][:,:] ]
+
+orog = Dvar['f1']['ZS'][:]
+Lylim = [(0,15000.1)]*len(Lplot)
+LaxeX = [Dvar['f1']['ni_u_2D'][:,:]]*2
+LaxeX.extend([Dvar['f1']['ni_2D'][:,:] for i in range(6)]) #ni for all except UT
+
+LaxeZ = [Dvar['f1']['altitude'][:,:]]*4
+LaxeZ.extend([Dvar['f1']['altitude_w'][:,:] for i in range(2)]) #altitude_w only for WT
+LaxeZ.extend([Dvar['f1']['altitude'][:,:] for i in range(2)])
+Lpltype = ['c']*len(Lplot)
+
+fig3 = Panel3.psectionV(Lxx=LaxeX[0:4], Lzz=LaxeZ[0:4], Lvar=Lplot[0:4], Lxlab=Lxlab[0:4], Lylab=Lylab[0:4], Ltitle=Ltitle[0:4], Lpltype=Lpltype,
+ Lminval=Lminval[0:4], Lmaxval=Lmaxval[0:4], Lstep=Lstep[0:4], Lstepticks=Lstepticks[0:4], LcolorLine=LcolorLine[0:4],
+ Lcbarlabel=Lcbarlabel[0:4], Lfacconv=Lfacconv[0:4], orog=orog, Lylim=Lylim[0:4], colorbar=False, Ltime=Ltime[0:4])
+
+Panel3.save_graph(3,fig3)
+
+Panel4 = PanelPlot(2,2, [20,20],'001_2DRelief full domain')
+fig4 = Panel4.psectionV(Lxx=LaxeX[:4], Lzz=LaxeZ[:4], Lvar=Lplot[:4], Lxlab=Lxlab[:4], Lylab=Lylab[:4], Ltitle=Ltitle[:4],
+ Lminval=Lminval[:4], Lmaxval=Lmaxval[:4], Lstep=Lstep[:4], Lstepticks=Lstepticks[:4], Lcolormap=Lcolormap[:4],
+ Lcbarlabel=Lcbarlabel[:4], Lfacconv=Lfacconv[:4], orog=orog, Lylim=Lylim[:4], colorbar=True, Ltime=Ltime[:4])
+Panel4.save_graph(4,fig4)
+
+################################################################
+######### PANEL 5
+###############################################################
+Panel5 = PanelPlot(2,2, [20,20],'001_2DRelief')
+Lplot = [ Dvar['f1']['CFLU'][:,:], Dvar['f2']['CFLU'][:,:], Dvar['f1']['CFLW'][:,:], Dvar['f2']['CFLW'][:,:]]
+LaxeX = [Dvar['f1']['ni_2D'][:,:]]*4
+LaxeZ = [Dvar['f1']['altitude'][:,:]]*4
+Ltitle = ['CFLU','CFLU','CFLW','CFLW']
+Lcbarlabel = ['-']*len(Lplot)
+Lxlab = ['x (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,15000.1)]*len(Lplot)
+Lminval = [0.03,0.03,0.004,0.004]
+Lmaxval = [0.078,0.078,0.072,0.072]
+Lstep = [0.003, 0.003, 0.004,0.004]
+Lstepticks = Lstep
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+Ltime = [Dvar['f1']['time'], Dvar['f2']['time']]*2
+
+fig5 = Panel5.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)
+Panel5.save_graph(5,fig5)
+
+################################################################
+######### PANEL 6
+###############################################################
+Dvar['f1']['altitude'], Dvar['f1']['ni_u_2D'] = comp_altitude1DVar(Dvar['f1']['UT'], Dvar['f1']['ZS'],Dvar['f1']['ZTOP'], Dvar['f1']['level'],Dvar['f1']['ni_u'])
+Dvar['f1']['THT-LSTHM'] = copy.deepcopy(Dvar['f1']['THT'])
+Dvar['f1']['THT-LSTHM'] = Dvar['f1']['THT'] - Dvar['f1']['LSTHM']
+
+Dvar['f2']['altitude'], Dvar['f2']['ni_u_2D'] = comp_altitude1DVar(Dvar['f2']['UT'], Dvar['f2']['ZS'],Dvar['f2']['ZTOP'], Dvar['f2']['level'],Dvar['f2']['ni_u'])
+Dvar['f2']['THT-LSTHM'] = copy.deepcopy(Dvar['f2']['THT'])
+Dvar['f2']['THT-LSTHM'] = Dvar['f2']['THT'] - Dvar['f2']['LSTHM']
+
+Dvar['f1']['UT-LSUM'] = copy.deepcopy(Dvar['f1']['UT'])
+Dvar['f1']['UT-LSUM'] = Dvar['f1']['UT'] - Dvar['f1']['LSUM']
+
+Dvar['f2']['UT-LSUM'] = copy.deepcopy(Dvar['f2']['UT'])
+Dvar['f2']['UT-LSUM'] = Dvar['f2']['UT'] - Dvar['f2']['LSUM']
+
+Panel6 = PanelPlot(2,2, [20,20],'Profiles at the center (top of the topography)')
+
+Lplot = [ Dvar['f1']['WT'][:,127]]
+LaxeZ = [Dvar['f1']['altitude'][:,127]]*len(Lplot)
+Ltitle = ['WT and THT-LSTHM']*len(Lplot)
+Llinelabel = ['WT']
+Lxlab = ['velocity (m/s)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,15000.1)]*len(Lplot)
+Lxlim = [(-0.3,0.3)]
+Llinecolor = ['r']
+LaxisColor = Llinecolor
+Llvl = [0]*len(Lplot)
+Ltime = [Dvar['f1']['time']]
+fig6 = Panel6.pXY_lines(Lyy=LaxeZ, Lxx=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lylim=Lylim, Lxlim=Lxlim, Llinelabel=Llinelabel,
+ Llinecolor=Llinecolor, LaxisColor=LaxisColor, Ltime=Ltime)
+
+Lplot = [ Dvar['f1']['THT-LSTHM'][:,127]]
+Ltitle = []
+Llinelabel = ['THT - LSTHM ']
+Lxlab = ['theta perturb (K)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,15000.1)]*len(Lplot)
+Lxlim = [(-0.8,0.1)]
+Llinecolor = ['g']
+LaxisColor = Llinecolor
+Llvl = [0]*len(Lplot)
+fig7 = Panel6.pXY_lines(Lyy=LaxeZ, Lxx=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle,ax=fig6.axes, id_overlap=1,
+ Lylim=Lylim, Lxlim=Lxlim, Llinelabel=Llinelabel, Llinecolor=Llinecolor,LaxisColor=LaxisColor, Ltime=Ltime)
+
+Lplot = [ Dvar['f2']['WT'][:,127]]
+LaxeZ = [Dvar['f2']['altitude'][:,127]]*len(Lplot)
+Ltitle = ['WT and THT-LSTHM']*len(Lplot)
+Llinelabel = ['WT']
+Lxlab = ['velocity (m/s)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,15000.1)]*len(Lplot)
+Lxlim = [(-0.3,0.3)]
+Llinecolor = ['r']
+LaxisColor = Llinecolor
+Llvl = [0]*len(Lplot)
+Ltime = [Dvar['f2']['time']]
+fig8 = Panel6.pXY_lines(Lyy=LaxeZ, Lxx=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lylim=Lylim, Lxlim=Lxlim, Llinelabel=Llinelabel,
+ Llinecolor=Llinecolor, LaxisColor=LaxisColor, Ltime=Ltime, ax=fig7.axes)
+
+Lplot = [ Dvar['f2']['THT-LSTHM'][:,127]]
+Ltitle = []
+Llinelabel = ['THT - LSTHM ']
+Lxlab = ['theta perturb (K)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,15000.1)]*len(Lplot)
+Lxlim = [(-0.1,0.2)]
+Llinecolor = ['g']
+LaxisColor = Llinecolor
+Llvl = [0]*len(Lplot)
+fig9 = Panel6.pXY_lines(Lyy=LaxeZ, Lxx=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, ax=fig8.axes, id_overlap=1,
+ Lylim=Lylim, Lxlim=Lxlim, Llinelabel=Llinelabel, Llinecolor=Llinecolor, LaxisColor=LaxisColor, Ltime=Ltime)
+
+# WT and UT-LSUM
+Lplot = [ Dvar['f1']['WT'][:,127]]
+LaxeZ = [Dvar['f1']['altitude'][:,127]]*len(Lplot)
+Ltitle = ['WT and UT-LSUM']*len(Lplot)
+Llinelabel = ['WT']
+Lxlab = ['velocity (m/s)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,15000.1)]*len(Lplot)
+Lxlim = [(-0.3,0.3)]
+Llinecolor = ['r']
+LaxisColor = Llinecolor
+Llvl = [0]*len(Lplot)
+Ltime = [Dvar['f1']['time']]
+fig10 = Panel6.pXY_lines(Lyy=LaxeZ, Lxx=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lylim=Lylim, Lxlim=Lxlim, Llinelabel=Llinelabel,
+ Llinecolor=Llinecolor, LaxisColor=LaxisColor, Ltime=Ltime, ax=fig9.axes)
+
+Lplot = [ Dvar['f1']['UT-LSUM'][:,127]]
+Ltitle = []
+Llinelabel = ['UT - LSUM ']
+Lxlab = ['u perturb (K)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,15000.1)]*len(Lplot)
+Lxlim = [(-0.2,0.8)]
+Llinecolor = ['g']
+LaxisColor = Llinecolor
+Llvl = [0]*len(Lplot)
+fig11 = Panel6.pXY_lines(Lyy=LaxeZ, Lxx=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, ax=fig10.axes, id_overlap=1,
+ Lylim=Lylim, Lxlim=Lxlim, Llinelabel=Llinelabel, Llinecolor=Llinecolor,LaxisColor=LaxisColor, Ltime=Ltime)
+
+Lplot = [ Dvar['f2']['WT'][:,127]]
+LaxeZ = [Dvar['f2']['altitude'][:,127]]*len(Lplot)
+Ltitle = ['WT and UT-LSUM']*len(Lplot)
+Llinelabel = ['WT']
+Lxlab = ['velocity (m/s)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,15000.1)]*len(Lplot)
+Lxlim = [(-0.3,0.3)]
+Llinecolor = ['r']
+LaxisColor = Llinecolor
+Llvl = [0]*len(Lplot)
+Ltime = [Dvar['f2']['time']]
+fig12 = Panel6.pXY_lines(Lyy=LaxeZ, Lxx=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lylim=Lylim, Lxlim=Lxlim, Llinelabel=Llinelabel,
+ Llinecolor=Llinecolor, LaxisColor=LaxisColor, Ltime=Ltime, ax=fig11.axes)
+
+Lplot = [ Dvar['f2']['UT-LSUM'][:,127]]
+Ltitle = []
+Llinelabel = ['UT - LSUM ']
+Lxlab = ['u perturb (K)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,15000.1)]*len(Lplot)
+Lxlim = [(-2.0,2.0)]
+Llinecolor = ['g']
+LaxisColor = Llinecolor
+Llvl = [0]*len(Lplot)
+fig13 = Panel6.pXY_lines(Lyy=LaxeZ, Lxx=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle,ax=fig12.axes, id_overlap=1,
+ Lylim=Lylim, Lxlim=Lxlim, Llinelabel=Llinelabel, Llinecolor=Llinecolor, LaxisColor=LaxisColor, Ltime=Ltime)
+
+Panel6.save_graph(6,fig13)
diff --git a/MY_RUN/KTEST/001_2Drelief/003_python/run_python b/MY_RUN/KTEST/001_2Drelief/003_python/run_python
new file mode 100755
index 0000000000000000000000000000000000000000..19a55602d8dfa2a0a58421bc177ad2661b9e3e7e
--- /dev/null
+++ b/MY_RUN/KTEST/001_2Drelief/003_python/run_python
@@ -0,0 +1,21 @@
+#!/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
+set -e
+ln -sf ${SRC_MESONH}/src/LIB/Python/* .
+
+ln -sf ../002_mesonh/EXPER.1.HYD2D.002.nc .
+ln -sf ../002_mesonh/EXPER.1.HYD2D.003.nc .
+
+python3 plot_001_2DRelief.py
+${POSTRUN} display tempgraph1.png
+${POSTRUN} display tempgraph2.png
+${POSTRUN} display tempgraph3.png
+${POSTRUN} display tempgraph4.png
+${POSTRUN} display tempgraph5.png
+${POSTRUN} display tempgraph6.png
+#${POSTRUN} convert *.png 001_2DRelief.pdf
+#${POSTRUN} evince 001_2DRelief.pdf
diff --git a/MY_RUN/KTEST/001_2Drelief/004_diaprog/clean_diaprog b/MY_RUN/KTEST/001_2Drelief/004_diaprog/clean_diaprog
deleted file mode 100755
index fc74351aa873e3b64453331da8378d7fddf1b329..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/001_2Drelief/004_diaprog/clean_diaprog
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/bash
-rm -f EXPER.1.HYD2D*
-rm -f gmeta OUT*
-rm -f rm dir.*:*
diff --git a/MY_RUN/KTEST/001_2Drelief/004_diaprog/dir.2Drelief b/MY_RUN/KTEST/001_2Drelief/004_diaprog/dir.2Drelief
deleted file mode 100644
index 9e18e8271f7926ab8437f679b6005120345f83f8..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/001_2Drelief/004_diaprog/dir.2Drelief
+++ /dev/null
@@ -1,60 +0,0 @@
-visu
-! directives generales
-LINVWB=T
-! plages de couleur
-LCOLAREA=T LISO=F
-XLWCONT=2
-LMINMAX=T
-! label de toutes les iso
-NULBLL=0
-! pour obtenir des labels d isolignes
-XSIZEL=0.012
-! localisation du minmax dans le print minmax
-LMNMXLOC=T
-! High&Low
-NHI=0
-! label des axes en indices plutot que km en CH
-LINDAX=T
-NIGRNC=10
-! vecteur
-XVRL=0.15
-NISKIP=4
-! pas de dilatation de la composante W
-LDILW=F
-! min max vecteur
-LVECTMNMX=T
-! min max du zoom si NIMNMX<=0
-LCVZOOM=T
-! normaliser la longueur des vecteurs a 20m/s et tracer tous les vecteurs
-XVHC=-20
-LVSUPSCA=T
-! pour agrandir la legende a droite
-LVPTUSER=T
-XVPTL=0.1 XVPTR=0.9 !XVPTT=0.8
-!LVPTVUSER=T
-!XVPTVL=0.08 XVPTVR=0.78 XVPTVT=0.8
-!LVPTPVUSER=T
-!XVPTPVL=0.08 XVPTPVR=0.78 XVPTPVT=0.8
-!LVPTXYUSER=T
-!XVPTXYL=0.08 XVPTXYR=0.78 XVPTXYT=0.8
-
-_file_'EXPER.1.HYD2D.002-3d'
-LCOLINE=T LCOLAREA=F
-! coupe verticale
-nidebcou=2 njdebcou=1 nlangle=0 xhmin=0 xhmax=15000 nlmax=256 lpointg=.T.
-UT_CV_
-THT_CV_
-WT_CV_
-RVT_CV_
-CFLU_CV_
-CFLV_CV_
-CFLW_CV_
-!profile
-PROFILE=128
-WT_T_time1_PV__ON_THT_T_time1_PV__MINUS_LSTHM_T_time1_PV_
-WT_T_time2_PV__ON_THT_T_time1_PV__MINUS_LSTHM_T_time2_PV_
-WT_T_time1_PV__ON_UT_T_time2_PV__MINUS_LSUM_T_time1_PV_
-WT_T_time2_PV__ON_UT_T_time2_PV__MINUS_LSUM_T_time2_PV_
-!
-! a vous d indiquer vos directives
-quit
diff --git a/MY_RUN/KTEST/001_2Drelief/004_diaprog/run_diaprog b/MY_RUN/KTEST/001_2Drelief/004_diaprog/run_diaprog
deleted file mode 100755
index 03431de5cdfd18131b22dd89fef23b6c6cd3c2c3..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/001_2Drelief/004_diaprog/run_diaprog
+++ /dev/null
@@ -1,10 +0,0 @@
-#!/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
-set -e
-ln -sf ../003_convdia/EXPER.1.HYD2D.002-3d.{des,lfi} .
-rm -f dir.0*
-${POSTRUN} diaprog < dir.2Drelief
diff --git a/MY_RUN/KTEST/001_2Drelief/005_ncl/clean_ncl b/MY_RUN/KTEST/001_2Drelief/004_ncl/clean_ncl
similarity index 100%
rename from MY_RUN/KTEST/001_2Drelief/005_ncl/clean_ncl
rename to MY_RUN/KTEST/001_2Drelief/004_ncl/clean_ncl
diff --git a/MY_RUN/KTEST/001_2Drelief/005_ncl/plot_2Drelief.ncl b/MY_RUN/KTEST/001_2Drelief/004_ncl/plot_2Drelief.ncl
similarity index 89%
rename from MY_RUN/KTEST/001_2Drelief/005_ncl/plot_2Drelief.ncl
rename to MY_RUN/KTEST/001_2Drelief/004_ncl/plot_2Drelief.ncl
index 41eb6d0eabd1d0c4bba10d705dac87a3bd68e58b..bfeaa593ef6d570f496d8ae85a8a249fdbe9c8c2 100644
--- a/MY_RUN/KTEST/001_2Drelief/005_ncl/plot_2Drelief.ncl
+++ b/MY_RUN/KTEST/001_2Drelief/004_ncl/plot_2Drelief.ncl
@@ -23,35 +23,33 @@ begin
mdims = getfilevardimsizes(fichier1,"UT")
nd = dimsizes(mdims)
imax=mdims(nd-1)-2*jphext
- jmax=mdims(nd-2)-2*jphext
- kmax=mdims(nd-3)-2
+ kmax=mdims(nd-2)-2
-
-zs = fichier1->ZS(0,jphext:imax+jphext-1) ; ZS
+zs = fichier1->ZS(jphext:imax+jphext-1) ; ZS
zhat = fichier1->ZHAT(1:kmax+1) ; ZHAT
xhat = fichier1->XHAT(jphext:imax+jphext-1+1) ; XHAT
-lsthm1 = fichier1->LSTHM(0,1:kmax,0,jphext:imax+jphext-1) ; LSTHM
+lsthm1 = fichier1->LSTHM(0,1:kmax,jphext:imax+jphext-1) ; LSTHM
lsthm1@long_name="LSTHM"
lsthm1@units="K"
-lsum1_old = fichier1->LSUM(0,1:kmax,0,jphext:imax+jphext-1+1) ; LSUM
-wt1_old= fichier1->WT(0,1:kmax+1,0,jphext:imax+jphext-1) ; WT
-ut1_old= fichier1->UT(0,1:kmax,0,jphext:imax+jphext-1+1) ; UT
+lsum1_old = fichier1->LSUM(0,1:kmax,jphext:imax+jphext-1+1) ; LSUM
+wt1_old= fichier1->WT(0,1:kmax+1,jphext:imax+jphext-1) ; WT
+ut1_old= fichier1->UT(0,1:kmax,jphext:imax+jphext-1+1) ; UT
-tht1= fichier1->THT(0,1:kmax,0,jphext:imax+jphext-1) ; THT
+tht1= fichier1->THT(0,1:kmax,jphext:imax+jphext-1) ; THT
tht1@long_name="Potential Temperature"
tht1@units="K"
-rvt1= fichier1->RVT(0,1:kmax,0,jphext:imax+jphext-1) ; RVT
+rvt1= fichier1->RVT(0,1:kmax,jphext:imax+jphext-1) ; RVT
rvt1@long_name="Vapor mixing ratio"
rvt1@units="g/kg"
-cflu1= fichier1->CFLU(0,1:kmax,0,jphext:imax+jphext-1) ; CFLU
+cflu1= fichier1->CFLU(0,1:kmax,jphext:imax+jphext-1) ; CFLU
cflu1@long_name="CFLU"
cflu1@units="-"
-cflw1= fichier1->CFLW(0,1:kmax,0,jphext:imax+jphext-1) ; CFLW
+cflw1= fichier1->CFLW(0,1:kmax,jphext:imax+jphext-1) ; CFLW
cflw1@long_name="CFLW"
cflw1@units=" "
@@ -60,27 +58,27 @@ SS1=fichier1->DTCUR
;YYYYDDMM2= fichier2->DTCUR__TDATE
SS2=fichier2->DTCUR
-lsthm2 = fichier2->LSTHM(0,1:kmax,0,jphext:imax+jphext-1) ; LSTHM
+lsthm2 = fichier2->LSTHM(0,1:kmax,jphext:imax+jphext-1) ; LSTHM
lsthm2@long_name="LSTHM"
lsthm2@units="K"
-lsum2_old = fichier2->LSUM(0,1:kmax,0,jphext:imax+jphext-1+1) ; LSUM
-wt2_old= fichier2->WT(0,1:kmax+1,0,jphext:imax+jphext-1) ; WT
-ut2_old= fichier2->UT(0,1:kmax,0,jphext:imax+jphext-1+1) ; UT
+lsum2_old = fichier2->LSUM(0,1:kmax,jphext:imax+jphext-1+1) ; LSUM
+wt2_old= fichier2->WT(0,1:kmax+1,jphext:imax+jphext-1) ; WT
+ut2_old= fichier2->UT(0,1:kmax,jphext:imax+jphext-1+1) ; UT
-tht2= fichier2->THT(0,1:kmax,0,jphext:imax+jphext-1) ; THT
+tht2= fichier2->THT(0,1:kmax,jphext:imax+jphext-1) ; THT
tht2@long_name="Potential Temperature"
tht2@units="K"
-rvt2= fichier2->RVT(0,1:kmax,0,jphext:imax+jphext-1) ; RVT
+rvt2= fichier2->RVT(0,1:kmax,jphext:imax+jphext-1) ; RVT
rvt2@long_name="Vapor mixing ratio"
rvt2@units="g/kg"
-cflu2= fichier2->CFLU(0,1:kmax,0,jphext:imax+jphext-1) ; CFLU
+cflu2= fichier2->CFLU(0,1:kmax,jphext:imax+jphext-1) ; CFLU
cflu2@long_name="CFLU"
cflu2@units="-"
-cflw2= fichier2->CFLW(0,1:kmax,0,jphext:imax+jphext-1) ; CFLW
+cflw2= fichier2->CFLW(0,1:kmax,jphext:imax+jphext-1) ; CFLW
cflw2@long_name="CFLW"
cflw2@units=" "
diff --git a/MY_RUN/KTEST/001_2Drelief/005_ncl/run_ncl b/MY_RUN/KTEST/001_2Drelief/004_ncl/run_ncl
similarity index 100%
rename from MY_RUN/KTEST/001_2Drelief/005_ncl/run_ncl
rename to MY_RUN/KTEST/001_2Drelief/004_ncl/run_ncl
diff --git a/MY_RUN/KTEST/001_2Drelief/Makefile b/MY_RUN/KTEST/001_2Drelief/Makefile
index e50e3b333d17d9505c803b9ba51ca34fcdcaafea..13deef8a4562ab8cad879c74b3b6ce78024bd9c2 100644
--- a/MY_RUN/KTEST/001_2Drelief/Makefile
+++ b/MY_RUN/KTEST/001_2Drelief/Makefile
@@ -1,13 +1,18 @@
all:
cd 001_prep_ideal_case && run_prep_ideal_case_xyz
cd 002_mesonh && run_mesonh_xyz
- cd 003_convdia && run_conv2dia
- cd 004_diaprog && run_diaprog
- cd 005_ncl && run_ncl
+ifneq "$(MNH_PYTHON)" "NO"
+ cd 003_python && run_python
+endif
+ cd 004_ncl && run_ncl
clean:
cd 001_prep_ideal_case && clean_prep_ideal_case_xyz
cd 002_mesonh && clean_mesonh_xyz
- cd 003_convdia && clean_conv2dia
- cd 004_diaprog && clean_diaprog
- cd 005_ncl && clean_ncl
+ifneq "$(MNH_PYTHON)" "NO"
+ cd 003_python && clean_python
+endif
+ cd 004_ncl && clean_ncl
+
+python:
+ cd 003_python && run_python
diff --git a/MY_RUN/KTEST/002_3Drelief/003_convdia/clean_conv2dia b/MY_RUN/KTEST/002_3Drelief/003_convdia/clean_conv2dia
deleted file mode 100755
index 4736bbeef2a40269d80176c3795d819bb2a8878b..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/002_3Drelief/003_convdia/clean_conv2dia
+++ /dev/null
@@ -1,5 +0,0 @@
-#!/bin/bash
-set -x
-rm -f REL3D.1.EXP01.002.{des,lfi,nc}
-rm -f REL3D.1.EXP01.002dg.{des,lfi,nc}
-rm -f dirconv FICJD LISTING_DIA OUT_DIA pipe_name
diff --git a/MY_RUN/KTEST/002_3Drelief/003_convdia/dir_conv2dia b/MY_RUN/KTEST/002_3Drelief/003_convdia/dir_conv2dia
deleted file mode 100644
index 5ba8fe21114ec45e4d73c53c52274b23049da4f8..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/002_3Drelief/003_convdia/dir_conv2dia
+++ /dev/null
@@ -1,6 +0,0 @@
-1
-REL3D.1.EXP01.002
-REL3D.1.EXP01.002dg
-n
-n
-0
diff --git a/MY_RUN/KTEST/002_3Drelief/003_python/clean_python b/MY_RUN/KTEST/002_3Drelief/003_python/clean_python
new file mode 100755
index 0000000000000000000000000000000000000000..d75604a6ad8743f9782400155bb3def9cfd69410
--- /dev/null
+++ b/MY_RUN/KTEST/002_3Drelief/003_python/clean_python
@@ -0,0 +1,4 @@
+#!/bin/bash
+rm -f *.png *.pdf *.nc
+rm -Rf __pycache__
+find . -type l -delete
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
new file mode 100644
index 0000000000000000000000000000000000000000..6f57fae700bef1f17d9783d15172b05175cf3e73
--- /dev/null
+++ b/MY_RUN/KTEST/002_3Drelief/003_python/plot_002_3DRelief.py
@@ -0,0 +1,69 @@
+#!/usr/bin/env python3
+"""
+@author: Quentin Rodier
+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
+import os
+
+os.system('rm -f tempgraph*')
+#
+# User's parameter / Namelist
+#
+path=""
+
+LnameFiles = ['REL3D.1.EXP01.002.nc']
+
+Dvar_input = {'f1':['ZS', 'UT', 'WT','ni_u','nj_u','level','ZTOP', 'ni','nj','level_w','time']}
+
+# Read the variables in the files
+Dvar = {}
+Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
+
+# Compute altitude variable in 3D with a 2D topography
+Dvar['f1']['altitude'], Dvar['f1']['ni_u_3D'], Dvar['f1']['nj_u_3D'] = comp_altitude2DVar(Dvar['f1']['UT'], Dvar['f1']['ZS'],Dvar['f1']['ZTOP'], Dvar['f1']['level'], Dvar['f1']['ni_u'], Dvar['f1']['nj_u'])
+Dvar['f1']['altitude_w'], Dvar['f1']['ni_3D'], Dvar['f1']['nj_3D'] = comp_altitude2DVar(Dvar['f1']['WT'], Dvar['f1']['ZS'],Dvar['f1']['ZTOP'], Dvar['f1']['level_w'],Dvar['f1']['ni'], Dvar['f1']['nj'])
+
+orog = Dvar['f1']['ZS'][15,:]
+
+################################################################
+######### PANEL 1
+###############################################################
+Panel1 = PanelPlot(2,2, [20,20],'003_2DRelief vertical and horizontal sections')
+
+Lplot = [ Dvar['f1']['UT'][:,15,:], Dvar['f1']['WT'][:,15,:]]
+LaxeX = [Dvar['f1']['ni_u_3D'][:,15,:], Dvar['f1']['ni_3D'][:,15,:]]
+LaxeZ = [Dvar['f1']['altitude'][:,15,:], Dvar['f1']['altitude_w'][:,15,:]]
+Ltitle = ['u-wind UT', 'Vertical velocity WT',]
+Lcbarlabel = ['m/s']*len(Lplot)
+Lxlab = ['x (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,10000.1)]*len(Lplot)
+Lminval = [8, -1.2]
+Lmaxval = [14, 0.9]
+Lstep = [0.25, 0.1]
+Lstepticks = Lstep
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+Ltime = [Dvar['f1']['time']]*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)
+
+# Horizontal cross-section
+Lplot = [ Dvar['f1']['UT'], Dvar['f1']['WT']]
+Ltitle = ['u-wind UT at K=2', 'Vertical velocity WT at K=2',]
+LaxeX = [Dvar['f1']['ni_u'], Dvar['f1']['ni']]
+LaxeY = [Dvar['f1']['nj_u'], Dvar['f1']['nj']]
+Llvl = [0]*len(Lplot)
+
+fig2 = Panel1.psectionH(lon=LaxeX, lat=LaxeY, Lvar=Lplot, Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel,
+ colorbar=True, Ltime=Ltime, ax=fig1.axes)
+
+Panel1.save_graph(1,fig2)
diff --git a/MY_RUN/KTEST/002_3Drelief/004_diaprog/run_diaprog b/MY_RUN/KTEST/002_3Drelief/003_python/run_python
similarity index 56%
rename from MY_RUN/KTEST/002_3Drelief/004_diaprog/run_diaprog
rename to MY_RUN/KTEST/002_3Drelief/003_python/run_python
index 6fb30e42f4fd801ec4fff45781196b0530e9af1c..7f4f816d956c462a75143af36c86fe34e1194970 100755
--- a/MY_RUN/KTEST/002_3Drelief/004_diaprog/run_diaprog
+++ b/MY_RUN/KTEST/002_3Drelief/003_python/run_python
@@ -5,8 +5,10 @@
#MNH_LIC for details. version 1.
set -x
set -e
-ln -sf ../003_convdia/REL3D.1.EXP01.002dg.{des,lfi} .
-#ln -sf ../003_convdia/REL3D_autre_run.{des,lfi} .
-rm -f dir.0*
-${POSTRUN} diaprog < dir_3Drelief
+ln -sf ${SRC_MESONH}/src/LIB/Python/* .
+ln -sf ../002_mesonh/REL3D.1.EXP01.002.nc .
+python3 plot_002_3DRelief.py
+${POSTRUN} display tempgraph1.png
+#${POSTRUN} convert *.png 002_3DRelief.pdf
+#${POSTRUN} evince 002_3DRelief.pdf
diff --git a/MY_RUN/KTEST/002_3Drelief/004_diaprog/clean_diaprog b/MY_RUN/KTEST/002_3Drelief/004_diaprog/clean_diaprog
deleted file mode 100755
index f1904b54b7017b3dbb9cb024ff32bc31a2672c0e..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/002_3Drelief/004_diaprog/clean_diaprog
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/bash
-set -x
-rm -f dir.* gmeta REL3D* OUT_DIA
diff --git a/MY_RUN/KTEST/002_3Drelief/004_diaprog/dir_3Drelief b/MY_RUN/KTEST/002_3Drelief/004_diaprog/dir_3Drelief
deleted file mode 100644
index 7181757a989b615e609ee3ca41021f23ab1b379b..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/002_3Drelief/004_diaprog/dir_3Drelief
+++ /dev/null
@@ -1,13 +0,0 @@
-visu
-_file1_'REL3D.1.EXP01.002dg'
-print groups
-UT_k_2_file1_
-liso=f
-lcolarea=t
-UT_k_2_file1_
-quit
-_file2_'REL3D_autre_run'
-UT_k_2_file2_
-UT_k_2_file1__minus_UT_k_2_file2_
-quit
-
diff --git a/MY_RUN/KTEST/002_3Drelief/004_ncl/clean_ncl b/MY_RUN/KTEST/002_3Drelief/004_ncl/clean_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..8b82cdb8e78561ded4ce43712ce50580c6423c07
--- /dev/null
+++ b/MY_RUN/KTEST/002_3Drelief/004_ncl/clean_ncl
@@ -0,0 +1,2 @@
+#!/bin/bash
+rm -f *.nc *.ps *.png
diff --git a/MY_RUN/KTEST/002_3Drelief/005_ncl/plot_3Drelief.ncl b/MY_RUN/KTEST/002_3Drelief/004_ncl/plot_3Drelief.ncl
similarity index 100%
rename from MY_RUN/KTEST/002_3Drelief/005_ncl/plot_3Drelief.ncl
rename to MY_RUN/KTEST/002_3Drelief/004_ncl/plot_3Drelief.ncl
diff --git a/MY_RUN/KTEST/002_3Drelief/005_ncl/run_ncl b/MY_RUN/KTEST/002_3Drelief/004_ncl/run_ncl
similarity index 100%
rename from MY_RUN/KTEST/002_3Drelief/005_ncl/run_ncl
rename to MY_RUN/KTEST/002_3Drelief/004_ncl/run_ncl
diff --git a/MY_RUN/KTEST/002_3Drelief/005_ncl/clean_ncl b/MY_RUN/KTEST/002_3Drelief/005_ncl/clean_ncl
deleted file mode 100755
index 233231e1eee2bac48853a70db7af884c517b70bd..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/002_3Drelief/005_ncl/clean_ncl
+++ /dev/null
@@ -1,2 +0,0 @@
-#!/bin/bash
-rm -f *.nc *.ps
diff --git a/MY_RUN/KTEST/002_3Drelief/Makefile b/MY_RUN/KTEST/002_3Drelief/Makefile
index e50e3b333d17d9505c803b9ba51ca34fcdcaafea..76fa1761ed35a74ba7d10078fd7ae9ea9397be2c 100644
--- a/MY_RUN/KTEST/002_3Drelief/Makefile
+++ b/MY_RUN/KTEST/002_3Drelief/Makefile
@@ -1,13 +1,18 @@
all:
cd 001_prep_ideal_case && run_prep_ideal_case_xyz
cd 002_mesonh && run_mesonh_xyz
- cd 003_convdia && run_conv2dia
- cd 004_diaprog && run_diaprog
- cd 005_ncl && run_ncl
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 003_python && run_python
+ endif
+ cd 004_ncl && run_ncl
clean:
cd 001_prep_ideal_case && clean_prep_ideal_case_xyz
cd 002_mesonh && clean_mesonh_xyz
- cd 003_convdia && clean_conv2dia
- cd 004_diaprog && clean_diaprog
- cd 005_ncl && clean_ncl
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 003_python && clean_python
+ endif
+ cd 004_ncl && clean_ncl
+
+python:
+ cd 003_python && run_python
diff --git a/MY_RUN/KTEST/003_KW78/003_convdia/clean_conv2dia b/MY_RUN/KTEST/003_KW78/003_convdia/clean_conv2dia
deleted file mode 100755
index 9ba04f4e6b5d7baf4a3832abff01338eaff2dac4..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/003_KW78/003_convdia/clean_conv2dia
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/bash
-set -x
-rm -f KWRAI.*
-rm -f dirconv FICJD LISTING_DIA OUT_DIA pipe_name
diff --git a/MY_RUN/KTEST/003_KW78/003_convdia/dir_conv2dia b/MY_RUN/KTEST/003_KW78/003_convdia/dir_conv2dia
deleted file mode 100644
index b6310ba659e65bdc1ac6cfec31770957b9c07690..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/003_KW78/003_convdia/dir_conv2dia
+++ /dev/null
@@ -1,6 +0,0 @@
-1
-KWRAI.1.SEG01.004
-KWRAI.1.SEG01.004dg
-n
-n
-0
diff --git a/MY_RUN/KTEST/003_KW78/003_diag/DIAG1.nam b/MY_RUN/KTEST/003_KW78/003_diag/DIAG1.nam
new file mode 100644
index 0000000000000000000000000000000000000000..bde6301da864476969b9ded6ec83edc699b3ad1c
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/003_diag/DIAG1.nam
@@ -0,0 +1,14 @@
+&NAM_CONFIO LCDF4=T, LLFIOUT=F, LLFIREAD=F /
+&NAM_CONFZ
+ ! NZ_VERB=5 , NZ_PROC=0 , NB_PROCIO_R=8 , NB_PROCIO_W=1
+/
+&NAM_DIAG
+ LCLSTR=T,
+ LBOTUP=T,
+ CFIELD='W',
+ XTHRES=10.,
+ LISOAL=T, XISOAL(1)=3000, XISOAL(2)=5000
+ /
+&NAM_DIAG_FILE YINIFILE(1) = "KWRAI.1.SEG01.004" ,
+ YSUFFIX='dia' /
+
diff --git a/MY_RUN/KTEST/003_KW78/003_diag/clean_diag_xyz b/MY_RUN/KTEST/003_KW78/003_diag/clean_diag_xyz
new file mode 100755
index 0000000000000000000000000000000000000000..19b1bf34eb5ca4964c57e9b503ef15a7e940213f
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/003_diag/clean_diag_xyz
@@ -0,0 +1,5 @@
+#!/bin/bash
+set -x
+rm -f KWRAI* OUTPUT_LISTING* OUTPUT_TRANSFER pipe* *.tex
+rm -f file_for_xtransfer
+
diff --git a/MY_RUN/KTEST/003_KW78/003_diag/diag.nam b/MY_RUN/KTEST/003_KW78/003_diag/diag.nam
new file mode 100644
index 0000000000000000000000000000000000000000..a1252a72b1b6ef1bf8d6ad58ebe2ffd962e53fc6
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/003_diag/diag.nam
@@ -0,0 +1,12 @@
+
+exemple 1, identification des ascendances > 10 m/s
+
+&NAM_DIAG LCLSTR = T, LBOTUP = T, CFIELD = "W", XTHRES = 10. /
+
+
+
+exemple 2, identification des overshoots
+
+&NAM_DIAG LCLSTR = T, LBOTUP = F, CFIELD = "CLOUD", XTHRES = 0.00001 /
+
+NB: par défaut CLOUD prend en compte Rc+Ri+Rs+Rg i.e. cloud water and ice, graupel and snow
diff --git a/MY_RUN/KTEST/004_Reunion/004_convdia/run_conv2dia b/MY_RUN/KTEST/003_KW78/003_diag/run_diag_xyz
similarity index 67%
rename from MY_RUN/KTEST/004_Reunion/004_convdia/run_conv2dia
rename to MY_RUN/KTEST/003_KW78/003_diag/run_diag_xyz
index 2ce0351394da80ab713f896060faec8d52a9e013..b36518443ebec0529cd0d53901f3adffe95dc551 100755
--- a/MY_RUN/KTEST/004_Reunion/004_convdia/run_conv2dia
+++ b/MY_RUN/KTEST/003_KW78/003_diag/run_diag_xyz
@@ -5,7 +5,11 @@
#MNH_LIC for details. version 1.
set -x
set -e
-ln -sf ../003_mesonh/REUNI.1.00A20.004.{des,lfi,nc} .
-rm -f REUNI.1.00A20.004dg.{des,lfi,nc}
-${POSTRUN} conv2dia < dir_conv2dia
+rm -f KWRAI* OUT*
+#
+#
+ln -sf ../002_mesonh/KWRAI.1.SEG01.004.des .
+ln -sf ../002_mesonh/KWRAI.1.SEG01.004.*nc .
+
+time ${MPIRUN} DIAG${XYZ}
diff --git a/MY_RUN/KTEST/003_KW78/004_diaprog/clean_diaprog b/MY_RUN/KTEST/003_KW78/004_diaprog/clean_diaprog
deleted file mode 100755
index f4e896519cb1fae63eb774815ca52c295b3e1c9a..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/003_KW78/004_diaprog/clean_diaprog
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/bash
-set -x
-rm -f dir.* gmeta KWRAI.1.SEG01.00* OUT_DIA
diff --git a/MY_RUN/KTEST/003_KW78/004_diaprog/dir_KW78 b/MY_RUN/KTEST/003_KW78/004_diaprog/dir_KW78
deleted file mode 100644
index f23437c1cdb46db72e54e3be4890ccbcbb5ae125..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/003_KW78/004_diaprog/dir_KW78
+++ /dev/null
@@ -1,78 +0,0 @@
-visu
-! directives de presentation
-LINVWB=T NIGRNC=10 nhi=0 lminmax=t xsizel=0.015
-! plages de couleur, pas d isolignes
-LCOLAREA=T LISO=F
-! gestion des vecteurs (1 vecteur sur 4)
-NISKIP=4 XVRL=0.15
-! 1er fichier a ouvrir
-_file1_'KWRAI.1.SEG01.004dg'
-! couleur de fond pour le 1er intervalle
-LCOLZERO=T NCOLZERO=1
-! precipitations explicites instantanees
-NIMNMX=1
-XISOMIN_INPRR=0
-XISOMAX_INPRR=6
-XDIAINT_INPRR=0.250
-INPRR
-! precipitations explicites cumulees
-XISOMIN_ACPRR=0
-XISOMAX_ACPRR=0.150
-XDIAINT_ACPRR=0.005
-ACPRR
-! trace de tous les vecteurs
-NISKIP=1
-! superposition de la pression et des vecteurs de vent au niveau K=2
-XISOMIN_PABST=98250
-XISOMAX_PABST=98350
-XDIAINT_PABST=5
-PABST_K_2_ON_UTVT_K_2
-! superposition du rapport d eau nuageuse et des vecteurs vent a 3000m
-XISOMIN_RCT=0
-XISOMAX_RCT=0.003
-XDIAINT_RCT=0.00005
-RCT_Z_3000_ON_UTVT_Z_3000
-! superposition du rapport d eau nuageuse et des vecteurs vent a 5000m
-RCT_Z_5000_ON_UTVT_Z_5000
-! definition d une coupe verticale
-NIDEBCOU=5 NJDEBCOU=2 NLANGLE=47 NLMAX=21
-! trace de la coupe verticale dans le plan horizontal
-LTRACECV=T
-! rapport de vapeur et vecteurs vent dans la coupe verticale
-XISOMIN_RVT=0
-XISOMAX_RVT=0.015
-XDIAINT_RVT=0.0005
-RVT_CV__ON_ULTWT_CV_
-! plus de trace de la coupe verticale
-LTRACECV=F
-! rapport de melange d eau nuageuse et rapport d eau de pluie
-XISOMIN_RRT=0.00025
-XISOMAX_RRT=0.005
-XDIAINT_RRT=0.00025
-XISOMIN_RCT=0.
-XISOMAX_RCT=0.001
-XDIAINT_RCT=0.00005
-RCT_CV__ON_RRT_CV_
-! difference pour la temperature potentielle avec le champ initial
-XISOMIN=-4
-XISOMAX=4
-XDIAINT=0.2
-THT_CV__MINUS_LSTHM_CV_
-! vitesse verticale en coupe verticale
-XISOMIN_WT=-4
-XISOMAX_WT=10
-XDIAINT_WT=0.5
-WT_CV_
-! definition d une autre coupe verticale
-NIDEBCOU=15 NJDEBCOU=2 NLANGLE=90 NLMAX=23
-LTRACECV=T
-RVT_CV__ON_ULTWT_CV_
-LTRACECV=F
-RCT_CV__ON_RRT_CV_
-XISOMIN=-4
-XISOMAX=4
-XDIAINT=0.2
-THT_CV__MINUS_LSTHM_CV_
-WT_CV_
-quit
-
diff --git a/MY_RUN/KTEST/003_KW78/004_diaprog/run_diaprog b/MY_RUN/KTEST/003_KW78/004_diaprog/run_diaprog
deleted file mode 100755
index 365ecc11eabe264469d38e41a4d1e10a743215ac..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/003_KW78/004_diaprog/run_diaprog
+++ /dev/null
@@ -1,11 +0,0 @@
-#!/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
-set -e
-ln -sf ../003_convdia/KWRAI.1.SEG01.004dg.{des,lfi} .
-rm -f dir.*
-${POSTRUN} diaprog < dir_KW78
-#idt gmeta
diff --git a/MY_RUN/KTEST/003_KW78/004_python/clean_python b/MY_RUN/KTEST/003_KW78/004_python/clean_python
new file mode 100755
index 0000000000000000000000000000000000000000..d75604a6ad8743f9782400155bb3def9cfd69410
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/004_python/clean_python
@@ -0,0 +1,4 @@
+#!/bin/bash
+rm -f *.png *.pdf *.nc
+rm -Rf __pycache__
+find . -type l -delete
diff --git a/MY_RUN/KTEST/003_KW78/004_python/plot_003_KW78.py b/MY_RUN/KTEST/003_KW78/004_python/plot_003_KW78.py
new file mode 100644
index 0000000000000000000000000000000000000000..9ec2501f9495c586925e8dc649351a883f6db275
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/004_python/plot_003_KW78.py
@@ -0,0 +1,229 @@
+#!/usr/bin/env python3
+"""
+
+@author: Quentin Rodier
+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, oblique_proj, windvec_verti_proj, mean_operator
+import math
+import os
+
+os.system('rm -f tempgraph*')
+#
+# User's parameter / Namelist
+#
+path=""
+
+LnameFiles = ['KWRAI.1.SEG01.004.nc','KWRAI.1.SEG01.004dia.nc' ]
+
+Dvar_input = {
+'f1':['ZS', 'UT','VT', 'WT','THT',
+ 'ni_u','nj_u','level','ZTOP', 'ni','nj','level_w','time',
+ 'INPRR','ACPRR','PABST','RCT','RVT','RRT','LSTHM'],
+'f2':['ALT_CLOUD', 'ALT_U', 'ALT_V', 'ni','nj']}
+
+# Read the variables in the files
+Dvar = {}
+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)
+
+Lplot = [ Dvar['f1']['INPRR'], Dvar['f1']['ACPRR'], Dvar['f1']['PABST'],Dvar['f2']['ALT_CLOUD'],Dvar['f2']['ALT_CLOUD'] ]
+
+LaxeX = [Dvar['f1']['ni']]*len(Lplot)
+LaxeY = [Dvar['f1']['nj']]*len(Lplot)
+Ltitle = ['Instantaneous precipitation INPRR', 'Accumulated precipitation ACPRR','Absolute pressure','Mixing ratio of liquid droplets at z=3000m','Mixing ratio of liquid droplets at z=5000m' ]
+Lcbarlabel = ['mm/h', 'mm','hPa','g/kg','g/kg']
+Lxlab = ['x (m)']*len(Lplot)
+Lylab = ['y (m)']*len(Lplot)
+Lminval = [0, 0, 982.25, 0, 0]
+Lmaxval = [6.25, 0.15, 983.55, 3.0, 3.0]
+Lstep = [0.25, 0.005, 0.05, 0.05, 0.05]
+Lstepticks = [0.5, 0.02, 0.2, 0.5, 0.5]
+Lfacconv = [1, 1, 1./100.0,1,1]
+Lcolormap = ['gist_ncar_r']*len(Lplot)
+Llvl = [0,0,0,0,1]
+Ltime = [Dvar['f1']['time']]*len(Lplot)
+LaddWhite = [True]*len(Lplot)
+Lpltype = ['cf']*len(Lplot)
+
+fig1 = Panel1.psectionH(lon=LaxeX, lat=LaxeY, Lvar=Lplot, Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
+ Ltime=Ltime, LaddWhite_cm=LaddWhite)
+fig1.tight_layout()
+
+# Wind vectors
+Lplot1 = [ Dvar['f1']['UT'], Dvar['f2']['ALT_U'], Dvar['f2']['ALT_U']]
+Lplot2 = [ Dvar['f1']['VT'], Dvar['f2']['ALT_V'], Dvar['f2']['ALT_V']]
+Ltitle = ['Wind at K=2', 'Wind at 3000m', 'Wind at 5000m']
+Lxlab = ['x (m)']*len(Lplot)
+Lylab = ['y (m)']*len(Lplot)
+Llegendval = [10,10,10]
+Lcbarlabel = ['m/s']*len(Lplot)
+Larrowstep = [1]*len(Lplot)
+Lwidth = [0.002]*len(Lplot)
+Lcolor = ['black']*len(Lplot)
+Llvl = [0,0,1]
+lon = [Dvar['f1']['ni_u'], Dvar['f2']['ni'], Dvar['f2']['ni'] ]
+lat = [Dvar['f1']['nj_u'], Dvar['f2']['nj'], Dvar['f2']['nj'] ]
+Lscale = [200]*len(Lplot)
+fig2 = Panel1.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Lvar2=Lplot2, Lcarte=[500,23500,500,23500], Llevel=Llvl,
+ Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep,
+ Lcolor=Lcolor, Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[4,6,8], ax=fig1.axes, Lscale=Lscale)
+# Oblique projection
+i_beg, j_beg = (3,0)
+i_end, j_end = (22,21)
+# Black line
+Panel1.addLine(fig2.axes[6],[Dvar['f1']['ni'][i_beg],Dvar['f1']['nj'][j_beg]],[Dvar['f1']['ni'][i_end],Dvar['f1']['nj'][j_end]],'black',2)
+Panel1.save_graph(1,fig2)
+
+################################################################
+######### PANEL 2 : Oblique projection
+###############################################################
+Panel2 = PanelPlot(2,2, [17,17],'Oblique section (angle = 47)', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, lateralminmaxpad=0.97)
+
+Dvar['f1']['THT-LSTHM'] = Dvar['f1']['THT'] - Dvar['f1']['LSTHM']
+
+tomass = mean_operator()
+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)
+angle_sec1, WT_sec1, axe_m1 = oblique_proj(Dvar['f1']['WM'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, RCT_sec1, axe_m1 = oblique_proj(Dvar['f1']['RCT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, RRT_sec1, axe_m1 = oblique_proj(Dvar['f1']['RRT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, anoTHT_sec1, axe_m1 = oblique_proj(Dvar['f1']['THT-LSTHM'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+
+Lplot = [RVT_sec1, RCT_sec1, anoTHT_sec1, WT_sec1]
+LaxeX = [axe_m1]*len(Lplot)
+LaxeZ = [Dvar['f1']['level'], Dvar['f1']['level'], Dvar['f1']['level'],Dvar['f1']['level_w']]
+Ltitle = ['Water vapor mixing ratio', 'Liquid cloud mxing ratio', 'Potential temperature anomaly', 'Vertical velocity']
+Lcbarlabel = ['g/kg','g/kg', 'K', 'm/s']
+Lxlab = ['distance (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lminval = [0., 0., -5, -18]
+Lmaxval = [15, 3.0, 5, 18]
+Lstep = [0.5, 0.05, 0.2, 0.5]
+Lstepticks = [1, 0.2, 1, 2.5]
+Lfacconv = [1000, 1000, 1, 1]
+Lcolormap = ['gist_rainbow_r','gist_rainbow_r', 'seismic','seismic']
+Ltime = [Dvar['f1']['time']]*len(Lplot)
+Lpltype = ['cf']*len(Lplot)
+LaddWhite = [True, True, False, False]
+
+fig3 = 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,
+ Ltime=Ltime, Lpltype=Lpltype, LaddWhite_cm=LaddWhite)
+
+Lplot1 = [ WIND_sec1]
+Lplot2 = [ WT_sec1]
+Ltitle = ['Wind']
+Llegendval = [25]
+Lcbarlabel = ['m/s']*len(Lplot)
+Larrowstep = [1]*len(Lplot)
+Lwidth = [0.004]*len(Lplot)
+Lscale = [200]*len(Lplot)
+
+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=[0], ax=fig3.axes, Lscale=Lscale)
+
+Lplot = [RRT_sec1]
+LaxeX = [axe_m1]
+LaxeZ = [Dvar['f1']['level']]
+Ltitle = ['precipitation']
+Lcbarlabel = ['g/kg']*len(Lplot)
+Lxlab = ['distance (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,10000.1)]*len(Lplot)
+Lminval = [0.]
+Lmaxval = [3.5]
+Lstep = [0.5]
+Lstepticks = [0.5]
+Lfacconv = [1000]*len(Lplot)
+LcolorLine = ['black']*len(Lplot)
+Llvl = [0]*len(Lplot)
+Ltime = [Dvar['f1']['time']]
+Lpltype = ['c']*len(Lplot)
+LaddWhite = [True]*len(Lplot)
+
+fig5 = Panel2.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)
+
+Panel2.save_graph(2,fig5)
+################################################################
+######### PANEL 3
+###############################################################
+Panel3 = PanelPlot(2,2, [17,17],'Vertical section along y at I=14', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, lateralminmaxpad=0.97)
+
+Lplot = [Dvar['f1']['RVT'][:,:,13], Dvar['f1']['RCT'][:,:,13], Dvar['f1']['THT-LSTHM'][:,:,13], Dvar['f1']['WT'][:,:,13]]
+LaxeX = [Dvar['f1']['nj']]*len(Lplot)
+LaxeZ = [Dvar['f1']['level'], Dvar['f1']['level'], Dvar['f1']['level'],Dvar['f1']['level_w']]
+Ltitle = ['Water vapor mixing ratio', 'Liquid cloud mxing ratio', 'Potential temperature anomaly', 'Vertical velocity']
+Lcbarlabel = ['g/kg','g/kg', 'K', 'm/s']
+Lxlab = ['distance (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lminval = [0., 0., -5, -18]
+Lmaxval = [15, 3.0, 5, 18]
+Lstep = [0.5, 0.05, 0.2, 0.5]
+Lstepticks = [1, 0.2, 1, 2.5]
+Lfacconv = [1000, 1000, 1, 1]
+Lcolormap = ['gist_rainbow_r','gist_rainbow_r', 'seismic','seismic']
+Ltime = [Dvar['f1']['time']]*len(Lplot)
+Lpltype = ['cf']*len(Lplot)
+LaddWhite = [True, True, False, False]
+
+fig6 = 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,
+ Ltime=Ltime, Lpltype=Lpltype, LaddWhite_cm=LaddWhite)
+
+Lplot1 = [ Dvar['f1']['VM'][:,:,13]]
+Lplot2 = [ Dvar['f1']['WM'][:,:,13]]
+Ltitle = ['Wind']
+Llegendval = [25]
+Lcbarlabel = ['m/s']*len(Lplot)
+Larrowstep = [1]*len(Lplot)
+Lwidth = [0.004]*len(Lplot)
+Lscale = [200]*len(Lplot)
+
+fig7 = 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=fig6.axes, Lscale=Lscale)
+
+
+Lplot = [Dvar['f1']['RRT'][:,:,13]]
+Ltitle = ['precipitation']
+Lcbarlabel = ['g/kg']*len(Lplot)
+Lxlab = ['distance (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,10000.1)]*len(Lplot)
+Lminval = [0.]
+Lmaxval = [3.5]
+Lstep = [0.5]
+Lstepticks = [0.5]
+Lfacconv = [1000]*len(Lplot)
+LcolorLine = ['black']*len(Lplot)
+Llvl = [0]*len(Lplot)
+Ltime = [Dvar['f1']['time']]
+Lpltype = ['c']*len(Lplot)
+LaddWhite = [True]*len(Lplot)
+
+fig8 = 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=fig7.axes,Lid_overlap=[2],colorbar=False)
+
+
+Panel3.save_graph(3,fig8)
diff --git a/MY_RUN/KTEST/003_KW78/004_python/run_python b/MY_RUN/KTEST/003_KW78/004_python/run_python
new file mode 100755
index 0000000000000000000000000000000000000000..32cd8deb136fab81897afada37acf4c53ee7350d
--- /dev/null
+++ b/MY_RUN/KTEST/003_KW78/004_python/run_python
@@ -0,0 +1,16 @@
+#!/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
+set -e
+ln -sf ${SRC_MESONH}/src/LIB/Python/* .
+ln -sf ../003_diag/KWRAI.1.SEG01.004*.nc .
+
+python3 plot_003_KW78.py
+${POSTRUN} display tempgraph1.png
+${POSTRUN} display tempgraph2.png
+${POSTRUN} display tempgraph3.png
+#${POSTRUN} convert *.png 003_KW78.pdf
+#${POSTRUN} evince 003_KW78.pdf
diff --git a/MY_RUN/KTEST/003_KW78/005_ncl/clean_ncl b/MY_RUN/KTEST/003_KW78/005_ncl/clean_ncl
index 233231e1eee2bac48853a70db7af884c517b70bd..8b82cdb8e78561ded4ce43712ce50580c6423c07 100755
--- a/MY_RUN/KTEST/003_KW78/005_ncl/clean_ncl
+++ b/MY_RUN/KTEST/003_KW78/005_ncl/clean_ncl
@@ -1,2 +1,2 @@
#!/bin/bash
-rm -f *.nc *.ps
+rm -f *.nc *.ps *.png
diff --git a/MY_RUN/KTEST/003_KW78/005_ncl/plot_KW78.ncl b/MY_RUN/KTEST/003_KW78/005_ncl/plot_KW78.ncl
index d721d9aae79491ac8197f610e61909a7f1a7404c..a25a8a407774a675ff16edb746d49d0c8c28ae7b 100644
--- a/MY_RUN/KTEST/003_KW78/005_ncl/plot_KW78.ncl
+++ b/MY_RUN/KTEST/003_KW78/005_ncl/plot_KW78.ncl
@@ -35,6 +35,8 @@
yhat = fichier1->YHAT(1:jmax+jphext-1+1) ; YHAT
xhat = fichier1->XHAT(1:imax+jphext-1+1) ; XHAT
+ vtype = typeof(zs)
+
wt= fichier1->WT(0,1:kmax+1,jphext:jmax+jphext-1,jphext:imax+jphext-1) ; WT
vt= fichier1->VT(0,1:kmax,jphext:jmax+jphext-1+1,jphext:imax+jphext-1) ; VT
ut= fichier1->UT(0,1:kmax,jphext:jmax+jphext-1,jphext:imax+jphext-1+1) ; UT
@@ -106,14 +108,14 @@
; Altitude des niveaux modèles
;=================================================;
; Unstagger zhat (from grid 4 to 1)
- nzh=new(kmax,double)
+ nzh=new(kmax,vtype)
do k=0,kmax-1
nzh(k)=(zhat(k)+zhat(k+1))/2.
end do
; Create alt (altitude des niveaux modèle)
- alt=new(dimsizes(tht1),double)
- zcoef=new((/jmax,imax/),double)
+ alt=new(dimsizes(tht1),vtype)
+ zcoef=new((/jmax,imax/),vtype)
zcoef=1.-zs/nzh(kmax-1)
do i=0,imax-1
do j=0,jmax-1
diff --git a/MY_RUN/KTEST/003_KW78/007_ncl_diag/run_ncl b/MY_RUN/KTEST/003_KW78/007_ncl_diag/run_ncl
index ffd98523395dcc3395c9141c10cdaf375591f2b3..ab46be0a29beaa0b1a96ace425e1ace5867b9b3b 100755
--- a/MY_RUN/KTEST/003_KW78/007_ncl_diag/run_ncl
+++ b/MY_RUN/KTEST/003_KW78/007_ncl_diag/run_ncl
@@ -6,7 +6,7 @@
set -x
ln -sf ../002_mesonh/KWRAI.1.SEG01.004.nc .
-ln -sf ../006_diag/KWRAI.1.SEG01.004dia.nc .
+ln -sf ../003_diag/KWRAI.1.SEG01.004dia.nc .
rm -f visu_KW78_diag.png
diff --git a/MY_RUN/KTEST/003_KW78/Makefile b/MY_RUN/KTEST/003_KW78/Makefile
index 43f486a681a58240ba48a5fa53a950b27e684939..3dc66698d1977cf61d89dc4752ccf699b742dee6 100644
--- a/MY_RUN/KTEST/003_KW78/Makefile
+++ b/MY_RUN/KTEST/003_KW78/Makefile
@@ -1,17 +1,22 @@
all:
cd 001_prep_ideal_case && run_prep_ideal_case_xyz
cd 002_mesonh && run_mesonh_xyz
- cd 003_convdia && run_conv2dia
- cd 004_diaprog && run_diaprog
+ cd 003_diag && run_diag_xyz
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 004_python && run_python
+ endif
cd 005_ncl && run_ncl
- cd 006_diag && run_diag_xyz
cd 007_ncl_diag && run_ncl
clean:
cd 001_prep_ideal_case && clean_prep_ideal_case_xyz
cd 002_mesonh && clean_mesonh_xyz
- cd 003_convdia && clean_conv2dia
- cd 004_diaprog && clean_diaprog
+ cd 003_diag && clean_diag_xyz
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 004_python && clean_python
+ endif
cd 005_ncl && clean_ncl
- cd 006_diag && clean_diag_xyz
cd 007_ncl_diag && clean_ncl
+
+python:
+ cd 004_python && run_python
diff --git a/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam.src b/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam.src
index 340173d3ecfbcaa2c521c297da685a9e74769bf4..5e04536479e84dfceaf2bcaad061feb3937e8dd9 100644
--- a/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam.src
+++ b/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam.src
@@ -32,12 +32,12 @@
&NAM_BACKUP
XBAK_TIME(1,1) = 80., XBAK_TIME(1,2) = 20.,
XBAK_TIME(1,3) = 40., XBAK_TIME(1,4) = 60. /
-&NAM_BUDGET CBUTYPE='CART', XBULEN=200.,
- NBUKL=2, NBUKH=51, NBUIL=15, NBUIH=64, NBUJL=15, NBUJH=68,
+&NAM_BUDGET CBUTYPE='CART', XBULEN=40.,
+ NBUKL=2, NBUKH=50, NBUIL=15, NBUIH=64, NBUJL=15, NBUJH=68,
LBU_KCP=.TRUE., LBU_ICP=.FALSE., LBU_JCP=.FALSE. /
&NAM_BU_RTH LBU_RTH=.FALSE. /
&NAM_BU_RTKE LBU_RTKE=.FALSE.,
- NDPTKE=1, NTPTKE=1, NDISSTKE=0, NTRTKE=0 /
+ CBULIST_RTKE(1)='DP', CBULIST_RTKE(2)='TP' /
&NAM_SERIES LSERIES=.TRUE. LMASKLANDSEA=.TRUE. LWMINMAX=.FALSE. /
&NAM_SEAFLUXn CSEA_ALB = 'UNIF' /
&NAM_ISBAn /
diff --git a/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam_CEN4TH b/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam_CEN4TH
index 31400d93df7530b73e55e22a22378c3c480adc09..07ee3c83ad280a377974b4771591dbf3246ab216 100644
--- a/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam_CEN4TH
+++ b/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam_CEN4TH
@@ -27,12 +27,12 @@
XALKTOP = 0.01, XALZBOT = 14000. /
&NAM_BACKUP XBAK_TIME(1,1) = 10., XBAK_TIME(1,2) = 20.,
XBAK_TIME(1,3) = 30., XBAK_TIME(1,4) = 40. /
-&NAM_BUDGET CBUTYPE='CART', XBULEN=200.,
+&NAM_BUDGET CBUTYPE='CART', XBULEN=40.,
NBUKL=2, NBUKH=51, NBUIL=15, NBUIH=64, NBUJL=15, NBUJH=68,
LBU_KCP=.TRUE., LBU_ICP=.FALSE., LBU_JCP=.FALSE. /
&NAM_BU_RTH LBU_RTH=.FALSE. /
&NAM_BU_RTKE LBU_RTKE=.FALSE.,
- NDPTKE=1, NTPTKE=1, NDISSTKE=0, NTRTKE=0 /
+ CBULIST_RTKE(1)='DP', CBULIST_RTKE(2)='TP' /
&NAM_SERIES LSERIES=.TRUE. LMASKLANDSEA=.TRUE. LWMINMAX=.FALSE. /
&NAM_SEAFLUXn CSEA_ALB = 'UNIF' /
&NAM_ISBAn /
diff --git a/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam_WENO b/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam_WENO
index a0b4e4ebea50a78ce339e6d94928bcc83001da14..74099cba7d98a7378d2676b72b2b6286cd6e3bde 100644
--- a/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam_WENO
+++ b/MY_RUN/KTEST/004_Reunion/003_mesonh/EXSEG1.nam_WENO
@@ -27,12 +27,12 @@
XALKTOP = 0.01, XALZBOT = 14000. /
&NAM_BACKUP XBAK_TIME(1,1) = 10., XBAK_TIME(1,2) = 20.,
XBAK_TIME(1,3) = 30., XBAK_TIME(1,4) = 40. /
-&NAM_BUDGET CBUTYPE='CART', XBULEN=200.,
+&NAM_BUDGET CBUTYPE='CART', XBULEN=40.,
NBUKL=2, NBUKH=51, NBUIL=15, NBUIH=64, NBUJL=15, NBUJH=68,
LBU_KCP=.TRUE., LBU_ICP=.FALSE., LBU_JCP=.FALSE. /
&NAM_BU_RTH LBU_RTH=.FALSE. /
&NAM_BU_RTKE LBU_RTKE=.FALSE.,
- NDPTKE=1, NTPTKE=1, NDISSTKE=0, NTRTKE=0 /
+ CBULIST_RTKE(1)='DP', CBULIST_RTKE(2)='TP' /
&NAM_SERIES LSERIES=.TRUE. LMASKLANDSEA=.TRUE. LWMINMAX=.FALSE. /
&NAM_SEAFLUXn CSEA_ALB = 'UNIF' /
&NAM_ISBAn /
diff --git a/MY_RUN/KTEST/004_Reunion/003_mesonh/clean_mesonh_xyz b/MY_RUN/KTEST/004_Reunion/003_mesonh/clean_mesonh_xyz
index 7530099e2719a131467ac11606935b609be440ce..ac8db97d41aeb9ddafe47a958cd69312f182b741 100755
--- a/MY_RUN/KTEST/004_Reunion/003_mesonh/clean_mesonh_xyz
+++ b/MY_RUN/KTEST/004_Reunion/003_mesonh/clean_mesonh_xyz
@@ -4,4 +4,4 @@ rm -f PRESSURE
rm -f REUNION_IDEA.{des,lfi,nc}
rm -f REUNION_PGD_1km5.{des,lfi,nc}
rm -f REUNI.1.* OUT* pipe_name
-
+rm -f *.nc file_for*
diff --git a/MY_RUN/KTEST/004_Reunion/003_mesonh/run_mesonh_xyz b/MY_RUN/KTEST/004_Reunion/003_mesonh/run_mesonh_xyz
index ce9bd3dc383068a96cab69ce6d6391bc1cd8926e..a7a52d5318cfbcbda9146263dc1c2b07d2ba295c 100755
--- a/MY_RUN/KTEST/004_Reunion/003_mesonh/run_mesonh_xyz
+++ b/MY_RUN/KTEST/004_Reunion/003_mesonh/run_mesonh_xyz
@@ -10,8 +10,8 @@ ln -fs ../002_prep_ideal_case/REUNION_IDEA*.{des,lfi,nc} .
ln -sf ../001_prep_pgd/REUNION_PGD_1km5.{des,lfi,nc} .
if [ "x${MNH_ECRAD}" != "x" ] ; then
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/RAD* .
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/*.nc .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/RAD* .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/*.nc .
sed -e's/ECMW/ECRA/g' EXSEG1.nam.src > EXSEG1.nam
else
cp EXSEG1.nam.src EXSEG1.nam
diff --git a/MY_RUN/KTEST/004_Reunion/004_convdia/clean_conv2dia b/MY_RUN/KTEST/004_Reunion/004_convdia/clean_conv2dia
deleted file mode 100755
index d61f25f709fb56f668221fb1094f9ddfcd6b645e..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/004_Reunion/004_convdia/clean_conv2dia
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/bash
-set -x
-rm -f REUNI.1* dirconv FICJD LISTING_DIA OUT_DIA pipe_name
diff --git a/MY_RUN/KTEST/004_Reunion/004_convdia/dir_conv2dia b/MY_RUN/KTEST/004_Reunion/004_convdia/dir_conv2dia
deleted file mode 100644
index ba3b4e5b27f6a6143d9c57f9322e7a4e41ce3c6d..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/004_Reunion/004_convdia/dir_conv2dia
+++ /dev/null
@@ -1,6 +0,0 @@
-1
-REUNI.1.00A20.004
-REUNI.1.00A20.004dg
-n
-n
-0
diff --git a/MY_RUN/KTEST/004_Reunion/004_diag/DIAG1.nam b/MY_RUN/KTEST/004_Reunion/004_diag/DIAG1.nam
new file mode 100644
index 0000000000000000000000000000000000000000..aa4b1ba37f6c5b02d36baadc9be22c391d96e61b
--- /dev/null
+++ b/MY_RUN/KTEST/004_Reunion/004_diag/DIAG1.nam
@@ -0,0 +1,7 @@
+&NAM_CONFIO LCDF4=T, LLFIOUT=F, LLFIREAD=F /
+&NAM_DIAG
+ LISOAL=T, XISOAL(1)=1500.0 /
+&NAM_DIAG_FILE YINIFILE(1) = "REUNI.1.00A20.004" ,
+ YINIFILEPGD(1) = "REUNION_PGD_1km5",
+ YSUFFIX='dia' /
+
diff --git a/MY_RUN/KTEST/004_Reunion/004_diag/clean_diag_xyz b/MY_RUN/KTEST/004_Reunion/004_diag/clean_diag_xyz
new file mode 100755
index 0000000000000000000000000000000000000000..1d7efa01b7fe0c30d3316c8a456c0eba00b24dc0
--- /dev/null
+++ b/MY_RUN/KTEST/004_Reunion/004_diag/clean_diag_xyz
@@ -0,0 +1,5 @@
+#!/bin/bash
+set -x
+rm -f KWRAI* OUTPUT_LISTING* OUTPUT_TRANSFER pipe* *.tex
+rm -f file_for_xtransfer
+rm -f *.lfi *.des *.nc
diff --git a/MY_RUN/KTEST/004_Reunion/004_diag/run_diag_xyz b/MY_RUN/KTEST/004_Reunion/004_diag/run_diag_xyz
new file mode 100755
index 0000000000000000000000000000000000000000..a14520746231626dfb6e8e3a7a9ebca91b0c9e65
--- /dev/null
+++ b/MY_RUN/KTEST/004_Reunion/004_diag/run_diag_xyz
@@ -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
+set -e
+rm -f KWRAI* OUT*
+#
+#
+ln -sf ../003_mesonh/REUNI.1.00A20.004.* .
+ln -sf ../001_prep_pgd/REUNION_PGD_1km5.* .
+
+if [ "x${MNH_ECRAD}" != "x" ] ; then
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/RAD* .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/*.nc .
+fi
+
+time ${MPIRUN} DIAG${XYZ}
+
diff --git a/MY_RUN/KTEST/004_Reunion/005_diaprog/clean_diaprog b/MY_RUN/KTEST/004_Reunion/005_diaprog/clean_diaprog
deleted file mode 100755
index ab7c07966f324073a71267c1c2fb8bf016eb03e3..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/004_Reunion/005_diaprog/clean_diaprog
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/bash
-set -x
-rm -f dir.* gmeta* REUNI.1.00A20.00* OUT_DIA
diff --git a/MY_RUN/KTEST/004_Reunion/005_diaprog/dir_Reunion b/MY_RUN/KTEST/004_Reunion/005_diaprog/dir_Reunion
deleted file mode 100644
index 7fafdea2284ea209c372c3efc69dd859416b6280..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/004_Reunion/005_diaprog/dir_Reunion
+++ /dev/null
@@ -1,30 +0,0 @@
-visu
-! directives de presentation
-LINVWB=T NIGRNC=10 nhi=0 lminmax=t xsizel=0.015 LCOLAREA=T LISO=F
-! gestion des vectuers
-NISKIP=4 XVRL=0.15
-! nom du fichier a ouvrir
-_file_'REUNI.1.00A20.004dg'
-! module du vent et vecteurs du niveau K=2
-MUTVT_K_2_ON_UTVT_K_2
-! temperature potentielle a 1500m
-THT_Z_1500
-pression et vent en vecteurs a 1500m
-PABST_Z_1500_ON_UTVT_Z_1500
-! definition d une coupe verticale
-NIDEBCOU=35 NJDEBCOU=2 NLANGLE=90 NLMAX=80
-! trace de la coupe verticale dans le plan horizontal
-LTRACECV=T
-! temperature potentielle
-THT_CV_
-! plus de trace de la coupe verticale
-LTRACECV=F
-! difference pour la temperature potentielle avec le champ initial
-THT_CV__MINUS_LSTHM_CV_
-! difference pour la composante du vent selon Y avec le champ initial
-VT_CV__MINUS_LSVM_CV_
-! difference pour la vitesse verticale avec le champ initial
-WT_CV__ON_ULTWT_CV_
-!
-! a vous d indiquer vos directives
-quit
diff --git a/MY_RUN/KTEST/004_Reunion/005_diaprog/run_diaprog b/MY_RUN/KTEST/004_Reunion/005_diaprog/run_diaprog
deleted file mode 100755
index dd66c99643e3bc11d5f5d094efc44e307328c06e..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/004_Reunion/005_diaprog/run_diaprog
+++ /dev/null
@@ -1,11 +0,0 @@
-#!/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
-set -e
-ln -sf ../004_convdia/REUNI.1.00A20.004dg.{des,lfi} .
-rm -f dir.0*
-${POSTRUN} diaprog < dir_Reunion
-mv gmeta gmeta_Reunion || echo pas de gmeta
diff --git a/MY_RUN/KTEST/004_Reunion/006_ncl/clean_ncl b/MY_RUN/KTEST/004_Reunion/006_ncl/clean_ncl
index 233231e1eee2bac48853a70db7af884c517b70bd..bbfe25caaa31a2e1aae687110d888e9805b34569 100755
--- a/MY_RUN/KTEST/004_Reunion/006_ncl/clean_ncl
+++ b/MY_RUN/KTEST/004_Reunion/006_ncl/clean_ncl
@@ -1,2 +1,2 @@
#!/bin/bash
-rm -f *.nc *.ps
+rm -f *.nc *.ps *.png
diff --git a/MY_RUN/KTEST/004_Reunion/006_ncl/plot_Reunion.ncl b/MY_RUN/KTEST/004_Reunion/006_ncl/plot_Reunion.ncl
index 2e7e9813a3efc76dc8f6fffe7afb56b4b7793a68..f13d0b901dfa169c109a999f0d0beb14e2cc1e49 100644
--- a/MY_RUN/KTEST/004_Reunion/006_ncl/plot_Reunion.ncl
+++ b/MY_RUN/KTEST/004_Reunion/006_ncl/plot_Reunion.ncl
@@ -102,6 +102,8 @@ load "$NCARG_ROOT/lib/ncarg/nclscripts/wrf/WRFUserARW.ncl"
zs@lat2d = lat2d
zs@lon2d = lon2d
+ vtype = typeof(zs)
+
wt= fichier1->WT(0,1:kmax+1,jphext:jmax+jphext-1,jphext:imax+jphext-1) ; WT
vt= fichier1->VT(0,1:kmax,jphext:jmax+jphext-1+1,jphext:imax+jphext-1); VT
ut= fichier1->UT(0,1:kmax,jphext:jmax+jphext-1,jphext:imax+jphext-1+1) ; UT
@@ -156,13 +158,13 @@ load "$NCARG_ROOT/lib/ncarg/nclscripts/wrf/WRFUserARW.ncl"
zhat= fichier1->ZHAT(1:kmax+1)
; Unstagger zhat (from grid 4 to 1)
- nzhat=new(kmax,double)
+ nzhat=new(kmax,vtype)
do k=0,kmax-1
nzhat(k)=(zhat(k)+zhat(k+1))/2.
end do
; Create Z3D == ALT
- alt=new(dimsizes(tht),double)
+ alt=new(dimsizes(tht),vtype)
zcoef=1.-zs/nzhat(kmax-1)
do i=0,imax-1
diff --git a/MY_RUN/KTEST/004_Reunion/007_python/clean_python b/MY_RUN/KTEST/004_Reunion/007_python/clean_python
new file mode 100755
index 0000000000000000000000000000000000000000..d75604a6ad8743f9782400155bb3def9cfd69410
--- /dev/null
+++ b/MY_RUN/KTEST/004_Reunion/007_python/clean_python
@@ -0,0 +1,4 @@
+#!/bin/bash
+rm -f *.png *.pdf *.nc
+rm -Rf __pycache__
+find . -type l -delete
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
new file mode 100644
index 0000000000000000000000000000000000000000..ea59e343330e5dfc43a383bb976da141751a6705
--- /dev/null
+++ b/MY_RUN/KTEST/004_Reunion/007_python/plot_004_Reunion.py
@@ -0,0 +1,138 @@
+#!/usr/bin/env python3
+"""
+
+@author: Quentin Rodier
+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, mean_operator
+import cartopy.crs as ccrs
+import numpy as np
+import copy
+import os
+
+os.system('rm -f tempgraph*')
+#
+# User's parameter / Namelist
+#
+LnameFiles = ['REUNI.1.00A20.004dia.nc', 'REUNI.1.00A20.004.nc']
+
+Dvar_input = {
+'f1':['ZS', 'UT', 'VT', 'WT', 'THT', 'ALT_PRESSURE','ALT_U','ALT_V','ALT_THETA','level','ZTOP', 'longitude','latitude','level_w','time'],
+'f2':['LSTHM', 'LSVM']}
+
+# Read the variables in the files
+Dvar = {}
+Dvar = read_netcdf(LnameFiles, Dvar_input, path="", removeHALO=True)
+
+################################################################
+######### PANEL 1 # Horizontal cross-section
+###############################################################
+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'][:,:], Dvar['f1']['ALT_PRESSURE'][:,:]]
+
+LaxeX = [Dvar['f1']['longitude']]*len(Lplot)
+LaxeY = [Dvar['f1']['latitude']]*len(Lplot)
+Ltitle = ['Orography', 'Wind speed ','Potential temperature at z = 1500m', 'Pressure']
+Lcbarlabel = ['m', 'm/s','K','hPa']
+Lxlab = ['longitude']*len(Lplot)
+Lylab = ['latitude']*len(Lplot)
+Lminval = [0, 8, 301.8, 831]
+Lmaxval = [3000, 26, 305, 838]
+Lstep = [50,1, 0.1, 0.1, 0.1]
+Lstepticks = [500, 2,1,0.5]
+Lfacconv = [1, 1, 1, 1./100.]
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+Ltime = [Dvar['f1']['time']]*len(Lplot)
+Lpltype = ['cf']*len(Lplot)
+LaddWhite_cm = [True, False, False, False]
+Lprojection = [ccrs.PlateCarree()]*len(Lplot)
+
+fig1 = Panel1.psectionH(lon=LaxeX, lat=LaxeY, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
+ colorbar=True, Ltime=Ltime, LaddWhite_cm=LaddWhite_cm, Lproj=Lprojection)
+
+Lplot1 = [ Dvar['f1']['UT'], Dvar['f1']['ALT_U']]
+Lplot2 = [ Dvar['f1']['VT'], Dvar['f1']['ALT_V']]
+Ltitle = ['wind vectors at K=2', 'wind vectors at z = 1500m ']
+Lxlab = ['longitude']*len(Lplot1)
+Lylab = ['latitude']*len(Lplot1)
+Llegendval = [25,25]
+Lcbarlabel = ['(m/s)']*len(Lplot1)
+Larrowstep = [4]*len(Lplot1)
+Lwidth = [0.003]*len(Lplot1)
+Lcolor = ['black']*len(Lplot1)
+Lprojection = [ccrs.PlateCarree()]*len(Lplot1)
+Llvl = [0]*len(Lplot1)
+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
+###############################################################
+# Compute wind into mass point
+tomass = mean_operator()
+Dvar['f1']['WM'] = tomass.MZM(Dvar['f1']['WT'])
+Dvar['f1']['VM'] = tomass.MYM(Dvar['f1']['VT'])
+
+Panel2 = PanelPlot(2,2, [20,20],'004_Reunion vertical sections at i=35')
+i_slice = 33
+
+# Black line
+Panel1.addLine(fig2.axes[0],[Dvar['f1']['longitude'][0,i_slice],Dvar['f1']['latitude'][0,i_slice]],[Dvar['f1']['longitude'][-1,i_slice],Dvar['f1']['latitude'][-1,i_slice]],'black',3)
+Panel1.save_graph(1,fig2)
+
+# Compute altitude variable in 3D with a 2D topography
+Dvar['f1']['altitude'] , Dvar['f1']['nx_3D'], Dvar['f1']['ny_3D'] = comp_altitude2DVar(Dvar['f2']['LSTHM'], Dvar['f1']['ZS'],Dvar['f1']['ZTOP'], Dvar['f1']['level'], Dvar['f1']['latitude'], Dvar['f1']['longitude'])
+Dvar['f1']['altitude_w'], Dvar['f1']['nx_3D'], Dvar['f1']['ny_3D'] = comp_altitude2DVar(Dvar['f1']['WM'], Dvar['f1']['ZS'],Dvar['f1']['ZTOP'], Dvar['f1']['level_w'], Dvar['f1']['latitude'], Dvar['f1']['longitude'])
+Dvar['f1']['THT-LSTHM'] = copy.deepcopy(Dvar['f1']['THT'])
+Dvar['f1']['THT-LSTHM'] = Dvar['f1']['THT'] - Dvar['f2']['LSTHM']
+Dvar['f1']['VT-LSVM'] = copy.deepcopy(Dvar['f1']['VM'])
+Dvar['f1']['VT-LSVM'] = Dvar['f1']['VM'] - Dvar['f2']['LSVM']
+
+Lplot = [ Dvar['f1']['THT'][:,:,i_slice], Dvar['f1']['THT-LSTHM'][:,:,i_slice],Dvar['f1']['VT-LSVM'][:,:,i_slice],Dvar['f1']['WT'][:,:,i_slice]]
+Ltitle = ['Potential Temperature', 'Anomalie de théta (THT-LSTHM)', 'Anomalie de V (VT-LSVM)', 'WT vertical velocity']
+LaxeZ = [Dvar['f1']['altitude'][:,:,i_slice], Dvar['f1']['altitude'][:,:,i_slice],Dvar['f1']['altitude'][:,:,i_slice],Dvar['f1']['altitude_w'][:,:,i_slice]]
+LaxeX = [Dvar['f1']['ny_3D'][:,:,i_slice]]*len(Lplot)
+Lcbarlabel = ['K', 'K','m/s', 'm/s']
+Lxlab = ['longitude']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,16000)]*len(Lplot)
+Lminval = [300, -1.9, -10.5, -6.75]
+Lmaxval = [355, 1.9, 10.5, 6.75]
+Lstep = [2.5, 0.2, 1, 0.5]
+Lstepticks = Lstep
+Lcolormap=['gist_rainbow_r','seismic','seismic','seismic']
+orog = Dvar['f1']['ZS'][:,i_slice]
+
+fig3 = Panel2.psectionV(Lxx=LaxeX, Lzz=LaxeZ, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval, Lylim=Lylim,
+ Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel,
+ orog=orog, colorbar=True, Ltime=Ltime)
+
+# Wind vector on last panel
+Lplot1 = [ Dvar['f1']['VM'][:,:,i_slice]]
+Lplot2 = [ Dvar['f1']['WM'][:,:,i_slice]]
+Ltitle = ['Wind']
+Llegendval = [15]
+Lcbarlabel = ['m/s']*len(Lplot)
+Lxlab = ['longitude']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Larrowstep = [1]*len(Lplot)
+Lwidth = [0.002]*len(Lplot)
+Lscale = [800]*len(Lplot)
+Lylim=[(0,3000)]
+Lxlim = [(-21.3,-20.9)]*len(Lplot)
+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)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/004_Reunion/007_python/run_python b/MY_RUN/KTEST/004_Reunion/007_python/run_python
new file mode 100755
index 0000000000000000000000000000000000000000..c2e201cef13c20655654d2ef31d5860c71c95492
--- /dev/null
+++ b/MY_RUN/KTEST/004_Reunion/007_python/run_python
@@ -0,0 +1,15 @@
+#!/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
+set -e
+ln -sf ${SRC_MESONH}/src/LIB/Python/* .
+ln -sf ../004_diag/REUNI.1.00A20.004*.nc .
+
+python3 plot_004_Reunion.py
+${POSTRUN} display tempgraph1.png
+${POSTRUN} display tempgraph2.png
+#${POSTRUN} convert *.png 004_Reunion.pdf
+#${POSTRUN} evince 004_Reunion.pdf
diff --git a/MY_RUN/KTEST/004_Reunion/Makefile b/MY_RUN/KTEST/004_Reunion/Makefile
index a4e5c76038ee62d7a08a5090dc346dbedf84b738..694409947ef64635be86920b347b3df7e27b81a0 100644
--- a/MY_RUN/KTEST/004_Reunion/Makefile
+++ b/MY_RUN/KTEST/004_Reunion/Makefile
@@ -3,16 +3,17 @@ all:
cd 001_prep_pgd && run_prep_pgd_xyz
cd 002_prep_ideal_case && run_prep_ideal_case_xyz
cd 003_mesonh && run_mesonh_xyz
- cd 004_convdia && run_conv2dia
- cd 005_diaprog && run_diaprog $
+ cd 004_diag && run_diag_xyz
cd 006_ncl && run_ncl
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 007_python && run_python
+ endif
all_ncl_lfi2cdf:
cd 001_prep_pgd && get_pgd_files
cd 001_prep_pgd && run_prep_pgd_xyz
cd 002_prep_ideal_case && run_prep_ideal_case_xyz
cd 003_mesonh && run_mesonh_xyz
- cd 004_convdia && run_conv2dia
cd 005_ncl_lfi2cdf && run_ncl
all_ncl_extractdia:
@@ -20,7 +21,6 @@ all_ncl_extractdia:
cd 001_prep_pgd && run_prep_pgd_xyz
cd 002_prep_ideal_case && run_prep_ideal_case_xyz
cd 003_mesonh && run_mesonh_xyz
- cd 004_convdia && run_conv2dia
cd 005_ncl_extractdia && run_ncl
all_ncl_nc4:
@@ -36,9 +36,14 @@ clean:
cd 001_prep_pgd && clean_prep_pgd_xyz
cd 002_prep_ideal_case && clean_prep_ideal_case_xyz
cd 003_mesonh && clean_mesonh_xyz
- cd 004_convdia && clean_conv2dia
- cd 005_diaprog && clean_diaprog
+ cd 004_diag && clean_diag_xyz
cd 005_ncl_lfi2cdf && clean_ncl
cd 005_ncl_extractdia && clean_ncl
cd 005_ncl_nc4 && clean_ncl
- cd 006_ncl && clean_ncl
+ cd 006_ncl && clean_ncl
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 007_python && clean_python
+ endif
+
+python:
+ cd 007_python && run_python
diff --git a/MY_RUN/KTEST/005_ARM/001_prep_ideal/PRE_IDEA1.nam b/MY_RUN/KTEST/005_ARM/001_prep_ideal/PRE_IDEA1.nam
index ae229db2b8483e0c292a6f5c5404e9ff6a37edcd..137f6f427a274c2d3649f7304bd6d70da720082f 100644
--- a/MY_RUN/KTEST/005_ARM/001_prep_ideal/PRE_IDEA1.nam
+++ b/MY_RUN/KTEST/005_ARM/001_prep_ideal/PRE_IDEA1.nam
@@ -19,7 +19,7 @@
&NAM_VPROF_PRE /
&NAM_GRn_PRE CSURF='EXTE'/
&NAM_CH_MNHCn_PRE /
-&NAM_BLANK /
+&NAM_BLANKn /
&NAM_PGD_SCHEMES CSEA='FLUX ' /
&NAM_COVER XUNIF_COVER(1)=1. /
RSOU
diff --git a/MY_RUN/KTEST/005_ARM/002_mesonh/EXSEG1.nam b/MY_RUN/KTEST/005_ARM/002_mesonh/EXSEG1.nam
index 5633d913d78826fd8bd637c25654f417dda54b87..320ba51b9439996141cf66f32517a86eae2f7f27 100644
--- a/MY_RUN/KTEST/005_ARM/002_mesonh/EXSEG1.nam
+++ b/MY_RUN/KTEST/005_ARM/002_mesonh/EXSEG1.nam
@@ -49,7 +49,7 @@
LLES_NEB_MASK = .TRUE.,
XLES_TEMP_MEAN_STEP=3600.,
XLES_TEMP_MEAN_START=3600., XLES_TEMP_MEAN_END=32400. /
-&NAM_BLANK /
+&NAM_BLANKn /
&NAM_FRC LGEOST_UV_FRC=.TRUE., LTEND_THRV_FRC=.TRUE. /
&NAM_CH_SOLVER /
&NAM_PARAM_ICE /
diff --git a/MY_RUN/KTEST/005_ARM/002_mesonh/clean_mesonh_xyz b/MY_RUN/KTEST/005_ARM/002_mesonh/clean_mesonh_xyz
index 5bd665b8535e16da39e66854dbb55394bb027879..cb5a967a5b767fa7ffcf560ff20f2e84c6dda16a 100755
--- a/MY_RUN/KTEST/005_ARM/002_mesonh/clean_mesonh_xyz
+++ b/MY_RUN/KTEST/005_ARM/002_mesonh/clean_mesonh_xyz
@@ -1,3 +1,3 @@
#!/bin/bash
rm -f ARM* pipe_name
-rm -f eurocs* OUT*
+rm -f eurocs* OUT* file_for* PRESSURE
diff --git a/MY_RUN/KTEST/005_ARM/003_diaprog/clean_diaprog b/MY_RUN/KTEST/005_ARM/003_diaprog/clean_diaprog
deleted file mode 100755
index 159c61110f80d5cc0e5800b4f3c94b6b5eeba74f..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/005_ARM/003_diaprog/clean_diaprog
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/bash
-rm -f ARM**
-rm -f gmeta OUT*
-rm -f rm dir.*:*
diff --git a/MY_RUN/KTEST/005_ARM/003_diaprog/dir_arm b/MY_RUN/KTEST/005_ARM/003_diaprog/dir_arm
deleted file mode 100644
index 56cfecac498a0ffd9e24eddcf8dfaf7c8c34dad6..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/005_ARM/003_diaprog/dir_arm
+++ /dev/null
@@ -1,77 +0,0 @@
-visu
-_file1_'ARM__.1.CEN4T.000'
-print groups
-lcolarea=t
-lminmax=t
-liso=f
-xhmax=3000
-LCOLZERO=t
-NCOLZERO=1
-LMINMAX=t
-LVPTUSER=T
-XVPTVL=0.20
-XVPTR=0.80
-NIMNMX=1
-LTITDEF=F
-LVPTUSER=T
-XVPTVL=0.20
-XVPTR=0.80
-CTITB1='white'
-CTITB2='white'
-CTITB3='white'
-CTITB4='white'
-CTITT1='white'
-CTITT2='white'
-CTITVAR2='white'
-LDATFILE=.FALSE.
-XISOMIN_SBG_TKE=0
-XISOMAX_SBG_TKE=2.5
-XDIAINT_SBG_TKE=0.25
-XISOMIN_MEAN_TH=298
-XISOMAX_MEAN_TH=316
-XDIAINT_MEAN_TH=1
-XISOMIN_MEAN_U=3
-XISOMAX_MEAN_U=11.
-XDIAINT_MEAN_U=0.5
-XISOMIN_MEAN_V=0
-XISOMAX_MEAN_V=3.2
-XDIAINT_MEAN_V=0.2
-XISOMIN_MEAN_RC=0
-XISOMAX_MEAN_RC=0.2E-03
-XDIAINT_MEAN_RC=0.1E-04
-XISOMIN_MEAN_RR=0
-XISOMAX_MEAN_RR=0.2E-04
-XDIAINT_MEAN_RR=0.1E-05
-XISOMIN_SBG_WTHL=-0.3
-XISOMAX_SBG_WTHL=0.12
-XDIAINT_SBG_WTHL=0.02
-XISOMIN_SBG_WRT=-0.1E-03
-XISOMAX_SBG_WRT=0.4E-03
-XDIAINT_SBG_WRT=0.05E-03
-SBG_TKE_pvt_
-MEAN_TH_pvt_
-MEAN_U_pvt_
-MEAN_V_pvt_
-MEAN_RC_pvt_
-MEAN_RR_pvt_
-SBG_WTHL_pvt_
-SBG_WRT_pvt_
-THLUP_MF_pvt_
-RTUP_MF_pvt_
-RVUP_MF_pvt_
-RCUP_MF_pvt_
-RIUP_MF_pvt_
-WUP_MF_pvt_
-MAFLX_MF_pvt_
-DETR_MF_pvt_
-ENTR_MF_pvt_
-FRCUP_MF_pvt_
-THVUP_MF_pvt_
-WTHL_MF_pvt_
-WRT_MF_pvt_
-WTHV_MF_pvt_
-WU_MF_pvt_
-WV_MF_pvt_
-quit
-
-
diff --git a/MY_RUN/KTEST/005_ARM/003_diaprog/run_diaprog b/MY_RUN/KTEST/005_ARM/003_diaprog/run_diaprog
deleted file mode 100755
index 15d55af0a576fae01a356cb2aea5ff3f42cc30b9..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/005_ARM/003_diaprog/run_diaprog
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/bin/bash
-set -x
-set -e
-ln -sf ../002_mesonh/ARM__.1.CEN4T.000.* .
-rm -f dir.0*
-${POSTRUN} diaprog < dir_arm
-
-
diff --git a/MY_RUN/KTEST/005_ARM/003_python/clean_python b/MY_RUN/KTEST/005_ARM/003_python/clean_python
new file mode 100755
index 0000000000000000000000000000000000000000..d75604a6ad8743f9782400155bb3def9cfd69410
--- /dev/null
+++ b/MY_RUN/KTEST/005_ARM/003_python/clean_python
@@ -0,0 +1,4 @@
+#!/bin/bash
+rm -f *.png *.pdf *.nc
+rm -Rf __pycache__
+find . -type l -delete
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
new file mode 100644
index 0000000000000000000000000000000000000000..c511cc9a7663a6c394b9e472973246d218be5a81
--- /dev/null
+++ b/MY_RUN/KTEST/005_ARM/003_python/plot_005_ARM.py
@@ -0,0 +1,148 @@
+#!/usr/bin/env python3
+"""
+
+@author: Quentin Rodier
+Creation : 07/01/2021
+
+Last modifications
+"""
+import matplotlib as mpl
+mpl.use('Agg')
+from read_MNHfile import read_netcdf
+from Panel_Plot import PanelPlot
+import os
+
+os.system('rm -f tempgraph*')
+#
+# User's parameter / Namelist
+#
+path=""
+LnameFiles = ['ARM__.1.CEN4T.000.nc' ]
+LG_MEAN = '/LES_budgets/Mean/Cartesian/Not_time_averaged/Not_normalized/cart/'
+LG_SBG = '/LES_budgets/Subgrid/Cartesian/Not_time_averaged/Not_normalized/cart/'
+LG_MISC = '/LES_budgets/Miscellaneous/Cartesian/Not_time_averaged/Not_normalized/cart/'
+LG_SURF = '/LES_budgets/Surface/Cartesian/Not_time_averaged/Not_normalized/cart/'
+
+Dvar_input = {
+'f1':[(LG_MEAN,'MEAN_TH') , (LG_MEAN,'MEAN_U') , (LG_MEAN,'MEAN_V') , (LG_MEAN,'MEAN_RC'), (LG_MEAN,'MEAN_RR'),
+ (LG_SBG,'SBG_TKE') , (LG_SBG,'SBG_WTHL'), (LG_SBG,'SBG_WRT'), (LG_SBG,'THLUP_MF'), (LG_SBG,'RTUP_MF') ,
+ (LG_SBG,'RVUP_MF'), (LG_SBG,'RCUP_MF'), (LG_SBG,'RIUP_MF'), (LG_SBG,'WUP_MF'), (LG_SBG,'MAFLX_MF'),
+ (LG_SBG,'DETR_MF') , (LG_SBG,'ENTR_MF'), (LG_SBG,'FRCUP_MF'), (LG_SBG,'THVUP_MF'), (LG_SBG,'WTHL_MF'),
+ (LG_SBG,'WRT_MF') , (LG_SBG,'WTHV_MF') , (LG_SBG,'WU_MF') , (LG_SBG,'WV_MF'),
+ 'level_les','time_les']
+}
+
+# Read the variables in the files
+Dvar = {}
+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'][(LG_MEAN,'MEAN_TH')],Dvar['f1'][(LG_MEAN,'MEAN_U')], Dvar['f1'][(LG_MEAN,'MEAN_V')],
+ Dvar['f1'][(LG_MEAN,'MEAN_RC')], Dvar['f1'][(LG_MEAN,'MEAN_RR')],Dvar['f1'][(LG_SBG,'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']
+Lcbarlabel = ['K','m/s','m/s','g/kg','g/kg','m2 s-2']
+Lxlab = ['time (h)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,3000)]*len(Lplot)
+Lminval = [298, 3, 0, 0, 0, 0]
+Lmaxval = [317, 12, 3.4,0.21, 0.021, 2.5]
+Lstep = [1, 0.5, 0.2, 0.01,0.001, 0.25]
+Lstepticks = Lstep
+Lfacconv = [1, 1, 1, 1000, 1000, 1]
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+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)
+
+################################################################
+######### PANEL 2
+###############################################################
+Panel2 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
+
+Lplot = [Dvar['f1'][(LG_SBG,'SBG_WTHL')], Dvar['f1'][(LG_SBG,'SBG_WRT')], Dvar['f1'][(LG_SBG,'THLUP_MF')],
+ Dvar['f1'][(LG_SBG,'RTUP_MF')], Dvar['f1'][(LG_SBG,'RVUP_MF')], Dvar['f1'][(LG_SBG,'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',
+ 'Updraft THL', 'Updraft total mixing ratio', 'Updraft water vapor mixing ratio', 'Updraft cloud mixing ratio']
+Lcbarlabel = ['m K s-1','m kg kg-1 s-1','K','kg/kg', 'kg/kg', 'kg/kg']
+Lxlab = ['time (h)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,3000)]*len(Lplot)
+Lminval = [ -0.3, -0.1E-3, 301,0.35E-2, 0.1E-2, 0.25E-3]
+Lmaxval = [0.14, 0.45E-3, 319 ,0.018, 0.018, 0.425E-2]
+Lstep = [ 0.02, 0.05E-3, 1 ,0.001, 0.001, 0.25E-3]
+Lstepticks = Lstep
+Lfacconv = [1]*len(Lplot)
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+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)
+
+################################################################
+######### PANEL 3
+###############################################################
+Panel3 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
+
+Lplot = [Dvar['f1'][(LG_SBG,'RIUP_MF')], Dvar['f1'][(LG_SBG,'WUP_MF')], Dvar['f1'][(LG_SBG,'MAFLX_MF')],
+ Dvar['f1'][(LG_SBG,'DETR_MF')], Dvar['f1'][(LG_SBG,'ENTR_MF')], Dvar['f1'][(LG_SBG,'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',
+ 'Updraft mass-flux', 'Updraft detrainment', 'Updraft entrainement', 'Subgrid updraft fraction']
+Lcbarlabel = ['g/kg','m/s','kg m-2 s-1','kg m-3 s-1', 'kg m-3 s-1', '-']
+Lxlab = ['time (h)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,3000)]*len(Lplot)
+Lminval = [ 0, 0., 0., 0., 0., 0.]
+Lmaxval = [0.001, 5.75, 0.34, 0.55, 0.52E-2, 0.17]
+Lstep = [ 0.0001, 0.25, 0.025, 0.025, 0.25E-3, 0.01]
+Lstepticks = Lstep
+Lfacconv = [1]*len(Lplot)
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+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'][(LG_SBG,'THVUP_MF')], Dvar['f1'][(LG_SBG,'WTHL_MF')], Dvar['f1'][(LG_SBG,'WRT_MF')],
+ Dvar['f1'][(LG_SBG,'WTHV_MF')], Dvar['f1'][(LG_SBG,'WU_MF')], Dvar['f1'][(LG_SBG,'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',
+ 'Subgrid WRT flux from Mass-Flux scheme', 'Subgrid WTHV flux from Mass-Flux scheme', 'Subgrid WU from Mass-Flux scheme', 'Subgrid WV from Mass-Flux scheme']
+Lcbarlabel = ['K','m K s-1','m kg/kg s-1','m K s-1', 'm2 s-2', 'm2 s-2']
+Lxlab = ['time (h)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,3000)]*len(Lplot)
+Lminval = [303, -0.07, 0., -0.015, -0.12, -0.024 ]
+Lmaxval = [320, 0.06, 0.19E-3, 0.08, 0., 0.052 ]
+Lstep = [1, 0.005,0.1E-4, 0.5E-2,0.005,0.4E-2 ]
+Lstepticks = Lstep
+Lfacconv = [1]*len(Lplot)
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+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)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/005_ARM/003_python/run_python b/MY_RUN/KTEST/005_ARM/003_python/run_python
new file mode 100755
index 0000000000000000000000000000000000000000..f15dc37f2cd2c43300e9c7b225a4e7378bbc519a
--- /dev/null
+++ b/MY_RUN/KTEST/005_ARM/003_python/run_python
@@ -0,0 +1,17 @@
+#!/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
+set -e
+ln -sf ${SRC_MESONH}/src/LIB/Python/* .
+ln -sf ../002_mesonh/ARM__.1.CEN4T.000.nc .
+
+python3 plot_005_ARM.py
+${POSTRUN} display tempgraph1.png
+${POSTRUN} display tempgraph2.png
+${POSTRUN} display tempgraph3.png
+${POSTRUN} display tempgraph4.png
+#${POSTRUN} convert *.png 005_ARM.pdf
+#${POSTRUN} evince 005_ARM.pdf
diff --git a/MY_RUN/KTEST/005_ARM/004_ncl/plot_arm.ncl b/MY_RUN/KTEST/005_ARM/004_ncl/plot_arm.ncl
index 5d315db0f450055db1dd39d5ee46455146bec67f..db891ad2bf53fe8e109ed891a3869417a180d428 100644
--- a/MY_RUN/KTEST/005_ARM/004_ncl/plot_arm.ncl
+++ b/MY_RUN/KTEST/005_ARM/004_ncl/plot_arm.ncl
@@ -32,177 +32,177 @@ do j=1,179
TIME(j)=TIME(j-1)+300
end do
+group_LES_budgets_SBG = fichier1=>LES_budgets/Subgrid/Cartesian/Not_time_averaged/Not_normalized/cart
+group_LES_budgets_MEAN = fichier1=>LES_budgets/Mean/Cartesian/Not_time_averaged/Not_normalized/cart
-
-vname="SBG_TKE___PROC1"
-SBGTKE = fichier1->$vname$(0,:,:,0,0)
+vname="SBG_TKE"
+SBGTKE = group_LES_budgets_SBG->$vname$(:,:)
SBGTKE@long_name="SBG_TKE"
SBGTKE!1="nzh"
SBGTKE!0="TIME"
SBG_TKE=transpose(SBGTKE)
-vname="MEAN_TH___PROC1"
-MEANTH = fichier1->$vname$(0,:,:,0,0) ; MEAN_TH
+vname="MEAN_TH"
+MEANTH = group_LES_budgets_MEAN->$vname$(:,:) ; MEAN_TH
MEANTH@long_name="MEAN_TH"
MEANTH@units="K"
MEANTH!1="nzh"
MEANTH!0="TIME"
MEAN_TH=transpose(MEANTH)
-
-vname="MEAN_U___PROC1"
-MEANU = fichier1->$vname$(0,:,:,0,0)
+vname="MEAN_U"
+MEANU = group_LES_budgets_MEAN->$vname$(:,:)
MEANU!1="nzh"
MEANU!0="TIME"
MEAN_U=transpose(MEANU)
MEAN_U@long_name="MEAN_U"
-vname="MEAN_V___PROC1"
-MEANV = fichier1->$vname$(0,:,:,0,0)
+vname="MEAN_V"
+MEANV = group_LES_budgets_MEAN->$vname$(:,:)
MEANV!1="nzh"
MEANV!0="TIME"
MEAN_V=transpose(MEANV)
MEAN_V@long_name="MEAN_V"
-vname="MEAN_RC___PROC1"
-MEANRC = fichier1->$vname$(0,:,:,0,0)
+vname="MEAN_RC"
+MEANRC = group_LES_budgets_MEAN->$vname$(:,:)
MEANRC!1="nzh"
MEANRC!0="TIME"
MEAN_RC=transpose(MEANRC)
MEAN_RC@long_name="MEAN_RC"
-vname="MEAN_RR___PROC1"
-MEANRR = fichier1->$vname$(0,:,:,0,0)
+vname="MEAN_RR"
+MEANRR = group_LES_budgets_MEAN->$vname$(:,:)
MEANRR!1="nzh"
MEANRR!0="TIME"
MEAN_RR=transpose(MEANRR)
MEAN_RR@long_name="MEAN_RR"
-vname="SBG_WTHL___PROC1"
-SBGWTHL = fichier1->$vname$(0,:,:,0,0)
+vname="SBG_WTHL"
+SBGWTHL = group_LES_budgets_SBG->$vname$(:,:)
SBGWTHL!1="nzh"
SBGWTHL!0="TIME"
SBG_WTHL=transpose(SBGWTHL)
SBG_WTHL@long_name="SBG_WTHL"
-vname="SBG_WRT___PROC1"
-SBGWRT = fichier1->$vname$(0,:,:,0,0)
+vname="SBG_WRT"
+SBGWRT = group_LES_budgets_SBG->$vname$(:,:)
SBGWRT!1="nzh"
SBGWRT!0="TIME"
SBG_WRT=transpose(SBGWRT)
SBG_WRT@long_name="SBG_WRT"
-vname="THLUP_MF___PROC1"
- THLUPMF= fichier1->$vname$(0,:,:,0,0)
+vname="THLUP_MF"
+ THLUPMF= group_LES_budgets_SBG->$vname$(:,:)
THLUPMF!1="nzh"
THLUPMF!0="TIME"
THLUP_MF=transpose(THLUPMF)
THLUP_MF@long_name="THLUP_MF"
-vname="RTUP_MF___PROC1"
-RTUPMF = fichier1->$vname$(0,:,:,0,0)
+vname="RTUP_MF"
+RTUPMF = group_LES_budgets_SBG->$vname$(:,:)
RTUPMF!1="nzh"
RTUPMF!0="TIME"
RTUP_MF=transpose(RTUPMF)
RTUP_MF@long_name="RTUP_MF"
-vname="RVUP_MF___PROC1"
-RVUPMF = fichier1->$vname$(0,:,:,0,0)
+vname="RVUP_MF"
+RVUPMF = group_LES_budgets_SBG->$vname$(:,:)
RVUPMF!1="nzh"
RVUPMF!0="TIME"
RVUP_MF=transpose(RVUPMF)
RVUP_MF@long_name="RVUP_MF"
-vname="RCUP_MF___PROC1"
-RCUPMF = fichier1->$vname$(0,:,:,0,0)
+vname="RCUP_MF"
+RCUPMF = group_LES_budgets_SBG->$vname$(:,:)
RCUPMF!1="nzh"
RCUPMF!0="TIME"
RCUP_MF=transpose(RCUPMF)
RCUP_MF@long_name="RCUP_MF"
-vname="RIUP_MF___PROC1"
-RIUPMF = fichier1->$vname$(0,:,:,0,0)
+vname="RIUP_MF"
+RIUPMF = group_LES_budgets_SBG->$vname$(:,:)
RIUPMF!1="nzh"
RIUPMF!0="TIME"
RIUP_MF=transpose(RIUPMF)
RIUP_MF@long_name="RIUP_MF"
-vname="WUP_MF___PROC1"
-WUPMF = fichier1->$vname$(0,:,:,0,0)
+vname="WUP_MF"
+WUPMF = group_LES_budgets_SBG->$vname$(:,:)
WUPMF!1="nzh"
WUPMF!0="TIME"
WUP_MF=transpose(WUPMF)
WUP_MF@long_name="WUP_MF"
-vname="MAFLX_MF___PROC1"
-MAFLXMF = fichier1->$vname$(0,:,:,0,0)
+vname="MAFLX_MF"
+MAFLXMF = group_LES_budgets_SBG->$vname$(:,:)
MAFLXMF!1="nzh"
MAFLXMF!0="TIME"
MAFLX_MF=transpose(MAFLXMF)
MAFLX_MF@long_name="MAFLX_MF"
-vname="DETR_MF___PROC1"
-DETRMF = fichier1->$vname$(0,:,:,0,0)
+vname="DETR_MF"
+DETRMF = group_LES_budgets_SBG->$vname$(:,:)
DETRMF!1="nzh"
DETRMF!0="TIME"
DETR_MF=transpose(DETRMF)
DETR_MF@long_name="DETR_MF"
-vname="ENTR_MF___PROC1"
-ENTRMF = fichier1->$vname$(0,:,:,0,0)
+vname="ENTR_MF"
+ENTRMF = group_LES_budgets_SBG->$vname$(:,:)
ENTRMF!1="nzh"
ENTRMF!0="TIME"
ENTR_MF=transpose(ENTRMF)
ENTR_MF@long_name="ENTR_MF"
-vname="FRCUP_MF___PROC1"
-FRCUPMF = fichier1->$vname$(0,:,:,0,0)
+vname="FRCUP_MF"
+FRCUPMF = group_LES_budgets_SBG->$vname$(:,:)
FRCUPMF!1="nzh"
FRCUPMF!0="TIME"
FRCUP_MF=transpose(FRCUPMF)
FRCUP_MF@long_name="FRCUP_MF"
-vname="THVUP_MF___PROC1"
-THVUPMF = fichier1->$vname$(0,:,:,0,0)
+vname="THVUP_MF"
+THVUPMF = group_LES_budgets_SBG->$vname$(:,:)
THVUPMF!1="nzh"
THVUPMF!0="TIME"
THVUP_MF=transpose(THVUPMF)
THVUP_MF@long_name="THVUP_MF"
-vname="WTHL_MF___PROC1"
-WTHLMF = fichier1->$vname$(0,:,:,0,0)
+vname="WTHL_MF"
+WTHLMF = group_LES_budgets_SBG->$vname$(:,:)
WTHLMF!1="nzh"
WTHLMF!0="TIME"
WTHL_MF=transpose(WTHLMF)
WTHL_MF@long_name="WTHL_MF"
-vname="WRT_MF___PROC1"
-WRTMF = fichier1->$vname$(0,:,:,0,0)
+vname="WRT_MF"
+WRTMF = group_LES_budgets_SBG->$vname$(:,:)
WRTMF!1="nzh"
WRTMF!0="TIME"
WRT_MF=transpose(WRTMF)
WRT_MF@long_name="WRT_MF"
-vname="WTHV_MF___PROC1"
-WTHVMF = fichier1->$vname$(0,:,:,0,0)
+vname="WTHV_MF"
+WTHVMF = group_LES_budgets_SBG->$vname$(:,:)
WTHVMF!1="nzh"
WTHVMF!0="TIME"
WTHV_MF=transpose(WTHVMF)
WTHV_MF@long_name="WTHV_MF"
-vname="WU_MF___PROC1"
-WUMF = fichier1->$vname$(0,:,:,0,0)
+vname="WU_MF"
+WUMF = group_LES_budgets_SBG->$vname$(:,:)
WUMF!1="nzh"
WUMF!0="TIME"
WU_MF=transpose(WUMF)
WU_MF@long_name="WU_MF"
-vname="WV_MF___PROC1"
-WVMF = fichier1->$vname$(0,:,:,0,0)
+vname="WV_MF"
+WVMF = group_LES_budgets_SBG->$vname$(:,:)
WVMF!1="nzh"
WVMF!0="TIME"
WV_MF=transpose(WVMF)
diff --git a/MY_RUN/KTEST/005_ARM/Makefile b/MY_RUN/KTEST/005_ARM/Makefile
index 15aadf169c336aed121259ec56aff30a717057e7..1bc0a343ccea47bac3e46f0c9626312f51860176 100644
--- a/MY_RUN/KTEST/005_ARM/Makefile
+++ b/MY_RUN/KTEST/005_ARM/Makefile
@@ -1,11 +1,18 @@
all:
cd 001_prep_ideal && run_prep_ideal_case_xyz
cd 002_mesonh && run_mesonh_xyz
- cd 003_diaprog && run_diaprog
+ 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
- cd 003_diaprog && clean_diaprog
- cd 004_ncl && clean_ncl
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 003_python && clean_python
+ endif
+ cd 004_ncl && clean_ncl
+
+python:
+ cd 003_python && run_python
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src
index 7040ceed94b9baf614d5e6b49c932a05112ed433..befbed1c8f72eb4b53c22467882f095a2d1b885c 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src
@@ -36,5 +36,5 @@
&NAM_SSOn CROUGH='Z01D' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH
index 32ba240a9ce78e73f3d472332d3db39a6bffe055..634a86cf824e2f4a81befbdbc3220a3bec7d3122 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_CEN4TH
@@ -33,5 +33,5 @@
&NAM_SSOn CROUGH='Z01D' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
index e662f00c317a49d983669ee5dff5717f2a7def49..949a1143b46c78205a0381314b7b8eaff82e99fc 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG1.nam.src_WENO
@@ -35,5 +35,5 @@
&NAM_SSOn CROUGH='Z01D' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src
index d081e1bd102731717b9f7491536ababe39aa3dc3..ef7c5c6733dd8a6a6b2b8a3e5d31eb6f36598d30 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src
@@ -23,5 +23,5 @@
CC1DRY = 'DEF', CSOILFRZ = 'DEF', CDIFSFCOND = 'DEF', CSNOWRES = 'DEF' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH
index 46d89895e125636a926cef831095aaa8c728039e..23163d477033c7d8ac8d73ab75be5d5bf93bf05a 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_CEN4TH
@@ -20,5 +20,5 @@
CC1DRY = 'DEF', CSOILFRZ = 'DEF', CDIFSFCOND = 'DEF', CSNOWRES = 'DEF' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
index 005f9db707414508b8a3dd2e887337bd0ec56ec1..af85881f172360325e667c77930619a1b33e0c21 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/EXSEG2.nam.src_WENO
@@ -23,5 +23,5 @@
CC1DRY = 'DEF', CSOILFRZ = 'DEF', CDIFSFCOND = 'DEF', CSNOWRES = 'DEF' /
&NAM_DIAG_ISBAn /
&NAM_SEAFLUXn CSEA_ALB="UNIF" /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/README.namelist b/MY_RUN/KTEST/007_16janvier/008_run2/README.namelist
index 0104c64442e897a78c45da4a8bbaef02c49db166..6fcdd4c80863d297a49c0627d24a6c5b86ae5ae8 100644
--- a/MY_RUN/KTEST/007_16janvier/008_run2/README.namelist
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/README.namelist
@@ -173,5 +173,5 @@ CSEA_ALB ="UNIF" ; type of albedo formula
'TA96' Taylor et al (1996) formula for water direct albedo )
-&NAM_BLANK
+&NAM_BLANKn
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/clean_mesonh_xyz b/MY_RUN/KTEST/007_16janvier/008_run2/clean_mesonh_xyz
index 5311f8a7dab9f2c6bdc2565bfa4cae145226e94c..c3956ffacac2ae0c695b0fdbe93cc68127728407 100755
--- a/MY_RUN/KTEST/007_16janvier/008_run2/clean_mesonh_xyz
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/clean_mesonh_xyz
@@ -1,5 +1,5 @@
#!/bin/bash
set -x
-rm -f 16JAN* OUTPUT_LISTING* OUTPUT_TRANSFER pipe* *.tex
+rm -f 16JAN* OUTPUT_LISTING* OUTPUT_TRANSFER pipe* *.tex REMAP*
rm -f EXSEG?.nam PRESSURE file_for_xtransfer
diff --git a/MY_RUN/KTEST/007_16janvier/008_run2/run_mesonh_xyz b/MY_RUN/KTEST/007_16janvier/008_run2/run_mesonh_xyz
index 77692f0f6cc8be019f7463931b40a9ed79072b3d..e82b13a488c3483b41efbe28899e1855fc93f306 100755
--- a/MY_RUN/KTEST/007_16janvier/008_run2/run_mesonh_xyz
+++ b/MY_RUN/KTEST/007_16janvier/008_run2/run_mesonh_xyz
@@ -14,8 +14,8 @@ ln -sf ../003_nest/16JAN98_36km.neste1.{des,lfi,nc} .
ln -sf ../003_nest/16JAN98_9km.neste1.{des,lfi,nc} .
if [ "x${MNH_ECRAD}" != "x" ] ; then
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/RAD* .
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/*.nc .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/RAD* .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/*.nc .
sed -e's/ECMW/ECRA/g' EXSEG1.nam.src > EXSEG1.nam
sed -e's/ECMW/ECRA/g' EXSEG2.nam.src > EXSEG2.nam
else
diff --git a/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam1 b/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam1
index 910e3354493cb77d56ba6ce24158766906ab936a..599bd73b5017c831a10b77fa0e87289a1b4fe684 100644
--- a/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam1
+++ b/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam1
@@ -19,7 +19,9 @@ LHU_FLX=T,LTRAJ=T,
LCLD_COV=T,
NCAPE=1,
LRADAR=T,
- LDIAG(:)=.FALSE. /
+ LDIAG(:)=.FALSE.,
+ LISOAL=T, XISOAL(1)=9000,
+ LISOPR=T, XISOPR(1)=850, XISOPR(2)=700 /
&NAM_DIAG_FILE YINIFILE(1) = "16JAN.1.12B18.001" ,
YINIFILEPGD(1) = "16JAN98_36km.neste1",
YSUFFIX='dg' /
diff --git a/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam2 b/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam2
index a621eff49d2c59ce2aab1fc0a4cd673b42b9e351..71020a0a80cbaa499561b633d9532f20ace65061 100644
--- a/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam2
+++ b/MY_RUN/KTEST/007_16janvier/009_diag/DIAG1.nam2
@@ -19,7 +19,9 @@ LHU_FLX=T,LTRAJ=T,
LCLD_COV=T,
NCAPE=1,
LRADAR=T,
- LDIAG(:)=.FALSE. /
+ LDIAG(:)=.FALSE.,
+ LISOAL=T, XISOAL(1)=9000,
+ LISOPR=T, XISOPR(1)=850, XISOPR(2)=700 /
&NAM_DIAG_FILE YINIFILE(1) = "16JAN.2.12B18.001" ,
YINIFILEPGD(1) ="16JAN98_9km.neste1",
YSUFFIX='dg' /
diff --git a/MY_RUN/KTEST/007_16janvier/009_diag/run_diag_xyz b/MY_RUN/KTEST/007_16janvier/009_diag/run_diag_xyz
index 27ffa99ea871b2f79b7d149dc36073667afa399b..ef961876a3a4c209f5f455058f0e1c74ebce364c 100755
--- a/MY_RUN/KTEST/007_16janvier/009_diag/run_diag_xyz
+++ b/MY_RUN/KTEST/007_16janvier/009_diag/run_diag_xyz
@@ -14,8 +14,8 @@ ln -sf ../003_nest/16JAN98_9km.neste1.* .
ln -sf ../003_nest/16JAN98_36km.neste1.* .
if [ "x${MNH_ECRAD}" != "x" ] ; then
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/RAD* .
-ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-1.0.1/data/*.nc .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/RAD* .
+ln -sf ${SRC_MESONH}/src/LIB/RAD/ecrad-${VERSION_ECRAD}/data/*.nc .
fi
cp DIAG1.nam1 DIAG1.nam
diff --git a/MY_RUN/KTEST/007_16janvier/010_conv2dia/clean_conv2dia b/MY_RUN/KTEST/007_16janvier/010_conv2dia/clean_conv2dia
deleted file mode 100755
index ef0cd032d0730ad98b606f17f6e976c12a32a6e4..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/007_16janvier/010_conv2dia/clean_conv2dia
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/bash
-set -x
-rm -f 16JAN*
-rm -f dirconv FICJD LISTING_DIA OUT_DIA pipe_name
diff --git a/MY_RUN/KTEST/007_16janvier/010_conv2dia/dir_conv2dia1 b/MY_RUN/KTEST/007_16janvier/010_conv2dia/dir_conv2dia1
deleted file mode 100644
index a0e51e0a6694487186cc1cda7f09bf2b7c5aaae8..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/007_16janvier/010_conv2dia/dir_conv2dia1
+++ /dev/null
@@ -1,6 +0,0 @@
-1
-16JAN.1.12B18.001dg
-16JAN.1.12B18.001cv
-n
-n
-0
diff --git a/MY_RUN/KTEST/007_16janvier/010_conv2dia/dir_conv2dia2 b/MY_RUN/KTEST/007_16janvier/010_conv2dia/dir_conv2dia2
deleted file mode 100644
index 4787f9a32466742f8c4d5af09cd28e71dc7fb28d..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/007_16janvier/010_conv2dia/dir_conv2dia2
+++ /dev/null
@@ -1,6 +0,0 @@
-1
-16JAN.2.12B18.001dg
-16JAN.2.12B18.001cv
-n
-n
-0
diff --git a/MY_RUN/KTEST/007_16janvier/010_conv2dia/run_conv2dia b/MY_RUN/KTEST/007_16janvier/010_conv2dia/run_conv2dia
deleted file mode 100755
index d6fd020632a5efe7e639b9019c633d7b0c51547c..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/007_16janvier/010_conv2dia/run_conv2dia
+++ /dev/null
@@ -1,12 +0,0 @@
-#!/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
-set -e
-ln -sf ../009_diag/16JAN.?.12B18.001dg.{des,lfi,nc} .
-rm -f 16JAN.?.12B18.001cv.{des,lfi,nc}
-${POSTRUN} conv2dia < dir_conv2dia1
-${POSTRUN} conv2dia < dir_conv2dia2
-
diff --git a/MY_RUN/KTEST/007_16janvier/010_python/clean_python b/MY_RUN/KTEST/007_16janvier/010_python/clean_python
new file mode 100755
index 0000000000000000000000000000000000000000..d75604a6ad8743f9782400155bb3def9cfd69410
--- /dev/null
+++ b/MY_RUN/KTEST/007_16janvier/010_python/clean_python
@@ -0,0 +1,4 @@
+#!/bin/bash
+rm -f *.png *.pdf *.nc
+rm -Rf __pycache__
+find . -type l -delete
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
new file mode 100644
index 0000000000000000000000000000000000000000..03bec46158136aacebbe3bb40e9d216a9c16aa85
--- /dev/null
+++ b/MY_RUN/KTEST/007_16janvier/010_python/plot_007_16janvier.py
@@ -0,0 +1,112 @@
+#!/usr/bin/env python3
+"""
+@author: Quentin Rodier
+Creation : 07/01/2021
+
+Last modifications
+"""
+import matplotlib as mpl
+mpl.use('Agg')
+import cartopy.crs as ccrs
+from read_MNHfile import read_netcdf
+from Panel_Plot import PanelPlot
+import os
+
+os.system('rm -f tempgraph*')
+#
+# User's parameter / Namelist
+#
+#
+path=""
+LnameFiles = ['16JAN.1.12B18.001dg.nc', '16JAN.2.12B18.001dg.nc']
+
+Dvar_input = {
+'f1':['MRV700HPA','THT850HPA','UT850HPA','VT850HPA','UT700HPA','VT700HPA', 'ALT_PRESSURE','ALT_U','ALT_V', 'ZS', 'latitude', 'longitude'],
+'f2':['MRV700HPA','THT850HPA','UT850HPA','VT850HPA','UT700HPA','VT700HPA', 'ALT_PRESSURE', 'ZS', 'ALT_U','ALT_V','latitude', 'longitude']
+}
+
+# Read the variables in the files
+Dvar = {}
+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', minmaxpad=1.05)
+
+Lplot = [ Dvar['f1']['ZS'],Dvar['f1']['THT850HPA'], Dvar['f1']['MRV700HPA'],Dvar['f1']['ALT_PRESSURE']]
+lon = [Dvar['f1']['longitude']]*len(Lplot)
+lat = [Dvar['f1']['latitude']]*len(Lplot)
+Ltitle = ['Orography', 'Potential Temperature at 850hPa', 'Water vapor mixing at 700hPa','Pressure at z = 9000m']
+Lcbarlabel = ['m','K', 'g/kg', 'hPa']
+Lxlab = ['longitude']*len(Lplot)
+Lylab = ['latitude']*len(Lplot)
+Lminval = [0, 285, 0.9, 286]
+Lmaxval = [300, 289, 2.6, 294]
+Lstep = [10, 0.25, 0.1, 0.4]
+Lstepticks = [50, 1, 0.2, 0.4]
+Lfacconv = [1.0, 1.0, 1.0, 1./100.0]
+Lcolormap = ['terrain', 'gist_rainbow_r', 'gist_rainbow_r', 'gist_rainbow_r']
+Lprojection = [ccrs.PlateCarree()]*len(Lplot)
+Llvl = [0, 0, 0, 0]
+fig1 = Panel1.psectionH(lon=lon, lat=lat, Lvar=Lplot, Lcarte=[], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lproj=Lprojection, Lfacconv=Lfacconv)
+
+Lplot1 = [ Dvar['f1']['UT850HPA'], Dvar['f1']['UT700HPA'], Dvar['f1']['ALT_U']]
+Lplot2 = [ Dvar['f1']['VT850HPA'], Dvar['f1']['VT700HPA'], Dvar['f1']['ALT_V']]
+Ltitle = ['Wind at 850hPa', 'Wind at 700hPa', 'Wind at 9000m']
+Lxlab = ['longitude']*len(Lplot1)
+Lylab = ['latitude']*len(Lplot1)
+Llegendval = [20,20,40]
+Lcbarlabel = ['(m/s)']*len(Lplot1)
+Larrowstep = [2]*len(Lplot1)
+Lwidth = [0.002]*len(Lplot1)
+Lcolor = ['black']*len(Lplot1)
+Lprojection = [ccrs.PlateCarree()]*len(Lplot1)
+Llvl = [0]*len(Lplot1)
+fig2 = Panel1.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Lvar2=Lplot2, Lcarte=[], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab,
+ Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, Lproj=Lprojection,
+ Lcolor=Lcolor, Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[2,4,6], ax=fig1.axes)
+
+Panel1.save_graph(1,fig2)
+
+################################################################
+######### PANEL 2
+###############################################################
+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)
+lat = [Dvar['f2']['latitude']]*len(Lplot)
+Ltitle = ['Orography', 'Potential Temperature at 850hPa', 'Water vapor mixing at 700hPa','Pressure at z = 9000m']
+Lcbarlabel = ['m','K', 'g/kg', 'hPa']
+Lxlab = ['longitude']*len(Lplot)
+Lylab = ['latitude']*len(Lplot)
+Lminval = [0, 285, 0.9, 286]
+Lmaxval = [300, 289, 2.6, 294]
+Lstep = [10, 0.25, 0.1, 0.4]
+Lstepticks = [50, 1, 0.2, 0.4]
+Lfacconv = [1.0, 1.0, 1.0, 1./100.0]
+Lcolormap = ['terrain', 'gist_rainbow_r', 'gist_rainbow_r', 'gist_rainbow_r']
+Lprojection = [ccrs.PlateCarree()]*len(Lplot)
+Llvl = [0]*len(Lplot)
+fig1 = Panel2.psectionH(lon=lon, lat=lat, Lvar=Lplot, Lcarte=[], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lproj=Lprojection, Lfacconv=Lfacconv)
+
+Lplot1 = [ Dvar['f2']['UT850HPA'], Dvar['f2']['UT700HPA'], Dvar['f2']['ALT_U']]
+Lplot2 = [ Dvar['f2']['VT850HPA'], Dvar['f2']['VT700HPA'], Dvar['f2']['ALT_V']]
+Ltitle = ['Wind at 850hPa', 'Wind at 700hPa', 'Wind at 9000m']
+Llegendval = [20,20,40]
+Lxlab = ['longitude']*len(Lplot1)
+Lylab = ['latitude']*len(Lplot1)
+Lcbarlabel = ['(m/s)']*len(Lplot1)
+Larrowstep = [2]*len(Lplot1)
+Lwidth = [0.002]*len(Lplot1)
+Lcolor = ['black']*len(Lplot1)
+Lprojection = [ccrs.PlateCarree()]*len(Lplot1)
+Llvl = [0]*len(Lplot1)
+fig2 = Panel2.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Lvar2=Lplot2, Lcarte=[], Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab,
+ Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep, Lproj=Lprojection,
+ Lcolor=Lcolor, Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[2,4,6], ax=fig1.axes)
+
+Panel2.save_graph(2,fig2)
diff --git a/MY_RUN/KTEST/007_16janvier/010_python/run_python b/MY_RUN/KTEST/007_16janvier/010_python/run_python
new file mode 100755
index 0000000000000000000000000000000000000000..f832cec2c06ab7bf3bdd700e972be416dafa3711
--- /dev/null
+++ b/MY_RUN/KTEST/007_16janvier/010_python/run_python
@@ -0,0 +1,15 @@
+#!/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
+set -e
+ln -sf ${SRC_MESONH}/src/LIB/Python/* .
+ln -sf ../009_diag/16JAN.*.12B18.001dg.nc .
+
+python3 plot_007_16janvier.py
+${POSTRUN} display tempgraph1.png
+${POSTRUN} display tempgraph2.png
+#${POSTRUN} convert *.png 007_16janvier.pdf
+#${POSTRUN} evince 007_16janvier.pdf
diff --git a/MY_RUN/KTEST/007_16janvier/011_diaprog/clean_diaprog b/MY_RUN/KTEST/007_16janvier/011_diaprog/clean_diaprog
deleted file mode 100755
index c0d45814101d68a224c6868790970b0e139068be..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/007_16janvier/011_diaprog/clean_diaprog
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/bash
-set -x
-rm -f dir.* gmeta 16JAN* OUT_DIA
diff --git a/MY_RUN/KTEST/007_16janvier/011_diaprog/dir_16janv b/MY_RUN/KTEST/007_16janvier/011_diaprog/dir_16janv
deleted file mode 100644
index 8c12e7a0cae260b94630229a4c48b11f6b910ba3..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/007_16janvier/011_diaprog/dir_16janv
+++ /dev/null
@@ -1,24 +0,0 @@
-LINVWB=T NIGRNC=5 nhi=0 lminmax=t xsizel=0.015
-NISKIP=4 XVRL=0.1
-_file1_'16JAN.1.12B18.001cv'
-_file2_'16JAN.2.12B18.001cv'
-visu
-print groups
-LCOLINE=T
-_file1_
-ZS
-LCOLAREA=T LISO=F
-LCOLZERO=T NCOLZERO=1
-LCOLZERO=F
-NIMNMX=0 XDIAINT_THT=1.
-THT_PR_850_ON_UTVT_PR_850
-NIMNMX=-1
-RVT(*1000)_PR_700
-PABST_Z_9000_ON_UTVT_Z_9000
-_file2_
-NIMNMX=0 XDIAINT_THT=1.
-THT_PR_850_ON_UTVT_PR_850
-NIMNMX=-1
-RVT(*1000)_PR_700
-PABST_Z_9000_ON_UTVT_Z_9000
-quit
diff --git a/MY_RUN/KTEST/007_16janvier/011_diaprog/run_diaprog b/MY_RUN/KTEST/007_16janvier/011_diaprog/run_diaprog
deleted file mode 100755
index 4fec27faf46c42c0b6e5203a548e8575110dd47b..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/007_16janvier/011_diaprog/run_diaprog
+++ /dev/null
@@ -1,11 +0,0 @@
-#!/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
-set -e
-ln -sf ../010_conv2dia/16JAN.?.12B18.001cv.{des,lfi} .
-rm -f dir.0*
-${POSTRUN} diaprog < dir_16janv
-
diff --git a/MY_RUN/KTEST/007_16janvier/011_ncl/plot_16j_2.ncl b/MY_RUN/KTEST/007_16janvier/011_ncl/plot_16j_2.ncl
index ffef5341c8c8b704b61e6b69daa7fceb3f501b47..0fedb8530ca39ec1886b44d8ea159efc98bca4c6 100644
--- a/MY_RUN/KTEST/007_16janvier/011_ncl/plot_16j_2.ncl
+++ b/MY_RUN/KTEST/007_16janvier/011_ncl/plot_16j_2.ncl
@@ -108,6 +108,7 @@ zs@units="m"
zs@lat2d = lat2d
zs@lon2d = lon2d
+vtype = typeof(zs)
wt= fichier1->WT(0,1:kmax+1,jphext:jmax+jphext-1,jphext:imax+jphext-1) ; WT
vt= fichier1->VT(0,1:kmax,jphext:jmax+jphext-1+1,jphext:imax+jphext-1) ; VT
@@ -160,13 +161,13 @@ wt1@lon2d = lon2d
zhat= fichier1->ZHAT(1:kmax+1)
; Unstagger zhat (from grid 4 to 1)
- nzhat=new(kmax,double)
+ nzhat=new(kmax,vtype)
do k=0,kmax-1
nzhat(k)=(zhat(k)+zhat(k+1))/2.
end do
; Create Z3D == ALT
- alt=new(dimsizes(tht1),double)
+ alt=new(dimsizes(tht1),vtype)
zcoef=1.-zs/nzhat(kmax-1)
do i=0,imax-1
diff --git a/MY_RUN/KTEST/007_16janvier/Makefile b/MY_RUN/KTEST/007_16janvier/Makefile
index aecb1327b1abb58c03dc7db215897ebf77429fcd..cc7eebb12360a407fb6d67908c22c0c00930274d 100644
--- a/MY_RUN/KTEST/007_16janvier/Makefile
+++ b/MY_RUN/KTEST/007_16janvier/Makefile
@@ -1,10 +1,14 @@
-all: E001_pgd1 E002_pgd2 E003_nest E004_arp2lfi E005_spa_mod1_mod2 E006_preal E008_run2 E009_diag E010_conv2dia E011_diaprog E011_ncl E012_spectre
+all: E001_pgd1 E002_pgd2 E003_nest E004_arp2lfi E005_spa_mod1_mod2 E006_preal E008_run2 E009_diag
+ifneq "$(MNH_PYTHON)" "NO"
+all: E010_python
+endif
+all: E011_ncl E012_spectre
all_ncl_nc4: E001_pgd1 E002_pgd2 E003_nest E004_arp2lfi E005_spa_mod1_mod2 E006_preal E008_run2 E009_diag E011_ncl_nc4
-all_ncl_lfi2cdf: E001_pgd1 E002_pgd2 E003_nest E004_arp2lfi E005_spa_mod1_mod2 E006_preal E008_run2 E009_diag E010_conv2dia E011_ncl_lfi2cdf
+all_ncl_lfi2cdf: E001_pgd1 E002_pgd2 E003_nest E004_arp2lfi E005_spa_mod1_mod2 E006_preal E008_run2 E009_diag E010_python E011_ncl_lfi2cdf
-all_ncl_extractdia: E001_pgd1 E002_pgd2 E003_nest E004_arp2lfi E005_spa_mod1_mod2 E006_preal E008_run2 E009_diag E010_conv2dia E011_ncl_extractdia
+all_ncl_extractdia: E001_pgd1 E002_pgd2 E003_nest E004_arp2lfi E005_spa_mod1_mod2 E006_preal E008_run2 E009_diag E010_python E011_ncl_extractdia
E001_pgd1 :
cd 001_pgd1 && get_pgd_files
@@ -23,10 +27,8 @@ E008_run2:
cd 008_run2 && run_mesonh_xyz
E009_diag:
cd 009_diag && run_diag_xyz
-E010_conv2dia:
- cd 010_conv2dia && run_conv2dia
-E011_diaprog:
- cd 011_diaprog && run_diaprog
+E010_python:
+ cd 010_python && run_python
E011_ncl:
cd 011_ncl && run_ncl
E011_ncl_nc4:
@@ -47,10 +49,13 @@ clean:
cd 006_preal && clean_preal_xyz
cd 008_run2 && clean_mesonh_xyz
cd 009_diag && clean_diag_xyz
- cd 010_conv2dia && clean_conv2dia
- cd 011_diaprog && clean_diaprog
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 010_python && clean_python
+ endif
cd 011_ncl_lfi2cdf && clean_ncl
cd 011_ncl_extractdia && clean_ncl
cd 011_ncl_nc4 && clean_ncl
cd 011_ncl && clean_ncl
cd 012_spectre && clean_spectre_xyz
+python:
+ cd 010_python && run_python
diff --git a/MY_RUN/KTEST/009_ICARTT/002_arp2lfi/PRE_REAL1.nam b/MY_RUN/KTEST/009_ICARTT/002_arp2lfi/PRE_REAL1.nam
index 6c9c0b5a071611299d2c4ae023fbd8312006acb6..7f59fcd294ede8f637425b79c6d8b19e03aee0b3 100644
--- a/MY_RUN/KTEST/009_ICARTT/002_arp2lfi/PRE_REAL1.nam
+++ b/MY_RUN/KTEST/009_ICARTT/002_arp2lfi/PRE_REAL1.nam
@@ -11,7 +11,7 @@
&NAM_VER_GRID NKMAX=60, YZGRID_TYPE='FUNCTN',
ZDZGRD=60., ZDZTOP=650.,
ZZMAX_STRGRD=2000., ZSTRGRD=4., ZSTRTOP=6. /
-&NAM_BLANK /
+&NAM_BLANKn /
MOC2MESONH
transfer mocage/ReLACS variables (default values)
36 # NUMBER OF OPTIONAL GRIB VARIABLES
diff --git a/MY_RUN/KTEST/009_ICARTT/003_mesonh/EXSEG1.nam.src b/MY_RUN/KTEST/009_ICARTT/003_mesonh/EXSEG1.nam.src
index 5d534b528ae7824896f77625a77fe66e12249607..de7ea31f5d7954009e75618b1767e42a4953be3d 100644
--- a/MY_RUN/KTEST/009_ICARTT/003_mesonh/EXSEG1.nam.src
+++ b/MY_RUN/KTEST/009_ICARTT/003_mesonh/EXSEG1.nam.src
@@ -66,4 +66,4 @@
&NAM_DIAG_SURFn /
&NAM_DIAG_ISBAn /
&NAM_DIAG_SURF_ATMn /
-&NAM_BLANK /
+&NAM_BLANKn /
diff --git a/MY_RUN/KTEST/009_ICARTT/003_mesonh/clean_mesonh_xyz b/MY_RUN/KTEST/009_ICARTT/003_mesonh/clean_mesonh_xyz
index 9db6cfa78a5a375dc8d1d257473e6f2dfd124cab..d8301acbd9c0935fa4ec90802731afe5f7da1036 100755
--- a/MY_RUN/KTEST/009_ICARTT/003_mesonh/clean_mesonh_xyz
+++ b/MY_RUN/KTEST/009_ICARTT/003_mesonh/clean_mesonh_xyz
@@ -1,6 +1,6 @@
#!/bin/bash
set -x
-rm -f ICART* CPLCH* OUTPUT_LISTING* pipe*
+rm -f ICART* CPLCH* OUTPUT_LISTING* pipe* REMAP*
rm -f EXSEG?.nam PRESSURE file_for_xtransfer
rm -f DATAE1 DATAJ1 DATAS1
diff --git a/MY_RUN/KTEST/009_ICARTT/005_python/clean_python b/MY_RUN/KTEST/009_ICARTT/005_python/clean_python
new file mode 100755
index 0000000000000000000000000000000000000000..d75604a6ad8743f9782400155bb3def9cfd69410
--- /dev/null
+++ b/MY_RUN/KTEST/009_ICARTT/005_python/clean_python
@@ -0,0 +1,4 @@
+#!/bin/bash
+rm -f *.png *.pdf *.nc
+rm -Rf __pycache__
+find . -type l -delete
diff --git a/MY_RUN/KTEST/009_ICARTT/005_python/plot_009_ICARTT.py b/MY_RUN/KTEST/009_ICARTT/005_python/plot_009_ICARTT.py
new file mode 100644
index 0000000000000000000000000000000000000000..9ca893ad07f9aa4a9ef2745a2cb31323a52117f0
--- /dev/null
+++ b/MY_RUN/KTEST/009_ICARTT/005_python/plot_009_ICARTT.py
@@ -0,0 +1,116 @@
+#!/usr/bin/env python3
+"""
+@author: Quentin Rodier
+Creation : 07/01/2021
+
+Last modifications
+"""
+import matplotlib as mpl
+mpl.use('Agg')
+from read_MNHfile import read_netcdf
+from Panel_Plot import PanelPlot
+import cartopy.crs as ccrs
+import os
+import numpy as np
+
+os.system('rm -f tempgraph*')
+#
+# User's parameter / Namelist
+#
+path=""
+
+LnameFiles = ['ICART.1.SEG01.001dg.nc', 'ICART.1.SEG01.002dg.nc']
+
+Dvar_input = {
+'f1':['MRC','COT','O3T','O3_PROD','O3_LOSS','CO_PROD','CO_LOSS','level','ZTOP', 'longitude','latitude','level_w','time',
+ 'CO_BUDGET','O3_BUDGET','O3_CHREACLIST','CO_CHREACLIST'],
+'f2':['MRC','COT','O3T','O3_PROD','O3_LOSS','CO_PROD','CO_LOSS','level','ZTOP', 'longitude','latitude','level_w','time',
+ 'CO_BUDGET','O3_BUDGET','O3_CHREACLIST','CO_CHREACLIST']
+}
+# Read the variables in the files
+Dvar = {}
+Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
+
+################################################################
+######### PANEL 1 # Horizontal cross-section
+###############################################################
+Panel1 = PanelPlot(3,3, [25,17],'Horizontal section at 1150m, 19h', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, colorbaraspect=40, labelcolorbarpad = 13)
+
+Lplot = [ Dvar['f1']['MRC'][:,:,:], Dvar['f1']['COT'][:,:,:], Dvar['f1']['O3T'][:,:,:], Dvar['f1']['O3_PROD'][:,:,:],
+ Dvar['f1']['O3_LOSS'][:,:,:], Dvar['f1']['CO_PROD'][:,:,:], Dvar['f1']['CO_LOSS'][:,:,:]]
+
+LaxeX = [Dvar['f1']['longitude']]*len(Lplot)
+LaxeY = [Dvar['f1']['latitude']]*len(Lplot)
+Ltitle = ['Cloud mixing ratio', 'Carbon monoxyde CO ','Ozone O3', 'Ozone production', 'Ozone destruction','Carbon monoxyde production','Carbon monoxyde destruction']
+Lcbarlabel = ['g/kg', 'ppbv','ppbv','ppbv/h','ppbv/h','ppbv/h','ppbv/h']
+Lylab = ['latitude']*len(Lplot)
+Lminval = [ 0, 107.5, 0, 70, 70, 0.5, 0.5 ]
+Lmaxval = [ 0.2, 137.5, 70, 130, 130, 1.7, 1.7 ]
+Lstep = [ 0.01, 2.5, 5, 5, 5, 0.1, 0.1]
+Lstepticks = Lstep
+Lfacconv = [ 1, 1, 1, 1e9*3600, 1e9*3600,1e9*3600, 1e9*3600]
+Lcolormap = ['gist_ncar']*len(Lplot)
+Llvl = [14]*len(Lplot)
+LaddWhite_cm = [True, False, False, False, False, False, False]
+Lprojection = [ccrs.PlateCarree()]*len(Lplot)
+
+fig1 = Panel1.psectionH(lon=LaxeX, lat=LaxeY, Lvar=Lplot, Llevel=Llvl,Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
+ colorbar=True, LaddWhite_cm=LaddWhite_cm, Lproj=Lprojection)
+
+Panel1.save_graph(1,fig1)
+
+################################################################
+######### PANEL 2 # Horizontal cross-section
+###############################################################
+Panel2 = PanelPlot(3,3, [25,17],'Horizontal section at 1150m, 20h', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, colorbaraspect=40, labelcolorbarpad = 13)
+
+Lplot = [ Dvar['f2']['MRC'][:,:,:], Dvar['f2']['COT'][:,:,:], Dvar['f2']['O3T'][:,:,:], Dvar['f2']['O3_PROD'][:,:,:],
+ Dvar['f2']['O3_LOSS'][:,:,:], Dvar['f2']['CO_PROD'][:,:,:], Dvar['f2']['CO_LOSS'][:,:,:]]
+
+fig2 = Panel2.psectionH(lon=LaxeX, lat=LaxeY, Lvar=Lplot, Llevel=Llvl,Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
+ colorbar=True, LaddWhite_cm=LaddWhite_cm, Lproj=Lprojection)
+
+Panel2.save_graph(2,fig2)
+
+################################################################
+######### PANEL 3 # Bar plots Budget chemical reactions
+###############################################################
+Dvar['f1']['CO_BUDGET_mean'] = np.mean(Dvar['f1']['CO_BUDGET'][:,13,:,:],axis=(1,2)) # {x,y} Average on height = 1150m
+Dvar['f1']['O3_BUDGET_mean'] = np.mean(Dvar['f1']['O3_BUDGET'][:,13,:,:],axis=(1,2)) # {x,y} Average on height = 1150m
+Dvar['f2']['CO_BUDGET_mean'] = np.mean(Dvar['f2']['CO_BUDGET'][:,13,:,:],axis=(1,2)) # {x,y} Average on height = 1150m
+Dvar['f2']['O3_BUDGET_mean'] = np.mean(Dvar['f2']['O3_BUDGET'][:,13,:,:],axis=(1,2)) # {x,y} Average on height = 1150m
+
+Panel3 = PanelPlot(2,2, [20,20],'Chemical budgets', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, colorbaraspect=40, labelcolorbarpad = 13)
+
+Lplot = [Dvar['f1']['CO_BUDGET_mean'], Dvar['f1']['O3_BUDGET_mean'], Dvar['f2']['CO_BUDGET_mean'], Dvar['f2']['O3_BUDGET_mean'] ]
+Lbins=[Dvar['f1']['CO_CHREACLIST'], Dvar['f1']['O3_CHREACLIST'],Dvar['f2']['CO_CHREACLIST'], Dvar['f2']['O3_CHREACLIST']]
+Ltitle = ['Carbon monoxyde CO chemical reactions', 'Ozone O3 chemical reactions']*2
+Lylab = ['Budget (ppbv/h)']*len(Lplot)
+Ltime = [Dvar['f1']['time'], Dvar['f1']['time'], Dvar['f2']['time'], Dvar['f2']['time']]
+Lylim=[(-1,1), (-100, 100)]*2
+Lfacconv = [1E9*3600]*len(Lplot)
+Lwidth=[0.95]*len(Lplot)
+Lcolors=[]
+for var in Lplot:
+ cc=['']*len(var)
+ for n,val in enumerate(var):
+ if val<0:
+ cc[n]='blue'
+ elif val>=0:
+ cc[n]='red'
+ Lcolors.append(cc)
+
+fig3 = Panel3.pXY_bar(Lbins=Lbins, Lvar=Lplot, Lylim=Lylim, Lfacconv=Lfacconv, Ltitle=Ltitle, Lylab=Lylab, Lcolor=Lcolors, Lwidth=Lwidth, Ltime=Ltime)
+
+# Handle a new axis at y=0 for each graphs
+for i,var in enumerate(Lplot):
+ ax2 = fig3.axes[i].twinx() # Clone the existing axis
+ ax2_x = ax2.get_xaxis()
+ ax2_x.set_label('Chemical reactions')
+ ax2_y = ax2.get_yaxis() # Get the new Y axe and hide it
+ ax2_y.set_visible(False)
+ fig3.axes[i].spines['bottom'].set_position('center') # Move the original axis to the center
+
+Panel3.save_graph(3,fig3)
diff --git a/MY_RUN/KTEST/009_ICARTT/005_python/run_python b/MY_RUN/KTEST/009_ICARTT/005_python/run_python
new file mode 100755
index 0000000000000000000000000000000000000000..b478acd33200e7c354ed683d70259239bbcd4d45
--- /dev/null
+++ b/MY_RUN/KTEST/009_ICARTT/005_python/run_python
@@ -0,0 +1,16 @@
+#!/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
+set -e
+ln -sf ${SRC_MESONH}/src/LIB/Python/* .
+ln -sf ../004_diag/ICART.1.SEG01.00*dg.nc .
+
+python3 plot_009_ICARTT.py
+${POSTRUN} display tempgraph1.png
+${POSTRUN} display tempgraph2.png
+${POSTRUN} display tempgraph3.png
+#${POSTRUN} convert *.png 009_ICARTT.pdf
+#${POSTRUN} evince 009_ICARTT.pdf
diff --git a/MY_RUN/KTEST/009_ICARTT/Makefile b/MY_RUN/KTEST/009_ICARTT/Makefile
index 047047e15b5c8a08f017c58136424b3481ce3b00..19532716375c8f1a87a27e687aff3a610f5f69ab 100644
--- a/MY_RUN/KTEST/009_ICARTT/Makefile
+++ b/MY_RUN/KTEST/009_ICARTT/Makefile
@@ -1,4 +1,8 @@
-all: E001_pgd1 E002_arp2lfi E003_mesonh E004_diag E006_ncl
+all: E001_pgd1 E002_arp2lfi E003_mesonh E004_diag
+ifneq "$(MNH_PYTHON)" "NO"
+all: E005_python
+endif
+all: E006_ncl
E001_pgd1 :
cd 001_pgd1 && get_chimie_files
@@ -9,6 +13,9 @@ E003_mesonh:
cd 003_mesonh && run_mesonh_xyz
E004_diag:
cd 004_diag && run_diag_xyz
+E005_python:
+ cd 005_python && run_python
+
E006_ncl:
cd 006_ncl && run_ncl
@@ -17,5 +24,10 @@ clean:
cd 002_arp2lfi && clean_arp2lfi_xyz
cd 003_mesonh && clean_mesonh_xyz
cd 004_diag && clean_diag_xyz
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 005_python && clean_python
+ endif
cd 006_ncl && clean_ncl
+python:
+ cd 005_python && run_python
diff --git a/MY_RUN/KTEST/011_KW78CHEM/003_convdia/clean_conv2dia b/MY_RUN/KTEST/011_KW78CHEM/003_convdia/clean_conv2dia
deleted file mode 100755
index 3e4536e706188a81078315a0f0efc8882bc454f9..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/011_KW78CHEM/003_convdia/clean_conv2dia
+++ /dev/null
@@ -1,5 +0,0 @@
-#!/bin/bash
-set -x
-rm -f KWRAI.1.SEGCH.004.*
-rm -f KWRAI.1.SEGCH.004dg.*
-rm -f dirconv FICJD LISTING_DIA OUT_DIA pipe_name
diff --git a/MY_RUN/KTEST/011_KW78CHEM/003_convdia/dir_conv2dia b/MY_RUN/KTEST/011_KW78CHEM/003_convdia/dir_conv2dia
deleted file mode 100644
index e427dacf03ac44d5078e10b15d7fe4c4f6e383c3..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/011_KW78CHEM/003_convdia/dir_conv2dia
+++ /dev/null
@@ -1,6 +0,0 @@
-1
-KWRAI.1.SEGCH.004
-KWRAI.1.SEGCH.004dg
-n
-n
-0
diff --git a/MY_RUN/KTEST/011_KW78CHEM/003_convdia/run_conv2dia b/MY_RUN/KTEST/011_KW78CHEM/003_convdia/run_conv2dia
deleted file mode 100755
index 15dbc6fa0d9008ce67bf343024a9bffeb869442d..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/011_KW78CHEM/003_convdia/run_conv2dia
+++ /dev/null
@@ -1,11 +0,0 @@
-#!/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
-set -e
-ln -sf ../002_mesonh/KWRAI.1.SEGCH.004.{des,lfi,nc} .
-rm -f KWRAI.1.SEGCH.004dg.{des,lfi,nc}
-${POSTRUN} conv2dia < dir_conv2dia
-
diff --git a/MY_RUN/KTEST/011_KW78CHEM/003_diag/DIAG1.nam b/MY_RUN/KTEST/011_KW78CHEM/003_diag/DIAG1.nam
new file mode 100644
index 0000000000000000000000000000000000000000..4ddee99a9be291870a1b2a752128d1d4f95f5465
--- /dev/null
+++ b/MY_RUN/KTEST/011_KW78CHEM/003_diag/DIAG1.nam
@@ -0,0 +1,14 @@
+&NAM_CONFIO LCDF4=T, LLFIOUT=F, LLFIREAD=F /
+&NAM_CONFZ
+ ! NZ_VERB=5 , NZ_PROC=0 , NB_PROCIO_R=8 , NB_PROCIO_W=1
+/
+&NAM_DIAG
+ LCLSTR=T,
+ LBOTUP=T,
+ CFIELD='W',
+ XTHRES=10.,
+ LISOAL=T, XISOAL(1)=3000, XISOAL(2)=5000
+ /
+&NAM_DIAG_FILE YINIFILE(1) = "KWRAI.1.SEGCH.004" ,
+ YSUFFIX='dg' /
+
diff --git a/MY_RUN/KTEST/011_KW78CHEM/003_diag/clean_diag_xyz b/MY_RUN/KTEST/011_KW78CHEM/003_diag/clean_diag_xyz
new file mode 100755
index 0000000000000000000000000000000000000000..19b1bf34eb5ca4964c57e9b503ef15a7e940213f
--- /dev/null
+++ b/MY_RUN/KTEST/011_KW78CHEM/003_diag/clean_diag_xyz
@@ -0,0 +1,5 @@
+#!/bin/bash
+set -x
+rm -f KWRAI* OUTPUT_LISTING* OUTPUT_TRANSFER pipe* *.tex
+rm -f file_for_xtransfer
+
diff --git a/MY_RUN/KTEST/011_KW78CHEM/003_diag/diag.nam b/MY_RUN/KTEST/011_KW78CHEM/003_diag/diag.nam
new file mode 100644
index 0000000000000000000000000000000000000000..a1252a72b1b6ef1bf8d6ad58ebe2ffd962e53fc6
--- /dev/null
+++ b/MY_RUN/KTEST/011_KW78CHEM/003_diag/diag.nam
@@ -0,0 +1,12 @@
+
+exemple 1, identification des ascendances > 10 m/s
+
+&NAM_DIAG LCLSTR = T, LBOTUP = T, CFIELD = "W", XTHRES = 10. /
+
+
+
+exemple 2, identification des overshoots
+
+&NAM_DIAG LCLSTR = T, LBOTUP = F, CFIELD = "CLOUD", XTHRES = 0.00001 /
+
+NB: par défaut CLOUD prend en compte Rc+Ri+Rs+Rg i.e. cloud water and ice, graupel and snow
diff --git a/MY_RUN/KTEST/002_3Drelief/003_convdia/run_conv2dia b/MY_RUN/KTEST/011_KW78CHEM/003_diag/run_diag_xyz
similarity index 67%
rename from MY_RUN/KTEST/002_3Drelief/003_convdia/run_conv2dia
rename to MY_RUN/KTEST/011_KW78CHEM/003_diag/run_diag_xyz
index db41113751bf7e7148be1a6100d95fc55c5aa443..2d50f858e38348e1f5e8afcbdcf61555014043e6 100755
--- a/MY_RUN/KTEST/002_3Drelief/003_convdia/run_conv2dia
+++ b/MY_RUN/KTEST/011_KW78CHEM/003_diag/run_diag_xyz
@@ -5,7 +5,11 @@
#MNH_LIC for details. version 1.
set -x
set -e
-ln -sf ../002_mesonh/REL3D.1.EXP01.002.{des,lfi,nc} .
-rm -f REL3D.1.EXP01.002dg.{des,lfi,nc}
-${POSTRUN} conv2dia < dir_conv2dia
+rm -f KWRAI* OUT*
+#
+#
+ln -sf ../002_mesonh/KWRAI.1.SEGCH.004.*des .
+ln -sf ../002_mesonh/KWRAI.1.SEGCH.004.*nc .
+
+time ${MPIRUN} DIAG${XYZ}
diff --git a/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/clean_diaprog b/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/clean_diaprog
deleted file mode 100755
index 9a215110f909a7c8883a8e3d44abb5b8dbe50acb..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/clean_diaprog
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/bash
-set -x
-rm -f dir.* gmeta KWRAI.1.SEGCH.00* OUT_DIA
diff --git a/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/dir_KW78_chem b/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/dir_KW78_chem
deleted file mode 100644
index 834ade876fb27691c47f1d02cbaaae22a7429f0e..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/dir_KW78_chem
+++ /dev/null
@@ -1,65 +0,0 @@
-visu
-! directives de presentation
-LINVWB=T NIGRNC=10 nhi=0 lminmax=t xsizel=0.015
-! plages de couleur, pas d isolignes
-LCOLAREA=T LISO=F
-! gestion des vecteurs (1 vecteur sur 4)
-NISKIP=4 XVRL=0.15
-! 1er fichier a ouvrir
-_file1_'KWRAI.1.SEGCH.004dg'
-! couleur de fond pour le 1er intervalle
-LCOLZERO=T NCOLZERO=1
-! precipitations explicites instantanees
-INPRR
-! precipitations explicites cumulees
-ACPRR
-! trace de tous les vecteurs
-NISKIP=1
-! superposition de la pression et des vecteurs de vent au niveau K=2
-PABST_K_2_ON_UTVT_K_2
-! superposition du rapport d eau nuageuse et des vecteurs vent a 3000m
-RCT_Z_3000_ON_UTVT_Z_3000
-! superposition du rapport d eau nuageuse et des vecteurs vent a 5000m
-RCT_Z_5000_ON_UTVT_Z_5000
-! concentration CO et ozone à 3000m
-COT_Z_3000
-O3T_Z_3000
-! concentration CO et ozone à 5000m
-COT_Z_5000
-O3T_Z_5000
-! definition d une coupe verticale
-NIDEBCOU=5 NJDEBCOU=2 NLANGLE=47 NLMAX=21
-! trace de la coupe verticale dans le plan horizontal
-LTRACECV=T
-! rapport de vapeur et vecteurs vent dans la coupe verticale
-RVT_CV__ON_ULTWT_CV_
-! plus de trace de la coupe verticale
-LTRACECV=F
-! rapport de melange d eau nuageuse et rapport d eau de pluie
-RCT_CV__ON_RRT_CV_
-! difference pour la temperature potentielle avec le champ initial
-THT_CV__MINUS_LSTHM_CV_
-! vitesse verticale en coupe verticale
-WT_CV_
-! concentration CO en coupe verticale
-COT_CV_
-! concentration HCHO en coupe verticale
-HCHOT_CV_
-WC_HCHOT_CV__ON_RCT_CV_
-WR_HCHOT_CV__ON_RRT_CV_
-IC_HCHOT_CV__ON_RST_PLUS_RGT_CV_
-! concentration SO2 en coupe verticale
-SO2T_CV_
-WC_SO2T_CV__ON_RCT_CV_
-WR_SO2T_CV__ON_RRT_CV_
-IC_SO2T_CV__ON_RST_PLUS_RGT_CV_
-! concentration HNO3 en coupe verticale
-HNO3T_CV_
-WC_HNO3T_CV__ON_RCT_CV_
-WR_HNO3T_CV__ON_RRT_CV_
-IC_HNO3T_CV__ON_RST_PLUS_RGT_CV_
-! PH nuage et pluie en coupe verticale
-PHC_CV_
-PHR_CV_
-quit
-
diff --git a/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/run_diaprog b/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/run_diaprog
deleted file mode 100755
index 307811a8f4af3792ad742348c6e0793551566777..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/011_KW78CHEM/004_diaprog/run_diaprog
+++ /dev/null
@@ -1,11 +0,0 @@
-#!/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
-set -e
-ln -sf ../003_convdia/KWRAI.1.SEGCH.004dg.{des,lfi} .
-rm -f dir.*
-${POSTRUN} diaprog < dir_KW78_chem
-#idt gmeta
diff --git a/MY_RUN/KTEST/011_KW78CHEM/004_python/clean_python b/MY_RUN/KTEST/011_KW78CHEM/004_python/clean_python
new file mode 100755
index 0000000000000000000000000000000000000000..d75604a6ad8743f9782400155bb3def9cfd69410
--- /dev/null
+++ b/MY_RUN/KTEST/011_KW78CHEM/004_python/clean_python
@@ -0,0 +1,4 @@
+#!/bin/bash
+rm -f *.png *.pdf *.nc
+rm -Rf __pycache__
+find . -type l -delete
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
new file mode 100644
index 0000000000000000000000000000000000000000..3f792a31363a78a8d5db2c9e5163afa1597afc82
--- /dev/null
+++ b/MY_RUN/KTEST/011_KW78CHEM/004_python/plot_011_KW78CHEM.py
@@ -0,0 +1,290 @@
+#!/usr/bin/env python3
+"""
+@author: Quentin Rodier
+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 oblique_proj, windvec_verti_proj, mean_operator
+import os
+
+os.system('rm -f tempgraph*')
+#
+# User's parameter / Namelist
+#
+path=""
+LnameFiles = ['KWRAI.1.SEGCH.004.nc','KWRAI.1.SEGCH.004dg.nc' ]
+
+Dvar_input = {
+'f1':['ZS', 'UT','VT', 'WT','THT',
+ 'ni_u','nj_u','level','ZTOP', 'ni','nj','level_w','time',
+ 'INPRR','ACPRR','PABST','RCT','RVT','RRT','RGT', 'LSTHM',
+ 'COT','O3T','HCHOT','WC_HCHOT','IC_HCHOT', 'WR_HCHOT','SO2T','WC_SO2T','WR_SO2T',
+ 'IC_SO2T','HNO3T','WC_HNO3T','WR_HNO3T','IC_HNO3T','PHC','PHR',],
+'f2':['ALT_CLOUD', 'ALT_U', 'ALT_V', 'ni','nj']
+}
+
+# Read the variables in the files
+Dvar = {}
+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, lateralminmaxpad=0.9)
+
+Lplot = [ Dvar['f1']['INPRR'], Dvar['f1']['ACPRR'], Dvar['f1']['PABST'],Dvar['f2']['ALT_CLOUD'],Dvar['f2']['ALT_CLOUD'] ]
+
+LaxeX = [Dvar['f1']['ni']]*len(Lplot)
+LaxeY = [Dvar['f1']['nj']]*len(Lplot)
+Ltitle = ['Instantaneous precipitation INPRR', 'Accumulated precipitation ACPRR','Absolute pressure','Mixing ratio of liquid droplets at z=3000m','Mixing ratio of liquid droplets at z=5000m' ]
+Lcbarlabel = ['mm/h', 'mm','hPa','g/kg','g/kg']
+Lxlab = ['x (m)']*len(Lplot)
+Lylab = ['y (m)']*len(Lplot)
+Lminval = [0, 0, 982.25, 0, 0]
+Lmaxval = [13.5, 0.36, 983.45, 2.5, 1.8]
+Lstep = [0.5, 0.005, 0.05, 0.05, 0.05]
+Lstepticks = [0.5, 0.02, 0.2, 0.5, 0.5]
+Lfacconv = [1, 1, 1./100.0,1,1]
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+Llvl = [0,0,0,0,1]
+Ltime = [Dvar['f1']['time']]*len(Lplot)
+LaddWhite = [True]*len(Lplot)
+Lpltype = ['cf']*len(Lplot)
+
+fig1 = Panel1.psectionH(lon=LaxeX, lat=LaxeY, Lvar=Lplot, Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel, Lfacconv=Lfacconv,
+ Ltime=Ltime, LaddWhite_cm=LaddWhite)
+fig1.tight_layout()
+
+# Wind vectors
+Lplot1 = [ Dvar['f1']['UT'], Dvar['f2']['ALT_U'], Dvar['f2']['ALT_U']]
+Lplot2 = [ Dvar['f1']['VT'], Dvar['f2']['ALT_V'], Dvar['f2']['ALT_V']]
+Ltitle = ['Wind at K=2', 'Wind at 3000m', 'Wind at 5000m']
+Lxlab = ['x (m)']*len(Lplot)
+Lylab = ['y (m)']*len(Lplot)
+Llegendval = [10,10,10]
+Lcbarlabel = ['m/s']*len(Lplot)
+Larrowstep = [1]*len(Lplot)
+Lwidth = [0.002]*len(Lplot)
+Lcolor = ['black']*len(Lplot)
+Llvl = [0,0,1]
+lon = [Dvar['f1']['ni_u'], Dvar['f2']['ni'], Dvar['f2']['ni'] ]
+lat = [Dvar['f1']['nj_u'], Dvar['f2']['nj'], Dvar['f2']['nj'] ]
+Lscale = [200]*len(Lplot)
+fig2 = Panel1.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Lvar2=Lplot2, Lcarte=[500,23500,500,23500], Llevel=Llvl,
+ Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep,
+ Lcolor=Lcolor, Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[4,6,8], ax=fig1.axes, Lscale=Lscale)
+# Oblique projection
+i_beg, j_beg = (2,0)
+i_end, j_end = (21,22)
+# Black line
+Panel1.addLine(fig2.axes[6],[Dvar['f1']['ni'][i_beg],Dvar['f1']['nj'][j_beg]],[Dvar['f1']['ni'][i_end],Dvar['f1']['nj'][j_end]],'black',2)
+Panel1.save_graph(1,fig2)
+
+################################################################
+######### PANEL 2
+###############################################################
+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 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
+Dvar['f1']['O3T5000m'] = (Dvar['f1']['O3T'][10,:,:] + Dvar['f1']['O3T'][9,:,:])/2.0
+Lplot = [Dvar['f1']['COT3000m'], Dvar['f1']['O3T3000m'],Dvar['f1']['COT5000m'], Dvar['f1']['O3T5000m'] ]
+
+LaxeX = [Dvar['f1']['ni']]*len(Lplot)
+LaxeY = [Dvar['f1']['nj']]*len(Lplot)
+Ltitle = ['CO at z = 3000m', 'Ozone O3 at z = 3000m ', 'CO at z = 5000m', 'Ozone O3 at z = 5000m ']
+Lcbarlabel = ['kg/kg']*len(Lplot)
+Lxlab = ['x (m)']*len(Lplot)
+Lylab = ['y (m)']*len(Lplot)
+Lminval = [0, 0, 0, 0]
+Lmaxval = [1E-7, 0.4E-7, 0.95E-7, 0.4E-7]
+Lstep = [0.05E-7, 0.02E-7, 0.05E-7, 0.02E-7]
+Lstepticks = Lstep
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+Ltime = [Dvar['f1']['time']]*len(Lplot)
+LaddWhite = [True]*len(Lplot)
+
+fig2 = Panel2.psectionH(lon=LaxeX, lat=LaxeY, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel,
+ Ltime=Ltime, LaddWhite_cm=LaddWhite)
+
+Panel2.save_graph(2,fig2)
+
+################################################################
+######### PANEL 3 : Oblique projection
+###############################################################
+Panel3 = PanelPlot(2,2, [17,17],'Oblique section (angle = 47)', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, lateralminmaxpad=0.9)
+
+Dvar['f1']['THT-LSTHM'] = Dvar['f1']['THT'] - Dvar['f1']['LSTHM']
+
+tomass = mean_operator()
+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)
+angle_sec1, WT_sec1, axe_m1 = oblique_proj(Dvar['f1']['WM'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, RCT_sec1, axe_m1 = oblique_proj(Dvar['f1']['RCT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, RRT_sec1, axe_m1 = oblique_proj(Dvar['f1']['RRT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, anoTHT_sec1, axe_m1 = oblique_proj(Dvar['f1']['THT-LSTHM'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+
+Lplot = [RVT_sec1, RCT_sec1, anoTHT_sec1, WT_sec1]
+LaxeX = [axe_m1]*len(Lplot)
+LaxeZ = [Dvar['f1']['level'], Dvar['f1']['level'], Dvar['f1']['level'],Dvar['f1']['level_w']]
+Ltitle = ['Water vapor mixing ratio', 'Liquid cloud mixing ratio', 'Potential temperature anomaly', 'Vertical velocity']
+Lcbarlabel = ['g/kg','g/kg', 'K', 'm/s']
+Lxlab = ['distance (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lminval = [0., 0., -5, -18]
+Lmaxval = [15, 3.0, 5, 18]
+Lstep = [0.5, 0.05, 0.2, 0.5]
+Lstepticks = [1, 0.2, 1, 2.5]
+Lfacconv = [1000, 1000, 1, 1]
+Lcolormap = ['gist_rainbow_r','gist_rainbow_r', 'seismic','seismic']
+Ltime = [Dvar['f1']['time']]*len(Lplot)
+Lpltype = ['cf']*len(Lplot)
+LaddWhite = [True, True, False, False]
+
+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,
+ Ltime=Ltime, Lpltype=Lpltype, LaddWhite_cm=LaddWhite)
+
+Lplot1 = [ WIND_sec1]
+Lplot2 = [ WT_sec1]
+Ltitle = ['Wind']
+Llegendval = [25]
+Lcbarlabel = ['m/s']*len(Lplot)
+Larrowstep = [1]*len(Lplot)
+Lwidth = [0.004]*len(Lplot)
+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']]
+Ltitle = ['precipitation']
+Lcbarlabel = ['g/kg']*len(Lplot)
+Lxlab = ['distance (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,10000.1)]*len(Lplot)
+Lminval = [0.]
+Lmaxval = [3.5]
+Lstep = [0.5]
+Lstepticks = [0.5]
+Lfacconv = [1000]*len(Lplot)
+LcolorLine = ['black']*len(Lplot)
+Ltime = [Dvar['f1']['time']]
+Lpltype = ['c']*len(Lplot)
+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)
+
+################################################################
+######### PANEL 4 : Oblique projection of chemical variables
+###############################################################
+Panel4 = PanelPlot(2,3, [25,14],'Oblique projection of chemical variables', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, colorbaraspect=40, labelcolorbarpad = 13)
+
+angle_sec1, RGT_sec1, axe_m1 = oblique_proj(Dvar['f1']['RGT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, COT_sec1, axe_m1 = oblique_proj(Dvar['f1']['COT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, O3T_sec1, axe_m1 = oblique_proj(Dvar['f1']['O3T'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, HCHOT_sec1, axe_m1 = oblique_proj(Dvar['f1']['HCHOT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, WC_HCHOT_sec1, axe_m1 = oblique_proj(Dvar['f1']['WC_HCHOT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, WR_HCHOT_sec1, axe_m1 = oblique_proj(Dvar['f1']['WR_HCHOT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, SO2T_sec1, axe_m1 = oblique_proj(Dvar['f1']['SO2T'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, WC_SO2T_sec1, axe_m1 = oblique_proj(Dvar['f1']['WC_SO2T'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, WR_SO2T_sec1, axe_m1 = oblique_proj(Dvar['f1']['WR_SO2T'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, IC_SO2T_sec1, axe_m1 = oblique_proj(Dvar['f1']['IC_SO2T'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, IC_HCHOT_sec1, axe_m1 = oblique_proj(Dvar['f1']['IC_HCHOT'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, HNO3T_sec1, axe_m1 = oblique_proj(Dvar['f1']['HNO3T'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, WC_HNO3T_sec1, axe_m1 = oblique_proj(Dvar['f1']['WC_HNO3T'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, WR_HNO3T_sec1, axe_m1 = oblique_proj(Dvar['f1']['WR_HNO3T'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, IC_HNO3T_sec1, axe_m1 = oblique_proj(Dvar['f1']['IC_HNO3T'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, PHC_sec1, axe_m1 = oblique_proj(Dvar['f1']['PHC'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+angle_sec1, PHR_sec1, axe_m1 = oblique_proj(Dvar['f1']['PHR'], Dvar['f1']['ni'], Dvar['f1']['nj'], Dvar['f1']['level'], i_beg, j_beg, i_end, j_end)
+
+Lplot = [COT_sec1, HCHOT_sec1, SO2T_sec1, HNO3T_sec1, PHC_sec1, PHR_sec1 ]
+
+LaxeX = [axe_m1]*len(Lplot)
+LaxeZ = [Dvar['f1']['level']]*len(Lplot)
+Ltitle = ['CO', 'HCHO', 'SO2', 'HNO3', 'pH in cloud','pH in rain']
+Lcbarlabel = ['ppp', 'ppp', 'ppp','ppp', '', '' ]
+Lxlab = ['distance (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lminval = [0., 0., 0., 0., 0., 0.]
+Lmaxval = [1E-7, 0.23E-9, 0.51E-10, 0.13E-9, 6, 6]
+Lstep = [0.05E-7, 0.1E-10, 0.25E-11, 0.01E-9, 0.25, 0.25]
+Lstepticks = Lstep
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+Ltime = [Dvar['f1']['time']]*len(Lplot)
+Lpltype = ['cf']*len(Lplot)
+LaddWhite = [True]*len(Lplot)
+
+fig6 = 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,
+ Ltime=Ltime, Lpltype=Lpltype, LaddWhite_cm=LaddWhite)
+fig1.tight_layout()
+Panel4.save_graph(4,fig6)
+
+################################################################
+######### PANEL 5 : Oblique projection of chemical variables
+###############################################################
+Panel5 = PanelPlot(3,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.01, colorbaraspect=40, labelcolorbarpad = 13)
+
+Lplot = [WC_HCHOT_sec1, WR_HCHOT_sec1, IC_HCHOT_sec1, WC_SO2T_sec1, WR_SO2T_sec1, IC_SO2T_sec1, WC_HNO3T_sec1, WR_HNO3T_sec1, IC_HNO3T_sec1]
+
+LaxeX = [axe_m1]*len(Lplot)
+LaxeZ = [Dvar['f1']['level']]*len(Lplot)
+Ltitle = ['WC_HCHO', 'WR_HCHO', 'IC_HCHO','WC_SO2', 'WR_SO2', 'IC_SO2','WC_HNO3', 'WR_HNO3', 'IC_HNO3']
+Lcbarlabel = ['ppp']*len(Lplot)
+Lxlab = ['distance (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lminval = [0., 0., 0., 0., 0., 0., 0., 0., 0.]
+Lmaxval = [0.6E-10, 1E-10, 0.17E-9, 0.9E-11, 0.68E-11, 0.62E-12, 0.85E-10, 0.12E-9, 0.18E-9]
+Lstep = [0.3E-11, 0.05E-10, 0.1E-10, 0.5E-12, 0.04E-11, 0.25E-13, 0.05E-10, 0.05E-10, 0.1E-10]
+Lstepticks = Lstep
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+Ltime = [Dvar['f1']['time']]*len(Lplot)
+Lpltype = ['cf']*len(Lplot)
+LaddWhite = [True]*len(Lplot)
+
+fig7 = Panel5.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,
+ Ltime=Ltime, Lpltype=Lpltype, LaddWhite_cm=LaddWhite)
+fig7.tight_layout()
+
+Lplot = [RCT_sec1, RRT_sec1, RGT_sec1, RCT_sec1, RRT_sec1, RGT_sec1, RCT_sec1, RRT_sec1, RGT_sec1 ]
+LaxeX = [axe_m1]*len(Lplot)
+LaxeZ = [Dvar['f1']['level']]*len(Lplot)
+Ltitle = ['cloud mixing ratio (g/kg)', 'precipitation mixing ratio (g/kg)', 'graupel mixing ratio (g/kg)']*3
+Lcbarlabel = ['g/kg']*len(Lplot)
+Lxlab = ['distance (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,10000.1)]*len(Lplot)
+Lminval = [0.]*len(Lplot)
+Lmaxval = [6]*len(Lplot)
+Lstep = [0.5]*len(Lplot)
+Lstepticks = [0.5]*len(Lplot)
+Lfacconv = [1000]*len(Lplot)
+LcolorLine = ['black']*len(Lplot)
+Lpltype = ['c']*len(Lplot)
+
+fig8 = Panel5.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,
+ Lpltype=Lpltype, ax=fig7.axes,Lid_overlap=[0, 2, 4, 6, 8, 10, 12, 14, 16],colorbar=False)
+
+Panel5.save_graph(5,fig8)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/011_KW78CHEM/004_python/run_python b/MY_RUN/KTEST/011_KW78CHEM/004_python/run_python
new file mode 100755
index 0000000000000000000000000000000000000000..829cd2a4f7de8c957f8e241fed3825647e9bf451
--- /dev/null
+++ b/MY_RUN/KTEST/011_KW78CHEM/004_python/run_python
@@ -0,0 +1,18 @@
+#!/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
+set -e
+ln -sf ${SRC_MESONH}/src/LIB/Python/* .
+ln -sf ../003_diag/KWRAI.1.SEGCH.004*.nc .
+
+python3 plot_011_KW78CHEM.py
+${POSTRUN} display tempgraph1.png
+${POSTRUN} display tempgraph2.png
+${POSTRUN} display tempgraph3.png
+${POSTRUN} display tempgraph4.png
+${POSTRUN} display tempgraph5.png
+#${POSTRUN} convert *.png 011_KW78CHEM.pdf
+#${POSTRUN} evince 011_KW78CHEM.pdf
diff --git a/MY_RUN/KTEST/011_KW78CHEM/005_ncl/clean_ncl b/MY_RUN/KTEST/011_KW78CHEM/005_ncl/clean_ncl
index 3f7a799f163d1faebcae30394e9e40a6de80898a..6d1fcfec203cbd90b4693d08c68964108cd43968 100755
--- a/MY_RUN/KTEST/011_KW78CHEM/005_ncl/clean_ncl
+++ b/MY_RUN/KTEST/011_KW78CHEM/005_ncl/clean_ncl
@@ -3,4 +3,4 @@
#MNH_LIC This is part of the Meso-NH software governed 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.
-rm -f *.nc *.ps
+rm -f *.nc *.ps *.png
diff --git a/MY_RUN/KTEST/011_KW78CHEM/Makefile b/MY_RUN/KTEST/011_KW78CHEM/Makefile
index e50e3b333d17d9505c803b9ba51ca34fcdcaafea..5bc36bf838c3b99458ec02e0b9dd4d912c5cd58e 100644
--- a/MY_RUN/KTEST/011_KW78CHEM/Makefile
+++ b/MY_RUN/KTEST/011_KW78CHEM/Makefile
@@ -1,13 +1,20 @@
all:
cd 001_prep_ideal_case && run_prep_ideal_case_xyz
cd 002_mesonh && run_mesonh_xyz
- cd 003_convdia && run_conv2dia
- cd 004_diaprog && run_diaprog
+ cd 003_diag && run_diag_xyz
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 004_python && run_python
+ endif
cd 005_ncl && run_ncl
clean:
cd 001_prep_ideal_case && clean_prep_ideal_case_xyz
cd 002_mesonh && clean_mesonh_xyz
- cd 003_convdia && clean_conv2dia
- cd 004_diaprog && clean_diaprog
+ cd 003_diag && clean_diag_xyz
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 004_python && clean_python
+ endif
cd 005_ncl && clean_ncl
+
+python:
+ cd 004_python && run_python
diff --git a/MY_RUN/KTEST/012_dust/002_ecmwf2lfi/run_ecmwf2lfi_xyz b/MY_RUN/KTEST/012_dust/002_ecmwf2lfi/run_ecmwf2lfi_xyz
index 9d85d71fbafd43690be45d1b7eac753d2ae3ba8c..c244dca4b64919ece5c9180cf14e186c2c06a4f7 100755
--- a/MY_RUN/KTEST/012_dust/002_ecmwf2lfi/run_ecmwf2lfi_xyz
+++ b/MY_RUN/KTEST/012_dust/002_ecmwf2lfi/run_ecmwf2lfi_xyz
@@ -22,16 +22,18 @@ rm -f S702000092* OUTPUT_LISTING* pipe* *.tex
cp PRE_REAL1.nam.20000924.00 PRE_REAL1.nam
time ${MONORUN} PREP_REAL_CASE${XYZ}
-mv OUTPUT_LISTING0 OUTPUT_LISTING0_2400
+cp OUTPUT_LISTING0 OUTPUT_LISTING0_2400
-#exit
+#exit
+rm -f OUTPUT_LISTING0
cp PRE_REAL1.nam.20000924.12 PRE_REAL1.nam
time ${MONORUN} PREP_REAL_CASE${XYZ}
-mv OUTPUT_LISTING0 OUTPUT_LISTING0_2412
+cp OUTPUT_LISTING0 OUTPUT_LISTING0_2412
+rm -f OUTPUT_LISTING0
cp PRE_REAL1.nam.20000925.00 PRE_REAL1.nam
time ${MONORUN} PREP_REAL_CASE${XYZ}
-mv OUTPUT_LISTING0 OUTPUT_LISTING0_2500
+cp OUTPUT_LISTING0 OUTPUT_LISTING0_2500
diff --git a/MY_RUN/KTEST/012_dust/005_conv2dia/clean_conv2dia b/MY_RUN/KTEST/012_dust/005_conv2dia/clean_conv2dia
deleted file mode 100755
index 9b1176bdf2cc5e00f1cc8d88dafbb5e00c1080eb..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/012_dust/005_conv2dia/clean_conv2dia
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/bash
-set -x
-rm -f DUST7*
-rm -f dirconv FICJD LISTING_DIA OUT_DIA pipe_name
diff --git a/MY_RUN/KTEST/012_dust/005_conv2dia/dir_conv2dia1 b/MY_RUN/KTEST/012_dust/005_conv2dia/dir_conv2dia1
deleted file mode 100644
index 858d45891459c812d0a8bf1369854aed026ce041..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/012_dust/005_conv2dia/dir_conv2dia1
+++ /dev/null
@@ -1,6 +0,0 @@
-1
-DUST7.1.SEG02.004
-DUST7.1.SEG02.004_dia
-n
-n
-0
diff --git a/MY_RUN/KTEST/012_dust/005_conv2dia/run_conv2dia b/MY_RUN/KTEST/012_dust/005_conv2dia/run_conv2dia
deleted file mode 100755
index 730b717dfaa9102e903c349f97b537be2fabc291..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/012_dust/005_conv2dia/run_conv2dia
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/bin/bash
-set -x
-set -e
-ln -sf ../004_restart/DUST7.1.SEG02.004.lfi .
-rm -f DUST7.1.SEG02.004_dia*
-${POSTRUN} conv2dia < dir_conv2dia1
-
diff --git a/MY_RUN/KTEST/012_dust/005_python/clean_python b/MY_RUN/KTEST/012_dust/005_python/clean_python
new file mode 100755
index 0000000000000000000000000000000000000000..d75604a6ad8743f9782400155bb3def9cfd69410
--- /dev/null
+++ b/MY_RUN/KTEST/012_dust/005_python/clean_python
@@ -0,0 +1,4 @@
+#!/bin/bash
+rm -f *.png *.pdf *.nc
+rm -Rf __pycache__
+find . -type l -delete
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
new file mode 100644
index 0000000000000000000000000000000000000000..2116f12329b9163e64761721f006b0e9e06efd1f
--- /dev/null
+++ b/MY_RUN/KTEST/012_dust/005_python/plot_012_dust.py
@@ -0,0 +1,124 @@
+#!/usr/bin/env python3
+"""
+@author: Quentin Rodier
+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 mean_operator
+import cartopy.crs as ccrs
+import numpy as np
+import os
+
+os.system('rm -f tempgraph*')
+#
+# User's parameter / Namelist
+#
+path=""
+LnameFiles = ['DUST7.1.SEG02.004.nc']
+
+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']}
+
+# Read the variables in the files
+Dvar = {}
+Dvar = read_netcdf(LnameFiles, Dvar_input, path=path, removeHALO=True)
+
+################################################################
+######### PANEL 1
+###############################################################
+Panel1 = PanelPlot(1,2, [20,10],'012_dust', titlepad=25, minmaxpad=1.04, timepad=-0.10, colorbarpad=0.01, colorbaraspect=30)
+tomass = mean_operator()
+Dvar['f1']['UM'] = tomass.MXM(Dvar['f1']['UT'])
+Dvar['f1']['VM'] = tomass.MYM(Dvar['f1']['VT'])
+Dvar['f1']['WIND'] = np.sqrt(Dvar['f1']['VM']**2 + Dvar['f1']['UM']**2)
+
+Lplot = [ Dvar['f1']['WIND'],Dvar['f1']['THT']]
+lon = [Dvar['f1']['longitude']]*len(Lplot)
+lat = [Dvar['f1']['latitude']]*len(Lplot)
+Ltitle = ['Wind speed', 'Potential Temperature at 1st level']
+Lcbarlabel = ['m/s','K']
+Lxlab = ['longitude']*len(Lplot)
+Lylab = ['latitude']*len(Lplot)
+Lminval = [0, 296.5]
+Lmaxval = [10.5, 307.5]
+Lstep = [0.5, 0.5]
+Lstepticks = Lstep
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+Lprojection = [ccrs.PlateCarree()]*len(Lplot)
+Llvl = [0, 0]
+LaddWhite = [True, False]
+Ltime = [Dvar['f1']['date']]*len(Lplot)
+
+fig1 = Panel1.psectionH(lon=lon, lat=lat, Lvar=Lplot, Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=Lstep, Lstepticks=Lstepticks, Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel,
+ Ltime=Ltime, LaddWhite_cm=LaddWhite, Lproj=Lprojection)
+
+Lplot1 = [ Dvar['f1']['UM']]
+Lplot2 = [ Dvar['f1']['VM']]
+Ltitle = [' vectors at 1st level']
+Llegendval = [20]
+Lcbarlabel = ['m/s']*len(Lplot)
+Larrowstep = [1]*len(Lplot)
+Lwidth = [0.002]*len(Lplot)
+Lcolor = ['black']*len(Lplot)
+Lscale = [200]*len(Lplot)
+
+fig2 = Panel1.pvector(Lxx=lon, Lyy=lat, Lvar1=Lplot1, Llevel=Llvl, Lvar2=Lplot2, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lwidth=Lwidth, Larrowstep=Larrowstep,
+ Llegendval=Llegendval, Lcbarlabel=Lcbarlabel, Lid_overlap=[0], ax=fig1.axes, Lscale=Lscale)
+
+Panel1.save_graph(1,fig2)
+
+################################################################
+######### PANEL 2
+###############################################################
+Panel2 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.07, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=40)
+Lplot = [ Dvar['f1']['DSTM03T'],Dvar['f1']['DSTM33T'],Dvar['f1']['DSTM02T'],Dvar['f1']['DSTM32T'],Dvar['f1']['DSTM01T'],Dvar['f1']['DSTM31T']]
+lon = [Dvar['f1']['longitude']]*len(Lplot)
+lat = [Dvar['f1']['latitude']]*len(Lplot)
+Ltitle = ['DSTM03T','DSTM33T','DSTM02T','DSTM32T','DSTM01T','DSTM31T']
+Lcbarlabel = ['kg/kg']*len(Lplot)
+Lxlab = ['longitude']*len(Lplot)
+Lylab = ['latitude']*len(Lplot)
+Lminval = [0,0,0,0,0,0]
+Lmaxval = [0.11E-21, 0.62E-9, 0.33E-17, 0.44E-6, 0.45E-16, 0.17E-7]
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+Lprojection = [ccrs.PlateCarree()]*len(Lplot)
+LaddWhite = [True]*len(Lplot)
+Ltime = [Dvar['f1']['time']]*len(Lplot)
+Llvl = [0]*len(Lplot)
+fig3 = Panel2.psectionH(lon=lon, lat=lat, Lvar=Lplot, Llevel=Llvl, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=[], Lstepticks=[], Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel,
+ Ltime=Ltime, LaddWhite_cm=LaddWhite, Lproj=Lprojection, ax=[])
+
+Panel2.save_graph(2,fig3)
+
+################################################################
+######### PANEL 3
+###############################################################
+Panel3 = PanelPlot(2,3, [25,14],'', titlepad=25, minmaxpad=1.04, timepad=-0.10, colorbarpad=0.03, labelcolorbarpad = 13, colorbaraspect=50)
+Lplot = [ Dvar['f1']['F_DST001P1'],Dvar['f1']['F_DST002P1'],Dvar['f1']['F_DST003P1']]
+lon = [Dvar['f1']['longitude']]*len(Lplot)
+lat = [Dvar['f1']['latitude']]*len(Lplot)
+Ltitle = ['F_DST001P1','F_DST002P1','F_DST003P1']
+Lcbarlabel = ['kg/m2/s']*len(Lplot)
+Lxlab = ['longitude']*len(Lplot)
+Lylab = ['latitude']*len(Lplot)
+Lminval = [0,0,0]
+Lmaxval = [0.54E-9,0.76E-7, 0.28E-8]
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+Lprojection = [ccrs.PlateCarree()]*len(Lplot)
+LaddWhite = [True]*len(Lplot)
+Ltime = [Dvar['f1']['date']]*len(Lplot)
+Lcarte = [Dvar['f1']['longitude'].min(),Dvar['f1']['longitude'].max(), Dvar['f1']['latitude'].min(), Dvar['f1']['latitude'].max()]
+fig4 = Panel3.psectionH(lon=lon, lat=lat, Lvar=Lplot, Lxlab=Lxlab, Lylab=Lylab, Ltitle=Ltitle, Lminval=Lminval, Lmaxval=Lmaxval,
+ Lstep=[], Lstepticks=[], Lcolormap=Lcolormap, Lcbarlabel=Lcbarlabel,Lcarte=Lcarte,
+ Ltime=Ltime, LaddWhite_cm=LaddWhite, Lproj=Lprojection, ax=[])
+
+Panel3.save_graph(3,fig4)
\ No newline at end of file
diff --git a/MY_RUN/KTEST/012_dust/005_python/run_python b/MY_RUN/KTEST/012_dust/005_python/run_python
new file mode 100755
index 0000000000000000000000000000000000000000..27e2f28c1558a45b015baf7bcfc3e1f46dc02714
--- /dev/null
+++ b/MY_RUN/KTEST/012_dust/005_python/run_python
@@ -0,0 +1,16 @@
+#!/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
+set -e
+ln -sf ${SRC_MESONH}/src/LIB/Python/* .
+ln -sf ../004_restart/DUST7.1.SEG02.004.nc .
+
+python3 plot_012_dust.py
+${POSTRUN} display tempgraph1.png
+${POSTRUN} display tempgraph2.png
+${POSTRUN} display tempgraph3.png
+#${POSTRUN} convert *.png 012_dust.pdf
+#${POSTRUN} evince 012_dust.pdf
diff --git a/MY_RUN/KTEST/012_dust/006_diaprog/clean_diaprog b/MY_RUN/KTEST/012_dust/006_diaprog/clean_diaprog
deleted file mode 100755
index b43ef143fa29d857798b07b0725c14c26f9b1d1c..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/012_dust/006_diaprog/clean_diaprog
+++ /dev/null
@@ -1,3 +0,0 @@
-#!/bin/bash
-set -x
-rm -f dir.* gmeta DUST* OUT_DIA
diff --git a/MY_RUN/KTEST/012_dust/006_diaprog/dirdust b/MY_RUN/KTEST/012_dust/006_diaprog/dirdust
deleted file mode 100644
index 355cf5afcceb252104c582b52c0706d9f3fbb770..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/012_dust/006_diaprog/dirdust
+++ /dev/null
@@ -1,34 +0,0 @@
-_file_'DUST7.1.SEG02.004_dia'
-LCOLAREA=T
-LISO=F
-print groups
-nigrnc=1
-lcolzero=f
-ncolzero=1
-LVPTUSER=.T.
-XVPTVL=0.1
-XVPTVR=0.8
-XVPTVB=0.1
-XVPTVT=0.9
-LFACTIMP=T
-LMINMAX=T
-LCOLAREA=.T.
-LCOLZERO=.T.
-NCOLZERO=1
-LCOLINE=F
-LISO=.F.
-
-niskip=1
-xvrl=0.1
-MUTVT_k_2_t_time1_on_UTVT_k_2_t_time1
-THT_K_2
-DSTM03T_K_2
-DSTM33T_K_2
-DSTM02T_K_2
-DSTM32T_K_2
-DSTM01T_K_2
-DSTM31T_K_2
-F_DST001P1
-F_DST002P1
-F_DST003P1
-quit
diff --git a/MY_RUN/KTEST/012_dust/006_diaprog/run_diaprog b/MY_RUN/KTEST/012_dust/006_diaprog/run_diaprog
deleted file mode 100755
index ab5bc445e57ea094c2b5079252a5c3939c5603ab..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/012_dust/006_diaprog/run_diaprog
+++ /dev/null
@@ -1,7 +0,0 @@
-#!/bin/bash
-set -x
-set -e
-ln -sf ../005_conv2dia/DUST7.1.SEG02.004_dia.lfi .
-rm -f dir.0*
-${POSTRUN} diaprog < dirdust
-
diff --git a/MY_RUN/KTEST/012_dust/006_ncl/clean_ncl b/MY_RUN/KTEST/012_dust/006_ncl/clean_ncl
new file mode 100755
index 0000000000000000000000000000000000000000..2bb66b885adab3b3c4eef7b62c3fc348e2b5b54d
--- /dev/null
+++ b/MY_RUN/KTEST/012_dust/006_ncl/clean_ncl
@@ -0,0 +1,3 @@
+#!/bin/bash
+set -x
+rm -f *.nc *.ps *.png
diff --git a/MY_RUN/KTEST/012_dust/007_ncl/plot_dust.ncl b/MY_RUN/KTEST/012_dust/006_ncl/plot_dust.ncl
similarity index 100%
rename from MY_RUN/KTEST/012_dust/007_ncl/plot_dust.ncl
rename to MY_RUN/KTEST/012_dust/006_ncl/plot_dust.ncl
diff --git a/MY_RUN/KTEST/012_dust/007_ncl/run_ncl b/MY_RUN/KTEST/012_dust/006_ncl/run_ncl
similarity index 100%
rename from MY_RUN/KTEST/012_dust/007_ncl/run_ncl
rename to MY_RUN/KTEST/012_dust/006_ncl/run_ncl
diff --git a/MY_RUN/KTEST/012_dust/007_ncl/clean_ncl b/MY_RUN/KTEST/012_dust/007_ncl/clean_ncl
deleted file mode 100755
index aa9f928147719870e032433d1a3ac85b8ed720d9..0000000000000000000000000000000000000000
--- a/MY_RUN/KTEST/012_dust/007_ncl/clean_ncl
+++ /dev/null
@@ -1,4 +0,0 @@
-#!/bin/bash
-set -x
-rm -f *.nc
-rm -f *.ps
diff --git a/MY_RUN/KTEST/012_dust/Makefile b/MY_RUN/KTEST/012_dust/Makefile
index ee078671aee07513f52f91018bf64d747f250039..79b127fcf2a7d72df95f6b39d5ec13c27c07ba09 100644
--- a/MY_RUN/KTEST/012_dust/Makefile
+++ b/MY_RUN/KTEST/012_dust/Makefile
@@ -1,4 +1,8 @@
-all: E001_pgd1 E002_ecmwf2lfi E003_run E004_restart E005_conv2dia E006_diaprog E007_ncl
+all: E001_pgd1 E002_ecmwf2lfi E003_run E004_restart
+ifneq "$(MNH_PYTHON)" "NO"
+all: E005_python
+ endif
+all: E006_ncl
E001_pgd1 :
cd 001_pgd1 && run_prep_pgd_xyz
@@ -8,17 +12,19 @@ E003_run:
cd 003_run && run_mesonh_xyz
E004_restart:
cd 004_restart && run_mesonh_xyz
-E005_conv2dia:
- cd 005_conv2dia && run_conv2dia
-E006_diaprog:
- cd 006_diaprog && run_diaprog
-E007_ncl:
- cd 007_ncl && run_ncl
+E005_python:
+ cd 005_python && run_python
+E006_ncl:
+ cd 006_ncl && run_ncl
clean:
cd 001_pgd1 && clean_prep_pgd_xyz
cd 002_ecmwf2lfi && clean_ecmwf2lfi_xyz
cd 003_run && clean_mesonh_xyz
- cd 004_restart && clean_mesonh_xyz
- cd 005_conv2dia && clean_conv2dia
- cd 006_diaprog && clean_diaprog
- cd 007_ncl && clean_ncl
+ cd 004_restart && clean_mesonh_xyz
+ ifneq "$(MNH_PYTHON)" "NO"
+ cd 005_python && clean_python
+ endif
+ cd 006_ncl && clean_ncl
+
+python:
+ cd 005_python && run_python
diff --git a/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/A_RUN_MNH_TOY/run_mesonh_xyz b/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/A_RUN_MNH_TOY/run_mesonh_xyz
index 61d9446dc67cdeb183afe66005dfed70c7e5fec7..cf56bd736ec0fce8c4b6c9ef499eb902287be0e3 100755
--- a/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/A_RUN_MNH_TOY/run_mesonh_xyz
+++ b/MY_RUN/KTEST/013_Iroise_ideal_case_coupling/A_RUN_MNH_TOY/run_mesonh_xyz
@@ -25,4 +25,5 @@ ln -sf ../2_INPUT_TOY/TOYNAMELIST.nam_${TYPE_TOY} TOYNAMELIST.nam
#~~~~~ OASIS
ln -fs ../3_INPUT_OASIS/namcouple_${TYPE_TOY} namcouple
-time Mpirun -np 1 MESONH${XYZ} : -np 1 $PATH_EXETOY/toy_model
+#time Mpirun -np 1 MESONH${XYZ} : -np 1 $PATH_EXETOY/toy_model
+time Mpirun -np 1 $PATH_EXETOY/toy_model : -np 1 MESONH${XYZ}
diff --git a/MY_RUN/KTEST/014_LIMA/002_mesonh/EXSEG1.nam b/MY_RUN/KTEST/014_LIMA/002_mesonh/EXSEG1.nam
index ee3b307108e483a9ae08780bebecf2de7b9d1cbc..0d8a9c3402e73d2443109d3ce917aed225aa493b 100644
--- a/MY_RUN/KTEST/014_LIMA/002_mesonh/EXSEG1.nam
+++ b/MY_RUN/KTEST/014_LIMA/002_mesonh/EXSEG1.nam
@@ -68,13 +68,13 @@
NBUMOD = 1,
XBULEN=3600.,
XBUWRI=3600.,
- NBUKL = 2,
- NBUKH = 51,
+ NBUKL = 1,
+ NBUKH = 50,
LBU_KCP = .FALSE.,
- NBUIL = 2,
- NBUIH = 181,
- NBUJL = 2,
- NBUJH = 2,
+ NBUIL = 1,
+ NBUIH = 180,
+ NBUJL = 1,
+ NBUJH = 1,
LBU_ICP = .FALSE.,
LBU_JCP = .FALSE. /
diff --git a/MY_RUN/KTEST/014_LIMA/003_ncl/plot_LIMA.ncl b/MY_RUN/KTEST/014_LIMA/003_ncl/plot_LIMA.ncl
index a7daead6570cdc6b4f249031185830640f62fc0d..753a1d2ec97a0c960d674b36dea14f611165c718 100644
--- a/MY_RUN/KTEST/014_LIMA/003_ncl/plot_LIMA.ncl
+++ b/MY_RUN/KTEST/014_LIMA/003_ncl/plot_LIMA.ncl
@@ -16,42 +16,47 @@ begin
;=================================================;
; lecture des différents champs
;=================================================;
-vname = "RI___0001___PROC3"
-RI___0001_P3= fichier1->$vname$(0,0,:,0,:)
-RI___0001_P3@long_name="ice water content"
-RI___0001_P3@units="g/kg"
-vname2 = "SV0050001___PROC3"
-NI___0001_P3= fichier1->$vname2$(0,0,:,0,:)
-NI___0001_P3@long_name="ice concentration"
-NI___0001_P3@units="/kg"
+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
-vname3 = "RS___0001___PROC3"
-RS___0001_P3= fichier1->$vname3$(0,0,:,0,:)
-RS___0001_P3@long_name="snow water content"
-RS___0001_P3@units="g/kg"
-vname4 = "RG___0001___PROC3"
-RG___0001_P3= fichier1->$vname4$(0,0,:,0,:)
-RG___0001_P3@long_name="graupel water content"
-RG___0001_P3@units="g/kg"
+vname = "AVEF"
+RI= group_RI->$vname$(0,:,0,:)
+RI@long_name="ice water content"
+RI@units="g/kg"
-vname5 = "SV0060001___PROC3"
-N_IFN_FREE_P3= fichier1->$vname5$(0,0,:,0,:)
-N_IFN_FREE_P3@long_name="concentration of free IFN"
-N_IFN_FREE_P3@units="/kg"
+NI= group_CICE->$vname$(0,:,0,:)
+NI@long_name="ice concentration"
+NI@units="/kg"
-vname6 = "SV0070001___PROC3"
-N_IFN_NUCL_P3= fichier1->$vname6$(0,0,:,0,:)
-N_IFN_NUCL_P3@long_name="concentration of nucleated IFN"
-N_IFN_NUCL_P3@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(0,1:180) ; ZS
+zs = fichier1->ZS(1:180) ; ZS
-xconf=conform(RI___0001_P3,xhat(0:179),1)
+xconf=conform(RI,xhat(0:179),1)
;=================================================;
; Altitude des niveaux modèles
@@ -96,25 +101,25 @@ xconf=conform(RI___0001_P3,xhat(0:179),1)
gsn_define_colormap(wks,"rainbow") ; Choose colormap
res=resmap
res@cnLevelSelectionMode = "AutomaticLevels"
- plot = gsn_csm_contour(wks,RI___0001_P3(:,:),res)
+ plot = gsn_csm_contour(wks,RI(:,:),res)
draw(plot)
frame(wks)
- plot2 = gsn_csm_contour(wks,NI___0001_P3(:,:),res)
+ plot2 = gsn_csm_contour(wks,NI(:,:),res)
draw(plot2)
frame(wks)
- plot3 = gsn_csm_contour(wks,RS___0001_P3(:,:),res)
+ plot3 = gsn_csm_contour(wks,RS(:,:),res)
draw(plot3)
frame(wks)
- plot4 = gsn_csm_contour(wks,RG___0001_P3(:,:),res)
+ plot4 = gsn_csm_contour(wks,RG(:,:),res)
draw(plot4)
frame(wks)
- plot5 = gsn_csm_contour(wks,N_IFN_FREE_P3(:,:),res)
+ plot5 = gsn_csm_contour(wks,N_IFN_FREE(:,:),res)
draw(plot5)
frame(wks)
- plot6 = gsn_csm_contour(wks,N_IFN_NUCL_P3(:,:),res)
+ plot6 = gsn_csm_contour(wks,N_IFN_NUCL(:,:),res)
draw(plot6)
frame(wks)
diff --git a/MY_RUN/KTEST/014_LIMA/004_python/clean_python b/MY_RUN/KTEST/014_LIMA/004_python/clean_python
new file mode 100755
index 0000000000000000000000000000000000000000..d75604a6ad8743f9782400155bb3def9cfd69410
--- /dev/null
+++ b/MY_RUN/KTEST/014_LIMA/004_python/clean_python
@@ -0,0 +1,4 @@
+#!/bin/bash
+rm -f *.png *.pdf *.nc
+rm -Rf __pycache__
+find . -type l -delete
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
new file mode 100644
index 0000000000000000000000000000000000000000..61f335890fa2c86098b3b9e1aeb1c33eaa038cb2
--- /dev/null
+++ b/MY_RUN/KTEST/014_LIMA/004_python/plot_014_LIMA.py
@@ -0,0 +1,65 @@
+#!/usr/bin/env python3
+"""
+
+@author: Quentin Rodier
+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_altitude1DVar
+import os
+
+os.system('rm -f tempgraph*')
+#
+# User's parameter / Namelist
+#
+path=""
+LnameFiles = ['XPREF.1.SEG01.000.nc' ]
+
+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=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'][('/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'][('/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',
+ 'Graupel water content', 'Concentration of free IFN', 'Concentration of nucleated IFN']
+Lcbarlabel = ['g/kg', '/kg', 'g/kg','g/kg',r'x $10^6$/kg','/kg']
+Lxlab = ['x (m)']*len(Lplot)
+Lylab = ['altitude (m)']*len(Lplot)
+Lylim = [(0,16000)]*len(Lplot)
+Lminval = [0, 0, 0, 0, 0.8 ,0]
+Lmaxval = [3.75E-2, 5400, 3E-1, 3E-1, 7, 1800]
+Lstep = [0.25E-2,400,0.01,0.01,0.25, 100]
+Lstepticks = Lstep
+Lfacconv = [1000, 1, 1000, 1000, 1E-6, 1]
+orog = Dvar_coord['f1']['ZS']
+Lcolormap = ['gist_rainbow_r']*len(Lplot)
+LaddWhite = [True, True, True, True, False, 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,Lylim=Lylim,
+ orog=orog, LaddWhite_cm=LaddWhite)
+
+Panel1.save_graph(1,fig1)
diff --git a/MY_RUN/KTEST/003_KW78/003_convdia/run_conv2dia b/MY_RUN/KTEST/014_LIMA/004_python/run_python
similarity index 57%
rename from MY_RUN/KTEST/003_KW78/003_convdia/run_conv2dia
rename to MY_RUN/KTEST/014_LIMA/004_python/run_python
index 60db55d108f1af83689bf6ce9a86a3147c97af83..96e73e8209bbefc840d543ad91254d261e707ec3 100755
--- a/MY_RUN/KTEST/003_KW78/003_convdia/run_conv2dia
+++ b/MY_RUN/KTEST/014_LIMA/004_python/run_python
@@ -5,7 +5,10 @@
#MNH_LIC for details. version 1.
set -x
set -e
-ln -sf ../002_mesonh/KWRAI.1.SEG01.004.{des,lfi,nc} .
-rm -f KWRAI.1.SEG01.004dg.{des,lfi,nc}
-${POSTRUN} conv2dia < dir_conv2dia
+ln -sf ${SRC_MESONH}/src/LIB/Python/* .
+ln -sf ../002_mesonh/XPREF.1.SEG01.000.nc .
+python3 plot_014_LIMA.py
+${POSTRUN} display tempgraph1.png
+#${POSTRUN} convert *.png 014_LIMA.pdf
+#${POSTRUN} evince 014_LIMA.pdf
diff --git a/MY_RUN/KTEST/014_LIMA/Makefile b/MY_RUN/KTEST/014_LIMA/Makefile
index 5ef01ca8d4fcc8a5c6caa9a142b53d18c3d74462..c9647fc057655aedccfee8e4f9ab9f8858a79190 100644
--- a/MY_RUN/KTEST/014_LIMA/Makefile
+++ b/MY_RUN/KTEST/014_LIMA/Makefile
@@ -2,8 +2,16 @@ 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
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
+python:
+ cd 004_python && run_python
diff --git a/README_MNH_CONDA b/README_MNH_CONDA
new file mode 100644
index 0000000000000000000000000000000000000000..d8b0bc0d7f56205e27f10717bcdd302162e0b205
--- /dev/null
+++ b/README_MNH_CONDA
@@ -0,0 +1,159 @@
+#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.
+#
+# Written by : Juan ESCOBAR , for the Meso-NH Support , 16/07/2021
+#
+###############################################################################################
+# #
+# How to install the python package needed for the new graphic script of the version MNH-55X #
+# test case with "conda" or "miniconda" #
+# #
+###############################################################################################
+#
+# MAP
+#
+# I) Installation from Scratch , on your PC for example
+# a) Installation of mini-conda
+# b) Creation of the conda environmenent "mnh_conda_cartopy_offlinedata"
+# c) Using the environment with mesonh
+# d) Optional: export the environment with "conda pack"
+#
+# OR
+#
+# II) Installation from a packed tar.gz file, created with "conda pack"
+# for Linux Supercomputer without internet connection
+
+# I) Installation from scratch, on your PC for example
+# =======================================================
+
+# I- a) Installation of mini-conda
+----------------------------------
+
+# If you don't have already the "conda" command in your PC
+# first install "miniconda"
+
+# Creation of the install directory, for example in your $HOME :
+
+export MNH_MINICONDA=${HOME}/MINICONDA
+mkdir -p ${MNH_MINICONDA}
+cd ${MNH_MINICONDA}
+
+# get/install the last version of miniconda for X64 ( here with python 3.9 )
+
+wget https://repo.anaconda.com/miniconda/Miniconda3-py39_4.9.2-Linux-x86_64.sh
+bash Miniconda3-py39_4.9.2-Linux-x86_64.sh
+
+# during the installation
+# - accept the licence -> yes
+# - give the path of installation > #path -> /home/{your_login}/MINICONDA/miniconda3
+
+
+# when installed initialization of miniconda
+
+source ${MNH_MINICONDA}/miniconda3/etc/profile.d/conda.sh
+
+# REM : the other solution is via "conda init bash" which changes the "~/.bashrc"
+# but I don't like it ...
+
+# I- b) Creation of the conda environment "mnh_conda_cartopy_offlinedata"
+---------------------------------------------------------------------------
+
+#
+# Now , creation of the conda environment "mnh_conda_cartopy_offlinedata"
+# /!\ about 3Go of disk space are needed
+#
+
+conda create -n mnh_conda_cartopy_offlinedata
+conda activate mnh_conda_cartopy_offlinedata
+conda install -c conda-forge netcdf4 cartopy matlibplot
+
+#
+# this is the minimum packages needed for the MesoNH script of the test cases
+#
+
+#
+# for computer without internet connection ( for example compute nodes of super computers )
+# you could add this package to download in advance cartopy data files
+#
+
+conda install -c conda-forge cartopy_offlinedata
+
+# REM : this files add about 2OO Mo and are located in "$CONDA_PREFIX/share/cartopy"
+ ( CONDA_PREFIX is set when you initialize/ source the (mini)conda command
+
+# I-c) Using the environment with mesonh
+-----------------------------------------
+
+#
+# Now to use this conda environment with MesoNH , the best way is to put
+# these lines at the end of your "profile_mesonh{the_good_one}"
+#
+
+export MNH_MINICONDA=${HOME}/MINICONDA
+source ${MNH_MINICONDA}/miniconda3/etc/profile.d/conda.sh
+conda activate mnh_conda_cartopy_offlinedata
+
+# and then use mesonh as usual by sourcing this file
+
+cd .../MNH.../conf
+. profile_mesonh{the_good_one}
+
+
+# I-d) Optional: export the environment with "conda pack"
+-----------------------------------------------------------
+
+#
+# After this, if you were to export your binary installation in a "tar.gz" file to another 'compatible' computer
+# first add the 'conda-pack' package
+
+conda install -c conda-forge conda-pack
+
+# And now export the environment with
+
+conda pack -n mnh_conda_cartopy_offlinedata -o mnh_conda_cartopy_offlinedata.tar.gz
+
+# II) Installation from a packed tar.gz file , created with "conda pack"
+# for Linux Supercomputer without internet connection
+=========================================================
+
+#
+# On Supercomputer without internet connection , like TGCC/CEA Irene or CINES/Occigen
+# you could not install package with the conda command.
+# As a work-around you could download and use a "tar.gz" as prepared on my Linux OpenSuse PC .
+# ( as explained in the previous sessions )
+#
+# REM : you don't need to load any 'module files' like python to do this work-around
+# <-> no conda/python needed in your PATH
+
+
+# First, on your PC computer download the "tar.gz" I prepared and uploaded on the MesoNH web page
+
+wget http://mesonh.aero.obs-mip.fr/mesonh/tmp/MINICONDA/mnh_conda_cartopy_offlinedata.tar.gz
+
+
+# Then, to use it for example on Irene or Occigen computer
+# Copy the "tar.gz" for you PC to Super computer in $CCCWORKDIR (or $WORKDIR ) :
+
+# From your PC
+
+scp mnh_conda_cartopy_offlinedata.tar.gz irene:.
+
+# On Irene
+
+cd $CCCWORKDIR
+mv ~/mnh_conda_cartopy_offlinedata.tar.gz $CCCWORKDIR/.
+mkdir mnh_conda_cartopy_offlinedata
+tar xvf mnh_conda_cartopy_offlinedata.tar.gz -C mnh_conda_cartopy_offlinedata
+
+# Activation of the package, for example at the end of your "profile_mesonh{the_good_one}
+
+source $CCCWORKDIR/mnh_conda_cartopy_offlinedata/bin/activate
+
+# That's all, you can now use the packages included in the "tar.gz"
+#/!\
+#/!\ Warning: you don't have "conda" so you cannot modify this installation/package .
+#/!\
+
+Good tests .
\ No newline at end of file
diff --git a/bin/numabind_core_slurm b/bin/numabind_core_slurm
new file mode 100755
index 0000000000000000000000000000000000000000..f78124c9243ef034a2d4245d1c307fad59c2e987
--- /dev/null
+++ b/bin/numabind_core_slurm
@@ -0,0 +1,23 @@
+#!/bin/bash
+#NB_CORE=128
+Numactl='numactl'
+export IP=${SLURM_PROCID}
+
+if [ "x${IP}" != "x" ]
+then
+export LIP=${SLURM_LOCALID}
+export NP=${SLURM_NTASKS}
+export NN=${SLURM_NNODES}
+export NPN=$(( NP / NN ))
+export NB_CORE=${SLURM_JOB_CPUS_PER_NODE/(*)/}
+export NPC=$(( NB_CORE / NPN ))
+CORE=$(( LIP * NPC ))
+#echo IP=${IP} LIP=${LIP} NP=${NP} NN=${NN} NPN=${NPN} NPC=${NPC} HOST=`hostname` NB_CORE=${NB_CORE} CORE=${CORE}
+#
+# execution
+#
+exec ${Numactl} --physcpubind ${CORE} $*
+else
+exec ${Numactl} --physcpubind 0 $*
+fi
+
diff --git a/bin/spll b/bin/spll
index ba2fd7884933a0040563bbb5c72637abd64dde54..b0e9f3f2c56845dc46cf26e303722784fbbde369 100755
--- a/bin/spll
+++ b/bin/spll
@@ -27,7 +27,8 @@ extern_usersurc_ll.f90|\
extern_userio.f90|fmreadwrit.f90|fm_read_ll.f90|poub.f90|\
mode_glt.*.F90|\
rrtm_.*.F90|srtm_.*.F90|\
-libs4py.f90"
+libs4py.f90|\
+ec_meminfo.F90"
#
if [ "$SUF" = "f" ]
diff --git a/conf/profile_mesonh.ihm b/conf/profile_mesonh.ihm
index 7a9aa3618dc70b0056b463ac73f2742d1c3cf7b1..11c7060f121da936de1c2838919ed1763808d31b 100755
--- a/conf/profile_mesonh.ihm
+++ b/conf/profile_mesonh.ihm
@@ -1,7 +1,7 @@
#!/bin/bash
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
##########################################################
# #
@@ -81,6 +81,11 @@ export MNH_IOCDF4=${MNH_IOCDF4}
export VER_GRIBAPI=${VER_GRIBAPI}
export VERSION_GRIBAPI=${VERSION_GRIBAPI}
#
+# Version of ecCodes
+#
+export VERSION_ECCODES=${VERSION_ECCODES}
+export ECCODES_DEFINITION_PATH=${ECCODES_DEFINITION_PATH}
+#
# Version of Def integer
#
export MNH_INT=${MNH_INT}
@@ -107,6 +112,7 @@ export VER_RTTOV=${VER_RTTOV}
#
export MNH_ECRAD=${MNH_ECRAD}
export VERSION_ECRAD=${VERSION_ECRAD}
+export VER_ECRAD=${VER_ECRAD}
#
# OASIS
#
@@ -130,7 +136,7 @@ export MNH_MEGAN=${MNH_MEGAN}
##########################################################
##########################################################
#
-export XYZ="-\${ARCH}-R\${MNH_REAL}I\${MNH_INT}-\${VERSION_XYZ}\${MNH_ECRAD:+-ECRAD}\${MNH_FOREFIRE:+-FF}\${VER_USER:+-\${VER_USER}}-\${VER_MPI}-\${OPTLEVEL}"
+export XYZ="-\${ARCH}-R\${MNH_REAL}I\${MNH_INT}-\${VERSION_XYZ}\${MNH_ECRAD:+-ECRAD${VER_ECRAD}}\${MNH_FOREFIRE:+-FF}\${VER_USER:+-\${VER_USER}}-\${VER_MPI}-\${OPTLEVEL}"
#[ "x\${VER_USER}" != "x" ] && export XYZ="\${XYZ}-\${VER_USER}"
# PATH to find tools like "makegen, etc ..."
export BIN_TOOLS=${BIN_TOOLS}
diff --git a/src/LIB/Python/Panel_Plot.py b/src/LIB/Python/Panel_Plot.py
new file mode 100644
index 0000000000000000000000000000000000000000..8e095faf07fd46b6dcd4f01df5dddca6b0b5759a
--- /dev/null
+++ b/src/LIB/Python/Panel_Plot.py
@@ -0,0 +1,907 @@
+#!/usr/bin/env python3
+# -*- coding: utf-8 -*-
+"""
+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: 07/2021 Quentin Rodier
+"""
+import matplotlib as mpl
+mpl.use('Agg')
+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():
+
+ def __init__(self, nb_l, nb_c, Lfigsize, bigtitle, titlepad=40, minmaxpad=1.03, timepad=-0.06, lateralminmaxpad=0.86,
+ labelcolorbarpad=6.0, colorbaraspect=20, colorbarpad=0.04 ):
+ self.bigtitle = bigtitle
+ self.Lfigsize = Lfigsize
+ self.nb_l = nb_l
+ self.nb_c = nb_c
+ self.nb_graph = 0 # New independent graph within the subplot
+ self.titlepad = titlepad # Title pad (vertical shift) from graph
+ self.minmaxpad = minmaxpad # Min/Max print pad (vertical shift)
+ self.timepad = timepad # Time print pad (vertical shift)
+ self.colorbarpad = colorbarpad # Colorbar pad (horizontal shift from graph)
+ self.lateralminmaxpad = lateralminmaxpad
+ self.labelcolorbarpad = labelcolorbarpad # Vertical colorbal label pad
+ self.colorbaraspect = colorbaraspect # Ratio of long to short dimensions of colorbar w.r.t. the figure
+
+ # Initialization of the panel plots
+ self.fig = plt.figure(figsize=(self.Lfigsize[0],self.Lfigsize[1]))
+ self.fig.set_dpi(125)
+ self.fig.suptitle(self.bigtitle,fontsize=16)
+
+ def save_graph(self, iplt, fig):
+ """
+ Create a temporary png file of (sub)-plot(s) which can be converted to PDF
+ """
+ self.iplt = iplt
+ self.fig = fig
+
+ self.fig.savefig('tempgraph'+str(self.iplt)) #TODO possibility to change the default value of .png file name
+ self.iplt+=1
+ return self.iplt
+
+ def draw_Backmap(self,drawCoastLines, ax, projo):
+ """
+ Handle drawing of the background plot (coastlines, departements, grid lines and labels)
+ """
+ self.drawCoastLines = drawCoastLines
+ self.projo = projo
+
+ # Grid lines and labels
+ if 'PlateCarree' in str(projo):
+ gl = ax.gridlines(crs=self.projo, draw_labels=True, linewidth=1, color='gray')
+ 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)):
+ ax.coastlines(resolution='10m')
+
+ # Countries border
+ ax.add_feature(cfeature.BORDERS)
+ ax.add_feature(cfeature.LAKES, alpha=0.7)
+
+ def addWhitecm(self, Laddwhite, colormap_in, nb_level):
+ if Laddwhite:
+ color_map = cm.get_cmap(colormap_in, 256)
+ newcolor_map = color_map(np.linspace(0, 1, 256))
+ whites = np.array([1, 1, 1, 1]) #RBG code + opacity
+ for i in range(int(256/nb_level)): newcolor_map[:i, :] = whites
+ newcmp = ListedColormap(newcolor_map)
+ return newcmp
+
+
+ def set_Title(self, ax, i, title, Lid_overlap, xlab, ylab):
+ """
+ Handle top title of each graph
+ Parameters :
+ - titlepad : global attribute for vertical shift placement w.r.t the graph
+ """
+ self.ax = ax
+ self.title = title
+ self.Lid_overlap = Lid_overlap
+ self.i = i
+ #self.ax[self.i].set_xlabel("test", fontweight='bold')
+ if not Lid_overlap:
+ self.ax[self.i].set_title(title, pad=self.titlepad)
+ else: # If graph overlap, title is concatenated
+ new_title = self.ax[self.i].get_title() + ' and ' + title
+ self.ax[self.i].set_title(new_title, pad=self.titlepad)
+
+ def set_xlim(self, ax, i, xlim):
+ """
+ Handle x limits plotted if necessary
+ """
+ self.ax = ax
+ self.xlim = xlim
+ self.i = i
+
+ self.ax[self.i].set_xlim(xlim[0],xlim[1])
+
+ def set_ylim(self, ax, i, ylim):
+ """
+ Handle x limits plotted if necessary
+ """
+ self.ax = ax
+ self.ylim = ylim
+ self.i = i
+
+ self.ax[self.i].set_ylim(ylim[0],ylim[1])
+
+ def set_XYaxislab(self, ax, i, xlab, ylab):
+ """
+ Handle x and y axis labels
+ """
+ self.ax = ax
+ self.xlab = xlab
+ self.ylab = ylab
+ self.i = i
+
+ # This handing label is a known issue with GeoAxes of cartopy
+ # https://stackoverflow.com/questions/35479508/cartopy-set-xlabel-set-ylabel-not-ticklabels
+ # https://github.com/SciTools/cartopy/issues/1332
+ if 'GeoAxes' in str(type(self.ax[self.i])):
+ self.ax[self.i].text(-0.11, 0.45, ylab, verticalalignment='top', horizontalalignment='left',
+ rotation='vertical', rotation_mode='anchor', transform=self.ax[self.i].transAxes, color='black', fontsize=11)
+ self.ax[self.i].text(0.45, -0.06, xlab, verticalalignment='top', horizontalalignment='left',
+ rotation='horizontal', rotation_mode='anchor', transform=self.ax[self.i].transAxes, color='black', fontsize=11)
+ else:
+ self.ax[self.i].set_xlabel(xlab)
+ self.ax[self.i].set_ylabel(ylab)
+
+ def addLine(self, ax, beg_coord, end_coord, color='black', linewidth=1):
+ self.ax = ax
+ self.beg_coord = beg_coord
+ self.end_coord = end_coord
+ self.color = color
+ self.linewidth = linewidth
+
+ x1, y1 = [self.beg_coord[0],self.end_coord[0]], [self.beg_coord[1], self.end_coord[1]]
+ ax.plot(x1, y1,color=self.color,linewidth=self.linewidth)
+
+ def print_minmax(self, var, title):
+ print(str(title) + " min = " + str(np.nanmin(var)) + " max = " + str(np.nanmax(var)))
+
+ def set_minmaxText(self, ax, i, var, title, Lid_overlap, facconv):
+ """
+ Show min and max value Text in the plot
+ If overlap variable, text is align to the right
+ TODO : handle more than 2 overlap variables
+ """
+ self.ax = ax
+ self.var = var
+ self.i = i
+ self.title = title
+ self.facconv = facconv
+
+ strtext = " min = " + "{:.3e}".format(np.nanmin(var*facconv)) + " max = " + "{:.3e}".format(np.nanmax(var*facconv))
+ if not Lid_overlap:
+ self.ax[self.i].text(0.01, self.minmaxpad, strtext, verticalalignment='top', horizontalalignment='left',
+ transform=self.ax[self.i].transAxes, color='black', fontsize=10)
+ else:
+ self.ax[self.i].text(self.lateralminmaxpad, self.minmaxpad, strtext, verticalalignment='top', horizontalalignment='right',
+ transform=self.ax[self.i].transAxes, color='black', fontsize=10)
+ # Print to help choose min/max value for ticks
+ self.print_minmax(var*facconv, title)
+
+ def showTimeText(self, ax, i, timetxt):
+ """
+ Show time validity
+ """
+ self.ax = ax
+ self.i = i
+ self.timetxt = timetxt
+
+ strtext = "Time = " + timetxt
+ self.ax[self.i].text(0.0, self.timepad, strtext, verticalalignment='top', horizontalalignment='left',
+ transform=self.ax[self.i].transAxes, color='black', fontsize=10)
+
+
+ def psectionV(self, Lxx=[], Lzz=[], Lvar=[], Lxlab=[], Lylab=[], Ltitle=[], Lminval=[], Lmaxval=[],
+ Lstep=[], Lstepticks=[], Lcolormap=[], Lcbarlabel=[], LcolorLine=[],
+ Lfacconv=[], ax=[], Lid_overlap=[], colorbar=True, orog=[], Lxlim=[], Lylim=[], Ltime=[], Lpltype=[], LaddWhite_cm=[]):
+ """
+ Horizontal cross section plot
+ Parameters :
+ - Lxx : List of x or y coordinate variable or time axis
+ - Lzz : List of z coordinates variable
+ - Lvar : List of variables to plot
+ - Lxlab : List of x-axis label
+ - Lylab : List of y-axis label
+ - Lxlim : List of x (min, max) value plotted
+ - Lylim : List of y (min, max) value plotted
+ - Ltime : List of time (validity)
+ - Ltitle : List of sub-title
+ - Lminval: List of minimum value for each colorbar
+ - Lmaxval: List of maximum value for each colorbar
+ - Lstep : List of color-steps for each colorbar
+ - Lstepticks : List of value of labels for each colorbar
+ - Lcolormap : List of colormap
+ - LcolorLine : List of colors for colors arg of contour (color line only)
+ - Lcbarlabel : List of colorbar label legend (units)
+ - Lfacconv : List of factors for unit conversion of each variables
+ - ax : List of fig.axes for ploting multiple different types of plots in a subplot panel
+ - Lid_overlap: List of number index of plot to overlap current variables
+ - Lpltype : List of types of plot 'cf' or 'c'. cf=contourf, c=contour (lines only)
+ - colorbar : show colorbar or not
+ - LaddWhite_cm : List of boolean to add white color to a colormap at the first (low value) tick colorbar
+ """
+ self.ax = ax
+ firstCall = (len(self.ax) == 0)
+
+ # Initialize default value w.r.t to the number of plots
+# D={'Lxlab':Lxlab, 'Lylab':Lylab, 'Ltitle':Ltitle,'Lminval':Lminval, 'Lmaxval':Lmaxval,
+# 'Lstep':Lstep, 'Lstepticks':Lstepticks, 'Lcolormap':Lcolormap, 'Lcbarlabel':Lcbarlabel, 'Lfacconv':Lfacconv, 'Ltime':Ltime,
+# 'LaddWhite_cm':LaddWhite_cm, 'Lpltype':Lpltype}
+# D = initialize_default_val(Lvar, D)
+
+ # Default values
+ if not Lfacconv: Lfacconv = [1.0]*len(Lvar)
+ if not Lcolormap and not LcolorLine: Lcolormap=['gist_rainbow_r']*len(Lvar) # If no color given, a cmap is given
+ if not Lcolormap: LcolorLine=['black']*len(Lvar)
+ if not Lpltype: Lpltype=['cf']*len(Lvar)
+ if not LaddWhite_cm: LaddWhite_cm=[False]*len(Lvar)
+ if not Lylab: Lylab = ['']*len(Lvar)
+ if not Lxlab: Lxlab = ['']*len(Lvar)
+ # Add an extra percentage of the top max value for forcing the colorbar show the true user maximum value (correct a bug)
+ Lmaxval = list(map(lambda x, y: x + 1E-6*y, Lmaxval, Lstep) ) #The extra value is 1E-6 times the step ticks of the colorbar
+
+ # On all variables to plot
+ for i,var in enumerate(Lvar):
+ if firstCall: #1st call
+ iax = i
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,i+1))
+ self.nb_graph+=1
+ elif Lid_overlap != []: #overlapping plot
+ iax = Lid_overlap[i]
+ else: #existing ax with no overlapping (graphd appended to existing panel)
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph+1))
+ self.nb_graph+=1
+ iax = len(self.ax)-1 # The ax index of the new coming plot is the length of the existant ax -1 for indices matter
+
+ # Colors normalization
+ norm = mpl.colors.Normalize(vmax=Lmaxval[i], vmin=Lminval[i])
+
+ # Print min/max (stout and on plot)
+ self.set_minmaxText(self.ax, iax, var, Ltitle[i], Lid_overlap, Lfacconv[i])
+
+ # 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
+ Lstepticks[i] = Lstep[i]
+
+ levels_contour = np.arange(Lminval[i],Lmaxval[i],step=Lstep[i])
+
+ # Add White to colormap
+ if LaddWhite_cm[i] and Lcolormap: Lcolormap[i]=self.addWhitecm(LaddWhite_cm[i], Lcolormap[i], len(levels_contour))
+
+ # Plot
+ if Lpltype[i]=='c': # Contour
+ if LcolorLine:
+ cf = self.ax[iax].contour(Lxx[i], Lzz[i], var*Lfacconv[i], levels=levels_contour,
+ norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], colors=LcolorLine[i])
+ else:
+ cf = self.ax[iax].contour(Lxx[i], Lzz[i], var*Lfacconv[i], levels=levels_contour,
+ norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], cmap=Lcolormap[i])
+ else: # Contourf
+ cf = self.ax[iax].contourf(Lxx[i], Lzz[i], var*Lfacconv[i], levels=levels_contour,
+ norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], cmap=Lcolormap[i])
+
+ # Title
+ self.set_Title(self.ax, iax, Ltitle[i], Lid_overlap,Lxlab[i], Lylab[i])
+
+ # X/Y Axis label
+ self.set_XYaxislab(self.ax, iax, Lxlab[i], Lylab[i])
+
+ # X/Y Axis limits value
+ if Lxlim:
+ try:
+ self.set_xlim(self.ax, iax, Lxlim[i])
+ except:
+ pass
+ if Lylim:
+ try:
+ self.set_ylim(self.ax, iax, Lylim[i])
+ except:
+ pass
+
+ # Color label on contour-line
+ if Lpltype[i]=='c': # Contour
+ self.ax[iax].clabel(cf)
+ #self.ax[iax].clabel(cf, levels=np.arange(Lminval[i],Lmaxval[i],step=Lstep[i])) #TODO bug, levels not recognized
+
+ #Filling area under topography
+ if not orog==[]:
+ self.ax[iax].fill_between(Lxx[i][0,:], orog, color='black')
+
+ # Colorbar
+ if colorbar:
+ cb=plt.colorbar(cf, ax=self.ax[iax], fraction=0.031, pad=self.colorbarpad, ticks=np.arange(Lminval[i],Lmaxval[i],Lstepticks[i]), aspect=self.colorbaraspect)
+ cb.ax.set_title(Lcbarlabel[i], pad = self.labelcolorbarpad, loc='left') #This creates a new AxesSubplot only for the colorbar y=0 ==> location at the bottom
+
+ return self.fig
+
+ def pXY_lines(self, Lxx=[], Lyy=[], Lxlab=[], Lylab=[], Ltitle=[], Llinetype=[], Llinewidth=[],
+ Llinecolor=[], Llinelabel=[], LfacconvX=[], LfacconvY=[], ax=[], id_overlap=None, Lxlim=[],
+ Lylim=[], Ltime=[], LaxisColor=[]):
+ """
+ XY (multiple)-lines plot
+ 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
+ - Lylab : List of y-axis label
+ - Lxlim : List of x (min, max) value plotted
+ - Lylim : List of y (min, max) value plotted
+ - Ltime : List of time (validity)
+ - Ltitle : List of sub-title
+ - Llinewidth : List of lines thickness
+ - Llinetype : List of line types
+ - Lcolorlines: List of color lines
+ - Llinelabel : List of legend label lines
+ - LfacconvX/Y: List of factors for unit conversion of the variables/coordinates to plot on X and Y axis
+ - ax : List of fig.axes for ploting multiple different types of plots in a subplot panel
+ - Lid_overlap: List of number index of plot to overlap current variables
+ - LaxisColor : List of colors for multiple x-axis overlap
+ """
+ self.ax = ax
+ firstCall = (len(self.ax) == 0)
+ # Defaults value convert to x number of variables list
+ if not LfacconvX: LfacconvX = [1.0]*len(Lxx)
+ if not LfacconvY: LfacconvY = [1.0]*len(Lxx)
+ if not Llinewidth: Llinewidth = [1.0]*len(Lxx)
+ if not Llinecolor: Llinecolor = ['blue']*len(Lxx)
+ if not Llinetype: Llinetype = ['-']*len(Lxx)
+ if not Llinelabel: Llinelabel = ['']*len(Lxx)
+ if not LaxisColor: LaxisColor = ['black']*len(Lxx)
+ if not Lylab: Lylab = ['']*len(Lxx)
+ if not Lxlab: Lxlab = ['']*len(Lxx)
+
+ if firstCall: # 1st call
+ iax = 0
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,1, label='graph axe x down'))
+ self.nb_graph+=1
+ elif id_overlap: # overlapping plot with a different x-axis
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph, label='graph axe x top',frame_on=False))
+ iax = len(self.ax)-1
+ else: # existing ax with no overlapping (graph appended to existing panel)
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph+1))
+ self.nb_graph+=1
+ iax = len(self.ax)-1 # The ax index of the new coming plot is the length of the existant ax -1 for indices matter
+
+ # On all variables to plot
+ for i,var in enumerate(Lxx):
+ # Print time validity
+ if Ltime: self.showTimeText(self.ax, iax, str(Ltime[i]))
+
+ # Plot
+ cf = self.ax[iax].plot(Lxx[i]*LfacconvX[i], Lyy[i]*LfacconvY[i], color=Llinecolor[i], ls=Llinetype[i],
+ label=Llinelabel[i], linewidth=Llinewidth[i])
+ # Legend
+ #TODO : Handling legend with overlap two axis lines in the same box. For now, placement is by hand
+ if not id_overlap:
+ self.ax[iax].legend(loc='upper right', bbox_to_anchor=(1, 0.95))
+ else:
+ self.ax[iax].legend(loc='upper right', bbox_to_anchor=(1, 0.90))
+
+ # Title
+ if Ltitle: self.set_Title(self.ax, iax, Ltitle[i], id_overlap,Lxlab[i], Lylab[i])
+
+ # X/Y Axis label
+ if id_overlap:
+ self.ax[iax].xaxis.tick_top()
+ self.ax[iax].xaxis.set_label_position('top')
+ self.ax[iax].set_xlabel(Lxlab[i])
+ self.ax[iax].set_ylabel(Lylab[i])
+ else:
+ self.set_XYaxislab(self.ax, iax, Lxlab[i], Lylab[i])
+
+ self.ax[iax].tick_params(axis='x', colors=LaxisColor[i])
+
+ # X/Y Axis limits value
+ if Lxlim:
+ try:
+ self.set_xlim(self.ax, iax, Lxlim[i])
+ except:
+ pass
+ if Lylim:
+ try:
+ self.set_ylim(self.ax, iax, Lylim[i])
+ except:
+ pass
+ return self.fig
+
+ def psectionH(self, lon=[],lat=[], Lvar=[], Lcarte=[], Llevel=[], Lxlab=[], Lylab=[], Ltitle=[], Lminval=[], Lmaxval=[],
+ Lstep=[], Lstepticks=[], Lcolormap=[], LcolorLine=[], Lcbarlabel=[], Lproj=[], Lfacconv=[], coastLines=True, ax=[],
+ Lid_overlap=[], colorbar=True, Ltime=[], LaddWhite_cm=[], Lpltype=[], Lcbformatlabel=[]):
+ """
+ Horizontal cross section plot
+ Parameters :
+ - lon : longitude 2D array
+ - lat : latitude 2D array
+ - Lvar : List of variables to plot
+ - Lcarte : Zooming [lonmin, lonmax, latmin, latmax]
+ - Llevel : List of k-level value for the section plot (ignored if variable is already 2D)
+ - Lxlab : List of x-axis label
+ - Lylab : List of y-axis label
+ - Ltitle : List of sub-title
+ - Ltime : List of time (validity)
+ - Lminval: List of minimum value for each colorbar
+ - Lmaxval: List of maximum value for each colorbar
+ - Lstep : List of color-steps for each colorbar
+ - Lstepticks : List of value of labels for each colorbar
+ - Lcolormap : List of colormap
+ - LcolorLine : List of colors for colors arg of contour (color line only)
+ - Lcbarlabel : List of colorbar label legend (units)
+ - Lproj : List of ccrs cartopy projection ([] for cartesian coordinates)
+ - Lfacconv : List of factors for unit conversion of each variables
+ - coastLines : Boolean to plot coast lines and grid lines
+ - ax : List of fig.axes for ploting multiple different types of plots in a subplot panel
+ - Lid_overlap : List of number index of plot to overlap current variables
+ - colorbar : show colorbar or not
+ - Lpltype : List of types of plot 'cf' or 'c'. cf=contourf, c=contour (lines only)
+ - LaddWhite_cm : List of boolean to add white color to a colormap at the first (low value) tick colorbar
+ - Lcbformatlabel: List of boolean to reduce the format to exponential 1.1E+02 format colorbar label
+ """
+ self.ax = ax
+ firstCall = (len(self.ax) == 0)
+
+ # Initialize default value w.r.t to the number of plots
+# D={'lon':lon, 'lat':lat, 'Lcarte':Lcarte, 'Llevel':Llevel, 'Lxlab':Lxlab, 'Lylab':Lylab, 'Ltitle':Ltitle,'Lminval':Lminval, 'Lmaxval':Lmaxval,
+# 'Lstep':Lstep, 'Lstepticks':Lstepticks, 'Lcolormap':Lcolormap, 'Lcbarlabel':Lcbarlabel, 'Lproj':Lproj, 'Lfacconv':Lfacconv, 'Ltime':Ltime,
+# 'LaddWhite_cm':LaddWhite_cm, 'Lpltype':Lpltype}
+# D = initialize_default_val(Lvar, D)
+
+ # If all plots are not using conversion factor, convert it to List
+ if not Lfacconv: Lfacconv = [1.0]*len(Lvar)
+ if not Lylab: Lylab = ['']*len(Lvar)
+ if not Lxlab: Lxlab = ['']*len(Lvar)
+ if not Lcolormap and not LcolorLine: Lcolormap=['gist_rainbow_r']*len(Lvar) # If no color given, a cmap is given
+ if not Lcolormap: LcolorLine=['black']*len(Lvar)
+ if not Lpltype: Lpltype=['cf']*len(Lvar)
+ if not LaddWhite_cm: LaddWhite_cm=[False]*len(Lvar)
+ if not Lcbformatlabel: Lcbformatlabel=[False]*len(Lvar)
+ # Add an extra percentage of the top max value for forcing the colorbar show the true user maximum value (correct a bug)
+ if Lstep: Lmaxval = list(map(lambda x, y: x + 1E-6*y, Lmaxval, Lstep) ) #The extra value is 1E-6 times the step ticks of the colorbar
+
+ # This following must be after the extra percentage top value addition
+ if not Lstep: Lstep=[None]*len(Lvar)
+ if not Lstepticks: Lstepticks=[None]*len(Lvar)
+
+ # On all variables to plot
+ for i,var in enumerate(Lvar):
+ if firstCall: #1st call
+ iax = i
+ if Lproj:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,i+1, projection = Lproj[i]))
+ else: # Cartesian coordinates
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,i+1))
+ self.nb_graph+=1
+ elif Lid_overlap != []: #overlapping plot
+ iax = Lid_overlap[i]
+ else: #existing ax with no overlapping (graphd appended to existing panel)
+ if Lproj:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph+1, projection = Lproj[i]))
+ else: # Cartesian coordinates
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph+1))
+ self.nb_graph+=1
+ iax = len(self.ax)-1 # The ax index of the new coming plot is the length of the existant ax -1 for indices matter
+
+ #Colors normalization
+ norm = mpl.colors.Normalize(vmax=Lmaxval[i], vmin=Lminval[i])
+
+ # Zooming
+ if len(Lcarte) == 4: #zoom
+ self.ax[iax].set_xlim(Lcarte[0], Lcarte[1])
+ self.ax[iax].set_ylim(Lcarte[2], Lcarte[3])
+ # Variable to plot w.r.t dimensions
+ if var.ndim==2:
+ vartoPlot = var[:,:]
+ else:
+ vartoPlot = var[Llevel[i],:,:]
+
+ # Print min/max (stout and on plot)
+ self.set_minmaxText(self.ax, iax, vartoPlot, Ltitle[i], Lid_overlap, Lfacconv[i])
+
+ # 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
+ Lstepticks[i] = Lstep[i]
+
+ levels_contour = np.arange(Lminval[i],Lmaxval[i],step=Lstep[i])
+
+ # Add White to colormap
+ if LaddWhite_cm[i] and Lcolormap: Lcolormap[i]=self.addWhitecm(LaddWhite_cm[i], Lcolormap[i], len(levels_contour))
+
+ # Plot
+ if Lproj:
+ if Lpltype[i]=='c': # Contour
+ if LcolorLine:
+ cf = self.ax[iax].contour(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,transform=Lproj[i],
+ norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], colors=LcolorLine[i])
+ else:
+ cf = self.ax[iax].contour(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,transform=Lproj[i],
+ norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], cmap=Lcolormap[i])
+ else:
+ cf = self.ax[iax].contourf(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,transform=Lproj[i],
+ norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], cmap=Lcolormap[i])
+ else: # Cartesian coordinates
+ if Lpltype[i]=='c': # Contour
+ cf = self.ax[iax].contour(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,
+ norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], colors=LcolorLine[i])
+ else:
+ cf = self.ax[iax].contourf(lon[i], lat[i], vartoPlot*Lfacconv[i], levels=levels_contour,
+ norm=norm, vmin=Lminval[i], vmax=Lmaxval[i], cmap=Lcolormap[i])
+ # Title
+ self.set_Title(self.ax, iax, Ltitle[i], Lid_overlap,Lxlab[i], Lylab[i])
+
+ # Coastlines / Grid lines and labels
+ if Lproj: self.draw_Backmap(coastLines, self.ax[iax], Lproj[i])
+
+ # X/Y Axis
+ self.set_XYaxislab(self.ax, iax, Lxlab[i], Lylab[i])
+
+ # Color label on contour-line
+ if Lpltype[i]=='c': # Contour
+ if 'GeoAxes' in str(type(self.ax[self.i])): # cartopy does not like the levels arguments in clabel, known issue
+ self.ax[iax].clabel(cf)
+ else:
+ self.ax[iax].clabel(cf, levels=np.arange(Lminval[i],Lmaxval[i],step=Lstep[i]))
+
+ # Colorbar
+ if colorbar:
+ cb=plt.colorbar(cf, ax=self.ax[iax], fraction=0.031, pad=self.colorbarpad, ticks=np.arange(Lminval[i],Lmaxval[i],Lstepticks[i]), aspect=self.colorbaraspect)
+ cb.ax.set_title(Lcbarlabel[i], pad = self.labelcolorbarpad, loc='left') #This creates a new AxesSubplot only for the colorbar y=0 ==> location at the bottom
+ if Lcbformatlabel[i]: cb.ax.set_yticklabels(["{:.1E}".format(i) for i in cb.get_ticks()])
+
+ return self.fig
+
+ def pvector(self, Lxx=[], Lyy=[], Lvar1=[], Lvar2=[], Lcarte=[], Llevel=[], Lxlab=[], Lylab=[],
+ Ltitle=[], Lwidth=[], Larrowstep=[], Lcolor=[], Llegendval=[], Lcbarlabel=[],
+ Lproj=[], Lfacconv=[], ax=[], coastLines=True, Lid_overlap=[], Ltime=[], Lscale=[],
+ Lylim=[], Lxlim=[]):
+ """
+ Horizontal vectors lines
+ 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)
+ - Lvar2 : List of wind-component along y-axis : v-component for horizontal section / w-component for vertical section
+ - Lcarte : Zooming [lonmin, lonmax, latmin, latmax]
+ - Llevel : List of k-level value for the horizontal section plot (ignored if variable is already 2D)
+ - Lxlab : List of x-axis label
+ - Lylab : List of y-axis label
+ - Lxlim : List of x (min, max) value plotted
+ - Lylim : List of y (min, max) value plotted
+ - Ltitle : List of sub-titles
+ - Ltime : List of time (validity)
+ - Lwidth : List of thickness of the arrows
+ - Lscale : List of scale for the length of the arrows (high value <=> small length)
+ - Larrowstep : List of sub-sample (frequency) if too much arrows
+ - Lcolor : List of colors for the arrows (default: black)
+ - Llegendval : List of value for the legend of the default arrow
+ - Lcbarlabel : List of labels for the legend of the default arrow
+ - Lproj : List of ccrs cartopy projection
+ - Lfacconv : List of factors for unit conversion of each variables
+ - coastLines : Boolean to plot coast lines and grid lines
+ - ax : List of fig.axes for ploting multiple different types of plots in a subplot panel
+ - Lid_overlap : List of number index of plot to overlap current variables
+ """
+ self.ax = ax
+ firstCall = (len(self.ax) == 0)
+ # If all plots are not using conversion factor, convert it to List
+ if not Lfacconv: Lfacconv = [1.0]*len(Lvar1)
+ if not Lcolor: Lcolor = ['black']*len(Lvar1)
+ if not Lscale : Lscale = [None]*len(Lvar1)
+ if not Lylab: Lylab = ['']*len(Lvar1)
+ if not Lxlab: Lxlab = ['']*len(Lvar1)
+ # On all variables to plot
+ for i,var1 in enumerate(Lvar1):
+ if firstCall: #1st call
+ iax = i
+ if Lproj:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,i+1, projection = Lproj[i]))
+ else:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,i+1))
+ self.nb_graph+=1
+ elif Lid_overlap != []: #overlapping plot
+ iax = Lid_overlap[i]
+ else: #existing ax with no overlapping (graphd appended to existing panel)
+ if Lproj:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph+1, projection = Lproj[i]))
+ else:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph+1))
+ self.nb_graph+=1
+ iax = len(self.ax)-1 # The ax index of the new coming plot is the length of the existant ax -1 for indices matter
+
+ # Zooming
+ if len(Lcarte) == 4: #zoom
+ self.ax[iax].set_xlim(Lcarte[0], Lcarte[1])
+ self.ax[iax].set_ylim(Lcarte[2], Lcarte[3])
+
+ # Variable to plot w.r.t dimensions
+ if var1.ndim==2:
+ vartoPlot1 = var1[:,:]
+ vartoPlot2 = Lvar2[i][:,:]
+ else: # Variable is 3D : only for horizontal section
+ vartoPlot1 = var1[Llevel[i],:,:]
+ vartoPlot2 = Lvar2[i][Llevel[i],:,:]
+
+ # Print min/max val to help choose colorbar steps
+ self.set_minmaxText(self.ax, iax, np.sqrt(vartoPlot1**2 + vartoPlot2**2), Ltitle[i], Lid_overlap, Lfacconv[i])
+
+ # Print time validity
+ if Ltime: self.showTimeText(self.ax, iax, str(Ltime[i]))
+
+ # Plot
+ axeX = Lxx[i]
+ axeY = Lyy[i]
+ if Lxx[i].ndim == 2:
+ cf = self.ax[iax].quiver(axeX[::Larrowstep[i],::Larrowstep[i]], axeY[::Larrowstep[i],::Larrowstep[i]],
+ vartoPlot1[::Larrowstep[i],::Larrowstep[i]], vartoPlot2[::Larrowstep[i],::Larrowstep[i]],
+ width=Lwidth[i] ,angles='uv', color=Lcolor[i],scale=Lscale[i])
+ else:
+ cf = self.ax[iax].quiver(axeX[::Larrowstep[i]], axeY[::Larrowstep[i]],
+ vartoPlot1[::Larrowstep[i],::Larrowstep[i]], vartoPlot2[::Larrowstep[i],::Larrowstep[i]],
+ width=Lwidth[i] ,angles='uv', color=Lcolor[i], scale=Lscale[i])
+ # Title
+ self.set_Title(self.ax, iax, Ltitle[i], Lid_overlap,Lxlab[i], Lylab[i])
+
+ # X/Y Axis Label
+ self.set_XYaxislab(self.ax, iax, Lxlab[i], Lylab[i])
+
+ # X/Y Axis limits value
+ if Lxlim:
+ try:
+ self.set_xlim(self.ax, iax, Lxlim[i])
+ except:
+ pass
+ if Lylim:
+ try:
+ self.set_ylim(self.ax, iax, Lylim[i])
+ except:
+ pass
+
+ # Coastlines:
+ if Lproj: self.draw_Backmap(coastLines, self.ax[iax], Lproj[i])
+
+ # Arrow legend key
+ qk = self.ax[iax].quiverkey(cf, 1.0, -0.05, Llegendval[i], str(Llegendval[i]) + Lcbarlabel[i], labelpos='E', color='black')
+
+ return self.fig
+
+ def pstreamline(self, Lxx=[], Lyy=[], Lvar1=[], Lvar2=[], Lcarte=[], Llevel=[], Lxlab=[], Lylab=[], Llinewidth=[], Ldensity=[],
+ Ltitle=[], Lcolor=[], Lproj=[], Lfacconv=[], ax=[], coastLines=True, Lid_overlap=[], Ltime=[],
+ Lylim=[], Lxlim=[]):
+ """
+ Wind stream lines
+ 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)
+ - Lvar2 : List of wind-component along y-axis : v-component for horizontal section / w-component for vertical section
+ - Lcarte : Zooming [lonmin, lonmax, latmin, latmax]
+ - Llevel : List of k-level value for the horizontal section plot (ignored if variable is already 2D)
+ - Lxlab : List of x-axis label
+ - Lylab : List of y-axis label
+ - Lxlim : List of x (min, max) value plotted
+ - Lylim : List of y (min, max) value plotted
+ - Ltitle : List of sub-titles
+ - Ltime : List of time (validity)
+ - Llinewidth : List of lines thickness
+ - Ldensity : List of density that control the closeness of streamlines
+ - Lcolor : List of colors for the streamline (default: black)
+ - Lproj : List of ccrs cartopy projection
+ - Lfacconv : List of factors for unit conversion of each variables
+ - coastLines : Boolean to plot coast lines and grid lines
+ - ax : List of fig.axes for ploting multiple different types of plots in a subplot panel
+ - Lid_overlap : List of number index of plot to overlap current variables
+ """
+ self.ax = ax
+ firstCall = (len(self.ax) == 0)
+ # If all plots are not using conversion factor, convert it to List
+ if not Lfacconv: Lfacconv = [1.0]*len(Lvar1)
+ if not Lcolor: Lcolor = ['black']*len(Lvar1)
+ if not Lylab: Lylab = ['']*len(Lvar1)
+ if not Lxlab: Lxlab = ['']*len(Lvar1)
+ if not Llinewidth: Llinewidth = [1.0]*len(Lvar1)
+ if not Ldensity: Ldensity = [1.0]*len(Lvar1)
+
+ # On all variables to plot
+ for i,var1 in enumerate(Lvar1):
+ if firstCall: #1st call
+ iax = i
+ if Lproj:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,i+1, projection = Lproj[i]))
+ else:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,i+1))
+ self.nb_graph+=1
+ elif Lid_overlap != []: #overlapping plot
+ iax = Lid_overlap[i]
+ else: #existing ax with no overlapping (graphd appended to existing panel)
+ if Lproj:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph+1, projection = Lproj[i]))
+ else:
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph+1))
+ self.nb_graph+=1
+ iax = len(self.ax)-1 # The ax index of the new coming plot is the length of the existant ax -1 for indices matter
+
+ # Zooming
+ if len(Lcarte) == 4: #zoom
+ self.ax[iax].set_xlim(Lcarte[0], Lcarte[1])
+ self.ax[iax].set_ylim(Lcarte[2], Lcarte[3])
+
+ # Variable to plot w.r.t dimensions
+ if var1.ndim==2:
+ vartoPlot1 = var1[:,:]
+ vartoPlot2 = Lvar2[i][:,:]
+ else: # Variable is 3D : only for horizontal section
+ vartoPlot1 = var1[Llevel[i],:,:]
+ vartoPlot2 = Lvar2[i][Llevel[i],:,:]
+
+ # Print min/max val to help choose steps
+ self.set_minmaxText(self.ax, iax, np.sqrt(vartoPlot1**2 + vartoPlot2**2), Ltitle[i], Lid_overlap, Lfacconv[i])
+
+ # Print time validity
+ if Ltime: self.showTimeText(self.ax, iax, str(Ltime[i]))
+
+ # Plot
+ cf = self.ax[iax].streamplot(Lxx[i], Lyy[i], vartoPlot1, vartoPlot2, density=Ldensity[i], linewidth=Llinewidth[i], color=Lcolor[i])
+
+ # Title
+ self.set_Title(self.ax, iax, Ltitle[i], Lid_overlap,Lxlab[i], Lylab[i])
+
+ # X/Y Axis Label
+ self.set_XYaxislab(self.ax, iax, Lxlab[i], Lylab[i])
+
+ # X/Y Axis limits value
+ if Lxlim:
+ try:
+ self.set_xlim(self.ax, iax, Lxlim[i])
+ except:
+ pass
+ if Lylim:
+ try:
+ self.set_ylim(self.ax, iax, Lylim[i])
+ except:
+ pass
+
+ # Coastlines:
+ if Lproj: self.draw_Backmap(coastLines, self.ax[iax], Lproj[i])
+
+ return self.fig
+
+ def pXY_bar(self, Lbins=[], Lvar=[], Lxlab=[], Lylab=[], Ltitle=[], Lcolor=[], Lwidth=[],
+ Llinecolor=[], Llinewidth=[], Lfacconv=[], ax=[], id_overlap=None, Lxlim=[],
+ Lylim=[], Ltime=[], LaxisColor=[]):
+ """
+ XY Histogram
+ Parameters :
+ - Lbins : List of bins
+ - Lvar : List of the value for each bin
+ - Lxlab : List of x-axis label
+ - Lylab : List of y-axis label
+ - Ltitle : List of sub-title
+ - Lcolor : List of color (or sequence of colors for each value) of the bars
+ - Lwidth : List of width of the bars
+ - Llinecolor : List of line color of the bar edges
+ - Llinewidth : List of lines thickness of the bar edges
+ - Lfacconv : List of factors for unit conversion of each variables
+ - Lxlim : List of x (min, max) value plotted
+ - Lylim : List of y (min, max) value plotted
+ - Ltime : List of time (validity)
+ - ax : List of fig.axes for ploting multiple different types of plots in a subplot panel
+ - Lid_overlap: List of number index of plot to overlap current variables
+ - LaxisColor : List of colors for multiple x-axis overlap
+ """
+ self.ax = ax
+ firstCall = (len(self.ax) == 0)
+ # Defaults value convert to x number of variables list
+ if not Lfacconv: Lfacconv = [1.0]*len(Lvar)
+ if not LaxisColor: LaxisColor = ['black']*len(Lvar)
+ if not Lylab: Lylab = ['']*len(Lvar)
+ if not Lxlab: Lxlab = ['']*len(Lvar)
+ if not Lcolor: Lcolor = ['black']*len(Lvar)
+ if not Lwidth: Lwidth = [1]*len(Lvar)
+ if not Llinecolor: Llinecolor = ['black']*len(Lvar)
+ if not Llinewidth: Llinewidth = [0]*len(Lvar)
+
+ # On all variables to plot
+ for i,var in enumerate(Lvar):
+ if firstCall: # 1st call
+ iax = i
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,i+1, label='graph axe x down'))
+ self.nb_graph+=1
+ elif id_overlap: # overlapping plot with a different x-axis
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph, label='graph axe x top',frame_on=False))
+ iax = len(self.ax)-1
+ else: # existing ax with no overlapping (graph appended to existing panel)
+ self.ax.append(self.fig.add_subplot(self.nb_l,self.nb_c,self.nb_graph+1))
+ self.nb_graph+=1
+ print(len(self.ax))
+ iax = len(self.ax)-1 # The ax index of the new coming plot is the length of the existant ax -1 for indices matter
+
+ # Print time validity
+ if Ltime: self.showTimeText(self.ax, iax, str(Ltime[i]))
+
+ # Bins by labels
+ labels = np.array([str(L) for L in Lbins[i]])
+
+ # Plot
+ cf = self.ax[iax].bar(labels, var*Lfacconv[i], width=Lwidth[i], color=Lcolor[i], linewidth=Llinewidth[i], edgecolor=Llinecolor[i])
+
+ # Legend
+ #TODO : Handling legend with overlap two axis lines in the same box. For now, placement is by hand
+ if not id_overlap:
+ self.ax[iax].legend(loc='upper right', bbox_to_anchor=(1, 0.95))
+ else:
+ self.ax[iax].legend(loc='upper right', bbox_to_anchor=(1, 0.90))
+
+ # Title
+ if Ltitle: self.set_Title(self.ax, iax, Ltitle[i], id_overlap,Lxlab[i], Lylab[i])
+
+ # X/Y Axis label
+ if id_overlap:
+ self.ax[iax].xaxis.tick_top()
+ self.ax[iax].xaxis.set_label_position('top')
+ self.ax[iax].set_xlabel(Lxlab[i])
+ self.ax[iax].set_ylabel(Lylab[i])
+ else:
+ self.set_XYaxislab(self.ax, iax, Lxlab[i], Lylab[i])
+
+ self.ax[iax].tick_params(axis='x', colors=LaxisColor[i])
+
+ # X/Y Axis limits value
+ if Lxlim:
+ try:
+ self.set_xlim(self.ax, iax, Lxlim[i])
+ except:
+ pass
+ if Lylim:
+ try:
+ self.set_ylim(self.ax, iax, Lylim[i])
+ except:
+ pass
+
+ return self.fig
+#def initialize_default_val(Lvar, Dparam):
+# #TODO : initialize default value for all parameter of all type of graphs
+# #Returns All the parameters given in Dparam where :
+# "- If no value is found (empty list []) : return the default value (if exist) * number of graph
+# #- If ONE value only is found : return the value copied x times the number of graph
+# #- If the list is complete, nothing is done
+# #CURRENT PROBLEM
+# #The returned value do not change the true referenced variable given as argument
+# # Number of graphs
+# l = len(Lvar)
+#
+# # Add an extra percentage of the top max value for forcing the colorbar show the true user maximum value (correct a bug)
+# #if Dparam['Lstep'] and Dparam['Lmaxval']: Dparam['Lmaxval'] = list(map(lambda x, y: x + 1E-6*y, Dparam['Lmaxval'], Dparam['Lstep']) ) #The extra value is 1E-6 times the step ticks of the colorbar
+# print(Dparam.items())
+#
+# # Read on which parameters initialize the default values
+# for args_t in list(Dparam.items()): # Test on all arguments present, if they are empty list, default values apply for each graph
+# args = list(args_t)
+# print(args)
+# if args[0] == 'Lfacconv' and not args[1]: args[1] = [1.0]*l
+# elif args[0] == 'Lcolormap' and not args[1]: args[1] = ['gist_rainbow_r']*l
+# elif args[0] == 'LcolorLine' and not args[1]: args[1] = ['black']*l
+# elif args[0] == 'Lpltype' and not args[1]: args[1]= ['cf']*l
+# elif args[0] == 'LaddWhite_cm' and not args[1]: args[1] = ['False']*l
+# elif args[0] == 'Lstep' and not args[1]: args[1] = [None]*l # default value filled later
+# elif args[0] == 'Lstepticks' and not args[1]: args[1] = [None]*l
+# Dparam[args[0]] = args[1]
+# print(args)
+#
+# # Check if there is no value for a parameter
+## for args_t in list(Dparam.items()):
+## args = list(args_t)
+## if args[1]
+# # Number of contours level
+## for i in range(l):
+## if 'Lstepticks' in arguments.args and 'Lmaxval' in arguments.args and 'Lminval' in arguments.args:
+## Lstep[i] = (Lmaxval[i] - Lminval[i])/20 # Default value of number of steps is 20
+## Lstepticks[i] = Lstep[i] # Default value is stepticks are the same as steps values
+#
+#
+# return Dparam
diff --git a/src/LIB/Python/misc_functions.py b/src/LIB/Python/misc_functions.py
new file mode 100644
index 0000000000000000000000000000000000000000..aa91aa7a311dc721c17f3f28cc7a8fd4f78df5b1
--- /dev/null
+++ b/src/LIB/Python/misc_functions.py
@@ -0,0 +1,209 @@
+#!/usr/bin/env python3
+# -*- coding: utf-8 -*-
+"""
+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: 07/2021 Quentin Rodier
+"""
+import copy
+from scipy.interpolate import RectBivariateSpline
+import numpy as np
+import math
+
+def convert_date(datesince, time_in_sec):
+ return str(time_in_sec) + datesince[:33]
+
+class mean_operator():
+ def MYM(self,var):
+ ny = var.shape[1]
+ out = copy.deepcopy(var)
+ for j in range(ny-1):
+ out[:,j,:] = (var[:,j,:] + var[:,j+1,:])*0.5
+ return out
+
+ def MXM(self,var):
+ nx = var.shape[2]
+ out = copy.deepcopy(var)
+ for i in range(nx-1):
+ out[:,:,i] = (var[:,:,i] + var[:,:,i+1])*0.5
+ return out
+
+ def MZM(self,var):
+ nz = var.shape[0]
+ out = copy.deepcopy(var)
+ for k in range(nz-1):
+ out[k,:,:] = (var[k,:,:] + var[k+1,:,:])*0.5
+ 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
+
+ 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
+
+ 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)):
+ 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
+
+ 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
new file mode 100644
index 0000000000000000000000000000000000000000..6c1311c1730eddb20446c428ddedc1de2d683cf2
--- /dev/null
+++ b/src/LIB/Python/read_MNHfile.py
@@ -0,0 +1,344 @@
+#!/usr/bin/env python3
+# -*- coding: utf-8 -*-
+"""
+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: 07/2021 Quentin Rodier
+"""
+import netCDF4 as nc
+import numpy as np
+
+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')
+ 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()
+ return Dvar
+
+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
+
+ 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:
+ 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
+
+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
+
+ 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:
+ 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)
+
+ if not get_data_only:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name]
+ else:
+ if var_dim == 0:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][0].data
+ if var_dim == 1:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:]
+ elif var_dim == 2:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:]
+ elif var_dim == 3:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:]
+ elif var_dim == 4:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:]
+ elif var_dim == 5:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:,:]
+ elif var_dim == 6:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:,:,:]
+ elif var_dim == 7:
+ Dvar[(group_name,var_name)] = theFile[group_name].variables[var_name][:,:,:,:,:,:,:]
+ if removeHALO:
+ for i in range(8):
+ try:
+ if var_dim_name[i]=='level' or var_dim_name[i]=='level_w' or \
+ var_dim_name[i]=='ni' or var_dim_name[i]=='ni_u' or var_dim_name[i]=='ni_v' or \
+ var_dim_name[i]=='nj' or var_dim_name[i]=='nj_u' or var_dim_name[i]=='nj_v':
+ if var_dim != 0:
+ Dvar[(group_name,var_name)] = removetheHALO(i+1, Dvar[(group_name,var_name)])
+ except:
+ break
+ if del_empty_dim:
+ Ldimtosqueeze=[]
+ var_shape = Dvar[(group_name,var_name)].shape
+ for i in range(8):
+ try:
+ if var_shape[i]==1: Ldimtosqueeze.append(i)
+ except IndexError:
+ break
+ Ldimtosqueeze=tuple(Ldimtosqueeze)
+ Dvar[(group_name,var_name)] = np.squeeze(Dvar[(group_name,var_name)], axis=Ldimtosqueeze)
+
+ # LES budget, ZTSERIES needs to be transposed to use psection functions without specifying .T each time
+ if 'LES_budget' in group_name or 'ZTSERIES' in group_name or 'XTSERIES' in group_name:
+ Dvar[(group_name,var_name)] = Dvar[(group_name,var_name)].T
+ return Dvar
+
+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
+
+ 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, 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
+
+ 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 = 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)
+ return Dvar
+
+def removetheHALO(idim, var):
+ """Remove a NHALO=1 point [1:-1] at a given dimension idim of a variable var
+
+ Parameters
+ ----------
+ idim: int
+ the dimension over which remove the first and last point
+
+ var: array
+ a Meso-NH netCDF4 variable name
+
+ Returns
+ -------
+ var : array
+ """
+ if idim == 1:
+ var = var[1:-1]
+ elif idim == 2:
+ var = var[:,1:-1]
+ elif idim == 3:
+ var = var[:,:,1:-1]
+ elif idim == 4:
+ var = var[:,:,:,1:-1]
+ elif idim == 5:
+ var = var[:,:,:,:,1:-1]
+ elif idim == 6:
+ var = var[:,:,:,:,:,1:-1]
+ elif idim == 7:
+ var = var[:,:,:,:,:,:,1:-1]
+ return var
diff --git a/src/LIB/RAD/ecrad-1.0.1_mnh/ifs/cos_sza.F90 b/src/LIB/RAD/ecrad-1.0.1_mnh/ifs/cos_sza.F90
index f02aeb1dc0d8b66f526824678b7bcea1428cb5f0..215743cfb0e67a32125a895a48f7114e5099eba5 100644
--- a/src/LIB/RAD/ecrad-1.0.1_mnh/ifs/cos_sza.F90
+++ b/src/LIB/RAD/ecrad-1.0.1_mnh/ifs/cos_sza.F90
@@ -135,7 +135,7 @@ DO JCOL = KSTART,KEND
ENDDO
! Computation of solar hour angle from sunposn
-ZTIME = TDTRAD_FULL%TIME + 0.5*XDTRAD
+ZTIME = TDTRAD_FULL%XTIME + 0.5*XDTRAD
ZUT = MOD( 24.0+MOD(ZTIME/3600.,24.0),24.0 )
ZTUT = ZUT - XTSIDER
ZSOLANG = (ZTUT-12.0)*15.0*(RPI/180.) ! hour angle in radians
diff --git a/src/LIB/RAD/ecrad-1.0.1_mnh/ifs/radiation_scheme.F90 b/src/LIB/RAD/ecrad-1.0.1_mnh/ifs/radiation_scheme.F90
index 4f00fba6f7b381a844ba27db13d6042dc9668d28..e0cdd612165c9401974af01bd5de8a1092087509 100644
--- a/src/LIB/RAD/ecrad-1.0.1_mnh/ifs/radiation_scheme.F90
+++ b/src/LIB/RAD/ecrad-1.0.1_mnh/ifs/radiation_scheme.F90
@@ -79,7 +79,7 @@ USE YOMHOOK , ONLY : LHOOK, DR_HOOK
USE MODD_PARAM_ECRAD_n, ONLY : NAERMACC, NDECOLAT, XCLOUD_FRAC_STD, & ! replace YRERAD to get attributes
& LAPPROXLWUPDATE, LAPPROXSWUPDATE
USE MODD_RADIATIONS_n , ONLY : NSWB_MNH,NSWB_OLD
-USE MODE_THERMO ! , ONLY QSATW_2D
+USE MODE_THERMO , ONLY : QSAT
USE MODD_DYN_n , ONLY : XTSTEP, NSTOP
USE MODD_TIME , ONLY : TDTEXP
USE MODD_TIME_n , ONLY : TDTMOD,TDTCUR
@@ -336,7 +336,7 @@ thermodynamics%temperature_hl(KIDIA:KFDIA,KLEV+1) &
! & PPRESSURE, PTEMPERATURE, thermodynamics%h2o_sat_liq, 2)
!MNH
-thermodynamics%h2o_sat_liq(:,:) = QSATW_2D(REAL(PPRESSURE), REAL(PTEMPERATURE))
+thermodynamics%h2o_sat_liq(:,:) = QSAT(REAL(PPRESSURE), REAL(PTEMPERATURE))
thermodynamics%h2o_sat_liq(:,:) = thermodynamics%h2o_sat_liq(:,:) &
& / (1.+thermodynamics%h2o_sat_liq(:,:)) ! mixing ratio => spec humid
!MNH
@@ -361,8 +361,8 @@ single_level%lw_emissivity(KIDIA:KFDIA,2) = PEMIS_WINDOW(KIDIA:KFDIA)
! Create the relevant seed from date and time get the starting day
! and number of minutes since start
! IDAY = NDD(NINDAT) ! NINDAT is AAAAMMDD initial date NDD extract DD as INTEGER
-IDAY = TDTEXP%TDATE%DAY ! MNH
-ITIM = NINT((TDTMOD%time-TDTCUR%time) / 60.0_JPRB) ! YRRIP contains timestep infos ; number of minutes since beginning
+IDAY = TDTEXP%DATE%NDAY ! MNH
+ITIM = NINT((TDTMOD%xtime-TDTCUR%xtime) / 60.0_JPRB) ! YRRIP contains timestep infos ; number of minutes since beginning
DO JLON = KIDIA, KFDIA
! This method gives a unique value for roughly every 1-km square
! on the globe and every minute. ASIN(PGEMU)*60 gives rough
diff --git a/src/LIB/RAD/ecrad-1.4.0.tar.gz b/src/LIB/RAD/ecrad-1.4.0.tar.gz
new file mode 100644
index 0000000000000000000000000000000000000000..23aca40b30fbe71caff28e98f33314d2d78f1be5
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0.tar.gz
@@ -0,0 +1,3 @@
+version https://git-lfs.github.com/spec/v1
+oid sha256:2fa92987214bde44613d682de4440caf766dc00b6cc04a3903afb62588e3ca0a
+size 8968642
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/cmpl_binding.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/cmpl_binding.F90
new file mode 100644
index 0000000000000000000000000000000000000000..727f23375cad7dc1c0c09e6e1864975c97477660
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/cmpl_binding.F90
@@ -0,0 +1,159 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+SUBROUTINE CMPL_RECV(KBUF,KCOUNT,KTYPE,KSOURCE,KTAG,KCOMM,&
+ &KSYNC,KBLOCK,KRCOUNT,KRFROM,KRTAG,KERROR)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+!USE MPL_MODULE
+USE MPL_RECV_MOD
+IMPLICIT NONE
+INTEGER KCOUNT,KTYPE,KSOURCE,KTAG,KCOMM
+INTEGER KRCOUNT,KRFROM,KRTAG,KERROR,KSYNC,KBLOCK
+INTEGER(KIND=JPIM) :: KBUF(*)
+INTEGER,EXTERNAL :: CONVIN,CONVOUT
+INTEGER ILENB,ILEN
+ILENB=CONVIN(KCOUNT,KTYPE)
+IF(KSOURCE > 0) THEN
+ IF(KTAG /= -1) THEN
+ CALL MPL_RECV(KBUF(1:ILENB),KSOURCE=KSOURCE,KTAG=KTAG,&
+ KFROM=KRFROM,KRECVTAG=KRTAG,KOUNT=ILEN,KERROR=KERROR)
+ ELSE
+ CALL MPL_RECV(KBUF(1:ILENB),KSOURCE=KSOURCE,&
+ KFROM=KRFROM,KRECVTAG=KRTAG,KOUNT=ILEN,KERROR=KERROR)
+ ENDIF
+ELSE
+ IF(KTAG /= -1) THEN
+ CALL MPL_RECV(KBUF(1:ILENB),KTAG=KTAG,&
+ KFROM=KRFROM,KRECVTAG=KRTAG,KOUNT=ILEN,KERROR=KERROR)
+ ELSE
+ CALL MPL_RECV(KBUF(1:ILENB),&
+ KFROM=KRFROM,KRECVTAG=KRTAG,KOUNT=ILEN,KERROR=KERROR)
+ ENDIF
+ENDIF
+KRCOUNT=CONVOUT(ILEN,KTYPE)
+END SUBROUTINE CMPL_RECV
+
+SUBROUTINE CMPL_SEND(KBUF,KCOUNT,KTYPE,KDEST,KTAG,KCOMM,&
+ &KSYNC,KBLOCK,KERROR)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+!USE MPL_MODULE
+USE MPL_SEND_MOD
+IMPLICIT NONE
+INTEGER KCOUNT,KTYPE,KTAG,KCOMM,KSYNC,KBLOCK,KDEST
+INTEGER KERROR
+INTEGER KBUF(*)
+INTEGER,EXTERNAL :: CONVIN,CONVOUT
+INTEGER ILEN
+ILEN=CONVIN(KCOUNT,KTYPE)
+CALL MPL_SEND(KBUF(1:ILEN),KDEST=KDEST,KTAG=KTAG,KERROR=KERROR)
+END SUBROUTINE CMPL_SEND
+
+SUBROUTINE CMPL_BROADCAST(KBUF,KCOUNT,KTYPE,KROOT,KTAG,KCOMM,&
+ &KSYNC,KBLOCK,KERROR)
+!USE MPL_MODULE
+USE MPL_BROADCAST_MOD
+IMPLICIT NONE
+INTEGER KCOUNT,KTYPE,KTAG,KCOMM,KSYNC,KBLOCK,KROOT
+INTEGER KERROR
+INTEGER KBUF(*)
+INTEGER,EXTERNAL :: CONVIN,CONVOUT
+INTEGER ILEN
+ILEN=CONVIN(KCOUNT,KTYPE)
+CALL MPL_BROADCAST(KBUF(1:ILEN),KROOT=KROOT,KTAG=KTAG,KERROR=KERROR)
+END SUBROUTINE CMPL_BROADCAST
+
+SUBROUTINE CMPL_ABORT(CDMESS)
+USE MPL_MODULE
+IMPLICIT NONE
+CHARACTER(LEN=*) CDMESS
+CALL MPL_ABORT(CDMESS)
+END SUBROUTINE CMPL_ABORT
+
+SUBROUTINE CMPI_ABORT(KRC)
+USE MPL_MPIF, ONLY : MPI_COMM_WORLD
+IMPLICIT NONE
+INTEGER,INTENT(IN) :: KRC
+INTEGER :: IRET
+CALL MPI_ABORT(MPI_COMM_WORLD,KRC,IRET)
+END SUBROUTINE CMPI_ABORT
+
+SUBROUTINE CMPL_INIT(LDTRMSG,KERROR)
+!USE MPL_MODULE
+USE MPL_INIT_MOD
+IMPLICIT NONE
+LOGICAL LDTRMSG
+INTEGER KERROR
+CALL MPL_INIT(KERROR=KERROR,LDINFO=.FALSE.)
+END SUBROUTINE CMPL_INIT
+
+FUNCTION CMPL_NPROC()
+!USE MPL_MODULE
+USE MPL_NPROC_MOD
+IMPLICIT NONE
+INTEGER CMPL_NPROC
+CMPL_NPROC=MPL_NPROC()
+END FUNCTION CMPL_NPROC
+
+FUNCTION CMPL_MYRANK()
+!USE MPL_MODULE
+USE MPL_MYRANK_MOD
+IMPLICIT NONE
+INTEGER CMPL_MYRANK
+CMPL_MYRANK=MPL_MYRANK()
+END FUNCTION CMPL_MYRANK
+
+SUBROUTINE CMPL_BARRIER(KERROR)
+!USE MPL_MODULE
+USE MPL_BARRIER_MOD
+IMPLICIT NONE
+INTEGER KERROR
+CALL MPL_BARRIER(KERROR=KERROR)
+END SUBROUTINE CMPL_BARRIER
+
+SUBROUTINE CMPL_END(KERROR)
+!USE MPL_MODULE
+USE MPL_END_MOD
+IMPLICIT NONE
+INTEGER KERROR
+CALL MPL_END(KERROR=KERROR)
+END SUBROUTINE CMPL_END
+
+SUBROUTINE CMPL_GETARG(KARGNO, CDARG)
+USE MPL_MODULE
+IMPLICIT NONE
+INTEGER KARGNO
+CHARACTER(LEN=*) CDARG
+CALL MPL_GETARG(KARGNO, CDARG)
+END SUBROUTINE CMPL_GETARG
+
+FUNCTION CMPL_IARGC()
+!USE MPL_MODULE
+USE MPL_ARG_MOD
+IMPLICIT NONE
+INTEGER CMPL_IARGC
+CMPL_IARGC = MPL_IARGC()
+END FUNCTION CMPL_IARGC
+
+FUNCTION MPE_MYRANK()
+!USE MPL_MODULE
+USE MPL_MYRANK_MOD
+
+IMPLICIT NONE
+INTEGER MPE_MYRANK
+MPE_MYRANK=MPL_MYRANK()
+END FUNCTION MPE_MYRANK
+
+SUBROUTINE MPEI_ABORT(CDMESS)
+!USE MPL_MODULE
+USE MPL_ABORT_MOD
+
+IMPLICIT NONE
+CHARACTER(LEN=*) CDMESS
+CALL MPL_ABORT()
+END SUBROUTINE MPEI_ABORT
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_procinfo.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_procinfo.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ada772f564253827627c4be5481d48a2cc313358
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_procinfo.F90
@@ -0,0 +1,19 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+SUBROUTINE DR_HOOK_PROCINFO(KMYPROC, KNPROC)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+!USE MPL_MODULE, ONLY : MPL_WORLD_RANK, MPL_WORLD_SIZE
+USE MPL_INIT_MOD , ONLY : MPL_WORLD_RANK, MPL_WORLD_SIZE
+IMPLICIT NONE
+INTEGER(KIND=JPIM),INTENT(OUT) :: KMYPROC, KNPROC
+!INTEGER(KIND=JPIM) :: MPL_WORLD_RANK, MPL_WORLD_SIZE
+KMYPROC = MPL_WORLD_RANK + 1
+KNPROC = MPL_WORLD_SIZE
+END SUBROUTINE DR_HOOK_PROCINFO
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_util_multi.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_util_multi.F90
new file mode 100644
index 0000000000000000000000000000000000000000..aafece69bebd38a2bec474f9c316fcc1a67dac3b
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/dr_hook_util_multi.F90
@@ -0,0 +1,54 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+SUBROUTINE DR_HOOK_UTIL_MULTI(LDHOOK,CDNAME,KCASE,PKEY,KPKEY,CDFILENAME,KSIZEINFO)
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE OML_MOD,ONLY : OML_MAX_THREADS,OML_MY_THREAD
+IMPLICIT NONE
+LOGICAL,INTENT(INOUT) :: LDHOOK
+CHARACTER(LEN=*),INTENT(IN) :: CDNAME,CDFILENAME
+INTEGER(KIND=JPIM),INTENT(IN) :: KPKEY, KCASE,KSIZEINFO
+REAL(KIND=JPRB),INTENT(INOUT) :: PKEY(KPKEY)
+
+LOGICAL,SAVE :: LL_FIRST_TIME = .TRUE.
+REAL(KIND=JPRB) :: ZDUMMY
+INTEGER(KIND=JPIM) :: IMYTID, ISILENT, IMAXTH
+
+!#include "dr_hook_util.h"
+
+! -----------------------------------------------------------------
+
+IF (.NOT.LDHOOK) RETURN
+IF (LL_FIRST_TIME) THEN
+ LL_FIRST_TIME = .FALSE.
+ CALL DR_HOOK_UTIL(LDHOOK,'',-1,ZDUMMY,'',-1_JPIM)
+
+ ! Approximately the very first OpenMP-loop
+ IMAXTH = OML_MAX_THREADS()
+ ! trapfpe setting also for slave threads -- was missing
+ !$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(IMYTID,ISILENT) IF (IMAXTH > 1)
+ DO IMYTID=1,IMAXTH
+ ISILENT = 1 ! no verbosity
+ IF (IMYTID == IMAXTH) ISILENT = 0 ! be verbose with the last thread
+ CALL TRAPFPE_SLAVE_THREADS(ISILENT) ! see drhook.c; does not anything for master thread
+ ENDDO ! IMYTID=1,IMAXTH
+ !$OMP END PARALLEL DO
+ENDIF
+
+!$OMP PARALLEL DO SCHEDULE(STATIC,1) PRIVATE(IMYTID)
+DO IMYTID=1,KPKEY
+ IF (KCASE == 0) THEN
+ CALL C_DRHOOK_START(CDNAME, IMYTID, PKEY(IMYTID), CDFILENAME, KSIZEINFO)
+ ELSE IF (KCASE == 1) THEN
+ CALL C_DRHOOK_END (CDNAME, IMYTID, PKEY(IMYTID), CDFILENAME, KSIZEINFO)
+ ENDIF
+ENDDO ! IMYTID=1,KPKEY
+!$OMP END PARALLEL DO
+
+END SUBROUTINE DR_HOOK_UTIL_MULTI
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_meminfo_mnh_mod.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_meminfo_mnh_mod.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2a90bd219bc4fca2091491f4a05e75ebeb8245c3
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_meminfo_mnh_mod.F90
@@ -0,0 +1,822 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE EC_MEMINFO_MOD
+
+CONTAINS
+
+SUBROUTINE EC_MEMINFO(KU,CDSTRING,KCOMM,KBARR,KIOTASK,KCALL)
+
+USE PARKIND1, ONLY : JPIM, JPIB, JPRD
+USE MPL_MPIF
+
+IMPLICIT NONE
+
+!-- EC_MEMINFO:
+! Author : Peter Towers (ECMWF) : 2015-2016
+! Modified : Sami Saarinen (ECMWF) : 21-SEP-2016 : Added getenv EC_MEMINFO -- export EC_MEMINFO=0 disables any EC_MEMINFO output
+! Sami Saarinen (ECMWF) : 02-MAR-2017 : Enabled flexible number of sockets & lots of tidying
+! Sami Saarinen (ECMWF) : 09-MAR-2017 : Power monitoring added (via EC_PMON) -- works at least on Cray systems
+! Sami Saarinen (ECMWF) : 12-MAR-2017 : Gather core affinities via call to ec_coreid()
+! Sami Saarinen (ECMWF) : 12-DEC-2017 : Obtain MPI & OpenMP version information
+
+!#include "ec_pmon.intfb.h"
+
+INTEGER(KIND=JPIM), INTENT(IN) :: KU,KCOMM,KBARR,KIOTASK,KCALL
+CHARACTER(LEN=*), INTENT(IN) :: CDSTRING
+INTEGER(KIND=JPIM), PARAMETER :: ITAG = 98765
+INTEGER(KIND=JPIM) :: ID,KULOUT
+INTEGER(KIND=JPIM) :: II,JJ,I,J,K,MYPROC,NPROC,LEN,ERROR,NODENUM,JID,IDX
+INTEGER(KIND=JPIB) :: TASKSMALL,NODEHUGE,MEMFREE,CACHED,NFREE
+INTEGER(KIND=JPIB),SAVE :: NODEHUGE_CACHED
+INTEGER(KIND=JPIM), PARAMETER :: MAXNUMA_DEF = 4 ! Max number of "sockets" supported by default
+INTEGER(KIND=JPIM), SAVE :: MAXNUMA = 0 ! Max number of "sockets" supported -- initialized to zero to enforce updated value (env EC_MAXNUMA)
+INTEGER(KIND=JPIM) :: NNUMA ! Actual number of "sockets" (can be 0 ob systems that do not have /proc/buddyinfo, e.g. WSL)
+!INTEGER(KIND=JPIB),DIMENSION(0:MAXNUMA-1) :: SMALLPAGE,HUGEPAGE
+INTEGER(KIND=JPIB),DIMENSION(:),ALLOCATABLE,SAVE :: SMALLPAGE,HUGEPAGE
+INTEGER(KIND=JPIB) :: GETMAXRSS,GETMAXHWM
+INTEGER(KIND=JPIB) :: HEAP_SIZE
+INTEGER(KIND=JPIB), PARAMETER :: ONEMEGA = 1024_JPIB * 1024_JPIB
+INTEGER(KIND=JPIB) :: ENERGY, POWER
+INTEGER(KIND=JPIB) :: TOT_ENERGY, MAXPOWER, AVGPOWER
+INTEGER(KIND=JPIM),SAVE :: PAGESIZE = 0
+INTEGER(KIND=JPIM),SAVE :: MAXTH = 0
+INTEGER(KIND=JPIM),SAVE :: MAXTH_COMP = 0
+INTEGER(KIND=JPIM),SAVE :: MAXTH_IO = 0
+INTEGER(KIND=JPIM),PARAMETER :: MAXCOLS = 18 ! Max numerical columns in /proc/buddyinfo (often just 11, but Cray has 18 entries)
+INTEGER(KIND=JPIM) :: N18
+!INTEGER(KIND=JPIB),DIMENSION(0:MAXCOLS-1,0:MAXNUMA-1) :: NODE, BUCKET
+!INTEGER(KIND=JPIB),DIMENSION(7+2*MAXNUMA) :: SENDBUF,RECVBUF
+INTEGER(KIND=JPIB),DIMENSION(:,:),ALLOCATABLE,SAVE :: NODE, BUCKET
+INTEGER(KIND=JPIB),DIMENSION(:),ALLOCATABLE,SAVE :: SENDBUF,RECVBUF
+REAL(KIND=JPRD) :: PERCENT_USED(2)
+CHARACTER(LEN=256) :: CLSTR
+CHARACTER(LEN=512) :: TMPDIR
+CHARACTER(LEN=512), SAVE :: PROGRAM = ' '
+CHARACTER(LEN=20) :: NODENAME,LASTNODE,CLMAXNODE
+CHARACTER(LEN=12) :: VAL
+CHARACTER(LEN=1) :: M
+CHARACTER(LEN=160) ::LINE
+CHARACTER(LEN=56) :: FILENAME
+CHARACTER(LEN=1) :: CLEC_MEMINFO
+CHARACTER(LEN=5) :: CSTAR
+CHARACTER(LEN=LEN(CSTAR)+1+LEN(CDSTRING)) :: ID_STRING
+CHARACTER(LEN=10) :: CLDATEOD,CLTIMEOD,CLZONEOD
+CHARACTER(LEN=3), PARAMETER :: CLMON(1:12) = (/ &
+ 'Jan','Feb','Mar','Apr','May','Jun', &
+ 'Jul','Aug','Sep','Oct','Nov','Dec' /)
+INTEGER(KIND=JPIM) :: IVALUES(8), IMON
+INTEGER(KIND=JPIM) :: IRECV_STATUS(MPI_STATUS_SIZE)
+LOGICAL :: LLNOCOMM, LLNOHDR
+INTEGER(KIND=JPIM), SAVE :: IAM_NODEMASTER = 0
+LOGICAL, SAVE :: LLFIRST_TIME = .TRUE.
+TYPE RANKNODE_T
+ INTEGER(KIND=JPIM) :: NODENUM
+ INTEGER(KIND=JPIM) :: RANK_WORLD
+ INTEGER(KIND=JPIM) :: RANK
+ INTEGER(KIND=JPIM) :: IORANK
+ INTEGER(KIND=JPIM) :: NODEMASTER
+ INTEGER(KIND=JPIM) :: NUMTH
+ INTEGER(KIND=JPIM), ALLOCATABLE :: COREIDS(:)
+ CHARACTER(LEN=LEN(NODENAME)) :: NODE
+ CHARACTER(LEN=LEN(CLSTR)) :: STR
+END TYPE
+TYPE (RANKNODE_T), ALLOCATABLE, SAVE :: RN(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: COREIDS(:)
+LOGICAL, ALLOCATABLE :: DONE(:)
+INTEGER(KIND=JPIM), SAVE :: NUMNODES = 0
+INTEGER(KIND=JPIM) :: NN
+INTEGER(KIND=JPIM), SAVE :: IOTASKS = 0
+INTEGER(KIND=JPIM) :: IORANK, NSEND, NRECV
+LOGICAL :: FILE_EXISTS
+REAL(KIND=JPRD), EXTERNAL :: UTIL_WALLTIME
+REAL(KIND=JPRD), SAVE :: WT0
+REAL(KIND=JPRD) :: WT
+CHARACTER(LEN=64) :: CLPFX
+CHARACTER(LEN=3) :: ZUM
+INTEGER(KIND=JPIM) :: IPFXLEN, NUMTH, MYTH
+INTEGER(KIND=JPIM) :: NCOMM_MEMINFO = 0
+COMMON /cmn_meminfo/ NCOMM_MEMINFO
+INTEGER OMP_GET_MAX_THREADS, OMP_GET_THREAD_NUM
+#ifdef _OPENMP
+EXTERNAL OMP_GET_MAX_THREADS, OMP_GET_THREAD_NUM
+#else
+OMP_GET_MAX_THREADS() = 1
+OMP_GET_THREAD_NUM() = 0
+#endif
+
+CALL GET_ENVIRONMENT_VARIABLE('EC_MEMINFO',CLEC_MEMINFO)
+IF (CLEC_MEMINFO == '0') RETURN
+
+IF (LLFIRST_TIME) WT0 = UTIL_WALLTIME()
+IF (MAXTH == 0) MAXTH = OMP_GET_MAX_THREADS()
+
+LLNOCOMM = (KCOMM == -1 .or. KCOMM == -2)
+LLNOHDR = (KCOMM == -2)
+
+IF (LLNOCOMM) THEN
+ ! Direct call to obtain EC_meminfo -output
+ ERROR = 0
+ MYPROC = 0
+ NPROC = 1
+ CLPFX = CDSTRING
+ IPFXLEN = LEN_TRIM(CLPFX)
+ ZUM = 'tsk'
+ELSE
+ CLPFX = ' '
+ IPFXLEN = 0
+ ZUM = 'sum'
+ CALL MPI_COMM_RANK(KCOMM,MYPROC,ERROR)
+ CALL CHECK_ERROR("from MPI_COMM_RANK",__FILE__,__LINE__)
+
+ CALL MPI_COMM_SIZE(KCOMM,NPROC,ERROR)
+ CALL CHECK_ERROR("from MPI_COMM_SIZE",__FILE__,__LINE__)
+
+ IF (KCALL == 0) THEN
+ CALL CONDBARR()
+ CALL CHECK_ERROR("from MPI_BARRIER(at start)",__FILE__,__LINE__)
+ ENDIF
+ENDIF
+
+IF (LLFIRST_TIME) THEN ! The *very* first time
+ CALL EC_PMON(ENERGY,POWER)
+
+ !-- Neither of these two may stop working when linking with C++ (like in OOPS) ...
+ ! CALL GETARG(0,PROGRAM)
+ ! CALL GET_COMMAND_ARGUMENT(0,PROGRAM)
+ !... so using the old saviour from ifsaux/support/cargs.c:
+ CALL GETARG_C(0,PROGRAM)
+
+ CALL GET_ENVIRONMENT_VARIABLE("HUGETLB_DEFAULT_PAGE_SIZE",VAL)
+ I=INDEX(VAL,"M")
+ IF(I > 0) THEN
+ READ(VAL(1:I-1),*) PAGESIZE
+ PAGESIZE=PAGESIZE*1024
+ ELSE
+ PAGESIZE=0
+ ENDIF
+
+ NODEHUGE=0
+
+ IF(PAGESIZE > 0) THEN
+ !WRITE(FILENAME,'(a,i0,a)') "/sys/kernel/mm/hugepages/hugepages-", &
+ ! PAGESIZE,"kB/nr_hugepages"
+ FILENAME='/proc/sys/vm/nr_hugepages' ! more generic; contents the same as in /sys/kernel/mm/hugepages/hugepages-2048kB/nr_hugepages
+ INQUIRE(FILE=FILENAME, EXIST=FILE_EXISTS)
+ IF( FILE_EXISTS ) THEN
+ OPEN(502,FILE=FILENAME,STATUS="old",ACTION="read",ERR=999)
+ READ(502,*,ERR=998,END=998) NODEHUGE
+998 continue
+ CLOSE(502)
+ ENDIF
+999 continue
+ ENDIF
+
+ NODEHUGE=NODEHUGE*PAGESIZE
+ NODEHUGE=NODEHUGE/1024
+ NODEHUGE_CACHED = NODEHUGE
+ENDIF
+
+NODEHUGE=NODEHUGE_CACHED
+
+CALL EC_GETHOSTNAME(NODENAME) ! from support/env.c
+
+IF (MAXNUMA == 0) THEN
+ CALL GET_ENVIRONMENT_VARIABLE("EC_MAXNUMA",VAL) ! Note: *not* export EC_MEMINFO_MAXNUMA=<value>, but EC_MAXNUMA=<value>
+ IF (VAL /= "") READ(VAL,*) MAXNUMA
+ IF (MAXNUMA < 1) MAXNUMA = MAXNUMA_DEF
+ ALLOCATE(SMALLPAGE(0:MAXNUMA-1))
+ ALLOCATE(HUGEPAGE(0:MAXNUMA-1))
+ ALLOCATE(NODE(0:MAXCOLS-1,0:MAXNUMA-1))
+ ALLOCATE(BUCKET(0:MAXCOLS-1,0:MAXNUMA-1))
+ ALLOCATE(SENDBUF(7+2*MAXNUMA))
+ ALLOCATE(RECVBUF(7+2*MAXNUMA))
+ENDIF
+
+IF (MYPROC == 0) THEN
+!
+! Use already open file for output or $EC_MEMINFO_TMPDIR/meminfo
+! We do not use $TMPDIR as it may have been inherited from mother superiour (MOMS) node
+!
+ IF(KU == -1) THEN
+ CALL GET_ENVIRONMENT_VARIABLE('EC_MEMINFO_TMPDIR',TMPDIR)
+ IF (TMPDIR == ' ') TMPDIR = '.'
+ ! write(0,*) '## EC_MEMINFO: KCOMM=',KCOMM
+ ! CALL LINUX_TRBK()
+ KULOUT=501
+ OPEN(UNIT=KULOUT,FILE=TRIM(TMPDIR)//"/"//"meminfo.txt",STATUS='unknown', &
+ ACTION='write',POSITION='append')
+ ELSE
+ KULOUT=KU
+ ENDIF
+ENDIF
+
+IF (LLFIRST_TIME .and. .not. LLNOCOMM) THEN
+! Fetch affinities (over OpenMP threads)
+! Note: I/O-tasks may now have different number of threads than on computational tasks
+ ALLOCATE(COREIDS(0:MAXTH-1))
+#ifdef _OPENMP
+!$OMP PARALLEL NUM_THREADS(MAXTH) SHARED(COREIDS) PRIVATE(MYTH)
+#endif
+ MYTH = OMP_GET_THREAD_NUM()
+ CALL EC_COREID(COREIDS(MYTH))
+#ifdef _OPENMP
+!$OMP END PARALLEL
+#endif
+
+! Store the communicator we are in upon entering EC_MEMINFO for the first time -- to be used in the EC_MPI_FINALIZE
+ NCOMM_MEMINFO = KCOMM
+! Fetch node names & numbers per task
+ IORANK = 0
+ IF (KIOTASK > 0) IORANK = 1
+ IF (MYPROC == 0) THEN
+ CALL SLASH_PROC
+ ALLOCATE(RN(0:NPROC-1))
+ DO I=0,NPROC-1
+ RN(I)%NODENUM = -1
+ IF (I > 0) THEN ! Receive in the MPI-rank order of KCOMM (i.e. may not be the same as MPI_COMM_WORLD -order)
+ CALL MPI_RECV(LASTNODE,LEN(LASTNODE),MPI_BYTE,I,ITAG,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(LASTNODE)",__FILE__,__LINE__)
+ CALL MPI_RECV(IORANK,1,MPI_INTEGER4,I,ITAG+1,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(IORANK)",__FILE__,__LINE__)
+ CALL MPI_RECV(K,1,MPI_INTEGER4,I,ITAG+2,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(RANK_WORLD)",__FILE__,__LINE__)
+ CALL MPI_RECV(NUMTH,1,MPI_INTEGER4,I,ITAG+3,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(NUMTH)",__FILE__,__LINE__)
+ CALL MPI_RECV(CLSTR,LEN(CLSTR),MPI_BYTE,I,ITAG+4,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(CLSTR)",__FILE__,__LINE__)
+ RN(I)%RANK = I
+ RN(I)%STR = CLSTR
+ ELSE
+ LASTNODE=NODENAME
+ NUMTH = MAXTH
+ CALL MPI_COMM_RANK(MPI_COMM_WORLD,K,ERROR)
+ RN(I)%RANK = 0 ! Itself
+ RN(I)%STR = CDSTRING
+ ENDIF
+ RN(I)%RANK_WORLD = K
+ RN(I)%IORANK = IORANK
+ RN(I)%NODEMASTER = 0
+ RN(I)%NODE = LASTNODE
+ ! Affinities
+ RN(I)%NUMTH = NUMTH
+ ALLOCATE(RN(I)%COREIDS(0:NUMTH-1))
+ IF (I > 0) THEN ! Receive in MPI-rank order
+ CALL MPI_RECV(RN(I)%COREIDS,NUMTH,MPI_INTEGER4,I,ITAG+5,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(COREIDS)",__FILE__,__LINE__)
+ ELSE
+ RN(I)%COREIDS = COREIDS
+ ENDIF
+ IF (IORANK == 0) THEN
+ MAXTH_COMP = MAX(MAXTH_COMP,NUMTH)
+ ELSE
+ MAXTH_IO = MAX(MAXTH_IO,NUMTH)
+ ENDIF
+ ENDDO
+
+ CALL RNSORT(KULOUT) ! Output now goes to "meminfo.txt"
+
+ IAM_NODEMASTER = RN(0)%NODEMASTER ! Itself
+ DO I=1,NPROC-1
+ CALL MPI_SEND(RN(I)%NODEMASTER,1,MPI_INTEGER4,I,ITAG+6,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(IAM_NODEMASTER)",__FILE__,__LINE__)
+ ENDDO
+ ELSE
+ CALL MPI_SEND(NODENAME,LEN(NODENAME),MPI_BYTE,0,ITAG,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(NODENAME)",__FILE__,__LINE__)
+ CALL MPI_SEND(IORANK,1,MPI_INTEGER4,0,ITAG+1,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(IORANK)",__FILE__,__LINE__)
+ CALL MPI_COMM_RANK(MPI_COMM_WORLD,K,ERROR)
+ CALL MPI_SEND(K,1,MPI_INTEGER4,0,ITAG+2,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(RANK_WORLD)",__FILE__,__LINE__)
+ CALL MPI_SEND(MAXTH,1,MPI_INTEGER4,0,ITAG+3,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(MAXTH)",__FILE__,__LINE__)
+ CLSTR = CDSTRING
+ CALL MPI_SEND(CLSTR,LEN(CLSTR),MPI_BYTE,0,ITAG+4,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(CLSTR)",__FILE__,__LINE__)
+ CALL MPI_SEND(COREIDS,MAXTH,MPI_INTEGER4,0,ITAG+5,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(COREIDS)",__FILE__,__LINE__)
+ CALL MPI_RECV(IAM_NODEMASTER,1,MPI_INTEGER4,0,ITAG+6,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(IAM_NODEMASTER)",__FILE__,__LINE__)
+ ENDIF
+ DEALLOCATE(COREIDS)
+ LLFIRST_TIME = .FALSE.
+ CALL CONDBARR()
+ CALL CHECK_ERROR("from MPI_BARRIER near LLFIRST_TIME=.FALSE.",__FILE__,__LINE__)
+ENDIF
+
+IF (MYPROC == 0 .or. IAM_NODEMASTER == 1) CALL SLASH_PROC
+
+HEAP_SIZE=GETMAXHWM()/ONEMEGA
+TASKSMALL=GETMAXRSS()/ONEMEGA
+
+IF (MYPROC == 0) THEN
+ CALL DATE_AND_TIME(CLDATEOD,CLTIMEOD,CLZONEOD,IVALUES)
+ READ(CLDATEOD(5:6),'(I2)') IMON
+ IF (.not.LLNOCOMM .AND. KCALL /= 1) CALL PRT_DETAIL(KULOUT)
+ IF (.not.LLNOHDR) CALL PRT_HDR(KULOUT)
+ IF(KU == -1) THEN
+ IF (KCALL /= 1) CALL PRT_DETAIL(0)
+ CALL PRT_HDR(0)
+ ENDIF
+
+ ! Note: MYPROC == 0 is always at the RN(0) i.e. at the first NODENUM
+ TOT_ENERGY = ENERGY
+ MAXPOWER = POWER
+ AVGPOWER = POWER
+ CLMAXNODE = NODENAME
+ LASTNODE = NODENAME
+
+ NN = NUMNODES
+ IF (LLNOCOMM) NN=1
+
+ IF (NPROC > 1) THEN
+ ALLOCATE(DONE(1:NPROC-1))
+ DONE(:) = .FALSE.
+ ENDIF
+
+ DO NODENUM=1,NN
+ JID = 0
+ DO II=1,NPROC-1
+ IF (.NOT.DONE(II)) THEN
+ J = II ! Used to be REF(II) -- don't know why ?!
+ IF (RN(J)%NODENUM == NODENUM) THEN
+ I = RN(J)%RANK
+ IF (RN(J)%NODEMASTER == 1) THEN ! Always the first task on particular NODENUM
+ LASTNODE = RN(J)%NODE
+ NRECV = SIZE(RECVBUF)
+ JID = J ! Always >= 1
+ ELSE
+ NRECV = 2
+ ENDIF
+ CALL MPI_RECV(RECVBUF,NRECV,MPI_INTEGER8,I,ITAG+5,KCOMM,IRECV_STATUS,ERROR)
+ CALL CHECK_ERROR("from MPI_RECV(RECVBUF)",__FILE__,__LINE__)
+ IF (NRECV > 2) THEN
+ HEAP_SIZE=RECVBUF(1)
+ TASKSMALL=RECVBUF(2)
+ ENERGY=RECVBUF(3)
+ POWER=RECVBUF(4)
+ NODEHUGE=RECVBUF(5)
+ MEMFREE=RECVBUF(6)
+ CACHED=RECVBUF(7)
+ DO K=0,MAXNUMA-1
+ SMALLPAGE(K) = RECVBUF(7+2*K+1)
+ HUGEPAGE(K) = RECVBUF(7+2*K+2)
+ ENDDO
+ TOT_ENERGY = TOT_ENERGY + ENERGY
+ IF (POWER > MAXPOWER) THEN
+ MAXPOWER = POWER
+ CLMAXNODE = LASTNODE
+ ENDIF
+ AVGPOWER = AVGPOWER + POWER
+ ELSE
+ HEAP_SIZE=HEAP_SIZE+RECVBUF(1)
+ TASKSMALL=TASKSMALL+RECVBUF(2)
+ ENDIF
+ DONE(II) = .TRUE.
+ ENDIF
+ ENDIF
+ ENDDO
+
+ PERCENT_USED(2) = 0
+ IF (NODEHUGE == 0 .or. HEAP_SIZE >= NODEHUGE) THEN
+ ! running with small pages
+ IF (TASKSMALL+NODEHUGE+MEMFREE+CACHED > 0) THEN
+ PERCENT_USED(1) = 100.0*(TASKSMALL+NODEHUGE)/(TASKSMALL+NODEHUGE+MEMFREE+CACHED)
+ ELSE
+ PERCENT_USED(1) = 0
+ ENDIF
+ CSTAR = " Sm/p"
+ ELSE
+ ! running with huge pages
+ PERCENT_USED(1) = 100.0*(HEAP_SIZE+TASKSMALL)/(TASKSMALL+NODEHUGE+MEMFREE+CACHED)
+ NFREE = 0
+ IF (NNUMA > 0) NFREE = SUM(HUGEPAGE(0:NNUMA-1))
+ PERCENT_USED(2) = (100.0*(NODEHUGE - NFREE))/NODEHUGE
+ IF (PERCENT_USED(2) < 0) PERCENT_USED(2) = 0
+ IF (PERCENT_USED(2) > 100) PERCENT_USED(2) = 100
+ CSTAR = " Hg/p"
+ ENDIF
+
+ IF (LLNOCOMM) THEN
+ ID_STRING = CSTAR
+ ELSE IF (KCALL == 0 .AND. JID > 0) THEN
+ ! This should signify the compute & I/O nodes (if they are separate)
+ CLSTR = RN(JID)%STR
+ ID_STRING = CSTAR//":"//TRIM(CLSTR)
+ ELSE
+ ID_STRING = CSTAR//":"//CDSTRING
+ ENDIF
+
+ CALL PRT_DATA(KULOUT)
+ IF (KU == -1) THEN
+ CALL PRT_DATA(0)
+ IF (NODENUM == NN) THEN
+ AVGPOWER = NINT(REAL(AVGPOWER)/REAL(NN))
+ CALL PRT_TOTAL_ENERGIES(0)
+ CALL PRT_TOTAL_ENERGIES(KULOUT)
+ IF (KCALL == 1) THEN
+ CALL DATE_AND_TIME(CLDATEOD,CLTIMEOD,CLZONEOD,IVALUES)
+ READ(CLDATEOD(5:6),'(I2)') IMON
+ CALL PRT_DETAIL(0)
+ CALL PRT_DETAIL(KULOUT)
+ ENDIF
+ CALL PRT_EMPTY(KULOUT,1)
+ CLOSE(KULOUT)
+ ENDIF
+ ENDIF
+ ENDDO ! DO NODENUM=1,NN
+ IF (ALLOCATED(DONE)) DEALLOCATE(DONE)
+ELSE
+ SENDBUF(1)=HEAP_SIZE
+ SENDBUF(2)=TASKSMALL
+ IF (IAM_NODEMASTER == 1) THEN
+ SENDBUF(3)=ENERGY
+ SENDBUF(4)=POWER
+ SENDBUF(5)=NODEHUGE
+ SENDBUF(6)=MEMFREE
+ SENDBUF(7)=CACHED
+ DO K=0,MAXNUMA-1
+ SENDBUF(7+2*K+1)=SMALLPAGE(K)
+ SENDBUF(7+2*K+2)=HUGEPAGE(K)
+ ENDDO
+ NSEND = SIZE(SENDBUF)
+ ELSE
+ NSEND = 2
+ ENDIF
+ CALL MPI_SEND(SENDBUF,NSEND,MPI_INTEGER8,0,ITAG+5,KCOMM,ERROR)
+ CALL CHECK_ERROR("from MPI_SEND(SENDBUF)",__FILE__,__LINE__)
+ENDIF
+
+IF (.not.LLNOCOMM) THEN
+ CALL CONDBARR()
+ CALL CHECK_ERROR("from MPI_BARRIER(at end)",__FILE__,__LINE__)
+ENDIF
+
+CONTAINS
+
+SUBROUTINE SLASH_PROC
+ IMPLICIT NONE
+ CALL EC_PMON(ENERGY,POWER)
+
+ N18 = 0 ! number of buddy columns (up to MAXCOLS)
+ NNUMA = 0 ! number of NUMA-nodes (up to MAXNUMA)
+
+ OPEN(FILE="/proc/buddyinfo",UNIT=502,STATUS="old",ACTION="read",ERR=97)
+
+ READ(502,'(a)',END=99) LINE
+ READ(502,'(a)',END=99) LINE
+ READ(502,'(a)',END=99) LINE
+ NODE(:,0)=-1
+ READ(LINE(22:),*,END=98) NODE(:,0)
+98 CONTINUE
+ N18 = COUNT(NODE(:,0) >= 0)
+ NNUMA = 1
+ DO K=1,MAXNUMA-1
+ NODE(:,K)=0
+ READ(502,'(a)',END=99) LINE
+ READ(LINE(22:),*) NODE(0:N18-1,K)
+ NNUMA = NNUMA + 1
+ ENDDO
+
+99 CONTINUE
+ CLOSE(502)
+97 CONTINUE
+
+ SMALLPAGE(:) = 0
+ HUGEPAGE(:) = 0
+ DO K=0,NNUMA-1
+ BUCKET(:,K) = 0
+ DO J=0,N18-1
+ BUCKET(J,K) = 4096_JPIB * NODE(J,K) * (2_JPIB ** J)
+ ENDDO
+ SMALLPAGE(K) = SUM(BUCKET(0:8,K))/ONEMEGA
+ HUGEPAGE(K) = SUM(BUCKET(9:N18-1,K))/ONEMEGA
+ ENDDO
+
+ MEMFREE = 0
+ CACHED = 0
+
+ INQUIRE(FILE="/proc/meminfo", EXIST=FILE_EXISTS)
+ IF( FILE_EXISTS ) THEN
+ OPEN(FILE="/proc/meminfo",UNIT=502,STATUS="old",ACTION="read",ERR=977)
+ DO I=1,10
+ READ(502,'(a)',ERR=988,END=988) LINE
+ IF(LINE(1:7) == "MemFree") THEN
+ READ(LINE(9:80),*) MEMFREE
+ ELSEIF(LINE(1:6) == "Cached") THEN
+ READ(LINE(8:80),*) CACHED
+ ENDIF
+ ENDDO
+988 continue
+ CLOSE(502)
+977 continue
+
+ MEMFREE=MEMFREE/1024
+ CACHED=CACHED/1024
+ ENDIF
+
+END SUBROUTINE SLASH_PROC
+
+SUBROUTINE PRT_EMPTY(KUN,KOUNT)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN,KOUNT
+INTEGER(KIND=JPIM) :: JJ
+DO JJ=1,KOUNT
+ WRITE(KUN,'(a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO "
+ENDDO
+END SUBROUTINE PRT_EMPTY
+
+FUNCTION KWH(JOULES)
+IMPLICIT NONE
+INTEGER(KIND=JPIB), INTENT(IN) :: JOULES
+REAL(KIND=JPRD) KWH
+KWH = REAL(JOULES,JPRD) / 3600000.0_JPRD
+END FUNCTION KWH
+
+SUBROUTINE PRT_TOTAL_ENERGIES(KUN)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN
+IF (KCALL == 1) THEN ! last call
+ WT = UTIL_WALLTIME() - WT0
+ CALL PRT_EMPTY(KUN,2)
+ WRITE(KUN,'(a,a,f12.3,a,i0,a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & " Total energy consumed : ",KWH(TOT_ENERGY), " kWh (",TOT_ENERGY," J)"
+!-- Peak power below is misleading since based on values at sample points
+! WRITE(KUN,'(a,a,i0,a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+! & " Peak power : ",MAXPOWER," W (node "//trim(CLMAXNODE)//")"
+!-- Avg power must be calculated based on total Joules divided by wall time and num nodes
+ AVGPOWER = TOT_ENERGY / WT / NUMNODES
+ WRITE(KUN,'(a,a,i0,a,i0,a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & " Avg. power / node : ",AVGPOWER," W across ",NUMNODES," nodes"
+ CALL PRT_EMPTY(KUN,1)
+ENDIF
+END SUBROUTINE PRT_TOTAL_ENERGIES
+
+SUBROUTINE PRT_DETAIL(KUN)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN
+CHARACTER(LEN=128) :: JOBNAME
+CHARACTER(LEN=128) :: JOBID
+CALL GET_ENVIRONMENT_VARIABLE('EC_JOB_NAME',JOBNAME)
+IF (JOBNAME == '') CALL GET_ENVIRONMENT_VARIABLE('PBS_JOBNAME',JOBNAME)
+IF (JOBNAME == '') CALL GET_ENVIRONMENT_VARIABLE('SLURM_JOB_NAME',JOBNAME)
+IF (JOBNAME == '') CALL GET_ENVIRONMENT_VARIABLE('EC_MEMINFO_JOBNAME',JOBNAME)
+CALL GET_ENVIRONMENT_VARIABLE('PBS_JOBID',JOBID)
+IF (JOBID == '') CALL GET_ENVIRONMENT_VARIABLE('SLURM_JOB_ID',JOBID)
+IF (JOBID == '') CALL GET_ENVIRONMENT_VARIABLE('EC_MEMINFO_JOBID',JOBID)
+CALL PRT_EMPTY(KUN,1)
+WT = UTIL_WALLTIME() - WT0
+WRITE(KUN,'(4a,f10.3,a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO Detailed memory information ", &
+ "for program ",TRIM(PROGRAM)," -- wall-time : ",WT,"s"
+WRITE(KUN,'(a,i0,a,i0,a,i0,a,i0,a,i0,a,i0,a,a,":",a,":",a,a,a,"-",a,"-",a)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO Running on ",NUMNODES," nodes (",NNUMA,&
+ "-numa) with ",NPROC-IOTASKS, &
+ " compute + ",IOTASKS," I/O-tasks and ", MAXTH_COMP, "+", MAXTH_IO, " threads at ", &
+ CLTIMEOD(1:2),CLTIMEOD(3:4),CLTIMEOD(5:10), &
+ " on ",CLDATEOD(7:8),CLMON(IMON),CLDATEOD(1:4)
+WRITE(KUN,'(4a)') CLPFX(1:IPFXLEN)//"## EC_MEMINFO The Job Name is ",TRIM(JOBNAME), &
+ " and the Job ID is ",TRIM(JOBID)
+CALL PRT_EMPTY(KUN,1)
+END SUBROUTINE PRT_DETAIL
+
+SUBROUTINE PRT_HDR(KUN)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN
+INTEGER(KIND=JPIM) :: INUMA, ILEN
+CHARACTER(LEN=4096) :: CLBUF
+INUMA = NNUMA
+
+ILEN = 0
+WRITE(CLBUF(ILEN+1:),'(A)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO | TC | MEMORY USED(MB) "
+ILEN = LEN_TRIM(CLBUF)
+DO K=0,INUMA-1
+ IF (K == 0) THEN
+ WRITE(CLBUF(ILEN+1:),'(A)') " | MEMORY FREE(MB)"
+ ILEN = LEN_TRIM(CLBUF)
+ ELSE
+ WRITE(CLBUF(ILEN+1:),'(A)') " ------------- "
+ ILEN = LEN_TRIM(CLBUF) + 2
+ ENDIF
+ENDDO
+IF (NNUMA > 0) THEN
+ WRITE(CLBUF(ILEN+1:),'(A)') " INCLUDING CACHED| %USED %HUGE | Energy Power"
+ELSE
+ WRITE(CLBUF(ILEN+1:),'(A)') " MEMORY FREE(MB) | %USED %HUGE | Energy Power"
+ENDIF
+WRITE(KUN,'(A)') TRIM(CLBUF)
+
+ILEN=0
+WRITE(CLBUF(ILEN+1:),'(A)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO | Malloc| Inc Heap |"
+ILEN = LEN_TRIM(CLBUF)
+DO K=0,INUMA-1
+ WRITE(CLBUF(ILEN+1:),'(A,I2,A)') " Numa region ",K," |"
+ ILEN = LEN_TRIM(CLBUF)
+ENDDO
+WRITE(CLBUF(ILEN+1:),'(A)') " | | (J) (W)"
+WRITE(KUN,'(A)') TRIM(CLBUF)
+
+ILEN=0
+WRITE(CLBUF(ILEN+1:),'(A)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO Node Name | Heap | RSS("//zum//") |"
+ILEN = LEN_TRIM(CLBUF)
+DO K=0,INUMA-1
+ WRITE(CLBUF(ILEN+1:),'(A)') " Small Huge or |"
+ ILEN = LEN_TRIM(CLBUF)
+ENDDO
+WRITE(CLBUF(ILEN+1:),'(A)') " Total |"
+WRITE(KUN,'(A)') TRIM(CLBUF)
+
+ILEN=0
+WRITE(CLBUF(ILEN+1:),'(A)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO | (sum) | Small Huge |"
+ILEN = LEN_TRIM(CLBUF)
+DO K=0,INUMA-1
+ WRITE(CLBUF(ILEN+1:),'(A)') " Only Small |"
+ ILEN = LEN_TRIM(CLBUF)
+ENDDO
+WRITE(CLBUF(ILEN+1:),'(A)') " Memfree+Cached |"
+WRITE(KUN,'(A)') TRIM(CLBUF)
+END SUBROUTINE PRT_HDR
+
+SUBROUTINE PRT_DATA(KUN)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN
+INTEGER(KIND=JPIM) :: INUMA,ILEN
+CHARACTER(LEN=4096) :: CLBUF
+INUMA = NNUMA
+
+ILEN=0
+WRITE(CLBUF(ILEN+1:),'(a,i4,1x,a,3i8,1x)') &
+ CLPFX(1:IPFXLEN)//"## EC_MEMINFO ", &
+ NODENUM-1,LASTNODE,HEAP_SIZE,TASKSMALL,NODEHUGE
+ILEN = LEN_TRIM(CLBUF) + 1
+DO K=0,INUMA-1
+ WRITE(CLBUF(ILEN+1:),'(1x,2i8)') SMALLPAGE(K),HUGEPAGE(K)
+ ILEN = LEN_TRIM(CLBUF)
+ENDDO
+WRITE(CLBUF(ILEN+1:),'(2x,2i8,3x,2f6.1,1x,i9,1x,i6,1x,a)') &
+ MEMFREE,CACHED, &
+ PERCENT_USED,&
+ ENERGY,POWER,&
+ trim(ID_STRING)
+WRITE(KUN,'(A)') TRIM(CLBUF)
+END SUBROUTINE PRT_DATA
+
+SUBROUTINE CONDBARR()
+IF (NPROC > 1 .and. KBARR /= 0) THEN
+ CALL MPI_BARRIER(KCOMM,ERROR)
+ELSE
+ ERROR = 0
+ENDIF
+END SUBROUTINE CONDBARR
+
+SUBROUTINE CHECK_ERROR(CLWHAT,SRCFILE,SRCLINE)
+IMPLICIT NONE
+CHARACTER(LEN=*), INTENT(IN) :: CLWHAT, SRCFILE
+INTEGER(KIND=JPIM), INTENT(IN) :: SRCLINE
+IF (ERROR /= 0) THEN
+ WRITE(0,'(A,I0,1X,A,1X,"(",A,":",I0,")")') &
+ & CLPFX(1:IPFXLEN)//"## EC_MEMINFO error code =",ERROR,CLWHAT,SRCFILE,SRCLINE
+ CALL MPI_ABORT(KCOMM,-1,ERROR)
+ENDIF
+ERROR = 0
+END SUBROUTINE CHECK_ERROR
+
+SUBROUTINE RNSORT(KUN)
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KUN
+INTEGER(KIND=JPIM) :: ILEN
+CHARACTER(LEN=1) :: CLAST
+CHARACTER(LEN=4) :: CLMASTER
+CHARACTER(LEN=4096) :: CLBUF
+INTEGER(KIND=JPIM) :: impi_vers, impi_subvers, ilibrary_version_len
+INTEGER(KIND=JPIM) :: iomp_vers, iomp_subvers, iopenmp
+CHARACTER(LEN=4096) :: clibrary_version
+LOGICAL :: LLDONE(0:NPROC-1)
+INTEGER(KIND=JPIM) :: REF(0:NPROC-1) ! Keep list of the order tasks been added
+LLDONE(:) = .FALSE.
+IOTASKS = 0
+K = 0
+NODENUM = 0
+DO I=0,NPROC-1
+ IF (RN(I)%NODENUM == -1) THEN
+ IF (RN(I)%IORANK == 1) THEN
+ IOTASKS = IOTASKS + 1
+ RN(I)%IORANK = IOTASKS
+ ELSE
+ RN(I)%IORANK = 0
+ ENDIF
+ NODENUM = NODENUM + 1
+ RN(I)%NODENUM = NODENUM
+ RN(I)%NODEMASTER = 1
+ LLDONE(I) = .TRUE.
+ ! NB: Adjacent REF-elements allow us to operate with particular node's tasks that follow their the node-master
+ REF(K) = I
+ K = K + 1
+ LASTNODE = RN(I)%NODE
+! DO J=I+1,NPROC-1 ! not valid anymore since ranks might have been reordered -- need to run through the whole list -- LLNODE speeds up
+ DO J=0,NPROC-1
+ IF (.NOT.LLDONE(J)) THEN
+ IF (RN(J)%NODENUM == -1) THEN
+ IF (RN(J)%NODE == LASTNODE) THEN
+ RN(J)%NODENUM = NODENUM
+ IF (RN(J)%IORANK == 1) THEN
+ IOTASKS = IOTASKS + 1
+ RN(J)%IORANK = IOTASKS
+ ELSE
+ RN(J)%IORANK = 0
+ ENDIF
+ RN(J)%NODEMASTER = 0
+ LLDONE(J) = .TRUE.
+ REF(K) = J
+ K = K + 1
+ ENDIF
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDIF
+ENDDO
+NUMNODES = NODENUM
+CALL ecmpi_version(impi_vers, impi_subvers, clibrary_version, ilibrary_version_len)
+call ecomp_version(iomp_vers, iomp_subvers, iopenmp)
+CALL PRT_EMPTY(KUN,1)
+WRITE(KUN,'(a,i0,".",i0)') &
+ & CLPFX(1:IPFXLEN)//&
+ & "## EC_MEMINFO : MPI-version ",impi_vers, impi_subvers
+WRITE(KUN,'(a)') &
+ & CLPFX(1:IPFXLEN)//&
+ & "## EC_MEMINFO : Start of MPI-library version"
+WRITE(KUN,'(a)') trim(clibrary_version) ! This is could be a multiline, very long string
+WRITE(KUN,'(a)') &
+ & CLPFX(1:IPFXLEN)//&
+ & "## EC_MEMINFO : End of MPI-library version"
+WRITE(KUN,'(a,i0,".",i0,".",i6.6)') &
+ & CLPFX(1:IPFXLEN)//&
+ & "## EC_MEMINFO : OpenMP-version ",iomp_vers, iomp_subvers, iopenmp
+CALL PRT_EMPTY(KUN,2)
+WRITE(KUN,1003) &
+ & CLPFX(1:IPFXLEN)//&
+ &"## EC_MEMINFO ********************************************************************************",&
+ & CLPFX(1:IPFXLEN)//&
+ &"## EC_MEMINFO *** Mapping of MPI & I/O-tasks to nodes and tasks' thread-to-core affinities ***", &
+ & CLPFX(1:IPFXLEN)//&
+ &"## EC_MEMINFO ********************************************************************************"
+1003 FORMAT((A))
+CALL PRT_EMPTY(KUN,1)
+WRITE(KUN,'(a,i0,a,i0,a,i0,a,i0,a,i0,a,i0,a)') &
+ & CLPFX(1:IPFXLEN)//"## EC_MEMINFO Running on ",NUMNODES," nodes (",NNUMA,&
+ & "-numa) with ",NPROC-IOTASKS, &
+ & " compute + ",IOTASKS," I/O-tasks and ", MAXTH_COMP, "+", MAXTH_IO, " threads"
+CALL PRT_EMPTY(KUN,1)
+WRITE(KUN,1000) CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & "#","NODE#","NODENAME","MPI#","WORLD#","I/O#","MASTER","REF#","OMP#","Core affinities"
+WRITE(KUN,1000) CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & "=","=====","========","====","======","====","======","====","====","==============="
+1000 FORMAT(A,2(1X,A5),1X,A20,6(1X,A6),2X,A)
+CALL PRT_EMPTY(KUN,1)
+DO K=0,NPROC-1 ! Loop over the task as they have been added (see few lines earlier how REF(K) has been getting its values I or J)
+ ILEN = 0
+ ! A formidable trick ? No need for a nested loop over 0:NPROC-1 to keep tasks within the same node together in the output
+ I = REF(K)
+ NUMTH = RN(I)%NUMTH
+ CLMASTER = '[No]'
+ IF (RN(I)%NODEMASTER == 1) CLMASTER = ' Yes'
+ IF (RN(I)%IORANK > 0) THEN
+ WRITE(CLBUF(ILEN+1:),1001) &
+ & CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & K,RN(I)%NODENUM-1,TRIM(ADJUSTL(RN(I)%NODE)),RN(I)%RANK,RN(I)%RANK_WORLD,RN(I)%IORANK-1,&
+ & CLMASTER,I,NUMTH,"{"
+1001 FORMAT(A,2(1X,I5),1X,A20,3(1X,I6),1X,A6,2(1X,I6),2X,A)
+ ELSE
+ WRITE(CLBUF(ILEN+1:),1002) &
+ & CLPFX(1:IPFXLEN)//"## EC_MEMINFO ",&
+ & K,RN(I)%NODENUM-1,TRIM(ADJUSTL(RN(I)%NODE)),RN(I)%RANK,RN(I)%RANK_WORLD,"[No]",&
+ & CLMASTER,I,NUMTH,"{"
+1002 FORMAT(A,2(1X,I5),1X,A20,2(1X,I6),2(1X,A6),2(1X,I6),2X,A)
+ ENDIF
+ ILEN = LEN_TRIM(CLBUF)
+ CLAST = ','
+ DO J=0,NUMTH-1
+ IF (J == NUMTH-1) CLAST = '}'
+ WRITE(CLBUF(ILEN+1:),'(I0,A1)') RN(I)%COREIDS(J),CLAST
+ ILEN = LEN_TRIM(CLBUF)
+ ENDDO
+ WRITE(KUN,'(A,1X)') TRIM(CLBUF)
+ENDDO
+CALL PRT_EMPTY(KUN,1)
+CALL FLUSH(KUN)
+END SUBROUTINE RNSORT
+
+END SUBROUTINE EC_MEMINFO
+
+END MODULE EC_MEMINFO_MOD
+
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_mmpi_finalize_mnh_mod.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_mmpi_finalize_mnh_mod.F90
new file mode 100644
index 0000000000000000000000000000000000000000..cabdf80c9ea53134a797d2cd60b2cb9f758d2856
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/ec_mmpi_finalize_mnh_mod.F90
@@ -0,0 +1,149 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+MODULE EC_MPI_FINALIZE_MOD
+
+CONTAINS
+
+SUBROUTINE MEMINFO(KOUT,KSTEP)
+USE PARKIND1, ONLY : JPIM, JPIB
+USE EC_MEMINFO_MOD
+
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(IN) :: KOUT, KSTEP
+CHARACTER(LEN=32) CLSTEP
+CHARACTER(LEN=160) :: LINE
+CHARACTER(LEN=20) :: NODENAME
+INTEGER(KIND=JPIB) :: NODE(0:17), ISMALL, IHUGE, ITOTAL
+INTEGER(KIND=JPIM) :: I,INUMA,ICOMM
+!#include "ec_meminfo.intfb.h"
+WRITE(CLSTEP,'(11X,"STEP",I5," :")') KSTEP
+ICOMM = -2 ! No headers from EC_MEMINFO by default
+IF (KSTEP == 0) ICOMM = -1 ! Do print headers, too
+CALL EC_MEMINFO(KOUT,TRIM(CLSTEP),ICOMM,KBARR=0,KIOTASK=-1,KCALL=-1)
+CALL FLUSH(KOUT)
+RETURN ! For now
+#if 0
+CALL EC_GETHOSTNAME(NODENAME) ! from support/env.c
+OPEN(FILE="/proc/buddyinfo",UNIT=502,ERR=98,STATUS="old",ACTION="read")
+READ(502,'(a)',END=99) LINE
+READ(502,'(a)',END=99) LINE
+DO INUMA=0,1
+ NODE(:)=0
+ READ(502,'(a)',END=99) LINE
+ READ(LINE(22:160),*,ERR=99,END=99) NODE
+ ISMALL = 0
+ DO I=0,8
+ ISMALL = ISMALL + NODE(I) * (2**I)
+ ENDDO
+ ! Pages >= 2M
+ IHUGE = 0
+ DO I=9,SIZE(NODE)-1
+ IHUGE = IHUGE + NODE(I) * (2**I)
+ ENDDO
+ ITOTAL = ISMALL + IHUGE
+ ISMALL = (ISMALL * 4096)/ONEMEGA
+ IHUGE = (IHUGE * 4096)/ONEMEGA
+ ITOTAL = (ITOTAL * 4096)/ONEMEGA
+ WRITE(KOUT,'(" MEMINFO: STEP=",I0," ",A," NUMA# ",I0," : Free Total = SMALL + HUGEPAGES in MB: ",I0," = ",I0," + ",I0)') &
+ & KSTEP, NODENAME, INUMA, ITOTAL, ISMALL, IHUGE
+ WRITE(KOUT,'(" BUDDYINFO: STEP=",I0," ",A," NUMA# ",I0," : Count of free 2^(0..",I0,")*4096B blocks: ",A)') &
+ & KSTEP, NODENAME, INUMA, SIZE(NODE)-1, LINE(22:160)
+ENDDO
+99 CONTINUE
+CLOSE(502)
+98 CONTINUE
+CALL FLUSH(KOUT)
+#endif
+END SUBROUTINE MEMINFO
+
+SUBROUTINE EC_MPI_FINALIZE(KERROR,LDCALLFINITO,LDMEMINFO,CALLER)
+USE PARKIND1, ONLY : JPIM
+USE MPL_MPIF
+USE EC_MEMINFO_MOD
+
+IMPLICIT NONE
+INTEGER(KIND=JPIM), INTENT(OUT) :: KERROR
+LOGICAL, INTENT(IN) :: LDCALLFINITO
+LOGICAL, INTENT(IN) :: LDMEMINFO
+CHARACTER(LEN=*), INTENT(IN) :: CALLER
+LOGICAL :: LLINIT, LLFIN, LLNOTMPIWORLD
+INTEGER(KIND=JPIM) :: IERR, ICOMM
+INTEGER(KIND=JPIM) :: NCOMM_MEMINFO
+COMMON /cmn_meminfo/ NCOMM_MEMINFO
+!#include "ec_meminfo.intfb.h"
+KERROR = 0
+IF (LDCALLFINITO) THEN !*** common MPI_Finalize()
+ CALL MPI_INITIALIZED(LLINIT,IERR)
+ IF (LLINIT .AND. IERR == 0) THEN
+ CALL MPI_FINALIZED(LLFIN,IERR)
+ IF (.NOT.LLFIN .AND. IERR == 0) THEN
+ LLNOTMPIWORLD = (NCOMM_MEMINFO /= 0 .and. NCOMM_MEMINFO /= MPI_COMM_WORLD)
+ IF (LLNOTMPIWORLD) THEN
+ ICOMM = NCOMM_MEMINFO
+ ELSE
+ ICOMM = MPI_COMM_WORLD
+ ENDIF
+ IF( LDMEMINFO ) CALL EC_MEMINFO(-1,"ec_mpi_finalize:"//caller,ICOMM,KBARR=1,KIOTASK=-1,KCALL=1)
+ CALL c_drhook_prof() ! ifsaux/support/drhook.c : Make sure DrHook output is produced before MPI_Finalize (in case it fails)
+ CALL MPI_BARRIER(ICOMM,IERR)
+ IF (LLNOTMPIWORLD) THEN
+ ! CALL MPI_COMM_FREE(NCOMM_MEMINFO,IERR)
+ NCOMM_MEMINFO = 0
+ ENDIF
+ CALL MPI_FINALIZE(KERROR)
+ ENDIF
+ ENDIF
+ENDIF
+END SUBROUTINE EC_MPI_FINALIZE
+
+SUBROUTINE EC_PMON(ENERGY,POWER)
+USE PARKIND1, ONLY : JPIM, JPIB
+IMPLICIT NONE
+INTEGER(KIND=JPIB),INTENT(OUT) :: ENERGY,POWER
+INTEGER(KIND=JPIB),SAVE :: ENERGY_START = 0
+INTEGER(KIND=JPIM),SAVE :: MONINIT = 0
+INTEGER(KIND=JPIM) :: ISTAT
+CHARACTER(LEN=1) :: CLEC_PMON
+ENERGY = 0
+IF (MONINIT >= 0) THEN
+ IF (MONINIT == 0) THEN ! The very first time only
+ CALL GET_ENVIRONMENT_VARIABLE('EC_PMON',CLEC_PMON)
+ IF (CLEC_PMON == '0') MONINIT = -2 ! Never try again
+ ENDIF
+ IF (MONINIT >= 0) THEN
+ OPEN(503,FILE='/sys/cray/pm_counters/energy',IOSTAT=ISTAT,STATUS='old',ACTION='read')
+ IF (ISTAT == 0) THEN
+ READ(503,*,IOSTAT=ISTAT) ENERGY
+ CLOSE(503)
+ IF (ISTAT == 0) THEN
+ IF (MONINIT == 0) THEN
+ ENERGY_START = ENERGY
+ MONINIT = 1 ! Ok
+ ENDIF
+ ENERGY = ENERGY - ENERGY_START
+ ENDIF
+ ENDIF
+ IF (ISTAT /= 0) THEN
+ MONINIT = -1 ! Never try again
+ ENERGY = 0
+ ENDIF
+ ENDIF
+ENDIF
+POWER = 0
+IF (MONINIT > 0) THEN
+ OPEN(504,FILE='/sys/cray/pm_counters/power',IOSTAT=ISTAT,STATUS='old',ACTION='read')
+ IF (ISTAT == 0) THEN
+ READ(504,*,IOSTAT=ISTAT) POWER
+ CLOSE(504)
+ ENDIF
+ IF (ISTAT /= 0) POWER = 0
+ENDIF
+END SUBROUTINE EC_PMON
+
+END MODULE EC_MPI_FINALIZE_MOD
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/get_proc_id.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/get_proc_id.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8549036011f3e52e474acef26ad8141c098d4ff2
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/get_proc_id.F90
@@ -0,0 +1,19 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+FUNCTION GET_PROC_ID() RESULT(PID)
+
+USE PARKIND1 ,ONLY : JPIM
+!USE MPL_MODULE, ONLY : MPL_RANK
+USE MPL_INIT_MOD
+IMPLICIT NONE
+INTEGER(KIND=JPIM) :: PID
+PID = MPL_RANK
+
+END FUNCTION GET_PROC_ID
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getheapstat.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getheapstat.F90
new file mode 100644
index 0000000000000000000000000000000000000000..2b2cf8357ef8b130f566c0c252f26ff52bc5d7a7
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getheapstat.F90
@@ -0,0 +1,97 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+SUBROUTINE GETHEAPSTAT(KOUT, CDLABEL)
+
+USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPIB
+
+!USE MPL_MODULE
+USE MPL_MYRANK_MOD
+USE MPL_NPROC_MOD
+USE MPL_GATHERV_MOD
+
+#ifdef NAG
+USE F90_UNIX_ENV, ONLY: GETENV
+#endif
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM), INTENT(IN) :: KOUT
+CHARACTER(LEN=*), INTENT(IN) :: CDLABEL
+INTEGER(KIND=JPIM) :: I, IMYPROC, INPROC, IRET, IOFFSET, II
+INTEGER(KIND=JPIM), PARAMETER :: JP_NPROFILE = 9 ! pls. consult ifsaux/utilities/getcurheap.c
+INTEGER(KIND=JPIM), PARAMETER :: ISIZE = JP_NPROFILE+1
+INTEGER(KIND=JPIB) ILIMIT(ISIZE)
+INTEGER(KIND=JPIB) ICNT(ISIZE)
+REAL(KIND=JPRB), ALLOCATABLE :: ZSEND(:), ZRECV(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: ICOUNTS(:)
+CHARACTER(LEN=1) CLENV
+CHARACTER(LEN=80) CLTEXT(0:4)
+
+CALL GET_ENVIRONMENT_VARIABLE("EC_PROFILE_HEAP", CLENV) ! turn OFF by export EC_PROFILE_HEAP=0
+
+IF (KOUT >= 0 .AND. CLENV /= '0') THEN
+ IMYPROC = MPL_MYRANK()
+ INPROC = MPL_NPROC()
+
+ DO I=1,ISIZE
+ ILIMIT(I) = I ! power of 10's ; pls. consult ifsaux/utilities/getcurheap.c
+ ENDDO
+
+ ALLOCATE(ZSEND(ISIZE))
+ ALLOCATE(ZRECV(ISIZE * INPROC))
+ ALLOCATE(ICOUNTS(INPROC))
+
+ CLTEXT(0) = "free()/DEALLOCATE -hits per byte range"
+ CLTEXT(1) = "malloc()/ALLOCATE -hits per byte range"
+ CLTEXT(2) = "Outstanding malloc()/ALLOCATE -hits per byte range"
+ CLTEXT(3) = "Outstanding amount of malloc()/ALLOCATE -bytes per byte range"
+ CLTEXT(4) = "Average amount of outstanding malloc()/ALLOCATE -bytes per byte range"
+
+ DO II=0,4
+ ICNT(:) = 0
+ CALL PROFILE_HEAP_GET(ICNT, ISIZE, II, IRET)
+
+ ZSEND(:) = 0
+ DO I=1,IRET
+ ZSEND(I) = ICNT(I)
+ ENDDO
+ ZRECV(:) = -1
+
+ ICOUNTS(:) = ISIZE
+ CALL MPL_GATHERV(ZSEND(:), KROOT=1, KRECVCOUNTS=ICOUNTS(:), &
+ &PRECVBUF=ZRECV, CDSTRING='GETHEAPSTAT:')
+
+ IF (IMYPROC == 1) THEN
+! Not more than 132 columns, please :-)
+ WRITE(KOUT,9000) TRIM(CLTEXT(II)),TRIM(CDLABEL), "Node", &
+ & (ILIMIT(I),I=1,MIN(JP_NPROFILE,9)), "Larger"
+9000 FORMAT(/,"Heap Utilization Profile (",A,"): ",A,&
+ &/,126("="),&
+ &//,(A4,2X,9(:,2X,4X,"< 10^",I1),:,2X,A10))
+ WRITE(KOUT,9001)
+9001 FORMAT(4("="),2X,10(2X,10("="))/)
+ IOFFSET = 0
+ DO I=1,INPROC
+ ICNT(:) = ZRECV(IOFFSET+1:IOFFSET+ISIZE)
+ WRITE(KOUT,'(i4,2x,(10(:,2x,i10)))') I,ICNT(:)
+ IOFFSET = IOFFSET + ISIZE
+ ENDDO
+ ENDIF
+ ENDDO
+
+ IF (IMYPROC == 1) THEN
+ WRITE(KOUT,'(/,a,/)') 'End of Heap Utilization Profile'
+ ENDIF
+
+ DEALLOCATE(ZSEND)
+ DEALLOCATE(ZRECV)
+ DEALLOCATE(ICOUNTS)
+ENDIF
+END SUBROUTINE GETHEAPSTAT
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getmemstat.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getmemstat.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c866925d7e3f3a27aeac4e8adc6ecfee23123167
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/getmemstat.F90
@@ -0,0 +1,75 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+SUBROUTINE GETMEMSTAT(KOUT, CDLABEL)
+
+USE PARKIND1 ,ONLY : JPIM ,JPRB ,JPIB
+
+! USE MPL_MODULE
+USE MPL_MYRANK_MOD
+USE MPL_NPROC_MOD
+USE MPL_GATHERV_MOD
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM), INTENT(IN) :: KOUT
+CHARACTER(LEN=*), INTENT(IN) :: CDLABEL
+INTEGER(KIND=JPIM) :: I, IMYPROC, INPROC, IOFFSET
+INTEGER(KIND=JPIM), PARAMETER :: JP_MEMKEYS = 5 ! pls. consult ifsaux/utilities/getmemvals.F90
+INTEGER(KIND=JPIM) IMEMKEYS(JP_MEMKEYS)
+INTEGER(KIND=JPIB) IMEMVALS(JP_MEMKEYS)
+REAL(KIND=JPRB), ALLOCATABLE :: ZSEND(:), ZRECV(:)
+INTEGER(KIND=JPIM), ALLOCATABLE :: ICOUNTS(:)
+CHARACTER(LEN=1) CLENV
+
+CALL GET_ENVIRONMENT_VARIABLE("EC_PROFILE_MEM", CLENV) ! turn OFF by export EC_PROFILE_MEM=0
+
+IF (KOUT >= 0 .AND. CLENV /= '0') THEN
+ IMYPROC = MPL_MYRANK()
+ INPROC = MPL_NPROC()
+
+ ALLOCATE(ZSEND(JP_MEMKEYS))
+ ALLOCATE(ZRECV(JP_MEMKEYS * INPROC))
+ ALLOCATE(ICOUNTS(INPROC))
+
+! 1=MAXHEAP, 2=MAXRSS, 3=CURRENTHEAP, 5=MAXSTACK, 6=PAGING
+ IMEMKEYS(:) = (/1, 2, 3, 5, 6/)
+ CALL GETMEMVALS(JP_MEMKEYS, IMEMKEYS, IMEMVALS)
+
+ ZSEND(:) = 0
+ DO I=1,JP_MEMKEYS
+ ZSEND(I) = IMEMVALS(I)
+ ENDDO
+ ZRECV(:) = -1
+
+ ICOUNTS(:) = JP_MEMKEYS
+ CALL MPL_GATHERV(ZSEND(:), KROOT=1, KRECVCOUNTS=ICOUNTS(:), &
+ &PRECVBUF=ZRECV, CDSTRING='GETMEMSTAT:')
+
+ IF (IMYPROC == 1) THEN
+ WRITE(KOUT,9000) TRIM(CDLABEL)
+9000 FORMAT(/,"Memory Utilization Information (in bytes) : ",a,/,79("="),//,&
+ & "Node Max heapsize Max resident Current heap Max stack I/O-paging #",/,&
+ & "==== ============ ============ ============ ============ ============",//)
+ IOFFSET = 0
+ DO I=1,INPROC
+ IMEMVALS(:) = ZRECV(IOFFSET+1:IOFFSET+JP_MEMKEYS)
+ WRITE(KOUT,'(I4,5(3X,I12))') I,IMEMVALS(:)
+ IOFFSET = IOFFSET + JP_MEMKEYS
+ ENDDO
+ WRITE(KOUT,'(/,a,/)') 'End of Memory Utilization Information'
+ ENDIF
+
+ DEALLOCATE(ZSEND)
+ DEALLOCATE(ZRECV)
+ DEALLOCATE(ICOUNTS)
+
+ CALL GETHEAPSTAT(KOUT, CDLABEL)
+ENDIF
+END SUBROUTINE GETMEMSTAT
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_barrier_mod.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_barrier_mod.F90
new file mode 100644
index 0000000000000000000000000000000000000000..c3ea263afe886c7cc63730a80dd26064d509ee2f
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_barrier_mod.F90
@@ -0,0 +1,110 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE MPL_BARRIER_MOD
+
+
+
+!**** MPL_BARRIER - Barrier synchronisation
+
+! Purpose.
+! --------
+! Blocks the caller until all group members have called it.
+
+!** Interface.
+! ----------
+! CALL MPL_BARRIER
+
+! Input required arguments :
+! -------------------------
+! none
+
+! Input optional arguments :
+! -------------------------
+! KCOMM - Communicator number if different from MPI_COMM_WORLD
+! or from that established as the default
+! by an MPL communicator routine
+! CDSTRING - Character string for ABORT messages
+! used when KERROR is not provided
+
+! Output required arguments :
+! -------------------------
+! none
+
+! Output optional arguments :
+! -------------------------
+! KERROR - return error code. If not supplied,
+! MPL_BARRIER aborts when an error is detected.
+! Author.
+! -------
+! D.Dent, M.Hamrud ECMWF
+
+! Modifications.
+! --------------
+! Original: 2000-09-01
+! Threadsafe: 2004-12-15, J.Hague
+
+! ------------------------------------------------------------------
+
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+
+USE MPL_DATA_MODULE
+USE MPL_MESSAGE_MOD
+
+IMPLICIT NONE
+
+
+PRIVATE
+
+LOGICAL :: LLABORT=.TRUE.
+
+PUBLIC MPL_BARRIER
+
+CONTAINS
+
+SUBROUTINE MPL_BARRIER(KCOMM,CDSTRING,KERROR)
+
+
+#ifdef USE_8_BYTE_WORDS
+ USE MPI4TO8, ONLY : &
+ MPI_BARRIER => MPI_BARRIER8
+#endif
+
+
+INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KCOMM
+INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
+CHARACTER*(*),INTENT(IN),OPTIONAL :: CDSTRING
+INTEGER :: ICOMM,IERROR,ITID
+IERROR = 0
+ITID = OML_MY_THREAD()
+IF(MPL_NUMPROC < 1) CALL MPL_MESSAGE(CDSTRING=CDSTRING,&
+ & CDMESSAGE='MPL_BARRIER: MPL NOT INITIALISED ',LDABORT=LLABORT)
+
+IF(PRESENT(KCOMM)) THEN
+ ICOMM=KCOMM
+ELSE
+ ICOMM=MPL_COMM_OML(ITID)
+ENDIF
+
+#ifdef VPP
+ CALL VPP_BARRIER
+#else
+ CALL MPI_BARRIER(ICOMM,IERROR)
+#endif
+
+IF(PRESENT(KERROR)) THEN
+ KERROR=IERROR
+ELSE
+ IF(IERROR /= 0 ) CALL MPL_MESSAGE(IERROR,'MPL_BARRIER',CDSTRING,LDABORT=LLABORT)
+ENDIF
+
+RETURN
+END SUBROUTINE MPL_BARRIER
+
+END MODULE MPL_BARRIER_MOD
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_end_mod.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_end_mod.F90
new file mode 100644
index 0000000000000000000000000000000000000000..ee3f727560cfbc8d31c8bdb067e68df0a7d309e1
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_end_mod.F90
@@ -0,0 +1,142 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE MPL_END_MOD
+
+!**** MPL_END - Terminates the message passing environment
+
+! Purpose.
+! --------
+! Cleans up all of the MPI state.
+! Subsequently, no MPI routine can be called
+
+!** Interface.
+! ----------
+! CALL MPL_END
+
+! Input required arguments :
+! -------------------------
+! none
+
+! Input optional arguments :
+! -------------------------
+! none
+
+! Output required arguments :
+! -------------------------
+! none
+
+! Output optional arguments :
+! -------------------------
+! KERROR - return error code. If not supplied,
+! MPL_END aborts when an error is detected.
+! Author.
+! -------
+! D.Dent, M.Hamrud ECMWF
+
+! Modifications.
+! --------------
+! Original: 2000-09-01
+! P. Towers 3-Jul-2014 Add call to ec_cray_meminfo
+
+! ------------------------------------------------------------------
+
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+
+USE MPL_DATA_MODULE
+USE MPL_MESSAGE_MOD
+USE EC_MPI_FINALIZE_MOD
+
+IMPLICIT NONE
+
+PUBLIC MPL_END
+PRIVATE
+
+INTEGER :: IERROR
+
+CONTAINS
+
+SUBROUTINE MPL_END(KERROR,LDMEMINFO)
+
+
+#ifdef USE_8_BYTE_WORDS
+ USE MPI4TO8, ONLY : &
+ MPI_BUFFER_DETACH => MPI_BUFFER_DETACH8, MPI_FINALIZE => MPI_FINALIZE8
+#endif
+
+
+INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR
+LOGICAL ,INTENT(IN), OPTIONAL :: LDMEMINFO
+INTEGER(KIND=JPIM) :: IERROR
+LOGICAL :: LLMEMINFO=.TRUE.
+LOGICAL :: LLABORT=.TRUE.
+
+!#include "ec_mpi_finalize.intfb.h"
+
+IF(MPL_NUMPROC < 1) THEN
+ IF(MPL_NUMPROC == -1) THEN
+ IF (.NOT.LINITMPI_VIA_MPL) THEN
+ ! Neither MPL_INIT_MOD nor MPL_ARG_MOD -modules were called before this
+ CALL MPL_MESSAGE(CDMESSAGE=' MPL_END CALLED BEFORE MPL_INIT ')
+ ENDIF
+!!-- we do not want the following message to appear, since its non-fatal
+!! ELSEIF(MPL_NUMPROC == -2) THEN
+!! CALL MPL_MESSAGE(CDMESSAGE=' MPL_END CALLED MULTIPLE TIMES ')
+ ENDIF
+ IF(PRESENT(KERROR)) THEN
+ IERROR=0
+ KERROR=IERROR
+ ENDIF
+ RETURN
+ENDIF
+
+IF (ALLOCATED(MPL_ATTACHED_BUFFER)) THEN
+ IF( MPI_IS_FINALIZED() ) THEN
+ CALL MPL_MESSAGE(CDMESSAGE='MPL_END -- Cannot call MPI_Buffer_detach() as MPI is already finalized',LDABORT=.FALSE.)
+ ELSE
+ CALL MPI_BUFFER_DETACH(MPL_ATTACHED_BUFFER,MPL_MBX_SIZE,IERROR)
+ IF(PRESENT(KERROR)) THEN
+ KERROR=IERROR
+ ELSE
+ IF( IERROR /= 0 )THEN
+ CALL MPL_MESSAGE(IERROR,'MPL_END ',LDABORT=LLABORT)
+ ENDIF
+ ENDIF
+ ENDIF
+ DEALLOCATE(MPL_ATTACHED_BUFFER)
+ENDIF
+
+IF(PRESENT(LDMEMINFO)) LLMEMINFO=LDMEMINFO
+CALL EC_MPI_FINALIZE(IERROR,LINITMPI_VIA_MPL,LLMEMINFO,"mpl_end")
+
+MPL_NUMPROC = -2
+LINITMPI_VIA_MPL = .FALSE.
+
+IF(PRESENT(KERROR)) THEN
+ KERROR=IERROR
+ENDIF
+
+RETURN
+END SUBROUTINE MPL_END
+
+FUNCTION MPI_IS_FINALIZED()
+ LOGICAL :: MPI_IS_FINALIZED
+ LOGICAL :: LLINIT, LLFIN
+ INTEGER(KIND=JPIM) :: IERR
+ MPI_IS_FINALIZED = .FALSE.
+ CALL MPI_INITIALIZED(LLINIT,IERR)
+ IF (LLINIT .AND. IERR == 0) THEN
+ CALL MPI_FINALIZED(LLFIN,IERR)
+ IF( IERR == 0 ) THEN
+ MPI_IS_FINALIZED = LLFIN
+ ENDIF
+ ENDIF
+END FUNCTION
+
+END MODULE MPL_END_MOD
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_init_mod.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_init_mod.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f30ad098b8e16f034d6ab763f4d0411427fe7a2d
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_init_mod.F90
@@ -0,0 +1,421 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE MPL_INIT_MOD
+
+!**** MPL_INIT - Initialises the Message passing environment
+
+! Purpose.
+! --------
+! Must be called before any other MPL routine.
+
+!** Interface.
+! ----------
+! CALL MPL_INIT
+
+! Input required arguments :
+! -------------------------
+! none
+
+! Input optional arguments :
+! -------------------------
+! KOUTPUT - Level of printing for MPL routines
+! =0: none
+! =1: intermediate (default)
+! =2: full trace
+! KUNIT - Fortran Unit to receive printed trace
+! LDINFO - = .TRUE. : Print informative msgs from MPL_INIT (default)
+! = .FALSE. : Do not print
+! LDENV - = .TRUE. : Propagate environment variables across participating tasks (default)
+! = .FALSE. : Do not propagate
+!
+
+! Output required arguments :
+! -------------------------
+! none
+
+! Output optional arguments :
+! -------------------------
+! KERROR - return error code. If not supplied,
+! MPL_INIT aborts when an error is detected.
+! KPROCS - Number of processes which have been initialised
+! in the MPI_COMM_WORLD communicator
+! Author.
+! -------
+! D.Dent, M.Hamrud ECMWF
+
+! Modifications.
+! --------------
+! Original: 2000-09-01
+! R. El Khatib 14-May-2007 Do not propagate environment if NECSX
+! S. Saarinen 04-Oct-2009 Reduced output & redefined MPL_COMM_OML(1)
+! P. Marguinaud 01-Jan-2011 Add LDENV argument
+! R. El Khatib 24-May-2011 Make MPI2 the default expectation.
+! P. Towers 3-Jul-2014 Add call to ec_cray_meminfo
+! ------------------------------------------------------------------
+
+USE PARKIND1 ,ONLY : JPIM ,JPRB
+USE OML_MOD, ONLY : OML_INIT, OML_MAX_THREADS
+USE MPL_MPIF
+USE MPL_DATA_MODULE
+USE MPL_MESSAGE_MOD
+USE MPL_BUFFER_METHOD_MOD
+USE MPL_TOUR_TABLE_MOD
+USE MPL_LOCOMM_CREATE_MOD
+USE MPL_ARG_MOD
+
+IMPLICIT NONE
+
+PUBLIC MPL_INIT,MPL_WORLD_RANK, MPL_WORLD_SIZE, MPL_RANK
+
+PRIVATE
+
+CONTAINS
+
+SUBROUTINE MPL_INIT(KOUTPUT,KUNIT,KERROR,KPROCS,LDINFO,LDENV)
+
+#ifdef USE_8_BYTE_WORDS
+ USE MPI4TO8, ONLY : &
+ MPI_INITIALIZED => MPI_INITIALIZED8, MPI_INIT => MPI_INIT8, &
+ MPI_COMM_SIZE => MPI_COMM_SIZE8, MPI_COMM_RANK => MPI_COMM_RANK8, &
+ MPI_BCAST => MPI_BCAST8
+#endif
+
+
+
+INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KOUTPUT,KUNIT
+INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL :: KERROR,KPROCS
+LOGICAL,INTENT(IN),OPTIONAL :: LDINFO,LDENV
+INTEGER(KIND=JPIM) :: IERROR,IP,ICOMM,IRANK,JNODE,JROC,ISTA
+INTEGER(KIND=JPIM) :: IMAX_THREADS, IRET, IROOT, INUM(2), ICOUNT
+INTEGER(KIND=JPIM) :: IREQUIRED,IPROVIDED
+INTEGER(KIND=JPIM) :: IWORLD_RANK, IWORLD_SIZE
+INTEGER(KIND=JPIM) :: MPL_WORLD_RANK, MPL_WORLD_SIZE, MPL_RANK
+INTEGER(KIND=JPIM) :: IME
+LOGICAL :: LLABORT=.TRUE., LLINFO
+LOGICAL :: LLINIT
+LOGICAL :: LLENV
+CHARACTER(LEN=12) :: CL_MBX_SIZE
+CHARACTER(LEN=12) :: CL_ARCH
+CHARACTER(LEN=12) :: CL_TASKSPERNODE
+CHARACTER(LEN=1024) :: CLENV
+CHARACTER(LEN=20) :: CL_METHOD,CL_HOST
+CHARACTER(LEN=1) :: CL_SET
+
+IF(PRESENT(KOUTPUT)) THEN
+ MPL_OUTPUT=MAX(0,KOUTPUT)
+ELSE
+ MPL_OUTPUT=1
+ENDIF
+
+IF(PRESENT(KUNIT)) THEN
+ MPL_UNIT=MAX(0,KUNIT)
+ELSE
+ MPL_UNIT=6
+ENDIF
+
+IF(PRESENT(LDINFO)) THEN
+ LLINFO = LDINFO
+ELSE
+ LLINFO = .TRUE.
+ENDIF
+
+IF(PRESENT(LDENV)) THEN
+ LLENV = LDENV
+ELSE
+ LLENV = .TRUE.
+ENDIF
+
+IF(MPL_NUMPROC /= -1) THEN
+!! We do not want this extra message
+!! CALL MPL_MESSAGE(CDMESSAGE=' MPL_INIT CALLED MULTIPLE TIMES ')
+ IF(PRESENT(KERROR)) THEN
+ KERROR=0
+ ENDIF
+ IF(PRESENT(KPROCS)) THEN
+ KPROCS=MPL_NUMPROC
+ ENDIF
+ RETURN
+ENDIF
+
+CALL MPI_INITIALIZED(LLINIT, IRET)
+
+IF (.NOT.LLINIT) THEN
+
+ CALL GET_ENVIRONMENT_VARIABLE('ARCH',CL_ARCH)
+
+#ifndef OPS_COMPILE
+#ifdef RS6K
+ IF(CL_ARCH(1:10)=='ibm_power6')THEN
+! write(0,*)'POWER6: CALLING EC_BIND BEFORE MPI_INIT'
+ CALL EC_BIND()
+ ENDIF
+#endif
+#endif
+
+
+#ifndef MPI1
+ IREQUIRED = MPI_THREAD_MULTIPLE
+ IPROVIDED = MPI_THREAD_SINGLE
+ CALL MPI_INIT_THREAD(IREQUIRED,IPROVIDED,IERROR)
+ IF (IERROR /= 0) CALL ABOR1 ('MPL_INIT: MPI_INIT_THREAD FAILED')
+ LTHSAFEMPI = (IPROVIDED >= IREQUIRED)
+#else
+ CALL MPI_INIT(IERROR)
+ IF (IERROR /= 0) CALL ABOR1 ('MPL_INIT: MPI_INIT FAILED')
+ LTHSAFEMPI = .FALSE.
+#endif
+
+CALL MPI_Comm_rank(MPI_COMM_WORLD, IME, IERROR)
+
+! Print out thread safety etc. messages -- must use MPI_Comm_rank since MPL not initialized just yet
+IF (IME == 0) THEN
+ WRITE(0,'(1X,A,4(1X,I0),1(1X,L1))') &
+ & 'MAIN: IREQUIRED, MPI_THREAD_MULTIPLE, MPI_THREAD_SINGLE, IPROVIDED, LTHSAFEMPI =',&
+ & IREQUIRED, MPI_THREAD_MULTIPLE, MPI_THREAD_SINGLE, IPROVIDED, LTHSAFEMPI
+ENDIF
+
+#ifndef OPS_COMPILE
+#ifdef RS6K
+ IF(CL_ARCH(1:10)=='ibm_power4')THEN
+! write(0,*)'POWER5: CALLING EC_BIND AFTER MPI_INIT'
+ CALL EC_BIND()
+ ENDIF
+#endif
+#endif
+
+ LINITMPI_VIA_MPL = .TRUE.
+! CALL ec_mpi_atexit() ! ifsaux/support/endian.c: to make sure MPI_FINALIZE gets called
+
+ELSE
+ IERROR = 0
+ENDIF
+
+IF(PRESENT(KERROR)) THEN
+ KERROR=IERROR
+ELSE
+ IF(IERROR /= 0) THEN
+ CALL MPL_MESSAGE(IERROR,CDMESSAGE=' MPL_INIT ERROR ',LDABORT=LLABORT)
+ ENDIF
+ENDIF
+
+! If LMPLUSERCOMM is not set use MPI_COMM_WORLD
+!mps: Sami Saarinen, 29-Nov-2016
+! Must be set *AFTER* MPI_INIT*() has ben called (or LLINIT is true)
+! Otherwise MPI_COMM_WORLD not defined (at least not in OpenMPI)
+IF(LMPLUSERCOMM) THEN
+ MPL_COMM = MPLUSERCOMM
+ELSE
+ MPL_COMM = MPI_COMM_WORLD
+ENDIF
+
+CALL MPI_COMM_SIZE(MPL_COMM,MPL_NUMPROC,IERROR)
+
+IF(PRESENT(KPROCS)) THEN
+ KPROCS=MPL_NUMPROC
+ENDIF
+
+ALLOCATE (MPL_IDS(MPL_NUMPROC))
+DO IP=1,MPL_NUMPROC
+ MPL_IDS(IP)=IP
+ENDDO
+
+CALL MPI_COMM_RANK(MPL_COMM, IRANK, IERROR)
+MPL_RANK=IRANK+1
+
+LLINFO = LLINFO .AND. (MPL_RANK <= 1)
+
+IF (LLINFO) THEN
+ IF(LMPLUSERCOMM) THEN
+ WRITE(MPL_UNIT,'(A)')'MPL_INIT : LMPLUSERCOMM used'
+ WRITE(MPL_UNIT,'(A,I0)')'Communicator : ',MPL_COMM
+ ELSE
+ WRITE(MPL_UNIT,'(A)')'MPL_INIT : LMPLUSERCOMM not used'
+ WRITE(MPL_UNIT,'(A,I0)')'Communicator : ',MPL_COMM
+ ENDIF
+ENDIF
+
+#ifndef NECSX
+
+!-- Propagate environment variables & argument lists
+! Here we have to be careful and use MPI_BCAST directly (not MPL_BROADCAST) since
+! 1) MPL_BUFFER_METHOD has not been called
+! 2) MPL_COMM_OML has not been initialized since it is possible that only the
+! master proc knows the # of threads (i.e. OMP_NUM_THREADS may be set only for master)
+
+! Do not propagate on nec machine because the environment variables could be mpi-task-specific.
+
+IF (MPL_NUMPROC > 1 .AND. LLENV) THEN
+ IROOT = 0
+ !-- Progate environment variables
+ INUM(1) = 0 ! The number of environment variables
+ INUM(2) = 0 ! Do not (=0) or do (=1) overwrite if particular environment variable already exists (0 = default)
+ IF (MPL_RANK == 1) THEN ! Master proc inquires
+ CALL EC_NUMENV(INUM(1)) ! ../support/env.c
+ CALL EC_OVERWRITE_ENV(INUM(2)) ! ../support/env.c
+ ENDIF
+ ! The following broadcast does not use "mailbox" nor attached buffer, both potentially yet to be allocated
+ CALL MPI_BCAST(INUM(1),2,INT(MPI_INTEGER),IROOT,MPL_COMM,IERROR)
+ ICOUNT = LEN(CLENV)
+ DO IP=1,INUM(1)
+ IF (MPL_RANK == 1) CALL EC_STRENV(IP,CLENV)
+ ! The following broadcast does not use "mailbox" nor attached buffer, both potentially yet to be allocated
+ CALL MPI_BCAST(CLENV,ICOUNT,INT(MPI_BYTE),IROOT,MPL_COMM,IERROR)
+ IF (MPL_RANK > 1) THEN
+ IF (INUM(2) == 1) THEN
+ CALL EC_PUTENV(CLENV) ! ../support/env.c ; Unconditionally overwrite, even if already exists
+ ELSE
+ CALL EC_PUTENV_NOOVERWRITE(CLENV) ! ../support/env.c ; Do not overwrite, if exists
+ ENDIF
+ ENDIF
+ ENDDO
+ !-- Redo some env. variables (see ../utilities/fnecsx.c)
+ CALL EC_ENVREDO()
+ !-- Propagate argument list (all under the bonnet using MPL_ARG_MOD-module)
+ INUM = MPL_IARGC()
+ENDIF
+
+#endif
+
+CALL OML_INIT()
+IMAX_THREADS = OML_MAX_THREADS()
+ALLOCATE(MPL_COMM_OML(IMAX_THREADS))
+
+IF (LMPLUSERCOMM) THEN
+ MPL_COMM_OML(1) = MPLUSERCOMM
+ ISTA = 2
+ELSE
+ ISTA = 1
+ENDIF
+
+DO IP=ISTA,IMAX_THREADS
+ CALL MPL_LOCOMM_CREATE(MPL_NUMPROC,MPL_COMM_OML(IP))
+ENDDO
+MPL_COMM = MPL_COMM_OML(1) ! i.e. not necessary MPI_COMM_WORLD anymore
+
+#ifdef VPP
+MPL_METHOD=JP_BLOCKING_STANDARD
+MPL_MBX_SIZE=4000000
+CL_MBX_SIZE=' '
+CALL GET_ENVIRONMENT_VARIABLE('VPP_MBX_SIZE',CL_MBX_SIZE)
+IF(CL_MBX_SIZE == ' ') THEN
+ CALL GET_ENVIRONMENT_VARIABLE('MPL_MBX_SIZE',CL_MBX_SIZE)
+ENDIF
+IF(CL_MBX_SIZE /= ' ') THEN
+ READ(CL_MBX_SIZE,*) MPL_MBX_SIZE
+ENDIF
+IF (LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT : MPL_METHOD=JP_BLOCKING_STANDARD'
+IF (LLINFO) WRITE(MPL_UNIT,'(A,I0)')'MPL_INIT : MAILBOX SIZE=',MPL_MBX_SIZE
+LUSEHLMPI = .FALSE.
+
+!#elif defined (LINUX)
+!MPL_METHOD=JP_BLOCKING_STANDARD
+!MPL_MBX_SIZE=4000000
+!CL_MBX_SIZE=' '
+!CALL GET_ENVIRONMENT_VARIABLE('VPP_MBX_SIZE',CL_MBX_SIZE)
+!IF(CL_MBX_SIZE == ' ') THEN
+! CALL GET_ENVIRONMENT_VARIABLE('MPL_MBX_SIZE',CL_MBX_SIZE)
+!ENDIF
+!IF(CL_MBX_SIZE /= ' ') THEN
+! READ(CL_MBX_SIZE,*) MPL_MBX_SIZE
+!ENDIF
+!IF (LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT : MPL_METHOD=JP_BLOCKING_STANDARD'
+!IF (LLINFO) WRITE(MPL_UNIT,'(A,I0)')'MPL_INIT : MAILBOX SIZE=',MPL_MBX_SIZE
+!LUSEHLMPI = .FALSE.
+
+#else
+CL_METHOD=' '
+CALL GET_ENVIRONMENT_VARIABLE('MPL_METHOD',CL_METHOD)
+IF (CL_METHOD == 'JP_BLOCKING_STANDARD' ) THEN
+ MPL_METHOD=JP_BLOCKING_STANDARD
+ELSE
+ MPL_METHOD=JP_BLOCKING_BUFFERED
+ENDIF
+MPL_MBX_SIZE=1000000
+CL_MBX_SIZE=' '
+CALL GET_ENVIRONMENT_VARIABLE('MPL_MBX_SIZE',CL_MBX_SIZE)
+IF (CL_MBX_SIZE /= ' ') THEN
+ READ(CL_MBX_SIZE,*) MPL_MBX_SIZE
+ENDIF
+IF (CL_METHOD == 'JP_BLOCKING_STANDARD' ) THEN
+ IF (LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT : MPL_METHOD=JP_BLOCKING_STANDARD'
+ELSE
+ IF (LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT : MPL_METHOD=JP_BLOCKING_BUFFERED'
+ENDIF
+!IF (LLINFO) WRITE(MPL_UNIT,'(A,I0)')'MPL_INIT : MAILBOX SIZE=',MPL_MBX_SIZE
+
+CALL MPL_BUFFER_METHOD(KMP_TYPE=MPL_METHOD,KMBX_SIZE=MPL_MBX_SIZE,LDINFO=LLINFO)
+LUSEHLMPI = .TRUE.
+#endif
+
+CALL MPI_COMM_RANK (MPI_COMM_WORLD, IWORLD_RANK, IERROR)
+CALL MPI_COMM_SIZE (MPI_COMM_WORLD, IWORLD_SIZE, IERROR)
+
+#ifdef LINUX
+CALL LINUX_BIND (IWORLD_RANK, IWORLD_SIZE)
+#endif
+
+!-- World-wide tasks
+MPL_WORLD_RANK = IWORLD_RANK
+MPL_WORLD_SIZE = IWORLD_SIZE
+
+!!!! If you are not at ECMWF this may need changing!!!!
+CALL GET_ENVIRONMENT_VARIABLE('EC_TASKS_PER_NODE',CL_TASKSPERNODE)
+IF (CL_TASKSPERNODE(1:1) == ' ' ) THEN
+ CALL GET_ENVIRONMENT_VARIABLE('HOST',CL_HOST)
+ IF(CL_HOST(1:3) == 'cck') THEN ! KNL
+ MPL_NCPU_PER_NODE=64
+ ELSEIF(CL_HOST(1:3) == 'cct') THEN ! Test-cluster
+ MPL_NCPU_PER_NODE=24
+ ELSEIF(CL_HOST(1:2) == 'cc') THEN ! cca/ccb
+ MPL_NCPU_PER_NODE=36
+ ELSEIF(CL_HOST(1:3) == 'lxg') THEN ! GPU-cluster
+ MPL_NCPU_PER_NODE=24
+ ELSEIF (CL_HOST(1:2) == 'c1') THEN
+ MPL_NCPU_PER_NODE=64
+ ELSEIF(CL_HOST(1:3) == 'hpc') THEN
+ MPL_NCPU_PER_NODE=32
+ ELSE
+ MPL_NCPU_PER_NODE=1
+ IF(LLINFO) WRITE(MPL_UNIT,'(A)')'MPL_INIT CAUTION: MPL_NCPU_PER_NODE=1'
+ ENDIF
+ELSE
+ READ(CL_TASKSPERNODE,*) MPL_NCPU_PER_NODE
+ENDIF
+MPL_MAX_TASK_PER_NODE=MAX(1, MPL_NCPU_PER_NODE/IMAX_THREADS)
+LFULLNODES=MOD(MPL_NUMPROC,MPL_MAX_TASK_PER_NODE) == 0
+MPL_NNODES=(MPL_NUMPROC-1)/MPL_MAX_TASK_PER_NODE+1
+ALLOCATE(MPL_TASK_PER_NODE(MPL_NNODES))
+ALLOCATE(MPL_NODE(MPL_NUMPROC))
+ALLOCATE(MPL_NODE_TASKS(MPL_NNODES,MPL_MAX_TASK_PER_NODE))
+MPL_NODE_TASKS(:,:)=-99
+ICOUNT=0
+DO JNODE=1,MPL_NNODES
+ DO JROC=1,MPL_MAX_TASK_PER_NODE
+ ICOUNT=ICOUNT+1
+ IF (ICOUNT<=MPL_NUMPROC) THEN
+ MPL_NODE(ICOUNT)=JNODE
+ MPL_TASK_PER_NODE(JNODE) = JROC
+ MPL_NODE_TASKS(JNODE,JROC) = ICOUNT
+ ENDIF
+ ENDDO
+ENDDO
+MPL_MYNODE=(MPL_RANK-1)/MPL_MAX_TASK_PER_NODE+1
+!WRITE(MPL_UNIT,*) 'MPL_INIT : NCPU_PER_NODE,MPL_MAX_TASK_PER_NODE,MPL_NNODES,MPL_MYNODE ',&
+! & MPL_NCPU_PER_NODE,MPL_MAX_TASK_PER_NODE,MPL_NNODES,MPL_MYNODE
+!WRITE(MPL_UNIT,*) 'MPL_INIT : MPL_NODE_TASKS(MPL_MYNODE,1:MPL_TASK_PER_NODE(MPL_MYNODE)) ', &
+! & MPL_NODE_TASKS(MPL_MYNODE,1:MPL_TASK_PER_NODE(MPL_MYNODE))
+
+ALLOCATE(MPL_OPPONENT(MPL_NUMPROC+1))
+CALL MPL_TOUR_TABLE(MPL_OPPONENT)
+
+RETURN
+END SUBROUTINE MPL_INIT
+
+END MODULE MPL_INIT_MOD
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_mpif.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_mpif.F90
new file mode 100644
index 0000000000000000000000000000000000000000..870bc88513b0b8bffb6bbea3f196affb10a20069
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/drhook/drhook/mpl_mpif.F90
@@ -0,0 +1,12 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE MPL_MPIF
+include "mpif.h"
+END MODULE MPL_MPIF
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_cloud_generator.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_cloud_generator.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bef81aeaa043144b51de23b0a59c01a892f61e41
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_cloud_generator.F90
@@ -0,0 +1,68 @@
+! (C) Copyright 2017- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+program test_cloud_generator
+
+ use parkind1, only : jprb
+ use radiation_cloud_generator, only : cloud_generator
+ use radiation_pdf_sampler, only : pdf_sampler_type
+ use radiation_cloud_cover, only : &
+ & IOverlapMaximumRandom, IOverlapExponentialRandom, IOverlapExponential
+
+ implicit none
+
+ integer, parameter :: ncol = 2000
+ integer, parameter :: nlev = 137
+ integer, parameter :: i_overlap_scheme = IOverlapExponential
+ real(jprb), parameter :: scale_height = 8000.0_jprb
+ real(jprb), parameter :: cloud_inhom_decorr_scaling = 0.5_jprb
+ real(jprb), parameter :: frac_threshold = 1.0e-6_jprb
+
+ real(jprb) :: cloud_fraction(nlev), overlap_param(nlev-1), fractional_std(nlev)
+! real(jprb) :: pressure_hl(nlev+1)
+
+! real(jprb) :: decorrelation_length
+
+ real(jprb) :: od_scaling(ncol,nlev)
+ real(jprb) :: total_cloud_cover
+
+ integer :: iseed
+
+ integer :: jcol, jlev
+
+ type(pdf_sampler_type) :: pdf_sampler
+
+ iseed = 1
+ cloud_fraction = 0.0_jprb
+ overlap_param = 0.9_jprb
+ fractional_std = 1.0_jprb ! Value up to 45R1
+
+ ! Insert cloud layers
+ cloud_fraction(115:125) = 0.1_jprb !0.5_jprb
+ cloud_fraction(20:100) = 0.1_jprb !0.75_jprb
+
+ call pdf_sampler%setup('data/mcica_gamma.nc', iverbose=0)
+
+ call cloud_generator(ncol, nlev, i_overlap_scheme, &
+ & iseed, frac_threshold, &
+ & cloud_fraction, overlap_param, &
+ & cloud_inhom_decorr_scaling, &
+ & fractional_std, pdf_sampler, &
+ & od_scaling, total_cloud_cover)
+
+ do jlev = 1,nlev
+ do jcol = 1,ncol
+ ! write(*,'(f5.2,a)','advance','no') od_scaling(jcol,jlev)
+ write(*,*)
+ end do
+ write(*,*)
+ end do
+
+
+end program test_cloud_generator
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_solver.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_solver.F90
new file mode 100644
index 0000000000000000000000000000000000000000..8becf0ad6389b56d0eb078a207ffd29c45923ef8
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/driver/test_solver.F90
@@ -0,0 +1,114 @@
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+program test_solver
+
+ use parkind1, only : jprb
+
+ use radiation_config, only : config_type, IGasModelMonochromatic
+ use radiation_single_level, only : single_level_type
+ use radiation_thermodynamics, only : thermodynamics_type
+ use radiation_cloud, only : cloud_type
+ use radiation_flux, only : flux_type
+ use radiation_monochromatic, only : setup_gas_optics
+ use radiation_homogeneous_sw, only : solver_homogeneous_sw
+ use radiation_cloud_optics, only : delta_eddington
+
+ implicit none
+
+ integer, parameter :: nlev = 1
+ integer, parameter :: ncol = 10
+ integer, parameter :: n_g_sw = 1
+
+ integer :: istartcol, iendcol, jcol, jlev, jod
+
+ type(config_type) :: config
+ type(single_level_type) :: single_level
+ type(thermodynamics_type) :: thermodynamics
+ type(cloud_type) :: cloud
+ type(flux_type) :: flux
+
+ real(jprb), dimension(n_g_sw,nlev,ncol) :: od_sw, ssa_sw, g_sw
+ real(jprb), dimension(n_g_sw,nlev,ncol) :: od_sw_cloud, ssa_sw_cloud, &
+ & scat_sw_cloud, g_sw_cloud
+ real(jprb), dimension(n_g_sw,ncol) :: incoming_sw
+
+ real(jprb), dimension(1,ncol) :: albedo_direct, albedo_diffuse
+
+ istartcol = 1
+ iendcol = ncol
+
+ config%i_gas_model = IGasModelMonochromatic
+ call config%consolidate()
+
+ call setup_gas_optics(config, trim(config%directory_name))
+
+ call config%define_sw_albedo_intervals(1, &
+ & [ 0.25], [1], &
+ & do_nearest=.false.)
+
+ call flux%allocate(config, istartcol, iendcol, nlev)
+ call cloud%allocate(ncol, nlev)
+ call thermodynamics%allocate(ncol, nlev)
+ call single_level%allocate(ncol, 1, 1, .false.)
+
+ cloud%fraction = 1.0
+
+ do jcol = 1,ncol
+ single_level%cos_sza(jcol) = cos((jcol-1)*acos(-1.0)/(2.0_jprb*(ncol-1)))
+ incoming_sw(1,jcol) = 1.0_jprb
+ end do
+ write(*,*) 'cos_sza = ', single_level%cos_sza
+ single_level%sw_albedo = 0.08_jprb
+
+ albedo_direct = single_level%sw_albedo
+ albedo_diffuse = single_level%sw_albedo
+
+ incoming_sw(:,:) = 100 ! to fix bugs only, not correct
+
+ do jlev = 1,nlev+1
+ thermodynamics%pressure_hl(:,jlev) = 100000.0_jprb * (jlev-1) / nlev
+ end do
+
+ od_sw = 0.0_jprb
+ ssa_sw = 1.0_jprb
+ g_sw = 0.0_jprb
+
+ do jod = 1,8
+ ssa_sw_cloud = 0.999_jprb
+ g_sw_cloud = 0.85_jprb
+! g_sw_cloud = 0.0_jprb
+
+ if (jod == 1) then
+ od_sw_cloud = 0.0_jprb
+ else
+! od_sw_cloud(1,2:,:) = 10.0**(0.5 * (jod-4)) / (nlev-1)
+ od_sw_cloud(1,:,:) = 10.0**(0.5 * (jod-4)) / nlev
+
+ scat_sw_cloud = od_sw_cloud * ssa_sw_cloud
+ call delta_eddington(od_sw_cloud, scat_sw_cloud, g_sw_cloud)
+ where (od_sw_cloud > 0.0)
+ ssa_sw_cloud = scat_sw_cloud / od_sw_cloud
+ end where
+ end if
+
+ write(*,*) 'Optical depth = ', sum(od_sw_cloud(1,:,1)), ' g=', g_sw_cloud(1,:,1)
+
+
+ ! Compute fluxes using the homogeneous solver
+ call solver_homogeneous_sw(nlev,istartcol,iendcol, &
+ & config, single_level, cloud, &
+ & od_sw, ssa_sw, g_sw, od_sw_cloud, ssa_sw_cloud, g_sw_cloud, &
+ & albedo_direct, albedo_diffuse, incoming_sw, flux)
+
+ write(0,*) flux%sw_up(:,1)
+ end do
+
+
+end program test_solver
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cloud_overlap_decorr_len.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cloud_overlap_decorr_len.F90
new file mode 100644
index 0000000000000000000000000000000000000000..225e12784f36d8486458c378f53c657e824535ee
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cloud_overlap_decorr_len.F90
@@ -0,0 +1,150 @@
+! #################################
+ MODULE MODI_CLOUD_OVERLAP_DECORR_LEN
+! #################################
+INTERFACE
+
+SUBROUTINE CLOUD_OVERLAP_DECORR_LEN &
+ & (KIDIA, KFDIA, KLON, PGEMU, NDECOLAT, &
+ & PDECORR_LEN_EDGES_KM, PDECORR_LEN_WATER_KM, PDECORR_LEN_RATIO)
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON) ! Sine of latitude
+INTEGER(KIND=JPIM),INTENT(IN) :: NDECOLAT
+REAL(KIND=JPRB), INTENT(OUT) :: PDECORR_LEN_EDGES_KM(KLON)
+REAL(KIND=JPRB), INTENT(OUT), OPTIONAL :: PDECORR_LEN_WATER_KM(KLON)
+REAL(KIND=JPRB), INTENT(OUT), OPTIONAL :: PDECORR_LEN_RATIO
+
+END SUBROUTINE CLOUD_OVERLAP_DECORR_LEN
+END INTERFACE
+END MODULE MODI_CLOUD_OVERLAP_DECORR_LEN
+
+SUBROUTINE CLOUD_OVERLAP_DECORR_LEN &
+ & (KIDIA, KFDIA, KLON, PGEMU, NDECOLAT, &
+ & PDECORR_LEN_EDGES_KM, PDECORR_LEN_WATER_KM, PDECORR_LEN_RATIO)
+
+! CLOUD_OVERLAP_DECORR_LEN
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+! Calculate the cloud overlap decorrelation length as a function of
+! latitude for use in the radiation scheme
+!
+! INTERFACE
+! ---------
+! CLOUD_OVERLAP_DECORR_LEN is called from RADLSWR and RADIATION_SCHEME
+!
+! AUTHOR
+! ------
+! Robin Hogan, ECMWF (using code extracted from radlswr.F90)
+! Original: 2016-02-16
+!
+! MODIFICATIONS
+! 2021-20-04 (Q. Libois) Adaptation to MNH
+! - embed in module with interface
+!
+! -------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMCST , ONLY : RPI
+USE MODD_PARAM_ECRAD_N , ONLY : XDECORR_CF,XDECORR_CW
+! -------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+
+! *** Configuration variable controlling the overlap scheme
+INTEGER(KIND=JPIM),INTENT(IN) :: NDECOLAT
+
+! *** Single-level variables
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON) ! Sine of latitude
+
+! OUTPUT ARGUMENTS
+
+! *** Decorrelation lengths for cloud edges and cloud water content,
+! *** in km
+REAL(KIND=JPRB), INTENT(OUT) :: PDECORR_LEN_EDGES_KM(KLON)
+REAL(KIND=JPRB), INTENT(OUT), OPTIONAL :: PDECORR_LEN_WATER_KM(KLON)
+
+! Ratio of water-content to cloud-edge decorrelation lengths
+REAL(KIND=JPRB), INTENT(OUT), OPTIONAL :: PDECORR_LEN_RATIO
+
+! LOCAL VARIABLES
+
+REAL(KIND=JPRB) :: ZRADIANS_TO_DEGREES, ZABS_LAT_DEG, ZCOS_LAT
+
+INTEGER(KIND=JPIM) :: JL
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('CLOUD_OVERLAP_DECORR_LEN',0,ZHOOK_HANDLE)
+
+! -------------------------------------------------------------------
+
+IF (NDECOLAT == 0) THEN
+
+ ! Decorrelation lengths are constant values
+ PDECORR_LEN_EDGES_KM(KIDIA:KFDIA) = XDECORR_CF
+ IF (PRESENT(PDECORR_LEN_WATER_KM)) THEN
+ PDECORR_LEN_WATER_KM(KIDIA:KFDIA) = XDECORR_CW
+ ENDIF
+ IF (PRESENT(PDECORR_LEN_RATIO)) THEN
+ PDECORR_LEN_RATIO = XDECORR_CW / XDECORR_CF
+ ENDIF
+
+ELSE
+
+ ZRADIANS_TO_DEGREES = 180.0_JPRB / RPI
+
+ IF (NDECOLAT == 1) THEN
+ ! Shonk et al. (2010) Eq. 13 formula
+ DO JL = KIDIA,KFDIA
+ ZABS_LAT_DEG = ABS(ASIN(PGEMU(JL)) * ZRADIANS_TO_DEGREES)
+ PDECORR_LEN_EDGES_KM(JL) = 2.899_JPRB - 0.02759_JPRB * ZABS_LAT_DEG
+ ENDDO
+ ELSE ! NDECOLAT == 2
+ DO JL = KIDIA,KFDIA
+ ! Shonk et al. (2010) but smoothed over the equator
+ ZCOS_LAT = COS(ASIN(PGEMU(JL)))
+ PDECORR_LEN_EDGES_KM(JL) = 0.75_JPRB + 2.149_JPRB * ZCOS_LAT*ZCOS_LAT
+ ENDDO
+ ENDIF
+
+ ! Both NDECOLAT = 1 and 2 assume that the decorrelation length for
+ ! cloud water content is half that for cloud edges
+ IF (PRESENT(PDECORR_LEN_WATER_KM)) THEN
+ PDECORR_LEN_WATER_KM(KIDIA:KFDIA) = PDECORR_LEN_EDGES_KM(KIDIA:KFDIA) * 0.5_JPRB
+ ENDIF
+
+ IF (PRESENT(PDECORR_LEN_RATIO)) THEN
+ PDECORR_LEN_RATIO = 0.5_JPRB
+ ENDIF
+
+ENDIF
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('CLOUD_OVERLAP_DECORR_LEN',1,ZHOOK_HANDLE)
+
+END SUBROUTINE CLOUD_OVERLAP_DECORR_LEN
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cos_sza.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cos_sza.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0fdf3511e8a13470bdda296d78f8400b535b7227
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/cos_sza.F90
@@ -0,0 +1,360 @@
+SUBROUTINE COS_SZA(KSTART,KEND,KCOL,PGEMU,PGELAM,LDRADIATIONTIMESTEP,PMU0)
+
+!**** *COS_SZA*
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Purpose.
+! --------
+! Compute the cosine of the solar zenith angle. Note that this
+! is needed for three different things: (1) as input to the
+! radiation scheme in which it is used to compute the path
+! length of the direct solar beam through the atmosphere, (2)
+! every timestep to scale the solar fluxes by the incoming
+! solar radiation at top-of-atmosphere, and (3) to compute the
+! albedo of the ocean. For (1) we ideally want an average
+! value for the duration of a radiation timestep while for (2)
+! we want an average value for the duration of a model
+! timestep.
+
+!** Interface.
+! ----------
+! *CALL* *COS_SZA(...)
+
+! Explicit arguments :
+! ------------------
+! PGEMU - Sine of latitude
+! PGELAM - Geographic longitude in radians
+! LDRadiationTimestep - Is this for a radiation timestep?
+! PMU0 - Output cosine of solar zenith angle
+
+! Implicit arguments :
+! --------------------
+! YRRIP%RWSOVR, RWSOVRM - Solar time for model/radiation timesteps
+! RCODECM, RSIDECM - Sine/cosine of solar declination
+! YRERAD%LAverageSZA - Average solar zenith angle in time interval?
+! YRRIP%TSTEP - Model timestep in seconds
+! YRERAD%NRADFR - Radiation frequency in timesteps
+
+! Method.
+! -------
+! Compute cosine of the solar zenith angle, mu0, from lat, lon
+! and solar time using standard formula. If
+! YRERAD%LAverageSZA=FALSE then this is done at a single time,
+! which is assumed to be the mid-point of either the model or
+! the radiation timestep. If YRERAD%LAverageSZA=TRUE then we
+! compute the average over the model timestep exactly by first
+! computing sunrise/sunset times. For radiation timesteps, mu0
+! is to be used to compute the path length of the direct solar
+! beam through the atmosphere, and the fluxes are subsequently
+! weighted by mu0. Therefore night-time values are not used,
+! so we average mu0 only when the sun is above the horizon.
+
+! Externals.
+! ----------
+
+! Reference.
+! ----------
+! ECMWF Research Department documentation of the IFS
+!
+! See also: Zhou, L., M. Zhang, Q. Bao, and Y. Liu (2015), On
+! the incident solar radiation in CMIP5
+! models. Geophys. Res. Lett., 42, 1930–1935. doi:
+! 10.1002/2015GL063239.
+
+! Author.
+! -------
+! Robin Hogan, ECMWF, May 2015
+
+! Modifications:
+! --------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMCST , ONLY : RPI, RDAY
+
+! MNH
+!USE YOMRIP , ONLY : YRRIP
+USE MODD_RADIATIONS_N , ONLY : XCOSDEL, XSINDEL, XZENITH ! no difference between yoerip and yomrip here
+!USE YOERIP , ONLY : YRERIP
+!USE YOERAD , ONLY : YRERAD
+USE MODD_PARAM_ECRAD_N , ONLY : NRADFR, LCENTREDTIMESZA, LAVERAGESZA
+USE MODD_PARAM_RAD_n, ONLY : XDTRAD
+USE MODD_RADIATIONS_n, ONLY : XSINDEL, XCOSDEL, XTSIDER
+USE MODD_TIME_n, ONLY : TDTRAD_FULL
+USE MODD_DYN_n, ONLY : XTSTEP
+! MNH
+
+USE YOMLUN , ONLY : NULOUT
+
+! ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KSTART ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KEND ! Last column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KCOL ! Number of columns in arrays
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KCOL) ! Sine of latitude
+REAL(KIND=JPRB), INTENT(IN) :: PGELAM(KCOL)! Longitude in radians
+LOGICAL, INTENT(IN) :: LDRADIATIONTIMESTEP ! Is this for a radiation timestep?
+REAL(KIND=JPRB), INTENT(OUT) :: PMU0(KCOL) ! Cosine of solar zenith angle
+
+! Solar time at the start and end of the time interval
+REAL(KIND=JPRB) :: ZSOLARTIMESTART, ZSOLARTIMEEND
+
+! The time of half a model/radiation timestep, in radians
+REAL(KIND=JPRB) :: ZHALFTIMESTEP
+
+! For efficiency we precompute sin(solar declination)*sin(latitude)
+REAL(KIND=JPRB) :: ZSINDECSINLAT(KSTART:KEND)
+!...and cos(solar declination)*cos(latitude)
+REAL(KIND=JPRB) :: ZCOSDECCOSLAT(KSTART:KEND)
+! ...and cosine of latitude
+REAL(KIND=JPRB) :: ZCOSLAT(KSTART:KEND)
+
+! MNH
+REAL(KIND=JPRB) :: ZTIME,ZUT
+REAL(KIND=JPRB) :: ZTUT,ZSOLANG
+! MNH
+
+! Tangent of solar declination
+REAL(KIND=JPRB) :: ZTANDEC
+
+! Hour angles (=local solar time in radians plus pi)
+REAL(KIND=JPRB) :: ZHOURANGLESTART, ZHOURANGLEEND
+REAL(KIND=JPRB) :: ZHOURANGLESUNSET, ZCOSHOURANGLESUNSET
+
+INTEGER(KIND=JPIM) :: JCOL ! Column index
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('COS_SZA',0,ZHOOK_HANDLE)
+
+! An average solar zenith angle can only be computed if the solar time
+! is centred on the time interval
+IF (LAVERAGESZA .AND. .NOT. LCENTREDTIMESZA) THEN
+ WRITE(NULOUT,*) 'ERROR IN COS_SZA: LAverageSZA=TRUE but LCentredTimeSZA=FALSE'
+ CALL ABOR1('COS_SZA: ABOR1 CALLED')
+ENDIF
+
+DO JCOL = KSTART,KEND
+ ZCOSLAT(JCOL) = SQRT(1.0_JPRB - PGEMU(JCOL)**2)
+ENDDO
+
+! Computation of solar hour angle from sunposn
+ZTIME = TDTRAD_FULL%XTIME + 0.5*XDTRAD
+ZUT = MOD( 24.0+MOD(ZTIME/3600.,24.0),24.0 )
+ZTUT = ZUT - XTSIDER
+ZSOLANG = (ZTUT-12.0)*15.0*(RPI/180.) ! hour angle in radians
+
+IF (LDRADIATIONTIMESTEP) THEN
+ ! Compute the effective cosine of solar zenith angle for a radiation
+ ! timestep
+
+ ! Precompute quantities that may be used more than once
+ DO JCOL = KSTART,KEND
+ ZSINDECSINLAT(JCOL) = XSINDEL * PGEMU(JCOL)
+ ZCOSDECCOSLAT(JCOL) = XCOSDEL * ZCOSLAT(JCOL)
+ ENDDO
+
+ IF (.NOT. LAVERAGESZA) THEN
+ ! Original method: compute the value at the centre of the
+ ! radiation timestep (assuming that LCentredTimeSZA=TRUE - see
+ ! updtim.F90)
+ DO JCOL = KSTART,KEND
+ ! It would be more efficient to do it like this...
+ ! PMU0(JCOL)=MAX(0.0_JPRB, ZSinDecSinLat(JCOL) &
+ ! & - ZCosDecCosLat(JCOL) * COS(YRERIP%RWSOVRM + PGELAM(JCOL)))
+ ! ...but for bit reproducibility with previous cycle we do it
+ ! like this:
+ PMU0(JCOL) = MAX(0.0_JPRB, ZSINDECSINLAT(JCOL) &
+ & - XCOSDEL*COS(ZSOLANG)*ZCOSLAT(JCOL)*COS(PGELAM(JCOL)) &
+ & + XCOSDEL*SIN(ZSOLANG)*ZCOSLAT(JCOL)*SIN(PGELAM(JCOL)))
+ ENDDO
+
+ ELSE
+ ! Compute the average MU0 for the period of the radiation
+ ! timestep, excluding times when the sun is below the horizon
+
+ ! First compute the sine and cosine of the times of the start and
+ ! end of the radiation timestep
+ ZHALFTIMESTEP = XTSTEP * REAL(NRADFR) * RPI / RDAY
+ ZSOLARTIMESTART = ZSOLANG - ZHALFTIMESTEP
+ ZSOLARTIMEEND = ZSOLANG + ZHALFTIMESTEP
+
+ ! Compute tangent of solar declination, with check in case someone
+ ! simulates a planet completely tipped over
+ ZTANDEC = XSINDEL / MAX(XCOSDEL, 1.0E-12)
+
+ DO JCOL = KSTART,KEND
+ ! Sunrise equation: cos(hour angle at sunset) =
+ ! -tan(declination)*tan(latitude)
+ ZCOSHOURANGLESUNSET = -ZTANDEC * PGEMU(JCOL) &
+ & / MAX(ZCOSLAT(JCOL), 1.0E-12)
+ IF (ZCOSHOURANGLESUNSET > 1.0) THEN
+ ! Perpetual darkness
+ PMU0(JCOL) = 0.0_JPRB
+ ELSE
+ ! Compute hour angle at start and end of time interval,
+ ! ensuring that the hour angle of the centre of the time
+ ! window is in the range -PI to +PI (equivalent to ensuring
+ ! that local solar time = solar time + longitude is in the
+ ! range 0 to 2PI)
+ IF (ZSOLANG + PGELAM(JCOL) < 2.0_JPRB*RPI) THEN
+ ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - RPI
+ ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - RPI
+ ELSE
+ ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - 3.0_JPRB*RPI
+ ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - 3.0_JPRB*RPI
+ ENDIF
+
+ IF (ZCOSHOURANGLESUNSET >= -1.0) THEN
+ ! Not perpetual daylight or perpetual darkness, so we need
+ ! to check for sunrise or sunset lying within the time
+ ! interval
+ ZHOURANGLESUNSET = ACOS(ZCOSHOURANGLESUNSET)
+ IF (ZHOURANGLEEND <= -ZHOURANGLESUNSET &
+ & .OR. ZHOURANGLESTART >= ZHOURANGLESUNSET) THEN
+ ! The time interval is either completely before sunrise or
+ ! completely after sunset
+ PMU0(JCOL) = 0.0_JPRB
+ CYCLE
+ ENDIF
+
+ ! Bound the start and end hour angles by sunrise and sunset
+ ZHOURANGLESTART = MAX(-ZHOURANGLESUNSET, &
+ & MIN(ZHOURANGLESTART, ZHOURANGLESUNSET))
+ ZHOURANGLEEND = MAX(-ZHOURANGLESUNSET, &
+ & MIN(ZHOURANGLEEND, ZHOURANGLESUNSET))
+ ENDIF
+
+ IF (ZHOURANGLEEND - ZHOURANGLESTART > 1.0E-8) THEN
+ ! Compute average MU0 in the interval ZHourAngleStart to
+ ! ZHourAngleEnd
+ PMU0(JCOL) = ZSINDECSINLAT(JCOL) &
+ & + (ZCOSDECCOSLAT(JCOL) &
+ & * (SIN(ZHOURANGLEEND) - SIN(ZHOURANGLESTART))) &
+ & / (ZHOURANGLEEND - ZHOURANGLESTART)
+
+ ! Just in case...
+ IF (PMU0(JCOL) < 0.0_JPRB) THEN
+ PMU0(JCOL) = 0.0_JPRB
+ ENDIF
+ ELSE
+ ! Too close to sunrise/sunset for a reliable calculation
+ PMU0(JCOL) = 0.0_JPRB
+ ENDIF
+
+ ENDIF
+ ENDDO
+ ENDIF
+
+ELSE
+ ! Compute the cosine of solar zenith angle for a model timestep
+
+ ! Precompute quantities that may be used more than once
+ DO JCOL = KSTART,KEND
+ ZSINDECSINLAT(JCOL) = XSINDEL * PGEMU(JCOL)
+ ZCOSDECCOSLAT(JCOL) = XCOSDEL * ZCOSLAT(JCOL)
+ ENDDO
+
+ IF (.NOT. LAVERAGESZA) THEN
+ ! Original method: compute the value at the centre of the
+ ! model timestep
+ DO JCOL = KSTART,KEND
+ ! It would be more efficient to do it like this...
+ ! PMU0(JCOL) = MAX(0.0_JPRB, ZSinDecSinLat(JCOL) &
+ ! & - ZCosDecCosLat(JCOL)*COS(YRRIP%RWSOVR + PGELAM(JCOL)))
+ ! ...but for bit reproducibility with previous cycle we do it
+ ! like this:
+ PMU0(JCOL) = MAX(0.0_JPRB, ZSINDECSINLAT(JCOL) &
+ & - XCOSDEL*COS(ZSOLANG)*ZCOSLAT(JCOL)*COS(PGELAM(JCOL)) &
+ & + XCOSDEL*SIN(ZSOLANG)*ZCOSLAT(JCOL)*SIN(PGELAM(JCOL)))
+ ENDDO
+
+ ELSE
+ ! Compute the average MU0 for the period of the model timestep
+
+ ! First compute the sine and cosine of the times of the start and
+ ! end of the model timestep
+ ZHALFTIMESTEP = XTSTEP * RPI / RDAY
+ ZSOLARTIMESTART = ZSOLANG - ZHALFTIMESTEP
+ ZSOLARTIMEEND = ZSOLANG + ZHALFTIMESTEP
+
+ ! Compute tangent of solar declination, with check in case someone
+ ! simulates a planet completely tipped over
+ ZTANDEC = XSINDEL / MAX(XCOSDEL, 1.0E-12)
+
+ DO JCOL = KSTART,KEND
+ ! Sunrise equation: cos(hour angle at sunset) =
+ ! -tan(declination)*tan(latitude)
+ ZCOSHOURANGLESUNSET = -ZTANDEC * PGEMU(JCOL) &
+ & / MAX(ZCOSLAT(JCOL), 1.0E-12)
+ IF (ZCOSHOURANGLESUNSET > 1.0) THEN
+ ! Perpetual darkness
+ PMU0(JCOL) = 0.0_JPRB
+ ELSE
+ ! Compute hour angle at start and end of time interval,
+ ! ensuring that the hour angle of the centre of the time
+ ! window is in the range -PI to +PI (equivalent to ensuring
+ ! that local solar time = solar time + longitude is in the
+ ! range 0 to 2PI)
+ IF (ZSOLANG + PGELAM(JCOL) < 2.0_JPRB*RPI) THEN
+ ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - RPI
+ ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - RPI
+ ELSE
+ ZHOURANGLESTART = ZSOLARTIMESTART + PGELAM(JCOL) - 3.0_JPRB*RPI
+ ZHOURANGLEEND = ZSOLARTIMEEND + PGELAM(JCOL) - 3.0_JPRB*RPI
+ ENDIF
+
+ IF (ZCOSHOURANGLESUNSET >= -1.0) THEN
+ ! Not perpetual daylight or perpetual darkness, so we need
+ ! to check for sunrise or sunset lying within the time
+ ! interval
+ ZHOURANGLESUNSET = ACOS(ZCOSHOURANGLESUNSET)
+ IF (ZHOURANGLEEND <= -ZHOURANGLESUNSET &
+ & .OR. ZHOURANGLESTART >= ZHOURANGLESUNSET) THEN
+ ! The time interval is either completely before sunrise or
+ ! completely after sunset
+ PMU0(JCOL) = 0.0_JPRB
+ CYCLE
+ ENDIF
+
+ ! Bound the start and end hour angles by sunrise and sunset
+ ZHOURANGLESTART = MAX(-ZHOURANGLESUNSET, &
+ & MIN(ZHOURANGLESTART, ZHOURANGLESUNSET))
+ ZHOURANGLEEND = MAX(-ZHOURANGLESUNSET, &
+ & MIN(ZHOURANGLEEND, ZHOURANGLESUNSET))
+ ENDIF
+
+ ! Compute average MU0 in the model timestep, although the
+ ! numerator considers only the time from ZHourAngleStart to
+ ! ZHourAngleEnd that the sun is above the horizon
+ PMU0(JCOL) = (ZSINDECSINLAT(JCOL) * (ZHOURANGLEEND-ZHOURANGLESTART) &
+ & + ZCOSDECCOSLAT(JCOL)*(SIN(ZHOURANGLEEND)-SIN(ZHOURANGLESTART))) &
+ & / (2.0_JPRB * ZHALFTIMESTEP)
+
+ ! This shouldn't ever result in negative values, but just in
+ ! case
+ IF (PMU0(JCOL) < 0.0_JPRB) THEN
+ PMU0(JCOL) = 0.0_JPRB
+ ENDIF
+
+ ENDIF
+ ENDDO
+ ENDIF
+
+ENDIF
+
+
+! ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('COS_SZA',1,ZHOOK_HANDLE)
+END SUBROUTINE COS_SZA
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/easy_netcdf_read_mpi.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/easy_netcdf_read_mpi.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d74399ba275d7765b8c4e0f46335f0e3eae8b52b
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/easy_netcdf_read_mpi.F90
@@ -0,0 +1,330 @@
+! easy_netcdf_read_mpi.f90 - Read netcdf file on one task and share with other tasks
+!
+! (C) Copyright 2017- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author: Robin Hogan
+! Email: r.j.hogan@ecmwf.int
+!
+
+module easy_netcdf_read_mpi
+
+ use easy_netcdf, only : netcdf_file_raw => netcdf_file
+ use parkind1, only : jpim, jprb
+ use radiation_io, only : nulout, nulerr, my_abort => radiation_abort
+
+ implicit none
+
+ ! MPI tag for radiation and physics communication
+ integer(kind=jpim), parameter :: mtagrad = 2800
+
+ !---------------------------------------------------------------------
+ ! An object of this type provides convenient read or write access to
+ ! a NetCDF file
+ type netcdf_file
+ type(netcdf_file_raw) :: file
+ logical :: is_master_task = .true.
+ contains
+ procedure :: open => open_netcdf_file
+ procedure :: close => close_netcdf_file
+ procedure :: get_real_scalar
+ procedure :: get_real_vector
+ procedure :: get_real_matrix
+ procedure :: get_real_array3
+ generic :: get => get_real_scalar, get_real_vector, &
+ & get_real_matrix, get_real_array3
+ procedure :: get_global_attribute
+
+ procedure :: set_verbose
+ procedure :: transpose_matrices
+ procedure :: exists
+ end type netcdf_file
+
+contains
+
+ ! --- GENERIC SUBROUTINES ---
+
+ !---------------------------------------------------------------------
+ ! Open a NetCDF file with name "file_name", optionally specifying the
+ ! verbosity level (0-5)
+ subroutine open_netcdf_file(this, file_name, iverbose)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_MYRANK
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_MYRANK_MOD , ONLY : MPL_MYRANK
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: file_name
+ integer, intent(in), optional :: iverbose
+
+ integer :: istatus
+
+ ! Store verbosity level in object
+ if (present(iverbose)) then
+ this%file%iverbose = iverbose
+ else
+ ! By default announce files being opened and closed, but not
+ ! variables read/written
+ this%file%iverbose = 2
+ end if
+
+ ! By default we don't transpose 2D arrays on read
+ this%file%do_transpose_2d = .false.
+
+ if (MPL_MYRANK() == 1) then
+ this%is_master_task = .true.
+ call this%file%open(file_name, iverbose)
+ else
+ this%is_master_task = .false.
+ end if
+
+ end subroutine open_netcdf_file
+
+
+ !---------------------------------------------------------------------
+ ! Close the NetCDF file
+ subroutine close_netcdf_file(this)
+ class(netcdf_file) :: this
+ integer :: istatus
+
+ if (this%is_master_task) then
+ call this%file%close()
+ end if
+
+ end subroutine close_netcdf_file
+
+
+ !---------------------------------------------------------------------
+ ! Set the verbosity level from 0 to 5, where the codes have the
+ ! following meaning: 0=errors only, 1=warning, 2=info, 3=progress,
+ ! 4=detailed, 5=debug
+ subroutine set_verbose(this, ival)
+ class(netcdf_file) :: this
+ integer, optional :: ival
+
+ if (present(ival)) then
+ this%file%iverbose = ival
+ else
+ this%file%iverbose = 2
+ end if
+
+ end subroutine set_verbose
+
+
+
+ !---------------------------------------------------------------------
+ ! Specify whether 2D arrays should be transposed on read
+ subroutine transpose_matrices(this, do_transpose)
+ class(netcdf_file) :: this
+ logical, optional :: do_transpose
+
+ if (present(do_transpose)) then
+ this%file%do_transpose_2d = do_transpose
+ else
+ this%file%do_transpose_2d = .true.
+ end if
+
+ end subroutine transpose_matrices
+
+
+
+ ! --- READING SUBROUTINES ---
+
+ !---------------------------------------------------------------------
+ ! Return true if the variable is present, false otherwise
+ function exists(this, var_name) result(is_present)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: var_name
+
+ logical :: is_present
+
+ if (this%is_master_task) then
+ is_present = this%file%exists(var_name)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(is_present, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:EXISTS')
+ end if
+
+ end function exists
+
+
+ !---------------------------------------------------------------------
+ ! The method "get" will read either a scalar, vector or matrix
+ ! depending on the rank of the output argument. This version reads a
+ ! scalar.
+ subroutine get_real_scalar(this, var_name, scalar)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: var_name
+ real(jprb), intent(out) :: scalar
+
+ if (this%is_master_task) then
+ call this%file%get(var_name, scalar)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(scalar, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_SCALAR')
+ end if
+
+ end subroutine get_real_scalar
+
+
+ !---------------------------------------------------------------------
+ ! Read a 1D array into "vector", which must be allocatable and will
+ ! be reallocated if necessary
+ subroutine get_real_vector(this, var_name, vector)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: var_name
+ real(jprb), allocatable, intent(out) :: vector(:)
+
+ integer :: n ! Length of vector
+
+ n = 0
+
+ if (this%is_master_task) then
+ call this%file%get(var_name, vector)
+ n = size(vector)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(n, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_VECTOR:SIZE')
+
+ if (.not. this%is_master_task) then
+ allocate(vector(n))
+ end if
+
+ CALL MPL_BROADCAST(vector, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_VECTOR')
+ end if
+
+ end subroutine get_real_vector
+
+
+ !---------------------------------------------------------------------
+ ! Read 2D array into "matrix", which must be allocatable and will be
+ ! reallocated if necessary. Whether to transpose is specifed by the
+ ! final optional argument, but can also be specified by the
+ ! do_transpose_2d class data member.
+ subroutine get_real_matrix(this, var_name, matrix, do_transp)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: var_name
+ real(jprb), allocatable, intent(out) :: matrix(:,:)
+ logical, optional, intent(in):: do_transp ! Transpose data?
+
+ integer :: n(2)
+
+ n = 0
+
+ if (this%is_master_task) then
+ call this%file%get(var_name, matrix, do_transp)
+ n = shape(matrix)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(n, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_MATRIX:SIZE')
+
+ if (.not. this%is_master_task) then
+ allocate(matrix(n(1),n(2)))
+ end if
+
+ CALL MPL_BROADCAST(matrix, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_MATRIX')
+ end if
+
+ end subroutine get_real_matrix
+
+
+ !---------------------------------------------------------------------
+ ! Read 3D array into "var", which must be allocatable and will be
+ ! reallocated if necessary. Whether to pemute is specifed by the
+ ! final optional argument
+ subroutine get_real_array3(this, var_name, var, ipermute)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+ character(len=*), intent(in) :: var_name
+ real(jprb), allocatable, intent(out) :: var(:,:,:)
+ integer, optional, intent(in) :: ipermute(3)
+
+ integer :: n(3)
+
+ n = 0
+
+ if (this%is_master_task) then
+ call this%file%get(var_name, var, ipermute)
+ n = shape(var)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(n, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_ARRAY3:SIZE')
+
+ if (.not. this%is_master_task) then
+ allocate(var(n(1),n(2),n(3)))
+ end if
+
+ CALL MPL_BROADCAST(var, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_REAL_ARRAY3')
+ end if
+
+ end subroutine get_real_array3
+
+
+ !---------------------------------------------------------------------
+ ! Get a global attribute as a character string
+ subroutine get_global_attribute(this, attr_name, attr_str)
+
+ !USE MPL_MODULE, ONLY : MPL_BROADCAST, MPL_NPROC
+ USE MPL_BROADCAST_MOD , ONLY : MPL_BROADCAST
+ USE MPL_NPROC_MOD , ONLY : MPL_NPROC
+
+ class(netcdf_file) :: this
+
+ character(len=*), intent(in) :: attr_name
+ character(len=*), intent(inout) :: attr_str
+
+ if (this%is_master_task) then
+ call this%file%get_global_attribute(attr_name, attr_str)
+ end if
+
+ if (MPL_NPROC() > 1) then
+ CALL MPL_BROADCAST(attr_str, mtagrad, 1, &
+ & CDSTRING='EASY_NETCDF_READ_MPI:GET_GLOBAL_ATTRIBUTE')
+ end if
+
+ end subroutine get_global_attribute
+
+end module easy_netcdf_read_mpi
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/ice_effective_radius.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/ice_effective_radius.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bf49064711ac14753db719592bfd774e9a13b063
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/ice_effective_radius.F90
@@ -0,0 +1,213 @@
+! #################################
+ MODULE MODI_ICE_EFFECTIVE_RADIUS
+! #################################
+INTERFACE
+
+SUBROUTINE ICE_EFFECTIVE_RADIUS &
+ & (KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PGEMU, &
+ & PRE_UM)
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV ! Number of levels
+
+! *** Variables on model levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE(KLON,KLEV) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
+REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_ICE(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_SNOW(KLON,KLEV) ! (kg/kg)
+
+! *** Single level variable
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON) ! Sine of latitude
+
+! OUTPUT ARGUMENT
+! Effective radius
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_UM(KLON,KLEV) ! (microns)
+
+END SUBROUTINE ICE_EFFECTIVE_RADIUS
+END INTERFACE
+END MODULE MODI_ICE_EFFECTIVE_RADIUS
+
+SUBROUTINE ICE_EFFECTIVE_RADIUS &
+ & (KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PGEMU, &
+ & PRE_UM)
+
+! ICE_EFFECTIVE_RADIUS
+!
+! (C) Copyright 2016- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+! Calculate effective radius of ice clouds
+!
+! AUTHOR
+! ------
+! Robin Hogan, ECMWF (using code extracted from radlswr.F90)
+! Original: 2016-02-24
+!
+! MODIFICATIONS
+! 2021-04-20 (Q. Libois) Compatibility with MNH
+! - embed in module with interface
+!
+!
+! -------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+!USE YOERAD , ONLY : YRERAD
+USE YOM_YGFL , ONLY : YGFL
+!USE YOECLDP , ONLY : YRECLDP
+USE YOERDU , ONLY : REPLOG, REPSCW
+USE YOMLUN , ONLY : NULERR
+USE YOMCST , ONLY : RD, RPI, RTT
+USE MODD_PARAM_ECRAD_n , ONLY : NRADIP, NMINICE, XRE2DE, XRMINICE ! ice optical properties model
+
+! -------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV ! Number of levels
+
+! *** Variables on model levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE(KLON,KLEV) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
+REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_ICE(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_SNOW(KLON,KLEV) ! (kg/kg)
+
+! *** Single level variable
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON) ! Sine of latitude
+
+! OUTPUT ARGUMENT
+! Effective radius
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_UM(KLON,KLEV) ! (microns)
+
+! LOCAL VARIABLES
+
+REAL(KIND=JPRB) :: ZIWC_INCLOUD_GM3 ! In-cloud ice+snow water content in g m-3
+REAL(KIND=JPRB) :: ZAIR_DENSITY_GM3 ! Air density in g m-3
+
+REAL(KIND=JPRB) :: ZTEMPERATURE_C ! Temperature, degrees Celcius
+REAL(KIND=JPRB) :: ZTEMP_FACTOR ! Temperature, Kelvin minus 83.15
+REAL(KIND=JPRB) :: ZAIWC, ZBIWC ! Factors in empirical relationship
+REAL(KIND=JPRB) :: ZDEFAULT_RE_UM ! Default effective radius in microns
+REAL(KIND=JPRB) :: ZDIAMETER_UM ! Effective diameter in microns
+
+! Min effective diameter in microns; may vary with latitude
+REAL(KIND=JPRB) :: ZMIN_DIAMETER_UM(KLON)
+
+INTEGER :: JL, JK
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! -------------------------------------------------------------------
+
+#include "abor1.intfb.h"
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('ICE_EFFECTIVE_RADIUS',0,ZHOOK_HANDLE)
+
+! -------------------------------------------------------------------
+
+SELECT CASE(NRADIP)
+CASE(0)
+ ! Ice effective radius fixed at 40 microns
+ PRE_UM(KIDIA:KFDIA,:) = 40.0_JPRB
+
+CASE(1,2)
+ ! Ice effective radius from Liou and Ou (1994)
+ DO JK = 1,KLEV
+ DO JL = KIDIA,KFDIA
+ ! Convert Kelvin to Celcius, preventing positive numbers
+ ZTEMPERATURE_C = MIN(PTEMPERATURE(JL,JK) - RTT, -0.1)
+ ! Liou and Ou's empirical formula
+ PRE_UM(JL,JK) = 326.3_JPRB + ZTEMPERATURE_C * (12.42_JPRB &
+ & + ZTEMPERATURE_C * (0.197_JPRB + ZTEMPERATURE_C * 0.0012_JPRB))
+ IF (NRADIP == 1) THEN
+ ! Original Liou and Ou (1994) bounds of 40-130 microns
+ PRE_UM(JL,JK) = MAX(PRE_UM(JL,JK), 40.0_JPRB)
+ PRE_UM(JL,JK) = MIN(PRE_UM(JL,JK),130.0_JPRB)
+ ELSE
+ ! Formulation following Jakob, Klein modifications to ice
+ ! content
+ PRE_UM(JL,JK) = MAX(PRE_UM(JL,JK), 30.0_JPRB)
+ PRE_UM(JL,JK) = MIN(PRE_UM(JL,JK), 60.0_JPRB)
+ ENDIF
+ ENDDO
+ ENDDO
+
+CASE(3)
+ ! Ice effective radius = f(T,IWC) from Sun and Rikus (1999), revised
+ ! by Sun (2001)
+
+ ! Default effective radius is computed from an effective diameter of
+ ! 80 microns; note that multiplying by re2de actually converts from
+ ! effective diameter to effective radius.
+ ZDEFAULT_RE_UM = 80.0_JPRB * XRE2DE
+
+ ! Minimum effective diameter may vary with latitude
+ IF (NMINICE == 0) THEN
+ ! Constant effective diameter
+ ZMIN_DIAMETER_UM(KIDIA:KFDIA) = XRMINICE
+ ELSE
+ ! Ice effective radius varies with latitude, smaller at poles
+ DO JL = KIDIA,KFDIA
+ ZMIN_DIAMETER_UM(JL) = 20.0_JPRB + (XRMINICE - 20.0_JPRB) &
+ & * COS(ASIN(PGEMU(JL)))
+ ENDDO
+ ENDIF
+
+ DO JK = 1,KLEV
+ DO JL = KIDIA,KFDIA
+ IF (PCLOUD_FRAC(JL,JK) > 0.001_JPRB &
+ & .AND. (PQ_ICE(JL,JK)+PQ_SNOW(JL,JK)) > 0.0_JPRB) THEN
+ ZAIR_DENSITY_GM3 = 1000.0_JPRB * PPRESSURE(JL,JK) / (RD*PTEMPERATURE(JL,JK))
+ ZIWC_INCLOUD_GM3 = ZAIR_DENSITY_GM3 * (PQ_ICE(JL,JK) + PQ_SNOW(JL,JK)) &
+ & / PCLOUD_FRAC(JL,JK)
+ ZTEMPERATURE_C = PTEMPERATURE(JL,JK) - RTT
+ ! Sun, 2001 (corrected from Sun & Rikus, 1999)
+ ZAIWC = 45.8966_JPRB * ZIWC_INCLOUD_GM3**0.2214_JPRB
+ ZBIWC = 0.7957_JPRB * ZIWC_INCLOUD_GM3**0.2535_JPRB
+ ZDIAMETER_UM = (1.2351_JPRB + 0.0105_JPRB * ZTEMPERATURE_C) &
+ & * (ZAIWC + ZBIWC*(PTEMPERATURE(JL,JK) - 83.15_JPRB))
+ ZDIAMETER_UM = MIN ( MAX( ZDIAMETER_UM, ZMIN_DIAMETER_UM(JL)), 155.0_JPRB)
+ PRE_UM(JL,JK) = ZDIAMETER_UM * XRE2DE
+ ELSE
+ PRE_UM(JL,JK) = ZDEFAULT_RE_UM
+ ENDIF
+ ENDDO
+ ENDDO
+
+CASE DEFAULT
+ WRITE(NULERR,'(A,I0,A)') 'ICE EFFECTIVE RADIUS OPTION NRADLP=',NRADIP,' NOT AVAILABLE'
+ CALL ABOR1('ERROR IN ICE_EFFECTIVE_RADIUS')
+
+END SELECT
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('ICE_EFFECTIVE_RADIUS',1,ZHOOK_HANDLE)
+
+END SUBROUTINE ICE_EFFECTIVE_RADIUS
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/liquid_effective_radius.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/liquid_effective_radius.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0478665d5bf3087112cb96987c4fead9674004b6
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/liquid_effective_radius.F90
@@ -0,0 +1,261 @@
+MODULE MODI_LIQUID_EFFECTIVE_RADIUS
+
+INTERFACE
+
+SUBROUTINE LIQUID_EFFECTIVE_RADIUS &
+ & (KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_LIQ, PQ_RAIN, &
+ & PLAND_FRAC, PCCN_LAND, PCCN_SEA, &
+ & PRE_UM)
+
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+
+
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV ! Number of levels
+
+! *** Variables on model levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE(KLON,KLEV) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
+REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_LIQ(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_RAIN(KLON,KLEV) ! (kg/kg)
+
+! *** Single-level variables
+REAL(KIND=JPRB), INTENT(IN) :: PLAND_FRAC(KLON) ! 1=land, 0=sea
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_LAND(KLON)
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_SEA(KLON)
+
+! OUTPUT ARGUMENT
+
+! Effective radius
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_UM(KLON,KLEV) ! (microns)
+
+END SUBROUTINE LIQUID_EFFECTIVE_RADIUS
+END INTERFACE
+END MODULE MODI_LIQUID_EFFECTIVE_RADIUS
+
+SUBROUTINE LIQUID_EFFECTIVE_RADIUS &
+ & (KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_LIQ, PQ_RAIN, &
+ & PLAND_FRAC, PCCN_LAND, PCCN_SEA, &
+ & PRE_UM)
+
+! LIQUID_EFFECTIVE_RADIUS
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+! Calculate effective radius of liquid clouds
+!
+! AUTHOR
+! ------
+! Robin Hogan, ECMWF (using code extracted from radlswr.F90)
+! Original: 2015-09-24
+!
+! MODIFICATIONS
+! 2021-04-20 (Q. Libois) Compatibility with MNH
+! - embed in module with interface
+!
+!
+! -------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+! USE YOERAD , ONLY : YRERAD
+USE MODD_PARAM_ECRAD_n , ONLY : NRADLP, NAERMACC, NMCVAR, XCCNSEA, XCCNLND, NAERCLD, &
+ & NACTAERO, LCCNO, LCCNL, XCCNLND, XCCNSEA
+USE YOM_YGFL , ONLY : YGFL
+!USE YOECLDP , ONLY : YRECLDP
+USE YOERDU , ONLY : REPLOG, REPSCW
+USE YOMLUN , ONLY : NULERR
+USE YOMCST , ONLY : RD, RPI
+
+! -------------------------------------------------------------------
+
+IMPLICIT NONE
+
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV ! Number of levels
+
+! *** Variables on model levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE(KLON,KLEV) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
+REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_LIQ(KLON,KLEV) ! (kg/kg)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_RAIN(KLON,KLEV) ! (kg/kg)
+
+! *** Single-level variables
+REAL(KIND=JPRB), INTENT(IN) :: PLAND_FRAC(KLON) ! 1=land, 0=sea
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_LAND(KLON)
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_SEA(KLON)
+
+! OUTPUT ARGUMENT
+
+! Effective radius
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_UM(KLON,KLEV) ! (microns)
+
+! PARAMETERS
+
+! Minimum and maximum effective radius, in microns
+REAL(KIND=JPRB), PARAMETER :: PP_MIN_RE_UM = 4.0_JPRB
+REAL(KIND=JPRB), PARAMETER :: PP_MAX_RE_UM = 30.0_JPRB
+
+! LOCAL VARIABLES
+INTEGER :: IRADLP ! ID of effective radius scheme to use
+INTEGER :: NACTIVE_AEROSOL ! Number of active aerosol
+REAL(KIND=JPRB) :: ZCCN ! CCN concentration (units?)
+
+REAL(KIND=JPRB) :: ZSPECTRAL_DISPERSION
+REAL(KIND=JPRB) :: ZNTOT_CM3 ! Number conc in cm-3
+REAL(KIND=JPRB) :: ZRE_CUBED
+REAL(KIND=JPRB) :: ZLWC_GM3, ZRWC_GM3 ! In-cloud liquid, rain content in g m-3
+REAL(KIND=JPRB) :: ZAIR_DENSITY_GM3 ! Air density in g m-3
+REAL(KIND=JPRB) :: ZRAIN_RATIO ! Ratio of rain to liquid water content
+REAL(KIND=JPRB) :: ZWOOD_FACTOR, ZRATIO
+
+INTEGER :: JL, JK
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! -------------------------------------------------------------------
+
+#include "abor1.intfb.h"
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('LIQUID_EFFECTIVE_RADIUS',0,ZHOOK_HANDLE)
+
+! -------------------------------------------------------------------
+
+! Reproduce logic from RADLSWR
+NACTIVE_AEROSOL = NACTAERO
+IF (NACTAERO == 0 .AND. NAERMACC == 1) NACTIVE_AEROSOL = NMCVAR
+IRADLP = NRADLP
+IF (NACTIVE_AEROSOL >= 12 .AND. NAERCLD > 0 ) IRADLP=3
+
+SELECT CASE(IRADLP)
+CASE(0)
+ ! Very old parameterization as a function of pressure, used in ERA-15
+ PRE_UM(KIDIA:KFDIA,:) = 10.0_JPRB &
+ & + (100000.0_JPRB-PPRESSURE(KIDIA:KFDIA,:))*3.5_JPRB
+
+CASE(1)
+ ! Simple distinction between land (10um) and ocean (13um) by Zhang
+ ! and Rossow
+ DO JL = KIDIA,KFDIA
+ IF (PLAND_FRAC(JL) < 0.5_JPRB) THEN
+ PRE_UM(JL,:) = 13.0_JPRB
+ ELSE
+ PRE_UM(JL,:) = 10.0_JPRB
+ ENDIF
+ ENDDO
+
+CASE(2)
+ ! Martin et al. (JAS 1994)
+ DO JL = KIDIA,KFDIA
+ ! First compute the cloud droplet concentration
+ IF (PLAND_FRAC(JL) < 0.5_JPRB) THEN
+ ! Sea case
+ IF (LCCNO) THEN
+ ZCCN = PCCN_SEA(JL)
+ ELSE
+ ZCCN = XCCNSEA
+ ENDIF
+ ZSPECTRAL_DISPERSION = 0.77_JPRB
+ ! Cloud droplet concentration in cm-3 (activated CCN) over
+ ! ocean
+ ZNTOT_CM3 = -1.15E-03_JPRB*ZCCN*ZCCN + 0.963_JPRB*ZCCN + 5.30_JPRB
+ ELSE
+ ! Land case
+ IF (LCCNL) THEN
+ ZCCN=PCCN_LAND(JL)
+ ELSE
+ ZCCN = XCCNLND
+ ENDIF
+ ZSPECTRAL_DISPERSION = 0.69_JPRB
+ ! Cloud droplet concentration in cm-3 (activated CCN) over
+ ! land
+ ZNTOT_CM3 = -2.10E-04_JPRB*ZCCN*ZCCN + 0.568_JPRB*ZCCN - 27.9_JPRB
+ ENDIF
+
+ ZRATIO = (0.222_JPRB/ZSPECTRAL_DISPERSION)**0.333_JPRB
+
+ DO JK = 1,KLEV
+
+ ! Only consider cloudy regions
+ IF (PCLOUD_FRAC(JL,JK) >= 0.001_JPRB &
+ & .AND. (PQ_LIQ(JL,JK)+PQ_RAIN(JL,JK)) > 0.0_JPRB) THEN
+
+ ! Compute liquid and rain water contents
+ ZAIR_DENSITY_GM3 = 1000.0_JPRB * PPRESSURE(JL,JK) &
+ & / (RD*PTEMPERATURE(JL,JK))
+ ! In-cloud mean water contents found by dividing by cloud
+ ! fraction
+ ZLWC_GM3 = ZAIR_DENSITY_GM3 * PQ_LIQ(JL,JK) / PCLOUD_FRAC(JL,JK)
+ ZRWC_GM3 = ZAIR_DENSITY_GM3 * PQ_RAIN(JL,JK) / PCLOUD_FRAC(JL,JK)
+
+ ! Wood's (2000, eq. 19) adjustment to Martin et al's
+ ! parameterization
+ IF (ZLWC_GM3 > REPSCW) THEN
+ ZRAIN_RATIO = ZRWC_GM3 / ZLWC_GM3
+ ZWOOD_FACTOR = ((1.0_JPRB + ZRAIN_RATIO)**0.666_JPRB) &
+ & / (1.0_JPRB + 0.2_JPRB * ZRATIO*ZRAIN_RATIO)
+ ELSE
+ ZWOOD_FACTOR = 1.0_JPRB
+ ENDIF
+
+ ! g m-3 and cm-3 units cancel out with density of water
+ ! 10^6/(1000*1000); need a factor of 10^6 to convert to
+ ! microns and cubed root is factor of 100 which appears in
+ ! equation below
+ ZRE_CUBED = (3.0_JPRB * (ZLWC_GM3 + ZRWC_GM3)) &
+ & / (4.0_JPRB*RPI*ZNTOT_CM3*ZSPECTRAL_DISPERSION)
+ IF (ZRE_CUBED > REPLOG) THEN
+ PRE_UM(JL,JK) = ZWOOD_FACTOR*100.0_JPRB*EXP(0.333_JPRB*LOG(ZRE_CUBED))
+ ! Make sure effective radius is bounded in range 4-30 microns
+ PRE_UM(JL,JK) = MAX(PP_MIN_RE_UM, MIN(PRE_UM(JL,JK), PP_MAX_RE_UM))
+ ELSE
+ PRE_UM(JL,JK) = PP_MIN_RE_UM
+ ENDIF
+
+ ELSE
+ ! Cloud fraction or liquid+rain water content too low to
+ ! consider this a cloud
+ PRE_UM(JL,JK) = PP_MIN_RE_UM
+
+ ENDIF
+
+ ENDDO
+
+ ENDDO
+
+CASE DEFAULT
+ WRITE(NULERR,'(A,I0,A)') 'LIQUID EFFECTIVE RADIUS OPTION IRADLP=',IRADLP,' NOT AVAILABLE'
+ CALL ABOR1('ERROR IN LIQUID_EFFECTIVE_RADIUS')
+END SELECT
+
+! -------------------------------------------------------------------
+
+IF (LHOOK) CALL DR_HOOK('LIQUID_EFFECTIVE_RADIUS',1,ZHOOK_HANDLE)
+
+END SUBROUTINE LIQUID_EFFECTIVE_RADIUS
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_scheme.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_scheme.F90
new file mode 100644
index 0000000000000000000000000000000000000000..06cd9e27126ab46ca69f02066a47b3e6115af03b
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_scheme.F90
@@ -0,0 +1,663 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ecmwf_radiation_vers2.f90,v $ $Revision: 1.3.2.4.2.2.2.1 $
+! masdev4_7 BUG1 2007/06/15 17:47:17
+!-----------------------------------------------------------------
+! #################################
+ MODULE MODI_RADIATION_SCHEME
+! #################################
+
+CONTAINS
+
+SUBROUTINE RADIATION_SCHEME &
+ & (KIDIA, KFDIA, KLON, KLEV, KAEROSOL, &
+ & PSOLAR_IRRADIANCE, &
+ & PMU0, PTEMPERATURE_SKIN, PALBEDO_DIF, PALBEDO_DIR, &
+ & PEMIS, PEMIS_WINDOW, &
+ & PCCN_LAND, PCCN_SEA, &
+ & PGELAM, PGEMU, PLAND_SEA_MASK, &
+ & PPRESSURE, PTEMPERATURE, &
+ & PPRESSURE_H, PTEMPERATURE_H, &
+ & PQ, PCO2, PCH4, PN2O, PNO2, PCFC11, PCFC12, PHCFC22, PCCL4, PO3_DP, &
+ & PCLOUD_FRAC, PQ_LIQUID, PQ_ICE, PQ_RAIN, PQ_SNOW, &
+ & PAEROSOL_OLD, PAEROSOL, &
+ & PFLUX_SW, PFLUX_LW, PFLUX_SW_CLEAR, PFLUX_LW_CLEAR, &
+ & PFLUX_SW_SURF, PFLUX_LW_SURF, PFLUX_SW_SURF_CLEAR, PFLUX_LW_SURF_CLEAR, &
+ & PFLUX_DIR_SURF, PFLUX_DIR_SURF_CLEAR, PFLUX_DIR_SURF_INTO_SUN, &
+ & PFLUX_UV, PFLUX_PAR, PFLUX_PAR_CLEAR, &
+ & PFLUX_SW_DN_TOA,PFLUX_SW_UP_TOA,PFLUX_LW_UP_TOA, &
+ & PFLUX_SW_UP_TOA_CLEAR,PFLUX_LW_UP_TOA_CLEAR, &
+ & PFLUX_SW_DN, PFLUX_LW_DN, PFLUX_SW_UP, PFLUX_LW_UP, &
+ & PFLUX_SW_DN_CLEAR, PFLUX_LW_DN_CLEAR, PFLUX_SW_UP_CLEAR, PFLUX_LW_UP_CLEAR, &
+ & PRE_LIQUID_UM, PRE_ICE_UM, &
+ & PEMIS_OUT, PLWDERIVATIVE, &
+ & PSWDIFFUSEBAND, PSWDIRECTBAND)
+
+! RADIATION_SCHEME - Interface to modular radiation scheme
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+! The modular radiation scheme is contained in a separate
+! library. This routine puts the the IFS arrays into appropriate
+! objects, computing the additional data that is required, and sends
+! it to the radiation scheme. It returns net fluxes and surface
+! flux components needed by the rest of the model.
+!
+! Lower case is used for variables and types taken from the
+! radiation library
+!
+! INTERFACE
+! ---------
+! RADIATION_SCHEME is called from RADLSWR. The
+! SETUP_RADIATION_SCHEME routine (in the RADIATION_SETUP module)
+! should have been run first.
+!
+! AUTHOR
+! ------
+! Robin Hogan, ECMWF
+! Original: 2015-09-16
+! Modifications by
+!
+! MODIFICATIONS
+! 2021-04-20 (Quentin Libois) Compatibility with Meso-NH
+! - adding extra output variables in RADIATION_SCHEME
+! - adding module container
+! - removing include *.h
+! - loading parameters from appropriate modules
+! - removing unexisting modules
+! - adding spectral dimension for SW fluxes
+! - using MNH saturation vapor pressure function
+!
+! TO DO
+! -----
+!
+!-----------------------------------------------------------------------
+
+! Modules from ifs or ifsaux libraries
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
+! MNH
+! USE YOERAD , ONLY : YRERAD YRERAD ! does not exist in MNH
+USE MODD_PARAM_ECRAD_n, ONLY : NAERMACC, NDECOLAT, XCLOUD_FRAC_STD, & ! get parameters from module
+ & LAPPROXLWUPDATE, LAPPROXSWUPDATE, &
+ & LSPEC_ALB, LSPEC_EMISS, LRRTM, &
+ & USER_ALB_DIFF, USER_ALB_DIR, USER_EMISS, &
+ & SURF_TYPE
+
+USE MODI_READ_ALBEDO_DATA , ONLY : READ_ALBEDO_DATA
+USE MODI_READ_EMISS_DATA , ONLY : READ_EMISS_DATA
+USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH, NSWB_OLD
+USE MODE_THERMO ! , ONLY QSATW_2D
+USE MODD_DYN_n , ONLY : XTSTEP, NSTOP
+USE MODD_TIME , ONLY : TDTEXP
+USE MODD_TIME_n , ONLY : TDTMOD,TDTCUR
+USE MODI_ICE_EFFECTIVE_RADIUS
+USE MODI_LIQUID_EFFECTIVE_RADIUS
+USE MODI_CLOUD_OVERLAP_DECORR_LEN
+USE MODD_LUNIT_n , ONLY : TLUOUT
+! MNH
+
+USE RADIATION_SETUP, ONLY : rad_config, &
+ & NWEIGHT_UV, IBAND_UV, WEIGHT_UV, &
+ & NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
+ & ITYPE_TROP_BG_AER, TROP_BG_AER_MASS_EXT, &
+ & ITYPE_STRAT_BG_AER, STRAT_BG_AER_MASS_EXT
+
+!USE YOMRIP0 , ONLY : NINDAT ! does not exist in MNH
+!USE YOMCT3 , ONLY : NSTEP ! does not exist in MNH
+!USE YOMRIP , ONLY : YRRIP ! does not exist in MNH
+
+USE YOMCST , ONLY : RSIGMA ! Stefan-Boltzmann constant
+
+! Modules from radiation library
+USE radiation_single_level, ONLY : single_level_type
+USE radiation_thermodynamics, ONLY : thermodynamics_type
+USE radiation_gas
+USE radiation_cloud, ONLY : cloud_type
+USE radiation_aerosol, ONLY : aerosol_type
+USE radiation_flux, ONLY : flux_type
+USE radiation_interface, ONLY : radiation, set_gas_units
+USE radiation_save, ONLY : save_inputs
+
+IMPLICIT NONE
+
+! INPUT ARGUMENTS
+
+! *** Array dimensions and ranges
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! Start column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! End column to process
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON ! Number of columns
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV ! Number of levels
+INTEGER(KIND=JPIM),INTENT(IN) :: KAEROSOL ! Number of aerosol types
+
+! *** Single-level fields
+REAL(KIND=JPRB), INTENT(IN) :: PSOLAR_IRRADIANCE ! (W m-2)
+REAL(KIND=JPRB), INTENT(IN) :: PMU0(KLON) ! Cosine of solar zenith ang
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE_SKIN(KLON) ! (K)
+! Diffuse and direct components of surface shortwave albedo
+REAL(KIND=JPRB), INTENT(IN) :: PALBEDO_DIF(KLON,NSWB_OLD)
+REAL(KIND=JPRB), INTENT(IN) :: PALBEDO_DIR(KLON,NSWB_OLD)
+! Longwave emissivity outside and inside the window region
+REAL(KIND=JPRB), INTENT(IN) :: PEMIS(KLON)
+REAL(KIND=JPRB), INTENT(IN) :: PEMIS_WINDOW(KLON)
+! Longitude (radians), sine of latitude
+REAL(KIND=JPRB), INTENT(IN) :: PGELAM(KLON)
+REAL(KIND=JPRB), INTENT(IN) :: PGEMU(KLON)
+! Land-sea mask
+REAL(KIND=JPRB), INTENT(IN) :: PLAND_SEA_MASK(KLON)
+
+! *** Variables on full levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE(KLON,KLEV) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE(KLON,KLEV) ! (K)
+! *** Variables on half levels
+REAL(KIND=JPRB), INTENT(IN) :: PPRESSURE_H(KLON,KLEV+1) ! (Pa)
+REAL(KIND=JPRB), INTENT(IN) :: PTEMPERATURE_H(KLON,KLEV+1) ! (K)
+
+! *** Gas mass mixing ratios on full levels
+REAL(KIND=JPRB), INTENT(IN) :: PQ(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PCO2(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PCH4(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PN2O(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PNO2(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PCFC11(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PCFC12(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PHCFC22(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PCCL4(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PO3_DP(KLON,KLEV) ! (Pa*kg/kg) !
+
+! *** Cloud fraction and hydrometeor mass mixing ratios
+REAL(KIND=JPRB), INTENT(IN) :: PCLOUD_FRAC(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_LIQUID(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_ICE(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_RAIN(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PQ_SNOW(KLON,KLEV)
+
+! *** Aerosol mass mixing ratios
+REAL(KIND=JPRB), INTENT(IN) :: PAEROSOL_OLD(KLON,6,KLEV)
+REAL(KIND=JPRB), INTENT(IN) :: PAEROSOL(KLON,KLEV,KAEROSOL)
+
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_LAND(KLON)
+REAL(KIND=JPRB), INTENT(IN) :: PCCN_SEA(KLON)
+
+! OUTPUT ARGUMENTS
+
+! *** Net fluxes on half-levels (W m-2)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_CLEAR(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_CLEAR(KLON,KLEV+1)
+
+! *** Surface flux components (W m-2)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_SURF(KLON,NSWB_MNH)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_SURF(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_SURF_CLEAR(KLON,NSWB_MNH)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_SURF_CLEAR(KLON)
+! Direct component of surface flux into horizontal plane
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_DIR_SURF(KLON,NSWB_MNH)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_DIR_SURF_CLEAR(KLON,NSWB_MNH)
+! As PFLUX_DIR but into a plane perpendicular to the sun
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_DIR_SURF_INTO_SUN(KLON,NSWB_MNH)
+
+! *** Ultraviolet and photosynthetically active radiation (W m-2)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_UV(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_PAR(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_PAR_CLEAR(KLON)
+
+! *** Other single-level diagnostics
+! Top-of-atmosphere fluxes flux (W m-2)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_DN_TOA(KLON)
+
+! MNH
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_UP_TOA(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_UP_TOA(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_UP_TOA_CLEAR(KLON)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_UP_TOA_CLEAR(KLON)
+
+! Total fluxes - QL
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_DN(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_DN(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_DN_CLEAR(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_DN_CLEAR(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_UP(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_UP(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_SW_UP_CLEAR(KLON,KLEV+1)
+REAL(KIND=JPRB), INTENT(OUT) :: PFLUX_LW_UP_CLEAR(KLON,KLEV+1)
+
+! Cloud effective radii in microns
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_LIQUID_UM(KLON,KLEV)
+REAL(KIND=JPRB), INTENT(OUT) :: PRE_ICE_UM(KLON,KLEV)
+! MNH
+
+! Diagnosed longwave surface emissivity across the whole spectrum
+REAL(KIND=JPRB), INTENT(OUT) :: PEMIS_OUT(KLON)
+
+! Partial derivative of total-sky longwave upward flux at each level
+! with respect to upward flux at surface, used to correct heating
+! rates at gridpoints/timesteps between calls to the full radiation
+! scheme. Note that this version uses the convention of level index
+! increasing downwards, unlike the local variable ZLwDerivative that
+! is returned from the LW radiation scheme.
+REAL(KIND=JPRB), INTENT(OUT) :: PLWDERIVATIVE(KLON,KLEV+1)
+
+! Surface diffuse and direct downwelling shortwave flux in each
+! shortwave albedo band, used in RADINTG to update the surface fluxes
+! accounting for high-resolution albedo information
+REAL(KIND=JPRB), INTENT(OUT) :: PSWDIFFUSEBAND(KLON,NSWB_MNH)
+REAL(KIND=JPRB), INTENT(OUT) :: PSWDIRECTBAND (KLON,NSWB_MNH)
+
+! LOCAL VARIABLES
+TYPE(single_level_type) :: single_level
+TYPE(thermodynamics_type) :: thermodynamics
+TYPE(gas_type) :: gas
+TYPE(cloud_type) :: cloud
+TYPE(aerosol_type) :: aerosol
+TYPE(flux_type) :: flux
+
+! Mass mixing ratio of ozone (kg/kg)
+REAL(KIND=JPRB) :: ZO3(KLON,KLEV)
+
+! Cloud overlap decorrelation length for cloud boundaries in km
+REAL(KIND=JPRB) :: ZDECORR_LEN_KM(KLON)
+
+! Ratio of cloud overlap decorrelation length for cloud water
+! inhomogeneities to that for cloud boundaries (typically 0.5)
+REAL(KIND=JPRB) :: ZDECORR_LEN_RATIO
+
+! The surface net longwave flux if the surface was a black body, used
+! to compute the effective broadband surface emissivity
+REAL(KIND=JPRB) :: ZBLACK_BODY_NET_LW(KIDIA:KFDIA)
+
+! Layer mass in kg m-2
+REAL(KIND=JPRB) :: ZLAYER_MASS(KIDIA:KFDIA,KLEV)
+
+! Time integers
+INTEGER :: ITIM, IDAY
+
+! Loop indices
+INTEGER :: JLON, JLEV, JBAND, JB_ALBEDO, JAER
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+! Import time functions for iseed calculation
+!#include "fcttim.func.h"
+!#include "liquid_effective_radius.intfb.h"
+!#include "ice_effective_radius.intfb.h"
+!#include "cloud_overlap_decorr_len.intfb.h"
+!#include "satur.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME',0,ZHOOK_HANDLE)
+
+! Allocate memory in radiation objects
+! Albedo and emissivities already on RRTM bands if CRAD="ECRA"
+if (LSPEC_ALB) then
+ CALL single_level%allocate(KLON, 14, NLWB_MNH, &
+ & use_sw_albedo_direct=.TRUE.)
+else
+ CALL single_level%allocate(KLON, 6, NLWB_MNH, &
+ & use_sw_albedo_direct=.TRUE.)
+end if
+
+CALL thermodynamics%allocate(KLON, KLEV, use_h2o_sat=.true.)
+CALL gas%allocate(KLON, KLEV)
+CALL cloud%allocate(KLON, KLEV)
+IF (NAERMACC > 0) THEN
+ CALL aerosol%allocate(KLON, 1, KLEV, KAEROSOL) ! MACC climatology
+ELSE
+ CALL aerosol%allocate(KLON, 1, KLEV, 6) ! Tegen climatology
+ENDIF
+CALL flux%allocate(rad_config, 1, KLON, KLEV)
+
+! Set thermodynamic profiles: simply copy over the half-level
+! pressure and temperature
+thermodynamics%pressure_hl (KIDIA:KFDIA,:) = PPRESSURE_H (KIDIA:KFDIA,:)
+thermodynamics%temperature_hl(KIDIA:KFDIA,:) = PTEMPERATURE_H(KIDIA:KFDIA,:)
+
+! IFS currently sets the half-level temperature at the surface to be
+! equal to the skin temperature. The radiation scheme takes as input
+! only the half-level temperatures and assumes the Planck function to
+! vary linearly in optical depth between half levels. In the lowest
+! atmospheric layer, where the atmospheric temperature can be much
+! cooler than the skin temperature, this can lead to significant
+! differences between the effective temperature of this lowest layer
+! and the true value in the model.
+!
+! We may approximate the temperature profile in the lowest model level
+! as piecewise linear between the top of the layer T[k-1/2], the
+! centre of the layer T[k] and the base of the layer Tskin. The mean
+! temperature of the layer is then 0.25*T[k-1/2] + 0.5*T[k] +
+! 0.25*Tskin, which can be achieved by setting the atmospheric
+! temperature at the half-level corresponding to the surface as
+! follows:
+thermodynamics%temperature_hl(KIDIA:KFDIA,KLEV+1) &
+ & = PTEMPERATURE(KIDIA:KFDIA,KLEV) &
+ & + 0.5_JPRB * (PTEMPERATURE_H(KIDIA:KFDIA,KLEV+1) &
+ & -PTEMPERATURE_H(KIDIA:KFDIA,KLEV))
+
+! Alternatively we respect the model's atmospheric temperature in the
+! lowest model level by setting the temperature at the lowest
+! half-level such that the mean temperature of the layer is correct:
+!thermodynamics%temperature_hl(KIDIA:KFDIA,KLEV+1) &
+! & = 2.0_JPRB * PTEMPERATURE(KIDIA:KFDIA,KLEV) &
+! & - PTEMPERATURE_H(KIDIA:KFDIA,KLEV)
+
+! Compute saturation specific humidity, used to hydrate aerosols. The
+! "2" for the last argument indicates that the routine is not being
+! called from within the convection scheme.
+!JUAN LIKE ecrad-1.0.1 CALL SATUR(KIDIA, KFDIA, KLON, 1, KLEV, &
+!JUAN LIKE ecrad-1.0.1 & PPRESSURE, PTEMPERATURE, thermodynamics%h2o_sat_liq, 2)
+
+!MNH
+thermodynamics%h2o_sat_liq(:,:) = QSAT(REAL(PPRESSURE), REAL(PTEMPERATURE))
+thermodynamics%h2o_sat_liq(:,:) = thermodynamics%h2o_sat_liq(:,:) &
+ & / (1.+thermodynamics%h2o_sat_liq(:,:)) ! mixing ratio => spec humid
+! MNH
+
+! Alternative approximate version using temperature and pressure from
+! the thermodynamics structure
+!CALL thermodynamics%calc_saturation_wrt_liquid(KIDIA, KFDIA)
+
+! Set single-level fileds
+single_level%solar_irradiance = PSOLAR_IRRADIANCE
+single_level%cos_sza(KIDIA:KFDIA) = PMU0(KIDIA:KFDIA)
+single_level%skin_temperature(KIDIA:KFDIA) = PTEMPERATURE_SKIN(KIDIA:KFDIA)
+
+
+! Use albedo from namelist if LSPEC_ALB=T
+if (LSPEC_ALB) then
+ ! Band of input albedo in which to read each ecRad bands
+ ! Last band in ecRad SW is 820-2600 cm-1
+ rad_config%i_albedo_from_band_sw = (/ 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 1 /)
+ ! READ ALBEDO FROM SURF_TYPE
+ CALL READ_ALBEDO_DATA(SURF_TYPE)
+ DO JLON = KIDIA, KFDIA
+ single_level%sw_albedo(JLON,:) = USER_ALB_DIFF(:)
+ single_level%sw_albedo_direct(JLON,:) = USER_ALB_DIR(:)
+ END DO
+else
+ single_level%sw_albedo(KIDIA:KFDIA,:) = PALBEDO_DIF(KIDIA:KFDIA,:)
+ single_level%sw_albedo_direct(KIDIA:KFDIA,:) = PALBEDO_DIR(KIDIA:KFDIA,:)
+end if
+
+if (LSPEC_EMISS) then
+ rad_config%i_emiss_from_band_lw = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16 /)
+ CALL READ_EMISS_DATA(SURF_TYPE)
+ DO JLON = KIDIA, KFDIA
+ single_level%lw_emissivity(JLON,:) = USER_EMISS(:)
+ END DO
+else
+ ! Longwave emissivity is in two bands
+ single_level%lw_emissivity(KIDIA:KFDIA,1) = PEMIS(KIDIA:KFDIA)
+ single_level%lw_emissivity(KIDIA:KFDIA,2) = PEMIS_WINDOW(KIDIA:KFDIA)
+end if
+
+! Create the relevant seed from date and time get the starting day
+! and number of minutes since start
+
+! MNH
+IDAY = TDTEXP%NDAY
+ITIM = NINT(TDTMOD%xtime-TDTCUR%xtime / 60.0_JPRB) ! number of minutes since beginning
+! MNH
+
+DO JLON = KIDIA, KFDIA
+ ! This method gives a unique value for roughly every 1-km square
+ ! on the globe and every minute. ASIN(PGEMU)*60 gives rough
+ ! latitude in degrees, which we multiply by 100 to give a unique
+ ! value for roughly every km. PGELAM*60*100 gives a unique number
+ ! for roughly every km of longitude around the equator, which we
+ ! multiply by 180*100 so there is no overlap with the latitude
+ ! values. The result can be contained in a 32-byte integer (but
+ ! since random numbers are generated with the help of integer
+ ! overflow, it should not matter if the number did overflow).
+ single_level%iseed(JLON) = ITIM + IDAY &
+ & + NINT(PGELAM(JLON)*108000000.0_JPRB &
+ & + ASIN(PGEMU(JLON))*6000.0_JPRB)
+ENDDO
+
+! Set cloud fields
+cloud%q_liq(KIDIA:KFDIA,:) = PQ_LIQUID(KIDIA:KFDIA,:)
+cloud%q_ice(KIDIA:KFDIA,:) = PQ_ICE(KIDIA:KFDIA,:) + PQ_SNOW(KIDIA:KFDIA,:)
+cloud%fraction(KIDIA:KFDIA,:) = PCLOUD_FRAC(KIDIA:KFDIA,:)
+
+! Compute effective radii and convert to metres
+CALL LIQUID_EFFECTIVE_RADIUS(KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_LIQUID, PQ_RAIN, &
+ & PLAND_SEA_MASK, PCCN_LAND, PCCN_SEA, &
+ & PRE_LIQUID_UM)
+cloud%re_liq(KIDIA:KFDIA,:) = PRE_LIQUID_UM(KIDIA:KFDIA,:) * 1.0e-6_JPRB
+
+CALL ICE_EFFECTIVE_RADIUS(KIDIA, KFDIA, KLON, KLEV, &
+ & PPRESSURE, PTEMPERATURE, PCLOUD_FRAC, PQ_ICE, PQ_SNOW, PGEMU, &
+ & PRE_ICE_UM)
+cloud%re_ice(KIDIA:KFDIA,:) = PRE_ICE_UM(KIDIA:KFDIA,:) * 1.0e-6_JPRB
+
+! Get the cloud overlap decorrelation length (for cloud boundaries),
+! in km, according to the parameterization specified by NDECOLAT,
+! and insert into the "cloud" object. Also get the ratio of
+! decorrelation lengths for cloud water content inhomogeneities and
+! cloud boundaries, and set it in the "rad_config" object.
+CALL CLOUD_OVERLAP_DECORR_LEN(KIDIA, KFDIA, KLON, PGEMU, NDECOLAT, &
+ & ZDECORR_LEN_KM, PDECORR_LEN_RATIO=ZDECORR_LEN_RATIO)
+rad_config%cloud_inhom_decorr_scaling = ZDECORR_LEN_RATIO
+DO JLON = KIDIA,KFDIA
+ CALL cloud%set_overlap_param(thermodynamics, &
+ & ZDECORR_LEN_KM(JLON)*1000.0_JPRB, &
+ & istartcol=JLON, iendcol=JLON)
+ENDDO
+
+! Cloud water content fractional standard deviation is configurable
+! from namelist NAERAD but must be globally constant. Before it was
+! hard coded at 1.0.
+CALL cloud%create_fractional_std(KLON, KLEV, XCLOUD_FRAC_STD)
+
+! By default mid and high cloud effective size is 10 km
+CALL cloud%create_inv_cloud_effective_size(KLON,KLEV,1.0_JPRB/10000.0_JPRB)
+! But for boundary clouds (eta > 0.8) we set it to 1 km
+DO JLEV = 1,KLEV
+ DO JLON = KIDIA,KFDIA
+ IF (PPRESSURE(JLON,JLEV) > 0.8_JPRB * PPRESSURE_H(JLON,KLEV+1)) THEN
+ cloud%inv_cloud_effective_size(JLON,JLEV) = 1.0e-3_JPRB
+ ENDIF
+ ENDDO
+ENDDO
+
+
+! Compute the dry mass of each layer neglecting humidity effects, in
+! kg m-2, needed to scale some of the aerosol inputs
+CALL thermodynamics%get_layer_mass(KIDIA, KFDIA, ZLAYER_MASS)
+
+! Copy over aerosol mass mixing ratio
+IF (NAERMACC > 0) THEN
+
+ ! MACC aerosol climatology - this is already in mass mixing ratio
+ ! units with the required array orientation so we can copy it over
+ ! directly
+ aerosol%mixing_ratio(KIDIA:KFDIA,:,:) = PAEROSOL(KIDIA:KFDIA,:,:)
+
+ ! Add the tropospheric and stratospheric backgrounds contained in the
+ ! old Tegen arrays - this is very ugly!
+ IF (TROP_BG_AER_MASS_EXT > 0.0_JPRB) THEN
+ aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_TROP_BG_AER) &
+ & = aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_TROP_BG_AER) &
+ & + PAEROSOL_OLD(KIDIA:KFDIA,1,:) &
+ & / (ZLAYER_MASS * TROP_BG_AER_MASS_EXT)
+ ENDIF
+ IF (STRAT_BG_AER_MASS_EXT > 0.0_JPRB) THEN
+ aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_STRAT_BG_AER) &
+ & = aerosol%mixing_ratio(KIDIA:KFDIA,:,ITYPE_STRAT_BG_AER) &
+ & + PAEROSOL_OLD(KIDIA:KFDIA,6,:) &
+ & / (ZLAYER_MASS * STRAT_BG_AER_MASS_EXT)
+ ENDIF
+
+ELSE
+
+ ! Tegen aerosol climatology - the array PAEROSOL_OLD contains the
+ ! 550-nm optical depth in each layer. The optics data file
+ ! aerosol_ifs_rrtm_tegen.nc does not contain mass extinction
+ ! coefficient, but a scaling factor that the 550-nm optical depth
+ ! should be multiplied by to obtain the optical depth in each
+ ! spectral band. Therefore, in order for the units to work out, we
+ ! need to divide by the layer mass (in kg m-2) to obtain the 550-nm
+ ! cross-section per unit mass of dry air (so in m2 kg-1). We also
+ ! need to permute the array.
+ DO JLEV = 1,KLEV
+ DO JAER = 1,6
+ aerosol%mixing_ratio(KIDIA:KFDIA,JLEV,JAER) &
+ & = PAEROSOL_OLD(KIDIA:KFDIA,JAER,JLEV) &
+ & / ZLAYER_MASS(KIDIA:KFDIA,JLEV)
+ ENDDO
+ ENDDO
+
+ENDIF
+
+
+! Convert ozone Pa*kg/kg to kg/kg
+DO JLEV = 1,KLEV
+ DO JLON = KIDIA,KFDIA
+ ZO3(JLON,JLEV) = PO3_DP(JLON,JLEV) &
+ & / (PPRESSURE_H(JLON,JLEV+1)-PPRESSURE_H(JLON,JLEV))
+ ENDDO
+ENDDO
+
+! Insert gas mixing ratios
+CALL gas%put(IH2O, IMassMixingRatio, PQ)
+CALL gas%put(ICO2, IMassMixingRatio, PCO2)
+CALL gas%put(ICH4, IMassMixingRatio, PCH4)
+CALL gas%put(IN2O, IMassMixingRatio, PN2O)
+CALL gas%put(ICFC11, IMassMixingRatio, PCFC11)
+CALL gas%put(ICFC12, IMassMixingRatio, PCFC12)
+CALL gas%put(IHCFC22, IMassMixingRatio, PHCFC22)
+CALL gas%put(ICCL4, IMassMixingRatio, PCCL4)
+CALL gas%put(IO3, IMassMixingRatio, ZO3)
+CALL gas%put_well_mixed(IO2, IVolumeMixingRatio, 0.20944_JPRB)
+!CALL gas%put_well_mixed(IO2, IVolumeMixingRatio, 0.001_JPRB)
+
+! Ensure the units of the gas mixing ratios are what is required by
+! the gas absorption model
+call set_gas_units(rad_config, gas)
+
+! Call radiation scheme
+CALL radiation(KLON, KLEV, KIDIA, KFDIA, rad_config, &
+ & single_level, thermodynamics, gas, cloud, aerosol, flux)
+
+! Compute required output fluxes
+! First the net fluxes
+PFLUX_SW(KIDIA:KFDIA,:) = flux%sw_dn(KIDIA:KFDIA,:) - flux%sw_up(KIDIA:KFDIA,:)
+PFLUX_LW(KIDIA:KFDIA,:) = flux%lw_dn(KIDIA:KFDIA,:) - flux%lw_up(KIDIA:KFDIA,:)
+PFLUX_SW_CLEAR(KIDIA:KFDIA,:) &
+ & = flux%sw_dn_clear(KIDIA:KFDIA,:) - flux%sw_up_clear(KIDIA:KFDIA,:)
+PFLUX_LW_CLEAR(KIDIA:KFDIA,:) &
+ & = flux%lw_dn_clear(KIDIA:KFDIA,:) - flux%lw_up_clear(KIDIA:KFDIA,:)
+
+! MNH
+
+! Now the surface fluxes
+PFLUX_SW_SURF (KIDIA:KFDIA,:) = TRANSPOSE(flux%sw_dn_surf_band (:,KIDIA:KFDIA))
+PFLUX_LW_SURF (KIDIA:KFDIA) = flux%lw_dn (KIDIA:KFDIA,KLEV+1)
+PFLUX_SW_SURF_CLEAR(KIDIA:KFDIA,:) = TRANSPOSE(flux%sw_dn_surf_clear_band (:,KIDIA:KFDIA))
+PFLUX_LW_SURF_CLEAR(KIDIA:KFDIA) = flux%lw_dn_clear (KIDIA:KFDIA,KLEV+1)
+PFLUX_DIR_SURF (KIDIA:KFDIA,:) = TRANSPOSE(flux%sw_dn_direct_surf_band (:,KIDIA:KFDIA))
+PFLUX_DIR_SURF_CLEAR (KIDIA:KFDIA,:) = TRANSPOSE(flux%sw_dn_direct_surf_clear_band (:,KIDIA:KFDIA))
+
+
+PFLUX_DIR_SURF_INTO_SUN(KIDIA:KFDIA,:) = 0.0_JPRB
+! MNH
+DO JBAND = 1,NSWB_MNH
+ WHERE (PMU0(KIDIA:KFDIA) > EPSILON(1.0_JPRB))
+ PFLUX_DIR_SURF_INTO_SUN(KIDIA:KFDIA, JBAND) = PFLUX_DIR_SURF(KIDIA:KFDIA,JBAND) / PMU0(KIDIA:KFDIA)
+ END WHERE
+END DO
+! Top-of-atmosphere downwelling flux
+PFLUX_SW_DN_TOA(KIDIA:KFDIA) = flux%sw_dn(KIDIA:KFDIA,1)
+
+! Top-of-atmosphere upwelling fluxes - Q.L.
+PFLUX_SW_UP_TOA(KIDIA:KFDIA) = flux%sw_up(KIDIA:KFDIA,1)
+PFLUX_LW_UP_TOA(KIDIA:KFDIA) = flux%lw_up(KIDIA:KFDIA,1)
+PFLUX_SW_UP_TOA_CLEAR(KIDIA:KFDIA) = flux%sw_up_clear(KIDIA:KFDIA,1)
+PFLUX_LW_UP_TOA_CLEAR(KIDIA:KFDIA) = flux%lw_up_clear(KIDIA:KFDIA,1)
+
+! Total fluxes - QL
+! print*,"flux%sw_dn(KIDIA:KFDIA,:)",flux%sw_dn(KIDIA:KFDIA,:)
+
+PFLUX_SW_DN(KIDIA:KFDIA,:) = flux%sw_dn(KIDIA:KFDIA,:)
+PFLUX_SW_UP(KIDIA:KFDIA,:) = flux%sw_up(KIDIA:KFDIA,:)
+PFLUX_LW_DN(KIDIA:KFDIA,:) = flux%lw_dn(KIDIA:KFDIA,:)
+PFLUX_LW_UP(KIDIA:KFDIA,:) = flux%lw_up(KIDIA:KFDIA,:)
+PFLUX_SW_DN_CLEAR(KIDIA:KFDIA,:) = flux%sw_dn_clear(KIDIA:KFDIA,:)
+PFLUX_SW_UP_CLEAR(KIDIA:KFDIA,:) = flux%sw_up_clear(KIDIA:KFDIA,:)
+PFLUX_LW_DN_CLEAR(KIDIA:KFDIA,:) = flux%lw_dn_clear(KIDIA:KFDIA,:)
+PFLUX_LW_UP_CLEAR(KIDIA:KFDIA,:) = flux%lw_up_clear(KIDIA:KFDIA,:)
+
+! Compute UV fluxes as weighted sum of appropriate shortwave bands
+PFLUX_UV (KIDIA:KFDIA) = 0.0_JPRB
+DO JBAND = 1,NWEIGHT_UV
+ PFLUX_UV(KIDIA:KFDIA) = PFLUX_UV(KIDIA:KFDIA) + WEIGHT_UV(JBAND) &
+ & * flux%sw_dn_surf_band(IBAND_UV(JBAND),KIDIA:KFDIA)
+ENDDO
+
+! Compute photosynthetically active radiation similarly
+PFLUX_PAR (KIDIA:KFDIA) = 0.0_JPRB
+PFLUX_PAR_CLEAR(KIDIA:KFDIA) = 0.0_JPRB
+DO JBAND = 1,NWEIGHT_PAR
+ PFLUX_PAR(KIDIA:KFDIA) = PFLUX_PAR(KIDIA:KFDIA) + WEIGHT_PAR(JBAND) &
+ & * flux%sw_dn_surf_band(IBAND_PAR(JBAND),KIDIA:KFDIA)
+ PFLUX_PAR_CLEAR(KIDIA:KFDIA) = PFLUX_PAR_CLEAR(KIDIA:KFDIA) &
+ & + WEIGHT_PAR(JBAND) &
+ & * flux%sw_dn_surf_clear_band(IBAND_PAR(JBAND),KIDIA:KFDIA)
+ENDDO
+
+! Compute effective broadband emissivity
+ZBLACK_BODY_NET_LW = PFLUX_LW_SURF(KIDIA:KFDIA) &
+ & - RSIGMA*PTEMPERATURE_SKIN(KIDIA:KFDIA)**4
+PEMIS_OUT(KIDIA:KFDIA) = PEMIS(KIDIA:KFDIA)
+WHERE (ABS(ZBLACK_BODY_NET_LW) > 1.0E-5)
+ PEMIS_OUT(KIDIA:KFDIA) = PFLUX_LW(KIDIA:KFDIA,KLEV+1) / ZBLACK_BODY_NET_LW
+END WHERE
+
+! Copy longwave derivatives
+IF (LAPPROXLWUPDATE) THEN
+ PLWDERIVATIVE(KIDIA:KFDIA,:) = flux%lw_derivatives(KIDIA:KFDIA,:)
+END IF
+
+! Store the shortwave downwelling fluxes in each albedo band
+IF (LAPPROXSWUPDATE) THEN
+ PSWDIFFUSEBAND(KIDIA:KFDIA,:) = 0.0_JPRB
+ PSWDIRECTBAND (KIDIA:KFDIA,:) = 0.0_JPRB
+ DO JBAND = 1,rad_config%n_bands_sw
+ JB_ALBEDO = rad_config%i_albedo_from_band_sw(JBAND)
+ DO JLON = KIDIA,KFDIA
+ PSWDIFFUSEBAND(JLON,JB_ALBEDO) = PSWDIFFUSEBAND(JLON,JB_ALBEDO) &
+ & + flux%sw_dn_surf_band(JBAND,JLON) &
+ & - flux%sw_dn_direct_surf_band(JBAND,JLON)
+ PSWDIRECTBAND(JLON,JB_ALBEDO) = PSWDIRECTBAND(JLON,JB_ALBEDO) &
+ & + flux%sw_dn_direct_surf_band(JBAND,JLON)
+ ENDDO
+ ENDDO
+ENDIF
+
+CALL single_level%deallocate
+CALL thermodynamics%deallocate
+CALL gas%deallocate
+CALL cloud%deallocate
+CALL aerosol%deallocate
+CALL flux%deallocate
+
+IF (LHOOK) CALL DR_HOOK('RADIATION_SCHEME',1,ZHOOK_HANDLE)
+
+END SUBROUTINE RADIATION_SCHEME
+
+END MODULE MODI_RADIATION_SCHEME
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_setup.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_setup.F90
new file mode 100644
index 0000000000000000000000000000000000000000..0677d3f94c66fd2ab89ac6efee68a4e993669f38
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifs/radiation_setup.F90
@@ -0,0 +1,386 @@
+MODULE RADIATION_SETUP
+
+! RADIATION_SETUP - Setting up modular radiation scheme
+!
+! (C) Copyright 2015- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! PURPOSE
+! -------
+! The modular radiation scheme is contained in a separate
+! library. SETUP_RADIATION_SCHEME in this module sets up a small
+! number of global variables needed to store the information for it.
+!
+! Lower case is used for variables and types taken from the
+! radiation library
+!
+! INTERFACE
+! ---------
+! SETUP_RADIATION_SCHEME is called from SUECRAD. The radiation
+! scheme is actually run using the RADIATION_SCHEME routine (not in
+! this module).
+!
+! AUTHOR
+! ------
+! Robin Hogan, ECMWF
+! Original: 2015-09-16
+!
+! MODIFICATIONS
+! -------------
+!
+!-----------------------------------------------------------------------
+
+ USE PARKIND1, ONLY : JPRB
+ USE radiation_config, ONLY : config_type, &
+ & ISolverMcICA, ISolverSpartacus, &
+ & ILiquidModelSlingo, ILiquidModelSOCRATES, &
+ & IIceModelFu, IIceModelBaran, &
+ & IOverlapExponential
+ USE MODD_PARAM_ECRAD_n , ONLY : rad_config
+
+ IMPLICIT NONE
+
+ ! Store configuration information for the radiation scheme in a
+ ! global variable
+ !type(config_type) :: rad_config
+
+ ! Ultraviolet weightings
+ INTEGER :: NWEIGHT_UV
+ INTEGER :: IBAND_UV(100)
+ REAL(KIND=JPRB) :: WEIGHT_UV(100)
+ ! Photosynthetically active radiation weightings
+ INTEGER :: NWEIGHT_PAR
+ INTEGER :: IBAND_PAR(100)
+ REAL(KIND=JPRB) :: WEIGHT_PAR(100)
+
+ ! Background aerosol is specified in an ugly way: using the old
+ ! Tegen fields that are in terms of optical depth, and converted to
+ ! mass mixing ratio via the relevant mass-extinction coefficient
+ INTEGER, PARAMETER :: ITYPE_TROP_BG_AER = 8 ! hydrophobic organic
+ INTEGER, PARAMETER :: ITYPE_STRAT_BG_AER=12 ! non-absorbing sulphate
+ REAL(KIND=JPRB) :: TROP_BG_AER_MASS_EXT
+ REAL(KIND=JPRB) :: STRAT_BG_AER_MASS_EXT
+
+CONTAINS
+
+ ! This routine copies information between the IFS radiation
+ ! configuration (stored in global variables) and the radiation
+ ! configuration of the modular radiation scheme (stored in
+ ! rad_config). The optional input logical LOUTPUT controls whether
+ ! to print lots of information during the setup stage (default is
+ ! no).
+ SUBROUTINE SETUP_RADIATION_SCHEME(LOUTPUT)
+
+ USE YOMHOOK, ONLY : LHOOK, DR_HOOK
+ USE YOMLUN, ONLY : NULNAM, NULOUT, NULERR
+ USE YOESRTWN, ONLY : NMPSRTM
+ !USE YOERAD, ONLY : YRERAD
+
+ ! MNH
+ USE MODD_PARAM_ECRAD_n , ONLY : LAPPROXLWUPDATE, NAERMACC, NLIQOPT, NICEOPT, &
+ & NLWSOLVER, NSWSOLVER, NLWSCATTERING, NOVLP,CDATADIR
+ ! MNH
+
+ USE radiation_interface, ONLY : setup_radiation
+ USE radiation_aerosol_optics, ONLY : dry_aerosol_sw_mass_extinction
+
+!#include "posname.intfb.h"
+
+ ! Whether or not to provide information on the radiation scheme
+ ! configuration
+ LOGICAL, INTENT(IN), OPTIONAL :: LOUTPUT
+
+ ! Verbosity of configuration information 0=none, 1=warning,
+ ! 2=info, 3=progress, 4=detailed, 5=debug
+ INTEGER :: IVERBOSESETUP
+ INTEGER :: ISTAT
+
+ REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+ IF (LHOOK) CALL DR_HOOK('RADIATION_SETUP:SETUP_RADIATION_SCHEME',0,ZHOOK_HANDLE)
+
+ ! *** GENERAL SETUP ***
+
+ ! Configure verbosity of setup of radiation scheme
+ IVERBOSESETUP = 4 ! Provide plenty of information
+ IF (PRESENT(LOUTPUT)) THEN
+ IF (.NOT. LOUTPUT) THEN
+ IVERBOSESETUP = 1 ! Warnings and errors only
+ ENDIF
+ ENDIF
+ rad_config%iverbosesetup = IVERBOSESETUP
+
+ IF (IVERBOSESETUP > 1) THEN
+ WRITE(NULOUT,'(a)') '-------------------------------------------------------------------------------'
+ WRITE(NULOUT,'(a)') 'RADIATION_SETUP'
+ ENDIF
+
+ ! Normal operation of the radiation scheme displays only errors
+ ! and warnings
+ rad_config%iverbose = 1
+
+ ! For the time being, ensure a valid default directory name
+ rad_config%directory_name = CDATADIR
+
+ ! Do we do Hogan and Bozzo (2014) approximate longwave updates?
+ rad_config%do_lw_derivatives = LAPPROXLWUPDATE
+
+ ! Surface spectral fluxes are needed for spectral shortwave albedo
+ ! calculation
+ rad_config%do_surface_sw_spectral_flux = .TRUE.
+
+
+ ! *** SETUP GAS OPTICS ***
+
+ ! Assume IFS has already set-up RRTM, so the setup_radiation
+ ! routine below does not have to
+ rad_config%do_setup_ifsrrtm = .FALSE.
+
+
+ ! *** SETUP CLOUD OPTICS ***
+
+ ! Setup liquid optics
+ IF (NLIQOPT == 2) THEN
+ rad_config%i_liq_model = ILiquidModelSlingo
+ ELSEIF (NLIQOPT == 3) THEN
+ rad_config%i_liq_model = ILiquidModelSOCRATES
+ ELSE
+ WRITE(NULERR,'(a,i0)') 'Unavailable liquid optics model in modular radiation scheme: NLIQOPT=', &
+ & NLIQOPT
+ CALL ABOR1('RADIATION_SETUP: error interpreting NLIQOPT')
+ ENDIF
+
+ ! Setup ice optics
+ IF (NICEOPT == 3) THEN
+ rad_config%i_ice_model = IIceModelFu
+ ELSEIF (NICEOPT == 4) THEN
+ rad_config%i_ice_model = IIceModelBaran
+ ELSE
+ WRITE(NULERR,'(a,i0)') 'Unavailable ice optics model in modular radiation scheme: NICEOPT=', &
+ & NICEOPT
+ CALL ABOR1('RADIATION_SETUP: error interpreting NICEOPT')
+ ENDIF
+
+ ! For consistency with earlier versions of the IFS radiation
+ ! scheme, we perform shortwave delta-Eddington scaling *after* the
+ ! merge of the cloud, aerosol and gas optical properties. Set
+ ! this to "false" to do the scaling on the cloud and aerosol
+ ! properties separately before merging with gases. Note that this
+ ! is not compatible with the SPARTACUS solver.
+ rad_config%do_sw_delta_scaling_with_gases = .TRUE.
+
+ ! Use Exponential-Exponential cloud overlap to match original IFS
+ ! implementation of Raisanen cloud generator
+
+ ! MNH
+ rad_config%i_overlap_scheme = IOverlapExponential
+ rad_config%i_overlap_scheme = NOVLP
+ ! MNH
+
+ ! *** SETUP AEROSOLS ***
+
+ rad_config%use_aerosols = .TRUE.
+
+ IF (NAERMACC > 0) THEN
+ ! Using MACC climatology - in this case the aerosol optics file
+ ! will be chosen automatically
+
+ ! 12 IFS aerosol classes: 1-3 Sea salt, 4-6 Boucher desert dust,
+ ! 7 hydrophilic organics, 8 hydrophobic organics, 9&10
+ ! hydrophobic black carbon, 11 ammonium sulphate, 12 inactive
+ ! SO2
+ rad_config%n_aerosol_types = 12
+
+ ! Indices to the aerosol optical properties in
+ ! aerosol_ifs_rrtm_*.nc, for each class, where negative numbers
+ ! index hydrophilic aerosol types and positive numbers index
+ ! hydrophobic aerosol types
+ rad_config%i_aerosol_type_map = 0 ! There can be up to 256 types
+ rad_config%i_aerosol_type_map(1:12) = (/ &
+ & -1, & ! Sea salt, size bin 1 (OPAC)
+ & -2, & ! Sea salt, size bin 2 (OPAC)
+ & -3, & ! Sea salt, size bin 3 (OPAC)
+ & 7, & ! Desert dust, size bin 1 (Woodward 2001)
+ & 8, & ! Desert dust, size bin 2 (Woodward 2001)
+ & 9, & ! Desert dust, size bin 3 (Woodward 2001)
+ & -4, & ! Hydrophilic organic matter (OPAC)
+ & 10, & ! Hydrophobic organic matter (OPAC)
+ & 11, & ! Black carbon (Boucher)
+ & 11, & ! Black carbon (Boucher)
+ & -5, & ! Ammonium sulphate (OPAC)
+ & 14 /) ! Stratospheric sulphate (hand edited from OPAC)
+
+ ! Background aerosol mass-extinction coefficients are obtained
+ ! after the configuration files have been read - see later in
+ ! this routine.
+
+ ELSE
+ ! Using Tegen climatology
+ rad_config%n_aerosol_types = 6
+ rad_config%i_aerosol_type_map = 0 ! There can be up to 256 types
+ rad_config%i_aerosol_type_map(1:6) = (/ &
+ & 1, & ! Continental background
+ & 2, & ! Maritime
+ & 3, & ! Desert
+ & 4, & ! Urban
+ & 5, & ! Volcanic active
+ & 6 /) ! Stratospheric background
+
+ ! Manually set the aerosol optics file name (the directory will
+ ! be added automatically)
+ rad_config%aerosol_optics_override_file_name = 'aerosol_ifs_rrtm_tegen.nc'
+ ENDIF
+
+ ! *** SETUP SOLVER ***
+
+ ! 3D effects are off by default
+ rad_config%do_3d_effects = .FALSE.
+
+ ! Select longwave solver
+ SELECT CASE (NLWSOLVER)
+ CASE(0)
+ rad_config%i_solver_lw = ISolverMcICA
+ CASE(1)
+ rad_config%i_solver_lw = ISolverSpartacus
+ CASE(2)
+ rad_config%i_solver_lw = ISolverSpartacus
+ rad_config%do_3d_effects = .TRUE.
+ CASE DEFAULT
+ WRITE(NULERR,'(a,i0)') 'Unknown value for NLWSOLVER: ', NLWSOLVER
+ CALL ABOR1('RADIATION_SETUP: error interpreting NLWSOLVER')
+ END SELECT
+
+ ! Select shortwave solver
+ SELECT CASE (NSWSOLVER)
+ CASE(0)
+ rad_config%i_solver_sw = ISolverMcICA
+ CASE(1)
+ rad_config%i_solver_sw = ISolverSpartacus
+ rad_config%do_3d_effects = .FALSE.
+ IF (NLWSOLVER == 2) THEN
+ CALL ABOR1('RADIATION_SETUP: cannot represent 3D effects in LW but not SW')
+ ENDIF
+ CASE(2)
+ rad_config%i_solver_sw = ISolverSpartacus
+ rad_config%do_3d_effects = .TRUE.
+ IF (NLWSOLVER == 1) THEN
+ CALL ABOR1('RADIATION_SETUP: cannot represent 3D effects in SW but not LW')
+ ENDIF
+ CASE DEFAULT
+ WRITE(NULERR,'(a,i0)') 'Unknown value for NSWSOLVER: ', NSWSOLVER
+ CALL ABOR1('RADIATION_SETUP: error interpreting NSWSOLVER')
+ END SELECT
+
+ ! SPARTACUS solver requires delta scaling to be done separately
+ ! for clouds & aerosols
+ IF (rad_config%i_solver_sw == ISolverSpartacus) THEN
+ rad_config%do_sw_delta_scaling_with_gases = .FALSE.
+ ENDIF
+
+ ! Do we represent longwave scattering?
+ rad_config%do_lw_cloud_scattering = .FALSE.
+ rad_config%do_lw_aerosol_scattering = .FALSE.
+ SELECT CASE (NLWSCATTERING)
+ CASE(1)
+ rad_config%do_lw_cloud_scattering = .TRUE.
+ CASE(2)
+ rad_config%do_lw_cloud_scattering = .TRUE.
+ IF (NAERMACC > 0) THEN
+ ! Tegen climatology omits data required to do longwave
+ ! scattering by aerosols, so only turn this on with a more
+ ! recent scattering database
+ rad_config%do_lw_aerosol_scattering = .TRUE.
+ ENDIF
+ END SELECT
+
+
+ ! *** IMPLEMENT SETTINGS ***
+
+ ! For advanced configuration, the configuration data for the
+ ! "radiation" project can specified directly in the namelist.
+ ! However, the variable naming convention is not consistent with
+ ! the rest of the IFS. For basic configuration there are specific
+ ! variables in the NAERAD namelist available in the YRERAD
+ ! structure.
+
+ ! MNH
+ !CALL POSNAME(NULNAM, 'RADIATION', ISTAT)
+ ISTAT = 1 ! no .nam namelist used, all in NAM_PARAM_ECRAD
+ ! MNH
+
+ SELECT CASE (ISTAT)
+ CASE(0)
+ CALL rad_config%read(unit=NULNAM)
+ CASE(1)
+ WRITE(NULOUT,'(a)') 'Namelist RADIATION not found, using settings from MNH namelist only'
+ CASE DEFAULT
+ CALL ABOR1('RADIATION_SETUP: error reading RADIATION section of namelist file')
+ END SELECT
+
+ ! Print configuration
+ IF (IVERBOSESETUP > 1) THEN
+ WRITE(NULOUT,'(a)') 'Radiation scheme settings:'
+ CALL rad_config%print(IVERBOSE=IVERBOSESETUP)
+ ENDIF
+
+ ! Use configuration data to set-up radiation scheme, including
+ ! reading scattering datafiles
+ CALL setup_radiation(rad_config)
+
+ ! Populate the mapping between the 14 RRTM shortwave bands and the
+ ! 6 albedo inputs. The mapping according to the stated wavelength
+ ! ranges of the 6-band model does not match the hard-wired mapping
+ ! in NMPSRTM, but only the hard-wired values produce sensible
+ ! results...
+ ! Note that NMPSRTM(:)=(/ 6, 6, 5, 5, 5, 5, 5, 4, 4, 3, 2, 2, 1, 6 /)
+ rad_config%i_albedo_from_band_sw = NMPSRTM
+ ! call rad_config%define_sw_albedo_intervals(6, &
+ ! & (/ 0.25e-6_jprb, 0.44e-6_jprb, 1.19e-6_jprb, &
+ ! & 2.38e-6_jprb, 4.00e-6_jprb /), (/ 1,2,3,4,5,6 /))
+
+ ! Likewise between the 16 RRTM longwave bands and the 2 emissivity
+ ! inputs (info taken from rrtm_ecrt_140gp_mcica.F90) representing
+ ! outside and inside the window region of the spectrum
+ ! rad_config%i_emiss_from_band_lw = (/ 1,1,1,1,1,2,2,2,1,1,1,1,1,1,1,1 /)
+ call rad_config%define_lw_emiss_intervals(3, &
+ & (/ 8.0e-6_jprb,13.0e-6_jprb /), (/ 1,2,1 /))
+
+ ! Get spectral weightings for UV and PAR
+ call rad_config%get_sw_weights(0.2e-6_jprb, 0.4415e-6_jprb, &
+ & NWEIGHT_UV, IBAND_UV, WEIGHT_UV, 'ultraviolet')
+ call rad_config%get_sw_weights(0.4e-6_jprb, 0.7e-6_jprb, &
+ & NWEIGHT_PAR, IBAND_PAR, WEIGHT_PAR, &
+ & 'photosynthetically active radiation, PAR')
+
+ IF (NAERMACC > 0) THEN
+ ! With the MACC aerosol climatology we need to add in the
+ ! background aerosol afterwards using the Tegen arrays. In this
+ ! case we first configure the background aerosol mass-extinction
+ ! coefficient at 550 nm, which corresponds to the 10th RRTMG
+ ! shortwave band.
+ TROP_BG_AER_MASS_EXT = dry_aerosol_sw_mass_extinction(rad_config, &
+ & ITYPE_TROP_BG_AER, 10)
+ STRAT_BG_AER_MASS_EXT = dry_aerosol_sw_mass_extinction(rad_config, &
+ & ITYPE_STRAT_BG_AER, 10)
+
+ WRITE(NULOUT,'(a,i0)') 'Tropospheric bacground uses aerosol type ', &
+ & ITYPE_TROP_BG_AER
+ WRITE(NULOUT,'(a,i0)') 'Stratospheric bacground uses aerosol type ', &
+ & ITYPE_STRAT_BG_AER
+ ENDIF
+
+ IF (IVERBOSESETUP > 1) THEN
+ WRITE(NULOUT,'(a)') '-------------------------------------------------------------------------------'
+ ENDIF
+
+ IF (LHOOK) CALL DR_HOOK('RADIATION_SETUP:SETUP_RADIATION_SCHEME',1,ZHOOK_HANDLE)
+
+ END SUBROUTINE SETUP_RADIATION_SCHEME
+
+END MODULE RADIATION_SETUP
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/parkind1.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/parkind1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..35b7f1225aded4ec78d892bbbdbcd248d5c10925
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/parkind1.F90
@@ -0,0 +1,58 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE PARKIND1
+!
+! *** Define usual kinds for strong typing ***
+!
+IMPLICIT NONE
+PUBLIC
+SAVE
+!
+! Integer Kinds
+! -------------
+!
+INTEGER, PARAMETER :: JPIT = SELECTED_INT_KIND(2)
+INTEGER, PARAMETER :: JPIS = SELECTED_INT_KIND(4)
+INTEGER :: JINT_DEF
+INTEGER, PARAMETER :: JPIM = KIND(JINT_DEF) ! to ensure standard integer SELECTED_INT_KIND(9)
+INTEGER, PARAMETER :: JPIB = SELECTED_INT_KIND(12)
+
+!Special integer type to be used for sensative adress calculations
+!should be *8 for a machine with 8byte adressing for optimum performance
+#ifdef ADDRESS64
+INTEGER, PARAMETER :: JPIA = JPIB
+#else
+INTEGER, PARAMETER :: JPIA = JPIM
+#endif
+
+!
+! Real Kinds
+! ----------
+!
+INTEGER, PARAMETER :: JPRT = SELECTED_REAL_KIND(2,1)
+INTEGER, PARAMETER :: JPRS = SELECTED_REAL_KIND(4,2)
+INTEGER, PARAMETER :: JPRM = SELECTED_REAL_KIND(6,37)
+! This parameter should always be double precision as a few parts of
+! the radiation code require it
+INTEGER, PARAMETER :: JPRD = SELECTED_REAL_KIND(13,300)
+
+! This parameter governs the precision of most of the code
+#ifdef SINGLE_PRECISION
+INTEGER, PARAMETER :: JPRB = JPRM
+#else
+INTEGER, PARAMETER :: JPRB = JPRD
+#endif
+!
+
+! Logical Kinds for RTTOV....
+
+INTEGER, PARAMETER :: JPLM = JPIM !Standard logical type
+
+END MODULE PARKIND1
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomcst.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomcst.F90
new file mode 100644
index 0000000000000000000000000000000000000000..d45f32c335271f2df4e53591991781da1114e00c
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomcst.F90
@@ -0,0 +1,41 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE YOMCST
+
+USE PARKIND1 ,ONLY : JPRB
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+! * RPI : number Pi
+REAL(KIND=JPRB), PARAMETER :: RPI = 3.14159265358979323846_JPRB
+! * RSIGMA : Stefan-Bolzman constant
+REAL(KIND=JPRB), PARAMETER :: RSIGMA = 5.67037321e-8_JPRB ! W m-2 K-4
+! * RG : gravity constant
+REAL(KIND=JPRB), PARAMETER :: RG = 9.80665_JPRB ! m s-2
+! * RD : R_dry (dry air constant)
+REAL(KIND=JPRB), PARAMETER :: RD = 287.058_JPRB! J kg-1 K-1
+! * RMD : dry air molar mass
+REAL(KIND=JPRB), PARAMETER :: RMD = 28.9644_JPRB
+! * RMV : vapour water molar mass
+REAL(KIND=JPRB), PARAMETER :: RMV = 18.0153_JPRB
+! * RMO3 : ozone molar mass
+REAL(KIND=JPRB), PARAMETER :: RMO3 = 47.9942_JPRB
+! * RI0 : solar constant
+REAL(KIND=JPRB), PARAMETER :: RI0 = 1366.0_JPRB
+! * RDAY : day duration in s
+REAL(KIND=JPRB), PARAMETER :: RDAY = 86400_JPRB
+! * RTT : freezing temperature
+REAL(KIND=JPRB), PARAMETER :: RTT=273.16_JPRB
+
+END MODULE YOMCST
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomlun.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomlun.F90
new file mode 100644
index 0000000000000000000000000000000000000000..adac0b230969cf6a0041327987c08f1b13450819
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsaux/yomlun.F90
@@ -0,0 +1,26 @@
+! (C) Copyright 2014- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+
+MODULE YOMLUN
+
+USE PARKIND1, ONLY : JPIM
+USE YOMLUN_IFSAUX, ONLY : NULOUT, NULERR
+
+IMPLICIT NONE
+
+PUBLIC
+
+SAVE
+
+INTEGER(KIND=JPIM) :: NULRAD = 25
+
+INTEGER(KIND=JPIM) :: NULNAM = 4
+
+! ------------------------------------------------------------------
+END MODULE YOMLUN
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_kgb1.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_kgb1.F90
new file mode 100644
index 0000000000000000000000000000000000000000..36c2ecd732b4f8a25220e103a9d9cecd3fe554e7
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_kgb1.F90
@@ -0,0 +1,358 @@
+SUBROUTINE RRTM_KGB1(DIRECTORY)
+
+! Originally by Eli J. Mlawer, Atmospheric & Environmental Research.
+! BAND 1: 10-250 cm-1 (low - H2O; high - H2O)
+! Reformatted for F90 by JJMorcrette, ECMWF
+! R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+! G.Mozdzynski March 2011 read constants from files
+! ABozzo May 2013 update to RRTMG v4.85
+! band 1: 10-350 cm-1
+! T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+! ------------------------------------------------------------------
+
+USE PARKIND1 ,ONLY : JPRB
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE YOMLUN ,ONLY : NULRAD
+USE MPL_MODULE,ONLY : MPL_BROADCAST
+USE YOMTAG ,ONLY : MTAGRAD
+USE YOMMP0 , ONLY : NPROC, MYPROC
+
+USE YOERRTO1 , ONLY : KAO ,KBO ,KAO_D,KBO_D,SELFREFO ,FRACREFAO ,&
+ & FRACREFBO ,FORREFO, KAO_MN2, KBO_MN2
+
+! ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+
+!CHARACTER(LEN = 80) :: CLZZZ
+CHARACTER(LEN = 255) :: CLF1
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB1',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ !CALL GETENV("DATA",CLZZZ)
+ !IF(CLZZZ /= " ") THEN
+ ! CLF1=TRIM(CLZZZ) // "/RADRRTM"
+ CLF1 = DIRECTORY // "/RADRRTM"
+ WRITE(0,'(A,A)') 'Reading ',TRIM(CLF1)
+ ! RRTM and SRTM files from ecrad are in big-endian format.
+ ! Here they are read as big-endian at opening because otherwise MNH assumes littel-endian
+ ! No need for complation option export GFORTRAN_CONVERT_UNIT="little_endian;big_endian:145"
+ OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",access='sequential',ERR=1000,CONVERT="BIG_ENDIAN")
+ !ELSE
+ ! OPEN(NULRAD,FILE='RADRRTM',FORM="UNFORMATTED",ACTION="READ",ERR=1000)
+ !ENDIF
+ READ(NULRAD,ERR=1001) KAO_D,KBO_D
+ ! Convert the data into model actual precision.
+ KAO = REAL(KAO_D,JPRB)
+ KBO = REAL(KBO_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+ CALL MPL_BROADCAST (KAO,MTAGRAD,1,CDSTRING='RRTM_KGB1:')
+ CALL MPL_BROADCAST (KBO,MTAGRAD,1,CDSTRING='RRTM_KGB1:')
+ENDIF
+
+! Planck fraction mapping level: P = 212.7250 mbar, T = 223.06 K
+FRACREFAO(:) = (/ &
+ & 2.1227E-01_JPRB,1.8897E-01_JPRB,1.3934E-01_JPRB,1.1557E-01_JPRB,9.5282E-02_JPRB,8.3359E-02_JPRB, &
+ & 6.5333E-02_JPRB,5.2016E-02_JPRB,3.4272E-02_JPRB,4.0257E-03_JPRB,3.1857E-03_JPRB,2.6014E-03_JPRB, &
+ & 1.9141E-03_JPRB,1.2612E-03_JPRB,5.3169E-04_JPRB,7.6476E-05_JPRB/)
+
+! Planck fraction mapping level: P = 212.7250 mbar, T = 223.06 K
+! These Planck fractions were calculated using lower atmosphere
+! parameters.
+FRACREFBO(:) = (/ &
+ & 2.1227E-01_JPRB,1.8897E-01_JPRB,1.3934E-01_JPRB,1.1557E-01_JPRB,9.5282E-02_JPRB,8.3359E-02_JPRB, &
+ & 6.5333E-02_JPRB,5.2016E-02_JPRB,3.4272E-02_JPRB,4.0257E-03_JPRB,3.1857E-03_JPRB,2.6014E-03_JPRB, &
+ & 1.9141E-03_JPRB,1.2612E-03_JPRB,5.3169E-04_JPRB,7.6476E-05_JPRB/)
+
+! The array FORREFO contains the coefficient of the water vapor
+! foreign-continuum (including the energy term). The first
+! index refers to reference temperature (296,260,224,260) and
+! pressure (970,475,219,3 mbar) levels. The second index
+! runs over the g-channel (1 to 16).
+
+ FORREFO(1,:) = (/ &
+ & 3.6742e-02_JPRB,1.0664e-01_JPRB,2.6132e-01_JPRB,2.7906e-01_JPRB,2.8151e-01_JPRB,2.7465e-01_JPRB, &
+ & 2.8530e-01_JPRB,2.9123e-01_JPRB,3.0697e-01_JPRB,3.1801e-01_JPRB,3.2444e-01_JPRB,2.7746e-01_JPRB, &
+ & 3.1994e-01_JPRB,2.9750e-01_JPRB,2.1226e-01_JPRB,1.2847e-01_JPRB/)
+ FORREFO(2,:) = (/ &
+ & 4.0450e-02_JPRB,1.1085e-01_JPRB,2.9205e-01_JPRB,3.1934e-01_JPRB,3.1739e-01_JPRB,3.1450e-01_JPRB, &
+ & 3.2797e-01_JPRB,3.2223e-01_JPRB,3.3099e-01_JPRB,3.4800e-01_JPRB,3.4046e-01_JPRB,3.5700e-01_JPRB, &
+ & 3.8264e-01_JPRB,3.6679e-01_JPRB,3.3481e-01_JPRB,3.2113e-01_JPRB/)
+ FORREFO(3,:) = (/ &
+ & 4.6952e-02_JPRB,1.1999e-01_JPRB,3.1473e-01_JPRB,3.7015e-01_JPRB,3.6913e-01_JPRB,3.6352e-01_JPRB, &
+ & 3.7754e-01_JPRB,3.7402e-01_JPRB,3.7113e-01_JPRB,3.7720e-01_JPRB,3.8365e-01_JPRB,4.0876e-01_JPRB, &
+ & 4.2968e-01_JPRB,4.4186e-01_JPRB,4.3468e-01_JPRB,4.7083e-01_JPRB/)
+ FORREFO(4,:) = (/ &
+ & 7.0645e-02_JPRB,1.6618e-01_JPRB,2.8516e-01_JPRB,3.1819e-01_JPRB,3.0131e-01_JPRB,2.9552e-01_JPRB, &
+ & 2.8972e-01_JPRB,2.9348e-01_JPRB,2.8668e-01_JPRB,2.8483e-01_JPRB,2.8130e-01_JPRB,2.7757e-01_JPRB, &
+ & 2.9735e-01_JPRB,3.1684e-01_JPRB,3.0681e-01_JPRB,3.6778e-01_JPRB/)
+
+
+! ------------------------------------------------------------------
+
+! The array KAO contains absorption coefs at the 16 chosen g-values
+! for a range of pressure levels > ~100mb and temperatures. The first
+! index in the array, JT, which runs from 1 to 5, corresponds to
+! different temperatures. More specifically, JT = 3 means that the
+! data are for the corresponding TREF for this pressure level,
+! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30,
+! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second
+! index, JP, runs from 1 to 13 and refers to the corresponding
+! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb).
+! The third index, IG, goes from 1 to 16, and tells us which
+! g-interval the absorption coefficients are for.
+
+
+
+! The array KBO contains absorption coefs at the 16 chosen g-values
+! for a range of pressure levels < ~100mb and temperatures. The first
+! index in the array, JT, which runs from 1 to 5, corresponds to
+! different temperatures. More specifically, JT = 3 means that the
+! data are for the reference temperature TREF for this pressure
+! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
+! The second index, JP, runs from 13 to 59 and refers to the JPth
+! reference pressure level (see taumol.f for the value of these
+! pressure levels in mb). The third index, IG, goes from 1 to 16,
+! and tells us which g-interval the absorption coefficients are for.
+
+
+
+ KAO_MN2(:, 1) = (/ &
+ & 5.12042E-08_JPRB, 5.51239E-08_JPRB, 5.93436E-08_JPRB, 6.38863E-08_JPRB, 6.87767E-08_JPRB, &
+ & 7.40415E-08_JPRB, 7.97093E-08_JPRB, 8.58110E-08_JPRB, 9.23797E-08_JPRB, 9.94513E-08_JPRB, &
+ & 1.07064E-07_JPRB, 1.15260E-07_JPRB, 1.24083E-07_JPRB, 1.33581E-07_JPRB, 1.43807E-07_JPRB, &
+ & 1.54815E-07_JPRB, 1.66666E-07_JPRB, 1.79424E-07_JPRB, 1.93159E-07_JPRB/)
+ KAO_MN2(:, 2) = (/ &
+ & 2.30938E-07_JPRB, 2.41696E-07_JPRB, 2.52955E-07_JPRB, 2.64738E-07_JPRB, 2.77071E-07_JPRB, &
+ & 2.89978E-07_JPRB, 3.03486E-07_JPRB, 3.17623E-07_JPRB, 3.32419E-07_JPRB, 3.47904E-07_JPRB, &
+ & 3.64111E-07_JPRB, 3.81072E-07_JPRB, 3.98824E-07_JPRB, 4.17402E-07_JPRB, 4.36846E-07_JPRB, &
+ & 4.57196E-07_JPRB, 4.78494E-07_JPRB, 5.00784E-07_JPRB, 5.24112E-07_JPRB/)
+ KAO_MN2(:, 3) = (/ &
+ & 6.70458E-07_JPRB, 7.04274E-07_JPRB, 7.39795E-07_JPRB, 7.77109E-07_JPRB, 8.16304E-07_JPRB, &
+ & 8.57476E-07_JPRB, 9.00724E-07_JPRB, 9.46154E-07_JPRB, 9.93876E-07_JPRB, 1.04400E-06_JPRB, &
+ & 1.09666E-06_JPRB, 1.15197E-06_JPRB, 1.21008E-06_JPRB, 1.27111E-06_JPRB, 1.33522E-06_JPRB, &
+ & 1.40256E-06_JPRB, 1.47331E-06_JPRB, 1.54761E-06_JPRB, 1.62567E-06_JPRB/)
+ KAO_MN2(:, 4) = (/ &
+ & 1.84182E-06_JPRB, 1.89203E-06_JPRB, 1.94360E-06_JPRB, 1.99658E-06_JPRB, 2.05101E-06_JPRB, &
+ & 2.10692E-06_JPRB, 2.16435E-06_JPRB, 2.22335E-06_JPRB, 2.28396E-06_JPRB, 2.34622E-06_JPRB, &
+ & 2.41017E-06_JPRB, 2.47587E-06_JPRB, 2.54337E-06_JPRB, 2.61270E-06_JPRB, 2.68392E-06_JPRB, &
+ & 2.75708E-06_JPRB, 2.83224E-06_JPRB, 2.90944E-06_JPRB, 2.98875E-06_JPRB/)
+ KAO_MN2(:, 5) = (/ &
+ & 3.41996E-06_JPRB, 3.32758E-06_JPRB, 3.23770E-06_JPRB, 3.15024E-06_JPRB, 3.06515E-06_JPRB, &
+ & 2.98235E-06_JPRB, 2.90180E-06_JPRB, 2.82341E-06_JPRB, 2.74715E-06_JPRB, 2.67294E-06_JPRB, &
+ & 2.60074E-06_JPRB, 2.53049E-06_JPRB, 2.46214E-06_JPRB, 2.39563E-06_JPRB, 2.33092E-06_JPRB, &
+ & 2.26796E-06_JPRB, 2.20670E-06_JPRB, 2.14709E-06_JPRB, 2.08910E-06_JPRB/)
+ KAO_MN2(:, 6) = (/ &
+ & 3.38746E-06_JPRB, 3.25966E-06_JPRB, 3.13669E-06_JPRB, 3.01836E-06_JPRB, 2.90449E-06_JPRB, &
+ & 2.79491E-06_JPRB, 2.68947E-06_JPRB, 2.58801E-06_JPRB, 2.49037E-06_JPRB, 2.39642E-06_JPRB, &
+ & 2.30601E-06_JPRB, 2.21902E-06_JPRB, 2.13530E-06_JPRB, 2.05475E-06_JPRB, 1.97723E-06_JPRB, &
+ & 1.90264E-06_JPRB, 1.83086E-06_JPRB, 1.76179E-06_JPRB, 1.69532E-06_JPRB/)
+ KAO_MN2(:, 7) = (/ &
+ & 3.17530E-06_JPRB, 3.07196E-06_JPRB, 2.97199E-06_JPRB, 2.87527E-06_JPRB, 2.78170E-06_JPRB, &
+ & 2.69118E-06_JPRB, 2.60360E-06_JPRB, 2.51887E-06_JPRB, 2.43690E-06_JPRB, 2.35759E-06_JPRB, &
+ & 2.28087E-06_JPRB, 2.20664E-06_JPRB, 2.13483E-06_JPRB, 2.06536E-06_JPRB, 1.99814E-06_JPRB, &
+ & 1.93312E-06_JPRB, 1.87021E-06_JPRB, 1.80934E-06_JPRB, 1.75046E-06_JPRB/)
+ KAO_MN2(:, 8) = (/ &
+ & 2.84701E-06_JPRB, 2.77007E-06_JPRB, 2.69521E-06_JPRB, 2.62237E-06_JPRB, 2.55150E-06_JPRB, &
+ & 2.48254E-06_JPRB, 2.41545E-06_JPRB, 2.35017E-06_JPRB, 2.28666E-06_JPRB, 2.22486E-06_JPRB, &
+ & 2.16473E-06_JPRB, 2.10623E-06_JPRB, 2.04930E-06_JPRB, 1.99392E-06_JPRB, 1.94003E-06_JPRB, &
+ & 1.88760E-06_JPRB, 1.83659E-06_JPRB, 1.78695E-06_JPRB, 1.73866E-06_JPRB/)
+ KAO_MN2(:, 9) = (/ &
+ & 2.79917E-06_JPRB, 2.73207E-06_JPRB, 2.66658E-06_JPRB, 2.60266E-06_JPRB, 2.54027E-06_JPRB, &
+ & 2.47937E-06_JPRB, 2.41994E-06_JPRB, 2.36192E-06_JPRB, 2.30530E-06_JPRB, 2.25004E-06_JPRB, &
+ & 2.19610E-06_JPRB, 2.14346E-06_JPRB, 2.09208E-06_JPRB, 2.04193E-06_JPRB, 1.99298E-06_JPRB, &
+ & 1.94520E-06_JPRB, 1.89857E-06_JPRB, 1.85306E-06_JPRB, 1.80864E-06_JPRB/)
+ KAO_MN2(:,10) = (/ &
+ & 2.74910E-06_JPRB, 2.64462E-06_JPRB, 2.54412E-06_JPRB, 2.44743E-06_JPRB, 2.35442E-06_JPRB, &
+ & 2.26495E-06_JPRB, 2.17887E-06_JPRB, 2.09606E-06_JPRB, 2.01641E-06_JPRB, 1.93978E-06_JPRB, &
+ & 1.86606E-06_JPRB, 1.79514E-06_JPRB, 1.72692E-06_JPRB, 1.66129E-06_JPRB, 1.59815E-06_JPRB, &
+ & 1.53742E-06_JPRB, 1.47899E-06_JPRB, 1.42278E-06_JPRB, 1.36871E-06_JPRB/)
+ KAO_MN2(:,11) = (/ &
+ & 2.63952E-06_JPRB, 2.60263E-06_JPRB, 2.56626E-06_JPRB, 2.53039E-06_JPRB, 2.49503E-06_JPRB, &
+ & 2.46016E-06_JPRB, 2.42578E-06_JPRB, 2.39188E-06_JPRB, 2.35845E-06_JPRB, 2.32549E-06_JPRB, &
+ & 2.29299E-06_JPRB, 2.26094E-06_JPRB, 2.22934E-06_JPRB, 2.19819E-06_JPRB, 2.16747E-06_JPRB, &
+ & 2.13717E-06_JPRB, 2.10731E-06_JPRB, 2.07786E-06_JPRB, 2.04882E-06_JPRB/)
+ KAO_MN2(:,12) = (/ &
+ & 2.94106E-06_JPRB, 2.82819E-06_JPRB, 2.71966E-06_JPRB, 2.61528E-06_JPRB, 2.51492E-06_JPRB, &
+ & 2.41841E-06_JPRB, 2.32560E-06_JPRB, 2.23635E-06_JPRB, 2.15053E-06_JPRB, 2.06800E-06_JPRB, &
+ & 1.98863E-06_JPRB, 1.91232E-06_JPRB, 1.83893E-06_JPRB, 1.76836E-06_JPRB, 1.70049E-06_JPRB, &
+ & 1.63524E-06_JPRB, 1.57248E-06_JPRB, 1.51214E-06_JPRB, 1.45411E-06_JPRB/)
+ KAO_MN2(:,13) = (/ &
+ & 2.94607E-06_JPRB, 2.87369E-06_JPRB, 2.80309E-06_JPRB, 2.73422E-06_JPRB, 2.66705E-06_JPRB, &
+ & 2.60152E-06_JPRB, 2.53760E-06_JPRB, 2.47526E-06_JPRB, 2.41445E-06_JPRB, 2.35513E-06_JPRB, &
+ & 2.29726E-06_JPRB, 2.24082E-06_JPRB, 2.18577E-06_JPRB, 2.13207E-06_JPRB, 2.07969E-06_JPRB, &
+ & 2.02859E-06_JPRB, 1.97875E-06_JPRB, 1.93014E-06_JPRB, 1.88272E-06_JPRB/)
+ KAO_MN2(:,14) = (/ &
+ & 2.58051E-06_JPRB, 2.48749E-06_JPRB, 2.39782E-06_JPRB, 2.31139E-06_JPRB, 2.22807E-06_JPRB, &
+ & 2.14775E-06_JPRB, 2.07033E-06_JPRB, 1.99570E-06_JPRB, 1.92376E-06_JPRB, 1.85441E-06_JPRB, &
+ & 1.78756E-06_JPRB, 1.72313E-06_JPRB, 1.66101E-06_JPRB, 1.60114E-06_JPRB, 1.54342E-06_JPRB, &
+ & 1.48778E-06_JPRB, 1.43415E-06_JPRB, 1.38245E-06_JPRB, 1.33262E-06_JPRB/)
+ KAO_MN2(:,15) = (/ &
+ & 3.03447E-06_JPRB, 2.88559E-06_JPRB, 2.74401E-06_JPRB, 2.60938E-06_JPRB, 2.48135E-06_JPRB, &
+ & 2.35961E-06_JPRB, 2.24384E-06_JPRB, 2.13375E-06_JPRB, 2.02906E-06_JPRB, 1.92951E-06_JPRB, &
+ & 1.83484E-06_JPRB, 1.74481E-06_JPRB, 1.65921E-06_JPRB, 1.57780E-06_JPRB, 1.50039E-06_JPRB, &
+ & 1.42677E-06_JPRB, 1.35677E-06_JPRB, 1.29020E-06_JPRB, 1.22690E-06_JPRB/)
+ KAO_MN2(:,16) = (/ &
+ & 1.48655E-06_JPRB, 1.48283E-06_JPRB, 1.47913E-06_JPRB, 1.47543E-06_JPRB, 1.47174E-06_JPRB, &
+ & 1.46806E-06_JPRB, 1.46439E-06_JPRB, 1.46072E-06_JPRB, 1.45707E-06_JPRB, 1.45343E-06_JPRB, &
+ & 1.44979E-06_JPRB, 1.44617E-06_JPRB, 1.44255E-06_JPRB, 1.43894E-06_JPRB, 1.43534E-06_JPRB, &
+ & 1.43176E-06_JPRB, 1.42817E-06_JPRB, 1.42460E-06_JPRB, 1.42104E-06_JPRB/)
+ KBO_MN2(:, 1) = (/ &
+ & 5.12042E-08_JPRB, 5.51239E-08_JPRB, 5.93436E-08_JPRB, 6.38863E-08_JPRB, 6.87767E-08_JPRB, &
+ & 7.40415E-08_JPRB, 7.97093E-08_JPRB, 8.58110E-08_JPRB, 9.23797E-08_JPRB, 9.94513E-08_JPRB, &
+ & 1.07064E-07_JPRB, 1.15260E-07_JPRB, 1.24083E-07_JPRB, 1.33581E-07_JPRB, 1.43807E-07_JPRB, &
+ & 1.54815E-07_JPRB, 1.66666E-07_JPRB, 1.79424E-07_JPRB, 1.93159E-07_JPRB/)
+ KBO_MN2(:, 2) = (/ &
+ & 2.30938E-07_JPRB, 2.41696E-07_JPRB, 2.52955E-07_JPRB, 2.64738E-07_JPRB, 2.77071E-07_JPRB, &
+ & 2.89978E-07_JPRB, 3.03486E-07_JPRB, 3.17623E-07_JPRB, 3.32419E-07_JPRB, 3.47904E-07_JPRB, &
+ & 3.64111E-07_JPRB, 3.81072E-07_JPRB, 3.98824E-07_JPRB, 4.17402E-07_JPRB, 4.36846E-07_JPRB, &
+ & 4.57196E-07_JPRB, 4.78494E-07_JPRB, 5.00784E-07_JPRB, 5.24112E-07_JPRB/)
+ KBO_MN2(:, 3) = (/ &
+ & 6.70458E-07_JPRB, 7.04274E-07_JPRB, 7.39795E-07_JPRB, 7.77109E-07_JPRB, 8.16304E-07_JPRB, &
+ & 8.57476E-07_JPRB, 9.00724E-07_JPRB, 9.46154E-07_JPRB, 9.93876E-07_JPRB, 1.04400E-06_JPRB, &
+ & 1.09666E-06_JPRB, 1.15197E-06_JPRB, 1.21008E-06_JPRB, 1.27111E-06_JPRB, 1.33522E-06_JPRB, &
+ & 1.40256E-06_JPRB, 1.47331E-06_JPRB, 1.54761E-06_JPRB, 1.62567E-06_JPRB/)
+ KBO_MN2(:, 4) = (/ &
+ & 1.84182E-06_JPRB, 1.89203E-06_JPRB, 1.94360E-06_JPRB, 1.99658E-06_JPRB, 2.05101E-06_JPRB, &
+ & 2.10692E-06_JPRB, 2.16435E-06_JPRB, 2.22335E-06_JPRB, 2.28396E-06_JPRB, 2.34622E-06_JPRB, &
+ & 2.41017E-06_JPRB, 2.47587E-06_JPRB, 2.54337E-06_JPRB, 2.61270E-06_JPRB, 2.68392E-06_JPRB, &
+ & 2.75708E-06_JPRB, 2.83224E-06_JPRB, 2.90944E-06_JPRB, 2.98875E-06_JPRB/)
+ KBO_MN2(:, 5) = (/ &
+ & 3.41996E-06_JPRB, 3.32758E-06_JPRB, 3.23770E-06_JPRB, 3.15024E-06_JPRB, 3.06515E-06_JPRB, &
+ & 2.98235E-06_JPRB, 2.90180E-06_JPRB, 2.82341E-06_JPRB, 2.74715E-06_JPRB, 2.67294E-06_JPRB, &
+ & 2.60074E-06_JPRB, 2.53049E-06_JPRB, 2.46214E-06_JPRB, 2.39563E-06_JPRB, 2.33092E-06_JPRB, &
+ & 2.26796E-06_JPRB, 2.20670E-06_JPRB, 2.14709E-06_JPRB, 2.08910E-06_JPRB/)
+ KBO_MN2(:, 6) = (/ &
+ & 3.38746E-06_JPRB, 3.25966E-06_JPRB, 3.13669E-06_JPRB, 3.01836E-06_JPRB, 2.90449E-06_JPRB, &
+ & 2.79491E-06_JPRB, 2.68947E-06_JPRB, 2.58801E-06_JPRB, 2.49037E-06_JPRB, 2.39642E-06_JPRB, &
+ & 2.30601E-06_JPRB, 2.21902E-06_JPRB, 2.13530E-06_JPRB, 2.05475E-06_JPRB, 1.97723E-06_JPRB, &
+ & 1.90264E-06_JPRB, 1.83086E-06_JPRB, 1.76179E-06_JPRB, 1.69532E-06_JPRB/)
+ KBO_MN2(:, 7) = (/ &
+ & 3.17530E-06_JPRB, 3.07196E-06_JPRB, 2.97199E-06_JPRB, 2.87527E-06_JPRB, 2.78170E-06_JPRB, &
+ & 2.69118E-06_JPRB, 2.60360E-06_JPRB, 2.51887E-06_JPRB, 2.43690E-06_JPRB, 2.35759E-06_JPRB, &
+ & 2.28087E-06_JPRB, 2.20664E-06_JPRB, 2.13483E-06_JPRB, 2.06536E-06_JPRB, 1.99814E-06_JPRB, &
+ & 1.93312E-06_JPRB, 1.87021E-06_JPRB, 1.80934E-06_JPRB, 1.75046E-06_JPRB/)
+ KBO_MN2(:, 8) = (/ &
+ & 2.84701E-06_JPRB, 2.77007E-06_JPRB, 2.69521E-06_JPRB, 2.62237E-06_JPRB, 2.55150E-06_JPRB, &
+ & 2.48254E-06_JPRB, 2.41545E-06_JPRB, 2.35017E-06_JPRB, 2.28666E-06_JPRB, 2.22486E-06_JPRB, &
+ & 2.16473E-06_JPRB, 2.10623E-06_JPRB, 2.04930E-06_JPRB, 1.99392E-06_JPRB, 1.94003E-06_JPRB, &
+ & 1.88760E-06_JPRB, 1.83659E-06_JPRB, 1.78695E-06_JPRB, 1.73866E-06_JPRB/)
+ KBO_MN2(:, 9) = (/ &
+ & 2.79917E-06_JPRB, 2.73207E-06_JPRB, 2.66658E-06_JPRB, 2.60266E-06_JPRB, 2.54027E-06_JPRB, &
+ & 2.47937E-06_JPRB, 2.41994E-06_JPRB, 2.36192E-06_JPRB, 2.30530E-06_JPRB, 2.25004E-06_JPRB, &
+ & 2.19610E-06_JPRB, 2.14346E-06_JPRB, 2.09208E-06_JPRB, 2.04193E-06_JPRB, 1.99298E-06_JPRB, &
+ & 1.94520E-06_JPRB, 1.89857E-06_JPRB, 1.85306E-06_JPRB, 1.80864E-06_JPRB/)
+ KBO_MN2(:,10) = (/ &
+ & 2.74910E-06_JPRB, 2.64462E-06_JPRB, 2.54412E-06_JPRB, 2.44743E-06_JPRB, 2.35442E-06_JPRB, &
+ & 2.26495E-06_JPRB, 2.17887E-06_JPRB, 2.09606E-06_JPRB, 2.01641E-06_JPRB, 1.93978E-06_JPRB, &
+ & 1.86606E-06_JPRB, 1.79514E-06_JPRB, 1.72692E-06_JPRB, 1.66129E-06_JPRB, 1.59815E-06_JPRB, &
+ & 1.53742E-06_JPRB, 1.47899E-06_JPRB, 1.42278E-06_JPRB, 1.36871E-06_JPRB/)
+ KBO_MN2(:,11) = (/ &
+ & 2.63952E-06_JPRB, 2.60263E-06_JPRB, 2.56626E-06_JPRB, 2.53039E-06_JPRB, 2.49503E-06_JPRB, &
+ & 2.46016E-06_JPRB, 2.42578E-06_JPRB, 2.39188E-06_JPRB, 2.35845E-06_JPRB, 2.32549E-06_JPRB, &
+ & 2.29299E-06_JPRB, 2.26094E-06_JPRB, 2.22934E-06_JPRB, 2.19819E-06_JPRB, 2.16747E-06_JPRB, &
+ & 2.13717E-06_JPRB, 2.10731E-06_JPRB, 2.07786E-06_JPRB, 2.04882E-06_JPRB/)
+ KBO_MN2(:,12) = (/ &
+ & 2.94106E-06_JPRB, 2.82819E-06_JPRB, 2.71966E-06_JPRB, 2.61528E-06_JPRB, 2.51492E-06_JPRB, &
+ & 2.41841E-06_JPRB, 2.32560E-06_JPRB, 2.23635E-06_JPRB, 2.15053E-06_JPRB, 2.06800E-06_JPRB, &
+ & 1.98863E-06_JPRB, 1.91232E-06_JPRB, 1.83893E-06_JPRB, 1.76836E-06_JPRB, 1.70049E-06_JPRB, &
+ & 1.63524E-06_JPRB, 1.57248E-06_JPRB, 1.51214E-06_JPRB, 1.45411E-06_JPRB/)
+ KBO_MN2(:,13) = (/ &
+ & 2.94607E-06_JPRB, 2.87369E-06_JPRB, 2.80309E-06_JPRB, 2.73422E-06_JPRB, 2.66705E-06_JPRB, &
+ & 2.60152E-06_JPRB, 2.53760E-06_JPRB, 2.47526E-06_JPRB, 2.41445E-06_JPRB, 2.35513E-06_JPRB, &
+ & 2.29726E-06_JPRB, 2.24082E-06_JPRB, 2.18577E-06_JPRB, 2.13207E-06_JPRB, 2.07969E-06_JPRB, &
+ & 2.02859E-06_JPRB, 1.97875E-06_JPRB, 1.93014E-06_JPRB, 1.88272E-06_JPRB/)
+ KBO_MN2(:,14) = (/ &
+ & 2.58051E-06_JPRB, 2.48749E-06_JPRB, 2.39782E-06_JPRB, 2.31139E-06_JPRB, 2.22807E-06_JPRB, &
+ & 2.14775E-06_JPRB, 2.07033E-06_JPRB, 1.99570E-06_JPRB, 1.92376E-06_JPRB, 1.85441E-06_JPRB, &
+ & 1.78756E-06_JPRB, 1.72313E-06_JPRB, 1.66101E-06_JPRB, 1.60114E-06_JPRB, 1.54342E-06_JPRB, &
+ & 1.48778E-06_JPRB, 1.43415E-06_JPRB, 1.38245E-06_JPRB, 1.33262E-06_JPRB/)
+ KBO_MN2(:,15) = (/ &
+ & 3.03447E-06_JPRB, 2.88559E-06_JPRB, 2.74401E-06_JPRB, 2.60938E-06_JPRB, 2.48135E-06_JPRB, &
+ & 2.35961E-06_JPRB, 2.24384E-06_JPRB, 2.13375E-06_JPRB, 2.02906E-06_JPRB, 1.92951E-06_JPRB, &
+ & 1.83484E-06_JPRB, 1.74481E-06_JPRB, 1.65921E-06_JPRB, 1.57780E-06_JPRB, 1.50039E-06_JPRB, &
+ & 1.42677E-06_JPRB, 1.35677E-06_JPRB, 1.29020E-06_JPRB, 1.22690E-06_JPRB/)
+ KBO_MN2(:,16) = (/ &
+ & 1.48655E-06_JPRB, 1.48283E-06_JPRB, 1.47913E-06_JPRB, 1.47543E-06_JPRB, 1.47174E-06_JPRB, &
+ & 1.46806E-06_JPRB, 1.46439E-06_JPRB, 1.46072E-06_JPRB, 1.45707E-06_JPRB, 1.45343E-06_JPRB, &
+ & 1.44979E-06_JPRB, 1.44617E-06_JPRB, 1.44255E-06_JPRB, 1.43894E-06_JPRB, 1.43534E-06_JPRB, &
+ & 1.43176E-06_JPRB, 1.42817E-06_JPRB, 1.42460E-06_JPRB, 1.42104E-06_JPRB/)
+
+
+! The array SELFREFO contains the coefficient of the water vapor
+! self-continuum (including the energy term). The first index
+! refers to temperature in 7.2 degree increments. For instance,
+! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+! etc. The second index runs over the g-channel (1 to 16).
+
+ SELFREFO(:, 1) = (/ &
+ & 2.16803e+00_JPRB, 1.98236e+00_JPRB, 1.81260e+00_JPRB, 1.65737e+00_JPRB, 1.51544e+00_JPRB, &
+ & 1.38567e+00_JPRB, 1.26700e+00_JPRB, 1.15850e+00_JPRB, 1.05929e+00_JPRB, 9.68576e-01_JPRB/)
+ SELFREFO(:, 2) = (/ &
+ & 3.70149e+00_JPRB, 3.43145e+00_JPRB, 3.18110e+00_JPRB, 2.94902e+00_JPRB, 2.73387e+00_JPRB, &
+ & 2.53441e+00_JPRB, 2.34951e+00_JPRB, 2.17810e+00_JPRB, 2.01919e+00_JPRB, 1.87188e+00_JPRB/)
+ SELFREFO(:, 3) = (/ &
+ & 6.17433e+00_JPRB, 5.62207e+00_JPRB, 5.11920e+00_JPRB, 4.66131e+00_JPRB, 4.24438e+00_JPRB, &
+ & 3.86474e+00_JPRB, 3.51906e+00_JPRB, 3.20430e+00_JPRB, 2.91769e+00_JPRB, 2.65672e+00_JPRB/)
+ SELFREFO(:, 4) = (/ &
+ & 6.56459e+00_JPRB, 5.94787e+00_JPRB, 5.38910e+00_JPRB, 4.88282e+00_JPRB, 4.42410e+00_JPRB, &
+ & 4.00848e+00_JPRB, 3.63190e+00_JPRB, 3.29070e+00_JPRB, 2.98155e+00_JPRB, 2.70145e+00_JPRB/)
+ SELFREFO(:, 5) = (/ &
+ & 6.49581e+00_JPRB, 5.91114e+00_JPRB, 5.37910e+00_JPRB, 4.89494e+00_JPRB, 4.45436e+00_JPRB, &
+ & 4.05344e+00_JPRB, 3.68860e+00_JPRB, 3.35660e+00_JPRB, 3.05448e+00_JPRB, 2.77956e+00_JPRB/)
+ SELFREFO(:, 6) = (/ &
+ & 6.50189e+00_JPRB, 5.89381e+00_JPRB, 5.34260e+00_JPRB, 4.84294e+00_JPRB, 4.39001e+00_JPRB, &
+ & 3.97944e+00_JPRB, 3.60727e+00_JPRB, 3.26990e+00_JPRB, 2.96409e+00_JPRB, 2.68687e+00_JPRB/)
+ SELFREFO(:, 7) = (/ &
+ & 6.64768e+00_JPRB, 6.01719e+00_JPRB, 5.44650e+00_JPRB, 4.92993e+00_JPRB, 4.46236e+00_JPRB, &
+ & 4.03914e+00_JPRB, 3.65605e+00_JPRB, 3.30930e+00_JPRB, 2.99543e+00_JPRB, 2.71134e+00_JPRB/)
+ SELFREFO(:, 8) = (/ &
+ & 6.43744e+00_JPRB, 5.87166e+00_JPRB, 5.35560e+00_JPRB, 4.88490e+00_JPRB, 4.45557e+00_JPRB, &
+ & 4.06397e+00_JPRB, 3.70679e+00_JPRB, 3.38100e+00_JPRB, 3.08384e+00_JPRB, 2.81281e+00_JPRB/)
+ SELFREFO(:, 9) = (/ &
+ & 6.55466e+00_JPRB, 5.99777e+00_JPRB, 5.48820e+00_JPRB, 5.02192e+00_JPRB, 4.59525e+00_JPRB, &
+ & 4.20484e+00_JPRB, 3.84759e+00_JPRB, 3.52070e+00_JPRB, 3.22158e+00_JPRB, 2.94787e+00_JPRB/)
+ SELFREFO(:,10) = (/ &
+ & 6.84510e+00_JPRB, 6.26933e+00_JPRB, 5.74200e+00_JPRB, 5.25902e+00_JPRB, 4.81667e+00_JPRB, &
+ & 4.41152e+00_JPRB, 4.04046e+00_JPRB, 3.70060e+00_JPRB, 3.38933e+00_JPRB, 3.10424e+00_JPRB/)
+ SELFREFO(:,11) = (/ &
+ & 6.83128e+00_JPRB, 6.25536e+00_JPRB, 5.72800e+00_JPRB, 5.24510e+00_JPRB, 4.80291e+00_JPRB, &
+ & 4.39799e+00_JPRB, 4.02722e+00_JPRB, 3.68770e+00_JPRB, 3.37681e+00_JPRB, 3.09212e+00_JPRB/)
+ SELFREFO(:,12) = (/ &
+ & 7.35969e+00_JPRB, 6.61719e+00_JPRB, 5.94960e+00_JPRB, 5.34936e+00_JPRB, 4.80968e+00_JPRB, &
+ & 4.32445e+00_JPRB, 3.88817e+00_JPRB, 3.49590e+00_JPRB, 3.14321e+00_JPRB, 2.82610e+00_JPRB/)
+ SELFREFO(:,13) = (/ &
+ & 7.50064e+00_JPRB, 6.80749e+00_JPRB, 6.17840e+00_JPRB, 5.60744e+00_JPRB, 5.08925e+00_JPRB, &
+ & 4.61894e+00_JPRB, 4.19210e+00_JPRB, 3.80470e+00_JPRB, 3.45310e+00_JPRB, 3.13399e+00_JPRB/)
+ SELFREFO(:,14) = (/ &
+ & 7.40801e+00_JPRB, 6.71328e+00_JPRB, 6.08370e+00_JPRB, 5.51316e+00_JPRB, 4.99613e+00_JPRB, &
+ & 4.52759e+00_JPRB, 4.10298e+00_JPRB, 3.71820e+00_JPRB, 3.36950e+00_JPRB, 3.05351e+00_JPRB/)
+ SELFREFO(:,15) = (/ &
+ & 7.51895e+00_JPRB, 6.68846e+00_JPRB, 5.94970e+00_JPRB, 5.29254e+00_JPRB, 4.70796e+00_JPRB, &
+ & 4.18795e+00_JPRB, 3.72538e+00_JPRB, 3.31390e+00_JPRB, 2.94787e+00_JPRB, 2.62227e+00_JPRB/)
+ SELFREFO(:,16) = (/ &
+ & 7.84774e+00_JPRB, 6.80673e+00_JPRB, 5.90380e+00_JPRB, 5.12065e+00_JPRB, 4.44138e+00_JPRB, &
+ & 3.85223e+00_JPRB, 3.34122e+00_JPRB, 2.89800e+00_JPRB, 2.51357e+00_JPRB, 2.18014e+00_JPRB/)
+
+
+
+
+
+IF (LHOOK) CALL DR_HOOK('RRTM_KGB1',1,ZHOOK_HANDLE)
+RETURN
+
+1000 CONTINUE
+CALL ABOR1("RRTM_KGB1:ERROR OPENING FILE RADRRTM")
+1001 CONTINUE
+CALL ABOR1("RRTM_KGB1:ERROR READING FILE RADRRTM")
+
+! -----------------------------------------------------------------
+END SUBROUTINE RRTM_KGB1
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_rrtm_140gp_mcica.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_rrtm_140gp_mcica.F90
new file mode 100644
index 0000000000000000000000000000000000000000..909d48afc107a5a9e8d7b4a2b28c2da6a654b66e
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/rrtm_rrtm_140gp_mcica.F90
@@ -0,0 +1,304 @@
+SUBROUTINE RRTM_RRTM_140GP_MCICA &
+ &( KIDIA , KFDIA , KLON , KLEV, KCOLS, KCLDCOL,&
+ & PAER , PAPH , PAP , PAERTAUL, PAERASYL, PAEROMGL, &
+ & PTS , PTH , PT , &
+ & PEMIS , PEMIW ,&
+ & PQ , PCO2 , PCH4 , PN2O, PNO2 , PC11, PC12, PC22, PCL4, POZN ,&
+ & PCLDF , PTAUCLD, PCLFR,&
+ & PEMIT , PFLUX , PFLUC, &
+ & PLwDerivative)
+
+! *** This program is the driver for the McICA version of RRTM_LW,
+! the AER rapid model.
+
+! For each atmosphere the user wishes to analyze, this routine
+! a) calls ECRTATM to read in the atmospheric profile
+! b) calls SETCOEF to calculate various quantities needed for
+! the radiative transfer algorithm
+! c) calls RTRN to do the radiative transfer calculation for
+! clear or cloudy sky
+! d) writes out the upward, downward, and net flux for each
+! level and the heating rate for each layer
+
+! JJMorcrette 20050110 McICA version revisited (changes in RRTM_ECRT, RRTM_RTRN)
+! NEC 25-Oct-2007 Optimisations
+! JJMorcrette 20080424 3D fields of CO2, CH4, N2O, NO2, CFC11, 12, 22 and CCL4
+! JJMorcrette 20110613 flexible number of g-points
+! P Bechtold 14/05/2012 replace ZHEATF by core constants RG*RDAY/RCPD
+! and put arrays to scalars
+! R Hogan 20/05/2014 pass partial derivatives back to calling function
+!-----------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARRRTM , ONLY : JPBAND, JPXSEC, JPINPX
+USE YOERRTM , ONLY : JPGPT
+USE YOMCST , ONLY : RG ! , RDAYI, RCPD
+
+IMPLICIT NONE
+
+!------------------------------Arguments--------------------------------
+
+! Input arguments
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON! Number of atmospheres (longitudes)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV! Number of atmospheric layers
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA ! First atmosphere index
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA ! Last atmosphere index
+INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS ! Number of columns on which to perform RT
+ ! should be the same as number of g-points, JPGPT
+INTEGER(KIND=JPIM),INTENT(IN) :: KCLDCOL(KLON) ! cloudy column index: 1=cloud, 0: clear
+
+REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) ! Aerosol optical thickness
+REAL(KIND=JPRB) ,INTENT(IN) :: PAERTAUL(KLON,KLEV,16), PAERASYL(KLON,KLEV,16), PAEROMGL(KLON,KLEV,16)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1) ! Interface pressures (Pa)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV) ! Layer pressures (Pa)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON) ! Surface temperature (JK)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1) ! Interface temperatures (JK)
+REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV) ! Layer temperature (JK)
+REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KLON) ! Non-window surface emissivity
+REAL(KIND=JPRB) ,INTENT(IN) :: PEMIW(KLON) ! Window surface emissivity
+REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV) ! H2O specific humidity (mmr)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCO2(KLON,KLEV) ! CO2 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PCH4(KLON,KLEV) ! CH4 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PN2O(KLON,KLEV) ! N2O mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PNO2(KLON,KLEV) ! NO2 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PC11(KLON,KLEV) ! CFC11 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PC12(KLON,KLEV) ! CFC12 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PC22(KLON,KLEV) ! CFC22 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PCL4(KLON,KLEV) ! CCL4 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV) ! O3 mass mixing ratio
+REAL(KIND=JPRB) ,INTENT(IN) :: PCLFR(KLON,KLEV)
+
+REAL(KIND=JPRB) ,INTENT(OUT) :: PEMIT(KLON) ! Surface LW emissivity
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KLON,2,KLEV+1) ! LW total sky flux (1=up, 2=down)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(KLON,2,KLEV+1) ! LW clear sky flux (1=up, 2=down)
+
+! Partial derivative of total upward flux at each level with respect
+! to upward flux at surface, used to correct heating rates at
+! gridpoints/timesteps between calls to the full radiation scheme:
+REAL(KIND=JPRB) ,INTENT(OUT) :: PLwDerivative(KLON,KLEV+1)
+
+!-- McICA ----------
+REAL(KIND=JPRB) ,INTENT(IN) :: PCLDF(KLON,KCOLS,KLEV) ! Cloud fraction
+REAL(KIND=JPRB) ,INTENT(IN) :: PTAUCLD(KLON,KLEV,KCOLS) ! Cloud optical depth
+
+REAL(KIND=JPRB) :: ZCLDFRAC(KIDIA:KFDIA,KCOLS,KLEV) ! Cloud fraction
+REAL(KIND=JPRB) :: ZTAUCLD(KIDIA:KFDIA,KLEV,KCOLS) ! Spectral optical thickness
+!-- McICA ----------
+
+REAL(KIND=JPRB) :: ZATR1(KIDIA:KFDIA,JPGPT,KLEV)
+
+REAL(KIND=JPRB) :: ZOD(KIDIA:KFDIA,JPGPT,KLEV)
+
+REAL(KIND=JPRB) :: ZTF1(KIDIA:KFDIA,JPGPT,KLEV)
+
+REAL(KIND=JPRB) :: ZCOLDRY(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZWBRODL(KIDIA:KFDIA,KLEV) !BROADENING GASES,column density (mol/cm2)
+REAL(KIND=JPRB) :: ZCOLBRD(KIDIA:KFDIA,KLEV) !BROADENING GASES, column amount
+REAL(KIND=JPRB) :: ZWKL(KIDIA:KFDIA,JPINPX,KLEV)
+
+REAL(KIND=JPRB) :: ZWX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
+
+REAL(KIND=JPRB) :: ZTOTDFLUC(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTOTDFLUX(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTOTUFLUC(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTOTUFLUX(KIDIA:KFDIA,0:KLEV)
+
+INTEGER(KIND=JPIM) :: JL, JK
+INTEGER(KIND=JPIM) :: ISTART
+INTEGER(KIND=JPIM) :: IEND
+
+REAL(KIND=JPRB) :: ZFLUXFAC, ZHEATFAC, ZPI
+REAL(KIND=JPRB) :: ZEPSEC
+
+!- from AER
+REAL(KIND=JPRB) :: ZTAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
+
+!- from INTFAC
+REAL(KIND=JPRB) :: ZFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC11(KIDIA:KFDIA,KLEV)
+
+!- from FOR
+REAL(KIND=JPRB) :: ZFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: INDFOR(KIDIA:KFDIA,KLEV)
+
+!- from MINOR
+INTEGER(KIND=JPIM) :: INDMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZSCALEMINOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZSCALEMINORN2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZMINORFRAC(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB) :: &
+ & ZRAT_H2OCO2(KIDIA:KFDIA,KLEV),ZRAT_H2OCO2_1(KIDIA:KFDIA,KLEV), &
+ & ZRAT_H2OO3(KIDIA:KFDIA,KLEV) ,ZRAT_H2OO3_1(KIDIA:KFDIA,KLEV), &
+ & ZRAT_H2ON2O(KIDIA:KFDIA,KLEV),ZRAT_H2ON2O_1(KIDIA:KFDIA,KLEV), &
+ & ZRAT_H2OCH4(KIDIA:KFDIA,KLEV),ZRAT_H2OCH4_1(KIDIA:KFDIA,KLEV), &
+ & ZRAT_N2OCO2(KIDIA:KFDIA,KLEV),ZRAT_N2OCO2_1(KIDIA:KFDIA,KLEV), &
+ & ZRAT_O3CO2(KIDIA:KFDIA,KLEV) ,ZRAT_O3CO2_1(KIDIA:KFDIA,KLEV)
+
+!- from INTIND
+INTEGER(KIND=JPIM) :: JP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: JT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: JT1(KIDIA:KFDIA,KLEV)
+
+!- from PRECISE
+REAL(KIND=JPRB) :: ZONEMINUS
+
+!- from PROFDATA
+REAL(KIND=JPRB) :: ZCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLN2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCO2MULT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: ILAYTROP(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: ILAYSWTCH(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: ILAYLOW(KIDIA:KFDIA)
+
+!- from PROFILE
+REAL(KIND=JPRB) :: ZPAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZTAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZPZ(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTZ(KIDIA:KFDIA,0:KLEV)
+REAL(KIND=JPRB) :: ZTBOUND(KIDIA:KFDIA)
+
+!- from SELF
+REAL(KIND=JPRB) :: ZSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: INDSELF(KIDIA:KFDIA,KLEV)
+
+!- from SP
+REAL(KIND=JPRB) :: ZPFRAC(KIDIA:KFDIA,JPGPT,KLEV)
+
+!- from SURFACE
+REAL(KIND=JPRB) :: ZSEMISS(KIDIA:KFDIA,JPBAND)
+REAL(KIND=JPRB) :: ZSEMISLW(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: IREFLECT(KIDIA:KFDIA)
+
+! Local variable required in case KFDIA /= KLON
+REAL(KIND=JPRB) :: ZLwDerivative(KIDIA:KFDIA,KLEV+1)
+
+LOGICAL :: LLPRINT
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!#include "rrtm_ecrt_140gp_mcica.intfb.h"
+#include "rrtm_gasabs1a_140gp.intfb.h"
+!#include "rrtm_rtrn1a_140gp_mcica.intfb.h"
+!#include "rrtm_setcoef_140gp.intfb.h"
+
+! HEATFAC is the factor by which one must multiply delta-flux/
+! delta-pressure, with flux in w/m-2 and pressure in mbar, to get
+! the heating rate in units of degrees/day. It is equal to
+! (g)x(#sec/day)x(1e-5)/(specific heat of air at const. p)
+! = (9.8066)(86400)(1e-5)/(1.004)
+
+IF (LHOOK) CALL DR_HOOK('RRTM_RRTM_140GP_MCICA',0,ZHOOK_HANDLE)
+
+ASSOCIATE(NFLEVG=>KLEV)
+
+ZEPSEC = 1.E-06_JPRB
+ZONEMINUS = 1.0_JPRB - ZEPSEC
+ZPI = 2.0_JPRB*ASIN(1.0_JPRB)
+ZFLUXFAC = ZPI * 2.E+4
+!ZHEATFAC = 8.4391_JPRB
+!ZHEATFAC = RG*RDAYI/RCPD*1.E-2_JPRB
+
+! *** mji ***
+
+! For use with ECRT, this loop is over atmospheres (or longitudes)
+LLPRINT=.TRUE.
+
+! do JK=1,KLEV
+! print 9901,JK,PT(JL,JK),PQ(JL,JK),POZN(JL,JK),PCLDF(JL,JK,1),PTAUCLD(JL,JK,1)
+! enddo
+
+! *** mji ***
+!- Prepare atmospheric profile from ECRT for use in RRTM, and define
+! other RRTM input parameters. Arrays are passed back through the
+! existing RRTM commons and arrays.
+
+ CALL RRTM_ECRT_140GP_MCICA &
+ &( KIDIA, KFDIA, KLON , KLEV, KCOLS , &
+ & PAER , PAPH , PAP , PAERTAUL, PAERASYL, PAEROMGL, &
+ & pts , PTH , PT , &
+ & PEMIS, PEMIW, &
+ & PQ , PCO2 , PCH4, PN2O, PNO2, PC11, PC12, PC22, PCL4, POZN , PCLDF, PTAUCLD, &
+ & ZCLDFRAC, ZTAUCLD, ZCOLDRY, ZWBRODL,ZWKL, ZWX, &
+ & ZTAUAERL, ZPAVEL , ZTAVEL , ZPZ , ZTZ, ZTBOUND, ZSEMISS, IREFLECT)
+
+ ISTART = 1
+ IEND = 16
+
+! Calculate information needed by the radiative transfer routine
+! that is specific to this atmosphere, especially some of the
+! coefficients and indices needed to compute the optical depths
+! by interpolating data from stored reference atmospheres.
+
+ CALL RRTM_SETCOEF_140GP &
+ &( KIDIA , KFDIA , KLEV , ZCOLDRY , ZWBRODL , ZWKL , &
+ & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, JP, JT, JT1 , &
+ & ZCOLH2O, ZCOLCO2 , ZCOLO3 , ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT , ZCOLBRD, &
+ & ILAYTROP,ILAYSWTCH, ILAYLOW, ZPAVEL , ZTAVEL , ZSELFFAC, ZSELFFRAC, INDSELF, &
+ & INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,&
+ & ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, &
+ & ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, &
+ & ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1)
+
+ CALL RRTM_GASABS1A_140GP &
+ &( KIDIA , KFDIA , KLEV, ZATR1, ZOD, ZTF1, ZPAVEL, ZCOLDRY, ZCOLBRD, ZWX ,&
+ & ZTAUAERL, ZFAC00 , ZFAC01, ZFAC10 , ZFAC11 , ZFORFAC,ZFORFRAC,INDFOR, JP, JT, JT1, ZONEMINUS ,&
+ & ZCOLH2O , ZCOLCO2, ZCOLO3, ZCOLN2O, ZCOLCH4, ZCOLO2,ZCO2MULT ,&
+ & ILAYTROP, ILAYSWTCH,ILAYLOW, ZSELFFAC, ZSELFFRAC, INDSELF, ZPFRAC, &
+ & INDMINOR,ZSCALEMINOR,ZSCALEMINORN2,ZMINORFRAC,&
+ & ZRAT_H2OCO2, ZRAT_H2OCO2_1, ZRAT_H2OO3, ZRAT_H2OO3_1, &
+ & ZRAT_H2ON2O, ZRAT_H2ON2O_1, ZRAT_H2OCH4, ZRAT_H2OCH4_1, &
+ & ZRAT_N2OCO2, ZRAT_N2OCO2_1, ZRAT_O3CO2, ZRAT_O3CO2_1)
+
+!- Call the radiative transfer routine.
+
+! Clear and cloudy parts of column are treated together in RTRN.
+
+! print 9901,JL,ZTBOUND
+
+ CALL RRTM_RTRN1A_140GP_MCICA &
+ &( KIDIA, KFDIA, KLEV, ISTART, IEND, KCOLS ,&
+ & ZCLDFRAC, ZTAUCLD, ZATR1 ,&
+ & ZOD , ZTF1 , &
+ & ZTOTDFLUC, ZTOTDFLUX, ZTOTUFLUC, ZTOTUFLUX ,&
+ & ZTAVEL, ZTZ, ZTBOUND, ZPFRAC, ZSEMISS, ZSEMISLW ,&
+ & ZLwDerivative )
+
+! *** Pass clear sky and total sky up and down flux profiles to ECRT
+! output arrays (zflux, zfluc). Array indexing from bottom to top
+! is preserved for ECRT.
+! Invert down flux arrays for consistency with ECRT sign conventions.
+
+DO JL = KIDIA,KFDIA
+
+ PEMIT(JL) = ZSEMISLW(JL)
+ DO JK = 0, KLEV
+ PFLUC(JL,1,JK+1) = ZTOTUFLUC(JL,JK)*ZFLUXFAC
+ PFLUC(JL,2,JK+1) = -ZTOTDFLUC(JL,JK)*ZFLUXFAC
+ PFLUX(JL,1,JK+1) = ZTOTUFLUX(JL,JK)*ZFLUXFAC
+ PFLUX(JL,2,JK+1) = -ZTOTDFLUX(JL,JK)*ZFLUXFAC
+ ENDDO
+
+ ! Copy to output array, noting that they may be dimensioned
+ ! differently
+ PLwDerivative(JL,:) = ZLwDerivative(JL,:)
+
+ENDDO
+
+9901 FORMAT(1X,'rrtm:',I4,12E12.5)
+
+!------------------------------------------------------------------------
+END ASSOCIATE
+
+IF (LHOOK) CALL DR_HOOK('RRTM_RRTM_140GP_MCICA',1,ZHOOK_HANDLE)
+END SUBROUTINE RRTM_RRTM_140GP_MCICA
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_gas_optical_depth.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_gas_optical_depth.F90
new file mode 100644
index 0000000000000000000000000000000000000000..12ae9c5dce0a46b20127071f59d1b25059435eeb
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_gas_optical_depth.F90
@@ -0,0 +1,338 @@
+#ifdef RS6K
+@PROCESS HOT(NOVECTOR) NOSTRICT
+#endif
+SUBROUTINE SRTM_GAS_OPTICAL_DEPTH &
+ & ( KIDIA , KFDIA , KLEV , PONEMINUS, &
+ & PRMU0, &
+ & KLAYTROP,&
+ & PCOLCH4 , PCOLCO2 , PCOLH2O , PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ !-- output arrays
+ & POD, PSSA, PINCSOL)
+
+
+!**** *SRTM_GAS_OPTICAL_DEPTH* - SPECTRAL LOOP TO COMPUTE THE SHORTWAVE RADIATION FLUXES.
+
+! PURPOSE.
+! --------
+
+! COMPUTE THE GAS OPTICAL DEPTH AT EACH SHORTWAVE G POINT
+
+!** INTERFACE.
+! ----------
+
+! *SRTM_GAS_OPTICAL_DEPTH* IS CALLED FROM THE NEW RADIATION SCHEME
+
+! IMPLICIT ARGUMENTS :
+! --------------------
+
+! ==== INPUTS ===
+! ==== OUTPUTS ===
+
+! METHOD.
+! -------
+
+! EXTERNALS.
+! ----------
+
+! REFERENCE.
+! ----------
+
+! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
+! DOCUMENTATION
+! AUTHOR.
+! -------
+! ADAPTED FROM SRTM_SPCVRT_MCICA (BY JEAN-JACQUES MORCRETTE) BY
+! ROBIN HOGAN
+!
+! MODIFICATIONS.
+! --------------
+! ORIGINAL : 2015-07-16
+
+! ------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARSRTM , ONLY : JPB1, JPB2
+USE YOESRTM , ONLY : JPGPT
+USE YOESRTWN , ONLY : NGC
+
+IMPLICIT NONE
+
+! ------------------------------------------------------------------
+
+!* 0.1 ARGUMENTS
+! ---------
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: PONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT1(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB) ,INTENT(OUT) :: POD(KIDIA:KFDIA,KLEV,JPGPT) ! Optical depth
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSSA(KIDIA:KFDIA,KLEV,JPGPT) ! Single scattering albedo
+REAL(KIND=JPRB) ,INTENT(OUT) :: PINCSOL(KIDIA:KFDIA,JPGPT) ! Incoming solar flux
+
+
+! ------------------------------------------------------------------
+
+INTEGER(KIND=JPIM) :: IB1, IB2, IBM, IGT, IW(KIDIA:KFDIA), JB, JG, JK, JL, IC, ICOUNT
+
+INTEGER(KIND=JPIM) :: IND(KFDIA-KIDIA+1)
+
+
+!-- Output of SRTM_TAUMOLn routines
+REAL(KIND=JPRB) :: ZTAUG(KIDIA:KFDIA,KLEV,16) ! Absorption optical depth
+REAL(KIND=JPRB) :: ZTAUR(KIDIA:KFDIA,KLEV,16) ! Rayleigh optical depth
+REAL(KIND=JPRB) :: ZSFLXZEN(KIDIA:KFDIA,16) ! Incoming solar flux
+
+
+REAL(KIND=JPRB) :: ZTAU, ZPAO, ZPTO
+REAL(KIND=JPRB) :: ZPAOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZPTOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZRMU0D(KIDIA:KFDIA)
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "srtm_taumol16.intfb.h"
+#include "srtm_taumol17.intfb.h"
+#include "srtm_taumol18.intfb.h"
+#include "srtm_taumol19.intfb.h"
+#include "srtm_taumol20.intfb.h"
+#include "srtm_taumol21.intfb.h"
+#include "srtm_taumol22.intfb.h"
+#include "srtm_taumol23.intfb.h"
+#include "srtm_taumol24.intfb.h"
+#include "srtm_taumol25.intfb.h"
+#include "srtm_taumol26.intfb.h"
+#include "srtm_taumol27.intfb.h"
+#include "srtm_taumol28.intfb.h"
+#include "srtm_taumol29.intfb.h"
+
+! ------------------------------------------------------------------
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_GAS_OPTICAL_DEPTH',0,ZHOOK_HANDLE)
+
+POD = 0.0
+PSSA = 0.0
+PINCSOL = 0.0
+
+IB1=JPB1
+IB2=JPB2
+
+IC=0
+DO JL = KIDIA, KFDIA
+ IF (PRMU0(JL) > 0.0_JPRB) THEN
+ IC=IC+1
+ IND(IC)=JL
+ IW(JL)=0
+ ENDIF
+ENDDO
+ICOUNT=IC
+IF(ICOUNT==0)THEN
+ IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+
+JB=IB1-1
+DO JB = IB1, IB2
+ DO IC=1,ICOUNT
+ JL=IND(IC)
+ IBM = JB-15
+ IGT = NGC(IBM)
+ ENDDO
+
+ !-- for each band, computes the gaseous and Rayleigh optical thickness
+ ! for all g-points within the band
+
+ IF (JB == 16) THEN
+ CALL SRTM_TAUMOL16 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC , PSELFFRAC, KINDSELF, PFORFAC , PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 17) THEN
+ CALL SRTM_TAUMOL17 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 18) THEN
+ CALL SRTM_TAUMOL18 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 19) THEN
+ CALL SRTM_TAUMOL19 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 20) THEN
+ CALL SRTM_TAUMOL20 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 21) THEN
+ CALL SRTM_TAUMOL21 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 22) THEN
+ CALL SRTM_TAUMOL22 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLMOL , PCOLO2 ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 23) THEN
+ CALL SRTM_TAUMOL23 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 24) THEN
+ CALL SRTM_TAUMOL24 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 25) THEN
+ !--- visible 16000-22650 cm-1 0.4415 - 0.6250 um
+ CALL SRTM_TAUMOL25 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLMOL , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 26) THEN
+ !--- UV-A 22650-29000 cm-1 0.3448 - 0.4415 um
+ CALL SRTM_TAUMOL26 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PCOLMOL ,KLAYTROP,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 27) THEN
+ !--- UV-B 29000-38000 cm-1 0.2632 - 0.3448 um
+ CALL SRTM_TAUMOL27 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLMOL , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 28) THEN
+ !--- UV-C 38000-50000 cm-1 0.2000 - 0.2632 um
+ CALL SRTM_TAUMOL28 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 29) THEN
+ CALL SRTM_TAUMOL29 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP , PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN , ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ENDIF
+
+ DO JG=1,IGT
+ DO IC=1,ICOUNT
+ JL=IND(IC)
+ IW(JL)=IW(JL)+1
+
+ ! Incoming solar flux into plane perp to incoming radiation
+ PINCSOL(JL,IW(JL)) = ZSFLXZEN(JL,JG)
+ ENDDO
+
+ DO JK=1,KLEV
+ DO IC=1,ICOUNT
+ JL=IND(IC)
+ POD (JL,JK,IW(JL)) = ZTAUR(JL,JK,JG) + ZTAUG(JL,JK,JG)
+ PSSA(JL,JK,IW(JL)) = ZTAUR(JL,JK,JG) / POD(JL,JK,IW(JL))
+ ENDDO
+ ENDDO
+
+ ENDDO !-- end loop on JG (g point)
+
+ENDDO !-- end loop on JB (band)
+
+! ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_GAS_OPTICAL_DEPTH',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_GAS_OPTICAL_DEPTH
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_kgb16.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_kgb16.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9ee70e54fe5cd55420c38d585b2e6800f5244cbb
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_kgb16.F90
@@ -0,0 +1,186 @@
+SUBROUTINE SRTM_KGB16(DIRECTORY)
+
+! Originally by J.Delamere, Atmospheric & Environmental Research.
+! Revision: 2.4
+! BAND 16: 2600-3000 cm-1 (low - H2O,CH4; high - nothing)
+! Reformatted for F90 by JJMorcrette, ECMWF
+! R. Elkhatib 12-10-2005 Split for faster and more robust compilation.
+! G.Mozdzynski March 2011 read constants from files
+! T. Wilhelmsson and K. Yessad (Oct 2013) Geometry and setup refactoring.
+! ------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMLUN , ONLY : NULRAD
+USE YOMMP0 , ONLY : NPROC, MYPROC
+USE MPL_MODULE, ONLY : MPL_BROADCAST
+USE YOMTAG , ONLY : MTAGRAD
+USE YOESRTA16 , ONLY : KA, KB, KA_D, KB_D, SELFREF, FORREF, SFLUXREF, RAYL, STRRAT1, LAYREFFR
+
+! ------------------------------------------------------------------
+
+IMPLICIT NONE
+
+CHARACTER(LEN=*), INTENT(IN) :: DIRECTORY
+
+! KURUCZ
+!CHARACTER(LEN = 80) :: CLZZZ
+CHARACTER(LEN = 80) :: CLF1
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+#include "abor1.intfb.h"
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB16',0,ZHOOK_HANDLE)
+
+IF( MYPROC==1 )THEN
+ !CALL GETENV("DATA",CLZZZ)
+ !IF(CLZZZ /= " ") THEN
+ ! CLF1=TRIM(CLZZZ)//"/RADSRTM"
+ CLF1 = DIRECTORY // "/RADSRTM"
+ WRITE(0,'(A,A)') 'Reading ',TRIM(CLF1)
+ ! RRTM and SRTM files from ecrad are in big-endian format.
+ ! Here they are covnerted into little-endian at opening
+ ! No need for compialtion option export GFORTRAN_CONVERT_UNIT="little_endian;big_endian:145"
+! OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",access='sequential',ERR=1000,CONVERT='swap')
+
+ OPEN(NULRAD,FILE=TRIM(CLF1),FORM="UNFORMATTED",ACTION="READ",access='sequential',ERR=1000,CONVERT='BIG_ENDIAN')
+ !ELSE
+ ! OPEN(NULRAD,FILE='RADSRTM',FORM="UNFORMATTED",ACTION="READ",ERR=1000)
+ !ENDIF
+ READ(NULRAD,ERR=1001) KA_D,KB_D
+ KA = REAL(KA_D,JPRB)
+ KB = REAL(KB_D,JPRB)
+ENDIF
+IF( NPROC>1 )THEN
+ CALL MPL_BROADCAST (KA,MTAGRAD,1,CDSTRING='SRTM_KGB16:')
+ CALL MPL_BROADCAST (KB,MTAGRAD,1,CDSTRING='SRTM_KGB16:')
+ENDIF
+
+SFLUXREF = (/ &
+ & 1.92269_JPRB , 1.72844_JPRB , 1.64326_JPRB , 1.58451_JPRB &
+ & , 1.44031_JPRB , 1.25108_JPRB , 1.02724_JPRB , 0.776759_JPRB &
+ & , 0.534444_JPRB , 5.87755E-02_JPRB, 4.86706E-02_JPRB, 3.87989E-02_JPRB &
+ & , 2.84532E-02_JPRB, 1.82431E-02_JPRB, 6.92320E-03_JPRB, 9.70770E-04_JPRB /)
+
+! Rayleigh extinction coefficient at v = 2925 cm-1.
+RAYL = 2.91E-10_JPRB
+
+STRRAT1 = 252.131_JPRB
+
+LAYREFFR = 18
+
+! ------------------------------------------------------------------
+
+! The array KA contains absorption coefs at the 16 chosen g-values
+! for a range of pressure levels> ~100mb, temperatures, and binary
+! species parameters (see taumol.f for definition). The first
+! index in the array, JS, runs from 1 to 9, and corresponds to
+! different values of the binary species parameter. For instance,
+! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8,
+! JS = 3 corresponds to the parameter value 2/8, etc. The second index
+! in the array, JT, which runs from 1 to 5, corresponds to different
+! temperatures. More specifically, JT = 3 means that the data are for
+! the reference temperature TREF for this pressure level, JT = 2 refers
+! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5
+! is for TREF+30. The third index, JP, runs from 1 to 13 and refers
+! to the JPth reference pressure level (see taumol.f for these levels
+! in mb). The fourth index, IG, goes from 1 to 16, and indicates
+! which g-interval the absorption coefficients are for.
+! -----------------------------------------------------------------
+
+! -----------------------------------------------------------------
+! The array KB contains absorption coefs at the 16 chosen g-values
+! for a range of pressure levels < ~100mb and temperatures. The first
+! index in the array, JT, which runs from 1 to 5, corresponds to
+! different temperatures. More specifically, JT = 3 means that the
+! data are for the reference temperature TREF for this pressure
+! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for
+! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30.
+! The second index, JP, runs from 13 to 59 and refers to the JPth
+! reference pressure level (see taumol.f for the value of these
+! pressure levels in mb). The third index, IG, goes from 1 to 16,
+! and tells us which g-interval the absorption coefficients are for.
+! -----------------------------------------------------------------
+
+FORREF(:, 1) = (/ 0.525585E-05_JPRB, 0.527618E-05_JPRB, 0.746929E-04_JPRB /)
+FORREF(:, 2) = (/ 0.794660E-05_JPRB, 0.136902E-04_JPRB, 0.849878E-04_JPRB /)
+FORREF(:, 3) = (/ 0.197099E-04_JPRB, 0.733094E-04_JPRB, 0.121687E-03_JPRB /)
+FORREF(:, 4) = (/ 0.148274E-03_JPRB, 0.169776E-03_JPRB, 0.164848E-03_JPRB /)
+FORREF(:, 5) = (/ 0.230296E-03_JPRB, 0.210384E-03_JPRB, 0.182028E-03_JPRB /)
+FORREF(:, 6) = (/ 0.280575E-03_JPRB, 0.259217E-03_JPRB, 0.196080E-03_JPRB /)
+FORREF(:, 7) = (/ 0.329034E-03_JPRB, 0.291575E-03_JPRB, 0.207044E-03_JPRB /)
+FORREF(:, 8) = (/ 0.349989E-03_JPRB, 0.323471E-03_JPRB, 0.225712E-03_JPRB /)
+FORREF(:, 9) = (/ 0.366097E-03_JPRB, 0.321519E-03_JPRB, 0.253150E-03_JPRB /)
+FORREF(:,10) = (/ 0.383589E-03_JPRB, 0.355314E-03_JPRB, 0.262555E-03_JPRB /)
+FORREF(:,11) = (/ 0.375933E-03_JPRB, 0.372443E-03_JPRB, 0.261313E-03_JPRB /)
+FORREF(:,12) = (/ 0.370652E-03_JPRB, 0.382366E-03_JPRB, 0.250070E-03_JPRB /)
+FORREF(:,13) = (/ 0.375092E-03_JPRB, 0.379542E-03_JPRB, 0.265794E-03_JPRB /)
+FORREF(:,14) = (/ 0.389705E-03_JPRB, 0.384274E-03_JPRB, 0.322135E-03_JPRB /)
+FORREF(:,15) = (/ 0.372084E-03_JPRB, 0.390422E-03_JPRB, 0.370035E-03_JPRB /)
+FORREF(:,16) = (/ 0.437802E-03_JPRB, 0.373406E-03_JPRB, 0.373222E-03_JPRB /)
+
+! -----------------------------------------------------------------
+! The array SELFREF contains the coefficient of the water vapor
+! self-continuum (including the energy term). The first index
+! refers to temperature in 7.2 degree increments. For instance,
+! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
+! etc. The second index runs over the g-channel (1 to 16).
+
+SELFREF(:, 1) = (/ &
+ & 0.126758E-02_JPRB, 0.105253E-02_JPRB, 0.873963E-03_JPRB, 0.725690E-03_JPRB, 0.602573E-03_JPRB, &
+ & 0.500344E-03_JPRB, 0.415458E-03_JPRB, 0.344973E-03_JPRB, 0.286447E-03_JPRB, 0.237849E-03_JPRB /)
+SELFREF(:, 2) = (/ &
+ & 0.144006E-02_JPRB, 0.118514E-02_JPRB, 0.975351E-03_JPRB, 0.802697E-03_JPRB, 0.660606E-03_JPRB, &
+ & 0.543667E-03_JPRB, 0.447429E-03_JPRB, 0.368226E-03_JPRB, 0.303044E-03_JPRB, 0.249400E-03_JPRB /)
+SELFREF(:, 3) = (/ &
+ & 0.294018E-02_JPRB, 0.227428E-02_JPRB, 0.175920E-02_JPRB, 0.136077E-02_JPRB, 0.105258E-02_JPRB, &
+ & 0.814189E-03_JPRB, 0.629789E-03_JPRB, 0.487153E-03_JPRB, 0.376821E-03_JPRB, 0.291478E-03_JPRB /)
+SELFREF(:, 4) = (/ &
+ & 0.395290E-02_JPRB, 0.348405E-02_JPRB, 0.307081E-02_JPRB, 0.270658E-02_JPRB, 0.238556E-02_JPRB, &
+ & 0.210261E-02_JPRB, 0.185322E-02_JPRB, 0.163341E-02_JPRB, 0.143967E-02_JPRB, 0.126891E-02_JPRB /)
+SELFREF(:, 5) = (/ &
+ & 0.419122E-02_JPRB, 0.385638E-02_JPRB, 0.354829E-02_JPRB, 0.326481E-02_JPRB, 0.300398E-02_JPRB, &
+ & 0.276399E-02_JPRB, 0.254317E-02_JPRB, 0.234000E-02_JPRB, 0.215305E-02_JPRB, 0.198104E-02_JPRB /)
+SELFREF(:, 6) = (/ &
+ & 0.495659E-02_JPRB, 0.456777E-02_JPRB, 0.420945E-02_JPRB, 0.387924E-02_JPRB, 0.357494E-02_JPRB, &
+ & 0.329450E-02_JPRB, 0.303606E-02_JPRB, 0.279790E-02_JPRB, 0.257842E-02_JPRB, 0.237615E-02_JPRB /)
+SELFREF(:, 7) = (/ &
+ & 0.526981E-02_JPRB, 0.490687E-02_JPRB, 0.456893E-02_JPRB, 0.425426E-02_JPRB, 0.396126E-02_JPRB, &
+ & 0.368844E-02_JPRB, 0.343441E-02_JPRB, 0.319788E-02_JPRB, 0.297764E-02_JPRB, 0.277256E-02_JPRB /)
+SELFREF(:, 8) = (/ &
+ & 0.575426E-02_JPRB, 0.531597E-02_JPRB, 0.491106E-02_JPRB, 0.453699E-02_JPRB, 0.419141E-02_JPRB, &
+ & 0.387216E-02_JPRB, 0.357722E-02_JPRB, 0.330475E-02_JPRB, 0.305303E-02_JPRB, 0.282048E-02_JPRB /)
+SELFREF(:, 9) = (/ &
+ & 0.549881E-02_JPRB, 0.514328E-02_JPRB, 0.481074E-02_JPRB, 0.449970E-02_JPRB, 0.420877E-02_JPRB, &
+ & 0.393665E-02_JPRB, 0.368213E-02_JPRB, 0.344406E-02_JPRB, 0.322138E-02_JPRB, 0.301310E-02_JPRB /)
+SELFREF(:,10) = (/ &
+ & 0.605357E-02_JPRB, 0.561246E-02_JPRB, 0.520349E-02_JPRB, 0.482432E-02_JPRB, 0.447278E-02_JPRB, &
+ & 0.414686E-02_JPRB, 0.384469E-02_JPRB, 0.356453E-02_JPRB, 0.330479E-02_JPRB, 0.306398E-02_JPRB /)
+SELFREF(:,11) = (/ &
+ & 0.640504E-02_JPRB, 0.587858E-02_JPRB, 0.539540E-02_JPRB, 0.495194E-02_JPRB, 0.454492E-02_JPRB, &
+ & 0.417136E-02_JPRB, 0.382850E-02_JPRB, 0.351382E-02_JPRB, 0.322501E-02_JPRB, 0.295993E-02_JPRB /)
+SELFREF(:,12) = (/ &
+ & 0.677803E-02_JPRB, 0.615625E-02_JPRB, 0.559152E-02_JPRB, 0.507859E-02_JPRB, 0.461271E-02_JPRB, &
+ & 0.418957E-02_JPRB, 0.380524E-02_JPRB, 0.345617E-02_JPRB, 0.313913E-02_JPRB, 0.285116E-02_JPRB /)
+SELFREF(:,13) = (/ &
+ & 0.690347E-02_JPRB, 0.627003E-02_JPRB, 0.569472E-02_JPRB, 0.517219E-02_JPRB, 0.469761E-02_JPRB, &
+ & 0.426658E-02_JPRB, 0.387509E-02_JPRB, 0.351953E-02_JPRB, 0.319659E-02_JPRB, 0.290328E-02_JPRB /)
+SELFREF(:,14) = (/ &
+ & 0.692680E-02_JPRB, 0.632795E-02_JPRB, 0.578087E-02_JPRB, 0.528109E-02_JPRB, 0.482452E-02_JPRB, &
+ & 0.440742E-02_JPRB, 0.402638E-02_JPRB, 0.367828E-02_JPRB, 0.336028E-02_JPRB, 0.306977E-02_JPRB /)
+SELFREF(:,15) = (/ &
+ & 0.754894E-02_JPRB, 0.681481E-02_JPRB, 0.615207E-02_JPRB, 0.555378E-02_JPRB, 0.501367E-02_JPRB, &
+ & 0.452609E-02_JPRB, 0.408593E-02_JPRB, 0.368857E-02_JPRB, 0.332986E-02_JPRB, 0.300603E-02_JPRB /)
+SELFREF(:,16) = (/ &
+ & 0.760689E-02_JPRB, 0.709755E-02_JPRB, 0.662232E-02_JPRB, 0.617891E-02_JPRB, 0.576519E-02_JPRB, &
+ & 0.537917E-02_JPRB, 0.501899E-02_JPRB, 0.468293E-02_JPRB, 0.436938E-02_JPRB, 0.407682E-02_JPRB /)
+
+IF (LHOOK) CALL DR_HOOK('SRTM_KGB16',1,ZHOOK_HANDLE)
+RETURN
+
+1000 CONTINUE
+CALL ABOR1("SRTM_KGB16:ERROR OPENING FILE RADSRTM")
+1001 CONTINUE
+CALL ABOR1("SRTM_KGB16:ERROR READING FILE RADSRTM")
+
+END SUBROUTINE SRTM_KGB16
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_spcvrt_mcica.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_spcvrt_mcica.F90
new file mode 100644
index 0000000000000000000000000000000000000000..98ae7a98649af277c159caf93d7fcf3984ad6bf4
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_spcvrt_mcica.F90
@@ -0,0 +1,699 @@
+#ifdef RS6K
+@PROCESS HOT(NOVECTOR) NOSTRICT
+#endif
+SUBROUTINE SRTM_SPCVRT_MCICA &
+ & ( KIDIA , KFDIA , KLEV , KSW , KCOLS , PONEMINUS, &
+ & PALBD , PALBP, &
+ & PFRCL , PTAUC , PASYC , POMGC , PTAUA , PASYA , POMGA , PRMU0, &
+ & KLAYTROP,&
+ & PCOLCH4 , PCOLCO2 , PCOLH2O , PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & PFORFAC , PFORFRAC , KINDFOR , PSELFFAC, PSELFFRAC, KINDSELF ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ !-- output arrays
+ & PBBFD , PBBFU , PBBCD, PBBCU, PFUVF, PFUVC, PPARF, PPARCF, PSUDU, &
+ & PBBFDIR , PBBCDIR , PSwDiffuseBand , PSwDirectBand )
+
+
+!**** *SRTM_SPCVRT* - SPECTRAL LOOP TO COMPUTE THE SHORTWAVE RADIATION FLUXES.
+
+! PURPOSE.
+! --------
+
+! THIS ROUTINE COMPUTES THE TWO-STREAM METHOD OF BARKER
+
+!** INTERFACE.
+! ----------
+
+! *SRTM_SPCVRT_MCICA* IS CALLED FROM *SRTM_SRTM_224GP*
+
+! IMPLICIT ARGUMENTS :
+! --------------------
+
+! ==== INPUTS ===
+! ==== OUTPUTS ===
+
+! METHOD.
+! -------
+
+! EXTERNALS.
+! ----------
+
+! *SWVRTQDR*
+
+! REFERENCE.
+! ----------
+
+! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
+! DOCUMENTATION
+! AUTHOR.
+! -------
+! from Howard Barker
+! JEAN-JACQUES MORCRETTE *ECMWF*
+
+! MODIFICATIONS.
+! --------------
+! ORIGINAL : 03-02-27
+! M.Hamrud 01-Oct-2003 CY28 Cleaning
+! JJMorcrette 20050110 McICA version
+! JJMorcrette 20070614 bug-fix for solar duration
+! JJMorcrette 20070831 UV-B surface flux
+! D.Salmond 31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+! JJMorcrette/MJIacono 20080724 Look-up table replacing exponential
+! JJMorcrette 20091201 Total and clear-sky downward direct flux
+! RJHogan 20140627 Store downwelling surface fluxes in each band
+! ------------------------------------------------------------------
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE PARSRTM , ONLY : JPB1, JPB2
+USE YOESRTM , ONLY : JPGPT
+USE YOESRTWN , ONLY : NGC, NMPSRTM
+USE YOERDI , ONLY : REPCLC
+USE YOESRTAB , ONLY : BPADE, TRANS, RODLOW, RTBLINT
+USE YOERAD , ONLY : NSW, LApproxSwUpdate
+
+IMPLICIT NONE
+
+! ------------------------------------------------------------------
+
+!* 0.1 ARGUMENTS
+! ---------
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KSW
+INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA, KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+REAL(KIND=JPRB) ,INTENT(IN) :: PONEMINUS(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KIDIA:KFDIA,KSW)
+REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KIDIA:KFDIA,KSW)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFRCL(KIDIA:KFDIA,KCOLS,KLEV) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PTAUC(KIDIA:KFDIA,KLEV,KCOLS) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PASYC(KIDIA:KFDIA,KLEV,KCOLS) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: POMGC(KIDIA:KFDIA,KLEV,KCOLS) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PTAUA(KIDIA:KFDIA,KLEV,KSW) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PASYA(KIDIA:KFDIA,KLEV,KSW) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: POMGA(KIDIA:KFDIA,KLEV,KSW) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KIDIA:KFDIA)
+INTEGER(KIND=JPIM),INTENT(IN) :: KLAYTROP(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCH4(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLMOL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFORFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDFOR(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PSELFFRAC(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KINDSELF(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC00(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC01(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PFAC11(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJP(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM),INTENT(IN) :: KJT1(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFD(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFU(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCD(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCU(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFUVF(KIDIA:KFDIA), PFUVC(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PPARF(KIDIA:KFDIA), PPARCF(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU(KIDIA:KFDIA)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBFDIR(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(INOUT) :: PBBCDIR(KIDIA:KFDIA,KLEV+1)
+
+! Surface diffuse and direct downwelling shortwave flux in each
+! shortwave albedo band, used in RADINTG to update the surface fluxes
+! accounting for high-resolution albedo information
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSwDiffuseBand(KIDIA:KFDIA,NSW)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSwDirectBand(KIDIA:KFDIA,NSW)
+
+! ------------------------------------------------------------------
+
+! ------------
+
+LOGICAL :: LLRTCHK(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB) :: &
+ & ZCLEAR(KIDIA:KFDIA) , ZCLOUD(KIDIA:KFDIA) &
+ & , ZDBT(KIDIA:KFDIA,KLEV+1) &
+ & , ZGCC(KIDIA:KFDIA,KLEV) , ZGCO(KIDIA:KFDIA,KLEV) &
+ & , ZOMCC(KIDIA:KFDIA,KLEV) , ZOMCO(KIDIA:KFDIA,KLEV) &
+ & , ZRDND(KIDIA:KFDIA,KLEV+1), ZRDNDC(KIDIA:KFDIA,KLEV+1)&
+ & , ZREF(KIDIA:KFDIA,KLEV+1) , ZREFC(KIDIA:KFDIA,KLEV+1) , ZREFO(KIDIA:KFDIA,KLEV+1) &
+ & , ZREFD(KIDIA:KFDIA,KLEV+1), ZREFDC(KIDIA:KFDIA,KLEV+1), ZREFDO(KIDIA:KFDIA,KLEV+1) &
+ & , ZRUP(KIDIA:KFDIA,KLEV+1) , ZRUPD(KIDIA:KFDIA,KLEV+1) &
+ & , ZRUPC(KIDIA:KFDIA,KLEV+1), ZRUPDC(KIDIA:KFDIA,KLEV+1)&
+ & , ZTAUC(KIDIA:KFDIA,KLEV) , ZTAUO(KIDIA:KFDIA,KLEV) &
+ & , ZTDBT(KIDIA:KFDIA,KLEV+1) &
+ & , ZTRA(KIDIA:KFDIA,KLEV+1) , ZTRAC(KIDIA:KFDIA,KLEV+1) , ZTRAO(KIDIA:KFDIA,KLEV+1) &
+ & , ZTRAD(KIDIA:KFDIA,KLEV+1), ZTRADC(KIDIA:KFDIA,KLEV+1), ZTRADO(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) :: &
+ & ZDBTC(KIDIA:KFDIA,KLEV+1), ZTDBTC(KIDIA:KFDIA,KLEV+1), ZINCFLX(KIDIA:KFDIA,JPGPT) &
+ & , ZINCF14(KIDIA:KFDIA,14) , ZINCTOT(KIDIA:KFDIA)
+
+INTEGER(KIND=JPIM) :: IB1, IB2, IBM, IGT, IKL, IW(KIDIA:KFDIA), JB, JG, JK, I_KMODTS, JL, IC, ICOUNT
+
+! An index for the 6 bands used in the original albedo data rather
+! than the 14 RRTM bands
+INTEGER(KIND=JPIM) :: JB_ALBEDO
+
+INTEGER(KIND=JPIM) :: INDEX(KIDIA:KFDIA)
+
+REAL(KIND=JPRB) :: ZDBTMC(KIDIA:KFDIA), ZDBTMO(KIDIA:KFDIA), ZF(KIDIA:KFDIA)
+! REAL(KIND=JPRB) :: ZARG1(KIDIA:KFDIA), ZARG2(KIDIA:KFDIA)
+REAL(KIND=JPRB) :: ZINCFLUX(KIDIA:KFDIA), ZWF(KIDIA:KFDIA)
+REAL(KIND=JPRB) :: ZCOEFVS
+
+!-- Output of SRTM_TAUMOLn routines
+
+REAL(KIND=JPRB) :: ZTAUG(KIDIA:KFDIA,KLEV,16), ZTAUR(KIDIA:KFDIA,KLEV,16), ZSFLXZEN(KIDIA:KFDIA,16)
+
+!-- Output of SRTM_VRTQDR routine
+REAL(KIND=JPRB) :: &
+ & ZCD(KIDIA:KFDIA,KLEV+1,JPGPT), ZCU(KIDIA:KFDIA,KLEV+1,JPGPT) &
+ & , ZFD(KIDIA:KFDIA,KLEV+1,JPGPT), ZFU(KIDIA:KFDIA,KLEV+1,JPGPT)
+
+REAL(KIND=JPRB) :: ZTAU, ZPAO, ZPTO
+REAL(KIND=JPRB) :: ZPAOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZPTOJ(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZRMU0D(KIDIA:KFDIA)
+
+!-- Use of exponential look-up table
+REAL(KIND=JPRB) :: ZE1, ZE2, ZTBLIND
+INTEGER(KIND=JPIM) :: ITIND
+
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "srtm_taumol16.intfb.h"
+#include "srtm_taumol17.intfb.h"
+#include "srtm_taumol18.intfb.h"
+#include "srtm_taumol19.intfb.h"
+#include "srtm_taumol20.intfb.h"
+#include "srtm_taumol21.intfb.h"
+#include "srtm_taumol22.intfb.h"
+#include "srtm_taumol23.intfb.h"
+#include "srtm_taumol24.intfb.h"
+#include "srtm_taumol25.intfb.h"
+#include "srtm_taumol26.intfb.h"
+#include "srtm_taumol27.intfb.h"
+#include "srtm_taumol28.intfb.h"
+#include "srtm_taumol29.intfb.h"
+!#include "srtm_reftra.intfb.h"
+!#include "srtm_vrtqdr.intfb.h"
+! ------------------------------------------------------------------
+ASSOCIATE(NFLEVG=>KLEV)
+IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',0,ZHOOK_HANDLE)
+
+!-- Two-stream model 1: Eddington, 2: PIFM, Zdunkowski et al., 3: discrete ordinates
+
+IB1=JPB1
+IB2=JPB2
+
+IC=0
+DO JL = KIDIA, KFDIA
+ IF (PRMU0(JL) > 0.0_JPRB) THEN
+ IC=IC+1
+ INDEX(IC)=JL
+ IW(JL)=0
+ ZINCFLUX(JL)=0.0_JPRB
+ ZINCTOT(JL)=0.0_JPRB
+ PFUVF(JL) = 0.0_JPRB
+ PFUVC(JL) = 0.0_JPRB
+ PPARF(JL) = 0.0_JPRB
+ PPARCF(JL)= 0.0_JPRB
+ ENDIF
+ENDDO
+ICOUNT=IC
+IF(ICOUNT==0)THEN
+ IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+
+! Since the stored shortwave downwelling fluxes in bands are
+! accumulated over the g-points within that band, they need to be
+! initialized here
+IF (LApproxSwUpdate) THEN
+ DO JB_ALBEDO = 1,NSW
+ DO JL = KIDIA, KFDIA
+ PSwDiffuseBand(JL,JB_ALBEDO) = 0.0_JPRB
+ PSwDirectBand (JL,JB_ALBEDO) = 0.0_JPRB
+ ENDDO
+ ENDDO
+ENDIF
+
+
+!-- fraction of visible (to 0.69 um) in interval 0.6250-0.7782 um
+ZCOEFVS = 0.42425_JPRB
+
+JB=IB1-1
+DO JB = IB1, IB2
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IBM = JB-15
+ IGT = NGC(IBM)
+ ZINCF14(JL,IBM)=0.0_JPRB
+ ENDDO
+
+ !-- for each band, computes the gaseous and Rayleigh optical thickness
+ ! for all g-points within the band
+
+ IF (JB == 16) THEN
+ CALL SRTM_TAUMOL16 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC , PSELFFRAC, KINDSELF, PFORFAC , PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 17) THEN
+ CALL SRTM_TAUMOL17 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 18) THEN
+ CALL SRTM_TAUMOL18 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 19) THEN
+ CALL SRTM_TAUMOL19 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 20) THEN
+ CALL SRTM_TAUMOL20 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLCH4 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 21) THEN
+ CALL SRTM_TAUMOL21 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 22) THEN
+ CALL SRTM_TAUMOL22 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLMOL , PCOLO2 ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 23) THEN
+ CALL SRTM_TAUMOL23 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLMOL ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 24) THEN
+ CALL SRTM_TAUMOL24 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLH2O , PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & KLAYTROP, PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 25) THEN
+ !--- visible 16000-22650 cm-1 0.4415 - 0.6250 um
+ CALL SRTM_TAUMOL25 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLMOL , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 26) THEN
+ !--- UV-A 22650-29000 cm-1 0.3448 - 0.4415 um
+ CALL SRTM_TAUMOL26 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PCOLMOL ,KLAYTROP,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 27) THEN
+ !--- UV-B 29000-38000 cm-1 0.2632 - 0.3448 um
+ CALL SRTM_TAUMOL27 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLMOL , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 28) THEN
+ !--- UV-C 38000-50000 cm-1 0.2000 - 0.2632 um
+ CALL SRTM_TAUMOL28 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 , PONEMINUS ,&
+ & PCOLMOL , PCOLO2 , PCOLO3 ,&
+ & KLAYTROP ,&
+ & ZSFLXZEN, ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ELSEIF (JB == 29) THEN
+ CALL SRTM_TAUMOL29 &
+ & ( KIDIA , KFDIA , KLEV ,&
+ & PFAC00 , PFAC01 , PFAC10 , PFAC11 ,&
+ & KJP , KJT , KJT1 ,&
+ & PCOLH2O , PCOLCO2 , PCOLMOL ,&
+ & KLAYTROP , PSELFFAC, PSELFFRAC, KINDSELF , PFORFAC, PFORFRAC, KINDFOR ,&
+ & ZSFLXZEN , ZTAUG , ZTAUR , PRMU0 &
+ & )
+
+ ENDIF
+
+!J---Start---
+ DO JK=1,KLEV
+ IKL=KLEV+1-JK
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZPAOJ(JL,JK) = PASYA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+ ZPTOJ(JL,JK) = PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+ ENDDO
+ ENDDO
+!J---End---
+
+ DO JG=1,IGT
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IW(JL)=IW(JL)+1
+
+ ZINCFLX(JL,IW(JL)) =ZSFLXZEN(JL,JG)*PRMU0(JL)
+ ZINCFLUX(JL) =ZINCFLUX(JL)+ZSFLXZEN(JL,JG)*PRMU0(JL)
+ ZINCTOT(JL) =ZINCTOT(JL)+ZSFLXZEN(JL,JG)
+ ZINCF14(JL,IBM)=ZINCF14(JL,IBM)+ZSFLXZEN(JL,JG)
+
+ !-- CALL to compute layer reflectances and transmittances for direct
+ ! and diffuse sources, first clear then cloudy.
+ ! Use direct/parallel albedo for direct radiation and diffuse albedo
+ ! otherwise.
+
+ ! ZREFC(JK) direct albedo for clear
+ ! ZREFO(JK) direct albedo for cloud
+ ! ZREFDC(JK) diffuse albedo for clear
+ ! ZREFDO(JK) diffuse albedo for cloud
+ ! ZTRAC(JK) direct transmittance for clear
+ ! ZTRAO(JK) direct transmittance for cloudy
+ ! ZTRADC(JK) diffuse transmittance for clear
+ ! ZTRADO(JK) diffuse transmittance for cloudy
+
+ ! ZREF(JK) direct reflectance
+ ! ZREFD(JK) diffuse reflectance
+ ! ZTRA(JK) direct transmittance
+ ! ZTRAD(JK) diffuse transmittance
+
+ ! ZDBTC(JK) clear direct beam transmittance
+ ! ZDBTO(JK) cloudy direct beam transmittance
+ ! ZDBT(JK) layer mean direct beam transmittance
+ ! ZTDBT(JK) total direct beam transmittance at levels
+
+ !-- clear-sky
+ !----- TOA direct beam
+ ZTDBTC(JL,1)=1._JPRB
+ !----- surface values
+ ZDBTC(JL,KLEV+1) =0.0_JPRB
+ ZTRAC(JL,KLEV+1) =0.0_JPRB
+ ZTRADC(JL,KLEV+1)=0.0_JPRB
+ ZREFC(JL,KLEV+1) =PALBP(JL,IBM)
+ ZREFDC(JL,KLEV+1)=PALBD(JL,IBM)
+ ZRUPC(JL,KLEV+1) =PALBP(JL,IBM)
+ ZRUPDC(JL,KLEV+1)=PALBD(JL,IBM)
+
+ !-- total sky
+ !----- TOA direct beam
+ ZTDBT(JL,1)=1._JPRB
+ !----- surface values
+ ZDBT(JL,KLEV+1) =0.0_JPRB
+ ZTRA(JL,KLEV+1) =0.0_JPRB
+ ZTRAD(JL,KLEV+1)=0.0_JPRB
+ ZREF(JL,KLEV+1) =PALBP(JL,IBM)
+ ZREFD(JL,KLEV+1)=PALBD(JL,IBM)
+ ZRUP(JL,KLEV+1) =PALBP(JL,IBM)
+ ZRUPD(JL,KLEV+1)=PALBD(JL,IBM)
+ ENDDO
+
+
+ !-- NB: a two-stream calculations from top to bottom, but RRTM_SW quantities
+ ! are given bottom to top (argh!)
+ ! Inputs for clouds and aerosols are bottom to top as inputs
+
+! DO JK=1,KLEV
+! IKL=KLEV+1-JK
+! WRITE(NULOUT,8001) IBM,JG,IKL,(PTAUA(INDEX(IC),IKL,IBM),IC=1,ICOUNT)
+8001 format(1X,'McICA_SW',3I5,30E12.5)
+! ENDDO
+
+
+
+ DO JK=1,KLEV
+ IKL=KLEV+1-JK
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ !-- clear-sky optical parameters
+ LLRTCHK(JL,JK)=.TRUE.
+ !-- clear-sky optical parameters including aerosols
+!J ZTAUC(JL,JK) = ZTAUR(JL,IKL,JG) + ZTAUG(JL,IKL,JG) + PTAUA(JL,IKL,IBM)
+!J ZOMCC(JL,JK) = ZTAUR(JL,IKL,JG)*1.0_JPRB + PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+!J ZGCC(JL,JK) = PASYA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)*PTAUA(JL,IKL,IBM) / ZOMCC(JL,JK)
+!J ZOMCC(JL,JK) = ZOMCC(JL,JK) / ZTAUC(JL,JK)
+!J ENDDO
+!J ENDDO
+!J DO JK=1,KLEV
+!J IKL=KLEV+1-JK
+!J DO IC=1,ICOUNT
+!J JL=INDEX(IC)
+!J !-- total sky optical parameters
+!J ZTAUO(JL,JK) = ZTAUR(JL,IKL,JG) + ZTAUG(JL,IKL,JG) + PTAUA(JL,IKL,IBM) + PTAUC(JL,IKL,IW(JL))
+!J ZOMCO(JL,JK) = PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM) + PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL)) &
+!J & + ZTAUR(JL,IKL,JG)*1.0_JPRB
+!J ZGCO(JL,JK) = (PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL))*PASYC(JL,IKL,IW(JL)) &
+!J & + PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)*PASYA(JL,IKL,IBM)) &
+!J & / ZOMCO(JL,JK)
+!J ZOMCO(JL,JK) = ZOMCO(JL,JK) / ZTAUO(JL,JK)
+
+ ZTAU = ZTAUR(JL,IKL,JG) + ZTAUG(JL,IKL,JG)
+! ZPAO = PASYA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+! ZPTO = PTAUA(JL,IKL,IBM)*POMGA(JL,IKL,IBM)
+ ZPAO = ZPAOJ(JL,JK)
+ ZPTO = ZPTOJ(JL,JK)
+ ZTAUC(JL,JK) = ZTAU + PTAUA(JL,IKL,IBM)
+ ZOMCC(JL,JK) = ZTAUR(JL,IKL,JG) + ZPTO
+ ZGCC(JL,JK) = ZPAO*PTAUA(JL,IKL,IBM) / ZOMCC(JL,JK)
+ ZOMCC(JL,JK) = ZOMCC(JL,JK) / ZTAUC(JL,JK)
+ !-- total sky optical parameters
+ ZTAUO(JL,JK) = ZTAU + PTAUA(JL,IKL,IBM) + PTAUC(JL,IKL,IW(JL))
+ ZOMCO(JL,JK) = ZPTO + PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL)) + ZTAUR(JL,IKL,JG)
+ ZGCO(JL,JK) = (PTAUC(JL,IKL,IW(JL))*POMGC(JL,IKL,IW(JL))*PASYC(JL,IKL,IW(JL)) &
+ & + PTAUA(JL,IKL,IBM)*ZPAO) / ZOMCO(JL,JK)
+ ZOMCO(JL,JK) = ZOMCO(JL,JK) / ZTAUO(JL,JK)
+ ENDDO
+ ENDDO
+
+ !-- Delta scaling for clear-sky / aerosol optical quantities
+ DO JK=1,KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZF(JL)=ZGCC(JL,JK)*ZGCC(JL,JK)
+ ZWF(JL)=ZOMCC(JL,JK)*ZF(JL)
+ ZTAUC(JL,JK)=(1._JPRB-ZWF(JL))*ZTAUC(JL,JK)
+ ZOMCC(JL,JK)=(ZOMCC(JL,JK)-ZWF(JL))/(1.0_JPRB-ZWF(JL))
+ ZGCC(JL,JK)=(ZGCC(JL,JK)-ZF(JL))/(1.0_JPRB-ZF(JL))
+ ENDDO
+ ENDDO
+
+ CALL SRTM_REFTRA ( KIDIA, KFDIA, KLEV, I_KMODTS ,&
+ & LLRTCHK, ZGCC , PRMU0, ZTAUC , ZOMCC ,&
+ & ZREFC , ZREFDC, ZTRAC, ZTRADC )
+
+ !-- Delta scaling for cloudy quantities
+ DO JK=1,KLEV
+ IKL=KLEV+1-JK
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ LLRTCHK(JL,JK)=.FALSE.
+ ZF(JL)=ZGCO(JL,JK)*ZGCO(JL,JK)
+ ZWF(JL)=ZOMCO(JL,JK)*ZF(JL)
+ ZTAUO(JL,JK)=(1._JPRB-ZWF(JL))*ZTAUO(JL,JK)
+ ZOMCO(JL,JK)=(ZOMCO(JL,JK)-ZWF(JL))/(1._JPRB-ZWF(JL))
+ ZGCO(JL,JK)=(ZGCO(JL,JK)-ZF(JL))/(1._JPRB-ZF(JL))
+ LLRTCHK(JL,JK)=(PFRCL(JL,IW(JL),IKL) > REPCLC)
+ ENDDO
+ ENDDO
+
+ CALL SRTM_REFTRA ( KIDIA, KFDIA, KLEV, I_KMODTS ,&
+ & LLRTCHK, ZGCO , PRMU0, ZTAUO , ZOMCO ,&
+ & ZREFO , ZREFDO, ZTRAO, ZTRADO )
+
+!J---Start---
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZRMU0D(JL)=1.0_JPRB/PRMU0(JL)
+ ENDDO
+!J---End---
+
+ DO JK=1,KLEV
+ IKL=KLEV+1-JK
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ !-- combine clear and cloudy contributions for total sky
+
+ ZCLEAR(JL) = 1.0_JPRB - PFRCL(JL,IW(JL),IKL)
+ ZCLOUD(JL) = PFRCL(JL,IW(JL),IKL)
+
+ ZREF(JL,JK) = ZCLEAR(JL)*ZREFC(JL,JK) + ZCLOUD(JL)*ZREFO(JL,JK)
+ ZREFD(JL,JK)= ZCLEAR(JL)*ZREFDC(JL,JK)+ ZCLOUD(JL)*ZREFDO(JL,JK)
+ ZTRA(JL,JK) = ZCLEAR(JL)*ZTRAC(JL,JK) + ZCLOUD(JL)*ZTRAO(JL,JK)
+ ZTRAD(JL,JK)= ZCLEAR(JL)*ZTRADC(JL,JK)+ ZCLOUD(JL)*ZTRADO(JL,JK)
+
+ !-- direct beam transmittance
+! ZARG1(JL) = MIN( 200._JPRB, ZTAUC(JL,JK)/PRMU0(JL) )
+! ZARG2(JL) = MIN( 200._JPRB, ZTAUO(JL,JK)/PRMU0(JL) )
+! ZDBTMC(JL) = EXP(-ZARG1(JL) )
+! ZDBTMO(JL) = EXP(-ZARG2(JL) )
+
+!-- Use exponential look-up table for transmittance, or expansion of exponential for
+! low optical thickness
+!J ZE1 = ZTAUC(JL,JK)/PRMU0(JL)
+ ZE1 = ZTAUC(JL,JK)*ZRMU0D(JL)
+ IF (ZE1 <= RODLOW) THEN
+ ZDBTMC(JL) = 1._JPRB - ZE1 + 0.5_JPRB*ZE1*ZE1
+ ELSE
+ ZTBLIND = ZE1 / (BPADE+ZE1)
+ ITIND = RTBLINT * ZTBLIND + 0.5_JPRB
+ ZDBTMC(JL) = TRANS(ITIND)
+ ENDIF
+
+!J ZE2 = ZTAUO(JL,JK)/PRMU0(JL)
+ ZE2 = ZTAUO(JL,JK)*ZRMU0D(JL)
+ IF (ZE2 <= RODLOW) THEN
+ ZDBTMO(JL) = 1._JPRB - ZE2 + 0.5_JPRB*ZE2*ZE2
+ ELSE
+ ZTBLIND = ZE2 / (BPADE+ZE2)
+ ITIND = RTBLINT * ZTBLIND + 0.5_JPRB
+ ZDBTMO(JL) = TRANS(ITIND)
+ ENDIF
+!---
+
+ ZDBT(JL,JK) = ZCLEAR(JL)*ZDBTMC(JL)+ZCLOUD(JL)*ZDBTMO(JL)
+ ZTDBT(JL,JK+1)= ZDBT(JL,JK)*ZTDBT(JL,JK)
+
+ !-- clear-sky
+ ZDBTC(JL,JK) =ZDBTMC(JL)
+ ZTDBTC(JL,JK+1)=ZDBTC(JL,JK)*ZTDBTC(JL,JK)
+
+ ENDDO
+ ENDDO
+
+ !-- vertical quadrature producing clear-sky fluxes
+
+ ! print *,'SRTM_SPCVRT after 3 before SRTM_VRTQDR clear'
+
+ CALL SRTM_VRTQDR ( KIDIA, KFDIA, KLEV, IW ,&
+ & ZREFC, ZREFDC, ZTRAC , ZTRADC ,&
+ & ZDBTC, ZRDNDC, ZRUPC , ZRUPDC, ZTDBTC ,&
+ & ZCD , ZCU , PRMU0 )
+
+ !-- vertical quadrature producing cloudy fluxes
+
+ CALL SRTM_VRTQDR ( KIDIA, KFDIA, KLEV, IW ,&
+ & ZREF , ZREFD , ZTRA , ZTRAD ,&
+ & ZDBT , ZRDND , ZRUP , ZRUPD , ZTDBT ,&
+ & ZFD , ZFU , PRMU0)
+
+ !-- up and down-welling fluxes at levels
+ DO JK=1,KLEV+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ !-- accumulation of spectral fluxes
+ PBBFU(JL,JK) = PBBFU(JL,JK) + ZINCFLX(JL,IW(JL))*ZFU(JL,JK,IW(JL))
+ PBBFD(JL,JK) = PBBFD(JL,JK) + ZINCFLX(JL,IW(JL))*ZFD(JL,JK,IW(JL))
+ PBBCU(JL,JK) = PBBCU(JL,JK) + ZINCFLX(JL,IW(JL))*ZCU(JL,JK,IW(JL))
+ PBBCD(JL,JK) = PBBCD(JL,JK) + ZINCFLX(JL,IW(JL))*ZCD(JL,JK,IW(JL))
+
+ PBBFDIR(JL,JK)=PBBFDIR(JL,JK)+ZINCFLX(JL,IW(JL))*ZTDBT (JL,JK)
+ PBBCDIR(JL,JK)=PBBCDIR(JL,JK)+ZINCFLX(JL,IW(JL))*ZTDBTC(JL,JK)
+
+ ENDDO
+ ENDDO
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IF ( JB >= 26 .AND. JB <= 28 ) THEN
+ PFUVF(JL) = PFUVF(JL) + ZINCFLX(JL,IW(JL))*ZFD(JL,KLEV+1,IW(JL))
+ PFUVC(JL) = PFUVC(JL) + ZINCFLX(JL,IW(JL))*ZCD(JL,KLEV+1,IW(JL))
+ ENDIF
+ IF ( JB == 23) THEN
+ PPARF(JL) = PPARF(JL)+ ZINCFLX(JL,IW(JL))*ZFD(JL,KLEV+1,IW(JL))*ZCOEFVS
+ PPARCF(JL)=PPARCF(JL)+ ZINCFLX(JL,IW(JL))*ZCD(JL,KLEV+1,IW(JL))*ZCOEFVS
+ ENDIF
+ IF ( JB == 24) THEN
+ PPARF(JL) = PPARF(JL)+ ZINCFLX(JL,IW(JL))*ZFD(JL,KLEV+1,IW(JL))
+ PPARCF(JL)=PPARCF(JL)+ ZINCFLX(JL,IW(JL))*ZCD(JL,KLEV+1,IW(JL))
+ ENDIF
+ PSUDU(JL) = PSUDU(JL) + ZINCFLX(JL,IW(JL))*ZTDBT(JL,KLEV+1)
+ ENDDO
+
+ ! Store the shortwave downwelling fluxes in each band
+ IF (LApproxSwUpdate) THEN
+ JB_ALBEDO = NMPSRTM(JB-IB1+1)
+ DO IC = 1,ICOUNT
+ JL = INDEX(IC)
+ PSwDiffuseBand(JL,JB_ALBEDO)= PSwDiffuseBand(JL,JB_ALBEDO) &
+ & + ZINCFLX(JL,IW(JL)) * (ZFD(JL, KLEV+1, IW(JL))-ZTDBT(JL,KLEV+1))
+ PSwDirectBand(JL,JB_ALBEDO) = PSwDirectBand(JL,JB_ALBEDO) &
+ & + ZINCFLX(JL,IW(JL)) * ZTDBT(JL,KLEV+1)
+ ENDDO
+ ENDIF
+
+ ENDDO
+ !-- end loop on JG
+
+ENDDO
+!-- end loop on JB
+
+! ------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_SPCVRT_MCICA',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_SPCVRT_MCICA
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_srtm_224gp_mcica.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_srtm_224gp_mcica.F90
new file mode 100644
index 0000000000000000000000000000000000000000..31b4565b4f4292440826e58346811d36ef11c9e9
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/ifsrrtm/srtm_srtm_224gp_mcica.F90
@@ -0,0 +1,463 @@
+SUBROUTINE SRTM_SRTM_224GP_MCICA &
+ & ( KIDIA, KFDIA, KLON , KLEV , KSW , KCOLS , KCLDLY ,&
+ & PAER , PALBD, PALBP, PAPH , PAP , PAERTAUS, PAERASYS, PAEROMGS ,&
+ & PTS , PTH , PT ,&
+ & PQ , PCO2 , PCH4 , PN2O , PNO2 , POZN , PRMU0 ,&
+ & PFRCL, PTAUC, PASYC, POMGC,&
+ & PFSUX, PFSUC, PFUVF, PFUVC, PPARF, PPARCF, PSUDU ,&
+ & PFDIR, PCDIR, PFDIF, PCDIF, PSwDiffuseBand, PSwDirectBand, RII0)
+
+!----compiled for Cray with -h nopaattern----
+
+!-- interface to RRTM_SW
+! JJMorcrette 030225
+! JJMorcrette 20050110 McICA version
+! JJMorcrette 20070614 bug-fix for solar duration
+! JJMorcrette 20071015 3D fields of CO2, CH4, N2O and NO2
+! D.Salmond 31-Oct-2007 Vector version in the style of RRTM from Meteo France & NEC
+! JJMorcrette 20091201 Total and clear-sky downward direct flux
+! PBechtold+NSemane 09-Jul-2012 Gravity
+! R J Hogan 20140627 Passing through PSwDn*SurfBand
+
+USE PARKIND1 , ONLY : JPIM, JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+USE YOMCST , ONLY : RG, RI0
+USE YOERAD , ONLY : NSW, NAER, LApproxSwUpdate
+USE YOESRTAER, ONLY : RSRTAUA, RSRPIZA, RSRASYA
+USE YOEAERATM, ONLY : LAERRRTM, LAERCSTR, LAERVOL
+!USE YOMPHY3 , ONLY : RII0
+USE YOMDYNCORE,ONLY : RPLRG
+USE YOM_YGFL , ONLY : YGFL
+
+IMPLICIT NONE
+
+!-- Input arguments
+
+INTEGER(KIND=JPIM),INTENT(IN) :: KLON
+INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
+INTEGER(KIND=JPIM),INTENT(IN) :: KSW
+INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
+INTEGER(KIND=JPIM),INTENT(IN) :: KCOLS
+INTEGER(KIND=JPIM),INTENT(IN) :: KCLDLY(KCOLS)
+
+REAL(KIND=JPRB) ,INTENT(IN) :: PAER(KLON,6,KLEV) ! top to bottom
+REAL(KIND=JPRB) ,INTENT(IN) :: PAERTAUS(KLON,KLEV,14), PAERASYS(KLON,KLEV,14), PAEROMGS(KLON,KLEV,14)
+REAL(KIND=JPRB) ,INTENT(IN) :: PALBD(KLON,KSW)
+REAL(KIND=JPRB) ,INTENT(IN) :: PALBP(KLON,KSW)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAPH(KLON,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(IN) :: PAP(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTS(KLON)
+REAL(KIND=JPRB) ,INTENT(IN) :: PTH(KLON,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(IN) :: PT(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PQ(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PCO2(KLON,KLEV), PCH4(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PN2O(KLON,KLEV), PNO2(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: POZN(KLON,KLEV)
+REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON)
+
+REAL(KIND=JPRB) ,INTENT(IN) :: PFRCL(KLON,KCOLS,KLEV) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PTAUC(KLON,KCOLS,KLEV) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: PASYC(KLON,KCOLS,KLEV) ! bottom to top
+REAL(KIND=JPRB) ,INTENT(IN) :: POMGC(KLON,KCOLS,KLEV) ! bottom to top
+
+!-- Output arguments
+
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUX(KLON,2,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFSUC(KLON,2,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFUVF(KLON), PFUVC(KLON), PPARF(KLON), PPARCF(KLON)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSUDU(KLON)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFDIF(KLON,KLEV+1), PCDIF(KLON,KLEV+1)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PFDIR(KLON,KLEV+1), PCDIR(KLON,KLEV+1)
+
+! Surface diffuse and direct downwelling shortwave flux in each
+! shortwave albedo band, used in RADINTG to update the surface fluxes
+! accounting for high-resolution albedo information
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSwDiffuseBand(KLON,NSW)
+REAL(KIND=JPRB) ,INTENT(OUT) :: PSwDirectBand (KLON,NSW)
+
+REAL(KIND=JPRB) ,INTENT(IN) :: RII0
+!-----------------------------------------------------------------------
+
+!-- dummy integers
+
+INTEGER(KIND=JPIM) :: ICLDATM, INFLAG, ICEFLAG, I_LIQFLAG, ITMOL, I_NSTR
+
+INTEGER(KIND=JPIM) :: IK, IMOL, J1, J2, JAE, JL, JK, JSW, JB
+
+!-- dummy reals
+
+REAL(KIND=JPRB) :: ZPZ(KIDIA:KFDIA,0:KLEV) , ZPAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZTAVEL(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLDRY(KIDIA:KFDIA,KLEV) , ZCOLMOL(KIDIA:KFDIA,KLEV) , ZWKL(KIDIA:KFDIA,35,KLEV)
+REAL(KIND=JPRB) :: ZCOLCH4(KIDIA:KFDIA,KLEV) , ZCOLCO2(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLH2O(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZCOLO2(KIDIA:KFDIA,KLEV) , ZCOLO3(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFORFAC(KIDIA:KFDIA,KLEV) , ZFORFRAC(KIDIA:KFDIA,KLEV), ZSELFFAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZSELFFRAC(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC00(KIDIA:KFDIA,KLEV) , ZFAC01(KIDIA:KFDIA,KLEV) , ZFAC10(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZFAC11(KIDIA:KFDIA,KLEV)
+REAL(KIND=JPRB) :: ZONEMINUS(KIDIA:KFDIA) , ZRMU0(KIDIA:KFDIA) , ZADJI0
+REAL(KIND=JPRB) :: ZALBD(KIDIA:KFDIA,KSW) , ZALBP(KIDIA:KFDIA,KSW)
+
+REAL(KIND=JPRB) :: ZFRCL(KIDIA:KFDIA,KCOLS,KLEV), ZTAUC(KIDIA:KFDIA,KLEV,KCOLS), &
+ & ZASYC(KIDIA:KFDIA,KLEV,KCOLS)
+REAL(KIND=JPRB) :: ZOMGC(KIDIA:KFDIA,KLEV,KCOLS)
+REAL(KIND=JPRB) :: ZTAUA(KIDIA:KFDIA,KLEV,KSW), ZASYA(KIDIA:KFDIA,KLEV,KSW), ZOMGA(KIDIA:KFDIA,KLEV,KSW)
+REAL(KIND=JPRB) :: ZFUVF(KIDIA:KFDIA), ZFUVC(KIDIA:KFDIA), ZPARF(KIDIA:KFDIA), ZPARCF(KIDIA:KFDIA), ZSUDU(KIDIA:KFDIA)
+
+REAL(KIND=JPRB) :: ZBBCD(KIDIA:KFDIA,KLEV+1), ZBBCU(KIDIA:KFDIA,KLEV+1), ZBBFD(KIDIA:KFDIA,KLEV+1), &
+ & ZBBFU(KIDIA:KFDIA,KLEV+1)
+REAL(KIND=JPRB) :: ZBBFDIR(KIDIA:KFDIA,KLEV+1),ZBBCDIR(KIDIA:KFDIA,KLEV+1)
+
+! As PSw*Band but dimensioned KIDIA:KFDIA
+REAL(KIND=JPRB) :: ZSwDiffuseBand(KIDIA:KFDIA,NSW)
+REAL(KIND=JPRB) :: ZSwDirectBand (KIDIA:KFDIA,NSW)
+
+INTEGER(KIND=JPIM) :: ILAYTROP(KIDIA:KFDIA)
+INTEGER(KIND=JPIM) :: INDFOR(KIDIA:KFDIA,KLEV), INDSELF(KIDIA:KFDIA,KLEV)
+INTEGER(KIND=JPIM) :: JP(KIDIA:KFDIA,KLEV), JT(KIDIA:KFDIA,KLEV), JT1(KIDIA:KFDIA,KLEV)
+
+REAL(KIND=JPRB) :: ZAMD ! Effective molecular weight of dry air (g/mol)
+REAL(KIND=JPRB) :: ZAMW ! Molecular weight of water vapor (g/mol)
+REAL(KIND=JPRB) :: ZAMCO2 ! Molecular weight of carbon dioxide (g/mol)
+REAL(KIND=JPRB) :: ZAMO ! Molecular weight of ozone (g/mol)
+REAL(KIND=JPRB) :: ZAMCH4 ! Molecular weight of methane (g/mol)
+REAL(KIND=JPRB) :: ZAMN2O ! Molecular weight of nitrous oxide (g/mol)
+REAL(KIND=JPRB) :: ZAMC11 ! Molecular weight of CFC11 (g/mol) - CFCL3
+REAL(KIND=JPRB) :: ZAMC12 ! Molecular weight of CFC12 (g/mol) - CF2CL2
+REAL(KIND=JPRB) :: ZAVGDRO ! Avogadro's number (molecules/mole)
+REAL(KIND=JPRB) :: ZGRAVIT ! Gravitational acceleration (cm/sec2)
+REAL(KIND=JPRB) :: ZAMM(KIDIA:KFDIA)
+
+REAL(KIND=JPRB) :: ZRAMW ! Molecular weight of water vapor (g/mol)
+REAL(KIND=JPRB) :: ZRAMCO2 ! Molecular weight of carbon dioxide (g/mol)
+REAL(KIND=JPRB) :: ZRAMO ! Molecular weight of ozone (g/mol)
+REAL(KIND=JPRB) :: ZRAMCH4 ! Molecular weight of methane (g/mol)
+REAL(KIND=JPRB) :: ZRAMN2O ! Molecular weight of nitrous oxide (g/mol)
+
+! Atomic weights for conversion from mass to volume mixing ratios; these
+! are the same values used in ECRT to assure accurate conversion to vmr
+data ZAMD / 28.970_JPRB /
+data ZAMW / 18.0154_JPRB /
+data ZAMCO2 / 44.011_JPRB /
+data ZAMO / 47.9982_JPRB /
+data ZAMCH4 / 16.043_JPRB /
+data ZAMN2O / 44.013_JPRB /
+data ZAMC11 / 137.3686_JPRB /
+data ZAMC12 / 120.9140_JPRB /
+data ZAVGDRO/ 6.02214E23_JPRB /
+data ZRAMW / 0.05550_JPRB /
+data ZRAMCO2 / 0.02272_JPRB /
+data ZRAMO / 0.02083_JPRB /
+data ZRAMCH4 / 0.06233_JPRB /
+data ZRAMN2O / 0.02272_JPRB /
+
+
+!REAL(KIND=JPRB) :: ZCLEAR, ZCLOUD, ZTOTCC
+REAL(KIND=JPRB) :: ZEPSEC
+
+INTEGER(KIND=JPIM) :: IOVLP, IC, ICOUNT, INDEX(KIDIA:KFDIA)
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+
+#include "srtm_setcoef.intfb.h"
+!#include "srtm_spcvrt_mcica.intfb.h"
+
+
+!-----------------------------------------------------------------------
+!-- calculate information needed ny the radiative transfer routine
+
+ASSOCIATE(NFLEVG=>KLEV, &
+ & NACTAERO=>YGFL%NACTAERO)
+IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',0,ZHOOK_HANDLE)
+ZGRAVIT =(RG/RPLRG)*1.E2_JPRB
+ZEPSEC = 1.E-06_JPRB
+ZONEMINUS=1.0_JPRB - ZEPSEC
+ZADJI0 = RII0 / RI0
+!-- overlap: 1=max-ran, 2=maximum, 3=random N.B.: irrelevant in McICA version
+IOVLP=3
+
+IC=0
+DO JL = KIDIA, KFDIA
+ IF (PRMU0(JL) > 0.0_JPRB) THEN
+ IC=IC+1
+ INDEX(IC)=JL
+ ENDIF
+ENDDO
+ICOUNT=IC
+
+ICLDATM = 1
+INFLAG = 2
+ICEFLAG = 3
+I_LIQFLAG= 1
+ITMOL = 7
+I_NSTR = 2
+
+DO JSW=1,KCOLS
+ DO JK=1,KLEV
+ DO JL = KIDIA, KFDIA
+ ZFRCL(JL,JSW,JK) = PFRCL(JL,JSW,JK)
+ ZTAUC(JL,JK,JSW) = PTAUC(JL,JSW,JK)
+ ZASYC(JL,JK,JSW) = PASYC(JL,JSW,JK)
+ ZOMGC(JL,JK,JSW) = POMGC(JL,JSW,JK)
+ ENDDO
+ ENDDO
+ENDDO
+
+ZRMU0(KIDIA:KFDIA)=PRMU0(KIDIA:KFDIA)
+PFUVF(KIDIA:KFDIA)=0._JPRB
+PFUVC(KIDIA:KFDIA)=0._JPRB
+PPARF(KIDIA:KFDIA)=0._JPRB
+PPARCF(KIDIA:KFDIA)=0._JPRB
+
+!- coefficients related to the cloud optical properties (original RRTM_SW)
+
+!- coefficients for the temperature and pressure dependence of the
+! molecular absorption coefficients
+
+DO J1=1,35
+ DO J2=1,KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZWKL(JL,J1,J2)=0.0_JPRB
+ ENDDO
+ ENDDO
+ENDDO
+
+DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZPZ(JL,0) = paph(JL,klev+1)*0.01_JPRB
+ENDDO
+
+!ZCLEAR=1.0_JPRB
+!ZCLOUD=0.0_JPRB
+!ZTOTCC=0.0_JPRB
+
+DO JK = 1, KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZPAVEL(JL,JK) = pap(JL,KLEV-JK+1) *0.01_JPRB
+ ZTAVEL(JL,JK) = pt (JL,KLEV-JK+1)
+ ZPZ(JL,JK) = paph(JL,KLEV-JK+1) *0.01_JPRB
+ ZWKL(JL,1,JK) = pq(JL,KLEV-JK+1) *ZAMD*ZRAMW
+ ZWKL(JL,2,JK) = PCO2(JL,KLEV-JK+1)*ZAMD*ZRAMCO2
+ ZWKL(JL,3,JK) = pozn(JL,KLEV-JK+1)*ZAMD*ZRAMO
+ ZWKL(JL,4,JK) = PN2O(JL,KLEV-JK+1)*ZAMD*ZRAMN2O
+ ZWKL(JL,6,JK) = PCH4(JL,KLEV-JK+1)*ZAMD*ZRAMCH4
+!O2 volume mixing ratio
+ ZWKL(JL,7,JK) = 0.20944_JPRB
+ ZAMM(JL) = (1-ZWKL(JL,1,JK))*ZAMD + ZWKL(JL,1,JK)*ZAMW
+ ZCOLDRY(JL,JK) = (ZPZ(JL,JK-1)-ZPZ(JL,JK))*1.E3_JPRB*ZAVGDRO/(ZGRAVIT*ZAMM(JL)*(1+ZWKL(JL,1,JK)))
+ ENDDO
+ENDDO
+
+DO IMOL=1,ITMOL
+ DO JK=1,KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZWKL(JL,IMOL,JK)=ZCOLDRY(JL,JK)* ZWKL(JL,IMOL,JK)
+ ENDDO
+ ENDDO
+ENDDO
+
+CALL SRTM_SETCOEF &
+ & ( KIDIA , KFDIA , KLEV,&
+ & ZPAVEL , ZTAVEL,&
+ & ZCOLDRY , ZWKL,&
+ & ILAYTROP,&
+ & ZCOLCH4 , ZCOLCO2 , ZCOLH2O , ZCOLMOL , ZCOLO2 , ZCOLO3,&
+ & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF, &
+ & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11,&
+ & JP , JT , JT1 , ZRMU0 &
+ & )
+
+!- call the radiation transfer routine
+
+DO JSW=1,KSW
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZALBD(JL,JSW)=PALBD(JL,JSW)
+ ZALBP(JL,JSW)=PALBP(JL,JSW)
+ ENDDO
+ENDDO
+
+!- mixing of aerosols
+
+IF (NAER == 0) THEN
+ DO JSW=1,KSW
+ DO JK=1,KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZTAUA(JL,JK,JSW)= 0.0_JPRB
+ ZASYA(JL,JK,JSW)= 0.0_JPRB
+ ZOMGA(JL,JK,JSW)= 1.0_JPRB
+ ENDDO
+ ENDDO
+ ENDDO
+ELSE
+
+!- If prognostic aerosols with proper RRTM optical properties, fill the RRTM aerosol arrays
+
+ IF (LAERRRTM) THEN
+ IF (LAERCSTR .OR. (LAERVOL .AND. NACTAERO == 15)) THEN
+ DO JSW=1,KSW
+ DO JK=1,KLEV
+ IK=KLEV-JK+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZTAUA(JL,JK,JSW)=PAERTAUS(JL,IK,JSW)
+ ZASYA(JL,JK,JSW)=PAERASYS(JL,IK,JSW)
+ ZOMGA(JL,JK,JSW)=PAEROMGS(JL,IK,JSW)
+ ENDDO
+ ENDDO
+ ENDDO
+
+ ELSEIF (.NOT.LAERCSTR) THEN
+ DO JSW=1,KSW
+ DO JK=1,KLEV
+ IK=KLEV-JK+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZTAUA(JL,JK,JSW)=PAERTAUS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)
+ ZASYA(JL,JK,JSW)=PAERASYS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)*RSRPIZA(JSW,6)
+ ZOMGA(JL,JK,JSW)=PAEROMGS(JL,IK,JSW)+RSRTAUA(JSW,6)*PAER(JL,6,IK)*RSRPIZA(JSW,6)*RSRASYA(JSW,6)
+ IF (ZOMGA(JL,JK,JSW) /= 0.0_JPRB) THEN
+ ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)/ZOMGA(JL,JK,JSW)
+ ENDIF
+ IF (ZTAUA(JL,JK,JSW) /= 0.0_JPRB) THEN
+ ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)/ZTAUA(JL,JK,JSW)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+
+ ELSE
+
+!- Otherwise, fill RRTM aerosol arrays with operational ECMWF aerosols,
+! do the mixing and distribute over the 14 spectral intervals
+
+ DO JSW=1,KSW
+ DO JK=1,KLEV
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IK=KLEV+1-JK
+ ZTAUA(JL,JK,JSW)=0.0_JPRB
+ ZASYA(JL,JK,JSW)=0.0_JPRB
+ ZOMGA(JL,JK,JSW)=0.0_JPRB
+!CDIR UNROLL=6
+ DO JAE=1,6
+ ZTAUA(JL,JK,JSW)=ZTAUA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK)
+ ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
+ & *RSRPIZA(JSW,JAE)
+ ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)+RSRTAUA(JSW,JAE)*PAER(JL,JAE,IK) &
+ & *RSRPIZA(JSW,JAE)*RSRASYA(JSW,JAE)
+ ENDDO
+ IF (ZOMGA(JL,JK,JSW) /= 0.0_JPRB) THEN
+ ZASYA(JL,JK,JSW)=ZASYA(JL,JK,JSW)/ZOMGA(JL,JK,JSW)
+ ENDIF
+ IF (ZTAUA(JL,JK,JSW) /= 0.0_JPRB) THEN
+ ZOMGA(JL,JK,JSW)=ZOMGA(JL,JK,JSW)/ZTAUA(JL,JK,JSW)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDIF
+ENDIF
+
+DO JK=1,KLEV+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZBBCU(JL,JK)=0.0_JPRB
+ ZBBCD(JL,JK)=0.0_JPRB
+ ZBBFU(JL,JK)=0.0_JPRB
+ ZBBFD(JL,JK)=0.0_JPRB
+ ZBBFDIR(JL,JK)=0.0_JPRB
+ ZBBCDIR(JL,JK)=0.0_JPRB
+ ENDDO
+ENDDO
+
+DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ ZFUVF(JL)=0.0_JPRB
+ ZFUVC(JL)=0.0_JPRB
+ ZPARF(JL)=0.0_JPRB
+ ZPARCF(JL)=0.0_JPRB
+ ZSUDU(JL)=0.0_JPRB
+ENDDO
+
+CALL SRTM_SPCVRT_MCICA &
+ &( KIDIA , KFDIA , KLEV , KSW , KCOLS , ZONEMINUS,&
+ & ZALBD , ZALBP,&
+ & ZFRCL , ZTAUC , ZASYC , ZOMGC ,&
+ & ZTAUA , ZASYA , ZOMGA , ZRMU0,&
+ & ILAYTROP,&
+ & ZCOLCH4 , ZCOLCO2 , ZCOLH2O, ZCOLMOL , ZCOLO2 , ZCOLO3,&
+ & ZFORFAC , ZFORFRAC , INDFOR , ZSELFFAC, ZSELFFRAC, INDSELF,&
+ & ZFAC00 , ZFAC01 , ZFAC10 , ZFAC11 ,&
+ & JP , JT , JT1 ,&
+ & ZBBFD , ZBBFU , ZBBCD , ZBBCU , ZFUVF , ZFUVC, ZPARF, ZPARCF, ZSUDU,&
+ & ZBBFDIR , ZBBCDIR , ZSwDiffuseBand, ZSwDirectBand)
+
+DO JK=1,KLEV+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ PFSUC(JL,1,JK)=ZADJI0 * ZBBCU(JL,JK)
+ PFSUC(JL,2,JK)=ZADJI0 * ZBBCD(JL,JK)
+ PFSUX(JL,1,JK)=ZADJI0 * ZBBFU(JL,JK)
+ PFSUX(JL,2,JK)=ZADJI0 * ZBBFD(JL,JK)
+ PFDIR(JL,JK) =ZADJI0 * ZBBFDIR(JL,JK)
+ PCDIR(JL,JK) =ZADJI0 * ZBBCDIR(JL,JK)
+ PFDIF(JL,JK) =PFSUX(JL,2,JK)-PFDIR(JL,JK)
+ PCDIF(JL,JK) =PFSUC(JL,2,JK)-PCDIR(JL,JK)
+ ENDDO
+ENDDO
+
+IF (LApproxSwUpdate) THEN
+ DO JB=1,NSW
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ PSwDiffuseBand(JL,JB) = ZADJI0 * ZSwDiffuseBand(JL,JB)
+ PSwDirectBand (JL,JB) = ZADJI0 * ZSwDirectBand (JL,JB)
+ ENDDO
+ ENDDO
+ENDIF
+
+DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ PFUVF(JL) =ZADJI0 * ZFUVF(JL)
+ PFUVC(JL) =ZADJI0 * ZFUVC(JL)
+ PPARF(JL) =ZADJI0 * ZPARF(JL)
+ PPARCF(JL)=ZADJI0 * ZPARCF(JL)
+ PSUDU(JL) =ZADJI0 * ZSUDU(JL)
+ENDDO
+
+DO JK=1,KLEV+1
+ DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IF (PRMU0(JL) <= 0.0_JPRB) THEN
+ PFSUC(JL,1,JK)=0.0_JPRB
+ PFSUC(JL,2,JK)=0.0_JPRB
+ PFSUX(JL,1,JK)=0.0_JPRB
+ PFSUX(JL,2,JK)=0.0_JPRB
+ PFDIR(JL,JK) =0.0_JPRB
+ PCDIR(JL,JK) =0.0_JPRB
+ ENDIF
+ ENDDO
+ENDDO
+DO IC=1,ICOUNT
+ JL=INDEX(IC)
+ IF (PRMU0(JL) <= 0.0_JPRB) THEN
+ PFUVF(JL) =0.0_JPRB
+ PFUVC(JL) =0.0_JPRB
+ PPARF(JL) =0.0_JPRB
+ PPARCF(JL)=0.0_JPRB
+ PSUDU(JL)=0.0_JPRB
+ ENDIF
+ENDDO
+
+!-----------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('SRTM_SRTM_224GP_MCICA',1,ZHOOK_HANDLE)
+END ASSOCIATE
+END SUBROUTINE SRTM_SRTM_224GP_MCICA
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_3d_vegetation.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_3d_vegetation.F90
new file mode 100644
index 0000000000000000000000000000000000000000..1b7f1e0f736475b2ea47ab10d093ce1cecb7ea77
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_3d_vegetation.F90
@@ -0,0 +1,74 @@
+! radsurf_3d_vegetation.f90 - Compute radiative transfer in 3D vegetation canopy
+!
+! (C) Copyright 2018- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author: Robin Hogan
+! Email: r.j.hogan@ecmwf.int
+!
+
+module radsurf_3d_vegetation
+
+contains
+ subroutine calc_boundary_conditions_sw(config, n_albedo_bands, tile_fraction, &
+ & canopy_depth, vegetation_optical_depth, vegetation_albedo, &
+ & vegetation_fraction, vegetation_normalized_perimeter, &
+ & ground_albedo_diffuse, ground_albedo_direct, &
+ & ref_dif, tra_dif, ref_dir, tra_dir_dif, tra_dir_dir, &
+ & albedo_diffuse_reg, albedo_direct_reg, &
+ & albedo_diffuse_out, albedo_direct_out, &
+ & ext_air, ssa_air, g_air)
+
+ use parkind1, only : jprb
+ use radiation_config, only : config_type
+
+ implicit none
+
+ ! Number of regions
+ integer, parameter :: nreg = 2
+
+ type(config_type), intent(in) :: config
+
+ integer, intent(in) :: n_albedo_bands
+
+ ! Fraction of gridbox occupied by this tile
+ real(kind=jprb), intent(in) :: tile_fraction
+
+ ! Depth of vegetation canopy in metres
+ real(kind=jprb), intent(in) :: canopy_depth
+
+ ! Optical properties of vegetation
+ real(kind=jprb), intent(in) :: vegetation_optical_depth
+ real(kind=jprb), intent(in) :: vegetation_albedo(:) ! Spectral interval
+
+ ! Optical properties of the ground (function of spectral interval)
+ real(kind=jprb), intent(in) :: ground_albedo_diffuse(:)
+ real(kind=jprb), intent(in) :: ground_albedo_direct(:)
+
+ ! Geometric properties
+ real(kind=jprb), intent(in) :: vegetation_fraction
+ real(kind=jprb), intent(in) :: vegetation_normalized_perimeter ! m-1
+
+
+ ! Intermediate properties to store
+ real(kind=jprb), intent(in), dimension(n_albedo_bands,nreg,nreg) :: ref_dif, ref_dir, tra_dif, tra_dir_dif, tra_dir_dir
+
+ ! Outputs
+ real(kind=jprb), intent(inout) :: albedo_diffuse_reg, albedo_direct_reg, albedo_diffuse_out, albedo_direct_out
+
+ real(kind=jprb), intent(inout) :: ext_air, ssa_air, g_air
+
+ end subroutine calc_boundary_conditions_sw
+
+ subroutine calc_boundary_conditions_lw
+
+ end subroutine calc_boundary_conditions_lw
+
+
+end module radsurf_3d_vegetation
diff --git a/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_homogeneous_vegetation.F90 b/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_homogeneous_vegetation.F90
new file mode 100644
index 0000000000000000000000000000000000000000..bad0a7da95e87256ff2c634651ef1a0571d4db18
--- /dev/null
+++ b/src/LIB/RAD/ecrad-1.4.0_mnh/radsurf/radsurf_homogeneous_vegetation.F90
@@ -0,0 +1,66 @@
+! radsurf_homogeneous_vegetation.f90 - Compute radiative transfer in homogeneous vegetation canopy
+!
+! (C) Copyright 2018- ECMWF.
+!
+! This software is licensed under the terms of the Apache Licence Version 2.0
+! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
+!
+! In applying this licence, ECMWF does not waive the privileges and immunities
+! granted to it by virtue of its status as an intergovernmental organisation
+! nor does it submit to any jurisdiction.
+!
+! Author: Robin Hogan
+! Email: r.j.hogan@ecmwf.int
+!
+
+module radsurf_homogeneous_vegetation
+
+contains
+ subroutine calc_boundary_conditions_sw(config, tile_fraction, &
+ & canopy_depth, vegetation_optical_depth, vegetation_albedo, &
+ & ground_albedo_diffuse, ground_albedo_direct, &
+ & ref_dif, tra_dif, ref_dir, tra_dir_dif, tra_dir_dir, &
+ & albedo_diffuse_reg, albedo_direct_reg, &
+ & albedo_diffuse_out, albedo_direct_out, &
+ & ext_air, ssa_air, g_air)
+
+ use parkind1, only :jprb
+ use radiation_config, only : config_type
+
+ implicit none
+
+ ! Number of regions
+ integer, parameter :: nreg = 2
+
+ type(config_type), intent(in) :: config
+
+ ! Fraction of gridbox occupied by this tile
+ real(kind=jprb), intent(in) :: tile_fraction
+
+ ! Depth of vegetation canopy in metres
+ real(kind=jprb), intent(in) :: canopy_depth
+
+ ! Optical properties of vegetation
+ real(kind=jprb), intent(in) :: vegetation_optical_depth
+ real(kind=jprb), intent(in) :: vegetation_albedo(:) ! Spectral interval
+
+ ! Optical properties of the ground (function of spectral interval)
+ real(kind=jprb), intent(in) :: ground_albedo_diffuse(:)
+ real(kind=jprb), intent(in) :: ground_albedo_direct(:)
+
+ ! Intermediate properties to store
+ real(kind=jprb), intent(in), dimension(nreg,nreg) :: ref_dif, ref_dir, tra_dif, tra_dir_dif, tra_dir_dir
+
+ ! Outputs
+ real(kind=jprb), intent(inout) :: albedo_diffuse_reg, albedo_direct_reg, albedo_diffuse_out, albedo_direct_out
+
+ real(kind=jprb), intent(inout) :: ext_air, ssa_air, g_air
+
+ end subroutine calc_boundary_conditions_sw
+
+ subroutine calc_boundary_conditions_lw
+
+ end subroutine calc_boundary_conditions_lw
+
+
+end module radsurf_homogeneous_vegetation
diff --git a/src/LIB/SURCOUCHE/src/modd_argslist_ll.f90 b/src/LIB/SURCOUCHE/src/modd_argslist_ll.f90
index f21707ecc22db75778043e6484f0f0b23911fd5b..5eafaed2757a253dc6171b6c287df64b80f1ee17 100644
--- a/src/LIB/SURCOUCHE/src/modd_argslist_ll.f90
+++ b/src/LIB/SURCOUCHE/src/modd_argslist_ll.f90
@@ -3,6 +3,7 @@
!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_ARGSLIST_ll
! #######################
@@ -37,15 +38,15 @@
!
!-------------------------------------------------------------------------------
!
- USE MODD_STRUCTURE2_ll, ONLY : HALO2_ll
+USE MODD_STRUCTURE2_ll, ONLY: HALO2_ll
implicit none
integer,parameter :: NLISTTYPENAMESIZE = 32
-! ############
- TYPE LIST_ll
-! ############
+!###########
+TYPE LIST_ll
+!###########
!
!!**** *Type LIST_ll* -
!
@@ -57,7 +58,7 @@ integer,parameter :: NLISTTYPENAMESIZE = 32
!
!-------------------------------------------------------------------------------
!
- INTEGER :: NCARD = -1
+ INTEGER :: NCARD = 0
LOGICAL :: L1D = .false.
LOGICAL :: L2D = .false.
LOGICAL :: L3D = .false.
@@ -68,15 +69,15 @@ integer,parameter :: NLISTTYPENAMESIZE = 32
REAL, DIMENSION(:,:), POINTER :: ARRAY2D => null()
REAL, DIMENSION(:,:,:), POINTER :: ARRAY3D => null()
!
- TYPE(LIST_ll), POINTER :: NEXT => null()
+ TYPE(LIST_ll), POINTER :: NEXT => null()
!
- END TYPE LIST_ll
+END TYPE LIST_ll
!
!-------------------------------------------------------------------------------
!
-! ##############
- TYPE LIST1D_ll
-! ##############
+!#############
+TYPE LIST1D_ll
+!#############
!
!!**** *Type LIST1D_ll* -
!
@@ -87,22 +88,22 @@ integer,parameter :: NLISTTYPENAMESIZE = 32
!
!-------------------------------------------------------------------------------
!
- INTEGER :: NCARD = -1
+ INTEGER :: NCARD = 0
character(len=NLISTTYPENAMESIZE) :: cname = 'UNKNOWN'
REAL, DIMENSION(:), POINTER :: ARRAY1D => null()
CHARACTER(LEN=1) :: CDIR = ' '
!
- TYPE(LIST1D_ll), POINTER :: NEXT => null()
+ TYPE(LIST1D_ll), POINTER :: NEXT => null()
!
- END TYPE LIST1D_ll
+END TYPE LIST1D_ll
!
!-------------------------------------------------------------------------------
!
-! #################
- TYPE HALO2LIST_ll
-! #################
+!################
+TYPE HALO2LIST_ll
+!################
!
!!**** *Type HALO2LIST_ll* -
!
@@ -113,13 +114,13 @@ integer,parameter :: NLISTTYPENAMESIZE = 32
!
!-------------------------------------------------------------------------------
!
- INTEGER :: NCARD = -1
+ INTEGER :: NCARD = 0
!
- TYPE(HALO2_ll), POINTER :: HALO2 => null()
+ TYPE(HALO2_ll), POINTER :: HALO2 => null()
!
TYPE(HALO2LIST_ll), POINTER :: NEXT => null()
!
- END TYPE HALO2LIST_ll
+END TYPE HALO2LIST_ll
!
!-------------------------------------------------------------------------------
!
diff --git a/src/LIB/SURCOUCHE/src/modd_field.f90 b/src/LIB/SURCOUCHE/src/modd_field.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b81b59f1f0354c2041f9908b0d3c7fb7230e0f3d
--- /dev/null
+++ b/src/LIB/SURCOUCHE/src/modd_field.f90
@@ -0,0 +1,241 @@
+!MNH_LIC Copyright 2016-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Original version:
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! Modifications:
+! P. Wautelet 12/04/2019: added pointers for C1D, L1D, N1D, X5D and X6D structures in TFIELDDATA
+! P. Wautelet 12/07/2019: add pointers for T1D structure in TFIELDDATA
+! P. Wautelet 23/01/2020: split in modd_field.f90 and mode_field.f90
+! P. Wautelet 27/01/2020: create the tfield_metadata_base abstract datatype
+! P. Wautelet 14/09/2020: add ndimlist field to tfield_metadata_base
+! P. Wautelet 10/11/2020: new data structures for netCDF dimensions
+!-----------------------------------------------------------------
+module modd_field
+
+use modd_parameters, only: NGRIDUNKNOWN, NMNHNAMELGTMAX, NSTDNAMELGTMAX
+use modd_type_date, only: date_time
+#ifdef MNH_IOCDF4
+use NETCDF, only: NF90_FILL_INT, NF90_FILL_REAL
+#endif
+
+implicit none
+
+integer, parameter :: NMNHMAXDIMS = 6 ! Cannot be less than 6
+INTEGER,PARAMETER :: MAXFIELDS = 250
+INTEGER,PARAMETER :: TYPEUNDEF = -1, TYPEINT = 1, TYPELOG = 2, TYPEREAL = 3, TYPECHAR = 4, TYPEDATE = 5
+!
+integer, parameter :: NMNHDIM_UNKNOWN = -2
+
+!For efficient use of memory, it is better that all values for real dimensions be contiguous
+integer, parameter :: NMNHDIM_NI = 1
+integer, parameter :: NMNHDIM_NJ = 2
+integer, parameter :: NMNHDIM_NI_U = 3
+integer, parameter :: NMNHDIM_NJ_U = 4
+integer, parameter :: NMNHDIM_NI_V = 5
+integer, parameter :: NMNHDIM_NJ_V = 6
+integer, parameter :: NMNHDIM_LEVEL = 7
+integer, parameter :: NMNHDIM_LEVEL_W = 8
+integer, parameter :: NMNHDIM_TIME = 9
+
+integer, parameter :: NMNHDIM_ONE = 10
+
+integer, parameter :: NMNHDIM_LASTDIM_NODIACHRO = 10 ! Index of the last defined dimension for non-diachronic files
+
+integer, parameter :: NMNHDIM_COMPLEX = 11
+
+integer, parameter :: NMNHDIM_BUDGET_CART_NI = 12
+integer, parameter :: NMNHDIM_BUDGET_CART_NJ = 13
+integer, parameter :: NMNHDIM_BUDGET_CART_NI_U = 14
+integer, parameter :: NMNHDIM_BUDGET_CART_NJ_U = 15
+integer, parameter :: NMNHDIM_BUDGET_CART_NI_V = 16
+integer, parameter :: NMNHDIM_BUDGET_CART_NJ_V = 17
+integer, parameter :: NMNHDIM_BUDGET_CART_LEVEL = 18
+integer, parameter :: NMNHDIM_BUDGET_CART_LEVEL_W = 19
+
+integer, parameter :: NMNHDIM_BUDGET_MASK_LEVEL = 20
+integer, parameter :: NMNHDIM_BUDGET_MASK_LEVEL_W = 21
+integer, parameter :: NMNHDIM_BUDGET_MASK_NBUMASK = 22
+
+integer, parameter :: NMNHDIM_BUDGET_TIME = 23
+
+integer, parameter :: NMNHDIM_BUDGET_LES_TIME = 24
+integer, parameter :: NMNHDIM_BUDGET_LES_AVG_TIME = 25
+integer, parameter :: NMNHDIM_BUDGET_LES_LEVEL = 26
+integer, parameter :: NMNHDIM_BUDGET_LES_SV = 27
+integer, parameter :: NMNHDIM_BUDGET_LES_PDF = 28
+integer, parameter :: NMNHDIM_BUDGET_LES_MASK = 100 ! This is not a true dimension
+
+integer, parameter :: NMNHDIM_SPECTRA_2PTS_NI = 29
+integer, parameter :: NMNHDIM_SPECTRA_2PTS_NJ = 30
+integer, parameter :: NMNHDIM_SPECTRA_SPEC_NI = 31
+integer, parameter :: NMNHDIM_SPECTRA_SPEC_NJ = 32
+integer, parameter :: NMNHDIM_SPECTRA_LEVEL = 33
+
+integer, parameter :: NMNHDIM_SERIES_LEVEL = 34
+integer, parameter :: NMNHDIM_SERIES_LEVEL_W = 35
+integer, parameter :: NMNHDIM_SERIES_TIME = 36 ! Time dimension for time series
+
+integer, parameter :: NMNHDIM_FLYER_TIME = 37 ! Time dimension for aircraft/balloon (dimension local to each flyer)
+integer, parameter :: NMNHDIM_PROFILER_TIME = 38 ! Time dimension for profilers
+integer, parameter :: NMNHDIM_STATION_TIME = 39 ! Time dimension for stations
+
+integer, parameter :: NMNHDIM_PAIR = 40 ! For values coming by pair (ie boundaries)
+
+integer, parameter :: NMNHDIM_LASTDIM_DIACHRO = 40 ! Index of the last defined dimension for diachronic files
+
+integer, parameter :: NMNHDIM_BUDGET_NGROUPS = 101 ! This is not a true dimension
+integer, parameter :: NMNHDIM_FLYER_PROC = 102 ! This is not a true dimension
+integer, parameter :: NMNHDIM_PROFILER_PROC = 103 ! This is not a true dimension
+integer, parameter :: NMNHDIM_STATION_PROC = 104 ! This is not a true dimension
+integer, parameter :: NMNHDIM_SERIES_PROC = 105 ! This is not a true dimension
+integer, parameter :: NMNHDIM_BUDGET_TERM = 106 ! This is not a true dimension
+
+integer, parameter :: NMNHDIM_NOTLISTED = 200 ! Special case for valid dimension but not in this parameter list
+
+integer, parameter :: NMNHDIM_UNUSED = 300
+
+!Array to allow easy identification of dimensions for Arakawa grid points
+integer, dimension(0:8,3), parameter :: NMNHDIM_ARAKAWA = reshape( [ &
+ NMNHDIM_UNKNOWN, NMNHDIM_UNKNOWN, NMNHDIM_UNKNOWN, & ! dummy point (to treat ngrid=0 without crash)
+ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_LEVEL, & ! mass point
+ NMNHDIM_NI_U, NMNHDIM_NJ_U, NMNHDIM_LEVEL, & ! u point
+ NMNHDIM_NI_V, NMNHDIM_NJ_V, NMNHDIM_LEVEL, & ! v point
+ NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_LEVEL_W, & ! w point
+ NMNHDIM_NI_U, NMNHDIM_NJ_V, NMNHDIM_LEVEL, & ! xi vorticity point (=f point =uv point)
+ NMNHDIM_NI_U, NMNHDIM_NJ_U, NMNHDIM_LEVEL_W, & ! eta vorticity point (=uw point)
+ NMNHDIM_NI_V, NMNHDIM_NJ_V, NMNHDIM_LEVEL_W, & ! zeta vorticity point (=vw point)
+ NMNHDIM_NI_U, NMNHDIM_NJ_V, NMNHDIM_LEVEL_W] & ! fw point (=uvw point)
+ , shape = [ 9, 3 ], order = [ 2, 1 ] )
+
+TYPE TFIELDPTR_C0D
+ CHARACTER(LEN=:), POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_C0D
+!
+TYPE TFIELDPTR_C1D
+ CHARACTER(LEN=:),DIMENSION(:),POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_C1D
+!
+TYPE TFIELDPTR_L0D
+ LOGICAL, POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_L0D
+!
+TYPE TFIELDPTR_L1D
+ LOGICAL,DIMENSION(:), POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_L1D
+!
+TYPE TFIELDPTR_N0D
+ INTEGER, POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_N0D
+!
+TYPE TFIELDPTR_N1D
+ INTEGER,DIMENSION(:), POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_N1D
+!
+TYPE TFIELDPTR_N2D
+ INTEGER,DIMENSION(:,:), POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_N2D
+!
+TYPE TFIELDPTR_N3D
+ INTEGER,DIMENSION(:,:,:),POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_N3D
+!
+TYPE TFIELDPTR_X0D
+ REAL, POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_X0D
+!
+TYPE TFIELDPTR_X1D
+ REAL,DIMENSION(:), POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_X1D
+!
+TYPE TFIELDPTR_X2D
+ REAL,DIMENSION(:,:), POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_X2D
+!
+TYPE TFIELDPTR_X3D
+ REAL,DIMENSION(:,:,:),POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_X3D
+!
+TYPE TFIELDPTR_X4D
+ REAL,DIMENSION(:,:,:,:),POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_X4D
+!
+TYPE TFIELDPTR_X5D
+ REAL,DIMENSION(:,:,:,:,:),POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_X5D
+!
+TYPE TFIELDPTR_X6D
+ REAL,DIMENSION(:,:,:,:,:,:),POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_X6D
+!
+TYPE TFIELDPTR_T0D
+ TYPE(DATE_TIME), POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_T0D
+!
+TYPE TFIELDPTR_T1D
+ TYPE(DATE_TIME), DIMENSION(:), POINTER :: DATA => NULL()
+END TYPE TFIELDPTR_T1D
+!
+type :: tfield_metadata_base
+ CHARACTER(LEN=NMNHNAMELGTMAX) :: CMNHNAME = '' !Name of the field (for MesoNH, non CF convention)
+ CHARACTER(LEN=NSTDNAMELGTMAX) :: CSTDNAME = '' !Standard name (CF convention)
+ CHARACTER(LEN=32) :: CLONGNAME = '' !Long name (CF convention)
+ CHARACTER(LEN=40) :: CUNITS = '' !Canonical units (CF convention)
+ CHARACTER(LEN=100) :: CCOMMENT = '' !Comment (for MesoNH, non CF convention)
+ INTEGER :: NGRID = NGRIDUNKNOWN !Localization on the model grid
+ INTEGER :: NTYPE = TYPEUNDEF !Datatype
+ INTEGER :: NDIMS = 0 !Number of dimensions
+ INTEGER, DIMENSION(NMNHMAXDIMS) :: NDIMLIST = NMNHDIM_UNKNOWN ! List of dimensions of the data field
+ !
+#ifdef MNH_IOCDF4
+ INTEGER :: NFILLVALUE = NF90_FILL_INT !Fill value for integer fields
+ REAL :: XFILLVALUE = NF90_FILL_REAL !Fill value for real fields
+ !NF90_FILL_REAL is the default fill value
+ !used by netCDF to pre-fill real and also double
+ !variables
+#else
+ INTEGER :: NFILLVALUE = -2147483647 !Fill value for integer fields
+ REAL :: XFILLVALUE = 9.9692099683868690e+36 !Fill value for real fields
+#endif
+ INTEGER :: NVALIDMIN = -2147483646 !Minimum valid value for integer fields
+ INTEGER :: NVALIDMAX = 2147483647 !Maximum valid value for integer fields
+ REAL :: XVALIDMIN = -1.E36 !Minimum valid value for real fields
+ REAL :: XVALIDMAX = 1.E36 !Maximum valid value for real fields
+end type tfield_metadata_base
+
+!Structure describing the characteristics of a field
+TYPE, extends( tfield_metadata_base ) :: TFIELDDATA
+ CHARACTER(LEN=2) :: CDIR = '' !Type of the data field (XX,XY,--...)
+ CHARACTER(LEN=4) :: CLBTYPE = 'NONE' !Type of the lateral boundary (LBX,LBY,LBXU,LBYV)
+ LOGICAL :: LTIMEDEP = .FALSE. !Is the field time-dependent?
+ !
+ TYPE(TFIELDPTR_C0D),DIMENSION(:),ALLOCATABLE :: TFIELD_C0D !Pointer to the character string fields (one per nested mesh)
+ TYPE(TFIELDPTR_C1D),DIMENSION(:),ALLOCATABLE :: TFIELD_C1D !Pointer to the character string 1D fields (one per nested mesh)
+ !
+ TYPE(TFIELDPTR_L0D),DIMENSION(:),ALLOCATABLE :: TFIELD_L0D !Pointer to the scalar logical fields (one per nested mesh)
+ TYPE(TFIELDPTR_L1D),DIMENSION(:),ALLOCATABLE :: TFIELD_L1D !Pointer to the logical 1D fields (one per nested mesh)
+ !
+ TYPE(TFIELDPTR_N0D),DIMENSION(:),ALLOCATABLE :: TFIELD_N0D !Pointer to the scalar integer fields (one per nested mesh)
+ TYPE(TFIELDPTR_N1D),DIMENSION(:),ALLOCATABLE :: TFIELD_N1D !Pointer to the integer 1D fields (one per nested mesh)
+ TYPE(TFIELDPTR_N2D),DIMENSION(:),ALLOCATABLE :: TFIELD_N2D !Pointer to the integer 2D fields (one per nested mesh)
+ TYPE(TFIELDPTR_N3D),DIMENSION(:),ALLOCATABLE :: TFIELD_N3D !Pointer to the integer 3D fields (one per nested mesh)
+ !
+ TYPE(TFIELDPTR_X0D),DIMENSION(:),ALLOCATABLE :: TFIELD_X0D !Pointer to the scalar real fields (one per nested mesh)
+ TYPE(TFIELDPTR_X1D),DIMENSION(:),ALLOCATABLE :: TFIELD_X1D !Pointer to the real 1D fields (one per nested mesh)
+ TYPE(TFIELDPTR_X2D),DIMENSION(:),ALLOCATABLE :: TFIELD_X2D !Pointer to the real 2D fields (one per nested mesh)
+ TYPE(TFIELDPTR_X3D),DIMENSION(:),ALLOCATABLE :: TFIELD_X3D !Pointer to the real 3D fields (one per nested mesh)
+ TYPE(TFIELDPTR_X4D),DIMENSION(:),ALLOCATABLE :: TFIELD_X4D !Pointer to the real 4D fields (one per nested mesh)
+ TYPE(TFIELDPTR_X5D),DIMENSION(:),ALLOCATABLE :: TFIELD_X5D !Pointer to the real 5D fields (one per nested mesh)
+ TYPE(TFIELDPTR_X6D),DIMENSION(:),ALLOCATABLE :: TFIELD_X6D !Pointer to the real 6D fields (one per nested mesh)
+ !
+ TYPE(TFIELDPTR_T0D),DIMENSION(:),ALLOCATABLE :: TFIELD_T0D !Pointer to the scalar date/time fields (one per nested mesh)
+ TYPE(TFIELDPTR_T1D),DIMENSION(:),ALLOCATABLE :: TFIELD_T1D !Pointer to the date/time 1D fields (one per nested mesh)
+END TYPE TFIELDDATA
+!
+integer, save :: NMODEL_ALLOCATED
+LOGICAL, SAVE :: LFIELDLIST_ISINIT = .FALSE.
+TYPE(TFIELDDATA),DIMENSION(MAXFIELDS),SAVE :: TFIELDLIST
+
+end module modd_field
diff --git a/src/LIB/SURCOUCHE/src/modd_io.f90 b/src/LIB/SURCOUCHE/src/modd_io.f90
index a27528eebe0f92b06e94ef1464a3f3f11396d382..c8457cc2d32624a020d122c41cb318faa86a1d4c 100644
--- a/src/LIB/SURCOUCHE/src/modd_io.f90
+++ b/src/LIB/SURCOUCHE/src/modd_io.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.
@@ -9,15 +9,20 @@
! P. Wautelet 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll to allow to disable writes (for bench purposes)
! P. Wautelet 07/02/2019: force TYPE to a known value for IO_File_add2list
! P. Wautelet 12/03/2019: add TMAINFILE field in TFILEDATA
+! P. Wautelet 17/01/2020: add 'BUD' category for Print_msg + corresponding namelist variables
+! P. Wautelet 22/09/2020: add ldimreduced in tfiledata
+! P. Wautelet 10/11/2020: new data structures for netCDF dimensions
!-----------------------------------------------------------------
+#define MNH_REDUCE_DIMENSIONS_IN_FILES 1
+
MODULE MODD_IO
!
-USE MODD_NETCDF, ONLY: IOCDF, TPTR2DIMCDF
+use modd_netcdf, only: tdimsnc
USE MODD_PARAMETERS, ONLY: NDIRNAMELGTMAX, NFILENAMELGTMAX
use modd_precision, only: CDFINT, LFIINT
!
-IMPLICIT NONE
+IMPLICIT NONE
!
!
INTEGER, PARAMETER :: NVERB_NO=0, NVERB_FATAL=1, NVERB_ERROR=2, NVERB_WARNING=3, NVERB_INFO=4, NVERB_DEBUG=5
@@ -41,10 +46,12 @@ LOGICAL, SAVE :: LLFIREAD = .FALSE. ! TRUE will force LFI read (instead of Net
LOGICAL, SAVE :: LVERB_OUTLST = .TRUE. ! TRUE will PRINT_MSG in OUTPUT_LISTINGn files
LOGICAL, SAVE :: LVERB_STDOUT = .FALSE. ! TRUE will also PRINT_MSG on standard output
LOGICAL, SAVE :: LVERB_ALLPRC = .FALSE. ! FALSE: only process 0 do PRINT_MSG, TRUE: all processes
-INTEGER, SAVE :: NIO_VERB = NVERB_WARNING ! Verbosity level for IO
+INTEGER, SAVE :: NBUD_VERB = NVERB_INFO ! Verbosity level for budgets
+INTEGER, SAVE :: NBUD_ABORT_LEVEL = NVERB_ERROR ! Level of budget error necessary to force stop of application
+INTEGER, SAVE :: NIO_VERB = NVERB_INFO ! Verbosity level for IO
INTEGER, SAVE :: NIO_ABORT_LEVEL = NVERB_ERROR ! Level of IO error necessary to force stop of application
-INTEGER, SAVE :: NGEN_VERB = NVERB_WARNING ! Verbosity level for 'GEN' (generic) messages
+INTEGER, SAVE :: NGEN_VERB = NVERB_INFO ! Verbosity level for 'GEN' (generic) messages
INTEGER, SAVE :: NGEN_ABORT_LEVEL = NVERB_ERROR ! Level of 'GEN' error necessary to force stop of application
CHARACTER(LEN=NDIRNAMELGTMAX) :: CIO_DIR = '' ! Directory for IO
@@ -65,7 +72,7 @@ TYPE TOUTBAK
REAL :: XTIME !Time from start of the segment (in seconds and rounded to a timestep)
INTEGER :: NOUTDAD = -1 !Index of the corresponding dad file (file with same time)
TYPE(TFILEDATA),POINTER :: TFILE => NULL() !Corresponding file
- TYPE(TFILE_ELT),DIMENSION(:),ALLOCATABLE :: TFILE_IOZ !Corresponding Z-splitted files
+ TYPE(TFILE_ELT),DIMENSION(:),ALLOCATABLE :: TFILE_IOZ !Corresponding Z-split files
INTEGER,DIMENSION(:),POINTER :: NFIELDLIST => NULL() !List of the fields to read or write
END TYPE TOUTBAK
@@ -85,31 +92,39 @@ TYPE TFILEDATA
INTEGER :: NMPICOMM = -1 !MPI communicator used for IO on this file
LOGICAL :: LMASTER = .FALSE. !True if process is master of the file (process that open/read/write/close)
LOGICAL :: LMULTIMASTERS = .FALSE. !True if several processes may access the file
+#if ( MNH_REDUCE_DIMENSIONS_IN_FILES == 1 )
+ logical :: ldimreduced = .true. !True if number of dimensions of fields can be reduced (for 2D simulations)
+#else
+ logical :: ldimreduced = .false. !True if number of dimensions of fields can be reduced (for 2D simulations)
+#endif
!
- INTEGER :: NSUBFILES_IOZ = 0 !Number of sub-files (Z-splitted files based on this file)
+ INTEGER :: NSUBFILES_IOZ = 0 !Number of sub-files (Z-split files based on this file)
!For example if 2 sub-files and this file is abcd,
!the 2 sub-files are abcd.Z001 and abcd.Z002
- TYPE(TFILE_ELT),DIMENSION(:),ALLOCATABLE :: TFILES_IOZ !Corresponding Z-splitted files
+ TYPE(TFILE_ELT),DIMENSION(:),ALLOCATABLE :: TFILES_IOZ !Corresponding Z-split files
!
INTEGER :: NMODEL = 0 !Model number corresponding to the file (field not always set)
INTEGER,DIMENSION(3) :: NMNHVERSION = (/0,0,0/) !MesoNH version used to create the file
!
+#ifdef MNH_IOLFI
! Fields for LFI files
INTEGER(KIND=LFIINT) :: NLFININAR = 0 !Number of articles of the LFI file (only accurate if file opened in read mode)
INTEGER(KIND=LFIINT) :: NLFINPRAR = 0 !Number of predicted articles of the LFI file (non crucial)
INTEGER :: NLFITYPE = -1 !Type of the file (used to generate list of files to transfers)
INTEGER :: NLFIVERB = 1 !LFI verbosity level
INTEGER(KIND=LFIINT) :: NLFIFLU = -1 !File identifier
+#endif
!
+#ifdef MNH_IOCDF4
! Fields for netCDF files
- INTEGER(KIND=CDFINT) :: NNCID = -1 !File identifier
- INTEGER(KIND=CDFINT) :: NNCNAR = 0 !Number of articles of the netCDF file (only accurate if file opened in read mode)
- LOGICAL :: LNCREDUCE_FLOAT_PRECISION = .FALSE. ! Reduce the precision of floats to single precision
- ! instead of double precision
- LOGICAL :: LNCCOMPRESS = .FALSE. ! Do compression on fields
- INTEGER(KIND=CDFINT) :: NNCCOMPRESS_LEVEL = 0 ! Compression level
- TYPE(IOCDF),POINTER :: TNCDIMS => NULL() ! Structure containing netCDF dimensions
- TYPE(TPTR2DIMCDF),DIMENSION(:,:),ALLOCATABLE :: TNCCOORDS ! Structure pointing to the coordinates variables
+ INTEGER(KIND=CDFINT) :: NNCID = -1 !File identifier (corresponding to the actual group)
+ INTEGER(KIND=CDFINT) :: NNCNAR = 0 !Number of articles of the netCDF file (only accurate if file opened in read mode)
+ LOGICAL :: LNCREDUCE_FLOAT_PRECISION = .FALSE. ! Reduce the precision of floats to single precision
+ ! instead of double precision
+ LOGICAL :: LNCCOMPRESS = .FALSE. ! Do compression on fields
+ INTEGER(KIND=CDFINT) :: NNCCOMPRESS_LEVEL = 0 ! Compression level
+ type(tdimsnc), pointer :: tncdims => Null() ! Dimensions of netCDF file
+#endif
!
!Fields for other files
INTEGER :: NLU = -1 !Logical unit number
@@ -139,6 +154,6 @@ TYPE(TFILEDATA),POINTER,SAVE :: TFILE_SURFEX => NULL() !Pointer used to find th
TYPE(TFILEDATA),POINTER,SAVE :: TFILE_OUTPUTLISTING => NULL() !Pointer used to point to the file used when writing to OUTPUT_LISTINGn file
!Non existing file which can be used as a dummy target
-TYPE(TFILEDATA),TARGET, SAVE :: TFILE_DUMMY = TFILEDATA(CNAME="dummy",CDIRNAME=NULL(),TFILES_IOZ=NULL(),TNCCOORDS=NULL())
+TYPE(TFILEDATA),TARGET, SAVE :: TFILE_DUMMY = TFILEDATA(CNAME="dummy",CDIRNAME=NULL(),TFILES_IOZ=NULL())
END MODULE MODD_IO
diff --git a/src/LIB/SURCOUCHE/src/modd_netcdf.f90 b/src/LIB/SURCOUCHE/src/modd_netcdf.f90
index b73380b5636a81333b7eeafce263fc062f56bf5d..0d289c67a511f8b20d8399613ac766c906daccd7 100644
--- a/src/LIB/SURCOUCHE/src/modd_netcdf.f90
+++ b/src/LIB/SURCOUCHE/src/modd_netcdf.f90
@@ -1,42 +1,35 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 10/11/2020: new data structures for netCDF dimensions
!-----------------------------------------------------------------
-MODULE MODD_NETCDF
+module modd_netcdf
use modd_precision, only: CDFINT
-IMPLICIT NONE
+implicit none
-TYPE IOCDF
- TYPE(DIMCDF), POINTER :: DIM_NI => NULL()
- TYPE(DIMCDF), POINTER :: DIM_NJ => NULL()
- TYPE(DIMCDF), POINTER :: DIM_LEVEL => NULL()
- TYPE(DIMCDF), POINTER :: DIM_NI_U => NULL()
- TYPE(DIMCDF), POINTER :: DIM_NJ_U => NULL()
- TYPE(DIMCDF), POINTER :: DIM_NI_V => NULL()
- TYPE(DIMCDF), POINTER :: DIM_NJ_V => NULL()
- TYPE(DIMCDF), POINTER :: DIM_LEVEL_W => NULL()
- TYPE(DIMCDF), POINTER :: DIMTIME => NULL()
- TYPE(DIMCDF), POINTER :: DIMSTR => NULL()
- TYPE(DIMCDF), POINTER :: DIMLIST => NULL()
-END TYPE IOCDF
+public
-TYPE DIMCDF
- CHARACTER(LEN=32) :: NAME = ''
- INTEGER(KIND=CDFINT) :: LEN = 0
- INTEGER(KIND=CDFINT) :: ID = -1
- TYPE(DIMCDF), POINTER :: NEXT => NULL()
-END TYPE DIMCDF
+integer, parameter :: NMAXDIMNAMELGTNC4 = 16
-TYPE TPTR2DIMCDF
- TYPE(DIMCDF),POINTER :: TDIM
-END TYPE TPTR2DIMCDF
+!Datatype to store metadata of 1 dimension
+type tdimnc
+ character(len=NMAXDIMNAMELGTNC4) :: cname = ''
+ integer(kind=CDFINT) :: nlen = -1
+ integer(kind=CDFINT) :: nid = -1
+end type tdimnc
-TYPE(DIMCDF),TARGET :: TDIM_DUMMY !Dummy dimension
+!Datatype to store dimension metadata of a netCDF file
+type tdimsnc
+ integer :: nmaxdims = 0
+ type(tdimnc), dimension(:), allocatable :: tdims
+ integer :: nmaxdims_str = 0 ! For character strings
+ type(tdimnc), dimension(:), allocatable :: tdims_str ! For character strings
+end type tdimsnc
-END MODULE MODD_NETCDF
+end module modd_netcdf
diff --git a/src/LIB/SURCOUCHE/src/modd_structure2_ll.f90 b/src/LIB/SURCOUCHE/src/modd_structure2_ll.f90
index 5a823e55df4954f4a670256b39e8be6d48cfb296..3b04ba768724c80140e10aa1af7a7d4071651e1d 100644
--- a/src/LIB/SURCOUCHE/src/modd_structure2_ll.f90
+++ b/src/LIB/SURCOUCHE/src/modd_structure2_ll.f90
@@ -1,20 +1,11 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC 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 CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-
-! ########################
- MODULE MODD_STRUCTURE2_ll
-! ########################
+!########################
+MODULE MODD_STRUCTURE2_ll
+!########################
!
!!**** *MODD_PARALLEL2* Contains the variables to treat
! the second layer of the halo
@@ -46,18 +37,20 @@
!
!-------------------------------------------------------------------------------
!
-! #############
- TYPE HALO2_ll
-! #############
+implicit none
+!
+!############
+TYPE HALO2_ll
+!############
!
! Type for the second layer of the halo
!
- REAL, DIMENSION(:,:), POINTER :: WEST
- REAL, DIMENSION(:,:), POINTER :: EAST
- REAL, DIMENSION(:,:), POINTER :: NORTH
- REAL, DIMENSION(:,:), POINTER :: SOUTH
+ REAL, DIMENSION(:,:), POINTER :: WEST => NULL()
+ REAL, DIMENSION(:,:), POINTER :: EAST => NULL()
+ REAL, DIMENSION(:,:), POINTER :: NORTH => NULL()
+ REAL, DIMENSION(:,:), POINTER :: SOUTH => NULL()
!
- END TYPE HALO2_ll
+END TYPE HALO2_ll
!
!-------------------------------------------------------------------------------
!
diff --git a/src/LIB/SURCOUCHE/src/modd_structure_ll.f90 b/src/LIB/SURCOUCHE/src/modd_structure_ll.f90
index 570dcba7e58e2f18d20d042d9a67b977355d11f6..f2ce9fe5c21b8c436db2714c36eec256cf8beb8e 100644
--- a/src/LIB/SURCOUCHE/src/modd_structure_ll.f90
+++ b/src/LIB/SURCOUCHE/src/modd_structure_ll.f90
@@ -1,11 +1,11 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-! ########################
- MODULE MODD_STRUCTURE_ll
-! ########################
+!#######################
+MODULE MODD_STRUCTURE_ll
+!#######################
!
!!**** *MODD_STRUCTURE_lll* - declaration of parallel structure
!
@@ -45,10 +45,12 @@
!
!-------------------------------------------------------------------------------
!
- USE MODD_ARGSLIST_ll, ONLY : LIST_ll
- USE MODD_PARAMETERS, ONLY : NNEGUNDEF
- USE MODD_PARAMETERS_ll, ONLY : NMAXRIM
-!
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODD_PARAMETERS, ONLY : NNEGUNDEF
+USE MODD_PARAMETERS_ll, ONLY : NMAXRIM
+
+implicit none
+
!-------------------------------------------------------------------------------
!
! Routines for allocation of structured types
diff --git a/src/LIB/SURCOUCHE/src/modd_type_date.f90 b/src/LIB/SURCOUCHE/src/modd_type_date.f90
deleted file mode 100644
index f7a3949cfc0d090a9beacf5c7436a6d9f704898c..0000000000000000000000000000000000000000
--- a/src/LIB/SURCOUCHE/src/modd_type_date.f90
+++ /dev/null
@@ -1,66 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
-
-!-----------------------------------------------------------------
-!--------------- special set of characters for SCCS information
-!-----------------------------------------------------------------
-! @(#) Lib:/d10/free/mesonh/sources/modd/s.modd_type_date.f90, Version:1.6, Date:01/01/15, Last modified:00/12/21
-!-----------------------------------------------------------------
-! #################
- MODULE MODD_TYPE_DATE
-! #################
-!
-!!**** *MODD_TYPE_DATE* - declaration of temporal types
-!!
-!! PURPOSE
-!! -------
-! The purpose of this declarative module is to define
-! the time types.
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! NONE
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation of Meso-NH (module MODD_TYPE_DATE)
-!!
-!! AUTHOR
-!! ------
-!! P. Jabouille *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 11/08/97
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-IMPLICIT NONE
-!
-TYPE DATE
-INTEGER :: YEAR
-INTEGER :: MONTH
-INTEGER :: DAY
-END TYPE DATE
-!
-TYPE DATE_TIME
-TYPE (DATE) :: TDATE
-REAL :: TIME
-END TYPE DATE_TIME
-!
-END MODULE MODD_TYPE_DATE
diff --git a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90 b/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
index e6d0e9a1a0fd514b227262f16a607f59a7710e2b..4f2c3df4b13c5864c5a7f095013390f58bed92c0 100644
--- a/src/LIB/SURCOUCHE/src/mode_allocbuff.f90
+++ b/src/LIB/SURCOUCHE/src/mode_allocbuff.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.
!-----------------------------------------------------------------
! Modifications:
! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 14/01/2021: add ALLOCBUFFER_N4 subroutine
!-----------------------------------------------------------------
MODULE MODE_ALLOCBUFFER_ll
@@ -16,10 +17,12 @@ IMPLICIT NONE
PRIVATE
INTERFACE ALLOCBUFFER_ll
- MODULE PROCEDURE ALLOCBUFFER_X1,ALLOCBUFFER_X2,ALLOCBUFFER_X3,&
- & ALLOCBUFFER_X4,ALLOCBUFFER_X5,ALLOCBUFFER_X6,&
- & ALLOCBUFFER_N1,ALLOCBUFFER_N2,ALLOCBUFFER_N3,&
- & ALLOCBUFFER_L1
+ MODULE PROCEDURE &
+ ALLOCBUFFER_X1, ALLOCBUFFER_X2, ALLOCBUFFER_X3, &
+ ALLOCBUFFER_X4, ALLOCBUFFER_X5, ALLOCBUFFER_X6, &
+ ALLOCBUFFER_N1, ALLOCBUFFER_N2, ALLOCBUFFER_N3, &
+ ALLOCBUFFER_N4, &
+ ALLOCBUFFER_L1
END INTERFACE
PUBLIC ALLOCBUFFER_ll
@@ -118,6 +121,42 @@ CASE default
END SELECT
END SUBROUTINE ALLOCBUFFER_N3
+SUBROUTINE ALLOCBUFFER_N4(KTAB_P,KTAB,HDIR,OALLOC)
+USE MODD_IO, ONLY: LPACK, L2D
+!
+INTEGER, DIMENSION(:,:,:,:), POINTER, INTENT(OUT) :: KTAB_P
+INTEGER, DIMENSION(:,:,:,:), TARGET, INTENT(IN) :: KTAB
+CHARACTER(LEN=*), INTENT(IN) :: HDIR
+LOGICAL, INTENT(OUT) :: OALLOC
+
+INTEGER :: IIMAX,IJMAX
+
+SELECT CASE(HDIR)
+CASE('XX')
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ALLOCATE(KTAB_P(IIMAX+2*JPHEXT,SIZE(KTAB,2),SIZE(KTAB,3)&
+ & ,SIZE(KTAB,4)))
+ OALLOC = .TRUE.
+CASE('YY')
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ ALLOCATE(KTAB_P(IJMAX+2*JPHEXT,SIZE(KTAB,2),SIZE(KTAB,3)&
+ & ,SIZE(KTAB,4)))
+ OALLOC = .TRUE.
+CASE('XY')
+ CALL GET_GLOBALDIMS_ll(IIMAX,IJMAX)
+ IF (LPACK .AND. L2D) THEN
+ ! 2D compact case
+ ALLOCATE(KTAB_P(IIMAX+2*JPHEXT,1,SIZE(KTAB,3),SIZE(KTAB,4)))
+ ELSE
+ ALLOCATE(KTAB_P(IIMAX+2*JPHEXT,IJMAX+2*JPHEXT,SIZE(KTAB,3),SIZE(KTAB,4)))
+ END IF
+ OALLOC = .TRUE.
+CASE default
+ KTAB_P=>KTAB
+ OALLOC = .FALSE.
+END SELECT
+END SUBROUTINE ALLOCBUFFER_N4
+
SUBROUTINE ALLOCBUFFER_L1(LTAB_P,LTAB,HDIR,OALLOC)
!
LOGICAL,DIMENSION(:),POINTER :: LTAB_P
diff --git a/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90 b/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90
index b42ab1c2a6ebd282856ac210b8a5e55247209f44..2e1214f648581a18d310113cbadb86d8a8055875 100644
--- a/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_argslist_ll.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -15,7 +15,7 @@
!
! SUBROUTINES : ADD1DFIELD_ll, ADD2DFIELD_ll, ADD3DFIELD_ll
! DEL1DFIELD_ll, DEL2DFIELD_ll, DEL3DFIELD_ll
-! CLEANLIST_ll
+! CLEANLIST_ll, CLEANLIST1D_ll
!
!! Purpose
!! -------
@@ -49,7 +49,7 @@
! Original May 19, 1998
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!
+! P. Wautelet 07/12/2020: add CLEANLIST1D_ll subroutine
!-------------------------------------------------------------------------------
!
! Implicit arguments
@@ -705,6 +705,7 @@ end subroutine add4dfield_ll
!
END SUBROUTINE DEL3DFIELD_ll
!
+!
!! ###############################
SUBROUTINE CLEANLIST_ll(TPLIST)
!! ###############################
@@ -770,4 +771,31 @@ end subroutine add4dfield_ll
!
END SUBROUTINE CLEANLIST_ll
!
+!! ###############################
+ SUBROUTINE CLEANLIST1D_ll(TPLIST)
+!! ###############################
+ IMPLICIT NONE
+!
+ TYPE(LIST1D_ll), POINTER :: TPLIST ! List of fields
+!
+ TYPE(LIST1D_ll), POINTER :: TZTEMP
+!
+!------------------------------------------------------------------------------
+!
+!* 1. Deallocate one by one the elements of TPLIST
+! --------------------------------------------
+!
+ IF (ASSOCIATED(TPLIST)) THEN
+ DO WHILE(ASSOCIATED(TPLIST))
+ TZTEMP => TPLIST
+ TPLIST => TPLIST%NEXT
+ DEALLOCATE(TZTEMP)
+ END DO
+ NULLIFY(TPLIST)
+ END IF
+!
+!------------------------------------------------------------------------------
+!
+ END SUBROUTINE CLEANLIST1D_ll
+
END MODULE MODE_ARGSLIST_ll
diff --git a/src/LIB/SURCOUCHE/src/mode_construct_ll.f90 b/src/LIB/SURCOUCHE/src/mode_construct_ll.f90
index b54e1a3b17701e6a5136cc6192f71ed1b85b375b..95ec8a43b86fadf39f50aefd59683550dfb0befd 100644
--- a/src/LIB/SURCOUCHE/src/mode_construct_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_construct_ll.f90
@@ -1,16 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for CVS information
-!-----------------------------------------------------------------
-! $Source$
-! $Name$
-! $Revision$
-! $Date$
-!-----------------------------------------------------------------
-!-----------------------------------------------------------------
! ########################
MODULE MODE_CONSTRUCT_ll
@@ -82,8 +74,6 @@
USE MODD_DIM_ll, ONLY : CLBCX, CLBCY
!
USE MODD_MPIF
-!
-! INCLUDE 'mpif.h'
!
CONTAINS
!
diff --git a/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90 b/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90
index 6d4a2c57504e2fdabecf613b4744446a489d37d3..93d5374168a1bf64bad4cc8b6a06886675d476da 100644
--- a/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_exchange2_ll.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -482,8 +482,6 @@ implicit none
USE MODD_MPIF
!
IMPLICIT NONE
-
-! INCLUDE 'mpif.h'
!
!* 0.1 declarations of arguments
!
@@ -716,8 +714,6 @@ implicit none
!
IMPLICIT NONE
!
-! INCLUDE 'mpif.h'
-!
!* 0.1 declarations of arguments
!
TYPE(CRSPD_ll), POINTER :: TPCRSPDSEND, TPCRSPDRECV
diff --git a/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90 b/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
index a5a47c36c7c229a8866df528622893845661738a..a087d3ca94dd56e9aa8c593eea6d0e1ea347ddf9 100644
--- a/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_exchange_ll.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -82,7 +82,6 @@
!JUANZ
USE MODD_VAR_ll, ONLY : NMNH_COMM_WORLD
!JUANZ
-! INCLUDE 'mpif.h'
!
!*
!
@@ -436,8 +435,6 @@
!
IMPLICIT NONE
!
-! INCLUDE 'mpif.h'
-!
!
!* 0.1 declarations of arguments
!
@@ -616,9 +613,6 @@ INTEGER :: NB_REQ
!JUANZ
IMPLICIT NONE
!
-! INCLUDE 'mpif.h'
-!
-!
!* 0.1 declarations of arguments
!
REAL, DIMENSION(:), POINTER :: PFIELD
diff --git a/src/LIB/SURCOUCHE/src/mode_field.f90 b/src/LIB/SURCOUCHE/src/mode_field.f90
index c6eca9e5cb6ead4f09a051774327023c7d67cb5b..97466a414e1dbb88e5fb8746cb10d3e65706df1c 100644
--- a/src/LIB/SURCOUCHE/src/mode_field.f90
+++ b/src/LIB/SURCOUCHE/src/mode_field.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2016-2019 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 for details. version 1.
@@ -11,162 +11,33 @@
! C. Lac 02/2019: add rain fraction as an output field
! S. Bielli 02/2019: sea salt: significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 06/03/2019: correct ZWS entry
-! P. Wautelet 12/04/2019: added pointers for C1D, L1D, N1D, X5D and X6D structures in TFIELDDATA
! P. Wautelet 06/06/2019: bug correction in FIELDLIST_GOTO_MODEL (XLSTHM was overwritten if LUSERV=.FALSE. due to wrong IF block)
! P. Wautelet 19/06/2019: add Fieldlist_nmodel_resize subroutine + provide KMODEL to INI_FIELD_LIST when known
+! P. Wautelet 23/01/2020: split in modd_field.f90 and mode_field.f90
+! JL Redelsperger 03/2021: add variables for Ocean LES and auto-coupled version
!-----------------------------------------------------------------
-MODULE MODE_FIELD
-!
-USE MODD_CONF, ONLY : CPROGRAM
-USE MODD_IO, ONLY : NVERB_DEBUG, NVERB_INFO, NVERB_WARNING, NVERB_ERROR, NVERB_FATAL
-USE MODD_PARAMETERS, only: JPMODELMAX, NGRIDUNKNOWN, NMNHNAMELGTMAX, NSTDNAMELGTMAX
-USE MODD_TYPE_DATE, ONLY : DATE_TIME
-#if defined(MNH_IOCDF4)
-USE NETCDF, ONLY : NF90_FILL_INT, NF90_FILL_REAL
-#endif
-!
-USE MODE_MSG
-!
-IMPLICIT NONE
-!
-#if 0
-!if enabled: crash of GCC 8.3 and 9.1 (and others?) in mode_io_field_read.f90
+module mode_field
+
+use modd_conf, only: cprogram
+use modd_field
+use modd_io, only: NVERB_DEBUG, NVERB_INFO, NVERB_WARNING, NVERB_ERROR, NVERB_FATAL
+use modd_parameters, only: JPMODELMAX
+
+use mode_msg
+
+implicit none
+
private
-!
-public :: TYPEUNDEF, TYPEINT, TYPELOG, TYPEREAL, TYPECHAR, TYPEDATE
-public :: TFIELDDATA
-public :: TFIELDLIST
-public :: INI_FIELD_LIST
-public :: FIND_FIELD_ID_FROM_MNHNAME
-public :: ALLOC_FIELD_SCALARS
-public :: FIELDLIST_GOTO_MODEL
+
+public :: Ini_field_list
+public :: Find_field_id_from_mnhname
+public :: Alloc_field_scalars
+public :: Fieldlist_goto_model
public :: Fieldlist_nmodel_resize
-#endif
-!
-INTEGER,PARAMETER :: MAXFIELDS = 250
-INTEGER,PARAMETER :: TYPEUNDEF = -1, TYPEINT = 1, TYPELOG = 2, TYPEREAL = 3, TYPECHAR = 4, TYPEDATE = 5
-!
-TYPE TFIELDPTR_C0D
- CHARACTER(LEN=:), POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_C0D
-!
-TYPE TFIELDPTR_C1D
- CHARACTER(LEN=:),DIMENSION(:),POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_C1D
-!
-TYPE TFIELDPTR_L0D
- LOGICAL, POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_L0D
-!
-TYPE TFIELDPTR_L1D
- LOGICAL,DIMENSION(:), POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_L1D
-!
-TYPE TFIELDPTR_N0D
- INTEGER, POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_N0D
-!
-TYPE TFIELDPTR_N1D
- INTEGER,DIMENSION(:), POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_N1D
-!
-TYPE TFIELDPTR_N2D
- INTEGER,DIMENSION(:,:), POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_N2D
-!
-TYPE TFIELDPTR_N3D
- INTEGER,DIMENSION(:,:,:),POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_N3D
-!
-TYPE TFIELDPTR_X0D
- REAL, POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_X0D
-!
-TYPE TFIELDPTR_X1D
- REAL,DIMENSION(:), POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_X1D
-!
-TYPE TFIELDPTR_X2D
- REAL,DIMENSION(:,:), POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_X2D
-!
-TYPE TFIELDPTR_X3D
- REAL,DIMENSION(:,:,:),POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_X3D
-!
-TYPE TFIELDPTR_X4D
- REAL,DIMENSION(:,:,:,:),POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_X4D
-!
-TYPE TFIELDPTR_X5D
- REAL,DIMENSION(:,:,:,:,:),POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_X5D
-!
-TYPE TFIELDPTR_X6D
- REAL,DIMENSION(:,:,:,:,:,:),POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_X6D
-!
-TYPE TFIELDPTR_T0D
- TYPE(DATE_TIME), POINTER :: DATA => NULL()
-END TYPE TFIELDPTR_T0D
-!
-!Structure describing the characteristics of a field
-TYPE TFIELDDATA
- CHARACTER(LEN=NMNHNAMELGTMAX) :: CMNHNAME = '' !Name of the field (for MesoNH, non CF convention)
- CHARACTER(LEN=NSTDNAMELGTMAX) :: CSTDNAME = '' !Standard name (CF convention)
- CHARACTER(LEN=32) :: CLONGNAME = '' !Long name (CF convention)
- CHARACTER(LEN=40) :: CUNITS = '' !Canonical units (CF convention)
- CHARACTER(LEN=2) :: CDIR = '' !Type of the data field (XX,XY,--...)
- CHARACTER(LEN=4) :: CLBTYPE = 'NONE' !Type of the lateral boundary (LBX,LBY,LBXU,LBYV)
- CHARACTER(LEN=100) :: CCOMMENT = '' !Comment (for MesoNH, non CF convention)
- INTEGER :: NGRID = NGRIDUNKNOWN !Localization on the model grid
- INTEGER :: NTYPE = TYPEUNDEF !Datatype
- INTEGER :: NDIMS = 0 !Number of dimensions
- LOGICAL :: LTIMEDEP = .FALSE. !Is the field time-dependent?
- !
-#if defined(MNH_IOCDF4)
- INTEGER :: NFILLVALUE = NF90_FILL_INT !Fill value for integer fields
- REAL :: XFILLVALUE = NF90_FILL_REAL !Fill value for real fields
- !NF90_FILL_REAL is the default fill value
- !used by netCDF to pre-fill real and also double
- !variables
-#else
- INTEGER :: NFILLVALUE = -2147483647 !Fill value for integer fields
- REAL :: XFILLVALUE = 9.9692099683868690e+36 !Fill value for real fields
-#endif
- INTEGER :: NVALIDMIN = -2147483646 !Minimum valid value for integer fields
- INTEGER :: NVALIDMAX = 2147483647 !Maximum valid value for integer fields
- REAL :: XVALIDMIN = -1.E36 !Minimum valid value for real fields
- REAL :: XVALIDMAX = 1.E36 !Maximum valid value for real fields
- !
- TYPE(TFIELDPTR_C0D),DIMENSION(:),ALLOCATABLE :: TFIELD_C0D !Pointer to the character string fields (one per nested mesh)
- TYPE(TFIELDPTR_C1D),DIMENSION(:),ALLOCATABLE :: TFIELD_C1D !Pointer to the character string 1D fields (one per nested mesh)
- !
- TYPE(TFIELDPTR_L0D),DIMENSION(:),ALLOCATABLE :: TFIELD_L0D !Pointer to the scalar logical fields (one per nested mesh)
- TYPE(TFIELDPTR_L1D),DIMENSION(:),ALLOCATABLE :: TFIELD_L1D !Pointer to the logical 1D fields (one per nested mesh)
- !
- TYPE(TFIELDPTR_N0D),DIMENSION(:),ALLOCATABLE :: TFIELD_N0D !Pointer to the scalar integer fields (one per nested mesh)
- TYPE(TFIELDPTR_N1D),DIMENSION(:),ALLOCATABLE :: TFIELD_N1D !Pointer to the integer 1D fields (one per nested mesh)
- TYPE(TFIELDPTR_N2D),DIMENSION(:),ALLOCATABLE :: TFIELD_N2D !Pointer to the integer 2D fields (one per nested mesh)
- TYPE(TFIELDPTR_N3D),DIMENSION(:),ALLOCATABLE :: TFIELD_N3D !Pointer to the integer 3D fields (one per nested mesh)
- !
- TYPE(TFIELDPTR_X0D),DIMENSION(:),ALLOCATABLE :: TFIELD_X0D !Pointer to the scalar real fields (one per nested mesh)
- TYPE(TFIELDPTR_X1D),DIMENSION(:),ALLOCATABLE :: TFIELD_X1D !Pointer to the real 1D fields (one per nested mesh)
- TYPE(TFIELDPTR_X2D),DIMENSION(:),ALLOCATABLE :: TFIELD_X2D !Pointer to the real 2D fields (one per nested mesh)
- TYPE(TFIELDPTR_X3D),DIMENSION(:),ALLOCATABLE :: TFIELD_X3D !Pointer to the real 3D fields (one per nested mesh)
- TYPE(TFIELDPTR_X4D),DIMENSION(:),ALLOCATABLE :: TFIELD_X4D !Pointer to the real 4D fields (one per nested mesh)
- TYPE(TFIELDPTR_X5D),DIMENSION(:),ALLOCATABLE :: TFIELD_X5D !Pointer to the real 5D fields (one per nested mesh)
- TYPE(TFIELDPTR_X6D),DIMENSION(:),ALLOCATABLE :: TFIELD_X6D !Pointer to the real 6D fields (one per nested mesh)
- !
- TYPE(TFIELDPTR_T0D),DIMENSION(:),ALLOCATABLE :: TFIELD_T0D !Pointer to the scalar date/time fields (one per nested mesh)
-END TYPE TFIELDDATA
-!
-integer, save :: NMODEL_ALLOCATED
-LOGICAL, SAVE :: LFIELDLIST_ISINIT = .FALSE.
-TYPE(TFIELDDATA),DIMENSION(MAXFIELDS),SAVE :: TFIELDLIST
-!
-CONTAINS
-!
+public :: Ini_field_scalars
+
+contains
+
SUBROUTINE INI_FIELD_LIST(KMODEL)
! Modif
! J.Escobar 25/04/2018: missing def of FRC
@@ -1177,6 +1048,32 @@ TFIELDLIST(IDX)%LTIMEDEP = .FALSE.
IDX = IDX+1
!
IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'LOCEAN'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'LOCEAN'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'Logical for Ocean MesoNH'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPELOG
+TFIELDLIST(IDX)%NDIMS = 0
+TFIELDLIST(IDX)%LTIMEDEP = .FALSE.
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'LCOUPLES'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'LCOUPLES'
+TFIELDLIST(IDX)%CUNITS = ''
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'Logical for coupling O-A LES'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPELOG
+TFIELDLIST(IDX)%NDIMS = 0
+TFIELDLIST(IDX)%LTIMEDEP = .FALSE.
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
TFIELDLIST(IDX)%CMNHNAME = 'SURF'
TFIELDLIST(IDX)%CSTDNAME = ''
TFIELDLIST(IDX)%CLONGNAME = 'SURF'
@@ -1399,6 +1296,20 @@ ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
IDX = IDX+1
!
IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'PHIT'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'PHIT'
+TFIELDLIST(IDX)%CUNITS = 'Pa'
+TFIELDLIST(IDX)%CDIR = 'XY'
+TFIELDLIST(IDX)%CCOMMENT = 'X_Y_Z_Reduced Pressure Oce/Shallow conv'
+TFIELDLIST(IDX)%NGRID = 1
+TFIELDLIST(IDX)%NTYPE = TYPEREAL
+TFIELDLIST(IDX)%NDIMS = 3
+TFIELDLIST(IDX)%LTIMEDEP = .TRUE.
+ALLOCATE(TFIELDLIST(IDX)%TFIELD_X3D(IMODEL))
+IDX = IDX+1
+!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
TFIELDLIST(IDX)%CMNHNAME = 'RT'
TFIELDLIST(IDX)%CSTDNAME = ''
TFIELDLIST(IDX)%CLONGNAME = 'RT'
@@ -3135,9 +3046,8 @@ IDX = IDX+1
!
IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
TFIELDLIST(IDX)%CMNHNAME = 'ACPRR'
-TFIELDLIST(IDX)%CSTDNAME = 'rainfall_amount'
+TFIELDLIST(IDX)%CSTDNAME = 'thickness_of_rainfall_amount'
TFIELDLIST(IDX)%CLONGNAME = 'ACPRR'
-!PW: TODO: CF-convention prefers 'kg m-2'
TFIELDLIST(IDX)%CUNITS = 'm'
TFIELDLIST(IDX)%CDIR = 'XY'
TFIELDLIST(IDX)%CCOMMENT = 'X_Y_ACcumulated Precipitation Rain Rate'
@@ -3579,6 +3489,31 @@ IDX = IDX+1
!END IF !LFILTERING
END IF !CPROGRAM==REAL .OR. LFICDF
!
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'NFRCLT'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'NFRCLT'
+TFIELDLIST(IDX)%CUNITS = '1'
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'number of sea surface forcings + 1'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPEINT
+TFIELDLIST(IDX)%NDIMS = 0
+TFIELDLIST(IDX)%LTIMEDEP = .FALSE.
+IDX = IDX+1
+IF(IDX>MAXFIELDS) CALL ERR_INI_FIELD_LIST()
+TFIELDLIST(IDX)%CMNHNAME = 'NINFRT'
+TFIELDLIST(IDX)%CSTDNAME = ''
+TFIELDLIST(IDX)%CLONGNAME = 'NINFRT'
+TFIELDLIST(IDX)%CUNITS = 's'
+TFIELDLIST(IDX)%CDIR = '--'
+TFIELDLIST(IDX)%CCOMMENT = 'Interval in seconds between forcings'
+TFIELDLIST(IDX)%NGRID = 0
+TFIELDLIST(IDX)%NTYPE = TYPEINT
+TFIELDLIST(IDX)%NDIMS = 0
+TFIELDLIST(IDX)%LTIMEDEP = .FALSE.
+IDX = IDX+1
+!
!
WRITE(YMSG,'("number of used fields=",I4," out of ",I4)') IDX-1,MAXFIELDS
CALL PRINT_MSG(NVERB_INFO,'GEN','INI_FIELD_LIST',TRIM(YMSG))
@@ -3854,6 +3789,7 @@ USE MODD_GRID_n
USE MODD_HURR_FIELD_n
USE MODD_LIMA_PRECIP_SCAVENGING_n
USE MODD_LSFIELD_n
+USE MODD_OCEANH
USE MODD_PARAM_n
USE MODD_PAST_FIELD_n
USE MODD_CH_PH_n
@@ -3886,6 +3822,9 @@ IF (.NOT.LFIELDLIST_ISINIT) THEN
RETURN
END IF
!
+if (kfrom > nmodel_allocated .or. kto > nmodel_allocated ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'FIELDLIST_GOTO_MODEL', 'kfrom or kto > nmodel_allocated' )
+!
! Initialize some pointers
!
!PW: TODO: check if still necessary as XRHODREFZ and XTHVREFZ are now initialiazed in ini_modeln even for KMI/=1 (29/01/2019)
@@ -3919,6 +3858,7 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('WT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(K
CALL FIND_FIELD_ID_FROM_MNHNAME('THT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XTHT
CALL FIND_FIELD_ID_FROM_MNHNAME('TKET', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XTKET
CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XPABST
+CALL FIND_FIELD_ID_FROM_MNHNAME('PHIT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XPHIT
CALL FIND_FIELD_ID_FROM_MNHNAME('RT', IID,IRESP); TFIELDLIST(IID)%TFIELD_X4D(KFROM)%DATA => XRT
!
IF (ASSOCIATED(XRT)) THEN
@@ -4053,7 +3993,7 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('LSUM', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(K
CALL FIND_FIELD_ID_FROM_MNHNAME('LSVM', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XLSVM
CALL FIND_FIELD_ID_FROM_MNHNAME('LSWM', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XLSWM
CALL FIND_FIELD_ID_FROM_MNHNAME('LSTHM',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XLSTHM
-IF ( LUSERV ) THEN
+IF (LUSERV) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('LSRVM',IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XLSRVM
END IF
CALL FIND_FIELD_ID_FROM_MNHNAME('LBXUM', IID,IRESP); TFIELDLIST(IID)%TFIELD_X3D(KFROM)%DATA => XLBXUM
@@ -4234,6 +4174,7 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('WT', IID,IRESP); XWT => TFIELDLIST(IID)%TF
CALL FIND_FIELD_ID_FROM_MNHNAME('THT', IID,IRESP); XTHT => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('TKET', IID,IRESP); XTKET => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('PABST',IID,IRESP); XPABST => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
+CALL FIND_FIELD_ID_FROM_MNHNAME('PHIT', IID,IRESP); XPHIT => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('RT', IID,IRESP); XRT => TFIELDLIST(IID)%TFIELD_X4D(KTO)%DATA
!
IF (ASSOCIATED(XRT)) THEN
@@ -4380,7 +4321,7 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('LSUM', IID,IRESP); XLSUM => TFIELDLIST(IID)%TF
CALL FIND_FIELD_ID_FROM_MNHNAME('LSVM', IID,IRESP); XLSVM => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('LSWM', IID,IRESP); XLSWM => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
CALL FIND_FIELD_ID_FROM_MNHNAME('LSTHM',IID,IRESP); XLSTHM => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
-IF ( LUSERV ) THEN
+IF (LUSERV) THEN
CALL FIND_FIELD_ID_FROM_MNHNAME('LSRVM',IID,IRESP); XLSRVM => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
END IF
CALL FIND_FIELD_ID_FROM_MNHNAME('LBXUM', IID,IRESP); XLBXUM => TFIELDLIST(IID)%TFIELD_X3D(KTO)%DATA
@@ -4540,6 +4481,7 @@ IF (.NOT.ASSOCIATED(TFIELDLIST(IID)%TFIELD_C0D(KTO)%DATA)) THEN
CALL PRINT_MSG(NVERB_DEBUG,'GEN','FIELDLIST_GOTO_MODEL',&
'TFIELDLIST(IID)%TFIELD_C0D(KTO)%DATA was not associated for '//TFIELDLIST(IID)%CMNHNAME)
ALLOCATE(CHARACTER(LEN=4) :: TFIELDLIST(IID)%TFIELD_C0D(KTO)%DATA)
+ TFIELDLIST(IID)%TFIELD_C0D(KTO)%DATA=''
END IF
CSURF => TFIELDLIST(IID)%TFIELD_C0D(KTO)%DATA
!
@@ -5093,4 +5035,4 @@ nmodel_allocated = kmodelnew
end subroutine Fieldlist_nmodel_resize
-END MODULE MODE_FIELD
+end module mode_field
diff --git a/src/LIB/SURCOUCHE/src/mode_ga.f90 b/src/LIB/SURCOUCHE/src/mode_ga.f90
index 9a2d05b6d6fe372ce51c922e91b467e545ed0b0b..ea98b0eedf5fd44edf7545347799c28335388319 100644
--- a/src/LIB/SURCOUCHE/src/mode_ga.f90
+++ b/src/LIB/SURCOUCHE/src/mode_ga.f90
@@ -9,6 +9,7 @@
! J. Escobar 05/02/2015: use JPHEXT from MODD_PARAMETERS_ll
! P. Wautelet 14/12/2018: split from fmwrit_ll.f90
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! J. Escobar 11/02/2020: for GA, add some sync, & reduce size of MA heap <-> not used
!-----------------------------------------------------------------
#ifdef MNH_GA
MODULE MODE_GA
@@ -20,11 +21,11 @@ MODULE MODE_GA
INTEGER, PARAMETER :: jpix=1 , jpiy = 2 , jpiz = 3
!
INTEGER :: NIMAX_ll,NJMAX_ll, IIU_ll,IJU_ll,IKU_ll
- integer :: heap=5*10**6, stack
+ integer :: heap=1*10**5, stack
logical :: gstatus_ga
INTEGER, PARAMETER :: ndim_GA = 3
INTEGER, DIMENSION(ndim_GA) :: dims_GA , chunk_GA
- INTEGER,PARAMETER :: CI=1 ,CJ=-1 ,CK=-1
+ INTEGER,PARAMETER :: CI= 1 ,CJ=-1 ,CK=-1
INTEGER :: g_a
integer, DIMENSION(ndim_GA) :: lo_col, hi_col , ld_col
integer, DIMENSION(ndim_GA) :: lo_zplan , hi_zplan , ld_zplan
@@ -68,6 +69,8 @@ MODULE MODE_GA
call ga_initialize()
END IF
+ call ga_sync()
+
CALL GET_GLOBALDIMS_ll (NIMAX_ll,NJMAX_ll)
IIU_ll = NIMAX_ll + 2*JPHEXT
IJU_ll = NJMAX_ll + 2*JPHEXT
@@ -92,9 +95,11 @@ MODULE MODE_GA
! reallocate the g_a , if need with bigger Z size
!
IF ( IKU_ll_MAX .NE. -1 ) gstatus_ga = ga_destroy(g_a)
+ call ga_sync()
IIU_ll_MAX = IIU_ll
IJU_ll_MAX = IJU_ll
IKU_ll_MAX = IKU_ll
+ !print*,"MNH_INIT_GA::nga_create=",MT_F_DBL, ndim_GA, dims_GA, HRECFM ,chunk_GA, g_a ; call flush(6)
gstatus_ga = nga_create(MT_F_DBL, ndim_GA, dims_GA, HRECFM ,chunk_GA, g_a)
call ga_sync()
END IF
diff --git a/src/LIB/SURCOUCHE/src/mode_gather.f90 b/src/LIB/SURCOUCHE/src/mode_gather.f90
index 631362f1caf295c21d3f16bac589772a8db11818..d57d47cf8566544bc2be3aa09a15c6ff9b65670e 100644
--- a/src/LIB/SURCOUCHE/src/mode_gather.f90
+++ b/src/LIB/SURCOUCHE/src/mode_gather.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.
@@ -8,7 +8,7 @@
! J. Escobar 22/05/2012: bug in ISEND with non-contiguous buffer: reintroduce intermediate buffer
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: use modd_precision parameters for datatypes of MPI communications
-!
+! P. Wautelet 14/01/2021: add GATHERXX_N4, GATHERXX_L3, GATHERXY_N4 and GATHERXY_L3 subroutines
!-----------------------------------------------------------------
MODULE MODE_GATHER_ll
@@ -29,13 +29,20 @@ INTERFACE GATHERALL_FIELD_ll
END INTERFACE
INTERFACE GATHER_XXFIELD
- MODULE PROCEDURE GATHERXX_X1,GATHERXX_X2,GATHERXX_X3,GATHERXX_X4,GATHERXX_X5,&
- & GATHERXX_X6,GATHERXX_N1,GATHERXX_N2,GATHERXX_N3,GATHERXX_L1,GATHERXX_L3
+ MODULE PROCEDURE &
+ GATHERXX_X1, GATHERXX_X2, GATHERXX_X3, &
+ GATHERXX_X4, GATHERXX_X5, GATHERXX_X6, &
+ GATHERXX_N1, GATHERXX_N2, GATHERXX_N3, &
+ GATHERXX_N4, &
+ GATHERXX_L1, GATHERXX_L3
END INTERFACE
INTERFACE GATHER_XYFIELD
- MODULE PROCEDURE GATHERXY_X2,GATHERXY_X3,GATHERXY_X4,GATHERXY_X5,GATHERXY_X6,&
- & GATHERXY_N2,GATHERXY_N3,GATHERXY_L3
+ MODULE PROCEDURE &
+ GATHERXY_X2, GATHERXY_X3, GATHERXY_X4, &
+ GATHERXY_X5, GATHERXY_X6, &
+ GATHERXY_N2, GATHERXY_N3, GATHERXY_N4, &
+ GATHERXY_L3
END INTERFACE
PUBLIC GATHER_XXFIELD,GATHER_XYFIELD,GATHERALL_FIELD_ll,GATHERALL_X1,&
@@ -64,7 +71,7 @@ ELSE
KRESP =-1
PRINT *,'Error GATHERALL_X1'
END IF
-! PRECV variable of IROOT processor contains the global field
+! PRECV variable of IROOT process contains the global field
CALL MPI_BCAST(PRECV,SIZE(PRECV),MNHREAL_MPI,IROOT-1,NMNH_COMM_WORLD,KRESP)
END SUBROUTINE GATHERALL_X1
@@ -87,7 +94,7 @@ ELSE IF (HDIR == 'XY') THEN
ELSE
PRINT *,'Error GATHERALL_X2'
END IF
-! PRECV variable of IROOT processor contains the global field
+! PRECV variable of IROOT process contains the global field
CALL MPI_BCAST(PRECV,SIZE(PRECV),MNHREAL_MPI,IROOT-1,NMNH_COMM_WORLD,KRESP)
END SUBROUTINE GATHERALL_X2
@@ -111,7 +118,7 @@ ELSE
PRINT *,'Error GATHERALL_X3'
KRESP = -1
END IF
-! PRECV variable of IROOT processor contains the global field
+! PRECV variable of IROOT process contains the global field
CALL MPI_BCAST(PRECV,SIZE(PRECV),MNHREAL_MPI,IROOT-1,NMNH_COMM_WORLD,KRESP)
END SUBROUTINE GATHERALL_X3
@@ -133,7 +140,7 @@ IF (HDIR == 'XX' .OR. HDIR == 'YY') THEN
ELSE
PRINT *,'Error GATHERALL_N1'
END IF
-! KRECV variable of IROOT processor contains the global field
+! KRECV variable of IROOT process contains the global field
CALL MPI_BCAST(KRECV,SIZE(KRECV),MNHINT_MPI,IROOT-1,NMNH_COMM_WORLD,KRESP)
END SUBROUTINE GATHERALL_N1
@@ -156,7 +163,7 @@ ELSE IF (HDIR == 'XY') THEN
ELSE
PRINT *,'Error GATHERALL_N2'
END IF
-! KRECV variable of IROOT processor contains the global field
+! KRECV variable of IROOT process contains the global field
CALL MPI_BCAST(KRECV,SIZE(KRECV),MNHINT_MPI,IROOT-1,NMNH_COMM_WORLD,KRESP)
END SUBROUTINE GATHERALL_N2
@@ -180,7 +187,7 @@ ELSE
PRINT *,'Error GATHERALL_L3'
KRESP = -1
END IF
-! ORECV variable of IROOT processor contains the global field
+! ORECV variable of IROOT process contains the global field
CALL MPI_BCAST(ORECV,SIZE(ORECV),MNHLOG_MPI,IROOT-1,NMNH_COMM_WORLD,KRESP)
END SUBROUTINE GATHERALL_L3
@@ -238,7 +245,7 @@ IF (ISP == KROOT) THEN
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
@@ -306,7 +313,7 @@ IF (ISP == KROOT) THEN
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
@@ -367,7 +374,7 @@ IF (ISP == KROOT) THEN
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
@@ -428,7 +435,7 @@ IF (ISP == KROOT) THEN
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
@@ -489,7 +496,7 @@ IF (ISP == KROOT) THEN
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
@@ -550,7 +557,7 @@ IF (ISP == KROOT) THEN
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
@@ -612,7 +619,7 @@ IF (ISP == KROOT) THEN
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
@@ -675,7 +682,7 @@ IF (ISP == KROOT) THEN
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
@@ -736,7 +743,7 @@ IF (ISP == KROOT) THEN
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
@@ -751,6 +758,68 @@ END IF
END SUBROUTINE GATHERXX_N3
+
+SUBROUTINE GATHERXX_N4(HDIR,KSEND,KRECV,KROOT,KCOMM)
+USE MODD_IO, ONLY: ISP, ISNPROC
+
+CHARACTER(LEN=*), INTENT(IN) :: HDIR
+INTEGER, DIMENSION(:,:,:,:), TARGET, INTENT(IN) :: KSEND
+INTEGER, DIMENSION(:,:,:,:), TARGET, INTENT(INOUT) :: KRECV
+INTEGER, INTENT(IN) :: KROOT
+INTEGER, INTENT(IN) :: KCOMM
+
+INTEGER :: JI
+INTEGER :: IXO,IXE,IYO,IYE
+INTEGER :: IGXO,IGXE,IGYO,IGYE
+INTEGER :: IERR
+INTEGER :: IXM, IYM
+INTEGER, DIMENSION(:,:,:,:), POINTER :: IP
+
+CALL GET_DOMWRITE_ll(KROOT,'global',IGXO,IGXE,IGYO,IGYE)
+IXM = (IGXE+IGXO)/2
+IYM = (IGYE+IGYO)/2
+
+IF (ISP == KROOT) THEN
+ ! I/O proc case
+ DO JI=1,ISNPROC
+ CALL GET_DOMWRITE_ll(JI,'global',IGXO,IGXE,IGYO,IGYE)
+ CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE)
+
+ IF (HDIR == 'XX' .AND. IYM <= IGYE .AND. IYM >= IGYO) THEN
+ IP=>KRECV(IGXO:IGXE,:,:,:)
+ IF (JI == KROOT) THEN
+ IP = KSEND(IXO:IXE,:,:,:)
+ ELSE
+ CALL MPI_RECV(IP,SIZE(IP),MNHINT_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ END IF
+
+ ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
+ IP=>KRECV(IGYO:IGYE,:,:,:)
+ IF (JI==KROOT) THEN
+ IP = KSEND(IYO:IYE,:,:,:)
+ ELSE
+ CALL MPI_RECV(IP,SIZE(IP),MNHINT_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ END IF
+ END IF
+ END DO
+
+ELSE
+ ! Other processes
+ CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
+ CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
+
+ IF (HDIR == 'XX' .AND. IYM <= IGYE .AND. IYM >= IGYO) THEN
+ IP=>KSEND(IXO:IXE,:,:,:)
+ CALL MPI_BSEND(IP,SIZE(IP),MNHINT_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
+ ELSE IF (HDIR == 'YY' .AND. IXM <= IGXE .AND. IXM >= IGXO) THEN
+ IP=>KSEND(IYO:IYE,:,:,:)
+ CALL MPI_BSEND(IP,SIZE(IP),MNHINT_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
+ END IF
+END IF
+
+END SUBROUTINE GATHERXX_N4
+
+
SUBROUTINE GATHERXX_L1(HDIR,OSEND,ORECV,KROOT,KCOMM)
USE MODD_IO, ONLY: ISP, ISNPROC
@@ -798,7 +867,7 @@ IF (ISP == KROOT) THEN
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
@@ -859,7 +928,7 @@ IF (ISP == KROOT) THEN
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'global',IGXO,IGXE,IGYO,IGYE)
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
@@ -914,7 +983,7 @@ IF (ISP == KROOT) THEN
END IF
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
IF (IXO /= 0) THEN ! intersection is not empty
XP=>PSEND(IXO:IXE,IYO:IYE)
@@ -961,7 +1030,7 @@ IF (ISP == KROOT) THEN
END IF
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
IF (IXO /= 0) THEN ! intersection is not empty
XP=>PSEND(IXO:IXE,IYO:IYE,:)
@@ -1002,7 +1071,7 @@ IF (ISP == KROOT) THEN
END IF
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
IF (IXO /= 0) THEN ! intersection is not empty
XP=>PSEND(IXO:IXE,IYO:IYE,:,:)
@@ -1043,7 +1112,7 @@ IF (ISP == KROOT) THEN
END IF
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
IF (IXO /= 0) THEN ! intersection is not empty
XP=>PSEND(IXO:IXE,IYO:IYE,:,:,:)
@@ -1084,7 +1153,7 @@ IF (ISP == KROOT) THEN
END IF
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
IF (IXO /= 0) THEN ! intersection is not empty
XP=>PSEND(IXO:IXE,IYO:IYE,:,:,:,:)
@@ -1121,7 +1190,7 @@ IF (ISP == KROOT) THEN
END IF
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
ITP=>KSEND(IXO:IXE,IYO:IYE)
CALL MPI_BSEND(ITP,SIZE(ITP),MNHINT_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
@@ -1160,7 +1229,7 @@ IF (ISP == KROOT) THEN
END IF
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
IF (IXO /= 0) THEN ! intersection is not empty
IP=>KSEND(IXO:IXE,IYO:IYE,:)
@@ -1170,6 +1239,48 @@ END IF
END SUBROUTINE GATHERXY_N3
+
+SUBROUTINE GATHERXY_N4(KSEND,KRECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
+USE MODD_IO, ONLY: ISP, ISNPROC
+
+INTEGER, DIMENSION(:,:,:,:), TARGET, INTENT(IN) :: KSEND
+INTEGER, DIMENSION(:,:,:,:), TARGET, INTENT(INOUT) :: KRECV
+INTEGER, INTENT(IN) :: KROOT
+INTEGER, INTENT(IN) :: KCOMM
+INTEGER, OPTIONAL, INTENT(IN) :: KXOBOX,KXEBOX,KYOBOX,KYEBOX
+CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HINTER
+
+INTEGER :: JI
+INTEGER :: IXO,IXE,IYO,IYE
+INTEGER :: IERR
+INTEGER, DIMENSION(:,:,:,:), POINTER :: IP
+
+IF (ISP == KROOT) THEN
+ ! I/O proc case
+ DO JI=1,ISNPROC
+ CALL GET_DOMWRITE_ll(JI,'global',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
+ IF (IXO /= 0) THEN ! intersection is not empty
+ IP=>KRECV(IXO:IXE,IYO:IYE,:,:)
+ IF (ISP == JI) THEN
+ CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
+ IP = KSEND(IXO:IXE,IYO:IYE,:,:)
+ ELSE
+ CALL MPI_RECV(IP,SIZE(IP),MNHINT_MPI,JI-1,99+KROOT,KCOMM,MPI_STATUS_IGNORE,IERR)
+ END IF
+ END IF
+ END DO
+ELSE
+ ! Other processes
+ CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
+ IF (IXO /= 0) THEN ! intersection is not empty
+ IP=>KSEND(IXO:IXE,IYO:IYE,:,:)
+ CALL MPI_BSEND(IP,SIZE(IP),MNHINT_MPI,KROOT-1,99+KROOT,KCOMM,IERR)
+ END IF
+END IF
+
+END SUBROUTINE GATHERXY_N4
+
+
SUBROUTINE GATHERXY_L3(OSEND,ORECV,KROOT,KCOMM,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
USE MODD_IO, ONLY : ISP, ISNPROC
@@ -1201,7 +1312,7 @@ IF (ISP == KROOT) THEN
END IF
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX,HINTER)
IF (IXO /= 0) THEN ! intersection is not empty
IP=>OSEND(IXO:IXE,IYO:IYE,:)
@@ -1241,7 +1352,7 @@ IF (ISP == KROOT) THEN
END IF
END DO
ELSE
- ! Other processors
+ ! Other processes
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE,KXOBOX,KXEBOX,KYOBOX,KYEBOX)
IF (IXO /= 0) THEN ! intersection is not empty
XP=>PSEND(IXO:IXE,IYO:IYE)
diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90
index 09f3f32ee8466d421b437975dc887220e8585cc2..0dd4e0ae6fd5e406124f62d15e02cbfc46d77523 100644
--- a/src/LIB/SURCOUCHE/src/mode_io.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io.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.
@@ -46,7 +46,7 @@ CONTAINS
IF (GCONFIO) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Config_set','already called (ignoring this call)')
ELSE
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
LIOCDF4 = OIOCDF4
LLFIOUT = OLFIOUT
LLFIREAD = OLFIREAD
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
index 8f717bce0cda430ec8cb752eab038973db07b230..15bb499d2ca93f21606dbcee61087753ef7c4230 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_read.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -15,17 +15,21 @@
! P. Wautelet 12/04/2019: use MNHTIME for time measurement variables
! P. Wautelet 26/04/2019: use modd_precision parameters for datatypes of MPI communications
! P. Wautelet 25/06/2019: added IO_Field_read for 3D integer arrays (IO_Field_read_byname_N3 and IO_Field_read_byfield_N3)
+! J. Escobar 11/02/2020: for GA & // IO, add update_halo + sync, & mpi_allreduce for error handling in // IO
+! P. Wautelet 22/09/2020: add IO_Format_read_select subroutine
+! P. Wautelet 22/09/2020: use ldimreduced to allow reduction in the number of dimensions of fields (used by 2D simulations)
!-----------------------------------------------------------------
MODULE MODE_IO_FIELD_READ
!
+use modd_field
USE MODD_IO, ONLY : NVERB_FATAL,NVERB_ERROR,NVERB_WARNING,NVERB_INFO,NVERB_DEBUG,TFILEDATA
USE MODD_MPIF
use modd_precision, only: MNHINT_MPI, MNHLOG_MPI, MNHREAL_MPI, MNHTIME
!
-USE MODE_FIELD
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_READ_LFI
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
USE MODE_IO_READ_NC4
#endif
USE MODE_MSG
@@ -94,6 +98,21 @@ END IF
END SUBROUTINE IO_File_read_check
+subroutine IO_Format_read_select( tpfile, olfi, onc4 )
+type(tfiledata), intent(in) :: tpfile ! File structure
+logical, intent(out) :: olfi ! Read in LFI format?
+logical, intent(out) :: onc4 ! Read in netCDF format?
+
+olfi = .false.
+onc4 = .false.
+if ( tpfile%cformat == 'LFI' ) olfi = .true.
+#ifdef MNH_IOCDF4
+if ( tpfile%cformat == 'NETCDF4' .or. tpfile%cformat == 'LFICDF4') onc4 = .true.
+#endif
+
+end subroutine IO_Format_read_select
+
+
SUBROUTINE IO_Field_metadata_bcast(TPFILE,TPFIELD)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
@@ -147,31 +166,24 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
INTEGER :: IRESP
+logical :: glfi, gnc4
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
IRESP = 0
!
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X0',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, pfield, iresp )
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, pfield, iresp )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -237,6 +249,7 @@ TYPE(ZONE_ll),DIMENSION(ISNPROC),OPTIONAL,INTENT(IN) :: TPSPLITTING ! splitting
INTEGER :: IERR
REAL,DIMENSION(:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
+logical :: glfi, gnc4
INTEGER :: IRESP
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
@@ -246,26 +259,18 @@ IRESP = 0
ZFIELDP => NULL()
!
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X1',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, pfield, iresp )
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC, KIMAX_ll, KJMAX_ll)
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfieldp, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
ALLOCATE(ZFIELDP(0))
@@ -326,6 +331,7 @@ END SUBROUTINE IO_Field_read_byname_X2
SUBROUTINE IO_Field_read_byfield_X2(TPFILE,TPFIELD,PFIELD,KRESP,KIMAX_ll,KJMAX_ll,TPSPLITTING)
!
+use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISP, ISNPROC, LPACK, L1D, L2D
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_STRUCTURE_ll, ONLY: ZONE_ll
@@ -338,6 +344,11 @@ USE MODE_GA
USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
USE MODE_SCATTER_ll
!
+#ifdef MNH_GA
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+USE MODE_ll , ONLY : ADD2DFIELD_ll,UPDATE_HALO_ll,CLEANLIST_ll
+#endif
+!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
REAL,DIMENSION(:,:),TARGET,INTENT(INOUT) :: PFIELD ! array containing the data field
@@ -347,66 +358,97 @@ INTEGER, OPTIONAL, INTENT(IN) :: KJMAX_ll
TYPE(ZONE_ll),DIMENSION(ISNPROC),OPTIONAL,INTENT(IN) :: TPSPLITTING ! splitting of the domain
!
INTEGER :: IERR
-REAL,DIMENSION(:,:),POINTER :: ZFIELDP
+real :: zfieldp0d
+real, dimension(:), pointer :: zfieldp1d
+REAL, DIMENSION(:,:), POINTER :: ZFIELDP
LOGICAL :: GALLOC
+logical :: glfi, gnc4
INTEGER :: IRESP
INTEGER :: IHEXTOT
-REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2
-REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
+REAL(kind=MNHTIME), DIMENSION(2) :: ZT0, ZT1, ZT2
+REAL(kind=MNHTIME), DIMENSION(2) :: ZT11, ZT22
+type(tfielddata) :: tzfield
#ifdef MNH_GA
-REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
+REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
+TYPE(LIST_ll) ,POINTER :: TZFIELD_ll
+INTEGER :: IINFO_ll
#endif
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
-CALL SECOND_MNH2(T11)
+CALL SECOND_MNH2(ZT11)
GALLOC = .FALSE.
IRESP = 0
ZFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X2',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1)
- ELSE
- ZFIELDP=>PFIELD(:,:)
- END IF
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- END IF
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- PFIELD(:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- PFIELD(:,:)=SPREAD(PFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
- END IF
+ if ( lpack .and. l1d .and. Size( pfield, 1 ) == ihextot .and. Size( pfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3) !Necessary if time dimension
+ tzfield%ndimlist(2:) = NMNHDIM_UNUSED
+ end if
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp0d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp0d, iresp )
+ pfield(:, :) = Spread( Spread( zfieldp0d, dim = 1, ncopies = ihextot ), dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
+ pfield(:, :) = Spread( Spread( pfield(jphext + 1, jphext + 1), dim = 1, ncopies = ihextot ), dim = 2, ncopies = ihextot )
+ endif
+ else if ( lpack .and. l2d .and. Size( pfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3) !Necessary if time dimension
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+ end if
+ zfieldp1d => pfield(:, jphext + 1)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp1d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp1d, iresp )
+ pfield(:, :) = Spread( pfield(:, jphext + 1), dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(:, jphext + 1 : jphext + 1)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
+ pfield(:,:) = Spread( pfield(:, jphext + 1), dim = 2, ncopies = ihextot )
+ endif
+ else
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, pfield, iresp )
+ end if
ELSE
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O process case
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC, KIMAX_ll, KJMAX_ll)
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfieldp, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
ALLOCATE(ZFIELDP(0,0))
GALLOC = .TRUE.
END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ2D_READ=TIMEZ%T_READ2D_READ + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_READ2D_READ=TIMEZ%T_READ2D_READ + ZT1 - ZT0
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
!
@@ -420,6 +462,7 @@ IF (IRESP==0) THEN
ELSE IF (TPFIELD%CDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
! 2D compact case
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X2', '2D not (yet) allowed for parallel execution' )
CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1),PFIELD(:,JPHEXT+1),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM,TPSPLITTING)
PFIELD(:,:) = SPREAD(PFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
ELSE
@@ -434,16 +477,23 @@ IF (IRESP==0) THEN
!
lo_zplan(JPIZ) = 1
hi_zplan(JPIZ) = 1
+ !print*,"IO_READ_FIELD_BYFIELD_X2::nga_put=",g_a, lo_zplan, hi_zplan, ld_zplan, TPFIELD%CMNHNAME ; call flush(6)
call nga_put(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
END IF
- call ga_sync
+ call ga_sync()
!
! get the columun data in this proc
!
! temp buf to avoid problem with none stride PFIELDS buffer with HALO
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
+ !print*,"IO_READ_FIELD_BYFIELD_X2::nga_get=",g_a, lo_col, hi_col, ld_col, TPFIELD%CMNHNAME ; call flush(6)
call nga_get(g_a, lo_col, hi_col,ZFIELD_GA(1,1) , ld_col)
PFIELD = ZFIELD_GA
+ call ga_sync()
+ NULLIFY(TZFIELD_ll)
+ CALL ADD2DFIELD_ll(TZFIELD_ll,PFIELD )
+ CALL UPDATE_HALO_ll(TZFIELD_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELD_ll)
DEALLOCATE(ZFIELD_GA)
#else
! XY Scatter Field
@@ -453,8 +503,8 @@ IF (IRESP==0) THEN
ELSE
CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
- CALL SECOND_MNH2(T2)
- TIMEZ%T_READ2D_SCAT=TIMEZ%T_READ2D_SCAT + T2 - T1
+ CALL SECOND_MNH2(ZT2)
+ TIMEZ%T_READ2D_SCAT=TIMEZ%T_READ2D_SCAT + ZT2 - ZT1
END IF
END IF
!
@@ -464,8 +514,8 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-CALL SECOND_MNH2(T22)
-TIMEZ%T_READ2D_ALL=TIMEZ%T_READ2D_ALL + T22 - T11
+CALL SECOND_MNH2(ZT22)
+TIMEZ%T_READ2D_ALL=TIMEZ%T_READ2D_ALL + ZT22 - ZT11
!
END SUBROUTINE IO_Field_read_byfield_X2
@@ -492,6 +542,7 @@ END SUBROUTINE IO_Field_read_byname_X3
SUBROUTINE IO_Field_read_byfield_X3(TPFILE,TPFIELD,PFIELD,KRESP)
!
+use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISP, ISNPROC, LPACK, L1D, L2D
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -500,6 +551,7 @@ USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
USE MODE_ALLOCBUFFER_ll
#ifdef MNH_GA
USE MODE_GA
+USE MODI_GET_HALO
#endif
USE MODE_IO_TOOLS, ONLY: IO_Level2filenumber_get
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
@@ -515,26 +567,29 @@ TYPE TX_2DP
REAL,DIMENSION(:,:), POINTER :: X
END TYPE TX_2DP
!
-INTEGER :: IERR,IRESP,IRESP_TMP
+INTEGER :: IERR,IRESP,IRESP_TMP,IRESP_ISP
INTEGER :: IHEXTOT
INTEGER :: IK_FILE,IK_RANK,INB_PROC_REAL,JK_MAX
INTEGER :: JI,IXO,IXE,IYO,IYE
INTEGER :: JK,JKK
-INTEGER :: NB_REQ
-INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
-INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
+INTEGER :: INB_REQ
+INTEGER,ALLOCATABLE,DIMENSION(:) :: IREQ_TAB
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
LOGICAL :: GALLOC, GALLOC_ll
-REAL,DIMENSION(:,:),POINTER :: TX2DP
+logical :: glfi, gnc4
+REAL,DIMENSION(:,:),POINTER :: ZTX2DP
REAL,DIMENSION(:,:),POINTER :: ZSLICE_ll,ZSLICE
-REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
-REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2
-REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
+real,dimension(:), pointer :: zfieldp1d
+real,dimension(:,:), pointer :: zfieldp2d
+REAL,DIMENSION(:,:,:), POINTER :: ZFIELDP
+REAL(kind=MNHTIME), DIMENSION(2) :: ZT0, ZT1, ZT2
+REAL(kind=MNHTIME), DIMENSION(2) :: ZT11, ZT22
CHARACTER(LEN=2) :: YDIR
CHARACTER(LEN=4) :: YK
CHARACTER(LEN=NMNHNAMELGTMAX+4) :: YRECZSLICE
CHARACTER(LEN=4) :: YSUFFIX
+type(tfielddata) :: tzfield
TYPE(TFILEDATA),POINTER :: TZFILE
-TYPE(TFIELDDATA) :: TZFIELD
TYPE(TX_2DP),ALLOCATABLE,DIMENSION(:) :: T_TX2DP
#ifdef MNH_GA
REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
@@ -542,7 +597,7 @@ REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
-CALL SECOND_MNH2(T11)
+CALL SECOND_MNH2(ZT11)
!
TZFILE => NULL()
GALLOC = .FALSE.
@@ -554,39 +609,69 @@ YDIR = TPFIELD%CDIR
IHEXTOT = 2*JPHEXT+1
!
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X3',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC .AND. TPFILE%NSUBFILES_IOZ==0 ) THEN ! sequential execution
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:)
- ELSE
- ZFIELDP=>PFIELD(:,:,:)
- END IF
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- END IF
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- PFIELD(:,:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1,:),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- PFIELD(:,:,:)=SPREAD(PFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
- END IF
+ if ( lpack .and. l1d .and. Size( pfield, 1 ) == ihextot .and. Size( pfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3)
+ tzfield%ndimlist(2) = tzfield%ndimlist(4) !Necessary if time dimension
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+ end if
+ zfieldp1d => pfield(jphext+1, jphext+1, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp1d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp1d, iresp )
+ pfield(:, :, :) = Spread( Spread( pfield(jphext + 1, jphext + 1, :), dim = 1, ncopies = ihextot ), &
+ dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
+ pfield(:, :, :) = Spread( Spread( pfield(jphext + 1, jphext + 1, :), dim = 1, ncopies = ihextot ), &
+ dim = 2, ncopies = ihextot )
+ endif
+ else if ( lpack .and. l2d .and. Size( pfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3)
+ tzfield%ndimlist(3) = tzfield%ndimlist(4) !Necessary if time dimension
+ tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+ zfieldp2d => pfield(:, jphext + 1, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp2d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp2d, iresp )
+ pfield(:, :, :) = Spread( pfield(:, jphext + 1, :), dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(:, jphext + 1 : jphext + 1, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
+ pfield(:,:, :) = Spread( pfield(:, jphext + 1, :), dim = 2, ncopies = ihextot )
+ endif
+ else
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, pfield, iresp )
+ end if
ELSE IF ( TPFILE%NSUBFILES_IOZ==0 .OR. YDIR == '--' ) THEN ! multiprocesses execution & 1 IO proc
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O process case
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,YDIR,GALLOC)
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfieldp, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
ALLOCATE(ZFIELDP(0,0,0))
@@ -605,6 +690,7 @@ IF (IRESP==0) THEN
ELSE IF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
! 2D compact case
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X3', '2D not (yet) allowed for parallel execution' )
CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,JPHEXT+1,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
PFIELD(:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
ELSE
@@ -623,14 +709,15 @@ IF (IRESP==0) THEN
!
! init/create the ga
!
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),TPFIELD%CMNHNAME,"READ")
!
! read the data
!
ALLOCATE(ZSLICE_ll(0,0)) ! to avoid bug on test of size
GALLOC_ll = .TRUE.
- DO JKK=1,IKU_ll
+ IRESP_ISP=0
+ DO JKK=1,SIZE(PFIELD,3) ! IKU_ll
IK_FILE = IO_Level2filenumber_get(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
TZFIELD = TPFIELD
@@ -648,44 +735,46 @@ IF (IRESP==0) THEN
CALL ALLOCBUFFER_ll(ZSLICE_ll,ZSLICE,YDIR,GALLOC_ll)
END IF
!
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
WRITE(YK,'(I4.4)') JKK
YRECZSLICE = TRIM(TPFIELD%CMNHNAME)//YK
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
+ call IO_Format_read_select( tzfile, glfi, gnc4 ) !Safer to do that (probably useless)
+ if ( gnc4 ) call IO_Field_read_nc4( tzfile, tzfield, zslice_ll, iresp_tmp )
+ if ( glfi ) call IO_Field_read_lfi( tzfile, tzfield, zslice_ll, iresp_tmp )
+ IF (IRESP_TMP .NE. 0 ) IRESP_ISP = IRESP_TMP
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + ZT1 - ZT0
!
! put the data in the g_a , this proc get this JKK slide
!
LO_ZPLAN(JPIZ) = JKK
HI_ZPLAN(JPIZ) = JKK
+ !print*,"IO_READ_FIELD_BYFIELD_X3::nga_put=",g_a, lo_zplan, hi_zplan, ld_zplan, TZFIELD%CMNHNAME ; call flush(6)
CALL NGA_PUT(G_A, LO_ZPLAN, HI_ZPLAN,ZSLICE_LL, LD_ZPLAN)
END IF
TZFILE => NULL()
END DO
- CALL GA_SYNC
+ CALL GA_SYNC()
!
- CALL MPI_BCAST(IRESP_TMP,1,MNHINT_MPI,IK_RANK-1,TZFILE%NMPICOMM,IERR)
+ CALL MPI_ALLREDUCE(-ABS(IRESP_ISP),IRESP_TMP,1,MNHINT_MPI,MPI_MIN,TPFILE%NMPICOMM,IRESP)
IF (IRESP_TMP/=0) IRESP = IRESP_TMP !Keep last "error"
!
! get the columun data in this proc
!
! temp buf to avoid problem with none stride PFIELDS buffer with HALO
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
+ !print*,"IO_READ_FIELD_BYFIELD_X3::nga_get=",g_a, lo_col, hi_col, ld_col, TPFIELD%CMNHNAME ; call flush(6)
CALL NGA_GET(G_A, LO_COL, HI_COL,ZFIELD_GA(1,1,1) , LD_COL)
PFIELD = ZFIELD_GA
+ call ga_sync()
+ CALL GET_HALO(PFIELD)
DEALLOCATE(ZFIELD_GA)
#else
ALLOCATE(ZSLICE_ll(0,0))
GALLOC_ll = .TRUE.
+ IRESP_ISP=0
INB_PROC_REAL = MIN(TPFILE%NSUBFILES_IOZ,ISNPROC)
- ALLOCATE(REQ_TAB((ISNPROC-1)*INB_PROC_REAL))
+ ALLOCATE(IREQ_TAB((ISNPROC-1)*INB_PROC_REAL))
ALLOCATE(T_TX2DP((ISNPROC-1)*INB_PROC_REAL))
Z_SLICE: DO JK=1,SIZE(PFIELD,3),INB_PROC_REAL
!
@@ -693,7 +782,7 @@ IF (IRESP==0) THEN
!
JK_MAX=MIN(SIZE(PFIELD,3),JK+INB_PROC_REAL-1)
!
- NB_REQ=0
+ INB_REQ=0
DO JKK=JK,JK_MAX
IF (TPFILE%NSUBFILES_IOZ .GT. 1 ) THEN
IK_FILE = IO_Level2filenumber_get(JKK,TPFILE%NSUBFILES_IOZ)
@@ -714,38 +803,33 @@ IF (IRESP==0) THEN
DEALLOCATE(ZSLICE_ll)
CALL ALLOCBUFFER_ll(ZSLICE_ll,ZSLICE,YDIR,GALLOC_ll)
END IF
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
WRITE(YK,'(I4.4)') JKK
YRECZSLICE = TRIM(TPFIELD%CMNHNAME)//YK
- IF (TZFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
- ELSE IF (TZFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
- ELSE IF (TZFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TZFILE,TZFIELD,ZSLICE_ll,IRESP_TMP)
- END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + T1 - T0
+ call IO_Format_read_select( tzfile, glfi, gnc4 ) !Safer to do that (probably useless)
+ if ( gnc4 ) call IO_Field_read_nc4( tzfile, tzfield, zslice_ll, iresp_tmp )
+ if ( glfi ) call IO_Field_read_lfi( tzfile, tzfield, zslice_ll, iresp_tmp )
+ IF (IRESP_TMP .NE. 0 ) IRESP_ISP = IRESP_TMP
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_READ3D_READ=TIMEZ%T_READ3D_READ + ZT1 - ZT0
DO JI = 1,ISNPROC
CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
- TX2DP=>ZSLICE_ll(IXO:IXE,IYO:IYE)
+ ZTX2DP=>ZSLICE_ll(IXO:IXE,IYO:IYE)
IF (ISP /= JI) THEN
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX2DP(NB_REQ)%X(IXO:IXE,IYO:IYE))
- T_TX2DP(NB_REQ)%X=TX2DP
- CALL MPI_ISEND(T_TX2DP(NB_REQ)%X,SIZE(TX2DP),MNHREAL_MPI,JI-1,199+IK_RANK, &
- TZFILE%NMPICOMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MNHREAL_MPI,JI-1,199+IK_RANK,TZFILE%NMPICOMM,IERR)
+ INB_REQ = INB_REQ + 1
+ ALLOCATE(T_TX2DP(INB_REQ)%X(IXO:IXE,IYO:IYE))
+ T_TX2DP(INB_REQ)%X=ZTX2DP
+ CALL MPI_ISEND(T_TX2DP(INB_REQ)%X,SIZE(ZTX2DP),MNHREAL_MPI,JI-1,199+IK_RANK, &
+ TZFILE%NMPICOMM,IREQ_TAB(INB_REQ),IERR)
+ !CALL MPI_BSEND(ZTX2DP,SIZE(ZTX2DP),MNHREAL_MPI,JI-1,199+IK_RANK,TZFILE%NMPICOMM,IERR)
ELSE
- PFIELD(:,:,JKK) = TX2DP(:,:)
+ PFIELD(:,:,JKK) = ZTX2DP(:,:)
END IF
END DO
- CALL SECOND_MNH2(T2)
- TIMEZ%T_READ3D_SEND=TIMEZ%T_READ3D_SEND + T2 - T1
+ CALL SECOND_MNH2(ZT2)
+ TIMEZ%T_READ3D_SEND=TIMEZ%T_READ3D_SEND + ZT2 - ZT1
END IF
!
- CALL MPI_BCAST(IRESP_TMP,1,MNHINT_MPI,IK_RANK-1,TZFILE%NMPICOMM,IERR)
- IF (IRESP_TMP/=0) IRESP = IRESP_TMP !Keep last "error"
TZFILE => NULL()
END DO
!
@@ -753,19 +837,19 @@ IF (IRESP==0) THEN
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
! XX or YY Scatter Field
- call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X3', 'XX or YY not yet planned on Blue Gene' )
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X3', 'XX/YY not (yet) allowed for parallel I/O' )
CALL SCATTER_XXFIELD(YDIR,ZFIELDP,PFIELD,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE IF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
! 2D compact case
- call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X3', 'L2D not yet planned on Blue Gene' )
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X3', '2D not (yet) allowed for parallel execution' )
CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:),PFIELD(:,JPHEXT+1,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
PFIELD(:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
ELSE
!
! XY Scatter Field
!
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
DO JKK=JK,JK_MAX
!
! get the file & rank
@@ -783,30 +867,32 @@ IF (IRESP==0) THEN
!CALL SCATTER_XYFIELD(ZSLICE_ll,ZSLICE,TZFILE%NMASTER_RANK,TZFILE%NMPICOMM)
IF (ISP .NE. IK_RANK) THEN
CALL MPI_RECV(ZSLICE,SIZE(ZSLICE),MNHREAL_MPI,IK_RANK-1,199+IK_RANK, &
- TZFILE%NMPICOMM,STATUS,IERR)
+ TZFILE%NMPICOMM,ISTATUS,IERR)
END IF
TZFILE => NULL()
END DO
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ3D_RECV=TIMEZ%T_READ3D_RECV + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_READ3D_RECV=TIMEZ%T_READ3D_RECV + ZT1 - ZT0
END IF
ELSE
! Broadcast Field
call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X3', 'broadcast field not yet planned on Blue Gene' )
CALL MPI_BCAST(PFIELD,SIZE(PFIELD),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
- CALL SECOND_MNH2(T0)
- IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- DO JI=1,NB_REQ ; DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
+ CALL SECOND_MNH2(ZT0)
+ IF (INB_REQ .GT.0 ) THEN
+ CALL MPI_WAITALL(INB_REQ,IREQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ DO JI=1,INB_REQ ; DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READ3D_WAIT=TIMEZ%T_READ3D_WAIT + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_READ3D_WAIT=TIMEZ%T_READ3D_WAIT + ZT1 - ZT0
END DO Z_SLICE
!
DEALLOCATE(T_TX2DP)
- DEALLOCATE(REQ_TAB)
+ DEALLOCATE(IREQ_TAB)
!
+ CALL MPI_ALLREDUCE(-ABS(IRESP_ISP),IRESP_TMP,1,MNHINT_MPI,MPI_MIN,TPFILE%NMPICOMM,IRESP)
+ IF (IRESP_TMP/=0) IRESP = IRESP_TMP !Keep last "error"
!Broadcast header only if IRESP==-111
!because metadata of field has been modified in IO_Field_read_xxx
IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
@@ -824,8 +910,8 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
IF (PRESENT(KRESP)) KRESP = IRESP
!
CALL MPI_BARRIER(TPFILE%NMPICOMM,IERR)
-CALL SECOND_MNH2(T22)
-TIMEZ%T_READ3D_ALL=TIMEZ%T_READ3D_ALL + T22 - T11
+CALL SECOND_MNH2(ZT22)
+TIMEZ%T_READ3D_ALL=TIMEZ%T_READ3D_ALL + ZT22 - ZT11
!
END SUBROUTINE IO_Field_read_byfield_X3
@@ -852,6 +938,7 @@ END SUBROUTINE IO_Field_read_byname_X4
SUBROUTINE IO_Field_read_byfield_X4(TPFILE,TPFIELD,PFIELD,KRESP)
!
+use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISP, LPACK, L1D, L2D
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -866,10 +953,14 @@ REAL,DIMENSION(:,:,:,:),TARGET,INTENT(INOUT) :: PFIELD ! array containing the
INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
-REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
+real, dimension(:,:), pointer :: zfieldp2d
+real, dimension(:,:,:), pointer :: zfieldp3d
+REAL, DIMENSION(:,:,:,:), POINTER :: ZFIELDP
LOGICAL :: GALLOC
+logical :: glfi, gnc4
INTEGER :: IRESP
INTEGER :: IHEXTOT
+type(tfielddata) :: tzfield
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -879,39 +970,71 @@ ZFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X4',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:)
- ELSE
- ZFIELDP=>PFIELD(:,:,:,:)
- END IF
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- END IF
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- PFIELD(:,:,:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1,:,:),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- PFIELD(:,:,:,:)=SPREAD(PFIELD(:,JPHEXT+1,:,:),DIM=2,NCOPIES=IHEXTOT)
- END IF
+ if ( lpack .and. l1d .and. Size( pfield, 1 ) == ihextot .and. Size( pfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3)
+ tzfield%ndimlist(2) = tzfield%ndimlist(4)
+ tzfield%ndimlist(3) = tzfield%ndimlist(5) !Necessary if time dimension
+ tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+ zfieldp2d => pfield(jphext+1, jphext+1, :, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp2d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp2d, iresp )
+ pfield(:, :, :, :) = Spread( Spread( pfield(jphext + 1, jphext + 1, :, :), dim = 1, ncopies = ihextot ), &
+ dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1, :, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
+ pfield(:, :, :, :) = Spread( Spread( pfield(jphext + 1, jphext + 1, :, :), dim = 1, ncopies = ihextot ), &
+ dim = 2, ncopies = ihextot )
+ endif
+ else if ( lpack .and. l2d .and. Size( pfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3)
+ tzfield%ndimlist(3) = tzfield%ndimlist(4)
+ tzfield%ndimlist(4) = tzfield%ndimlist(5) !Necessary if time dimension
+ tzfield%ndimlist(5:) = NMNHDIM_UNUSED
+ end if
+ zfieldp3d => pfield(:, jphext + 1, :, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp3d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp3d, iresp )
+ pfield(:, :, :, :) = Spread( pfield(:, jphext + 1, :, :), dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(:, jphext + 1 : jphext + 1, :, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
+ pfield(:,:, :, :) = Spread( pfield(:, jphext + 1, :, :), dim = 2, ncopies = ihextot )
+ endif
+ else
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, pfield, iresp )
+ end if
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O process case
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfieldp, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
ALLOCATE(ZFIELDP(0,0,0,0))
@@ -930,6 +1053,7 @@ IF (IRESP==0) THEN
ELSE IF (TPFIELD%CDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
! 2D compact case
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X4', '2D not (yet) allowed for parallel execution' )
CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:),PFIELD(:,JPHEXT+1,:,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
PFIELD(:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:),DIM=2,NCOPIES=IHEXTOT)
ELSE
@@ -973,6 +1097,7 @@ END SUBROUTINE IO_Field_read_byname_X5
SUBROUTINE IO_Field_read_byfield_X5(TPFILE,TPFIELD,PFIELD,KRESP)
!
+use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISP, LPACK, L1D, L2D
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -987,10 +1112,14 @@ REAL,DIMENSION(:,:,:,:,:),TARGET,INTENT(INOUT) :: PFIELD ! array containing th
INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
-REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
+real, dimension(:,:,:), pointer :: zfieldp3d
+real, dimension(:,:,:,:), pointer :: zfieldp4d
+REAL, DIMENSION(:,:,:,:,:), POINTER :: ZFIELDP
LOGICAL :: GALLOC
+logical :: glfi, gnc4
INTEGER :: IRESP
INTEGER :: IHEXTOT
+type(tfielddata) :: tzfield
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -1000,39 +1129,73 @@ ZFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X5',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:,:)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:,:)
- ELSE
- ZFIELDP=>PFIELD(:,:,:,:,:)
- END IF
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- END IF
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- PFIELD(:,:,:,:,:)=SPREAD(SPREAD(PFIELD(JPHEXT+1,JPHEXT+1,:,:,:),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- PFIELD(:,:,:,:,:)=SPREAD(PFIELD(:,JPHEXT+1,:,:,:),DIM=2,NCOPIES=IHEXTOT)
- END IF
+ if ( lpack .and. l1d .and. Size( pfield, 1 ) == ihextot .and. Size( pfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3)
+ tzfield%ndimlist(2) = tzfield%ndimlist(4)
+ tzfield%ndimlist(3) = tzfield%ndimlist(5)
+ tzfield%ndimlist(4) = tzfield%ndimlist(6) !Necessary if time dimension
+ tzfield%ndimlist(5:) = NMNHDIM_UNUSED
+ end if
+ zfieldp3d => pfield(jphext+1, jphext+1, :, :, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp3d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp3d, iresp )
+ pfield(:, :, :, :, :) = Spread( Spread( pfield(jphext + 1, jphext + 1, :, :, :), dim = 1, ncopies = ihextot ), &
+ dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1, :, :, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
+ pfield(:, :, :, :, :) = Spread( Spread( pfield(jphext + 1, jphext + 1, :, :, :), dim = 1, ncopies = ihextot ), &
+ dim = 2, ncopies = ihextot )
+ endif
+ else if ( lpack .and. l2d .and. Size( pfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3)
+ tzfield%ndimlist(3) = tzfield%ndimlist(4)
+ tzfield%ndimlist(4) = tzfield%ndimlist(5)
+ tzfield%ndimlist(5) = tzfield%ndimlist(6) !Necessary if time dimension
+ tzfield%ndimlist(6:) = NMNHDIM_UNUSED
+ end if
+ zfieldp4d => pfield(:, jphext + 1, :, :, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp4d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp4d, iresp )
+ pfield(:, :, :, :, :) = Spread( pfield(:, jphext + 1, :, :, :), dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(:, jphext + 1 : jphext + 1, :, :, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, zfieldp, iresp )
+ pfield(:,:, :, :, :) = Spread( pfield(:, jphext + 1, :, :, :), dim = 2, ncopies = ihextot )
+ endif
+ else
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, pfield, iresp )
+ end if
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O process case
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfieldp, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
ALLOCATE(ZFIELDP(0,0,0,0,0))
@@ -1051,6 +1214,7 @@ IF (IRESP==0) THEN
ELSE IF (TPFIELD%CDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
! 2D compact case
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_X5', '2D not (yet) allowed for parallel execution' )
CALL SCATTER_XXFIELD('XX',ZFIELDP(:,1,:,:,:),PFIELD(:,JPHEXT+1,:,:,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
PFIELD(:,:,:,:,:) = SPREAD(PFIELD(:,JPHEXT+1,:,:,:),DIM=2,NCOPIES=IHEXTOT)
ELSE
@@ -1094,7 +1258,7 @@ END SUBROUTINE IO_Field_read_byname_X6
SUBROUTINE IO_Field_read_byfield_X6(TPFILE,TPFIELD,PFIELD,KRESP)
!
-USE MODD_IO, ONLY: GSMONOPROC,ISP,LPACK,L1D,L2D
+USE MODD_IO, ONLY: GSMONOPROC, ISP
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
!
@@ -1110,6 +1274,7 @@ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: IERR
REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
+logical :: glfi, gnc4
INTEGER :: IRESP
INTEGER :: IHEXTOT
!
@@ -1121,27 +1286,19 @@ ZFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_X6',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, pfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, pfield, iresp )
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O process case
CALL ALLOCBUFFER_ll(ZFIELDP,PFIELD,TPFIELD%CDIR,GALLOC)
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, zfieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, zfieldp, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
ALLOCATE(ZFIELDP(0,0,0,0,0,0))
@@ -1206,31 +1363,24 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
INTEGER :: IRESP
+logical :: glfi, gnc4
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
IRESP = 0
!
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_N0',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, kfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, kfield, iresp )
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, kfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, kfield, iresp )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1286,6 +1436,7 @@ INTEGER :: IERR
INTEGER :: IRESP
INTEGER,DIMENSION(:),POINTER :: IFIELDP
LOGICAL :: GALLOC
+logical :: glfi, gnc4
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -1294,26 +1445,18 @@ IRESP = 0
IFIELDP => NULL()
!
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_N1',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, kfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, kfield, iresp )
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,TPFIELD%CDIR,GALLOC)
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ifieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ifieldp, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
ALLOCATE(IFIELDP(0))
@@ -1367,6 +1510,7 @@ END SUBROUTINE IO_Field_read_byname_N2
SUBROUTINE IO_Field_read_byfield_N2(TPFILE,TPFIELD,KFIELD,KRESP)
!
+use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISP, LPACK, L1D, L2D
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -1380,10 +1524,14 @@ INTEGER,DIMENSION(:,:),TARGET,INTENT(INOUT) :: KFIELD ! array containing the d
INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
-INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
+integer :: ifieldp0d
+integer, dimension(:), pointer :: ifieldp1d
+INTEGER, DIMENSION(:,:), POINTER :: IFIELDP
LOGICAL :: GALLOC
+logical :: glfi, gnc4
INTEGER :: IRESP
INTEGER :: IHEXTOT
+type(tfielddata) :: tzfield
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -1393,39 +1541,64 @@ IFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_N2',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1)
- ELSE
- IFIELDP=>KFIELD(:,:)
- END IF
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- END IF
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- KFIELD(:,:)=SPREAD(SPREAD(KFIELD(JPHEXT+1,JPHEXT+1),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- KFIELD(:,:)=SPREAD(KFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
- END IF
+ if ( lpack .and. l1d .and. Size( kfield, 1 ) == ihextot .and. Size( kfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3) !Necessary if time dimension
+ tzfield%ndimlist(2:) = NMNHDIM_UNUSED
+ end if
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, ifieldp0d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, ifieldp0d, iresp )
+ kfield(:, :) = Spread( Spread( ifieldp0d, dim = 1, ncopies = ihextot ), dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ ifieldp => kfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, ifieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, ifieldp, iresp )
+ kfield(:, :) = Spread( Spread( kfield(jphext + 1, jphext + 1), dim = 1, ncopies = ihextot ), dim = 2, ncopies = ihextot )
+ endif
+ else if ( lpack .and. l2d .and. Size( kfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3) !Necessary if time dimension
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+ end if
+ ifieldp1d => kfield(:, jphext + 1)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, ifieldp1d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, ifieldp1d, iresp )
+ kfield(:, :) = Spread( kfield(:, jphext + 1), dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = NMNHDIM_ONE
+ end if
+ ifieldp => kfield(:, jphext + 1 : jphext + 1)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, ifieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, ifieldp, iresp )
+ kfield(:, :) = Spread( kfield(:, jphext + 1), dim = 2, ncopies = ihextot )
+ endif
+ else
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, kfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, kfield, iresp )
+ end if
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O process case
CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,TPFIELD%CDIR,GALLOC)
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ifieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ifieldp, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
ALLOCATE(IFIELDP(0,0))
@@ -1446,6 +1619,7 @@ IF (IRESP==0) THEN
ELSE IF (TPFIELD%CDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
! 2D compact case
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_N2', '2D not (yet) allowed for parallel execution' )
CALL SCATTER_XXFIELD('XX',IFIELDP(:,1),KFIELD(:,JPHEXT+1),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
KFIELD(:,:) = SPREAD(KFIELD(:,JPHEXT+1),DIM=2,NCOPIES=IHEXTOT)
ELSE
@@ -1490,6 +1664,7 @@ END SUBROUTINE IO_Field_read_byname_N3
SUBROUTINE IO_Field_read_byfield_N3(TPFILE,TPFIELD,KFIELD,KRESP)
!
+use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISP, LPACK, L1D, L2D
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -1503,10 +1678,14 @@ INTEGER,DIMENSION(:,:,:),TARGET,INTENT(INOUT) :: KFIELD ! array containing the
INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
-INTEGER,DIMENSION(:,:,:),POINTER :: IFIELDP
+integer, dimension(:), pointer :: ifieldp1d
+integer, dimension(:,:), pointer :: ifieldp2d
+INTEGER, DIMENSION(:,:,:), POINTER :: IFIELDP
LOGICAL :: GALLOC
+logical :: glfi, gnc4
INTEGER :: IRESP
INTEGER :: IHEXTOT
+type(tfielddata) :: tzfield
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_N3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -1516,39 +1695,69 @@ IFIELDP => NULL()
!
IHEXTOT = 2*JPHEXT+1
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_N3',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1,:)
- ELSE
- IFIELDP=>KFIELD(:,:,:)
- END IF
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- END IF
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- KFIELD(:,:,:)=SPREAD(SPREAD(KFIELD(JPHEXT+1,JPHEXT+1,:),DIM=1,NCOPIES=IHEXTOT),DIM=2,NCOPIES=IHEXTOT)
- ELSE IF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- KFIELD(:,:,:)=SPREAD(KFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
- END IF
+ if ( lpack .and. l1d .and. Size( kfield, 1 ) == ihextot .and. Size( kfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3)
+ tzfield%ndimlist(2) = tzfield%ndimlist(4) !Necessary if time dimension
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+ end if
+ ifieldp1d => kfield(jphext + 1, jphext + 1, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, ifieldp1d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, ifieldp1d, iresp )
+ kfield(:, :, :) = Spread( Spread( kfield(jphext + 1, jphext + 1, :), dim = 1, ncopies = ihextot ), &
+ dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ ifieldp => kfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, ifieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, ifieldp, iresp )
+ kfield(:, :, :) = Spread( Spread( kfield(jphext + 1, jphext + 1, :), dim = 1, ncopies = ihextot ), &
+ dim = 2, ncopies = ihextot )
+ endif
+ else if ( lpack .and. l2d .and. Size( kfield, 2 ) == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3)
+ tzfield%ndimlist(3) = tzfield%ndimlist(4) !Necessary if time dimension
+ tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+ ifieldp2d => kfield(:, jphext + 1, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, ifieldp2d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, ifieldp2d, iresp )
+ kfield(:, :, :) = Spread( kfield(:, jphext + 1, :), dim = 2, ncopies = ihextot )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = NMNHDIM_ONE
+ end if
+ ifieldp => kfield(:, jphext + 1 : jphext + 1, :)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, ifieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, ifieldp, iresp )
+ kfield(:, :, :) = Spread( kfield(:, jphext + 1, :), dim = 2, ncopies = ihextot )
+ endif
+ else
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, kfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, kfield, iresp )
+ end if
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O process case
CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,TPFIELD%CDIR,GALLOC)
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ifieldp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ifieldp, iresp )
ELSE
!Not really necessary but useful to suppress alerts with Valgrind
ALLOCATE(IFIELDP(0,0,0))
@@ -1569,6 +1778,7 @@ IF (IRESP==0) THEN
ELSE IF (TPFIELD%CDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
! 2D compact case
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_N3', '2D not (yet) allowed for parallel execution' )
CALL SCATTER_XXFIELD('XX',IFIELDP(:,1,:),KFIELD(:,JPHEXT+1,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
KFIELD(:,:,:) = SPREAD(KFIELD(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
ELSE
@@ -1622,31 +1832,24 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
INTEGER :: IRESP
+logical :: glfi, gnc4
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
IRESP = 0
!
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_L0',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ofield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ofield, iresp )
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ofield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ofield, iresp )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1697,31 +1900,24 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
INTEGER :: IRESP
+logical :: glfi, gnc4
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
IRESP = 0
!
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_L1',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ofield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ofield, iresp )
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, ofield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, ofield, iresp )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1772,31 +1968,24 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
!
INTEGER :: IERR
INTEGER :: IRESP
+logical :: glfi, gnc4
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
IRESP = 0
!
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_C0',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,HFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, hfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, hfield, iresp )
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,HFIELD,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, hfield, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, hfield, iresp )
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1851,34 +2040,27 @@ INTEGER,OPTIONAL, INTENT(OUT) :: KRESP ! return-code
INTEGER :: IERR
INTEGER :: IRESP
INTEGER,DIMENSION(3) :: ITDATE
+logical :: glfi, gnc4
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
IRESP = 0
!
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_T0',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,TPDATA,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,TPDATA,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,TPDATA,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, tpdata, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, tpdata, iresp )
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,TPDATA,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,TPDATA,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,TPDATA,IRESP)
- END IF
- ITDATE(1) = TPDATA%TDATE%YEAR
- ITDATE(2) = TPDATA%TDATE%MONTH
- ITDATE(3) = TPDATA%TDATE%DAY
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, tpdata, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, tpdata, iresp )
+ ITDATE(1) = TPDATA%nyear
+ ITDATE(2) = TPDATA%nmonth
+ ITDATE(3) = TPDATA%nday
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -1888,10 +2070,10 @@ IF (IRESP==0) THEN
IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
CALL MPI_BCAST( ITDATE, 3, MNHINT_MPI, TPFILE%NMASTER_RANK-1, TPFILE%NMPICOMM, IERR )
- CALL MPI_BCAST( TPDATA%TIME, 1, MNHREAL_MPI, TPFILE%NMASTER_RANK-1, TPFILE%NMPICOMM, IERR )
- TPDATA%TDATE%YEAR = ITDATE(1)
- TPDATA%TDATE%MONTH = ITDATE(2)
- TPDATA%TDATE%DAY = ITDATE(3)
+ CALL MPI_BCAST( TPDATA%xtime, 1, MNHREAL_MPI, TPFILE%NMASTER_RANK-1, TPFILE%NMPICOMM, IERR )
+ TPDATA%nyear = ITDATE(1)
+ TPDATA%nmonth = ITDATE(2)
+ TPDATA%nday = ITDATE(3)
END IF
END IF
!
@@ -1926,6 +2108,7 @@ END SUBROUTINE IO_Field_read_byname_lb
SUBROUTINE IO_Field_read_byfield_lb(TPFILE,TPFIELD,KL3D,KRIM,PLB,KRESP)
!
+use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISP, ISNPROC, LPACK, L2D
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -1954,14 +2137,17 @@ INTEGER :: IHEXTOT
INTEGER :: IIMAX_ll,IJMAX_ll
INTEGER :: IIB,IIE,IJB,IJE
INTEGER :: JI
-INTEGER :: NB_REQ,IKU
-INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
-INTEGER, ALLOCATABLE,DIMENSION(:,:) :: STATUSES
-INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
+INTEGER :: INB_REQ,IKU
+INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+INTEGER, ALLOCATABLE,DIMENSION(:,:) :: ISTATUSES
+INTEGER,ALLOCATABLE,DIMENSION(:) :: IREQ_TAB
+logical :: glfi, gnc4
REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
+real, dimension(:,:), pointer :: ZTX2DP
REAL,DIMENSION(:,:,:), POINTER :: TX3DP
-REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2, T3
-REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
+REAL(kind=MNHTIME), DIMENSION(2) :: ZT0, ZT1, ZT2, ZT3
+REAL(kind=MNHTIME), DIMENSION(2) :: ZT11, ZT22
+type(tfielddata) :: tzfield
TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_byfield_lb','reading '//TRIM(TPFIELD%CMNHNAME))
@@ -1976,45 +2162,55 @@ END IF
!
!* 1.1 THE NAME OF LFIFM
!
-CALL SECOND_MNH2(T11)
+CALL SECOND_MNH2(ZT11)
IRESP = 0
!------------------------------------------------------------------
IHEXTOT = 2*JPHEXT+1
CALL IO_File_read_check(TPFILE,'IO_Field_read_byfield_lb',IRESP)
-!
+
+call IO_Format_read_select( tpfile, glfi, gnc4 )
+
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
IF (YLBTYPE == 'LBX' .OR. YLBTYPE == 'LBXU') THEN
ALLOCATE(Z3D(KL3D,SIZE(PLB,2),SIZE(PLB,3)))
- Z3D = 0.0
IF (LPACK .AND. L2D) THEN
- TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3)
+ tzfield%ndimlist(3) = tzfield%ndimlist(4) !Necessary if time dimension
+ tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+ ZTX2DP=>Z3D(:,JPHEXT+1,:)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, ZTX2DP, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, ZTX2DP, iresp )
+ Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(2) /= NMNHDIM_UNKNOWN ) tzfield%ndimlist(2) = NMNHDIM_ONE
+ TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tzfield, tx3dp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tzfield, tx3dp, iresp )
+ Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
+ endif
ELSE
- TX3DP => Z3D(:,:,:)
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, z3d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, z3d, iresp )
END IF
- ELSE !(YLBTYPE == 'LBY' .OR. YLBTYPE == 'LBYV')
- ALLOCATE(Z3D(SIZE(PLB,1),KL3D,SIZE(PLB,3)))
- Z3D = 0.0
- TX3DP => Z3D(:,:,:)
- END IF
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,TX3DP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,TX3DP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,TX3DP,IRESP)
- END IF
- IF (YLBTYPE == 'LBX' .OR. YLBTYPE == 'LBXU') THEN
- IF (LPACK .AND. L2D) Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
PLB(1:KRIM+JPHEXT,:,:) = Z3D(1:KRIM+JPHEXT,:,:)
PLB(KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:,:) = Z3D(KL3D-KRIM-JPHEXT+1:KL3D,:,:)
ELSE !(YLBTYPE == 'LBY' .OR. YLBTYPE == 'LBYV')
+ ALLOCATE(Z3D(SIZE(PLB,1),KL3D,SIZE(PLB,3)))
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, z3d, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, z3d, iresp )
PLB(:,1:KRIM+JPHEXT,:) = Z3D(:,1:KRIM+JPHEXT,:)
PLB(:,KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:) = Z3D(:,KL3D-KRIM-JPHEXT+1:KL3D,:)
END IF
ELSE ! multiprocesses execution
IF (ISP == TPFILE%NMASTER_RANK) THEN
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
IF (YLBTYPE == 'LBX' .OR. YLBTYPE == 'LBXU') THEN
ALLOCATE(Z3D(KL3D,IJMAX_ll+2*JPHEXT,SIZE(PLB,3)))
@@ -2029,23 +2225,21 @@ IF (IRESP==0) THEN
Z3D = 0.0
TX3DP => Z3D(:,:,:)
END IF
- IF (TPFILE%CFORMAT=='NETCDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,TX3DP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFI') THEN
- CALL IO_Field_read_lfi(TPFILE,TPFIELD,TX3DP,IRESP)
- ELSE IF (TPFILE%CFORMAT=='LFICDF4') THEN
- CALL IO_Field_read_nc4(TPFILE,TPFIELD,TX3DP,IRESP)
- END IF
+ if ( gnc4 ) call IO_Field_read_nc4( tpfile, tpfield, tx3dp, iresp )
+ if ( glfi ) call IO_Field_read_lfi( tpfile, tpfield, tx3dp, iresp )
IF (YLBTYPE == 'LBX' .OR. YLBTYPE == 'LBXU') THEN
- IF (LPACK .AND. L2D) Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
+ IF (LPACK .AND. L2D) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_read_byfield_lb', '2D not (yet) allowed for parallel execution' )
+ Z3D(:,:,:) = SPREAD(Z3D(:,JPHEXT+1,:),DIM=2,NCOPIES=IHEXTOT)
+ END IF
! erase gap in LB field
Z3D(KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:,:) = Z3D(KL3D-KRIM-JPHEXT+1:KL3D,:,:)
ELSE !(YLBTYPE == 'LBY' .OR. YLBTYPE == 'LBYV')
! erase gap in LB field
Z3D(:,KRIM+JPHEXT+1:2*(KRIM+JPHEXT),:) = Z3D(:,KL3D-KRIM-JPHEXT+1:KL3D,:)
END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READLB_READ=TIMEZ%T_READLB_READ + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_READLB_READ=TIMEZ%T_READLB_READ + ZT1 - ZT0
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
@@ -2054,13 +2248,13 @@ IF (IRESP==0) THEN
!because metadata of field has been modified in IO_Field_read_xxx
IF (IRESP==-111) CALL IO_Field_metadata_bcast(TPFILE,TPFIELD)
!
- NB_REQ=0
- ALLOCATE(REQ_TAB(ISNPROC-1))
- !REQ_TAB=MPI_REQUEST_NULL
+ INB_REQ=0
+ ALLOCATE(IREQ_TAB(ISNPROC-1))
+ !IREQ_TAB=MPI_REQUEST_NULL
IF (ISP == TPFILE%NMASTER_RANK) THEN
- CALL SECOND_MNH2(T1)
- !ALLOCATE(REQ_TAB(ISNPROC-1))
- !REQ_TAB=MPI_REQUEST_NULL
+ CALL SECOND_MNH2(ZT1)
+ !ALLOCATE(IREQ_TAB(ISNPROC-1))
+ !IREQ_TAB=MPI_REQUEST_NULL
ALLOCATE(T_TX3DP(ISNPROC-1))
IKU = SIZE(Z3D,3)
DO JI = 1,ISNPROC
@@ -2068,46 +2262,46 @@ IF (IRESP==0) THEN
IF (IIB /= 0) THEN
TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
IF (ISP /= JI) THEN
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
- T_TX3DP(NB_REQ)%X=Z3D(IIB:IIE,IJB:IJE,:)
- CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MNHREAL_MPI,JI-1,99,TPFILE%NMPICOMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MNHREAL_MPI,JI-1,99,TPFILE%NMPICOMM,IERR)
+ INB_REQ = INB_REQ + 1
+ ALLOCATE(T_TX3DP(INB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
+ T_TX3DP(INB_REQ)%X=Z3D(IIB:IIE,IJB:IJE,:)
+ CALL MPI_ISEND(T_TX3DP(INB_REQ)%X,SIZE(TX3DP),MNHREAL_MPI,JI-1,99,TPFILE%NMPICOMM,IREQ_TAB(INB_REQ),IERR)
+ !CALL MPI_BSEND(T_TX3DP(INB_REQ)%X,SIZE(TX3DP),MNHREAL_MPI,JI-1,99,TPFILE%NMPICOMM,IERR)
ELSE
CALL GET_DISTRIB_lb(YLBTYPE,JI,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
PLB(IIB:IIE,IJB:IJE,:) = TX3DP(:,:,:)
END IF
END IF
END DO
- CALL SECOND_MNH2(T2)
- TIMEZ%T_READLB_SEND=TIMEZ%T_READLB_SEND + T2 - T1
- IF (NB_REQ .GT.0 ) THEN
- !ALLOCATE(STATUSES(MPI_STATUS_SIZE,NB_REQ))
- !CALL MPI_WAITALL(NB_REQ,REQ_TAB,STATUSES,IERR)
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- !DEALLOCATE(STATUSES)
- DO JI=1,NB_REQ ; DEALLOCATE(T_TX3DP(JI)%X) ; ENDDO
+ CALL SECOND_MNH2(ZT2)
+ TIMEZ%T_READLB_SEND=TIMEZ%T_READLB_SEND + ZT2 - ZT1
+ IF (INB_REQ .GT.0 ) THEN
+ !ALLOCATE(ISTATUSES(MPI_STATUS_SIZE,INB_REQ))
+ !CALL MPI_WAITALL(INB_REQ,IREQ_TAB,ISTATUSES,IERR)
+ CALL MPI_WAITALL(INB_REQ,IREQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ !DEALLOCATE(ISTATUSES)
+ DO JI=1,INB_REQ ; DEALLOCATE(T_TX3DP(JI)%X) ; ENDDO
END IF
DEALLOCATE(T_TX3DP)
- !DEALLOCATE(REQ_TAB)
- CALL SECOND_MNH2(T3)
- TIMEZ%T_READLB_WAIT=TIMEZ%T_READLB_WAIT + T3 - T2
+ !DEALLOCATE(IREQ_TAB)
+ CALL SECOND_MNH2(ZT3)
+ TIMEZ%T_READLB_WAIT=TIMEZ%T_READLB_WAIT + ZT3 - ZT2
ELSE
- CALL SECOND_MNH2(T0)
- !ALLOCATE(REQ_TAB(1))
- !REQ_TAB=MPI_REQUEST_NULL
+ CALL SECOND_MNH2(ZT0)
+ !ALLOCATE(IREQ_TAB(1))
+ !IREQ_TAB=MPI_REQUEST_NULL
CALL GET_DISTRIB_lb(YLBTYPE,ISP,'LOC','READ',KRIM,IIB,IIE,IJB,IJE)
IF (IIB /= 0) THEN
TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
- CALL MPI_RECV(TX3DP,SIZE(TX3DP),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,99,TPFILE%NMPICOMM,STATUS,IERR)
- !NB_REQ = NB_REQ + 1
- !CALL MPI_IRECV(TX3DP,SIZE(TX3DP),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,99,TPFILE%NMPICOMM,REQ_TAB(NB_REQ),IERR)
- !IF (NB_REQ .GT.0 ) CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ CALL MPI_RECV(TX3DP,SIZE(TX3DP),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,99,TPFILE%NMPICOMM,ISTATUS,IERR)
+ !INB_REQ = INB_REQ + 1
+ !CALL MPI_IRECV(TX3DP,SIZE(TX3DP),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,99,TPFILE%NMPICOMM,IREQ_TAB(INB_REQ),IERR)
+ !IF (INB_REQ .GT.0 ) CALL MPI_WAITALL(INB_REQ,IREQ_TAB,MNH_STATUSES_IGNORE,IERR)
END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_READLB_RECV=TIMEZ%T_READLB_RECV + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_READLB_RECV=TIMEZ%T_READLB_RECV + ZT1 - ZT0
END IF
- DEALLOCATE(REQ_TAB)
+ DEALLOCATE(IREQ_TAB)
END IF !(GSMONOPROC)
END IF
!----------------------------------------------------------------
@@ -2118,8 +2312,8 @@ IF (IRESP==-111) IRESP = 0 !-111 is not really an error (metadata has changed)
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
-CALL SECOND_MNH2(T22)
-TIMEZ%T_READLB_ALL=TIMEZ%T_READLB_ALL + T22 - T11
+CALL SECOND_MNH2(ZT22)
+TIMEZ%T_READLB_ALL=TIMEZ%T_READLB_ALL + ZT22 - ZT11
!
END SUBROUTINE IO_Field_read_byfield_lb
diff --git a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90 b/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
index aeeb0721b76933ef7072d00a4efe2a9d0d344940..1879a20a2b6f5d0f25000a92d3d19fd2d8cdd91a 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_field_write.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_field_write.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.
@@ -12,20 +12,28 @@
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 12/04/2019: added pointers for C1D, L1D, N1D, X5D and X6D structures in TFIELDDATA
! P. Wautelet 12/04/2019: use MNHTIME for time measurement variables
+! P. Wautelet 12/07/2019: add support for 1D array of dates
+! J. Escobar 11/02/2020: for GA & // IO, add sync, & mpi_allreduce for error handling in // IO
+! P. Wautelet 22/09/2020: use ldimreduced to allow reduction in the number of dimensions of fields (used by 2D simulations)
+! P. Wautelet 30/09/2020: add IO_Field_write_box_byfield_X3 and IO_Field_write_error_check subroutines
+! P. Wautelet 04/12/2020: add IO_Field_create and IO_Ndimlist_reduce subroutines
+! P. Wautelet 07/12/2020: add support for partial write of fields (optional argument: koffset, not all subroutines, no LFI spport)
+! P. Wautelet 14/01/2021: add IO_Field_write_byname_N4 and IO_Field_write_byfield_N4 subroutines
!-----------------------------------------------------------------
#define MNH_SCALARS_IN_SPLITFILES 0
MODULE MODE_IO_FIELD_WRITE
+ use modd_field, only: tfielddata, tfieldlist, TYPECHAR, TYPEDATE, TYPEINT, TYPELOG, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA, TOUTBAK
USE MODD_MPIF
use modd_parameters, only: NMNHNAMELGTMAX
use modd_precision, only: MNHINT_MPI, MNHREAL_MPI, MNHTIME
- USE MODE_FIELD
+ use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_WRITE_LFI
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
USE MODE_IO_WRITE_NC4
#endif
use mode_msg
@@ -35,8 +43,8 @@ MODULE MODE_IO_FIELD_WRITE
PRIVATE
public :: IO_Field_write, IO_Field_write_box, IO_Field_write_lb
- public :: IO_Header_write
public :: IO_Fieldlist_write, IO_Field_user_write
+ public :: IO_Header_write, IO_Field_create
INTERFACE IO_Field_write
MODULE PROCEDURE IO_Field_write_byname_X0, IO_Field_write_byname_X1, &
@@ -45,22 +53,25 @@ MODULE MODE_IO_FIELD_WRITE
IO_Field_write_byname_X6, &
IO_Field_write_byname_N0, IO_Field_write_byname_N1, &
IO_Field_write_byname_N2, IO_Field_write_byname_N3, &
+ IO_Field_write_byname_N4, &
IO_Field_write_byname_L0, IO_Field_write_byname_L1, &
IO_Field_write_byname_C0, IO_Field_write_byname_C1, &
- IO_Field_write_byname_T0, &
+ IO_Field_write_byname_T0, IO_Field_write_byname_T1, &
IO_Field_write_byfield_X0,IO_Field_write_byfield_X1, &
IO_Field_write_byfield_X2,IO_Field_write_byfield_X3, &
IO_Field_write_byfield_X4,IO_Field_write_byfield_X5, &
IO_Field_write_byfield_X6, &
IO_Field_write_byfield_N0,IO_Field_write_byfield_N1, &
IO_Field_write_byfield_N2,IO_Field_write_byfield_N3, &
+ IO_Field_write_byfield_N4, &
IO_Field_write_byfield_L0,IO_Field_write_byfield_L1, &
IO_Field_write_byfield_C0,IO_Field_write_byfield_C1, &
- IO_Field_write_byfield_T0
+ IO_Field_write_byfield_T0,IO_Field_write_byfield_T1
END INTERFACE
INTERFACE IO_Field_write_box
- MODULE PROCEDURE IO_Field_write_box_byfield_X5
+ MODULE PROCEDURE IO_Field_write_box_byfield_X2, IO_Field_write_box_byfield_X3, &
+ IO_Field_write_box_byfield_X4, IO_Field_write_box_byfield_X5
END INTERFACE
INTERFACE IO_Field_write_lb
@@ -157,10 +168,64 @@ CONTAINS
OLFI = .FALSE.
ONC4 = .FALSE.
IF (TPFILE%CFORMAT=='LFI' .OR. TPFILE%CFORMAT=='LFICDF4') OLFI = .TRUE.
+#ifdef MNH_IOCDF4
IF (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4') ONC4 = .TRUE.
+#endif
END SUBROUTINE IO_Format_write_select
+ subroutine IO_Field_write_error_check( tpfile, tpfield, hsubr, kresp_in, kresp_lfi, kresp_nc4, kresp_out )
+ use modd_io, only: gsmonoproc
+
+ type(tfiledata), intent(in) :: tpfile
+ type(tfielddata), intent(in) :: tpfield
+ character(len=*), intent(in) :: hsubr
+ integer, intent(in) :: kresp_in
+ integer, intent(in) :: kresp_lfi
+ integer, intent(in) :: kresp_nc4
+ integer, intent(out) :: kresp_out
+
+ character(len=:), allocatable :: ymsg
+ character(len=6) :: yresp
+ integer :: ierr_mpi
+ integer, dimension(3) :: iresps
+
+ kresp_out = 0
+
+ iresps(1) = kresp_in
+ iresps(2) = kresp_lfi
+ iresps(3) = kresp_nc4
+
+ if ( .not. gsmonoproc ) call MPI_BCAST( iresps, 3, MNHINT_MPI, tpfile%nmaster_rank - 1, tpfile%nmpicomm, ierr_mpi )
+
+ if ( iresps(1) /= 0 ) then
+ write(yresp, '( i6 )') iresps(1)
+ ymsg = Trim( tpfile%cname ) // ': resp=' // yresp // ' when writing ' // Trim( tpfield%cmnhname )
+ call Print_msg( NVERB_ERROR, 'IO', hsubr, ymsg )
+ kresp_out = iresps(1)
+ end if
+
+#ifdef MNH_IOLFI
+ if ( iresps(2) /= 0 ) then
+ write(yresp, '( i6 )') iresps(2)
+ ymsg = Trim( tpfile%cname ) // ': LFI: resp=' // yresp // ' when writing ' // Trim( tpfield%cmnhname )
+ call Print_msg( NVERB_ERROR, 'IO', hsubr, ymsg )
+ kresp_out = iresps(2)
+ end if
+#endif
+
+#ifdef MNH_IOCDF4
+ if ( iresps(3) /= 0 ) then
+ write(yresp, '( i6 )') iresps(3)
+ ymsg = Trim( tpfile%cname ) // ': netCDF: resp=' // yresp // ' when writing ' // Trim( tpfield%cmnhname )
+ call Print_msg( NVERB_ERROR, 'IO', hsubr, ymsg )
+ kresp_out = iresps(3)
+ end if
+#endif
+
+ end subroutine IO_Field_write_error_check
+
+
SUBROUTINE IO_Header_write(TPFILE,HDAD_NAME)
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! File structure
CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HDAD_NAME
@@ -240,6 +305,195 @@ CONTAINS
END SUBROUTINE IO_Header_onefile_write
+subroutine IO_Field_create( tpfile, tpfield )
+ ! Subroutine to create a variable in a file and write its metadata without writing its data
+ ! LFI files are not supported
+ use modd_field
+ use modd_io, only: gsmonoproc, isp
+
+ type(tfiledata), intent(in) :: tpfile
+ type(tfielddata), intent(in) :: tpfield
+
+ integer :: ik_file
+ integer :: iresp
+ logical :: glfi, gnc4
+ type(tfielddata) :: tzfield
+ type(tfiledata), pointer :: tzfile
+
+ call Print_msg( NVERB_DEBUG, 'IO', 'IO_Field_create', Trim( tpfile%cname ) // ': creating ' // Trim( tpfield%cmnhname ) )
+
+ if ( Any (tpfield%ndimlist(:) == NMNHDIM_UNKNOWN ) ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_create', Trim( tpfile%cname ) // ': ' // Trim( tpfield%cmnhname ) &
+ // ' : ndimlist must be populated' )
+ return
+ end if
+
+ !Not very useful: call IO_Field_metadata_check( tpfield, tpfield%ntype, tpfield%ndims, 'IO_Field_create' )
+
+ call IO_File_write_check( tpfile, 'IO_Field_create', iresp )
+
+ call IO_Format_write_select( tpfile, glfi, gnc4 )
+
+ if ( glfi ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_create', Trim( tpfile%cname ) // ': LFI format not supported' )
+ glfi = .false.
+ end if
+
+ if ( iresp == 0 ) then
+ tzfield = tpfield
+
+ if ( All( tzfield%ntype /= [ TYPEINT, TYPELOG, TYPEREAL, TYPECHAR, TYPEDATE ] ) ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_create', Trim( tpfile%cname ) // ': ' &
+ // Trim( tzfield%cmnhname ) // ': invalid ntype' )
+ return
+ end if
+
+ NDIMS: select case ( tzfield%ndims )
+ case ( 0 ) NDIMS
+#if MNH_SCALARS_IN_SPLITFILES
+ if ( Any( tzfield%ntype == [ TYPEREAL, TYPEINT, TYPELOG ] ) then
+ if ( tpfile%nsubfiles_ioz > 0 ) then
+ !Create the variable in all the Z-split files
+ do ik_file = 1, tpfile%nsubfiles_ioz
+ tzfile => tpfile%tfiles_ioz(ik_file)%tfile
+ if ( isp == tzfile%nmaster_rank ) then
+#ifdef MNH_IOCDF4
+ if ( gnc4 ) call IO_Field_create_nc4( tzfile, tzfield )
+#endif
+ end if
+ end do
+ endif
+ end if
+#endif
+ case ( 1 ) NDIMS
+ ! Nothing to do
+
+ case ( 2 ) NDIMS
+ 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 2D field' )
+ return
+ end if
+
+ if ( gsmonoproc ) call IO_Ndimlist_reduce( tpfile, tzfield )
+
+ case ( 3 ) NDIMS
+ 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 2D field' )
+ return
+ end if
+
+ if ( gsmonoproc .and. ( tzfield%ntype /= TYPEREAL .or. tpfile%nsubfiles_ioz == 0 ) ) &
+ call IO_Ndimlist_reduce( tpfile, tzfield )
+
+ if ( tzfield%ntype == TYPEREAL .and. tpfile%nsubfiles_ioz > 0 ) then
+#ifdef MNH_IOCDF4
+ ! Write the variable attributes in the non-split file
+ if ( tpfile%nmaster_rank==isp .and. gnc4 ) &
+ call IO_Field_header_split_write_nc4( tpfile, tzfield, &
+ Int( tpfile%tncdims%tdims(tzfield%ndimlist(3))%nlen, kind = Kind( 1 ) ) )
+ end if
+#endif
+
+ case ( 4 ) NDIMS
+ 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
+ end if
+
+ if ( gsmonoproc ) call IO_Ndimlist_reduce( tpfile, tzfield )
+
+ case ( 5 ) NDIMS
+ if ( tzfield%ntype /= TYPEREAL ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_create', Trim( tpfile%cname ) // ': ' &
+ // Trim( tzfield%cmnhname ) // ': invalid ntype for 5D field' )
+ return
+ end if
+
+ if ( gsmonoproc ) call IO_Ndimlist_reduce( tpfile, tzfield )
+
+ case ( 6 ) NDIMS
+ if ( tzfield%ntype /= TYPEREAL ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_create', Trim( tpfile%cname ) // ': ' &
+ // Trim( tzfield%cmnhname ) // ': invalid ntype for 6D field' )
+ return
+ end if
+
+ ! Nothing else to do
+
+ case default NDIMS
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_create', Trim( tpfile%cname ) // ': ' &
+ // Trim( tzfield%cmnhname ) // ': invalid ndims' )
+ end select NDIMS
+
+ if ( isp == tpfile%nmaster_rank ) then
+#ifdef MNH_IOCDF4
+ if ( gnc4 ) call IO_Field_create_nc4( tpfile, tzfield )
+#endif
+ end if
+ end if
+
+end subroutine IO_Field_create
+
+
+subroutine IO_Ndimlist_reduce( tpfile, tpfield )
+ use modd_field, only: NMNHDIM_ONE, NMNHDIM_UNKNOWN, NMNHDIM_UNUSED
+ use modd_io, only: gsmonoproc, l1d, l2d, lpack
+ use modd_parameters_ll, only: jphext
+
+ type(tfiledata), intent(in) :: tpfile
+ type(tfielddata), intent(inout) :: tpfield
+
+ integer :: ihextot
+ integer :: ji
+
+ if ( .not. gsmonoproc ) return
+
+ ihextot = 2*jphext+1
+
+ ! sequential execution and non Z-split field
+ if ( tpfield%ndims /= 3 .or. tpfield%ntype /= TYPEREAL .or. tpfile%nsubfiles_ioz == 0 ) then
+ if ( lpack .and. l1d .and. tpfile%tncdims%tdims(tpfield%ndimlist(1))%nlen == ihextot &
+ .and. tpfile%tncdims%tdims(tpfield%ndimlist(2))%nlen == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tpfield%ndims = tpfield%ndims - 2
+ if ( tpfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ ! Last iteration necessary if time dimension
+ do ji = 1, tpfield%ndims + 1
+ tpfield%ndimlist(ji) = tpfield%ndimlist(ji + 2)
+ end do
+ tpfield%ndimlist(tpfield%ndims + 2 : ) = NMNHDIM_UNUSED
+ end if
+ else
+ if ( tpfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tpfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ endif
+ else if ( lpack .and. l2d .and. tpfile%tncdims%tdims(tpfield%ndimlist(2))%nlen == ihextot ) then
+ if ( tpfile%ldimreduced ) then
+ tpfield%ndims = tpfield%ndims - 1
+ if ( tpfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ ! Last iteration necessary if time dimension
+ do ji = 2, tpfield%ndims + 1
+ tpfield%ndimlist(ji) = tpfield%ndimlist(ji + 1)
+ end do
+ tpfield%ndimlist(tpfield%ndims + 2 : ) = NMNHDIM_UNUSED
+ end if
+ else
+ if ( tpfield%ndimlist(2) /= NMNHDIM_UNKNOWN ) then
+ tpfield%ndimlist(2) = NMNHDIM_ONE
+ end if
+ endif
+ else
+ !Nothing to do
+ end if
+ end if
+
+end subroutine IO_Ndimlist_reduce
+
+
SUBROUTINE IO_Field_write_byname_X0(TPFILE,HNAME,PFIELD,KRESP)
!
!* 0.1 Declarations of arguments
@@ -285,7 +539,7 @@ CONTAINS
CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
!
INTEGER :: IK_FILE
TYPE(TFILEDATA),POINTER :: TZFILE
@@ -297,7 +551,9 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
TZFILE => NULL()
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_X0',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
@@ -310,15 +566,14 @@ CONTAINS
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,iresp_nc4)
ELSE ! multiprocesses execution
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,iresp_nc4)
END IF
!
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF ! multiprocesses execution
#if MNH_SCALARS_IN_SPLITFILES
IF (TPFILE%NSUBFILES_IOZ>0) THEN
@@ -326,31 +581,28 @@ CONTAINS
DO IK_FILE=1,TPFILE%NSUBFILES_IOZ
TZFILE => TPFILE%TFILES_IOZ(IK_FILE)%TFILE
IF ( ISP == TZFILE%NMASTER_RANK ) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TZFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TZFILE,TPFIELD,PFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TZFILE,TPFIELD,PFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TZFILE,TPFIELD,PFIELD,iresp_nc4)
END IF
END DO
ENDIF
#endif
END IF
!
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X0',YMSG)
- END IF
- IF (PRESENT(KRESP)) KRESP = IRESP
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_X0', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
END SUBROUTINE IO_Field_write_byfield_X0
- SUBROUTINE IO_Field_write_byname_X1(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_X1( TPFILE, HNAME, PFIELD, KRESP, koffset )
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- REAL,DIMENSION(:), INTENT(IN) :: PFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ REAL,DIMENSION(:), INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(1), optional, intent(in) :: koffset
!
!* 0.2 Declarations of local variables
!
@@ -361,14 +613,14 @@ CONTAINS
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ if( iresp == 0 ) call IO_Field_write( tpfile, tfieldlist(id), pfield, iresp, koffset )
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
END SUBROUTINE IO_Field_write_byname_X1
- SUBROUTINE IO_Field_write_byfield_X1(TPFILE,TPFIELD,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byfield_X1( TPFILE, TPFIELD, PFIELD, KRESP, koffset )
USE MODD_IO, ONLY: GSMONOPROC, ISP
!
USE MODE_ALLOCBUFFER_ll
@@ -379,10 +631,11 @@ CONTAINS
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- REAL,DIMENSION(:),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(:),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(1), optional, intent(in) :: koffset
!
!* 0.2 Declarations of local variables
!
@@ -390,7 +643,7 @@ CONTAINS
CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
INTEGER :: ISIZEMAX
REAL,DIMENSION(:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
@@ -399,7 +652,9 @@ CONTAINS
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
GALLOC = .FALSE.
!
YFILEM = TPFILE%CNAME
@@ -416,10 +671,15 @@ CONTAINS
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, pfield, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, pfield, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, pfield, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, pfield, iresp_nc4 )
+ end if
ELSE ! multiprocesses execution
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
IF (ISIZEMAX==0) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
@@ -438,32 +698,35 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4 )
+ end if
END IF
!
CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF ! multiprocesses execution
END IF
!
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X1',YMSG)
- END IF
IF (GALLOC) DEALLOCATE(ZFIELDP)
- IF (PRESENT(KRESP)) KRESP = IRESP
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_X1', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
END SUBROUTINE IO_Field_write_byfield_X1
- SUBROUTINE IO_Field_write_byname_X2(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_X2( TPFILE, HNAME, PFIELD, KRESP, koffset )
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- REAL,DIMENSION(:,:), INTENT(IN) :: PFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ REAL,DIMENSION(:,:), INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(2), optional, intent(in) :: koffset
!
!* 0.2 Declarations of local variables
!
@@ -474,14 +737,15 @@ CONTAINS
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ if( iresp == 0 ) call IO_Field_write( tpfile, tfieldlist(id), pfield, iresp, koffset )
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
END SUBROUTINE IO_Field_write_byname_X2
- SUBROUTINE IO_Field_write_byfield_X2(TPFILE,TPFIELD,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byfield_X2( TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC,ISP,L1D,L2D,LPACK
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -497,10 +761,11 @@ CONTAINS
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- REAL,DIMENSION(:,:),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(:,:),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(2), optional, intent(in) :: koffset
!
!* 0.2 Declarations of local variables
!
@@ -509,29 +774,35 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
INTEGER :: ISIZEMAX
- INTEGER :: IRESP
- REAL,DIMENSION(:,:),POINTER :: ZFIELDP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ integer, dimension(1) :: ioffset1d
+ real :: zfieldp0d
+ real, dimension(:), pointer :: zfieldp1d
+ REAL, DIMENSION(:,:), POINTER :: ZFIELDP
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
!
- REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2
- REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
+ REAL(kind=MNHTIME), DIMENSION(2) :: ZT0, ZT1, ZT2
+ REAL(kind=MNHTIME), DIMENSION(2) :: ZT11, ZT22
#ifdef MNH_GA
REAL,DIMENSION(:,:),POINTER :: ZFIELD_GA
#endif
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
+ type(tfielddata) :: tzfield
!
YFILEM = TPFILE%CNAME
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
GALLOC = .FALSE.
IHEXTOT = 2*JPHEXT+1
!
- CALL SECOND_MNH2(T11)
+ CALL SECOND_MNH2(ZT11)
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_X2',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
@@ -541,25 +812,90 @@ CONTAINS
!
CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
+ if ( Present( koffset ) .and. glfi ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_partial_write_byfield_X2', Trim( tpfile%cname ) // ': LFI format not supported' )
+ glfi = .false.
+ end if
+
IF (IRESP==0) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- ! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GSMONOPROC) THEN ! sequential execution
+ ! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
+ IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3) !Necessary if time dimension
+ tzfield%ndimlist(2:) = NMNHDIM_UNUSED
+ end if
+ zfieldp0d = pfield(jphext + 1, jphext + 1)
+ if ( Present( koffset ) ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_partial_write_byfield_X2', Trim( tpfile%cname ) &
+ // ': impossible situation/not implemented' )
+ !!if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp0d, ioffset0d, iresp_lfi )
+ !if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp0d, ioffset0d, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp0d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp0d, iresp_nc4 )
+ end if
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1)
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp, iresp_nc4 )
+ end if
+ endif
! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1)
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- END IF
- ELSE ! multiprocesses execution
- CALL SECOND_MNH2(T0)
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3) !Necessary if time dimension
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+ end if
+ zfieldp1d => pfield(:, jphext + 1)
+ if ( Present( koffset ) ) then
+ ioffset1d(1) = koffset(1)
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp1d, ioffset1d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp1d, ioffset1d, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp1d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp1d, iresp_nc4 )
+ end if
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(:, jphext + 1 : jphext + 1)
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp, iresp_nc4 )
+ end if
+ endif
+ ELSE
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, pfield, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, pfield, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, pfield, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, pfield, iresp_nc4 )
+ end if
+ END IF
+ ELSE ! multiprocesses execution
+ CALL SECOND_MNH2(ZT0)
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
IF (ISIZEMAX==0) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X2','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
@@ -578,6 +914,7 @@ CONTAINS
CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_write_byfield_X2', '2D not (yet) allowed for parallel execution' )
CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1),ZFIELDP(:,1),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE
#ifdef MNH_GA
@@ -590,8 +927,10 @@ CONTAINS
!
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2)))
ZFIELD_GA = PFIELD
+ !print*,"IO_WRITE_FIELD_BYFIELD_X2::nga_put=",g_a, lo_col, hi_col,NIXO_L,NIYO_L , ld_col, YRECFM ; call flush(6)
+ call ga_sync()
call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L) , ld_col)
- call ga_sync
+ call ga_sync()
DEALLOCATE (ZFIELD_GA)
IF (ISP == TPFILE%NMASTER_RANK) THEN
!
@@ -599,6 +938,7 @@ CONTAINS
!
lo_zplan(JPIZ) = 1
hi_zplan(JPIZ) = 1
+ !print*,"IO_WRITE_FIELD_BYFIELD_X2::nga_get=",g_a, lo_zplan, hi_zplan, ld_zplan, YRECFM ; call flush(6)
call nga_get(g_a, lo_zplan, hi_zplan,ZFIELDP, ld_zplan)
END IF
#else
@@ -606,43 +946,44 @@ CONTAINS
#endif
END IF
END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + ZT1 - ZT0
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4 )
+ end if
END IF
#ifdef MNH_GA
call ga_sync
-#endif
- CALL SECOND_MNH2(T2)
- TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + T2 - T1
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+#endif
+ CALL SECOND_MNH2(ZT2)
+ TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + ZT2 - ZT1
END IF
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X2',YMSG)
- END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_X2', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (GALLOC) DEALLOCATE(ZFIELDP)
- IF (PRESENT(KRESP)) KRESP = IRESP
- CALL SECOND_MNH2(T22)
- TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
+ CALL SECOND_MNH2(ZT22)
+ TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + ZT22 - ZT11
END SUBROUTINE IO_Field_write_byfield_X2
- SUBROUTINE IO_Field_write_byname_X3(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_X3( TPFILE, HNAME, PFIELD, KRESP, koffset )
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- REAL,DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
!
!* 0.2 Declarations of local variables
!
@@ -653,14 +994,15 @@ CONTAINS
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ if( iresp == 0 ) call IO_Field_write( tpfile, tfieldlist(id), pfield, iresp, koffset )
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
END SUBROUTINE IO_Field_write_byname_X3
- SUBROUTINE IO_Field_write_byfield_X3(TPFILE,TPFIELD,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byfield_X3( TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISNPROC, ISP, L1D, L2D, LPACK
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -678,10 +1020,11 @@ CONTAINS
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA),TARGET, INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: PFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA),TARGET, INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(:,:,:),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
!
!* 0.2 Declarations of local variables
!
@@ -690,7 +1033,13 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
INTEGER :: ISIZEMAX
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ integer :: iresp_tmp_lfi, iresp_tmp_nc4
+ integer, dimension(2) :: iresps
+ integer, dimension(1) :: ioffset1d
+ integer, dimension(2) :: ioffset2d
+ real,dimension(:), pointer :: zfieldp1d
+ real,dimension(:,:), pointer :: zfieldp2d
REAL,DIMENSION(:,:,:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
@@ -698,23 +1047,24 @@ CONTAINS
REAL,DIMENSION(:,:),POINTER :: ZSLICE_ll,ZSLICE
INTEGER :: IK_FILE,IK_RANK,INB_PROC_REAL,JK_MAX
INTEGER :: JI,IXO,IXE,IYO,IYE
- REAL,DIMENSION(:,:),POINTER :: TX2DP
- INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
+ REAL,DIMENSION(:,:),POINTER :: ZTX2DP
+ INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
LOGICAL :: GALLOC_ll
- INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
- INTEGER :: NB_REQ
+ INTEGER,ALLOCATABLE,DIMENSION(:) :: IREQ_TAB
+ INTEGER :: INB_REQ
TYPE TX_2DP
REAL, DIMENSION(:,:), POINTER :: X
END TYPE TX_2DP
TYPE(TX_2DP),ALLOCATABLE,DIMENSION(:) :: T_TX2DP
- REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2
- REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
+ REAL(kind=MNHTIME), DIMENSION(2) :: ZT0, ZT1, ZT2
+ REAL(kind=MNHTIME), DIMENSION(2) :: ZT11, ZT22
#ifdef MNH_GA
REAL,DIMENSION(:,:,:),POINTER :: ZFIELD_GA
#endif
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
+ type(tfielddata) :: tzfield
TYPE(TFILEDATA),POINTER :: TZFILE
!
TZFILE => NULL()
@@ -726,14 +1076,16 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
GALLOC = .FALSE.
GALLOC_ll = .FALSE.
IHEXTOT = 2*JPHEXT+1
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_X3',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL SECOND_MNH2(T11)
+ CALL SECOND_MNH2(ZT11)
!
CALL IO_Field_metadata_check(TPFIELD,TYPEREAL,3,'IO_Field_write_byfield_X3')
!
@@ -741,24 +1093,88 @@ CONTAINS
!
CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
+ if ( Present( koffset ) .and. glfi ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_partial_write_byfield_X3', Trim( tpfile%cname ) // ': LFI format not supported' )
+ glfi = .false.
+ end if
+
IF (IRESP==0) THEN
- IF (GSMONOPROC .AND. TPFILE%NSUBFILES_IOZ==0 ) THEN ! sequential execution
- ! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:)
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- END IF
- ELSEIF ( TPFILE%NSUBFILES_IOZ==0 .OR. YDIR=='--' ) THEN ! multiprocesses execution & 1 proc IO
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
+ IF (GSMONOPROC .AND. TPFILE%NSUBFILES_IOZ==0 ) THEN ! sequential execution
+ ! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
+ IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3)
+ tzfield%ndimlist(2) = tzfield%ndimlist(4) !Necessary if time dimension
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+ end if
+ zfieldp1d => pfield(jphext + 1, jphext + 1, :)
+ if ( Present ( koffset ) ) then
+ ioffset1d(1) = koffset(3)
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp1d, ioffset1d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp1d, ioffset1d, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp1d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp1d, iresp_nc4 )
+ end if
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1, :)
+ if ( Present ( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp, iresp_nc4 )
+ end if
+ endif
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3)
+ tzfield%ndimlist(3) = tzfield%ndimlist(4) !Necessary if time dimension
+ tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+ zfieldp2d => pfield(:, jphext + 1, :)
+ if ( Present ( koffset ) ) then
+ ioffset2d(1) = koffset(1)
+ ioffset2d(2) = koffset(3)
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp2d, ioffset2d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp2d, ioffset2d, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp2d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp2d, iresp_nc4 )
+ end if
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(2) /= NMNHDIM_UNKNOWN ) tzfield%ndimlist(2) = NMNHDIM_ONE
+ zfieldp => pfield(:, jphext + 1 : jphext + 1, :)
+ if ( Present ( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp, iresp_nc4 )
+ end if
+ endif
+ ELSE
+ if ( Present ( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, pfield, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, pfield, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, pfield, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, pfield, iresp_nc4 )
+ end if
+ END IF
+ ELSEIF ( TPFILE%NSUBFILES_IOZ==0 .OR. YDIR=='--' ) THEN ! multiprocesses execution & 1 proc IO
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
IF (ISIZEMAX==0) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
@@ -777,6 +1193,7 @@ CONTAINS
CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_write_byfield_X3', '2D not (yet) allowed for parallel execution' )
CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE
CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
@@ -784,20 +1201,28 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ if ( Present ( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if (glfi) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
+ if (gnc4) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4 )
+ end if
END IF
!
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
- !
- ELSE ! multiprocesses execution & // IO
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
+ ELSE ! multiprocesses execution & // IO
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
IF (ISIZEMAX==0) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
!
+ ! Write the variable attributes in the non-split file
+ !
+ if ( tpfile%nmaster_rank==isp .and. gnc4 ) &
+ call IO_Field_header_split_write_nc4( tpfile, tpfield, size( pfield, 3 ) )
+ !
!JUAN BG Z SLICE
!
!
@@ -805,38 +1230,35 @@ CONTAINS
!
! init/create the ga
!
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
CALL MNH_INIT_GA(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),YRECFM,"WRITE")
!
- ! copy columun data to global arrays g_a
+ ! copy columun data to global arrays g_a
!
ALLOCATE (ZFIELD_GA (SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)))
ZFIELD_GA = PFIELD
- call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L,1) , ld_col)
+ !print*,"IO_WRITE_FIELD_BYFIELD_X3::nga_put=",g_a, lo_col, hi_col,NIXO_L,NIYO_L , ld_col, YRECFM ; call flush(6)
+ call ga_sync()
+ call nga_put(g_a, lo_col, hi_col,ZFIELD_GA(NIXO_L,NIYO_L,1) , ld_col)
+ call ga_sync()
DEALLOCATE(ZFIELD_GA)
- call ga_sync
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + T1 - T0
- !
- ! Write the variable attributes in the non-split file
- !
- if ( tpfile%nmaster_rank==isp .and. gnc4 ) &
- call IO_Write_field_header_split_nc4( tpfile, tpfield, size( pfield, 3 ) )
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + ZT1 - ZT0
!
! write the data
!
ALLOCATE(ZSLICE_ll(0,0)) ! to avoid bug on test of size
GALLOC_ll = .TRUE.
!
- DO JKK=1,IKU_ll
+ DO JKK=1,SIZE(PFIELD,3) ! IKU_ll
!
IK_FILE = IO_Level2filenumber_get(JKK,TPFILE%NSUBFILES_IOZ)
TZFILE => TPFILE%TFILES_IOZ(IK_FILE+1)%TFILE
!
IK_RANK = TZFILE%NMASTER_RANK
!
- IF (ISP == IK_RANK ) THEN
- CALL SECOND_MNH2(T0)
+ IF (ISP == IK_RANK ) THEN
+ CALL SECOND_MNH2(ZT0)
!
IF ( SIZE(ZSLICE_ll) .EQ. 0 ) THEN
DEALLOCATE(ZSLICE_ll)
@@ -847,21 +1269,35 @@ CONTAINS
!
lo_zplan(JPIZ) = JKK
hi_zplan(JPIZ) = JKK
+ !print*,"IO_WRITE_FIELD_BYFIELD_X3::nga_get=",g_a, lo_zplan, hi_zplan, ld_zplan, YRECFM,JKK ; call flush(6)
call nga_get(g_a, lo_zplan, hi_zplan,ZSLICE_ll, ld_zplan)
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + ZT1 - ZT0
!
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- CALL SECOND_MNH2(T2)
- TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
+ if ( Present ( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zslice_ll, koffset, iresp_tmp_lfi, &
+ ! kvertlevel = jkk, kzfile = ik_file + 1 )
+ !if ( iresp_tmp_lfi /= 0 ) iresp_lfi = iresp_tmp_lfi
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zslice_ll, koffset, iresp_tmp_nc4, &
+ kvertlevel = jkk, kzfile = ik_file + 1 )
+ if ( iresp_tmp_nc4 /= 0 ) iresp_nc4 = iresp_tmp_nc4
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zslice_ll, iresp_tmp_lfi, &
+ kvertlevel = jkk, kzfile = ik_file + 1 )
+ if ( iresp_tmp_lfi /= 0 ) iresp_lfi = iresp_tmp_lfi
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zslice_ll, iresp_tmp_nc4, &
+ kvertlevel = jkk, kzfile = ik_file + 1 )
+ if ( iresp_tmp_nc4 /= 0 ) iresp_nc4 = iresp_tmp_nc4
+ end if
+ CALL SECOND_MNH2(ZT2)
+ TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + ZT2 - ZT1
END IF
END DO
!
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
call ga_sync
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_WAIT=TIMEZ%T_WRIT3D_WAIT + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_WRIT3D_WAIT=TIMEZ%T_WRIT3D_WAIT + ZT1 - ZT0
#else
!
ALLOCATE(ZSLICE_ll(0,0))
@@ -873,8 +1309,8 @@ CONTAINS
!
JK_MAX=MIN(SIZE(PFIELD,3),JK+INB_PROC_REAL-1)
!
- NB_REQ=0
- ALLOCATE(REQ_TAB(INB_PROC_REAL))
+ INB_REQ=0
+ ALLOCATE(IREQ_TAB(INB_PROC_REAL))
ALLOCATE(T_TX2DP(INB_PROC_REAL))
DO JKK=JK,JK_MAX
!
@@ -890,37 +1326,38 @@ CONTAINS
IK_RANK = TZFILE%NMASTER_RANK
!
IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
- call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_X3', 'XX not yet planned on Blue Gene' )
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_X3', 'XX/YY not (yet) allowed for parallel I/O' )
CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
- call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_X3', 'L2D not yet planned on Blue Gene' )
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_X3', &
+ '2D not (yet) allowed for parallel execution' )
CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:),ZFIELDP(:,1,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
IF ( ISP /= IK_RANK ) THEN
! Other processes
CALL GET_DOMWRITE_ll(ISP,'local',IXO,IXE,IYO,IYE)
IF (IXO /= 0) THEN ! intersection is not empty
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX2DP(NB_REQ)%X(IXO:IXE,IYO:IYE))
+ INB_REQ = INB_REQ + 1
+ ALLOCATE(T_TX2DP(INB_REQ)%X(IXO:IXE,IYO:IYE))
ZSLICE => PFIELD(:,:,JKK)
- TX2DP=>ZSLICE(IXO:IXE,IYO:IYE)
- T_TX2DP(NB_REQ)%X=ZSLICE(IXO:IXE,IYO:IYE)
- CALL MPI_ISEND(T_TX2DP(NB_REQ)%X,SIZE(TX2DP),MNHREAL_MPI,IK_RANK-1,99+IK_RANK &
- & ,TZFILE%NMPICOMM,REQ_TAB(NB_REQ),IERR)
- !CALL MPI_BSEND(TX2DP,SIZE(TX2DP),MNHREAL_MPI,IK_RANK-1,99+IK_RANK,TZFILE%NMPICOMM,IERR)
+ ZTX2DP=>ZSLICE(IXO:IXE,IYO:IYE)
+ T_TX2DP(INB_REQ)%X=ZSLICE(IXO:IXE,IYO:IYE)
+ CALL MPI_ISEND(T_TX2DP(INB_REQ)%X,SIZE(ZTX2DP),MNHREAL_MPI,IK_RANK-1,99+IK_RANK &
+ & ,TZFILE%NMPICOMM,IREQ_TAB(INB_REQ),IERR)
+ !CALL MPI_BSEND(ZTX2DP,SIZE(ZTX2DP),MNHREAL_MPI,IK_RANK-1,99+IK_RANK,TZFILE%NMPICOMM,IERR)
END IF
END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_WRIT3D_SEND=TIMEZ%T_WRIT3D_SEND + ZT1 - ZT0
END IF
END IF
END DO
!
! Write the variable attributes in the non-split file
!
- if ( tpfile%nmaster_rank==isp .and. gnc4 ) &
+ if ( tpfile%nmaster_rank == isp .and. gnc4 ) &
call IO_Field_header_split_write_nc4( tpfile, tpfield, size( pfield, 3 ) )
!
! write the data
@@ -935,7 +1372,7 @@ CONTAINS
IK_RANK = TZFILE%NMASTER_RANK
!
IF (ISP == IK_RANK ) THEN
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
! I/O proc case
IF ( SIZE(ZSLICE_ll) .EQ. 0 ) THEN
DEALLOCATE(ZSLICE_ll)
@@ -944,62 +1381,78 @@ CONTAINS
DO JI=1,ISNPROC
CALL GET_DOMWRITE_ll(JI,'global',IXO,IXE,IYO,IYE)
IF (IXO /= 0) THEN ! intersection is not empty
- TX2DP=>ZSLICE_ll(IXO:IXE,IYO:IYE)
- IF (ISP == JI) THEN
+ ZTX2DP=>ZSLICE_ll(IXO:IXE,IYO:IYE)
+ IF (ISP == JI) THEN
CALL GET_DOMWRITE_ll(JI,'local',IXO,IXE,IYO,IYE)
ZSLICE => PFIELD(:,:,JKK)
- TX2DP = ZSLICE(IXO:IXE,IYO:IYE)
- ELSE
- CALL MPI_RECV(TX2DP,SIZE(TX2DP),MNHREAL_MPI,JI-1,99+IK_RANK,TZFILE%NMPICOMM,STATUS,IERR)
+ ZTX2DP = ZSLICE(IXO:IXE,IYO:IYE)
+ ELSE
+ CALL MPI_RECV(ZTX2DP,SIZE(ZTX2DP),MNHREAL_MPI,JI-1,99+IK_RANK,TZFILE%NMPICOMM,ISTATUS,IERR)
END IF
END IF
END DO
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + T1 - T0
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZSLICE_ll,IRESP,KVERTLEVEL=JKK,KZFILE=IK_FILE+1)
- CALL SECOND_MNH2(T2)
- TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + T2 - T1
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_WRIT3D_RECV=TIMEZ%T_WRIT3D_RECV + ZT1 - ZT0
+ if ( Present ( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zslice_ll, koffset, iresp_tmp_lfi, &
+ ! kvertlevel = jkk, kzfile = ik_file + 1 )
+ !if ( iresp_tmp_lfi /= 0 ) iresp_lfi = iresp_tmp_lfi
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zslice_ll, koffset, iresp_tmp_nc4, &
+ kvertlevel = jkk, kzfile = ik_file + 1 )
+ if ( iresp_tmp_nc4 /= 0 ) iresp_nc4 = iresp_tmp_nc4
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zslice_ll, iresp_tmp_lfi, &
+ kvertlevel = jkk, kzfile = ik_file + 1 )
+ if ( iresp_tmp_lfi /= 0 ) iresp_lfi = iresp_tmp_lfi
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zslice_ll, iresp_tmp_nc4, &
+ kvertlevel = jkk, kzfile = ik_file + 1 )
+ if ( iresp_tmp_nc4 /= 0 ) iresp_nc4 = iresp_tmp_nc4
+ end if
+ CALL SECOND_MNH2(ZT2)
+ TIMEZ%T_WRIT3D_WRIT=TIMEZ%T_WRIT3D_WRIT + ZT2 - ZT1
END IF
END DO
!
- CALL SECOND_MNH2(T0)
- IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
- DO JI=1,NB_REQ ; DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
+ CALL SECOND_MNH2(ZT0)
+ IF (INB_REQ .GT.0 ) THEN
+ CALL MPI_WAITALL(INB_REQ,IREQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ DO JI=1,INB_REQ ; DEALLOCATE(T_TX2DP(JI)%X) ; ENDDO
END IF
DEALLOCATE(T_TX2DP)
- DEALLOCATE(REQ_TAB)
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT3D_WAIT=TIMEZ%T_WRIT3D_WAIT + T1 - T0
+ DEALLOCATE(IREQ_TAB)
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_WRIT3D_WAIT=TIMEZ%T_WRIT3D_WAIT + ZT1 - ZT0
END DO Z_SLICE
!JUAN BG Z SLICE
! end of MNH_GA
#endif
- END IF ! multiprocesses execution
- END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X3',YMSG)
+ !Not global reduction because a broadcast is done in IO_Field_write_error_check
+ call MPI_REDUCE( -Abs( [ iresp_lfi, iresp_nc4 ] ), iresps(:), 1, MNHINT_MPI, MPI_MIN, &
+ tpfile%nmaster_rank - 1, tpfile%nmpicomm, ierr )
+ iresp_lfi = iresps(1)
+ iresp_nc4 = iresps(2)
+ END IF ! multiprocesses execution
END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_X3', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (GALLOC) DEALLOCATE(ZFIELDP)
IF (GALLOC_ll) DEALLOCATE(ZSLICE_ll)
- IF (PRESENT(KRESP)) KRESP = IRESP
- CALL SECOND_MNH2(T22)
- TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + T22 - T11
+ CALL SECOND_MNH2(ZT22)
+ TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + ZT22 - ZT11
END SUBROUTINE IO_Field_write_byfield_X3
- SUBROUTINE IO_Field_write_byname_X4(TPFILE,HNAME,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_X4( TPFILE, HNAME, PFIELD, KRESP, koffset )
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- REAL,DIMENSION(:,:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ REAL,DIMENSION(:,:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(4), optional, intent(in) :: koffset
!
!* 0.2 Declarations of local variables
!
@@ -1010,14 +1463,15 @@ CONTAINS
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),PFIELD,IRESP)
+ if( iresp == 0 ) call IO_Field_write( tpfile, tfieldlist(id), pfield, iresp, koffset )
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
END SUBROUTINE IO_Field_write_byname_X4
- SUBROUTINE IO_Field_write_byfield_X4(TPFILE,TPFIELD,PFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byfield_X4( TPFILE, TPFIELD, PFIELD, KRESP, koffset )
+ use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISP, L1D, L2D, LPACK
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -1031,10 +1485,11 @@ CONTAINS
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- REAL,DIMENSION(:,:,:,:),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ REAL,DIMENSION(:,:,:,:),TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(4), optional, intent(in) :: koffset
!
!* 0.2 Declarations of local variables
!
@@ -1043,19 +1498,26 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
INTEGER :: ISIZEMAX
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ integer, dimension(2) :: ioffset2d
+ integer, dimension(3) :: ioffset3d
+ real,dimension(:,:), pointer :: zfieldp2d
+ real,dimension(:,:,:), pointer :: zfieldp3d
REAL,DIMENSION(:,:,:,:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
+ type(tfielddata) :: tzfield
!
YFILEM = TPFILE%CNAME
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
GALLOC = .FALSE.
!
IHEXTOT = 2*JPHEXT+1
@@ -1068,22 +1530,93 @@ CONTAINS
!
CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
+ if ( Present( koffset ) .and. glfi ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_partial_write_byfield_X4', Trim( tpfile%cname ) // ': LFI format not supported' )
+ glfi = .false.
+ end if
+
IF (IRESP==0) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- ! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:)
+ IF (GSMONOPROC) THEN ! sequential execution
+ ! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
+ IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3)
+ tzfield%ndimlist(2) = tzfield%ndimlist(4)
+ tzfield%ndimlist(3) = tzfield%ndimlist(5) !Necessary if time dimension
+ tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+ zfieldp2d => pfield(jphext + 1, jphext + 1, :, :)
+ if ( Present( koffset ) ) then
+ ioffset2d(1) = koffset(3)
+ ioffset2d(2) = koffset(4)
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp2d, ioffset2d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp2d, ioffset2d, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp2d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp2d, iresp_nc4 )
+ end if
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1, :, :)
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp, iresp_nc4 )
+ end if
+ endif
! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:)
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- END IF
- ELSE
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3)
+ tzfield%ndimlist(3) = tzfield%ndimlist(4)
+ tzfield%ndimlist(4) = tzfield%ndimlist(5) !Necessary if time dimension
+ tzfield%ndimlist(5:) = NMNHDIM_UNUSED
+ end if
+ zfieldp3d => pfield(:, jphext + 1, :, :)
+ if ( Present( koffset ) ) then
+ ioffset3d(1) = koffset(1)
+ ioffset3d(2) = koffset(3)
+ ioffset3d(3) = koffset(4)
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp3d, ioffset3d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp3d, ioffset3d, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp3d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp3d, iresp_nc4 )
+ end if
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(2) /= NMNHDIM_UNKNOWN ) tzfield%ndimlist(2) = NMNHDIM_ONE
+ zfieldp => pfield(:, jphext + 1 : jphext + 1, :, :)
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp, iresp_nc4 )
+ end if
+ endif
+ ELSE
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, pfield, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, pfield, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, pfield, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, pfield, iresp_nc4 )
+ end if
+ END IF
+ ELSE
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
IF (ISIZEMAX==0) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X4','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
@@ -1101,6 +1634,7 @@ CONTAINS
CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_X4', '2D not (yet) allowed for parallel execution' )
CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:,:),ZFIELDP(:,1,:,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE
CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
@@ -1108,21 +1642,21 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4 )
+ end if
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF ! multiprocess execution
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X4',YMSG)
- END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_X4', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (GALLOC) DEALLOCATE(ZFIELDP)
- IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_Field_write_byfield_X4
@@ -1152,6 +1686,7 @@ CONTAINS
SUBROUTINE IO_Field_write_byfield_X5(TPFILE,TPFIELD,PFIELD,KRESP)
+ use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISP, L1D, L2D, LPACK
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -1177,19 +1712,24 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
INTEGER :: ISIZEMAX
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ real,dimension(:,:,:), pointer :: zfieldp3d
+ real,dimension(:,:,:,:), pointer :: zfieldp4d
REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
+ type(tfielddata) :: tzfield
!
YFILEM = TPFILE%CNAME
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
GALLOC = .FALSE.
!
IHEXTOT = 2*JPHEXT+1
@@ -1203,21 +1743,59 @@ CONTAINS
CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- ! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
- IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:,:,:)
+ IF (GSMONOPROC) THEN ! sequential execution
+ ! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
+ IF (LPACK .AND. L1D .AND. SIZE(PFIELD,1)==IHEXTOT .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3)
+ tzfield%ndimlist(2) = tzfield%ndimlist(4)
+ tzfield%ndimlist(3) = tzfield%ndimlist(5)
+ tzfield%ndimlist(4) = tzfield%ndimlist(6) !Necessary if time dimension
+ tzfield%ndimlist(5:) = NMNHDIM_UNUSED
+ end if
+ zfieldp3d => pfield(jphext + 1, jphext + 1, :, :, :)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp3d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp3d, iresp_nc4 )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ zfieldp => pfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1, :, :, :)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp, iresp_nc4 )
+ endif
! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
- ZFIELDP=>PFIELD(:,JPHEXT+1:JPHEXT+1,:,:,:)
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
- ELSE
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
- END IF
- ELSE
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(PFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3)
+ tzfield%ndimlist(3) = tzfield%ndimlist(4)
+ tzfield%ndimlist(4) = tzfield%ndimlist(5)
+ tzfield%ndimlist(5) = tzfield%ndimlist(6) !Necessary if time dimension
+ tzfield%ndimlist(6:) = NMNHDIM_UNUSED
+ end if
+ zfieldp4d => pfield(:, jphext + 1, :, :, :)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp4d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp4d, iresp_nc4 )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(2) /= NMNHDIM_UNKNOWN ) tzfield%ndimlist(2) = NMNHDIM_ONE
+ zfieldp => pfield(:, jphext + 1 : jphext + 1, :, :, :)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, zfieldp, iresp_nc4 )
+ endif
+ ELSE
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,iresp_nc4)
+ END IF
+ ELSE
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
IF (ISIZEMAX==0) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X5','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
@@ -1235,6 +1813,7 @@ CONTAINS
CALL GATHER_XXFIELD(YDIR,PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_X5', '2D not (yet) allowed for parallel execution' )
CALL GATHER_XXFIELD('XX',PFIELD(:,JPHEXT+1,:,:,:),ZFIELDP(:,1,:,:,:),&
& TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE
@@ -1243,21 +1822,16 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,iresp_nc4)
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF ! multiprocess execution
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X5',YMSG)
- END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_X5', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (GALLOC) DEALLOCATE(ZFIELDP)
- IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_Field_write_byfield_X5
@@ -1311,7 +1885,7 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
INTEGER :: ISIZEMAX
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
REAL,DIMENSION(:,:,:,:,:,:),POINTER :: ZFIELDP
LOGICAL :: GLFI, GNC4
LOGICAL :: GALLOC
@@ -1323,7 +1897,9 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
GALLOC = .FALSE.
!
IHEXTOT = 2*JPHEXT+1
@@ -1338,10 +1914,10 @@ CONTAINS
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PFIELD,iresp_nc4)
ELSE
- CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
+ CALL MPI_ALLREDUCE(SIZE(PFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
IF (ISIZEMAX==0) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_X6','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
@@ -1362,21 +1938,16 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,iresp_nc4)
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF ! multiprocess execution
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_X6',YMSG)
- END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_X6', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (GALLOC) DEALLOCATE(ZFIELDP)
- IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_Field_write_byfield_X6
@@ -1420,15 +1991,16 @@ CONTAINS
!
!* 0.2 Declarations of local variables
!
- INTEGER :: IERR
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
INTEGER :: IK_FILE
TYPE(TFILEDATA),POINTER :: TZFILE
LOGICAL :: GLFI, GNC4
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
TZFILE => NULL()
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_N0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
@@ -1441,15 +2013,13 @@ CONTAINS
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,iresp_nc4)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,iresp_nc4)
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF ! multiprocess execution
#if MNH_SCALARS_IN_SPLITFILES
IF (TPFILE%NSUBFILES_IOZ>0) THEN
@@ -1457,20 +2027,16 @@ CONTAINS
DO IK_FILE=1,TPFILE%NSUBFILES_IOZ
TZFILE => TPFILE%TFILES_IOZ(IK_FILE)%TFILE
IF ( ISP == TZFILE%NMASTER_RANK ) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TZFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TZFILE,TPFIELD,KFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TZFILE,TPFIELD,KFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TZFILE,TPFIELD,KFIELD,iresp_nc4)
END IF
END DO
ENDIF
#endif
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_N0',YMSG)
- END IF
- IF (PRESENT(KRESP)) KRESP = IRESP
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_N0', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
END SUBROUTINE IO_Field_write_byfield_N0
@@ -1522,7 +2088,7 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
INTEGER :: ISIZEMAX
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
INTEGER,DIMENSION(:),POINTER :: IFIELDP
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
@@ -1533,7 +2099,9 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
GALLOC = .FALSE.
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_N1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
@@ -1546,10 +2114,10 @@ CONTAINS
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,iresp_nc4)
ELSE ! multiprocesses execution
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
IF (ISIZEMAX==0) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_N1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
@@ -1568,22 +2136,16 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,iresp_nc4)
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_N1',YMSG)
- END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_N1', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (GALLOC) DEALLOCATE(IFIELDP)
- IF (PRESENT(KRESP)) KRESP = IRESP
- !
END SUBROUTINE IO_Field_write_byfield_N1
@@ -1613,6 +2175,7 @@ CONTAINS
SUBROUTINE IO_Field_write_byfield_N2(TPFILE,TPFIELD,KFIELD,KRESP)
+ use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISP, L1D, L2D, LPACK
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -1637,29 +2200,34 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
INTEGER :: ISIZEMAX
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ integer :: ifieldp0d
+ integer,dimension(:), pointer :: ifieldp1d
INTEGER,DIMENSION(:,:),POINTER :: IFIELDP
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
!
- REAL(kind=MNHTIME), DIMENSION(2) :: T0, T1, T2
- REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
+ REAL(kind=MNHTIME), DIMENSION(2) :: ZT0, ZT1, ZT2
+ REAL(kind=MNHTIME), DIMENSION(2) :: ZT11, ZT22
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
+ type(tfielddata) :: tzfield
!
YFILEM = TPFILE%CNAME
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
GALLOC = .FALSE.
!
IHEXTOT = 2*JPHEXT+1
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_N2',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL SECOND_MNH2(T11)
+ CALL SECOND_MNH2(ZT11)
!
CALL IO_Field_metadata_check(TPFIELD,TYPEINT,2,'IO_Field_write_byfield_N2')
!
@@ -1668,29 +2236,61 @@ CONTAINS
CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1)
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3) !Necessary if time dimension
+ tzfield%ndimlist(2:) = NMNHDIM_UNUSED
+ end if
+ ifieldp0d = kfield(jphext + 1, jphext + 1)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ifieldp0d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ifieldp0d, iresp_nc4 )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ ifieldp => kfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1)
+ if ( glfi) call IO_Field_write_lfi( tpfile, tzfield, ifieldp, iresp_lfi )
+ if ( gnc4) call IO_Field_write_nc4( tpfile, tzfield, ifieldp, iresp_nc4 )
+ endif
! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1)
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
- END IF
- ELSE ! multiprocesses execution
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3) !Necessary if time dimension
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+ end if
+ ifieldp1d => kfield(:, jphext + 1)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ifieldp1d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ifieldp1d, iresp_nc4 )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = NMNHDIM_ONE
+ end if
+ ifieldp => kfield(:, jphext + 1 : jphext + 1)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ifieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ifieldp, iresp_nc4 )
+ endif
+ ELSE
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,iresp_nc4)
+ END IF
+ ELSE ! multiprocesses execution
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
IF (ISIZEMAX==0) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_N2','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
RETURN
END IF
- CALL SECOND_MNH2(T0)
+ CALL SECOND_MNH2(ZT0)
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O process case
CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,YDIR,GALLOC)
@@ -1703,34 +2303,30 @@ CONTAINS
CALL GATHER_XXFIELD(YDIR,KFIELD,IFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_N2', '2D not (yet) allowed for parallel execution' )
CALL GATHER_XXFIELD('XX',KFIELD(:,JPHEXT+1),IFIELDP(:,1),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE
CALL GATHER_XYFIELD(KFIELD,IFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
END IF
END IF
- CALL SECOND_MNH2(T1)
- TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + T1 - T0
+ CALL SECOND_MNH2(ZT1)
+ TIMEZ%T_WRIT2D_GATH=TIMEZ%T_WRIT2D_GATH + ZT1 - ZT0
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,iresp_nc4)
END IF
- CALL SECOND_MNH2(T2)
- TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + T2 - T1
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
+ CALL SECOND_MNH2(ZT2)
+ TIMEZ%T_WRIT2D_WRIT=TIMEZ%T_WRIT2D_WRIT + ZT2 - ZT1
END IF
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_N2',YMSG)
- END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_N2', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (GALLOC) DEALLOCATE(IFIELDP)
- IF (PRESENT(KRESP)) KRESP = IRESP
- CALL SECOND_MNH2(T22)
- TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + T22 - T11
+ CALL SECOND_MNH2(ZT22)
+ TIMEZ%T_WRIT2D_ALL=TIMEZ%T_WRIT2D_ALL + ZT22 - ZT11
!
END SUBROUTINE IO_Field_write_byfield_N2
@@ -1760,6 +2356,7 @@ CONTAINS
END SUBROUTINE IO_Field_write_byname_N3
SUBROUTINE IO_Field_write_byfield_N3(TPFILE,TPFIELD,KFIELD,KRESP)
+ use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
USE MODD_IO, ONLY: GSMONOPROC, ISP, L1D, L2D, LPACK
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_TIMEZ, ONLY: TIMEZ
@@ -1784,28 +2381,33 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
INTEGER :: ISIZEMAX
- INTEGER :: IRESP
- INTEGER,DIMENSION(:,:,:),POINTER :: IFIELDP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ integer, dimension(:), pointer :: ifieldp1d
+ integer, dimension(:,:), pointer :: ifieldp2d
+ INTEGER, DIMENSION(:,:,:), POINTER :: IFIELDP
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
!
- REAL(kind=MNHTIME), DIMENSION(2) :: T11, T22
+ REAL(kind=MNHTIME), DIMENSION(2) :: ZT11, ZT22
INTEGER :: IHEXTOT
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
+ type(tfielddata) :: tzfield
!
YFILEM = TPFILE%CNAME
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
GALLOC = .FALSE.
!
IHEXTOT = 2*JPHEXT+1
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_N3',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
- CALL SECOND_MNH2(T11)
+ CALL SECOND_MNH2(ZT11)
!
CALL IO_Field_metadata_check(TPFIELD,TYPEINT,3,'IO_Field_write_byfield_N3')
!
@@ -1814,22 +2416,54 @@ CONTAINS
CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(JPHEXT+1:JPHEXT+1,JPHEXT+1:JPHEXT+1,:)
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3)
+ tzfield%ndimlist(2) = tzfield%ndimlist(4) !Necessary if time dimension
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+ end if
+ ifieldp1d => kfield(jphext + 1, jphext + 1, :)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ifieldp1d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ifieldp1d, iresp_nc4 )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ ifieldp => kfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1, :)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ifieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ifieldp, iresp_nc4 )
+ endif
! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
- ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
- IFIELDP=>KFIELD(:,JPHEXT+1:JPHEXT+1,:)
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
- ELSE
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,IRESP)
- END IF
- ELSE ! multiprocesses execution
- CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3)
+ tzfield%ndimlist(3) = tzfield%ndimlist(4) !Necessary if time dimension
+ tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+ ifieldp2d => kfield(:, jphext + 1, :)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ifieldp2d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ifieldp2d, iresp_nc4 )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(2) /= NMNHDIM_UNKNOWN ) tzfield%ndimlist(2) = NMNHDIM_ONE
+ ifieldp => kfield(:, jphext + 1 : jphext + 1, :)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ifieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ifieldp, iresp_nc4 )
+ endif
+ ELSE
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,KFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,KFIELD,iresp_nc4)
+ END IF
+ ELSE ! multiprocesses execution
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
IF (ISIZEMAX==0) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_N3','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
@@ -1848,6 +2482,7 @@ CONTAINS
CALL GATHER_XXFIELD(YDIR,KFIELD,IFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSEIF (YDIR == 'XY') THEN
IF (LPACK .AND. L2D) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_N3', '2D not (yet) allowed for parallel execution' )
CALL GATHER_XXFIELD('XX',KFIELD(:,JPHEXT+1,:),IFIELDP(:,1,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
ELSE
CALL GATHER_XYFIELD(KFIELD,IFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
@@ -1855,119 +2490,325 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELDP,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,IFIELDP,iresp_nc4)
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_N3',YMSG)
- END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_N3', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (GALLOC) DEALLOCATE(IFIELDP)
- IF (PRESENT(KRESP)) KRESP = IRESP
- CALL SECOND_MNH2(T22)
- TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + T22 - T11
+ CALL SECOND_MNH2(ZT22)
+ TIMEZ%T_WRIT3D_ALL=TIMEZ%T_WRIT3D_ALL + ZT22 - ZT11
!
END SUBROUTINE IO_Field_write_byfield_N3
- SUBROUTINE IO_Field_write_byname_L0(TPFILE,HNAME,OFIELD,KRESP)
+ SUBROUTINE IO_Field_write_byname_N4( TPFILE, HNAME, KFIELD, KRESP, koffset )
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
- LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ INTEGER,DIMENSION(:,:,:,:), INTENT(IN) :: KFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(4), optional, intent(in) :: koffset
!
!* 0.2 Declarations of local variables
!
INTEGER :: ID ! Index of the field
INTEGER :: IRESP ! return_code
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_N4',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
!
CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
!
- IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
+ if( iresp == 0 ) call IO_Field_write( tpfile, tfieldlist(id), kfield, iresp, koffset )
!
IF (PRESENT(KRESP)) KRESP = IRESP
!
- END SUBROUTINE IO_Field_write_byname_L0
+ END SUBROUTINE IO_Field_write_byname_N4
- SUBROUTINE IO_Field_write_byfield_L0(TPFILE,TPFIELD,OFIELD,KRESP)
- USE MODD_IO, ONLY: GSMONOPROC, ISP
+
+ SUBROUTINE IO_Field_write_byfield_N4( TPFILE, TPFIELD, KFIELD, KRESP, koffset )
+ use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
+ USE MODD_IO, ONLY: GSMONOPROC, ISP, L1D, L2D, LPACK
+ USE MODD_PARAMETERS_ll, ONLY: JPHEXT
+ USE MODD_TIMEZ, ONLY: TIMEZ
!
- USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
- !* 0. DECLARATIONS
- ! ------------
+ USE MODE_ALLOCBUFFER_ll
+ USE MODE_GATHER_ll
+ USE MODE_IO_TOOLS, ONLY: IO_Level2filenumber_get
+ USE MODE_MNH_TIMING, ONLY: SECOND_MNH2
+ USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
!
!
!* 0.1 Declarations of arguments
!
- TYPE(TFILEDATA), INTENT(IN) :: TPFILE
- TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
- LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field
- INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ INTEGER,DIMENSION(:,:,:,:),TARGET, INTENT(IN) :: KFIELD ! array containing the data field
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(4), optional, intent(in) :: koffset
!
!* 0.2 Declarations of local variables
!
- INTEGER :: IERR
- INTEGER :: IRESP
- INTEGER :: IK_FILE
- LOGICAL :: GLFI, GNC4
- TYPE(TFILEDATA),POINTER :: TZFILE
- CHARACTER(LEN=:),ALLOCATABLE :: YMSG
- CHARACTER(LEN=6) :: YRESP
+ CHARACTER(LEN=28) :: YFILEM ! FM-file name
+ CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! name of the article to write
+ CHARACTER(LEN=2) :: YDIR ! field form
+ INTEGER :: IERR
+ INTEGER :: ISIZEMAX
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ integer, dimension(2) :: ioffset2d
+ integer, dimension(3) :: ioffset3d
+ integer, dimension(:,:), pointer :: ifieldp2d
+ integer, dimension(:,:,:), pointer :: ifieldp3d
+ integer, dimension(:,:,:,:), pointer :: ifieldp
+ LOGICAL :: GALLOC
+ LOGICAL :: GLFI, GNC4
+ INTEGER :: IHEXTOT
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
+ type(tfielddata) :: tzfield
!
- IRESP = 0
- TZFILE => NULL()
+ YFILEM = TPFILE%CNAME
+ YRECFM = TPFIELD%CMNHNAME
+ YDIR = TPFIELD%CDIR
!
- CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
+ GALLOC = .FALSE.
!
- CALL IO_Field_metadata_check(TPFIELD,TYPELOG,0,'IO_Field_write_byfield_L0')
+ IHEXTOT = 2*JPHEXT+1
!
- CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_L0',IRESP)
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_N4',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
+ !
+ CALL IO_Field_metadata_check(TPFIELD,TYPEINT,4,'IO_Field_write_byfield_N4')
+ !
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_N4',IRESP)
!
CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
+ if ( Present( koffset ) .and. glfi ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_partial_write_byfield_N4', Trim( tpfile%cname ) // ': LFI format not supported' )
+ glfi = .false.
+ end if
+
IF (IRESP==0) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
- ELSE
+ IF (GSMONOPROC) THEN ! sequential execution
+ ! IF (LPACK .AND. L1D .AND. YDIR=='XY') THEN
+ IF (LPACK .AND. L1D .AND. SIZE(KFIELD,1)==IHEXTOT .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 2
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1) = tzfield%ndimlist(3)
+ tzfield%ndimlist(2) = tzfield%ndimlist(4)
+ tzfield%ndimlist(3) = tzfield%ndimlist(5) !Necessary if time dimension
+ tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+ ifieldp2d => kfield(jphext + 1, jphext + 1, :, :)
+ if ( Present( koffset ) ) then
+ ioffset2d(1) = koffset(3)
+ ioffset2d(2) = koffset(4)
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, ifieldp2d, ioffset2d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, ifieldp2d, ioffset2d, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ifieldp2d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ifieldp2d, iresp_nc4 )
+ end if
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(1:2) = NMNHDIM_ONE
+ end if
+ ifieldp => kfield(jphext + 1 : jphext + 1, jphext + 1 : jphext + 1, :, :)
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, ifieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, ifieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ifieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ifieldp, iresp_nc4 )
+ end if
+ endif
+ ! ELSE IF (LPACK .AND. L2D .AND. YDIR=='XY') THEN
+ ELSEIF (LPACK .AND. L2D .AND. SIZE(KFIELD,2)==IHEXTOT) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3)
+ tzfield%ndimlist(3) = tzfield%ndimlist(4)
+ tzfield%ndimlist(4) = tzfield%ndimlist(5) !Necessary if time dimension
+ tzfield%ndimlist(5:) = NMNHDIM_UNUSED
+ end if
+ ifieldp3d => kfield(:, jphext + 1, :, :)
+ if ( Present( koffset ) ) then
+ ioffset3d(1) = koffset(1)
+ ioffset3d(2) = koffset(3)
+ ioffset3d(3) = koffset(4)
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, ifieldp3d, ioffset3d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, ifieldp3d, ioffset3d, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ifieldp3d, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ifieldp3d, iresp_nc4 )
+ end if
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(2) /= NMNHDIM_UNKNOWN ) tzfield%ndimlist(2) = NMNHDIM_ONE
+ ifieldp => kfield(:, jphext + 1 : jphext + 1, :, :)
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tzfield, ifieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tzfield, ifieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ifieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ifieldp, iresp_nc4 )
+ end if
+ endif
+ ELSE
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, kfield, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, kfield, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, kfield, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, kfield, iresp_nc4 )
+ end if
+ END IF
+ ELSE
+ CALL MPI_ALLREDUCE(SIZE(KFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
+ IF (ISIZEMAX==0) THEN
+ CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_N4','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
+ IF (PRESENT(KRESP)) KRESP=0
+ RETURN
+ END IF
+
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
+ CALL ALLOCBUFFER_ll(IFIELDP,KFIELD,YDIR,GALLOC)
+ ELSE
+ ALLOCATE(IFIELDP(0,0,0,0))
+ GALLOC = .TRUE.
END IF
!
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
- END IF ! multiprocesses execution
-#if MNH_SCALARS_IN_SPLITFILES
- IF (TPFILE%NSUBFILES_IOZ>0) THEN
+ IF (YDIR == 'XX' .OR. YDIR =='YY') THEN
+ CALL GATHER_XXFIELD(YDIR,KFIELD,IFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ELSEIF (YDIR == 'XY') THEN
+ IF (LPACK .AND. L2D) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_N4', '2D not (yet) allowed for parallel execution' )
+ CALL GATHER_XXFIELD('XX',KFIELD(:,JPHEXT+1,:,:),IFIELDP(:,1,:,:),TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ ELSE
+ CALL GATHER_XYFIELD(KFIELD,IFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
+ END IF
+ END IF
+ !
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, ifieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, ifieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, ifieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, ifieldp, iresp_nc4 )
+ end if
+ END IF
+ END IF ! multiprocess execution
+ END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_N4', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
+ IF (GALLOC) DEALLOCATE(IFIELDP)
+ END SUBROUTINE IO_Field_write_byfield_N4
+
+
+ SUBROUTINE IO_Field_write_byname_L0(TPFILE,HNAME,OFIELD,KRESP)
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER :: ID ! Index of the field
+ INTEGER :: IRESP ! return_code
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+ !
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),OFIELD,IRESP)
+ !
+ IF (PRESENT(KRESP)) KRESP = IRESP
+ !
+ END SUBROUTINE IO_Field_write_byname_L0
+
+ SUBROUTINE IO_Field_write_byfield_L0(TPFILE,TPFIELD,OFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
+ !
+ USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ LOGICAL, INTENT(IN) :: OFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ INTEGER :: IK_FILE
+ LOGICAL :: GLFI, GNC4
+ TYPE(TFILEDATA),POINTER :: TZFILE
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
+ !
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
+ TZFILE => NULL()
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ !
+ CALL IO_Field_metadata_check(TPFIELD,TYPELOG,0,'IO_Field_write_byfield_L0')
+ !
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_L0',IRESP)
+ !
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
+ !
+ IF (IRESP==0) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,OFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,OFIELD,iresp_nc4)
+ ELSE
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,OFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,OFIELD,iresp_nc4)
+ END IF
+ END IF ! multiprocesses execution
+#if MNH_SCALARS_IN_SPLITFILES
+ IF (TPFILE%NSUBFILES_IOZ>0) THEN
! write the data in all Z files
DO IK_FILE=1,TPFILE%NSUBFILES_IOZ
TZFILE => TPFILE%TFILES_IOZ(IK_FILE)%TFILE
IF ( ISP == TZFILE%NMASTER_RANK ) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TZFILE,TPFIELD,OFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TZFILE,TPFIELD,OFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TZFILE,TPFIELD,OFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TZFILE,TPFIELD,OFIELD,iresp_nc4)
END IF
END DO
ENDIF
#endif
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_L0',YMSG)
- END IF
- IF (PRESENT(KRESP)) KRESP = IRESP
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_L0', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
END SUBROUTINE IO_Field_write_byfield_L0
@@ -2019,7 +2860,7 @@ CONTAINS
CHARACTER(LEN=2) :: YDIR ! field form
INTEGER :: IERR
INTEGER :: ISIZEMAX
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
LOGICAL,DIMENSION(:),POINTER :: GFIELDP
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
@@ -2030,7 +2871,9 @@ CONTAINS
YRECFM = TPFIELD%CMNHNAME
YDIR = TPFIELD%CDIR
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
GALLOC = .FALSE.
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_L1',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
@@ -2043,10 +2886,10 @@ CONTAINS
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,OFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,OFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,OFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,OFIELD,iresp_nc4)
ELSE ! multiprocesses execution
- CALL MPI_ALLREDUCE(SIZE(OFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IRESP)
+ CALL MPI_ALLREDUCE(SIZE(OFIELD),ISIZEMAX,1,MNHINT_MPI,MPI_MAX,TPFILE%NMPICOMM,IERR)
IF (ISIZEMAX==0) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_write_byfield_L1','ignoring variable with a zero size ('//TRIM(YRECFM)//')')
IF (PRESENT(KRESP)) KRESP=0
@@ -2065,22 +2908,16 @@ CONTAINS
END IF
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,GFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,GFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,GFIELDP,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,GFIELDP,iresp_nc4)
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_L1',YMSG)
- END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_L1', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (GALLOC) DEALLOCATE(GFIELDP)
- IF (PRESENT(KRESP)) KRESP = IRESP
- !
END SUBROUTINE IO_Field_write_byfield_L1
@@ -2125,13 +2962,14 @@ CONTAINS
!
!* 0.2 Declarations of local variables
!
- INTEGER :: IERR
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
LOGICAL :: GLFI, GNC4
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -2148,24 +2986,18 @@ CONTAINS
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,HFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,HFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,iresp_nc4)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,HFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,HFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,iresp_nc4)
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_C0',YMSG)
- END IF
- IF (PRESENT(KRESP)) KRESP = IRESP
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_C0', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
END SUBROUTINE IO_Field_write_byfield_C0
@@ -2210,8 +3042,7 @@ CONTAINS
!
!* 0.2 Declarations of local variables
!
- INTEGER :: IERR
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
INTEGER :: J,JJ
INTEGER :: ILE, IP
INTEGER,DIMENSION(:),ALLOCATABLE :: IFIELD
@@ -2224,7 +3055,9 @@ CONTAINS
!
CALL IO_Field_metadata_check(TPFIELD,TYPECHAR,1,'IO_Field_write_byfield_C1')
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
!
CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
@@ -2253,25 +3086,20 @@ CONTAINS
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,iresp_nc4)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,IFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,HFIELD,iresp_nc4)
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_C1',YMSG)
- END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_C1', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (ALLOCATED(IFIELD)) DEALLOCATE(IFIELD)
- IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_Field_write_byfield_C1
@@ -2318,8 +3146,7 @@ CONTAINS
!
!* 0.2 Declarations of local variables
!
- INTEGER :: IERR
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
LOGICAL :: GLFI, GNC4
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
@@ -2328,7 +3155,9 @@ CONTAINS
!
CALL IO_Field_metadata_check(TPFIELD,TYPEDATE,0,'IO_Field_write_byfield_T0')
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
!
CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_T0',IRESP)
!
@@ -2336,25 +3165,96 @@ CONTAINS
!
IF (IRESP==0) THEN
IF (GSMONOPROC) THEN ! sequential execution
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TFIELD,iresp_nc4)
ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TFIELD,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TFIELD,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TFIELD,iresp_nc4)
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_T0', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+ END SUBROUTINE IO_Field_write_byfield_T0
+
+
+ SUBROUTINE IO_Field_write_byname_T1(TPFILE,HNAME,TFIELD,KRESP)
+ USE MODD_TYPE_DATE, only: DATE_TIME
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! name of the field to write
+ TYPE (DATE_TIME),DIMENSION(:), INTENT(IN) :: TFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ INTEGER :: ID ! Index of the field
+ INTEGER :: IRESP ! return_code
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byname_T1',TRIM(TPFILE%CNAME)//': writing '//TRIM(HNAME))
+ !
+ CALL FIND_FIELD_ID_FROM_MNHNAME(HNAME,ID,IRESP)
+ !
+ IF(IRESP==0) CALL IO_Field_write(TPFILE,TFIELDLIST(ID),TFIELD,IRESP)
!
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_T0',YMSG)
- END IF
IF (PRESENT(KRESP)) KRESP = IRESP
- END SUBROUTINE IO_Field_write_byfield_T0
+ !
+ END SUBROUTINE IO_Field_write_byname_T1
+
+
+ SUBROUTINE IO_Field_write_byfield_T1(TPFILE,TPFIELD,TFIELD,KRESP)
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
+ USE MODD_TYPE_DATE, only: DATE_TIME
+ !
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ TYPE (DATE_TIME),DIMENSION(:), INTENT(IN) :: TFIELD ! array containing the data field
+ INTEGER,OPTIONAL, INTENT(OUT):: KRESP ! return-code
+ !
+ !* 0.2 Declarations of local variables
+ !
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ LOGICAL :: GLFI, GNC4
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_T1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ !
+ CALL IO_Field_metadata_check(TPFIELD,TYPEDATE,1,'IO_Field_write_byfield_T1')
+ !
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
+ !
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_byfield_T1',IRESP)
+ !
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
+ !
+ IF (IRESP==0) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TFIELD,iresp_nc4)
+ ELSE
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TFIELD,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TFIELD,iresp_nc4)
+ END IF
+ END IF
+ END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_T1', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+ END SUBROUTINE IO_Field_write_byfield_T1
SUBROUTINE IO_Field_write_byname_lb(TPFILE,HNAME,KL3D,PLB,KRESP)
@@ -2385,7 +3285,8 @@ CONTAINS
SUBROUTINE IO_Field_write_byfield_lb(TPFILE,TPFIELD,KL3D,PLB,KRESP)
!
- USE MODD_IO, ONLY: GSMONOPROC, ISNPROC, ISP, L1D, L2D, LPACK
+ use modd_field, only: NMNHDIM_UNKNOWN, NMNHDIM_ONE, NMNHDIM_UNUSED
+ USE MODD_IO, ONLY: GSMONOPROC, ISNPROC, ISP, L2D, LPACK
USE MODD_PARAMETERS_ll, ONLY: JPHEXT
USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
!
@@ -2408,15 +3309,16 @@ CONTAINS
CHARACTER(LEN=4) :: YLBTYPE ! 'LBX','LBXU','LBY' or 'LBYV'
INTEGER :: IRIM ! size of the LB area
INTEGER :: IERR
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
REAL,DIMENSION(:,:,:),ALLOCATABLE,TARGET :: Z3D
+ real,dimension(:,:), pointer :: ztx2dp
REAL,DIMENSION(:,:,:), POINTER :: TX3DP
INTEGER :: IIMAX_ll,IJMAX_ll
INTEGER :: JI
INTEGER :: IIB,IIE,IJB,IJE
- INTEGER, DIMENSION(MPI_STATUS_SIZE) :: STATUS
- INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
- INTEGER :: NB_REQ,IKU
+ INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ISTATUS
+ INTEGER,ALLOCATABLE,DIMENSION(:) :: IREQ_TAB
+ INTEGER :: INB_REQ,IKU
LOGICAL :: GLFI, GNC4
TYPE TX_3DP
REAL,DIMENSION(:,:,:), POINTER :: X
@@ -2424,12 +3326,15 @@ CONTAINS
TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
CHARACTER(LEN=:),ALLOCATABLE :: YMSG
CHARACTER(LEN=6) :: YRESP
+ type(tfielddata) :: tzfield
!
YFILEM = TPFILE%CNAME
YRECFM = TPFIELD%CMNHNAME
YLBTYPE = TPFIELD%CLBTYPE
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_byfield_lb',TRIM(YFILEM)//': writing '//TRIM(YRECFM))
!
@@ -2454,16 +3359,31 @@ CONTAINS
CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
!
IF (IRESP==0) THEN
- IF (GSMONOPROC) THEN ! sequential execution
- IF (LPACK .AND. L2D) THEN
- TX3DP=>PLB(:,JPHEXT+1:JPHEXT+1,:)
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TX3DP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TX3DP,IRESP)
- ELSE
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PLB,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PLB,IRESP)
- END IF
- ELSE
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (LPACK .AND. L2D) THEN
+ if ( tpfile%ldimreduced ) then
+ tzfield = tpfield
+ tzfield%ndims = tzfield%ndims - 1
+ if ( tzfield%ndimlist(1) /= NMNHDIM_UNKNOWN ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(3)
+ tzfield%ndimlist(3) = tzfield%ndimlist(4) !Necessary if time dimension
+ tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+ ztx2dp => plb(:, jphext + 1, :)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, ztx2dp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, ztx2dp, iresp_nc4 )
+ else
+ tzfield = tpfield
+ if ( tzfield%ndimlist(2) /= NMNHDIM_UNKNOWN ) tzfield%ndimlist(2) = NMNHDIM_ONE
+ tx3dp => plb(:, jphext + 1 : jphext + 1, :)
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tzfield, tx3dp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tzfield, tx3dp, iresp_nc4 )
+ endif
+ ELSE
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,PLB,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,PLB,iresp_nc4)
+ END IF
+ ELSE
IF (ISP == TPFILE%NMASTER_RANK) THEN
! I/O proc case
CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
@@ -2477,7 +3397,7 @@ CONTAINS
IF (IIB /= 0) THEN
TX3DP=>Z3D(IIB:IIE,IJB:IJE,:)
IF (ISP /= JI) THEN
- CALL MPI_RECV(TX3DP,SIZE(TX3DP),MNHREAL_MPI,JI-1,99,TPFILE%NMPICOMM,STATUS,IERR)
+ CALL MPI_RECV(TX3DP,SIZE(TX3DP),MNHREAL_MPI,JI-1,99,TPFILE%NMPICOMM,ISTATUS,IERR)
ELSE
CALL GET_DISTRIB_lb(YLBTYPE,JI,'LOC','WRITE',IRIM,IIB,IIE,IJB,IJE)
TX3DP = PLB(IIB:IIE,IJB:IJE,:)
@@ -2485,51 +3405,330 @@ CONTAINS
END IF
END DO
IF (LPACK .AND. L2D) THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'IO_Field_write_byfield_lb', '2D not (yet) allowed for parallel execution' )
TX3DP=>Z3D(:,JPHEXT+1:JPHEXT+1,:)
ELSE
TX3DP=>Z3D
END IF
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TX3DP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TX3DP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,TX3DP,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,TX3DP,iresp_nc4)
ELSE
- NB_REQ=0
- ALLOCATE(REQ_TAB(1))
+ INB_REQ=0
+ ALLOCATE(IREQ_TAB(1))
ALLOCATE(T_TX3DP(1))
IKU = SIZE(PLB,3)
! Other processes
CALL GET_DISTRIB_lb(YLBTYPE,ISP,'LOC','WRITE',IRIM,IIB,IIE,IJB,IJE)
IF (IIB /= 0) THEN
TX3DP=>PLB(IIB:IIE,IJB:IJE,:)
- NB_REQ = NB_REQ + 1
- ALLOCATE(T_TX3DP(NB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
- T_TX3DP(NB_REQ)%X=PLB(IIB:IIE,IJB:IJE,:)
- CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,99, &
- TPFILE%NMPICOMM,REQ_TAB(NB_REQ),IERR)
+ INB_REQ = INB_REQ + 1
+ ALLOCATE(T_TX3DP(INB_REQ)%X(IIB:IIE,IJB:IJE,IKU))
+ T_TX3DP(INB_REQ)%X=PLB(IIB:IIE,IJB:IJE,:)
+ CALL MPI_ISEND(T_TX3DP(INB_REQ)%X,SIZE(TX3DP),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,99, &
+ TPFILE%NMPICOMM,IREQ_TAB(INB_REQ),IERR)
!CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MNHREAL_MPI,TPFILE%NMASTER_RANK-1,99,TPFILE%NMPICOMM,IERR)
END IF
- IF (NB_REQ .GT.0 ) THEN
- CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ IF (INB_REQ .GT.0 ) THEN
+ CALL MPI_WAITALL(INB_REQ,IREQ_TAB,MNH_STATUSES_IGNORE,IERR)
DEALLOCATE(T_TX3DP(1)%X)
END IF
- DEALLOCATE(T_TX3DP,REQ_TAB)
+ DEALLOCATE(T_TX3DP,IREQ_TAB)
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF
END IF
!
1000 CONTINUE
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(YRECFM)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_byfield_lb',YMSG)
- END IF
- !
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_byfield_lb', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (ALLOCATED(Z3D)) DEALLOCATE(Z3D)
IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_Field_write_byfield_lb
+ SUBROUTINE IO_Field_write_box_byfield_X2( TPFILE, TPFIELD, HBUDGET, PFIELD, KXOBOX, KXEBOX, KYOBOX, KYEBOX, KRESP, koffset )
+ !
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
+ !
+ USE MODE_GATHER_ll
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ CHARACTER(LEN=*), INTENT(IN) :: HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
+ REAL, DIMENSION(:,:), TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) :: KXOBOX !
+ INTEGER, INTENT(IN) :: KXEBOX ! Global coordinates of the box
+ INTEGER, INTENT(IN) :: KYOBOX !
+ INTEGER, INTENT(IN) :: KYEBOX !
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(2), optional, intent(in) :: koffset
+ !
+ !* 0.2 Declarations of local variables
+ !
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ REAL, DIMENSION(:,:), POINTER :: ZFIELDP
+ LOGICAL :: GALLOC
+ LOGICAL :: GLFI, GNC4
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_box_byfield_X2',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ !
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
+ GALLOC = .FALSE.
+ !
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_box_byfield_X2',IRESP)
+ !
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
+ !
+ if ( Present( koffset ) .and. glfi ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_write_box_byfield_X3', Trim( tpfile%cname ) &
+ // ': LFI format not supported' )
+ glfi = .false.
+ end if
+
+ IF (IRESP==0) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (HBUDGET /= 'BUDGET') THEN
+ ! take the sub-section of PFIELD defined by the box
+ ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX)
+ ELSE
+ ! take the field as a budget
+ ZFIELDP=>PFIELD
+ END IF
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4 )
+ end if
+ ELSE ! multiprocesses execution
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
+ ! Allocate the box
+ ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1))
+ GALLOC = .TRUE.
+ ELSE
+ ALLOCATE(ZFIELDP(0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM,&
+ & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
+ !
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4 )
+ end if
+ END IF
+ END IF ! multiprocesses execution
+ END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_box_byfield_X2', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ END SUBROUTINE IO_Field_write_box_byfield_X2
+
+
+ SUBROUTINE IO_Field_write_box_byfield_X3( TPFILE, TPFIELD, HBUDGET, PFIELD, KXOBOX, KXEBOX, KYOBOX, KYEBOX, KRESP, koffset )
+ !
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
+ !
+ USE MODE_GATHER_ll
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ CHARACTER(LEN=*), INTENT(IN) :: HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
+ REAL, DIMENSION(:,:,:), TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) :: KXOBOX !
+ INTEGER, INTENT(IN) :: KXEBOX ! Global coordinates of the box
+ INTEGER, INTENT(IN) :: KYOBOX !
+ INTEGER, INTENT(IN) :: KYEBOX !
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(3), optional, intent(in) :: koffset
+ !
+ !* 0.2 Declarations of local variables
+ !
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ REAL, DIMENSION(:,:,:), POINTER :: ZFIELDP
+ LOGICAL :: GALLOC
+ LOGICAL :: GLFI, GNC4
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_box_byfield_X3',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ !
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
+ GALLOC = .FALSE.
+ !
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_box_byfield_X3',IRESP)
+ !
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
+ !
+ if ( Present( koffset ) .and. glfi ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_write_box_byfield_X3', Trim( tpfile%cname ) &
+ // ': LFI format not supported' )
+ glfi = .false.
+ end if
+
+ IF (IRESP==0) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (HBUDGET /= 'BUDGET') THEN
+ ! take the sub-section of PFIELD defined by the box
+ ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:)
+ ELSE
+ ! take the field as a budget
+ ZFIELDP=>PFIELD
+ END IF
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4 )
+ end if
+ ELSE ! multiprocesses execution
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
+ ! Allocate the box
+ ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3)))
+ GALLOC = .TRUE.
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM,&
+ & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
+ !
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4 )
+ end if
+ END IF
+ END IF ! multiprocesses execution
+ END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_box_byfield_X3', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ END SUBROUTINE IO_Field_write_box_byfield_X3
+
+
+ SUBROUTINE IO_Field_write_box_byfield_X4( TPFILE, TPFIELD, HBUDGET, PFIELD, KXOBOX, KXEBOX, KYOBOX, KYEBOX, KRESP, koffset )
+ !
+ USE MODD_IO, ONLY: GSMONOPROC, ISP
+ !
+ USE MODE_GATHER_ll
+ !
+ !
+ !* 0.1 Declarations of arguments
+ !
+ TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+ CHARACTER(LEN=*), INTENT(IN) :: HBUDGET ! 'BUDGET' (budget) or 'OTHER' (MesoNH field)
+ REAL, DIMENSION(:,:,:,:), TARGET, INTENT(IN) :: PFIELD ! array containing the data field
+ INTEGER, INTENT(IN) :: KXOBOX !
+ INTEGER, INTENT(IN) :: KXEBOX ! Global coordinates of the box
+ INTEGER, INTENT(IN) :: KYOBOX !
+ INTEGER, INTENT(IN) :: KYEBOX !
+ INTEGER, OPTIONAL, INTENT(OUT) :: KRESP ! return-code
+ integer, dimension(4), optional, intent(in) :: koffset
+ !
+ !* 0.2 Declarations of local variables
+ !
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
+ REAL, DIMENSION(:,:,:,:), POINTER :: ZFIELDP
+ LOGICAL :: GALLOC
+ LOGICAL :: GLFI, GNC4
+ CHARACTER(LEN=:),ALLOCATABLE :: YMSG
+ CHARACTER(LEN=6) :: YRESP
+ !
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_box_byfield_X4',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+ !
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
+ GALLOC = .FALSE.
+ !
+ CALL IO_File_write_check(TPFILE,'IO_Field_write_box_byfield_X4',IRESP)
+ !
+ CALL IO_Format_write_select(TPFILE,GLFI,GNC4)
+ !
+ if ( Present( koffset ) .and. glfi ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_partial_write_box_byfield_X4', Trim( tpfile%cname ) &
+ // ': LFI format not supported' )
+ glfi = .false.
+ end if
+
+ IF (IRESP==0) THEN
+ IF (GSMONOPROC) THEN ! sequential execution
+ IF (HBUDGET /= 'BUDGET') THEN
+ ! take the sub-section of PFIELD defined by the box
+ ZFIELDP=>PFIELD(KXOBOX:KXEBOX,KYOBOX:KYEBOX,:,:)
+ ELSE
+ ! take the field as a budget
+ ZFIELDP=>PFIELD
+ END IF
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4 )
+ end if
+ ELSE ! multiprocesses execution
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
+ ! Allocate the box
+ ALLOCATE(ZFIELDP(KXEBOX-KXOBOX+1,KYEBOX-KYOBOX+1,SIZE(PFIELD,3),SIZE(PFIELD,4)))
+ GALLOC = .TRUE.
+ ELSE
+ ALLOCATE(ZFIELDP(0,0,0,0))
+ GALLOC = .TRUE.
+ END IF
+ !
+ CALL GATHER_XYFIELD(PFIELD,ZFIELDP,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM,&
+ & KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
+ !
+ IF (ISP == TPFILE%NMASTER_RANK) THEN
+ if ( Present( koffset ) ) then
+ !if ( glfi ) call IO_Field_partial_write_lfi( tpfile, tpfield, zfieldp, koffset, iresp_lfi )
+ if ( gnc4 ) call IO_Field_partial_write_nc4( tpfile, tpfield, zfieldp, koffset, iresp_nc4 )
+ else
+ if ( glfi ) call IO_Field_write_lfi( tpfile, tpfield, zfieldp, iresp_lfi )
+ if ( gnc4 ) call IO_Field_write_nc4( tpfile, tpfield, zfieldp, iresp_nc4 )
+ end if
+ END IF
+ END IF ! multiprocesses execution
+ END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_box_byfield_X4', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
+ IF (GALLOC) DEALLOCATE(ZFIELDP)
+ END SUBROUTINE IO_Field_write_box_byfield_X4
+
+
SUBROUTINE IO_Field_write_box_byfield_X5(TPFILE,TPFIELD,HBUDGET,PFIELD,KXOBOX,KXEBOX,KYOBOX,KYEBOX,KRESP)
!
USE MODD_IO, ONLY: GSMONOPROC, ISP
@@ -2551,8 +3750,7 @@ CONTAINS
!
!* 0.2 Declarations of local variables
!
- INTEGER :: IERR
- INTEGER :: IRESP
+ integer :: iresp, iresp_lfi, iresp_nc4, iresp_glob
REAL,DIMENSION(:,:,:,:,:),POINTER :: ZFIELDP
LOGICAL :: GALLOC
LOGICAL :: GLFI, GNC4
@@ -2561,7 +3759,9 @@ CONTAINS
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_box_byfield_X5',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
- IRESP = 0
+ iresp = 0
+ iresp_lfi = 0
+ iresp_nc4 = 0
GALLOC = .FALSE.
!
CALL IO_File_write_check(TPFILE,'IO_Field_write_box_byfield_X5',IRESP)
@@ -2577,8 +3777,8 @@ CONTAINS
! take the field as a budget
ZFIELDP=>PFIELD
END IF
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,iresp_nc4)
ELSE ! multiprocesses execution
IF (ISP == TPFILE%NMASTER_RANK) THEN
! Allocate the box
@@ -2594,21 +3794,16 @@ CONTAINS
& KXOBOX,KXEBOX,KYOBOX,KYEBOX,HBUDGET)
!
IF (ISP == TPFILE%NMASTER_RANK) THEN
- IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,IRESP)
- IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,IRESP)
+ IF (GLFI) CALL IO_Field_write_lfi(TPFILE,TPFIELD,ZFIELDP,iresp_lfi)
+ IF (GNC4) CALL IO_Field_write_nc4(TPFILE,TPFIELD,ZFIELDP,iresp_nc4)
END IF
- !
- CALL MPI_BCAST(IRESP,1,MNHINT_MPI,TPFILE%NMASTER_RANK-1,TPFILE%NMPICOMM,IERR)
END IF ! multiprocesses execution
END IF
- !
- IF (IRESP.NE.0) THEN
- WRITE(YRESP, '( I6 )') IRESP
- YMSG = 'RESP='//YRESP//' when writing '//TRIM(TPFIELD%CMNHNAME)//' in '//TRIM(TPFILE%CNAME)
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_box_byfield_X5',YMSG)
- END IF
+
+ call IO_Field_write_error_check( tpfile, tpfield, 'IO_Field_write_box_byfield_X5', iresp, iresp_lfi, iresp_nc4, iresp_glob )
+ if ( Present( kresp ) ) kresp = iresp_glob
+
IF (GALLOC) DEALLOCATE(ZFIELDP)
- IF (PRESENT(KRESP)) KRESP = IRESP
END SUBROUTINE IO_Field_write_box_byfield_X5
@@ -2812,6 +4007,24 @@ DO JI = 1,SIZE(TPOUTPUT%NFIELDLIST)
END IF
#endif
!
+ !1D date/time
+ !
+ CASE (TYPEDATE)
+ IF ( .NOT.ALLOCATED(TFIELDLIST(IDX)%TFIELD_T1D) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_T1D is NOT allocated ' )
+ END IF
+ IF ( .NOT.ASSOCIATED(TFIELDLIST(IDX)%TFIELD_T1D(IMI)%DATA) ) THEN
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': TFIELD_T1D%DATA is NOT associated' )
+ END IF
+ IF ( TFIELDLIST(IDX)%CLBTYPE == 'NONE' ) THEN
+ CALL IO_Field_write(TPOUTPUT%TFILE,TFIELDLIST(IDX),TFIELDLIST(IDX)%TFIELD_T1D(IMI)%DATA)
+ ELSE
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Fieldlist_write', trim(tfieldlist(idx)%cmnhname)// &
+ ': CLBTYPE/=NONE not allowed for 1D date/time fields' )
+ END IF
+ !
!1D other types
!
CASE DEFAULT
@@ -3030,7 +4243,7 @@ SUBROUTINE IO_Field_user_write(TPOUTPUT)
!
#if 0
USE MODD_DYN_n, ONLY: XTSTEP
-USE MODD_FIELD_n, ONLY: XUT, XVT, XRT, XTHT
+USE MODD_FIELD_n, ONLY: XUT, XVT, XRT, XTHT, XSVT
USE MODD_PARAMETERS, ONLY: JPVEXT
USE MODD_PRECIP_n, ONLY: XINPRR
#endif
@@ -3107,6 +4320,19 @@ TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .TRUE.
!XACPRR is multiplied by 1000. to convert from m to kg m-2 (water density is assumed to be 1000 kg m-3)
CALL IO_Field_write(TPOUTPUT%TFILE,TZFIELD,XINPRR*XTSTEP*1.0E3)
+!
+TZFIELD%CMNHNAME = 'SVT001'
+TZFIELD%CSTDNAME = 'concentration in scalar variable'
+TZFIELD%CLONGNAME = ''
+TZFIELD%CUNITS = 'kg kg-1'
+TZFIELD%CDIR = 'XY'
+TZFIELD%CCOMMENT = 'X_Y_Z_concentration in scalar variable'
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPEREAL
+TZFIELD%NDIMS = 3
+TZFIELD%LTIMEDEP = .TRUE.
+CALL IO_WRITE_FIELD(TPOUTPUT%TFILE,TZFIELD,XSVT(:,:,:,1))
+!
#endif
!
END SUBROUTINE IO_Field_user_write
diff --git a/src/LIB/SURCOUCHE/src/mode_io_file.f90 b/src/LIB/SURCOUCHE/src/mode_io_file.f90
index f341a1a62868cb50663100c5d795cbb0f576a7fa..e269accf0320ac26d31879e4ea155bc61ecc2d17 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_file.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_file.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.
@@ -37,6 +37,7 @@
! P. Wautelet 05/03/2019: rename IO subroutines and modules
! P. Wautelet 12/03/2019: simplify opening of IO split files
! P. Wautelet 05/09/2019: disable IO_Coordvar_write_nc4 for Z-split files
+! P. Wautelet 01/10/2020: bugfix: add missing initializations for IRESP
!-----------------------------------------------------------------
module mode_io_file
@@ -77,6 +78,8 @@ TYPE(TFILEDATA), POINTER :: TZFILE_DES
TYPE(TFILEDATA), POINTER :: TZFILE_DUMMY
TYPE(TFILEDATA), POINTER :: TZFILE_SPLIT
!
+iresp = 0
+!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_File_open','opening '//TRIM(TPFILE%CNAME)//' for '//TRIM(TPFILE%CMODE)// &
' (filetype='//TRIM(TPFILE%CTYPE)//')')
!
@@ -180,15 +183,17 @@ SELECT CASE(TPFILE%CTYPE)
IF (IRESP/=0) THEN !File not yet in filelist => add it (nothing to do if already in list)
IF (ALLOCATED(TPFILE%CDIRNAME)) THEN
- CALL IO_File_add2list(TZFILE_SPLIT,TRIM(TPFILE%CNAME)//TRIM(YFILE),TPFILE%CTYPE,TPFILE%CMODE, &
- HDIRNAME=TPFILE%CDIRNAME, &
- KLFINPRAR=TPFILE%NLFINPRAR,KLFITYPE=TPFILE%NLFITYPE,KLFIVERB=TPFILE%NLFIVERB, &
- HFORMAT=TPFILE%CFORMAT,osplit_ioz=.false.)
+ call IO_File_add2list( tzfile_split, trim(tpfile%cname)//trim(yfile), tpfile%ctype, tpfile%cmode, &
+ hdirname = tpfile%cdirname, &
+ klfinprar = tpfile%nlfinprar, klfitype = tpfile%nlfitype, klfiverb = tpfile%nlfiverb, &
+ hformat = tpfile%cformat, &
+ osplit_ioz=.false. )
ELSE
- CALL IO_File_add2list(TZFILE_SPLIT,TRIM(TPFILE%CNAME)//TRIM(YFILE),TPFILE%CTYPE,TPFILE%CMODE, &
- KLFINPRAR=TPFILE%NLFINPRAR,KLFITYPE=TPFILE%NLFITYPE,KLFIVERB=TPFILE%NLFIVERB, &
- HFORMAT=TPFILE%CFORMAT,osplit_ioz=.false.)
- END IF
+ call IO_File_add2list( tzfile_split, trim(tpfile%cname)//trim(yfile), tpfile%ctype, tpfile%cmode, &
+ klfinprar = tpfile%nlfinprar, klfitype = tpfile%nlfitype, klfiverb = tpfile%nlfiverb, &
+ hformat = tpfile%cformat, &
+ osplit_ioz=.false. )
+ END IF
TZFILE_SPLIT%TMAINFILE => TPFILE
END IF
@@ -492,7 +497,7 @@ use modd_conf, only: cprogram
use modd_io, only: nnullunit
use mode_io_file_lfi, only: IO_File_close_lfi
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
use mode_io_file_nc4, only: IO_File_close_nc4
use mode_io_write_nc4, only: IO_Coordvar_write_nc4
#endif
@@ -508,7 +513,9 @@ TYPE(TFILEDATA),POINTER :: TZFILE_DES
TYPE(TFILEDATA),POINTER :: TZFILE_IOZ
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_File_close','closing '//TRIM(TPFILE%CNAME))
-!
+
+iresp = 0
+
IF (.NOT.TPFILE%LOPENED) THEN
CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_close','trying to close a file not opened: '//TRIM(TPFILE%CNAME))
RETURN
@@ -548,13 +555,13 @@ SELECT CASE(TPFILE%CTYPE)
!Remark: 'MNH' is more general than MNHBACKUP and could be in fact a MNHBACKUP file
CASE ('MNH', 'MNHBACKUP', 'MNHDIACHRONIC', 'MNHDIAG', 'MNHOUTPUT', 'PGD')
!Do not close (non-existing) '.des' file if OUTPUT
- IF(TPFILE%CTYPE/='OUTPUT' .AND. CPROGRAM/='LFICDF') THEN
+ IF(TPFILE%CTYPE/='MNHOUTPUT' .AND. CPROGRAM/='LFICDF') THEN
CALL IO_File_find_byname(TRIM(TPFILE%CNAME)//'.des',TZFILE_DES,IRESP)
IF (IRESP/=0) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_File_close','file '//TRIM(TPFILE%CNAME)//'.des not in filelist')
CALL IO_File_close(TZFILE_DES,KRESP=IRESP,HPROGRAM_ORIG=HPROGRAM_ORIG)
ENDIF
!
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
!Write coordinates variables in NetCDF file
IF (TPFILE%CMODE == 'WRITE' .AND. (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4')) THEN
CALL IO_Coordvar_write_nc4(TPFILE,HPROGRAM_ORIG=HPROGRAM_ORIG)
@@ -563,7 +570,7 @@ SELECT CASE(TPFILE%CTYPE)
if (tpfile%lmaster) then
if (tpfile%cformat == 'LFI' .or. tpfile%cformat == 'LFICDF4') call IO_File_close_lfi(tpfile,iresp)
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
if (tpfile%cformat == 'NETCDF4' .or. tpfile%cformat == 'LFICDF4') call IO_File_close_nc4(tpfile,iresp)
#endif
end if
@@ -580,7 +587,7 @@ SELECT CASE(TPFILE%CTYPE)
TZFILE_IOZ%LOPENED = .FALSE.
TZFILE_IOZ%NOPEN_CURRENT = 0
TZFILE_IOZ%NCLOSE = TZFILE_IOZ%NCLOSE + 1
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
!Remark: IO_Coordvar_write_nc4 disabled (for the moment) for Z-split files
! because it introduce a serialization due to MPI communications inside the call
! !Write coordinates variables in netCDF file
@@ -590,7 +597,7 @@ SELECT CASE(TPFILE%CTYPE)
#endif
IF (TZFILE_IOZ%LMASTER) THEN
if (tzfile_ioz%cformat == 'LFI' .or. tzfile_ioz%cformat == 'LFICDF4') call IO_File_close_lfi(tzfile_ioz,iresp)
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
if (tzfile_ioz%cformat == 'NETCDF4' .or. tzfile_ioz%cformat == 'LFICDF4') call IO_File_close_nc4(tzfile_ioz,iresp)
#endif
END IF
@@ -644,13 +651,13 @@ IF (TPFILE%LMASTER .AND. CPROGRAM/='LFICDF') THEN
CASE(1)
YCPIO='MESONH'
CASE(2)
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_Transfer_list_addto','file '//TRIM(YFILEM)//' not transferred')
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Transfer_list_addto','file '//TRIM(YFILEM)//' not transferred')
END SELECT
if (TPFILE%NLFITYPE==0 .or. TPFILE%NLFITYPE==1) then
ICPT=ICPT+1
WRITE (YCOMMAND,'(A," ",A," ",A," >> OUTPUT_TRANSFER",I3.3," 2>&1 &")') YTRANS,YCPIO,TRIM(YFILEM),ICPT
- CALL PRINT_MSG(NVERB_INFO,'IO','IO_Transfer_list_addto','YCOMMAND='//TRIM(YCOMMAND))
+ CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Transfer_list_addto','YCOMMAND='//TRIM(YCOMMAND))
CALL SYSTEM_MNH(YCOMMAND)
end if
END IF
@@ -718,7 +725,7 @@ end subroutine IO_File_check_format_exist
subroutine IO_File_open_format( tpfile, hprogram_orig )
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
use mode_io_file_nc4, only: IO_File_create_nc4, IO_File_open_nc4
#endif
use mode_io_file_lfi, only: IO_File_create_lfi, IO_File_open_lfi
@@ -731,7 +738,7 @@ integer :: iresp
call Print_msg( NVERB_DEBUG, 'IO', 'IO_File_open_format', 'called for '//TRIM(tpfile%cname) )
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
IF (TPFILE%CFORMAT=='NETCDF4' .OR. TPFILE%CFORMAT=='LFICDF4') THEN
SELECT CASE (TPFILE%CMODE)
CASE('READ')
diff --git a/src/LIB/SURCOUCHE/src/mode_io_file_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_file_lfi.f90
index 1d07379957d7f74d8d407d23b450d51f87f96067..ae58ffa6c527933ddf1c32a756b9f1532643d023 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_file_lfi.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_file_lfi.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.
@@ -16,6 +16,7 @@
! P. Wautelet 05/03/2019: rename IO subroutines and modules
!
!-----------------------------------------------------------------
+#ifdef MNH_IOLFI
module mode_io_file_lfi
use modd_io, only: tfiledata
@@ -202,3 +203,5 @@ end subroutine IO_Flu_dealloc
end module mode_io_file_lfi
+#endif
+
diff --git a/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90
index 5a80880fa4e74e5bcee57266b095c9bead5d8e6e..5fc23539af2b79f2eb7c989229da81b008eeab36 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_file_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_file_nc4.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.
@@ -17,9 +17,9 @@
! P. Wautelet 05/03/2019: rename IO subroutines and modules
! P. Wautelet 07/03/2019: bugfix: io_set_mnhversion must be called by all the processes
! P. Wautelet 18/09/2019: correct support of 64bit integers (MNH_INT=8)
-!
+! P. Wautelet 22/09/2020: use ldimreduced to allow reduction in the number of dimensions of fields (used by 2D simulations)
!-----------------------------------------------------------------
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
module mode_io_file_nc4
use modd_io, only: tfiledata
@@ -70,8 +70,8 @@ end subroutine IO_File_create_nc4
subroutine IO_File_close_nc4(tpfile,kstatus)
use mode_io_tools_nc4, only: IO_Iocdf_dealloc_nc4
- type(tfiledata), intent(inout) :: tpfile
- integer(kind=CDFINT), optional, intent(out) :: kstatus
+ type(tfiledata), intent(inout) :: tpfile
+ integer, optional, intent(out) :: kstatus
integer(kind=CDFINT) :: istatus
@@ -126,11 +126,51 @@ subroutine IO_File_open_nc4(tpfile)
if (trim(tpfile%cmode) == 'READ') then
call IO_Mnhversion_get(tpfile)
if (tpfile%lmaster) call IO_Cleanly_closed_check_nc4(tpfile)
+ call IO_Are_dimension_reduced(tpfile)
end if
end subroutine IO_File_open_nc4
+subroutine IO_Are_dimension_reduced(tpfile)
+ use modd_io, only: isp
+ use modd_mpif
+ use modd_precision, only: MNHLOG_MPI
+
+ type(tfiledata), intent(inout) :: tpfile
+
+ integer :: ierr
+ integer(kind=CDFINT) :: istatus
+ character(len=1) :: ydimred
+
+ call print_msg(NVERB_DEBUG,'IO','IO_Are_dimension_reduced','called for '//trim(tpfile%cname))
+
+ if ( tpfile%nmnhversion(1) < 5 .or. ( tpfile%nmnhversion(1) == 5 .and. tpfile%nmnhversion(2) < 5 ) ) then
+ call Print_msg( NVERB_DEBUG, 'IO', 'IO_Are_dimension_reduced', 'ldimreduced set to false (created with MesoNH < 5.5.0)' )
+ tpfile%ldimreduced = .false.
+ else
+ if ( isp == tpfile%nmaster_rank ) then
+ istatus = NF90_GET_ATT( tpfile%nncid, NF90_GLOBAL, 'MNH_REDUCE_DIMENSIONS_IN_FILES', ydimred )
+ if ( istatus == NF90_NOERR ) then
+ if ( ydimred == '0' ) then
+ tpfile%ldimreduced = .false.
+ else if ( ydimred == '1' ) then
+ tpfile%ldimreduced = .true.
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Are_dimension_reduced', &
+ 'invalid value for MNH_REDUCE_DIMENSIONS_IN_FILES attribute' )
+ end if
+ else !attribute not found
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Are_dimension_reduced', 'MNH_REDUCE_DIMENSIONS_IN_FILES attribute not found' )
+ end if
+ end if
+
+ call MPI_BCAST( tpfile%ldimreduced, 1, MNHLOG_MPI, tpfile%nmaster_rank - 1, tpfile%nmpicomm, ierr )
+ end if
+
+end subroutine IO_Are_dimension_reduced
+
+
subroutine IO_Cleanly_closed_check_nc4(tpfile)
type(tfiledata), intent(in) :: tpfile
diff --git a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90 b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
index 4e6bce3f26e7f74836495171a3da9dcab91a5e6b..f7954781fd46754679b6f25aeb2c6fc018a19b6b 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_manage_struct.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2016-2019 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 for details. version 1.
@@ -16,6 +16,9 @@
! P. Wautelet 18/02/2019: bugfixes for nsubfiles_ioz
! P. Wautelet 05/03/2019: rename IO subroutines and modules
! P. Wautelet 12/03/2019: add TMAINFILE field in TFILEDATA
+! P. Wautelet 11/02/2020: bugfix: TDADFILE was wrongly constructed for output files
+! S. Donnier 28/02/2020: type STREAM needed for use of ECOCLIMAP SG
+! P. Wautelet 08/01/2021: allow output files with empty variable list (useful if IO_Field_user_write is not empty)
!-----------------------------------------------------------------
MODULE MODE_IO_MANAGE_STRUCT
!
@@ -41,13 +44,15 @@ USE MODD_CONF
USE MODD_CONF_n
USE MODD_DYN, ONLY : XSEGLEN
USE MODD_DYN_n, ONLY : DYN_MODEL
+use modd_field, only: tfieldlist
USE MODD_IO_SURF_MNH,ONLY : IO_SURF_MNH_MODEL
USE MODD_NESTING, ONLY : CDAD_NAME,NDAD
USE MODD_NSV, ONLY: NSV
USE MODD_OUT_n, ONLY : OUT_MODEL
USE MODD_VAR_ll, ONLY : IP
-USE MODE_FIELD
-!
+
+use mode_field, only: Find_field_id_from_mnhname
+
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSUP ! supp. time steps
@@ -253,7 +258,7 @@ DO IMI = 1, NMODEL
IF (IDX>0) THEN
OUT_MODEL(IMI)%TOUTPUTN(IPOS)%NOUTDAD = IDX
WRITE (YDADNUMBER,FMT="('.',I3.3)") OUT_MODEL(IMI)%TOUTPUTN(IPOS)%NOUTDAD
- OUT_MODEL(IMI)%TOUTPUTN(IPOS)%TFILE%TDADFILE => OUT_MODEL(NDAD(IMI))%TBACKUPN(IDX)%TFILE
+ OUT_MODEL(IMI)%TOUTPUTN(IPOS)%TFILE%TDADFILE => OUT_MODEL(NDAD(IMI))%TOUTPUTN(IDX)%TFILE
ELSE
OUT_MODEL(IMI)%TOUTPUTN(IPOS)%NOUTDAD = -1
NULLIFY(OUT_MODEL(IMI)%TOUTPUTN(IPOS)%TFILE%TDADFILE) !No dad file
@@ -268,24 +273,28 @@ DO IMI = 1, NMODEL
DO IPOS = 1,JPOUTVARMAX
IF (COUT_VAR(IMI,IPOS)/='') IVAR = IVAR + 1
END DO
- IF (IVAR==0) CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Bakout_struct_prepare','no fields chosen for output')
+ IF (IVAR==0) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Bakout_struct_prepare','no fields chosen for output')
ALLOCATE(OUT_MODEL(IMI)%TOUTPUTN(1)%NFIELDLIST(IVAR))
- !Determine the list of the outputs to do (by field number)
- IVAR = 1
- !Set the NFIELDLIST for the 1st output
- !All the others will use the same list (for the moment)
- DO IPOS = 1,JPOUTVARMAX
- IF (COUT_VAR(IMI,IPOS)/='') THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME(COUT_VAR(IMI,IPOS),IFIELD,IRESP)
- OUT_MODEL(IMI)%TOUTPUTN(1)%NFIELDLIST(IVAR) = IFIELD
- IF (IRESP/=0) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Bakout_struct_prepare','unknown field for output: '//TRIM(COUT_VAR(IMI,IPOS)))
- !MNH is killed to prevent problems with wrong values in NFIELDLIST
+
+ if ( ivar > 0 ) then
+ !Determine the list of the outputs to do (by field number)
+ !Set the NFIELDLIST for the 1st output
+ !All the others will use the same list (for the moment)
+ IVAR = 0
+ DO IPOS = 1,JPOUTVARMAX
+ IF (COUT_VAR(IMI,IPOS)/='') THEN
+ IVAR=IVAR+1
+ CALL FIND_FIELD_ID_FROM_MNHNAME(COUT_VAR(IMI,IPOS),IFIELD,IRESP)
+ OUT_MODEL(IMI)%TOUTPUTN(1)%NFIELDLIST(IVAR) = IFIELD
+ IF (IRESP/=0) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Bakout_struct_prepare','unknown field for output: '//TRIM(COUT_VAR(IMI,IPOS)))
+ !MNH is killed to prevent problems with wrong values in NFIELDLIST
+ END IF
+ !
END IF
- !
- IVAR=IVAR+1
- END IF
- END DO
+ END DO
+ end if
+
!All the outputs use the same field list (for the moment)
DO IPOS = 2,IOUT_NUMB
OUT_MODEL(IMI)%TOUTPUTN(IPOS)%NFIELDLIST => OUT_MODEL(IMI)%TOUTPUTN(1)%NFIELDLIST
@@ -589,7 +598,7 @@ SUBROUTINE POPULATE_STRUCT(TPFILE_FIRST,TPFILE_LAST,KSTEPS,HFILETYPE,TPBAKOUTN)
CALL PRINT_MSG(NVERB_FATAL,'IO','POPULATE_STRUCT','unknown backup/output fileformat')
ENDIF
!
- !Create file structures if Z-splitted files
+ !Create file structures if Z-split files
IF (NB_PROCIO_W>1) THEN
TPBAKOUTN(IPOS)%TFILE%NSUBFILES_IOZ = NB_PROCIO_W
ALLOCATE(TPBAKOUTN(IPOS)%TFILE%TFILES_IOZ(NB_PROCIO_W))
@@ -950,7 +959,7 @@ SELECT CASE(TPFILE%CTYPE)
TPFILE%NLFITYPE = ILFITYPE
TPFILE%NLFIVERB = ILFIVERB
!
- IF (TRIM(HTYPE)=='OUTPUT') THEN
+ IF (TRIM(HTYPE)=='MNHOUTPUT') THEN
TPFILE%LNCREDUCE_FLOAT_PRECISION = LOUT_REDUCE_FLOAT_PRECISION(IMI)
TPFILE%LNCCOMPRESS = LOUT_COMPRESS(IMI)
TPFILE%NNCCOMPRESS_LEVEL = NOUT_COMPRESS_LEVEL(IMI)
diff --git a/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90
index 01b03897d2134c902a7b0aa0c1384771bdc04557..f98999c1ea643987e3825b791b28d30d41a151fa 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_read_lfi.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -13,11 +13,11 @@
!-----------------------------------------------------------------
module mode_io_read_lfi
!
+use modd_field, only: tfielddata
USE MODD_IO
USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH
-use modd_precision, only: LFIINT
+use modd_precision, only: LFIINT, MNHINT64, MNHREAL32, MNHREAL64
!
-USE MODE_FIELD, ONLY : TFIELDDATA
USE MODE_MSG
!
IMPLICIT NONE
@@ -57,11 +57,11 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
-REAL,DIMENSION(1) :: ZFIELD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
+REAL,DIMENSION(1) :: ZFIELD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -96,10 +96,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -130,10 +130,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -164,10 +164,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -198,10 +198,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occur
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X4',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -232,10 +232,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occ
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X5',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -266,10 +266,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems o
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_X6',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -300,10 +300,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -334,10 +334,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -368,10 +368,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occure
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N2',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -402,10 +402,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occu
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_N3',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -436,11 +436,11 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER :: IFIELD
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER :: IFIELD
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_L0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -483,12 +483,12 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG
-INTEGER :: JI
-INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG
+INTEGER :: JI
+INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_L1',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -538,10 +538,10 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
-INTEGER :: ILENG, ILENGMAX, JLOOP
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
+INTEGER(KIND=LFIINT) :: IRESP,ITOTAL
+INTEGER :: ILENG, ILENGMAX, JLOOP
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_C0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -588,13 +588,13 @@ INTEGER, INTENT(OUT) :: KRESP ! return-code if problems occured
!
!* 0.2 Declarations of local variables
!
-INTEGER(KIND=LFIINT) :: IRESP, ITOTAL
-INTEGER :: ILENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-LOGICAL :: GGOOD
-TYPE(TFIELDDATA) :: TZFIELD
-INTEGER, DIMENSION(3) :: ITDATE ! date array
-REAL,DIMENSION(1) :: ZTIME
+INTEGER(KIND=LFIINT) :: IRESP, ITOTAL
+INTEGER :: ILENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+LOGICAL :: GGOOD
+TYPE(TFIELDDATA) :: TZFIELD
+INTEGER, DIMENSION(3) :: ITDATE ! date array
+REAL,DIMENSION(1) :: ZTIME
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_read_lfi_T0',TRIM(TPFILE%CNAME)//': reading '//TRIM(TPFIELD%CMNHNAME))
!
@@ -610,9 +610,9 @@ ILENG=SIZE(ITDATE)
CALL IO_Field_read_check_lfi(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
!
IF (GGOOD) THEN
- TPDATA%TDATE%YEAR = IWORK(IWORK(2)+2+1)
- TPDATA%TDATE%MONTH = IWORK(IWORK(2)+2+2)
- TPDATA%TDATE%DAY = IWORK(IWORK(2)+2+3)
+ TPDATA%nyear = IWORK(IWORK(2)+2+1)
+ TPDATA%nmonth = IWORK(IWORK(2)+2+2)
+ TPDATA%nday = IWORK(IWORK(2)+2+3)
END IF
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
@@ -634,7 +634,7 @@ CALL IO_Field_read_check_lfi(TPFILE,TZFIELD,ILENG,IWORK,ITOTAL,IRESP,GGOOD)
IF (GGOOD) THEN
!TRANSFER_I8_R works with 1D arrays
ZTIME = TRANSFER_I8_R( (/ IWORK(IWORK(2)+3) /) )
- TPDATA%TIME = ZTIME(1)
+ TPDATA%xtime = ZTIME(1)
END IF
!
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
@@ -648,13 +648,13 @@ SUBROUTINE IO_Field_read_check_lfi(TPFILE,TPFIELD,KLENG,KWORK,KTOTAL,KRESP,OGOOD
!
USE MODD_PARAMETERS, ONLY: NGRIDUNKNOWN
!
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
-INTEGER, INTENT(IN) :: KLENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KWORK
-INTEGER(KIND=LFIINT), INTENT(OUT) :: KTOTAL
-INTEGER(KIND=LFIINT), INTENT(OUT) :: KRESP
-LOGICAL, INTENT(OUT) :: OGOOD
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
+INTEGER, INTENT(IN) :: KLENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KWORK
+INTEGER(KIND=LFIINT), INTENT(OUT) :: KTOTAL
+INTEGER(KIND=LFIINT), INTENT(OUT) :: KRESP
+LOGICAL, INTENT(OUT) :: OGOOD
!
INTEGER :: IERRLEVEL,IROW,J
INTEGER,DIMENSION(JPXKRK) :: ICOMMENT
@@ -788,12 +788,12 @@ END SUBROUTINE IO_Field_read_check_lfi
!
FUNCTION TRANSFER_I8_R(KFIELDIN) RESULT(PFIELDOUT)
!
-INTEGER(KIND=8),DIMENSION(:),INTENT(IN) :: KFIELDIN
+INTEGER(KIND=MNHINT64),DIMENSION(:),INTENT(IN) :: KFIELDIN
REAL,DIMENSION(SIZE(KFIELDIN)) :: PFIELDOUT
!
INTEGER :: ILENG
#if (MNH_REAL == 4)
-REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: ZFIELD8
+REAL(KIND=MNHREAL64),DIMENSION(:),ALLOCATABLE :: ZFIELD8
#endif
!
ILENG = SIZE(PFIELDOUT)
@@ -803,7 +803,7 @@ ILENG = SIZE(PFIELDOUT)
#else
ALLOCATE(ZFIELD8(ILENG))
ZFIELD8(:) = TRANSFER(KFIELDIN,ZFIELD8(1),ILENG)
- PFIELDOUT(:) = REAL(ZFIELD8(:),KIND=4)
+ PFIELDOUT(:) = REAL(ZFIELD8(:),KIND=MNHREAL32)
DEALLOCATE(ZFIELD8)
#endif
!
diff --git a/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90
index 75e142d20f6469336fb3ec89e106d833b43b13aa..a257e66b8cdd31e21396959c0d72217ae4a3a615 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_read_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_read_nc4.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.
@@ -14,13 +14,13 @@
! P. Wautelet 25/06/2019: added IO_Field_read for 3D integer arrays (IO_Field_read_nc4_N3)
! P. Wautelet 18/09/2019: correct support of 64bit integers (MNH_INT=8)
!-----------------------------------------------------------------
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
module mode_io_read_nc4
+use modd_field, only: tfielddata
use modd_io, only: tfiledata
use modd_precision, only: CDFINT
-use mode_field, only: tfielddata
use mode_io_tools_nc4, only: IO_Mnhname_clean, IO_Err_handle_nc4
use mode_msg
@@ -63,7 +63,7 @@ INTEGER :: IERRLEVEL
INTEGER :: IGRID
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: ILEN
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
CHARACTER(LEN=12) :: YVAL_FILE, YVAL_MEM
CHARACTER(LEN=:),ALLOCATABLE :: YVALUE
LOGICAL :: GOLDMNH !if old version of MesoNH (<5.4, old files without complete and correct metadata)
@@ -83,9 +83,9 @@ END IF
!
! GRID
!
-STATUS = NF90_GET_ATT(INCID,KVARID,'grid',IGRID)
-IF (STATUS /= NF90_NOERR) STATUS = NF90_GET_ATT(INCID,KVARID,'GRID',IGRID)
-IF (STATUS == NF90_NOERR) THEN
+istatus = NF90_GET_ATT(INCID,KVARID,'grid',IGRID)
+IF (istatus /= NF90_NOERR) istatus = NF90_GET_ATT(INCID,KVARID,'GRID',IGRID)
+IF (istatus == NF90_NOERR) THEN
IF (IGRID/=TPFIELD%NGRID) THEN
WRITE(YVAL_FILE,'(I12)') IGRID
WRITE(YVAL_MEM, '(I12)') TPFIELD%NGRID
@@ -112,10 +112,10 @@ ENDIF
!
! COMMENT
!
-STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'comment', LEN=ILEN)
-IF (STATUS == NF90_NOERR) THEN
+istatus = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'comment', LEN=ILEN)
+IF (istatus == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(INCID, KVARID, 'comment', YVALUE)
+ istatus = NF90_GET_ATT(INCID, KVARID, 'comment', YVALUE)
IF (LEN_TRIM(TPFIELD%CCOMMENT)==0 .AND. LEN_TRIM(YVALUE)>0) THEN
!Expected comment is empty, read comment is not
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
@@ -144,10 +144,10 @@ END IF
!
! STDNAME
!
-STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'standard_name', LEN=ILEN)
-IF (STATUS == NF90_NOERR) THEN
+istatus = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'standard_name', LEN=ILEN)
+IF (istatus == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(INCID, KVARID, 'standard_name', YVALUE)
+ istatus = NF90_GET_ATT(INCID, KVARID, 'standard_name', YVALUE)
IF (TRIM(YVALUE)/=TRIM(TPFIELD%CSTDNAME)) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected STDNAME ('//TRIM(TPFIELD%CSTDNAME)// &
@@ -171,10 +171,10 @@ END IF
!
! LONGNAME
!
-STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'long_name', LEN=ILEN)
-IF (STATUS == NF90_NOERR) THEN
+istatus = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'long_name', LEN=ILEN)
+IF (istatus == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(INCID, KVARID, 'long_name', YVALUE)
+ istatus = NF90_GET_ATT(INCID, KVARID, 'long_name', YVALUE)
IF (TRIM(YVALUE)/=TRIM(TPFIELD%CLONGNAME)) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected LONGNAME ('//TRIM(TPFIELD%CLONGNAME)// &
@@ -198,10 +198,10 @@ END IF
!
! UNITS
!
-STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'units', LEN=ILEN)
-IF (STATUS == NF90_NOERR) THEN
+istatus = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'units', LEN=ILEN)
+IF (istatus == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(INCID, KVARID, 'units', YVALUE)
+ istatus = NF90_GET_ATT(INCID, KVARID, 'units', YVALUE)
IF (TRIM(YVALUE)/=TRIM(TPFIELD%CUNITS)) THEN
IF(.NOT.PRESENT(HCALENDAR)) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
@@ -237,10 +237,10 @@ END IF
! CALENDAR
!
IF(PRESENT(HCALENDAR)) THEN
-STATUS = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'calendar', LEN=ILEN)
-IF (STATUS == NF90_NOERR) THEN
+istatus = NF90_INQUIRE_ATTRIBUTE(INCID, KVARID, 'calendar', LEN=ILEN)
+IF (istatus == NF90_NOERR) THEN
ALLOCATE(CHARACTER(LEN=ILEN) :: YVALUE)
- STATUS = NF90_GET_ATT(INCID, KVARID, 'calendar', YVALUE)
+ istatus = NF90_GET_ATT(INCID, KVARID, 'calendar', YVALUE)
IF (TRIM(YVALUE)/=TRIM(HCALENDAR)) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_attr_read_check_nc4',TRIM(TPFILE%CNAME)// &
': expected CALENDAR ('//TRIM(HCALENDAR)// &
@@ -265,7 +265,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
REAL, INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -282,22 +282,22 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
IF (IDIMS == 0 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
@@ -320,7 +320,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
REAL,DIMENSION(:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -339,27 +339,27 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X1','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X1','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
IF (IDIMS == 1 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X1','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X1','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF (IDIMLEN == SIZE(PFIELD)) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
@@ -387,7 +387,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
REAL,DIMENSION(:,:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -406,21 +406,21 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X2','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X2','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X2','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X2','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
!Treat special case of a degenerated 3D array (3rd dimension size is 1)
IF (IDIMS==3) THEN
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF (IDIMLEN(3)==1) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_read_nc4_X2',TRIM(TPFILE%CNAME)// &
': reading 3D array with degenerated third dimension in 2D array for '//TRIM(YVARNAME))
@@ -432,16 +432,16 @@ END IF
IF (IDIMS == 2 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF (IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2)) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X2','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X2','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
@@ -469,7 +469,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
REAL,DIMENSION(:,:,:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -488,31 +488,31 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X3','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X3','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X3','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X3','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
IF (IDIMS == 3 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF (IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. IDIMLEN(3) == SIZE(PFIELD,3)) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X3','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X3','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
@@ -540,7 +540,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
REAL,DIMENSION(:,:,:,:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -559,34 +559,34 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X4','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X4','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X4','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X4','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
IF (IDIMS == 4 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X4','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF ( IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. &
IDIMLEN(3) == SIZE(PFIELD,3) .AND. IDIMLEN(4) == SIZE(PFIELD,4)) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X4','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X4','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
@@ -614,7 +614,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
REAL,DIMENSION(:,:,:,:,:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -633,37 +633,37 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X5','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X5','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X5','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X5','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
IF (IDIMS == 5 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(5), LEN=IDIMLEN(5))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(5), LEN=IDIMLEN(5))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X5','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF ( IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. &
IDIMLEN(3) == SIZE(PFIELD,3) .AND. IDIMLEN(4) == SIZE(PFIELD,4) .AND. &
IDIMLEN(5) == SIZE(PFIELD,5) ) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X5','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X5','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
@@ -691,7 +691,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
REAL,DIMENSION(:,:,:,:,:,:),INTENT(INOUT) :: PFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -710,39 +710,39 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X6','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X6','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X6','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X6','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
IF (IDIMS == 6 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(5), LEN=IDIMLEN(5))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(6), LEN=IDIMLEN(6))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(4), LEN=IDIMLEN(4))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(5), LEN=IDIMLEN(5))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(6), LEN=IDIMLEN(6))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X6','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF ( IDIMLEN(1) == SIZE(PFIELD,1) .AND. IDIMLEN(2) == SIZE(PFIELD,2) .AND. &
IDIMLEN(3) == SIZE(PFIELD,3) .AND. IDIMLEN(4) == SIZE(PFIELD,4) .AND. &
IDIMLEN(5) == SIZE(PFIELD,5) .AND. IDIMLEN(6) == SIZE(PFIELD,6) ) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, PFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_X6','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_X6','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
@@ -770,7 +770,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
INTEGER, INTENT(INOUT) :: KFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -787,13 +787,13 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -801,9 +801,9 @@ IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
!Can read either 4 or 8 byte integers
IF (IDIMS == 0 .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT64) ) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, KFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, KFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
@@ -826,7 +826,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
INTEGER, DIMENSION(:), INTENT(INOUT) :: KFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -845,13 +845,13 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N1','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N1','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -859,14 +859,14 @@ IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
!NF90_INT1 is for the case a boolean was written
IF (IDIMS == 1 .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N1','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N1','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF (IDIMLEN == SIZE(KFIELD)) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, KFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, KFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
@@ -894,7 +894,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
INTEGER, DIMENSION(:,:), INTENT(INOUT) :: KFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -913,21 +913,21 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N2','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N2','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N2','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N2','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
!Treat special case of a degenerated 3D array (3rd dimension size is 1)
IF (IDIMS==3) THEN
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF (IDIMLEN(3)==1) THEN
CALL PRINT_MSG(NVERB_INFO,'IO','IO_Field_read_nc4_N2',TRIM(TPFILE%CNAME)// &
': reading 3D array with degenerated third dimension in 2D array for '//TRIM(YVARNAME))
@@ -940,16 +940,16 @@ END IF
!NF90_INT1 is for the case a boolean was written
IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N2','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF (IDIMLEN(1) == SIZE(KFIELD,1) .AND. IDIMLEN(2) == SIZE(KFIELD,2)) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, KFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N2','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, KFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N2','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
@@ -976,7 +976,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
INTEGER, DIMENSION(:,:,:), INTENT(INOUT) :: KFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -995,13 +995,13 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N3','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N3','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -1009,18 +1009,18 @@ IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
!NF90_INT1 is for the case a boolean was written
IF (IDIMS == SIZE(SHAPE(KFIELD)) .AND. (ITYPE == NF90_INT .OR. ITYPE == NF90_INT64 .OR. ITYPE == NF90_INT1) ) THEN
! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN(1))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(2), LEN=IDIMLEN(2))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(3), LEN=IDIMLEN(3))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N3','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF (IDIMLEN(1) == SIZE(KFIELD,1) .AND. IDIMLEN(2) == SIZE(KFIELD,2) .AND. IDIMLEN(3) == SIZE(KFIELD,3)) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, KFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_N3','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, KFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_N3','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
@@ -1047,7 +1047,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
LOGICAL, INTENT(INOUT) :: OFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -1065,13 +1065,13 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_L0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_L0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_L0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_L0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -1080,9 +1080,9 @@ IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
!Accept also INT and INT64 (for backward compatibility)
IF (IDIMS == 0 .AND. (ITYPE == NF90_INT1 .OR. ITYPE == NF90_INT .OR. ITYPE == NF90_INT64) ) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, IFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_L0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, IFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_L0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
@@ -1117,7 +1117,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
LOGICAL,DIMENSION(:),INTENT(INOUT) :: OFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -1138,13 +1138,13 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_L1','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_L1','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_L1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_L1','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
!Neglect the time dimension (of size 1)
IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
@@ -1153,14 +1153,14 @@ IF (TPFIELD%LTIMEDEP) IDIMS=IDIMS-1
!Accept also INT and INT64 (for backward compatibility)
IF (IDIMS == 1 .AND. (ITYPE == NF90_INT1 .OR. ITYPE == NF90_INT .OR. ITYPE == NF90_INT64) ) THEN
! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_L1','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_L1','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
IF (IDIMLEN == SIZE(OFIELD)) THEN
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, IFIELD)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_L1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, IFIELD)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_L1','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
@@ -1204,7 +1204,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
CHARACTER(LEN=*), INTENT(INOUT) :: HFIELD
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -1224,24 +1224,24 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_C0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_C0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_C0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS, DIMIDS=IVDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_C0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
IF (IDIMS == 1 .AND. (ITYPE == NF90_CHAR) ) THEN
! Check size of variable before reading
- STATUS = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_C0','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
+ istatus = NF90_INQUIRE_DIMENSION(INCID, IVDIMS(1), LEN=IDIMLEN)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_C0','NF90_INQUIRE_DIMENSION',TRIM(YVARNAME))
!
ALLOCATE(CHARACTER(LEN=IDIMLEN)::YSTR)
! Read variable
- STATUS = NF90_GET_VAR(INCID, IVARID, YSTR)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_C0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, YSTR)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_C0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
IF (LEN_TRIM(YSTR) > LEN(HFIELD)) &
@@ -1273,7 +1273,7 @@ TYPE(TFIELDDATA), INTENT(INOUT) :: TPFIELD
TYPE (DATE_TIME), INTENT(INOUT) :: TPDATA
INTEGER, INTENT(OUT) :: KRESP ! return-code
-INTEGER(KIND=CDFINT) :: STATUS
+INTEGER(KIND=CDFINT) :: istatus
INTEGER(KIND=CDFINT) :: INCID
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: ITYPE ! variable type
@@ -1292,30 +1292,30 @@ INCID = TPFILE%NNCID
CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
! Get variable ID, NDIMS and TYPE
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_T0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
+istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_T0','NF90_INQ_VARID',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
-STATUS = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
-IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_T0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
+istatus = NF90_INQUIRE_VARIABLE(INCID, IVARID, XTYPE=ITYPE, NDIMS=IDIMS)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_T0','NF90_INQUIRE_VARIABLE',TRIM(YVARNAME))
IF (IDIMS == 0 .AND. (ITYPE == NF90_FLOAT .OR. ITYPE == NF90_DOUBLE) ) THEN
! Read time
- STATUS = NF90_GET_VAR(INCID, IVARID, TPDATA%TIME)
- IF (STATUS /= NF90_NOERR) THEN
- CALL IO_Err_handle_nc4(status,'IO_Field_read_nc4_T0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
+ istatus = NF90_GET_VAR(INCID, IVARID, TPDATA%xtime)
+ IF (istatus /= NF90_NOERR) THEN
+ CALL IO_Err_handle_nc4(istatus,'IO_Field_read_nc4_T0','NF90_GET_VAR',TRIM(YVARNAME),IRESP)
GOTO 1000
END IF
! Read and check attributes of variable
CALL IO_Field_attr_read_check_nc4(TPFILE,TPFIELD,IVARID,IRESP,HCALENDAR='standard')
! Extract date from UNITS
IDX = INDEX(TPFIELD%CUNITS,'since ')
- READ(TPFIELD%CUNITS(IDX+6 :IDX+9), '( I4.4 )') TPDATA%TDATE%YEAR
- READ(TPFIELD%CUNITS(IDX+11:IDX+12),'( I2.2 )') TPDATA%TDATE%MONTH
- READ(TPFIELD%CUNITS(IDX+14:IDX+15),'( I2.2 )') TPDATA%TDATE%DAY
+ READ(TPFIELD%CUNITS(IDX+6 :IDX+9), '( I4.4 )') TPDATA%nyear
+ READ(TPFIELD%CUNITS(IDX+11:IDX+12),'( I2.2 )') TPDATA%nmonth
+ READ(TPFIELD%CUNITS(IDX+14:IDX+15),'( I2.2 )') TPDATA%nday
! Simple check (should catch most errors)
- IF ( TPDATA%TDATE%DAY<1 .OR. TPDATA%TDATE%DAY>31 .OR. TPDATA%TDATE%MONTH<1 .OR. TPDATA%TDATE%MONTH>12 ) THEN
+ IF ( TPDATA%nday<1 .OR. TPDATA%nday>31 .OR. TPDATA%nmonth<1 .OR. TPDATA%nmonth>12 ) THEN
CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_read_nc4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)// &
' read date is invalid')
IRESP = -3
diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools.f90
index fb0eb161c7c708bd1df9dd04fe59bafb88b61eb7..42236655f7c00e3db69c6574f122cc343db0ff7e 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_tools.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_tools.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -7,7 +7,7 @@
! P. Wautelet 13/12/2018: extracted from mode_io.f90
! P. Wautelet 14/12/2018: added IO_Filename_construct
! P. Wautelet 05/03/2019: rename IO subroutines and modules
-! P. Wautelet 05/09/2019: io_get_mnhversion: Z-split files: to prevent serialization between files,
+! P. Wautelet 05/09/2019: IO_Mnhversion_get: Z-split files: to prevent serialization between files,
! nmnhversion is taken from the main file
!-----------------------------------------------------------------
module mode_io_tools
@@ -103,7 +103,8 @@ contains
subroutine IO_Mnhversion_get(tpfile)
!Compare MNHVERSION of file with current version and store it in file metadata
use modd_conf, only: nmnhversion
- use mode_field, only: tfielddata,typeint
+ use modd_field, only: tfielddata, TYPEINT
+
use mode_io_field_read, only: IO_Field_read
type(tfiledata), intent(inout) :: tpfile
@@ -166,24 +167,24 @@ subroutine IO_Mnhversion_get(tpfile)
if ( imnhversion(1)==0 .and. imnhversion(2)==0 .and. imnhversion(3)==0 ) then
call print_msg(NVERB_WARNING,'IO','IO_Mnhversion_get','file '//trim(tpfile%cname)//&
' was written with an unknown version of MesoNH')
- else if ( imnhversion(1)< nmnhversion(1) .or. &
+ else if ( imnhversion(1)< nmnhversion(1) .or. &
(imnhversion(1)==nmnhversion(1) .and. imnhversion(2)< nmnhversion(2)) .or. &
(imnhversion(1)==nmnhversion(1) .and. imnhversion(2)==nmnhversion(2) .and. imnhversion(3)<nmnhversion(3)) ) then
call print_msg(NVERB_WARNING,'IO','IO_Mnhversion_get','file '//trim(tpfile%cname)//&
' was written with an older version of MesoNH ('//trim(ymnhversion_file)//&
' instead of '//trim(ymnhversion_curr)//')')
- else if ( imnhversion(1)> nmnhversion(1) .or. &
- (imnhversion(1)==nmnhversion(1) .and. imnhversion(2)> nmnhversion(2)) .or. &
- (imnhversion(1)==nmnhversion(1) .and. imnhversion(2)==nmnhversion(2) .and. imnhversion(3)>nmnhversion(3)) ) then
- call print_msg(NVERB_WARNING,'IO','IO_Mnhversion_get','file '//trim(tpfile%cname)//&
- ' was written with a more recent version of MesoNH ('//trim(ymnhversion_file)//&
- ' instead of '//trim(ymnhversion_curr)//')')
- else
- call print_msg(NVERB_DEBUG,'IO','IO_Mnhversion_get','file '//trim(tpfile%cname)//&
+ else if ( imnhversion(1)> nmnhversion(1) .or. &
+ (imnhversion(1)==nmnhversion(1) .and. imnhversion(2)> nmnhversion(2)) .or. &
+ (imnhversion(1)==nmnhversion(1) .and. imnhversion(2)==nmnhversion(2) .and. imnhversion(3)>nmnhversion(3)) ) then
+ call print_msg(NVERB_WARNING,'IO','IO_Mnhversion_get','file '//trim(tpfile%cname)//&
+ ' was written with a more recent version of MesoNH ('//trim(ymnhversion_file)//&
+ ' instead of '//trim(ymnhversion_curr)//')')
+ else
+ call print_msg(NVERB_DEBUG,'IO','IO_Mnhversion_get','file '//trim(tpfile%cname)//&
' was written with the same version of MesoNH ('//trim(ymnhversion_curr)//')')
- end if
- !
- tpfile%nmnhversion(:) = imnhversion(:)
+ end if
+ !
+ tpfile%nmnhversion(:) = imnhversion(:)
else ! associated( tpfile%tmainfile )
if ( .not. tpfile%tmainfile%lopened ) &
call Print_msg( NVERB_FATAL, 'IO', 'IO_Mnhversion_get', 'tmainfile should be opened' )
diff --git a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
index 2be340eafd509639e7f2385f1c2f05f543e666ab..477c389dbf6ffe6691029ff11a627e431b2e0a84 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_tools_nc4.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,15 +11,23 @@
! P. Wautelet 10/01/2019: replace handle_err by IO_Err_handle_nc4 for better netCDF error messages
! P. Wautelet 05/03/2019: rename IO subroutines and modules
! P. Wautelet 18/09/2019: correct support of 64bit integers (MNH_INT=8)
+! P. Wautelet 14/09/2020: IO_Knowndims_set_nc4: add new dimensions + remove 'time' dimension in diachronic files
+! P. Wautelet 14/09/2020: IO_Vdims_fill_nc4: use ndimlist when provided to fill dimensions ids
+! P. Wautelet 10/11/2020: new data structures for netCDF dimensions
+! 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
!-----------------------------------------------------------------
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
module mode_io_tools_nc4
+use modd_field, only: tfielddata
use modd_io, only: tfiledata
-use modd_netcdf, only: dimcdf, iocdf, tdim_dummy
+use modd_netcdf, only: tdimnc, tdimsnc
use modd_precision, only: CDFINT
-use mode_field, only: tfielddata
use mode_msg
use NETCDF, only: NF90_NOERR, NF90_UNLIMITED, &
@@ -31,59 +39,62 @@ private
public :: IO_Dim_find_byname_nc4, IO_Dimids_guess_nc4, IO_Knowndims_set_nc4
public :: IO_Iocdf_alloc_nc4, IO_Iocdf_dealloc_nc4, IO_Mnhname_clean
-public :: IO_Dimcdf_get_nc4, IO_Strdimid_get_nc4, IO_Vdims_fill_nc4, IO_Err_handle_nc4
+public :: IO_Dim_find_create_nc4, IO_Strdimid_get_nc4, IO_Vdims_fill_nc4, IO_Err_handle_nc4
contains
-SUBROUTINE IO_Dim_find_byname_nc4(TPFILE, HDIMNAME, TPDIM, KRESP)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-CHARACTER(LEN=*), INTENT(IN) :: HDIMNAME
-TYPE(DIMCDF), INTENT(OUT) :: TPDIM
-INTEGER, INTENT(OUT) :: KRESP
-!
-TYPE(DIMCDF), POINTER :: TMP
-!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dim_find_byname_nc4','called for dimension name '//TRIM(HDIMNAME))
-!
-KRESP = -2
-!
-IF(.NOT.ASSOCIATED(TPFILE%TNCDIMS%DIMLIST)) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dim_find_byname_nc4','DIMLIST not associated for file '//TRIM(TPFILE%CNAME))
- KRESP = -1
- RETURN
-END IF
-!
-TMP => TPFILE%TNCDIMS%DIMLIST
-!
-DO WHILE(ASSOCIATED(TMP))
- IF (TRIM(TMP%NAME)==TRIM(HDIMNAME)) THEN
- TPDIM = TMP
- KRESP = 0
- EXIT
- END IF
- TMP => TMP%NEXT
-END DO
-!
-END SUBROUTINE IO_Dim_find_byname_nc4
+subroutine IO_Dim_find_byname_nc4( tpfile, hdimname, tpdim, kresp )
+type(tfiledata), intent(in) :: tpfile
+character(len=*), intent(in) :: hdimname
+type(tdimnc), intent(out) :: tpdim
+integer, intent(out) :: kresp
+
+integer :: ji
+
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_Dim_find_byname_nc4', 'called for dimension name ' // Trim( hdimname ) )
+
+kresp = -2
+
+if ( .not.Associated( tpfile%tncdims ) ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_find_byname_nc4', 'tncdims not associated for file '//trim(tpfile%cname) )
+ kresp = -3
+ return
+end if
+
+if ( .not.Allocated( tpfile%tncdims%tdims ) ) then
+ call Print_msg( NVERB_WARNING, 'IO', 'IO_Dim_find_byname_nc4', 'tdims not allocated for file '//trim(tpfile%cname) )
+ kresp = -1
+ return
+end if
+
+do ji = 1, tpfile%tncdims%nmaxdims
+ if ( Trim( hdimname ) == Trim( tpfile%tncdims%tdims(ji)%cname ) ) then
+ tpdim = tpfile%tncdims%tdims(ji)
+ kresp = 0
+ exit
+ end if
+end do
+
+end subroutine IO_Dim_find_byname_nc4
SUBROUTINE IO_Dimids_guess_nc4(TPFILE, TPFIELD, KLEN, TPDIMS, KRESP)
!
-USE MODE_FIELD, ONLY: TYPECHAR
+USE MODD_FIELD, ONLY: NMNHDIM_ARAKAWA, TYPECHAR
!
!Used by LFI2CDF
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
INTEGER, INTENT(IN) :: KLEN
-TYPE(DIMCDF),DIMENSION(:), INTENT(OUT) :: TPDIMS
+TYPE(tdimnc),DIMENSION(:), INTENT(OUT) :: TPDIMS
INTEGER, INTENT(OUT) :: KRESP
!
INTEGER :: IGRID
+integer :: iidx
INTEGER(kind=CDFINT) :: ILEN, ISIZE
INTEGER :: JI
CHARACTER(LEN=32) :: YINT
CHARACTER(LEN=2) :: YDIR
-TYPE(DIMCDF), POINTER :: PTDIM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dimids_guess_nc4','called for '//TRIM(TPFIELD%CMNHNAME))
!
@@ -92,7 +103,6 @@ YDIR = TPFIELD%CDIR
!
KRESP = 0
ILEN = 0
-PTDIM => NULL()
!
IF(IGRID<0 .OR. IGRID>8) THEN
WRITE(YINT,'( I0 )') IGRID
@@ -113,9 +123,9 @@ IF (IGRID==0) THEN
ILEN = 1
END IF
CASE (1)
- PTDIM => IO_Dimcdf_get_nc4(TPFILE, int( KLEN, kind=CDFINT ) )
- TPDIMS(1) = PTDIM
- ILEN = PTDIM%LEN
+ call IO_Dim_find_create_nc4( tpfile, Int( klen, kind = CDFINT ), iidx )
+ tpdims(1) = tpfile%tncdims%tdims(iidx)
+ ilen = tpdims(1)%nlen
CASE DEFAULT
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4','NGRID=0 and NDIMS>1 not yet supported (field '&
//TRIM(TPFIELD%CMNHNAME)//')')
@@ -127,29 +137,25 @@ ELSE IF (TPFIELD%CLBTYPE/='NONE') THEN
END IF
!
IF (TPFIELD%CLBTYPE=='LBX' .OR. TPFIELD%CLBTYPE=='LBXU') THEN
- PTDIM => TPFILE%TNCCOORDS(2,IGRID)%TDIM
- TPDIMS(2) = PTDIM
- PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
- TPDIMS(3) = PTDIM
- ILEN = TPDIMS(2)%LEN * TPDIMS(3)%LEN
+ tpdims(2) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,2) )
+ tpdims(3) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,3) )
+ ilen = tpdims(2)%nlen * tpdims(3)%nlen
ISIZE = KLEN/ILEN
IF (MOD(KLEN,ILEN)/=0) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4', &
'can not guess 1st dimension for field '//TRIM(TPFIELD%CMNHNAME))
- PTDIM => IO_Dimcdf_get_nc4(TPFILE, ISIZE)
- TPDIMS(1) = PTDIM
- ILEN = ILEN * PTDIM%LEN
+ call IO_Dim_find_create_nc4( tpfile, isize, iidx )
+ tpdims(1) = tpfile%tncdims%tdims(iidx)
+ ilen = ilen * tpdims(1)%nlen
ELSE IF (TPFIELD%CLBTYPE=='LBY' .OR. TPFIELD%CLBTYPE=='LBYV') THEN
- PTDIM => TPFILE%TNCCOORDS(1,IGRID)%TDIM
- TPDIMS(1) = PTDIM
- PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
- TPDIMS(3) = PTDIM
- ILEN = TPDIMS(1)%LEN * TPDIMS(3)%LEN
+ tpdims(1) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,1) )
+ tpdims(3) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,3) )
+ ilen = tpdims(1)%nlen * tpdims(3)%nlen
ISIZE = KLEN/ILEN
IF (MOD(KLEN,ILEN)/=0) CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4', &
'can not guess 2nd dimension for field '//TRIM(TPFIELD%CMNHNAME))
- PTDIM => IO_Dimcdf_get_nc4(TPFILE, ISIZE)
- TPDIMS(2) = PTDIM
- ILEN = ILEN * PTDIM%LEN
+ call IO_Dim_find_create_nc4( tpfile, isize, iidx )
+ tpdims(2) = tpfile%tncdims%tdims(iidx)
+ ilen = ilen * tpdims(2)%nlen
ELSE
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4','invalid CLBTYPE ('//TPFIELD%CLBTYPE//') for field '&
//TRIM(TPFIELD%CMNHNAME))
@@ -160,19 +166,19 @@ ELSE
DO JI=1,TPFIELD%NDIMS
IF (JI == 1) THEN
IF ( (YDIR == 'XX' .OR. YDIR == 'XY') ) THEN
- PTDIM => TPFILE%TNCCOORDS(1,IGRID)%TDIM
+ tpdims(1) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,1) )
ELSE IF ( YDIR == 'YY' ) THEN
- PTDIM => TPFILE%TNCCOORDS(2,IGRID)%TDIM
+ tpdims(1) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,2) )
ELSE IF ( YDIR == 'ZZ' ) THEN
- PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
+ tpdims(1) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,3) )
ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
- PTDIM => IO_Dimcdf_get_nc4(TPFILE, int( KLEN, kind=CDFINT ) )
+ call IO_Dim_find_create_nc4( tpfile, Int( klen, kind = CDFINT ), iidx )
+ tpdims(1) = tpfile%tncdims%tdims(iidx)
END IF
- ILEN = PTDIM%LEN
- TPDIMS(JI) = PTDIM
+ ilen = tpdims(1)%nlen
ELSE IF (JI == 2) THEN
IF ( YDIR == 'XY') THEN
- PTDIM => TPFILE%TNCCOORDS(2,IGRID)%TDIM
+ tpdims(2) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,2) )
ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
ISIZE = KLEN/ILEN
IF (MOD(KLEN,ILEN)/=0) THEN
@@ -180,21 +186,22 @@ ELSE
'can not guess 2nd and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
EXIT
END IF
- PTDIM => IO_Dimcdf_get_nc4(TPFILE, ISIZE)
+ call IO_Dim_find_create_nc4( tpfile, isize, iidx )
+ tpdims(2) = tpfile%tncdims%tdims(iidx)
ELSE
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4','can not guess 2nd dimension for field '//TRIM(TPFIELD%CMNHNAME))
EXIT
END IF
- ILEN = ILEN * PTDIM%LEN
- TPDIMS(JI) = PTDIM
+ ilen = ilen * tpdims(2)%nlen
ELSE IF (JI == 3) THEN
IF ( YDIR == 'XY' ) THEN
IF (JI==TPFIELD%NDIMS .AND. KLEN/ILEN==1 .AND. MOD(KLEN,ILEN)==0) THEN
!The last dimension is of size 1 => probably time dimension
ISIZE = 1
- PTDIM => IO_Dimcdf_get_nc4(TPFILE,ISIZE)
+ call IO_Dim_find_create_nc4( tpfile, isize, iidx )
+ tpdims(3) = tpfile%tncdims%tdims(iidx)
ELSE
- PTDIM => TPFILE%TNCCOORDS(3,IGRID)%TDIM
+ tpdims(3) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,3) )
END IF
ELSE IF (JI==TPFIELD%NDIMS) THEN !Guess last dimension
ISIZE = KLEN/ILEN
@@ -203,13 +210,13 @@ ELSE
'can not guess 3rd and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
EXIT
END IF
- PTDIM => IO_Dimcdf_get_nc4(TPFILE, ISIZE)
+ call IO_Dim_find_create_nc4( tpfile, isize, iidx )
+ tpdims(3) = tpfile%tncdims%tdims(iidx)
ELSE
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4','can not guess 3rd dimension for field '//TRIM(TPFIELD%CMNHNAME))
EXIT
END IF
- ILEN = ILEN * PTDIM%LEN
- TPDIMS(JI) = PTDIM
+ ilen = ilen * tpdims(3)%nlen
ELSE IF (JI==4 .AND. JI==TPFIELD%NDIMS) THEN !Guess last dimension
ISIZE = KLEN/ILEN
IF (MOD(KLEN,ILEN)/=0) THEN
@@ -217,9 +224,9 @@ ELSE
'can not guess 4th and last dimension for field '//TRIM(TPFIELD%CMNHNAME))
EXIT
END IF
- PTDIM => IO_Dimcdf_get_nc4(TPFILE, ISIZE)
- ILEN = ILEN * PTDIM%LEN
- TPDIMS(JI) = PTDIM
+ call IO_Dim_find_create_nc4( tpfile, isize, iidx )
+ tpdims(4) = tpfile%tncdims%tdims(iidx)
+ ilen = ilen * tpdims(4)%nlen
ELSE
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Dimids_guess_nc4','can not guess dimension above 4 for field '&
//TRIM(TPFIELD%CMNHNAME))
@@ -238,22 +245,50 @@ END SUBROUTINE IO_Dimids_guess_nc4
SUBROUTINE IO_Knowndims_set_nc4(TPFILE,HPROGRAM_ORIG)
-USE MODD_CONF, ONLY: CPROGRAM
+use modd_budget, only: cbutype, lbu_icp, lbu_jcp, lbu_kcp, nbuimax_ll, nbujmax_ll, nbukmax, nbumask, nbutotwrite
+use modd_lbc_n, only: clbcx, clbcy
+USE MODD_CONF, ONLY: CPROGRAM, l2d, lpack
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_DIM_n, ONLY: NIMAX_ll, NJMAX_ll, NKMAX
+use modd_dyn, only: xseglen
+use modd_dyn_n, only: xtstep
+use modd_field, only: NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NI_U, NMNHDIM_NJ_U, NMNHDIM_NI_V, NMNHDIM_NJ_V, &
+ NMNHDIM_LEVEL, NMNHDIM_LEVEL_W, NMNHDIM_TIME, &
+ NMNHDIM_ONE, NMNHDIM_COMPLEX, &
+ 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, &
+ NMNHDIM_BUDGET_MASK_LEVEL, NMNHDIM_BUDGET_MASK_LEVEL_W, &
+ NMNHDIM_BUDGET_MASK_NBUMASK, NMNHDIM_BUDGET_TIME, &
+ NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_LES_AVG_TIME, NMNHDIM_BUDGET_LES_LEVEL, &
+ NMNHDIM_BUDGET_LES_SV, NMNHDIM_BUDGET_LES_PDF, &
+ NMNHDIM_SPECTRA_2PTS_NI, NMNHDIM_SPECTRA_2PTS_NJ, &
+ NMNHDIM_SPECTRA_SPEC_NI, NMNHDIM_SPECTRA_SPEC_NJ, NMNHDIM_SPECTRA_LEVEL, &
+ NMNHDIM_SERIES_LEVEL, NMNHDIM_SERIES_LEVEL_W, &
+ NMNHDIM_SERIES_TIME, NMNHDIM_PROFILER_TIME, NMNHDIM_STATION_TIME, &
+ NMNHDIM_PAIR, &
+ NMNHDIM_ARAKAWA, &
+ NMNHDIM_LASTDIM_NODIACHRO, NMNHDIM_LASTDIM_DIACHRO
+
+use modd_les, only: lles_pdf, nles_k, npdf, nspectra_k, xles_temp_mean_start, xles_temp_mean_step, xles_temp_mean_end
+use modd_les_n, only: nles_times, nspectra_ni, nspectra_nj
+use modd_nsv, only: nsv
USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
+use modd_profiler_n, only: numbprofiler, tprofiler
+use modd_series, only: lseries
+use modd_series_n, only: nsnbstept
+use modd_station_n, only: numbstat, tstation
TYPE(TFILEDATA),INTENT(INOUT) :: TPFILE
CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
CHARACTER(LEN=:),ALLOCATABLE :: YPROGRAM
+integer :: iavg, iprof, istation
+integer :: ispectra_ni, ispectra_nj
INTEGER :: IIU_ll, IJU_ll, IKU
-TYPE(IOCDF), POINTER :: PIOCDF
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Knowndims_set_nc4','called for '//TRIM(TPFILE%CNAME))
-PIOCDF => TPFILE%TNCDIMS
-
IF (PRESENT(HPROGRAM_ORIG)) THEN
YPROGRAM = HPROGRAM_ORIG
ELSE
@@ -264,116 +299,241 @@ IIU_ll = NIMAX_ll + 2*JPHEXT
IJU_ll = NJMAX_ll + 2*JPHEXT
IKU = NKMAX + 2*JPVEXT
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI)) PIOCDF%DIM_NI => IO_Dimcdf_get_nc4(TPFILE, int( IIU_ll, kind=CDFINT ), 'ni')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ)) PIOCDF%DIM_NJ => IO_Dimcdf_get_nc4(TPFILE, int( IJU_ll, kind=CDFINT ), 'nj')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI_U)) PIOCDF%DIM_NI_U => IO_Dimcdf_get_nc4(TPFILE, int( IIU_ll, kind=CDFINT ), 'ni_u')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ_U)) PIOCDF%DIM_NJ_U => IO_Dimcdf_get_nc4(TPFILE, int( IJU_ll, kind=CDFINT ), 'nj_u')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NI_V)) PIOCDF%DIM_NI_V => IO_Dimcdf_get_nc4(TPFILE, int( IIU_ll, kind=CDFINT ), 'ni_v')
-IF (.NOT. ASSOCIATED(PIOCDF%DIM_NJ_V)) PIOCDF%DIM_NJ_V => IO_Dimcdf_get_nc4(TPFILE, int( IJU_ll, kind=CDFINT ), 'nj_v')
-IF (TRIM(YPROGRAM)/='PGD' .AND. TRIM(YPROGRAM)/='NESPGD' .AND. TRIM(YPROGRAM)/='ZOOMPG' &
- .AND. .NOT.(TRIM(YPROGRAM)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
- IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL)) PIOCDF%DIM_LEVEL => IO_Dimcdf_get_nc4(TPFILE, int( IKU, kind=CDFINT ), 'level')
- IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL_W)) PIOCDF%DIM_LEVEL_W => IO_Dimcdf_get_nc4(TPFILE, int( IKU, kind=CDFINT ), 'level_w')
- IF (.NOT. ASSOCIATED(PIOCDF%DIMTIME)) PIOCDF%DIMTIME => IO_Dimcdf_get_nc4(TPFILE, NF90_UNLIMITED, 'time')
-ELSE
- !PGD and SURFEX files for MesoNH have no vertical levels or time scale
- !These dimensions are allocated to default values
- !(they need to be allocated when looking for dimensions of variables)
- IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL)) ALLOCATE(PIOCDF%DIM_LEVEL)
- IF (.NOT. ASSOCIATED(PIOCDF%DIM_LEVEL_W)) ALLOCATE(PIOCDF%DIM_LEVEL_W)
- IF (.NOT. ASSOCIATED(PIOCDF%DIMTIME)) ALLOCATE(PIOCDF%DIMTIME)
-END IF
+if ( .not.Associated( tpfile%tncdims ) ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Knowndims_set_nc4', 'tncdims not associated for ' // Trim( tpfile%cname ) )
+ Allocate( tpfile%tncdims )
+end if
+
+if ( Allocated( tpfile%tncdims%tdims ) ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Knowndims_set_nc4', 'tdims already allocated for ' // Trim( tpfile%cname ) )
+ Deallocate( tpfile%tncdims%tdims )
+end if
-!Store X,Y,Z coordinates for the Arakawa points
-!0 2nd-dimension is to treat NGRID=0 case without crash
-IF (.NOT.ALLOCATED(TPFILE%TNCCOORDS)) ALLOCATE(TPFILE%TNCCOORDS(3,0:8))
-!Dummy point
-TPFILE%TNCCOORDS(1,0)%TDIM => TDIM_DUMMY
-TPFILE%TNCCOORDS(2,0)%TDIM => TDIM_DUMMY
-TPFILE%TNCCOORDS(3,0)%TDIM => TDIM_DUMMY
-! Mass point
-TPFILE%TNCCOORDS(1,1)%TDIM => PIOCDF%DIM_NI
-TPFILE%TNCCOORDS(2,1)%TDIM => PIOCDF%DIM_NJ
-TPFILE%TNCCOORDS(3,1)%TDIM => PIOCDF%DIM_LEVEL
-! u point
-TPFILE%TNCCOORDS(1,2)%TDIM => PIOCDF%DIM_NI_U
-TPFILE%TNCCOORDS(2,2)%TDIM => PIOCDF%DIM_NJ_U
-TPFILE%TNCCOORDS(3,2)%TDIM => PIOCDF%DIM_LEVEL
-! v point
-TPFILE%TNCCOORDS(1,3)%TDIM => PIOCDF%DIM_NI_V
-TPFILE%TNCCOORDS(2,3)%TDIM => PIOCDF%DIM_NJ_V
-TPFILE%TNCCOORDS(3,3)%TDIM => PIOCDF%DIM_LEVEL
-! w point
-TPFILE%TNCCOORDS(1,4)%TDIM => PIOCDF%DIM_NI
-TPFILE%TNCCOORDS(2,4)%TDIM => PIOCDF%DIM_NJ
-TPFILE%TNCCOORDS(3,4)%TDIM => PIOCDF%DIM_LEVEL_W
-! xi vorticity point (=f point =uv point)
-TPFILE%TNCCOORDS(1,5)%TDIM => PIOCDF%DIM_NI_U
-TPFILE%TNCCOORDS(2,5)%TDIM => PIOCDF%DIM_NJ_V
-TPFILE%TNCCOORDS(3,5)%TDIM => PIOCDF%DIM_LEVEL
-! eta vorticity point (=uw point)
-TPFILE%TNCCOORDS(1,6)%TDIM => PIOCDF%DIM_NI_U
-TPFILE%TNCCOORDS(2,6)%TDIM => PIOCDF%DIM_NJ_U
-TPFILE%TNCCOORDS(3,6)%TDIM => PIOCDF%DIM_LEVEL_W
-! zeta vorticity point (=vw point)
-TPFILE%TNCCOORDS(1,7)%TDIM => PIOCDF%DIM_NI_V
-TPFILE%TNCCOORDS(2,7)%TDIM => PIOCDF%DIM_NJ_V
-TPFILE%TNCCOORDS(3,7)%TDIM => PIOCDF%DIM_LEVEL_W
-! fw point (=uvw point)
-TPFILE%TNCCOORDS(1,8)%TDIM => PIOCDF%DIM_NI_U
-TPFILE%TNCCOORDS(2,8)%TDIM => PIOCDF%DIM_NJ_V
-TPFILE%TNCCOORDS(3,8)%TDIM => PIOCDF%DIM_LEVEL_W
+if ( tpfile%ctype /= 'MNHDIACHRONIC' ) then
+ tpfile%tncdims%nmaxdims = NMNHDIM_LASTDIM_NODIACHRO
+ Allocate( tpfile%tncdims%tdims(NMNHDIM_LASTDIM_NODIACHRO) )
+else
+ tpfile%tncdims%nmaxdims = NMNHDIM_LASTDIM_DIACHRO
+ Allocate( tpfile%tncdims%tdims(NMNHDIM_LASTDIM_DIACHRO) )
+end if
+call IO_Add_dim_nc4( tpfile, NMNHDIM_NI, 'ni', IIU_ll )
+call IO_Add_dim_nc4( tpfile, NMNHDIM_NJ, 'nj', IJU_ll )
+call IO_Add_dim_nc4( tpfile, NMNHDIM_NI_U, 'ni_u', IIU_ll )
+call IO_Add_dim_nc4( tpfile, NMNHDIM_NJ_U, 'nj_u', IJU_ll )
+call IO_Add_dim_nc4( tpfile, NMNHDIM_NI_V, 'ni_v', IIU_ll )
+call IO_Add_dim_nc4( tpfile, NMNHDIM_NJ_V, 'nj_v', IJU_ll )
+if ( Trim( yprogram ) /= 'PGD' .and. Trim( yprogram ) /= 'NESPGD' .and. Trim( yprogram ) /= 'ZOOMPG' &
+ .and. .not. ( Trim( yprogram ) == 'REAL' .and. cstorage_type == 'SU' ) ) then !condition to detect PREP_SURFEX
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_LEVEL, 'level', IKU )
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_LEVEL_W, 'level_w', IKU )
+ if ( tpfile%ctype /= 'MNHDIACHRONIC' ) &
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_TIME, 'time', Int( NF90_UNLIMITED, kind = Kind(1) ) )
+end if
+
+if ( tpfile%ctype == 'MNHDIACHRONIC' .or. ( lpack .and. l2d ) ) then
+ !Dimension of size 1 used for NMNHDIM_ONE
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_ONE, 'one', 1 )
+end if
+
+!Write dimensions used in diachronic files
+if ( tpfile%ctype == 'MNHDIACHRONIC' ) then
+ !Dimension of size 2 used for NMNHDIM_COMPLEX
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_COMPLEX, 'real_imaginary', 2 )
+
+ !Dimension pair is used ie for boundaries of time intervals
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_PAIR, 'pair', 2 )
+
+ !Dimensions for the budgets masks
+ if ( cbutype == 'CART' .or. cbutype == 'SKIP' ) then
+ if ( .not. lbu_icp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NI, 'cart_ni', nbuimax_ll )
+ if ( .not. lbu_jcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NJ, 'cart_nj', nbujmax_ll )
+ if ( .not. lbu_icp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NI_U, 'cart_ni_u', nbuimax_ll )
+ if ( .not. lbu_jcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NJ_U, 'cart_nj_u', nbujmax_ll )
+ if ( .not. lbu_icp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NI_V, 'cart_ni_v', nbuimax_ll )
+ if ( .not. lbu_jcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_NJ_V, 'cart_nj_v', nbujmax_ll )
+ if ( .not. lbu_kcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_LEVEL, 'cart_level', nbukmax )
+ if ( .not. lbu_kcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_CART_LEVEL_W, 'cart_level_w', nbukmax )
+ if ( nbutotwrite > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_TIME, 'time_budget', nbutotwrite )
+ else if ( cbutype == 'MASK' ) then
+ if ( .not. lbu_kcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_MASK_LEVEL, 'mask_level', nbukmax )
+ if ( .not. lbu_kcp ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_MASK_LEVEL_W, 'mask_level_w', nbukmax )
+ if ( nbutotwrite > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_TIME, 'time_budget', nbutotwrite )
+ if ( nbumask > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_MASK_NBUMASK, 'nbumask', nbumask )
+ end if
+
+ !Dimension for the number of LES budget time samplings
+ if ( nles_times > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_LES_TIME, 'time_les', nles_times )
+
+ !Dimension for the number of LES budget time averages
+ iavg = int( xles_temp_mean_end - 1.e-10 - xles_temp_mean_start ) / xles_temp_mean_step + 1
+ !Condition also on nles_times to not create this dimension when not used (no time average if nles_times=0)
+ if ( nles_times > 0 .and. iavg > 0 ) &
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_LES_AVG_TIME, 'time_les_avg', iavg )
+
+ !Dimension for the number of vertical levels for local LES budgets
+ if ( nles_k > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_LES_LEVEL, 'level_les', nles_k )
+
+ !Dimension for the number of scalar variables
+ if ( nsv > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_LES_SV, 'nsv', nsv )
+
+ !Dimension for the number of PDF
+ if ( lles_pdf ) call IO_Add_dim_nc4( tpfile, NMNHDIM_BUDGET_LES_PDF, 'npdf', npdf )
+
+ !Dimensions for the number of horizontal wavelengths for non-local LES budgets (2 points correlations)
+ if ( nspectra_ni > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_SPECTRA_2PTS_NI, 'nspectra_2pts_ni', nspectra_ni )
+ if ( nspectra_nj > 0 .and. .not. l2d ) &
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_SPECTRA_2PTS_NJ, 'nspectra_2pts_nj', nspectra_nj )
+
+ !Dimensions for the number of horizontal wavelengths for LES spectra budgets
+ if ( nspectra_ni > 0 ) then
+ if ( clbcx(1) == 'CYCL' ) then
+ ispectra_ni = ( nspectra_ni + 1 ) / 2 - 1
+ else
+ ispectra_ni = nspectra_ni - 1
+ end if
+ if ( ispectra_ni == 0 ) call Print_msg( NVERB_WARNING, 'IO', 'IO_Knowndims_set_nc4', &
+ 'nspectra_spec_ni dimension is zero sized for ' // Trim( tpfile%cname ) )
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_SPECTRA_SPEC_NI, 'nspectra_spec_ni', ispectra_ni )
+ end if
+
+ if ( nspectra_nj > 0 .and. .not. l2d ) then
+ if ( clbcy(1) == 'CYCL' ) then
+ ispectra_nj = ( nspectra_nj + 1 ) / 2 - 1
+ else
+ ispectra_nj = nspectra_nj - 1
+ end if
+ if ( ispectra_nj == 0 ) call Print_msg( NVERB_WARNING, 'IO', 'IO_Knowndims_set_nc4', &
+ 'nspectra_spec_nj dimension is zero sized for ' // Trim( tpfile%cname ) )
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_SPECTRA_SPEC_NJ, 'nspectra_spec_nj', ispectra_nj )
+ end if
+
+ !Dimension for the number of vertical levels for non-local LES budgets
+ if ( nspectra_k > 0 ) call IO_Add_dim_nc4( tpfile, NMNHDIM_SPECTRA_LEVEL, 'nspectra_level', nspectra_k )
+
+ !Dimension for the number of profiler times
+ if ( numbprofiler > 0 ) then
+ iprof = Int ( ( xseglen - xtstep ) / tprofiler%step ) + 1
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_PROFILER_TIME, 'time_profiler', iprof )
+ end if
+
+ !Dimension for the number of station times
+ if ( numbstat > 0 ) then
+ istation = Int ( ( xseglen - xtstep ) / tstation%step ) + 1
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_STATION_TIME, 'time_station', istation )
+ end if
+
+ !Dimension for the number of series times
+ if ( lseries .and. nsnbstept > 0 ) then
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_SERIES_LEVEL, 'series_level', nkmax )
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_SERIES_LEVEL_W, 'series_level_w', nkmax )
+ call IO_Add_dim_nc4( tpfile, NMNHDIM_SERIES_TIME, 'time_series', nsnbstept )
+ end if
+end if
END SUBROUTINE IO_Knowndims_set_nc4
-SUBROUTINE IO_Iocdf_dealloc_nc4(PIOCDF)
-TYPE(IOCDF), POINTER :: PIOCDF
+subroutine IO_Add_dim_nc4( tpfile, kidx, hdimname, klen )
+use NETCDF, only: NF90_DEF_DIM, NF90_NOERR
-INTEGER(KIND=CDFINT) :: IRESP
+type(tfiledata), intent(inout) :: tpfile
+integer, intent(in) :: kidx !Position of the dimension in the list
+character(len=*), intent(in) :: hdimname !Name of the dimension
+integer, intent(in) :: klen !Length of the dimension
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Iocdf_dealloc_nc4','called')
+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 ) )
-! Clean DIMLIST and DIMSTR
-CALL CLEANLIST(PIOCDF%DIMLIST)
-CALL CLEANLIST(PIOCDF%DIMSTR)
-! Then free iocdf
-DEALLOCATE(PIOCDF)
+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( ydimname_clean ) // &
+ ' of file ' //Trim( tpfile%cname ) )
-CONTAINS
+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( ydimname_clean ) // &
+ ' already defined for file ' //Trim( tpfile%cname ) )
-SUBROUTINE CLEANLIST(PLIST)
-TYPE(DIMCDF), POINTER :: PLIST,TZDIMCUR, TZDIMNEXT
+tpfile%tncdims%tdims(kidx)%cname = ydimname_clean
+tpfile%tncdims%tdims(kidx)%nlen = Int( klen, kind = CDFINT )
-TZDIMCUR => PLIST
-DO WHILE(ASSOCIATED(TZDIMCUR))
- TZDIMNEXT => TZDIMCUR%NEXT
- DEALLOCATE(TZDIMCUR)
- TZDIMCUR => TZDIMNEXT
-END DO
+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( ydimname_clean ) )
-END SUBROUTINE CLEANLIST
+end subroutine IO_Add_dim_nc4
+
+
+SUBROUTINE IO_Iocdf_dealloc_nc4(tpdimsnc)
+TYPE(tdimsnc), POINTER :: tpdimsnc
+
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Iocdf_dealloc_nc4','called')
+
+if ( Allocated( tpdimsnc%tdims ) ) deallocate( tpdimsnc%tdims )
+if ( Allocated( tpdimsnc%tdims_str ) ) deallocate( tpdimsnc%tdims_str )
+
+deallocate( tpdimsnc )
+tpdimsnc => Null()
END SUBROUTINE IO_Iocdf_dealloc_nc4
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, &
+ 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, &
+ NMNHDIM_BUDGET_MASK_LEVEL, NMNHDIM_BUDGET_MASK_LEVEL_W, &
+ NMNHDIM_BUDGET_MASK_NBUMASK, NMNHDIM_BUDGET_TIME, &
+ NMNHDIM_BUDGET_LES_AVG_TIME, NMNHDIM_BUDGET_LES_TIME, &
+ NMNHDIM_BUDGET_LES_LEVEL, NMNHDIM_BUDGET_LES_SV, &
+ NMNHDIM_SPECTRA_2PTS_NI, NMNHDIM_SPECTRA_2PTS_NJ, &
+ NMNHDIM_SPECTRA_SPEC_NI, NMNHDIM_SPECTRA_SPEC_NJ, &
+ NMNHDIM_SPECTRA_LEVEL, &
+ NMNHDIM_SERIES_LEVEL, NMNHDIM_SERIES_LEVEL_W, NMNHDIM_SERIES_TIME, &
+ NMNHDIM_FLYER_TIME, NMNHDIM_PROFILER_TIME, &
+ NMNHDIM_STATION_TIME, NMNHDIM_LASTDIM_DIACHRO, &
+ NMNHDIM_NOTLISTED, NMNHDIM_UNUSED, NMNHDIM_ARAKAWA
+
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
INTEGER(KIND=CDFINT),DIMENSION(:), INTENT(IN) :: KSHAPE
INTEGER(KIND=CDFINT),DIMENSION(:),ALLOCATABLE,INTENT(OUT) :: KVDIMS
!
-INTEGER :: IGRID
-INTEGER :: JI
-CHARACTER(LEN=32) :: YINT
-CHARACTER(LEN=2) :: YDIR
-TYPE(DIMCDF), POINTER :: PTDIM
+CHARACTER(LEN=32) :: YINT
+CHARACTER(LEN=2) :: YDIR
+character(len=:), allocatable :: ydimname
+integer :: idimn
+INTEGER :: IGRID
+integer :: iidx
+integer :: iresp
+INTEGER :: JI
+integer(kind=CDFINT) :: ilen
+integer(kind=CDFINT) :: istatus
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Vdims_fill_nc4','called for '//TRIM(TPFIELD%CMNHNAME))
!
-IF (SIZE(KSHAPE) < 1 .AND. .NOT.TPFIELD%LTIMEDEP) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Vdims_fill_nc4','empty KSHAPE')
-!
+if ( Size( kshape ) == 0 .and. .not. tpfield%ltimedep) then
+ !Scalar variable case not time dependent
+ if ( tpfield%ndims == 0 ) then
+ Allocate( kvdims(0) )
+ return
+ else
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Vdims_fill_nc4', 'empty kshape' )
+ end if
+end if
+
IGRID = TPFIELD%NGRID
YDIR = TPFIELD%CDIR
!
@@ -386,7 +546,7 @@ END IF
IF (TPFIELD%LTIMEDEP) THEN
!Add time dimension
ALLOCATE(KVDIMS(TPFIELD%NDIMS+1))
- KVDIMS(TPFIELD%NDIMS+1) = TPFILE%TNCDIMS%DIMTIME%ID
+ KVDIMS(TPFIELD%NDIMS+1) = tpfile%tncdims%tdims(NMNHDIM_TIME)%nid
ELSE
ALLOCATE(KVDIMS(TPFIELD%NDIMS))
END IF
@@ -400,160 +560,260 @@ IF(IGRID==0 .AND. YDIR/='--' .AND. YDIR/='' ) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Vdims_fill_nc4','invalid YDIR ('//TRIM(YDIR)//') with NGRID=0 for field ' &
//TRIM(TPFIELD%CMNHNAME))
END IF
-!
-DO JI=1,SIZE(KSHAPE)
- IF (JI == 1) THEN
- IF ( (YDIR == 'XX' .OR. YDIR == 'XY') .AND. KSHAPE(1)==TPFILE%TNCCOORDS(1,IGRID)%TDIM%LEN) THEN
- KVDIMS(1) = TPFILE%TNCCOORDS(1,IGRID)%TDIM%ID
- ELSE IF ( YDIR == 'YY' .AND. KSHAPE(1)==TPFILE%TNCCOORDS(2,IGRID)%TDIM%LEN) THEN
- KVDIMS(1) = TPFILE%TNCCOORDS(2,IGRID)%TDIM%ID
- ELSE IF ( YDIR == 'ZZ' .AND. KSHAPE(1)==TPFILE%TNCCOORDS(3,IGRID)%TDIM%LEN) THEN
- KVDIMS(1) = TPFILE%TNCCOORDS(3,IGRID)%TDIM%ID
- ELSE
- PTDIM => IO_Dimcdf_get_nc4(TPFILE, KSHAPE(1)); KVDIMS(1) = PTDIM%ID
- END IF
- ELSE IF (JI == 2) THEN
- IF ( YDIR == 'XY' .AND. KSHAPE(2)==TPFILE%TNCCOORDS(2,IGRID)%TDIM%LEN) THEN
- KVDIMS(2) = TPFILE%TNCCOORDS(2,IGRID)%TDIM%ID
- ELSE
- PTDIM => IO_Dimcdf_get_nc4(TPFILE, KSHAPE(2)); KVDIMS(2) = PTDIM%ID
- END IF
- ELSE IF (JI == 3) THEN
- IF ( YDIR == 'XY' .AND. KSHAPE(3)==TPFILE%TNCCOORDS(3,IGRID)%TDIM%LEN) THEN
- KVDIMS(3) = TPFILE%TNCCOORDS(3,IGRID)%TDIM%ID
- ELSE
- PTDIM => IO_Dimcdf_get_nc4(TPFILE, KSHAPE(3)); KVDIMS(3) = PTDIM%ID
- END IF
- ELSE
- PTDIM => IO_Dimcdf_get_nc4(TPFILE, KSHAPE(JI)); KVDIMS(JI) = PTDIM%ID
- END IF
-END DO
-!
+
+if ( Any( tpfield%ndimlist(:) /= NMNHDIM_UNKNOWN ) ) then
+ do ji = 1, Size( kvdims )
+ if ( tpfield%ndimlist(ji) == NMNHDIM_UNKNOWN ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Vdims_fill_nc4', 'ndimlist partially filled for field ' // Trim( tpfield%cmnhname ) )
+
+ if ( tpfield%ndimlist(ji) == NMNHDIM_NOTLISTED ) then
+ call IO_Dim_find_create_nc4( tpfile, kshape(ji), iidx )
+ kvdims(ji) = tpfile%tncdims%tdims(iidx)%nid
+ cycle
+ end if
+
+ if ( tpfield%ndimlist(ji) == NMNHDIM_FLYER_TIME ) then
+ istatus = NF90_INQ_DIMID( tpfile%nncid, 'time_flyer', kvdims(ji) )
+ if ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'IO_Vdims_fill_nc4','NF90_INQ_DIMID', Trim( tpfield%cmnhname ) )
+
+ istatus = NF90_INQUIRE_DIMENSION( tpfile%nncid, kvdims(ji), len = ilen)
+ if ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'IO_Vdims_fill_nc4','NF90_INQUIRE_DIMENSION', Trim( tpfield%cmnhname ) )
+
+ if ( kshape(ji) /= ilen ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Vdims_fill_nc4', &
+ 'wrong size for dimension '// 'time_flyer' // ' of field ' // Trim( tpfield%cmnhname ) )
+ end if
+ cycle
+ end if
+
+ if ( tpfield%ndimlist(ji) > 0 .and. tpfield%ndimlist(ji) <= tpfile%tncdims%nmaxdims ) then
+ kvdims(ji) = tpfile%tncdims%tdims(tpfield%ndimlist(ji))%nid
+
+ ! Check if dimension sizes are consistent with the declared dimensions ( skip ji>size(kshape), timedep dimension)
+ if ( ji <= Size( kshape ) ) then
+ if ( kshape(ji) /= tpfile%tncdims%tdims(tpfield%ndimlist(ji))%nlen ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Vdims_fill_nc4', 'wrong size for dimension ' &
+ // Trim( tpfile%tncdims%tdims(tpfield%ndimlist(ji))%cname ) // &
+ ' of field ' // Trim( tpfield%cmnhname ) )
+ end if
+ else
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Vdims_fill_nc4', 'wrong dimension' )
+ end if
+ end do
+else !ndimlist not provided
+ do ji = 1, Size( kshape )
+ if ( igrid > 0 .and. igrid < 9 ) then
+ if ( ji == 1 ) then
+ if ( ( ydir == 'XX' .or. ydir == 'XY') .and. kshape(1) == tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,1) )%nlen ) then
+ kvdims(1) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,1) )%nid
+ else if ( ydir == 'YY' .and. kshape(1) == tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,2) )%nlen ) then
+ kvdims(1) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,2) )%nid
+ else if ( ydir == 'ZZ' .and. kshape(1) == tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,3) )%nlen ) then
+ kvdims(1) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,3) )%nid
+ else
+ call IO_Dim_find_create_nc4( tpfile, kshape(1), iidx )
+ kvdims(1) = tpfile%tncdims%tdims(iidx)%nid
+ end if
+ else if ( ji == 2 ) then
+ !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
+ end if
+ else if ( ji == 3 ) then
+ if ( ydir == 'XY' .and. kshape(3) == tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,3) )%nlen ) then
+ kvdims(3) = tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(igrid,3) )%nid
+ else
+ call IO_Dim_find_create_nc4( tpfile, kshape(3), iidx )
+ kvdims(3) = tpfile%tncdims%tdims(iidx)%nid
+ end if
+ else
+ call IO_Dim_find_create_nc4( tpfile, kshape(ji), iidx )
+ kvdims(ji) = tpfile%tncdims%tdims(iidx)%nid
+ end if
+ else
+ call IO_Dim_find_create_nc4( tpfile, kshape(ji), iidx )
+ kvdims(ji) = tpfile%tncdims%tdims(iidx)%nid
+ end if
+ END DO
+end if
+
END SUBROUTINE IO_Vdims_fill_nc4
-FUNCTION IO_Dimcdf_get_nc4(TPFILE, KLEN, HDIMNAME)
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-INTEGER(KIND=CDFINT), INTENT(IN) :: KLEN
-CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HDIMNAME ! When provided don't search but
- ! simply create with name HDIMNAME
-TYPE(DIMCDF), POINTER :: IO_Dimcdf_get_nc4
+subroutine IO_Dim_find_create_nc4( tpfile, klen, kidx, hdimname)
+use modd_netcdf, only: tdimnc
-TYPE(DIMCDF), POINTER :: TMP
-INTEGER :: COUNT
-CHARACTER(LEN=16) :: YSUFFIX
-CHARACTER(LEN=20) :: YDIMNAME
-INTEGER(KIND=CDFINT) :: STATUS
-LOGICAL :: GCHKLEN !Check if KLEN is valid
-TYPE(IOCDF), POINTER :: PIOCDF
+type(tfiledata), intent(in) :: tpfile
+integer(kind=CDFINT), intent(in) :: klen
+CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HDIMNAME
+integer, intent(out) :: kidx !Position of the dimension in the dimension array
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dimcdf_get_nc4','called')
+character(len=:), allocatable :: ydimname_clean
+character(len=16) :: ysuffix
+integer :: inewsize
+integer :: ji
+integer(kind=CDFINT) :: istatus
+type(tdimnc), dimension(:), allocatable :: tzncdims
-PIOCDF => TPFILE%TNCDIMS
-GCHKLEN = .TRUE.
-!Do not check KLEN if 'time' (because NF90_UNLIMITED = 0)
-IF (PRESENT(HDIMNAME)) THEN
- IF (TRIM(HDIMNAME)=='time') THEN
- GCHKLEN = .FALSE.
- END IF
-END IF
+kidx = -1
-WRITE(YSUFFIX,'(I0)') KLEN
+if ( Present( hdimname ) ) call IO_Mnhname_clean( hdimname, ydimname_clean )
-IF (GCHKLEN .AND. KLEN < 1) THEN
- CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Dimcdf_get_nc4','KLEN='//TRIM(YSUFFIX))
-END IF
+do ji = 1, Size( tpfile%tncdims%tdims )
+ if ( tpfile%tncdims%tdims(ji)%nlen == klen ) then
+ if ( Present( hdimname ) ) then
+ if ( ydimname_clean == Trim( tpfile%tncdims%tdims(ji)%cname ) ) then
+ kidx = ji
+ exit
+ end if
+ else
+ kidx = ji
+ exit
+ end if
+ end if
+end do
+
+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 ( ydimname_clean == Trim( tpfile%tncdims%tdims(ji)%cname ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Dim_find_create_nc4', 'dimension ' &
+ // Trim( ydimname_clean ) // ' already exist but with a different size' )
+ end do
+ end if
-IF (PRESENT(HDIMNAME)) THEN
- NULLIFY(TMP)
- YDIMNAME = TRIM(HDIMNAME)
-ELSE
- ! Search dimension with KLEN length
- COUNT = 1
- TMP => PIOCDF%DIMLIST
- DO WHILE(ASSOCIATED(TMP))
- IF (TMP%LEN == KLEN .AND. TMP%NAME(1:4) /= 'char') EXIT
- TMP=>TMP%NEXT
- COUNT = COUNT+1
- END DO
- YDIMNAME = 'size'//TRIM(YSUFFIX)
-END IF
+ !Create new dimension
+ inewsize = Size( tpfile%tncdims%tdims ) + 1
+ allocate( tzncdims(inewsize) )
+ tzncdims(1 : inewsize - 1) = tpfile%tncdims%tdims(:)
-IF (.NOT. ASSOCIATED(TMP)) THEN
- ! Not found then define new dimension
- ALLOCATE(TMP)
- TMP%NAME = YDIMNAME
- TMP%LEN = KLEN
- STATUS = NF90_DEF_DIM(TPFILE%NNCID, TMP%NAME, KLEN, TMP%ID)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Dimcdf_get_nc4','NF90_DEF_DIM',trim(TMP%NAME))
- NULLIFY(TMP%NEXT)
- TMP%NEXT => PIOCDF%DIMLIST
- PIOCDF%DIMLIST => TMP
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Dimcdf_get_nc4','new dimension: '//TRIM(TMP%NAME))
-END IF
+ if ( Present( hdimname ) ) then
+ tzncdims(inewsize)%cname = Trim( ydimname_clean )
+ else
+ Write( ysuffix, '( i0 )' ) klen
+ tzncdims(inewsize)%cname = 'size' // Trim( ysuffix )
+ end if
+ tzncdims(inewsize)%nlen = klen
+
+ istatus = NF90_DEF_DIM( tpfile%nncid, tzncdims(inewsize)%cname, klen, tzncdims(inewsize)%nid )
+ if ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'IO_Dim_find_create_nc4', 'NF90_DEF_DIM', Trim( tzncdims(inewsize)%cname) )
+
+#if 0
+ !Disabled here due to a probable bug in the Intel compiler
+ call Move_alloc( from = tzncdims, to = tpfile%tncdims%tdims )
+#else
+ !Do the Move_alloc by hand...
+ if ( Allocated( tpfile%tncdims%tdims ) ) Deallocate( tpfile%tncdims%tdims )
+ Allocate( tpfile%tncdims%tdims(Size( tzncdims )) )
+ tpfile%tncdims%tdims(:) = tzncdims
+ Deallocate( tzncdims )
+#endif
-IO_Dimcdf_get_nc4 => TMP
+ tpfile%tncdims%nmaxdims = inewsize
-END FUNCTION IO_Dimcdf_get_nc4
+ kidx = inewsize
+ call Print_msg( NVERB_DEBUG, 'IO', 'IO_Dim_find_create_nc4','new dimension: ' // Trim( tpfile%tncdims%tdims(inewsize)%cname ) )
+end if
+
+end subroutine IO_Dim_find_create_nc4
FUNCTION IO_Strdimid_get_nc4(TPFILE,KLEN)
+use modd_netcdf, only: tdimnc
+
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
INTEGER(KIND=CDFINT), INTENT(IN) :: KLEN
INTEGER(KIND=CDFINT) :: IO_Strdimid_get_nc4
-TYPE(DIMCDF), POINTER :: TMP
-TYPE(IOCDF), POINTER :: TZIOCDF
-CHARACTER(LEN=16) :: YSUFFIX
-INTEGER(KIND=CDFINT) :: STATUS
+CHARACTER(LEN=16) :: YSUFFIX
+integer :: idx
+integer :: inewsize
+integer :: ji
+integer(kind=CDFINT) :: istatus
+type(tdimnc), dimension(:), allocatable :: tzncdims
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Strdimid_get_nc4','called')
-WRITE(YSUFFIX,'(I0)') KLEN
-
IF (KLEN < 1) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Strdimid_get_nc4','KLEN='//TRIM(YSUFFIX))
END IF
! Search string dimension with KLEN length
-TMP => TPFILE%TNCDIMS%DIMSTR
-DO WHILE(ASSOCIATED(TMP))
- IF (TMP%LEN == KLEN) EXIT
- TMP=>TMP%NEXT
-END DO
-
-IF (.NOT. ASSOCIATED(TMP)) THEN
- ! Not found then define new dimension
- ALLOCATE(TMP)
- TMP%NAME = 'char'//TRIM(YSUFFIX)
- TMP%LEN = KLEN
- STATUS = NF90_DEF_DIM(TPFILE%NNCID, TMP%NAME, KLEN, TMP%ID)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Strdimid_get_nc4','NF90_DEF_DIM',trim(TMP%NAME))
- NULLIFY(TMP%NEXT)
- TMP%NEXT => TPFILE%TNCDIMS%DIMSTR
- TZIOCDF => TPFILE%TNCDIMS
- TZIOCDF%DIMSTR => TMP
-END IF
+idx = -1
+if ( Allocated( tpfile%tncdims%tdims_str ) ) then
+ do ji = 1, Size( tpfile%tncdims%tdims_str )
+ if ( tpfile%tncdims%tdims_str(ji)%nlen == klen ) then
+ idx = ji
+ exit
+ end if
+ end do
+end if
+
+if ( idx == -1 ) then
+ !Create new dimension
+ inewsize = tpfile%tncdims%nmaxdims_str + 1
+ allocate( tzncdims(inewsize) )
+ if ( Allocated( tpfile%tncdims%tdims_str ) ) &
+ tzncdims(1 : inewsize - 1) = tpfile%tncdims%tdims_str(:)
-IO_Strdimid_get_nc4 = TMP%ID
+ Write( ysuffix, '( i0 )' ) klen
+ tzncdims(inewsize)%cname = 'char' // Trim( ysuffix )
+ tzncdims(inewsize)%nlen = Int( klen, kind = CDFINT )
+
+ istatus = NF90_DEF_DIM( tpfile%nncid, tzncdims(inewsize)%cname, Int( klen, kind = CDFINT ), tzncdims(inewsize)%nid )
+ if ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'IO_Strdimid_get_nc4', 'NF90_DEF_DIM', Trim( tzncdims(inewsize)%cname) )
+
+#if 0
+ !Disabled here due to a probable bug in the Intel compiler
+ call Move_alloc( from = tzncdims, to = tpfile%tncdims%tdims_str )
+#else
+ !Do the Move_alloc by hand...
+ if ( Allocated( tpfile%tncdims%tdims_str ) ) Deallocate( tpfile%tncdims%tdims_str )
+ Allocate( tpfile%tncdims%tdims_str(Size( tzncdims )) )
+ tpfile%tncdims%tdims_str(:) = tzncdims(:)
+ Deallocate( tzncdims )
+#endif
+ tpfile%tncdims%nmaxdims_str = inewsize
+
+ idx = inewsize
+
+ call Print_msg( NVERB_DEBUG, 'IO', 'IO_Dim_find_create_nc4','new dimension: ' &
+ // Trim( tpfile%tncdims%tdims_str(inewsize)%cname ) )
+end if
+
+IO_Strdimid_get_nc4 = tpfile%tncdims%tdims_str(idx)%nid
END FUNCTION IO_Strdimid_get_nc4
FUNCTION IO_Iocdf_alloc_nc4()
-TYPE(IOCDF), POINTER :: IO_Iocdf_alloc_nc4
-TYPE(IOCDF), POINTER :: TZIOCDF
-INTEGER :: IRESP
+type(tdimsnc), pointer :: IO_Iocdf_alloc_nc4
+type(tdimsnc), pointer :: tzdimsnc
+INTEGER :: IRESP
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Iocdf_alloc_nc4','called')
-ALLOCATE(TZIOCDF, STAT=IRESP)
+ALLOCATE(tzdimsnc, STAT=IRESP)
IF (IRESP > 0) THEN
CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Iocdf_alloc_nc4','memory allocation error')
END IF
-IO_Iocdf_alloc_nc4=>TZIOCDF
+IO_Iocdf_alloc_nc4 => tzdimsnc
END FUNCTION IO_Iocdf_alloc_nc4
@@ -582,31 +842,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_lfi.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90
index 26f18bc04cee5ec685bbc4d1d07d1c83964aa6fa..430f06ccfed1c5d64d8daeec50f95164be6d1ed7 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_write_lfi.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_write_lfi.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.
@@ -9,14 +9,16 @@
! P. Wautelet 14/12/2018: split fmreadwrit.f90
! P. Wautelet 11/01/2019: do not write variables with a zero size
! P. Wautelet 05/03/2019: rename IO subroutines and modules
+! P. Wautelet 12/07/2019: add support for 1D array of dates
+! P. Wautelet 14/01/2021: add IO_Field_write_lfi_N4 subroutine
!-----------------------------------------------------------------
module mode_io_write_lfi
!
+use modd_field, only: tfielddata
USE MODD_IO
USE MODD_PARAMETERS, ONLY: NLFIMAXCOMMENTLENGTH
-use modd_precision, only: LFIINT
+use modd_precision, only: LFIINT, MNHINT64, MNHREAL64
!
-USE MODE_FIELD, ONLY: TFIELDDATA
USE MODE_MSG
!
IMPLICIT NONE
@@ -35,9 +37,10 @@ INTERFACE IO_Field_write_lfi
IO_Field_write_lfi_X6, &
IO_Field_write_lfi_N0,IO_Field_write_lfi_N1, &
IO_Field_write_lfi_N2,IO_Field_write_lfi_N3, &
+ IO_Field_write_lfi_N4, &
IO_Field_write_lfi_L0,IO_Field_write_lfi_L1, &
IO_Field_write_lfi_C0, &
- IO_Field_write_lfi_T0
+ IO_Field_write_lfi_T0,IO_Field_write_lfi_T1
END INTERFACE IO_Field_write_lfi
!
CONTAINS
@@ -56,10 +59,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(KIND=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG
+INTEGER(KIND=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X0','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -95,10 +98,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X1','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -137,18 +140,18 @@ TYPE(TFILEDATA),TARGET,INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
REAL,DIMENSION(:,:), INTENT(IN) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
-INTEGER,OPTIONAL, INTENT(IN) :: KVERTLEVEL ! Number of the vertical level (needed for Z-level splitted files)
-INTEGER,OPTIONAL, INTENT(IN) :: KZFILE ! Number of the Z-level splitted file
+INTEGER,OPTIONAL, INTENT(IN) :: KVERTLEVEL ! Number of the vertical level (needed for Z-level split files)
+INTEGER,OPTIONAL, INTENT(IN) :: KZFILE ! Number of the Z-level split file
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=4) :: YSUFFIX
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)+4) :: YVARNAME
-CHARACTER(LEN=LEN_HREC) :: YRECFM
-TYPE(TFILEDATA),POINTER :: TZFILE
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=4) :: YSUFFIX
+CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)+4) :: YVARNAME
+CHARACTER(LEN=LEN_HREC) :: YRECFM
+TYPE(TFILEDATA),POINTER :: TZFILE
!
IRESP=0
!
@@ -206,10 +209,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X3','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -251,10 +254,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X4','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -296,10 +299,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X5','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -341,10 +344,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems arais
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_X6','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -386,10 +389,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N0','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -425,10 +428,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N1','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -470,10 +473,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N2','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -515,10 +518,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N3','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -546,7 +549,54 @@ KRESP=IRESP
IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
END SUBROUTINE IO_Field_write_lfi_N3
+
+
+SUBROUTINE IO_Field_write_lfi_N4(TPFILE,TPFIELD,KFIELD,KRESP)
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+INTEGER,DIMENSION(:,:,:,:),INTENT(IN) :: KFIELD ! array containing the data field
+INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_N4','writing '//TRIM(TPFIELD%CMNHNAME))
+!
+ILENG = SIZE(KFIELD)
+!
+IF ( ILENG==0 ) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_N4','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ KRESP = 0
+ RETURN
+END IF
+!
+CALL WRITE_PREPARE(TPFIELD,ILENG,IWORK,ITOTAL,IRESP)
+!
+IF (IRESP==0) THEN
+ IWORK(LEN(TPFIELD%CCOMMENT)+3:) = RESHAPE( KFIELD(:,:,:,:) , (/ SIZE(KFIELD) /) )
+ YRECFM=TRIM(TPFIELD%CMNHNAME)
+ IF( LEN_TRIM(TPFIELD%CMNHNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_N4','field name was truncated to '&
+ //YRECFM//' for '//TRIM(TPFIELD%CMNHNAME))
+ CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
+ENDIF
+!
+KRESP=IRESP
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
+END SUBROUTINE IO_Field_write_lfi_N4
+
+
SUBROUTINE IO_Field_write_lfi_L0(TPFILE,TPFIELD,OFIELD,KRESP)
!
IMPLICIT NONE
@@ -560,11 +610,11 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: IFIELD
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: IFIELD
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_L0','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -607,11 +657,11 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_L1','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -662,10 +712,10 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG, ILENGMAX, JLOOP
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG, ILENGMAX, JLOOP
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_C0','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -720,12 +770,12 @@ INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
!
!* 0.2 Declarations of local variables
!
-INTEGER :: ILENG
-INTEGER(kind=LFIINT) :: IRESP, ITOTAL
-TYPE(TFIELDDATA) :: TZFIELD
-INTEGER, DIMENSION(3) :: ITDATE ! date array
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE :: IWORK
-CHARACTER(LEN=LEN_HREC) :: YRECFM
+INTEGER :: ILENG
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+TYPE(TFIELDDATA) :: TZFIELD
+INTEGER, DIMENSION(3) :: ITDATE ! date array
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_T0','writing '//TRIM(TPFIELD%CMNHNAME))
!
@@ -735,9 +785,9 @@ TZFIELD = TPFIELD
!
TZFIELD%CMNHNAME = TRIM(TPFIELD%CMNHNAME)//'%TDATE'
TZFIELD%CCOMMENT = 'YYYYMMDD'
-ITDATE(1)=TPDATA%TDATE%YEAR
-ITDATE(2)=TPDATA%TDATE%MONTH
-ITDATE(3)=TPDATA%TDATE%DAY
+ITDATE(1)=TPDATA%nyear
+ITDATE(2)=TPDATA%nmonth
+ITDATE(3)=TPDATA%nday
ILENG=SIZE(ITDATE)
!
CALL WRITE_PREPARE(TZFIELD,ILENG,IWORK,ITOTAL,IRESP)
@@ -767,7 +817,7 @@ ILENG=1
CALL WRITE_PREPARE(TZFIELD,ILENG,IWORK,ITOTAL,IRESP)
!
IF (IRESP==0) THEN
- IWORK(LEN(TZFIELD%CCOMMENT)+3) = TRANSFER(TPDATA%TIME,IWORK(1))
+ IWORK(LEN(TZFIELD%CCOMMENT)+3) = TRANSFER(TPDATA%xtime,IWORK(1))
YRECFM=TRIM(TZFIELD%CMNHNAME)
IF( LEN_TRIM(TZFIELD%CMNHNAME) > LEN(YRECFM) ) &
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_T0','field name was truncated to '&
@@ -781,13 +831,104 @@ IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
!
END SUBROUTINE IO_Field_write_lfi_T0
!
+SUBROUTINE IO_Field_write_lfi_T1(TPFILE,TPFIELD,TPDATA,KRESP)
+!
+USE MODD_TYPE_DATE
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+TYPE (DATE_TIME), DIMENSION(:), INTENT(IN) :: TPDATA ! array containing the data field
+INTEGER, INTENT(OUT):: KRESP ! return-code if problems araised
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER :: ILENG, IPOS
+INTEGER :: JI
+INTEGER(kind=LFIINT) :: IRESP, ITOTAL
+TYPE(TFIELDDATA) :: TZFIELD
+INTEGER, DIMENSION(:), ALLOCATABLE :: ITDATE ! date array
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE :: IWORK
+CHARACTER(LEN=LEN_HREC) :: YRECFM
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_lfi_T1','writing '//TRIM(TPFIELD%CMNHNAME))
+!
+ILENG = 3 * SIZE( TPDATA )
+!
+IF ( ILENG==0 ) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_T1','ignoring variable with a zero size ('//TRIM(TPFIELD%CMNHNAME)//')')
+ KRESP = 0
+ RETURN
+END IF
+!
+ALLOCATE( ITDATE( ILENG ) )
+!
+TZFIELD = TPFIELD
+!
+! Write date
+!
+TZFIELD%CMNHNAME = TRIM(TPFIELD%CMNHNAME)//'%TDATE'
+TZFIELD%CCOMMENT = 'YYYYMMDD'
+!
+DO JI = 1, SIZE( TPDATA )
+ IPOS = 1 + 3 * ( JI - 1 )
+ ITDATE(IPOS ) = TPDATA(JI)%nyear
+ ITDATE(IPOS + 1 ) = TPDATA(JI)%nmonth
+ ITDATE(IPOS + 2 ) = TPDATA(JI)%nday
+END DO
+!
+CALL WRITE_PREPARE(TZFIELD,ILENG,IWORK,ITOTAL,IRESP)
+!
+IF (IRESP==0) THEN
+ IWORK(LEN(TZFIELD%CCOMMENT)+3:)=ITDATE(:)
+ YRECFM=TRIM(TZFIELD%CMNHNAME)
+ IF( LEN_TRIM(TZFIELD%CMNHNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_T1','field name was truncated to '&
+ //YRECFM//' for '//TRIM(TZFIELD%CMNHNAME))
+ CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
+ENDIF
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+!
+IF (IRESP/=0) THEN
+ KRESP = IRESP
+ RETURN
+END IF
+!
+! Write time
+!
+TZFIELD%CMNHNAME = TRIM(TPFIELD%CMNHNAME)//'%TIME'
+TZFIELD%CCOMMENT = 'SECONDS'
+ILENG = SIZE( TPDATA )
+!
+CALL WRITE_PREPARE(TZFIELD,ILENG,IWORK,ITOTAL,IRESP)
+!
+IF (IRESP==0) THEN
+ CALL TRANSFER_R_I8(TPDATA(:)%xtime,IWORK(LEN(TPFIELD%CCOMMENT)+3:))
+ YRECFM=TRIM(TZFIELD%CMNHNAME)
+ IF( LEN_TRIM(TZFIELD%CMNHNAME) > LEN(YRECFM) ) &
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_lfi_T1','field name was truncated to '&
+ //YRECFM//' for '//TRIM(TZFIELD%CMNHNAME))
+ CALL LFIECR(IRESP,TPFILE%NLFIFLU,YRECFM,IWORK,ITOTAL)
+ENDIF
+!
+KRESP=IRESP
+!
+IF (ALLOCATED(IWORK)) DEALLOCATE(IWORK)
+DEALLOCATE( ITDATE )
+!
+END SUBROUTINE IO_Field_write_lfi_T1
+!
SUBROUTINE WRITE_PREPARE(TPFIELD,KLENG,KWORK,KTOTAL,KRESP)
!
-TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
-INTEGER, INTENT(IN) :: KLENG
-INTEGER(KIND=8),DIMENSION(:),ALLOCATABLE,INTENT(INOUT) :: KWORK
-INTEGER(kind=LFIINT), INTENT(OUT) :: KTOTAL
-INTEGER(kind=LFIINT), INTENT(OUT) :: KRESP
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+INTEGER, INTENT(IN) :: KLENG
+INTEGER(KIND=MNHINT64),DIMENSION(:),ALLOCATABLE,INTENT(INOUT) :: KWORK
+INTEGER(kind=LFIINT), INTENT(OUT) :: KTOTAL
+INTEGER(kind=LFIINT), INTENT(OUT) :: KRESP
!
INTEGER :: ICOMLEN
INTEGER :: J
@@ -830,12 +971,12 @@ END SUBROUTINE WRITE_PREPARE
!
SUBROUTINE TRANSFER_R_I8(PFIELDIN,KFIELDOUT)
!
-REAL,DIMENSION(:), INTENT(IN) :: PFIELDIN
-INTEGER(KIND=8),DIMENSION(:),INTENT(OUT) :: KFIELDOUT
+REAL,DIMENSION(:), INTENT(IN) :: PFIELDIN
+INTEGER(KIND=MNHINT64),DIMENSION(:),INTENT(OUT) :: KFIELDOUT
!
INTEGER :: ILENG
#if (MNH_REAL == 4)
-REAL(KIND=8),DIMENSION(:),ALLOCATABLE :: ZFIELD8
+REAL(KIND=MNHREAL64),DIMENSION(:),ALLOCATABLE :: ZFIELD8
#endif
!
ILENG = SIZE(PFIELDIN)
@@ -844,7 +985,7 @@ ILENG = SIZE(PFIELDIN)
KFIELDOUT(:) = TRANSFER(PFIELDIN,KFIELDOUT(1),ILENG)
#else
ALLOCATE(ZFIELD8(ILENG))
- ZFIELD8(:) = REAL(PFIELDIN(:),KIND=8)
+ ZFIELD8(:) = REAL(PFIELDIN(:),KIND=MNHREAL64)
KFIELDOUT(:) = TRANSFER(ZFIELD8,KFIELDOUT(1),ILENG)
DEALLOCATE(ZFIELD8)
#endif
diff --git a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90 b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
index 34eebc5adef4e993658ae2cbc7dcd0f27b164250..53053069c936e71c6df416594babe000686782a7 100644
--- a/src/LIB/SURCOUCHE/src/mode_io_write_nc4.f90
+++ b/src/LIB/SURCOUCHE/src/mode_io_write_nc4.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.
@@ -12,18 +12,32 @@
! P. Wautelet 11/01/2019: NVERB_INFO->NVERB_WARNING for zero size fields
! P. Wautelet 01/02/2019: IO_Coordvar_write_nc4: bug: use of non-associated pointers (PIOCDF%DIM_Nx_y)
! P. Wautelet 05/03/2019: rename IO subroutines and modules
+! P. Wautelet 12/07/2019: add support for 1D array of dates
+! P. Wautelet 10/09/2019: IO_Coordvar_write_nc4: split communication and file write operations
+! + no more process coordination for Z-split files
! P. Wautelet 18/09/2019: correct support of 64bit integers (MNH_INT=8)
! P. Wautelet 19/09/2019: temporary workaround for netCDF bug if MNH_INT=8 (if netCDF fortran < 4.4.5)
+! P. Wautelet 11/02/2020: add 'dims' attribute in IO_Write_field_header_split_nc4
+! P. Wautelet 25/06/2020: remove workaround for netCDF bug (see 19/09/2019)
+! P. Wautelet 14/09/2020: IO_Coordvar_write_nc4: do not store 'time' coordinate in diachronic files
+! P. Wautelet 22/09/2020: add ldimreduced field to allow reduction in the number of dimensions of fields (used by 2D simulations)
+! P. Wautelet 10/11/2020: new data structures for netCDF dimensions
+! P. Wautelet 26/11/2020: add IO_Field_create_nc4 subroutine + use it for all IO_Field_write_nc4_*
+! P. Wautelet 04/12/2020: add IO_Field_partial_write_nc4 subroutines
+! P. Wautelet 11/01/2021: add coordinates for dimension variables in diachronic files
+! P. Wautelet 14/01/2021: add IO_Field_write_nc4_N4, IO_Field_partial_write_nc4_N2,
+! IO_Field_partial_write_nc4_N3 and IO_Field_partial_write_nc4_N4 subroutines
+! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
!-----------------------------------------------------------------
-#if defined(MNH_IOCDF4)
+#ifdef MNH_IOCDF4
module mode_io_write_nc4
+use modd_field, only: tfielddata
use modd_io, only: gsmonoproc, tfiledata
-use modd_netcdf, only: dimcdf, iocdf
-use modd_precision, only: CDFINT, MNHINT_NF90, MNHREAL_NF90
+use modd_parameters, only: NMNHNAMELGTMAX
+use modd_precision, only: CDFINT, MNHINT_NF90, MNHREAL32, MNHREAL_MPI, MNHREAL_NF90
-use mode_field, only: tfielddata
-use mode_io_tools_nc4, only: IO_Mnhname_clean, IO_Vdims_fill_nc4, IO_Dimcdf_get_nc4, IO_Strdimid_get_nc4, IO_Err_handle_nc4
+use mode_io_tools_nc4, only: IO_Mnhname_clean, IO_Vdims_fill_nc4, IO_Dim_find_create_nc4, IO_Strdimid_get_nc4, IO_Err_handle_nc4
use mode_msg
use NETCDF, only: NF90_CHAR, NF90_FLOAT, NF90_INT1, &
@@ -35,8 +49,8 @@ implicit none
private
-public :: IO_Coordvar_write_nc4, IO_Field_write_nc4, IO_Header_write_nc4
-public :: IO_Field_header_split_write_nc4
+public :: IO_Coordvar_write_nc4, IO_Header_write_nc4, IO_Field_header_split_write_nc4
+public :: IO_Field_create_nc4, IO_Field_write_nc4, IO_Field_partial_write_nc4
INTERFACE IO_Field_write_nc4
MODULE PROCEDURE IO_Field_write_nc4_X0,IO_Field_write_nc4_X1, &
@@ -45,11 +59,19 @@ INTERFACE IO_Field_write_nc4
IO_Field_write_nc4_X6, &
IO_Field_write_nc4_N0,IO_Field_write_nc4_N1, &
IO_Field_write_nc4_N2,IO_Field_write_nc4_N3, &
+ IO_Field_write_nc4_N4, &
IO_Field_write_nc4_L0,IO_Field_write_nc4_L1, &
IO_Field_write_nc4_C0,IO_Field_write_nc4_C1, &
- IO_Field_write_nc4_T0
+ IO_Field_write_nc4_T0,IO_Field_write_nc4_T1
END INTERFACE IO_Field_write_nc4
+interface IO_Field_partial_write_nc4
+ module procedure IO_Field_partial_write_nc4_X1, IO_Field_partial_write_nc4_X2, &
+ IO_Field_partial_write_nc4_X3, IO_Field_partial_write_nc4_X4, &
+ IO_Field_partial_write_nc4_N2, IO_Field_partial_write_nc4_N3, &
+ IO_Field_partial_write_nc4_N4
+end interface IO_Field_partial_write_nc4
+
integer,parameter :: NSTRINGCHUNKSIZE = 16 !Dimension of the chunks of strings
!(to limit the number of dimensions for strings)
@@ -59,9 +81,9 @@ integer(kind=CDFINT),parameter :: DEFLATE = 1
contains
subroutine IO_Field_header_split_write_nc4( tpfile, tpfield, knblocks )
-use modd_parameters, only : jphext
+use modd_field, only: TYPEREAL
+use modd_parameters, only: jphext
-use mode_field, only: TYPEREAL
use mode_tools_ll, only: Get_globaldims_ll
type(tfiledata), intent(in) :: tpfile
@@ -130,6 +152,10 @@ if ( istatus /= NF90_NOERR ) then
if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'IO_Field_header_split_write_nc4', 'NF90_PUT_ATT', &
'ndims for '//trim( tpfield%cmnhname ) )
+ istatus = NF90_PUT_ATT( incid, ivarid,'dims', ishape )
+ if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'IO_Field_header_split_write_nc4', 'NF90_PUT_ATT', &
+ 'dims for '//trim( tpfield%cmnhname ) )
+
if ( tpfield%ltimedep ) then
istatus = NF90_PUT_ATT( incid, ivarid,'time_dependent', 'yes' )
else
@@ -148,8 +174,7 @@ SUBROUTINE IO_Field_attr_write_nc4(TPFILE,TPFIELD,KVARID,OEXISTED,KSHAPE,HCALEND
!
USE MODD_CONF, ONLY: CPROGRAM, LCARTESIAN
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
-!
-USE MODE_FIELD, ONLY: TYPEINT, TYPEREAL
+use modd_field, only: NMNHDIM_ARAKAWA, TYPEINT, TYPEREAL
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
@@ -159,10 +184,10 @@ INTEGER(KIND=CDFINT), DIMENSION(:), OPTIONAL, INTENT(IN) :: KSHAPE
CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: HCALENDAR
LOGICAL, OPTIONAL, INTENT(IN) :: OISCOORD ! Is a coordinate variable (->do not write coordinates attribute)
!
-INTEGER(KIND=CDFINT) :: INCID
-INTEGER(KIND=CDFINT) :: STATUS
-CHARACTER(LEN=:),ALLOCATABLE :: YCOORDS
-LOGICAL :: GISCOORD
+CHARACTER(LEN=:), ALLOCATABLE :: YCOORDS
+INTEGER(KIND=CDFINT) :: INCID
+INTEGER(KIND=CDFINT) :: istatus
+LOGICAL :: GISCOORD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_write_nc4','called for field '//TRIM(TPFIELD%CMNHNAME))
!
@@ -186,8 +211,8 @@ INCID = TPFILE%NNCID
IF(LEN_TRIM(TPFIELD%CSTDNAME)==0) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_write_nc4','TPFIELD%CSTDNAME not set for variable '//TRIM(TPFIELD%CMNHNAME))
ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'standard_name', TRIM(TPFIELD%CSTDNAME))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','standard_name for ' &
+ istatus = NF90_PUT_ATT(INCID, KVARID,'standard_name', TRIM(TPFIELD%CSTDNAME))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','standard_name for ' &
//trim(TPFIELD%CMNHNAME))
ENDIF
!
@@ -195,8 +220,8 @@ ENDIF
IF(LEN_TRIM(TPFIELD%CLONGNAME)==0) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_write_nc4','TPFIELD%CLONGNAME not set for variable '//TRIM(TPFIELD%CMNHNAME))
ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'long_name', TRIM(TPFIELD%CLONGNAME))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','long_name for ' &
+ istatus = NF90_PUT_ATT(INCID, KVARID,'long_name', TRIM(TPFIELD%CLONGNAME))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','long_name for ' &
//trim(TPFIELD%CMNHNAME))
ENDIF
!
@@ -204,8 +229,8 @@ ENDIF
IF(LEN_TRIM(TPFIELD%CUNITS)==0) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_write_nc4','TPFIELD%CUNITS not set for variable '//TRIM(TPFIELD%CMNHNAME))
ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'units', TRIM(TPFIELD%CUNITS))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','units for ' &
+ istatus = NF90_PUT_ATT(INCID, KVARID,'units', TRIM(TPFIELD%CUNITS))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','units for ' &
//trim(TPFIELD%CMNHNAME))
ENDIF
!
@@ -214,8 +239,8 @@ IF(TPFIELD%NGRID<0) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_write_nc4','TPFIELD%NGRID not set for variable '//TRIM(TPFIELD%CMNHNAME))
!Do not write GRID attribute if NGRID=0
ELSE IF (TPFIELD%NGRID>0) THEN
- STATUS = NF90_PUT_ATT(INCID, KVARID, 'grid', TPFIELD%NGRID)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','grid for ' &
+ istatus = NF90_PUT_ATT(INCID, KVARID, 'grid', TPFIELD%NGRID)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','grid for ' &
//trim(TPFIELD%CMNHNAME))
ENDIF
!
@@ -223,16 +248,16 @@ ENDIF
IF(LEN_TRIM(TPFIELD%CCOMMENT)==0) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_write_nc4','TPFIELD%CCOMMENT not set for variable '//TRIM(TPFIELD%CMNHNAME))
ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'comment', TRIM(TPFIELD%CCOMMENT))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','comment for ' &
+ istatus = NF90_PUT_ATT(INCID, KVARID,'comment', TRIM(TPFIELD%CCOMMENT))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','comment for ' &
//trim(TPFIELD%CMNHNAME))
ENDIF
!
! Calendar (CF convention)
IF(PRESENT(HCALENDAR)) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_attr_write_nc4','CALENDAR provided for variable '//TRIM(TPFIELD%CMNHNAME))
- STATUS = NF90_PUT_ATT(INCID, KVARID,'calendar', TRIM(HCALENDAR))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','calendar for ' &
+ istatus = NF90_PUT_ATT(INCID, KVARID,'calendar', TRIM(HCALENDAR))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','calendar for ' &
//trim(TPFIELD%CMNHNAME))
ENDIF
!
@@ -242,7 +267,8 @@ IF (.NOT.GISCOORD) THEN
!1D: no direct correspondance with latitude(_x)/longitude(_x) 2D variables => nothing to do
IF (.NOT.LCARTESIAN .AND. TPFIELD%NDIMS>1 .AND. TPFIELD%NGRID/=0) THEN
IF (TPFIELD%CDIR=='XY') THEN
- IF (KSHAPE(1)==TPFILE%TNCCOORDS(1,TPFIELD%NGRID)%TDIM%LEN .AND. KSHAPE(2)==TPFILE%TNCCOORDS(2,TPFIELD%NGRID)%TDIM%LEN ) THEN
+ if ( kshape(1) == tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(tpfield%ngrid,1) )%nlen &
+ .and. kshape(2) == tpfile%tncdims%tdims( NMNHDIM_ARAKAWA(tpfield%ngrid,2) )%nlen ) then
SELECT CASE(TPFIELD%NGRID)
CASE (0) !Not on Arakawa grid
!Nothing to do
@@ -266,11 +292,11 @@ IF (.NOT.GISCOORD) THEN
CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_attr_write_nc4','invalid NGRID for variable '//TRIM(TPFIELD%CMNHNAME))
END SELECT
!
- STATUS = NF90_PUT_ATT(INCID, KVARID,'coordinates',YCOORDS)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','coordinates')
+ istatus = NF90_PUT_ATT(INCID, KVARID,'coordinates',YCOORDS)
+ 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
@@ -288,21 +314,19 @@ IF(TPFIELD%NTYPE==TYPEINT .AND. TPFIELD%NDIMS>0) THEN
! Remarks: * the attribute '_FillValue' is also recognized by the netCDF library
! and is used when pre-filling a variable
! * it cannot be modified if some data has already been written (->check OEXISTED)
-#if ( MNH_INT == 4 )
-!BUG: NF90_PUT_ATT does not work for NF90_INT64 and _FillValue attribute if netCDF-fortran version < 4.4.5 (bug in netCDF)
-! (see https://github.com/Unidata/netcdf-fortran/issues/62)
+ !BUG: NF90_PUT_ATT does not work for NF90_INT64 and _FillValue attribute if netCDF-fortran version < 4.4.5 (bug in netCDF)
+ ! (see https://github.com/Unidata/netcdf-fortran/issues/62)
IF(.NOT.OEXISTED) THEN
- STATUS = NF90_PUT_ATT(INCID, KVARID,'_FillValue', TPFIELD%NFILLVALUE)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','_FillValue')
+ istatus = NF90_PUT_ATT(INCID, KVARID,'_FillValue', TPFIELD%NFILLVALUE)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','_FillValue')
END IF
-#endif
!
! Valid_min/max (CF/COMODO convention)
- STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_min', TPFIELD%NVALIDMIN)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','valid_min')
+ istatus = NF90_PUT_ATT(INCID, KVARID,'valid_min', TPFIELD%NVALIDMIN)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','valid_min')
!
- STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_max',TPFIELD%NVALIDMAX)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','valid_max')
+ istatus = NF90_PUT_ATT(INCID, KVARID,'valid_max',TPFIELD%NVALIDMAX)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','valid_max')
ENDIF
!
IF(TPFIELD%NTYPE==TYPEREAL .AND. TPFIELD%NDIMS>0) THEN
@@ -316,32 +340,188 @@ IF(TPFIELD%NTYPE==TYPEREAL .AND. TPFIELD%NDIMS>0) THEN
! * it cannot be modified if some data has already been written (->check OEXISTED)
IF(.NOT.OEXISTED) THEN
IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_PUT_ATT(INCID, KVARID,'_FillValue', REAL(TPFIELD%XFILLVALUE,KIND=4))
+ istatus = NF90_PUT_ATT(INCID, KVARID,'_FillValue', REAL(TPFIELD%XFILLVALUE,KIND=MNHREAL32))
ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'_FillValue', TPFIELD%XFILLVALUE)
+ istatus = NF90_PUT_ATT(INCID, KVARID,'_FillValue', TPFIELD%XFILLVALUE)
END IF
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','_FillValue')
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','_FillValue')
END IF
!
! Valid_min/max (CF/COMODO convention)
IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_min', REAL(TPFIELD%XVALIDMIN,KIND=4))
+ istatus = NF90_PUT_ATT(INCID, KVARID,'valid_min', REAL(TPFIELD%XVALIDMIN,KIND=MNHREAL32))
ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_min', TPFIELD%XVALIDMIN)
+ istatus = NF90_PUT_ATT(INCID, KVARID,'valid_min', TPFIELD%XVALIDMIN)
END IF
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','valid_min')
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','valid_min')
!
IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_max', REAL(TPFIELD%XVALIDMAX,KIND=4))
+ istatus = NF90_PUT_ATT(INCID, KVARID,'valid_max', REAL(TPFIELD%XVALIDMAX,KIND=MNHREAL32))
ELSE
- STATUS = NF90_PUT_ATT(INCID, KVARID,'valid_max',TPFIELD%XVALIDMAX)
+ istatus = NF90_PUT_ATT(INCID, KVARID,'valid_max',TPFIELD%XVALIDMAX)
END IF
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_attr_write_nc4','NF90_PUT_ATT','valid_max')
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_attr_write_nc4','NF90_PUT_ATT','valid_max')
ENDIF
!
END SUBROUTINE IO_Field_attr_write_nc4
+subroutine IO_Field_create_nc4( tpfile, tpfield, kshape, hcalendar, oiscoord, kvarid, oisempty )
+use NETCDF, only: NF90_CHAR, NF90_FLOAT, NF90_INT1
+
+use modd_field, only: NMNHDIM_TIME, TYPECHAR, TYPEDATE, TYPEINT, TYPELOG, TYPEREAL, TYPEUNDEF
+use modd_precision, only: MNHINT_NF90, MNHREAL_NF90
+
+type(tfiledata), intent(in) :: tpfile
+type(tfielddata), intent(in) :: tpfield
+integer, dimension(:), intent(in), optional :: kshape
+character(len=*), intent(in), optional :: hcalendar
+logical, intent(in), optional :: oiscoord ! Is a coordinate variable (->do not write coordinates attribute)
+integer(kind=CDFINT), intent(out), optional :: kvarid
+logical, intent(out), optional :: oisempty
+
+character(len = Len( tpfield%cmnhname )) :: yvarname
+integer :: idims
+integer :: idx
+integer :: ji
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: itype
+integer(kind=CDFINT) :: ivarid
+integer(kind=CDFINT), dimension(:), allocatable :: ivdims
+integer(kind=CDFINT), dimension(:), allocatable :: ivdimstmp
+integer(kind=CDFINT), dimension(:), allocatable :: ishape
+logical :: gexisted !True if variable was already defined
+
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_Field_create_nc4', Trim( tpfile%cname ) // ': creating ' // Trim( tpfield%cmnhname ) )
+
+gexisted = .false.
+
+call IO_Mnhname_clean( tpfield%cmnhname, yvarname )
+
+if ( .not. Present( kshape ) .and. tpfield%ndims > 0 ) then
+ !kshape not provided => ndimlist has to be previously populated
+ idims = tpfield%ndims
+ if ( tpfield%ltimedep ) idims = idims + 1
+ Allocate( ivdims(idims) )
+ Allocate( ishape(idims) )
+
+ do ji = 1, tpfield%ndims
+ idx = tpfield%ndimlist(ji)
+ if ( idx > tpfile%tncdims%nmaxdims .or. idx < 1 ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_create_nc4', Trim( tpfile%cname ) // ': ' &
+ // Trim( tpfield%cmnhname ) // ': invalid ndimlist' )
+ ivdims(ji) = tpfile%tncdims%tdims(idx)%nid
+ ishape(ji) = tpfile%tncdims%tdims(idx)%nlen
+ end do
+
+ !Set the last dimension if variable is time dependent
+ if ( tpfield%ltimedep ) then
+ ivdims(idims) = tpfile%tncdims%tdims(NMNHDIM_TIME)%nid
+ ishape(idims) = 1
+ end if
+else
+ !Guess the dimensions from the shape of the field
+ if ( tpfield%ndims == 0 ) then
+ Allocate( ishape(0) )
+ else
+ Allocate( ishape(Size( kshape )) )
+ ishape(:) = kshape(:)
+ end if
+
+ !Get the netCDF dimensions
+ if ( tpfield%ntype /= TYPECHAR ) then
+ call IO_Vdims_fill_nc4( tpfile, tpfield, ishape, ivdims )
+ else
+ if ( tpfield%ndims == 0 ) then
+ idims = 1
+ else if ( tpfield%ndims == 1 ) then
+ idims = 2
+ else
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_create_nc4', Trim( tpfile%cname ) // ': ' &
+ // Trim( tpfield%cmnhname ) // ': ndims value not supported for character strings' )
+ end if
+
+ Allocate( ivdims(idims) )
+ ivdims(1) = IO_Strdimid_get_nc4( tpfile, Int( kshape(1), kind=CDFINT ) )
+
+ if ( idims == 2 ) then
+ call IO_Vdims_fill_nc4( tpfile, tpfield, [ Int( kshape(2), kind=CDFINT ) ], ivdimstmp )
+ ivdims(2) = ivdimstmp(1)
+ Deallocate( ivdimstmp )
+ end if
+ end if
+end if
+
+if ( Present( oisempty ) ) oisempty = .false.
+do ji = 1, Size( ishape )
+ if ( ishape(ji) == 0 ) then
+ if ( Present( oisempty ) ) then
+ call Print_msg( NVERB_WARNING, 'IO', 'IO_Field_create_nc4','ignoring variable with a zero size (' // Trim( yvarname ) // ')' )
+ oisempty = .true.
+ return
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_create_nc4','variable with a zero size (' // Trim( yvarname ) // ')' )
+ end if
+ end if
+end do
+
+! The variable should not already exist but who knows ?
+istatus = NF90_INQ_VARID( tpfile%nncid, yvarname, ivarid )
+if ( istatus /= NF90_NOERR ) then
+ select case( tpfield%ntype )
+ case ( TYPEINT )
+ itype = MNHINT_NF90
+
+ case ( TYPELOG )
+ itype = NF90_INT1
+
+ case ( TYPEREAL )
+ if ( tpfile%lncreduce_float_precision .and. tpfield%ndims >= 1 ) then
+ itype = NF90_FLOAT
+ else
+ itype = MNHREAL_NF90
+ end if
+
+ case ( TYPECHAR )
+ itype = NF90_CHAR
+
+ case ( TYPEDATE )
+ itype = MNHREAL_NF90
+ if ( .not. Present( hcalendar ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_create_nc4', Trim( tpfield%cmnhname ) // ': hcalendar not provided' )
+
+ case ( TYPEUNDEF )
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_create_nc4', Trim( tpfield%cmnhname ) // ': ntype is TYPEUNDEF' )
+ return
+
+ case default
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Field_create_nc4', Trim( tpfield%cmnhname ) // ': invalid ntype' )
+ return
+ end select
+
+ ! Define the variable
+ istatus = NF90_DEF_VAR( tpfile%nncid, yvarname, itype, ivdims, ivarid )
+ if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'IO_Field_create_nc4', 'NF90_DEF_VAR', Trim( yvarname ) )
+
+ ! Add compression if asked for
+ if ( tpfile%lnccompress .and. tpfield%ntype == TYPEREAL .and. tpfield%ndims >= 1 ) then
+ istatus = NF90_DEF_VAR_DEFLATE( tpfile%nncid, ivarid, SHUFFLE, DEFLATE, tpfile%nnccompress_level )
+ if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'IO_Field_create_nc4', 'NF90_DEF_VAR_DEFLATE', Trim( yvarname ) )
+ end if
+else
+ gexisted = .true.
+ call Print_msg( NVERB_WARNING, 'IO', 'IO_Field_create_nc4', Trim( tpfile%cname ) // ': ' &
+ // Trim( yvarname ) // ' already defined' )
+end if
+
+! Write metadata
+call IO_Field_attr_write_nc4( tpfile, tpfield, ivarid, gexisted, kshape = ishape, hcalendar = hcalendar, oiscoord = oiscoord )
+
+if ( Present( kvarid ) ) kvarid = ivarid
+
+end subroutine IO_Field_create_nc4
+
+
SUBROUTINE IO_Field_write_nc4_X0(TPFILE,TPFIELD,PFIELD,KRESP)
!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
@@ -349,51 +529,19 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
REAL, INTENT(IN) :: PFIELD
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_X0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-!
-GEXISTED = .FALSE.
-!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-!
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (TPFIELD%LTIMEDEP) THEN
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=CDFINT), IVDIMS)
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X0','NF90_DEF_VAR',trim(YVARNAME))
- DEALLOCATE(IVDIMS)
- ELSE
- ! Define the scalar variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X0','NF90_DEF_VAR',trim(YVARNAME))
- END IF
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+KRESP = 0
+
+call IO_Field_create_nc4( tpfile, tpfield, kvarid = ivarid )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED)
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, PFIELD)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_X0','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_X0
@@ -404,153 +552,58 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
REAL,DIMENSION(:), INTENT(IN) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)+4) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_X1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-!
-GEXISTED = .FALSE.
+KRESP = 0
!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (SIZE(PFIELD)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X1','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
- KRESP = 0
- RETURN
- END IF
-
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=CDFINT), IVDIMS)
-
- ! Define the variable
- IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
- ELSE
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
- END IF
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X1','NF90_DEF_VAR',trim(YVARNAME))
- ! Add compression if asked for
- IF (TPFILE%LNCCOMPRESS) THEN
- STATUS = NF90_DEF_VAR_DEFLATE(INCID, IVARID, SHUFFLE, DEFLATE, TPFILE%NNCCOMPRESS_LEVEL)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X1','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
- END IF
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tpfile, tpfield, kshape = Shape( pfield ), kvarid = ivarid, oisempty = gisempty )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED)
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X1','NF90_PUT_VAR',trim(YVARNAME),IRESP)
-
-IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_X1','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_X1
SUBROUTINE IO_Field_write_nc4_X2(TPFILE,TPFIELD,PFIELD,KRESP,KVERTLEVEL,KZFILE,OISCOORD)
!
-TYPE(TFILEDATA),TARGET,INTENT(IN) :: TPFILE
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
REAL,DIMENSION(:,:), INTENT(IN) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT):: KRESP
-INTEGER,OPTIONAL, INTENT(IN) :: KVERTLEVEL ! Number of the vertical level (needed for Z-level splitted files)
-INTEGER,OPTIONAL, INTENT(IN) :: KZFILE ! Number of the Z-level splitted file
+INTEGER,OPTIONAL, INTENT(IN) :: KVERTLEVEL ! Number of the vertical level (needed for Z-level split files)
+INTEGER,OPTIONAL, INTENT(IN) :: KZFILE ! Number of the Z-level split file
LOGICAL,OPTIONAL, INTENT(IN) :: OISCOORD ! Is a coordinate variable (->do not write coordinates attribute)
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=4) :: YSUFFIX
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)+4) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-TYPE(TFIELDDATA) :: TZFIELD
-TYPE(TFILEDATA),POINTER :: TZFILE
-LOGICAL :: GEXISTED !True if variable was already defined
-!
-IRESP = 0
-!
-IF (PRESENT(KVERTLEVEL)) THEN
- WRITE(YSUFFIX,'(I4.4)') KVERTLEVEL
- IF (.NOT.PRESENT(KZFILE)) THEN
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_nc4_X2','KZFILE argument not provided')
- RETURN
- END IF
- IF (KZFILE>TPFILE%NSUBFILES_IOZ) CALL PRINT_MSG(NVERB_FATAL,'IO','IO_Field_write_nc4_X2','KZFILE value too high')
- TZFILE => TPFILE%TFILES_IOZ(KZFILE)%TFILE
- TZFIELD = TPFIELD
- TZFIELD%CMNHNAME = TRIM(TZFIELD%CMNHNAME)//YSUFFIX
- IF (LEN_TRIM(TZFIELD%CSTDNAME)>0) TZFIELD%CSTDNAME = TRIM(TZFIELD%CSTDNAME)//'_at_level_'//YSUFFIX
- IF (LEN_TRIM(TZFIELD%CLONGNAME)>0) TZFIELD%CLONGNAME = TRIM(TZFIELD%CLONGNAME)//' at level '//YSUFFIX
- TZFIELD%NDIMS = 2
-ELSE
- TZFILE => TPFILE
- TZFIELD = TPFIELD
-ENDIF
+INTEGER(KIND=CDFINT) :: istatus
+CHARACTER(LEN=4) :: YSUFFIX
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
+TYPE(TFIELDDATA), pointer :: TZFIELD
+TYPE(TFILEDATA), POINTER :: TZFILE
!
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_X2',TRIM(TZFILE%CNAME)//': writing '//TRIM(TZFIELD%CMNHNAME))
+KRESP = 0
!
-! Get the Netcdf file ID
-INCID = TZFILE%NNCID
+call IO_Select_split_file( tpfile, tpfield, tzfile, tzfield, kvertlevel, kzfile )
!
-GEXISTED = .FALSE.
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_X2',TRIM(TZFILE%CNAME)//': writing '//TRIM(TZFIELD%CMNHNAME))
!
-CALL IO_Mnhname_clean(TZFIELD%CMNHNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (SIZE(PFIELD)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X2','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
- KRESP = 0
- RETURN
- END IF
-
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TZFILE, TZFIELD, INT(SHAPE(PFIELD),KIND=CDFINT), IVDIMS)
-
- ! Define the variable
- IF (TZFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
- ELSE
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
- END IF
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X2','NF90_DEF_VAR',trim(YVARNAME))
- ! Add compression if asked for
- IF (TZFILE%LNCCOMPRESS) THEN
- STATUS = NF90_DEF_VAR_DEFLATE(INCID, IVARID, SHUFFLE, DEFLATE, TZFILE%NNCCOMPRESS_LEVEL)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X2','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
- END IF
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X2',TRIM(TZFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tzfile, tzfield, kshape = Shape( pfield ), oiscoord = oiscoord, kvarid = ivarid, oisempty = gisempty )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TZFILE,TZFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(PFIELD),KIND=CDFINT),OISCOORD=OISCOORD)
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X2','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TZFILE%NNCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_X2','NF90_PUT_VAR',trim(TZFIELD%CMNHNAME),KRESP)
+end if
-IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
+if ( Present( kvertlevel ) ) deallocate( tzfield )
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_X2
@@ -561,64 +614,22 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
REAL,DIMENSION(:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
-!
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_X3',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+KRESP = 0
!
-GEXISTED = .FALSE.
-!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (SIZE(PFIELD)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X3','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
- KRESP = 0
- RETURN
- END IF
-
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=CDFINT), IVDIMS)
-
- ! Define the variable
- IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
- ELSE
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
- END IF
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X3','NF90_DEF_VAR',trim(YVARNAME))
-
- ! Add compression if asked for
- IF (TPFILE%LNCCOMPRESS) THEN
- STATUS = NF90_DEF_VAR_DEFLATE(INCID, IVARID, SHUFFLE, DEFLATE, TPFILE%NNCCOMPRESS_LEVEL)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X3','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
- END IF
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tpfile, tpfield, kshape = Shape( pfield ), kvarid = ivarid, oisempty = gisempty )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(PFIELD),KIND=CDFINT))
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X3','NF90_PUT_VAR',trim(YVARNAME),IRESP)
-
-IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_X3','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_X3
@@ -629,64 +640,22 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
REAL,DIMENSION(:,:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
-!
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_X4',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+KRESP = 0
!
-GEXISTED = .FALSE.
-!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (SIZE(PFIELD)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X4','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
- KRESP = 0
- RETURN
- END IF
-
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=CDFINT), IVDIMS)
-
- ! Define the variable
- IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
- ELSE
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
- END IF
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X4','NF90_DEF_VAR',trim(YVARNAME))
-
- ! Add compression if asked for
- IF (TPFILE%LNCCOMPRESS) THEN
- STATUS = NF90_DEF_VAR_DEFLATE(INCID, IVARID, SHUFFLE, DEFLATE, TPFILE%NNCCOMPRESS_LEVEL)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X4','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
- END IF
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X4',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tpfile, tpfield, kshape = Shape( pfield ), kvarid = ivarid, oisempty = gisempty )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(PFIELD),KIND=CDFINT))
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X4','NF90_PUT_VAR',trim(YVARNAME),IRESP)
-
-IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_X4','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_X4
@@ -697,64 +666,22 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
REAL,DIMENSION(:,:,:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
-!
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_X5',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+KRESP = 0
!
-GEXISTED = .FALSE.
-!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (SIZE(PFIELD)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X5','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
- KRESP = 0
- RETURN
- END IF
-
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=CDFINT), IVDIMS)
-
- ! Define the variable
- IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
- ELSE
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
- END IF
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X5','NF90_DEF_VAR',trim(YVARNAME))
-
- ! Add compression if asked for
- IF (TPFILE%LNCCOMPRESS) THEN
- STATUS = NF90_DEF_VAR_DEFLATE(INCID, IVARID, SHUFFLE, DEFLATE, TPFILE%NNCCOMPRESS_LEVEL)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X5','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
- END IF
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X5',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tpfile, tpfield, kshape = Shape( pfield ), kvarid = ivarid, oisempty = gisempty )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(PFIELD),KIND=CDFINT))
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X5','NF90_PUT_VAR',trim(YVARNAME),IRESP)
-
-IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_X5','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_X5
@@ -765,73 +692,33 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PFIELD ! array containing the data field
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
-!
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_X6',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+KRESP = 0
!
-GEXISTED = .FALSE.
-!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (SIZE(PFIELD)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X6','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
- KRESP = 0
- RETURN
- END IF
-
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(PFIELD),KIND=CDFINT), IVDIMS)
-
- ! Define the variable
- IF (TPFILE%LNCREDUCE_FLOAT_PRECISION) THEN
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_FLOAT, IVDIMS, IVARID)
- ELSE
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIMS, IVARID)
- END IF
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X6','NF90_DEF_VAR',trim(YVARNAME))
-
- ! Add compression if asked for
- IF (TPFILE%LNCCOMPRESS) THEN
- STATUS = NF90_DEF_VAR_DEFLATE(INCID, IVARID, SHUFFLE, DEFLATE, TPFILE%NNCCOMPRESS_LEVEL)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X6','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
- END IF
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_X6',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tpfile, tpfield, kshape = Shape( pfield ), kvarid = ivarid, oisempty = gisempty )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(PFIELD),KIND=CDFINT))
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, PFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_X6','NF90_PUT_VAR',trim(YVARNAME),IRESP)
-
-IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, PFIELD)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_X6','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_X6
SUBROUTINE IO_Field_write_nc4_N0(TPFILE,TPFIELD,KFIELD,KRESP)
!
#if 0
-USE MODD_IO, ONLY: LPACK,L1D,L2D
+use modd_field, only: NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_LEVEL
+USE MODD_IO, ONLY: LPACK, L2D
USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
#else
+use modd_field, only: NMNHDIM_LEVEL
USE MODD_PARAMETERS_ll, ONLY: JPVEXT
#endif
!
@@ -840,78 +727,46 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
INTEGER, INTENT(IN) :: KFIELD
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
-TYPE(IOCDF), POINTER :: TZIOCDF
+integer :: iidx
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_N0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-!
-GEXISTED = .FALSE.
+KRESP = 0
!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-!
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (TPFIELD%LTIMEDEP) THEN
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=CDFINT), IVDIMS)
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHINT_NF90, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N0','NF90_DEF_VAR',trim(YVARNAME))
- DEALLOCATE(IVDIMS)
- ELSE
- ! Define the scalar variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHINT_NF90, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N0','NF90_DEF_VAR',trim(YVARNAME))
- END IF
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_N0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tpfile, tpfield, kvarid = ivarid )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED)
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, KFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
-
+istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, KFIELD)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_N0','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
!
! Use IMAX, JMAX, KMAX to define DIM_NI, DIM_NJ, DIM_LEVEL
! /!\ Can only work if IMAX, JMAX or KMAX are written before any array
!
#if 0
-IF (YVARNAME == 'IMAX' .AND. .NOT. ASSOCIATED(TPFILE%TNCDIMS%DIM_NI)) TPFILE%TNCDIMS%DIM_NI=>IO_Dimcdf_get_nc4(TPFILE%TNCDIMS,KFIELD+2*JPHEXT,'X')
-IF (YVARNAME == 'JMAX' .AND. .NOT. ASSOCIATED(TPFILE%TNCDIMS%DIM_NJ)) THEN
- IF (LPACK .AND. L2D) THEN
- TPFILE%TNCDIMS%DIM_NJ=>IO_Dimcdf_get_nc4(TPFILE, 1,'Y')
- ELSE
- TPFILE%TNCDIMS%DIM_NJ=>IO_Dimcdf_get_nc4(TPFILE, KFIELD+2*JPHEXT, 'Y')
- END IF
-END IF
+if ( tpfield%cmnhname == 'IMAX' .and. tpfile%tncdims%tdims(NMNHDIM_NI)%nid == -1 ) then
+ call IO_Dim_find_create_nc4( tpfile, kfield + 2 * jphext, iidx, 'X' )
+end if
+if ( tpfield%cmnhname == 'JMAX' .and. tpfile%tncdims%tdims(NMNHDIM_NJ)%nid == -1 ) then
+ if ( lpack .and. l2d ) then
+ call IO_Dim_find_create_nc4( tpfile, 1, iidx, 'Y' )
+ else
+ call IO_Dim_find_create_nc4( tpfile, kfield + 2 * jphext, iidx, 'Z' )
+ end if
+end if
#endif
-IF (YVARNAME == 'KMAX' .AND. .NOT. ASSOCIATED(TPFILE%TNCDIMS%DIM_LEVEL)) THEN
- TZIOCDF => TPFILE%TNCDIMS
- TZIOCDF%DIM_LEVEL=>IO_Dimcdf_get_nc4(TPFILE,INT(KFIELD+2*JPVEXT,KIND=CDFINT),'Z')
-END IF
+if ( tpfield%cmnhname == 'KMAX' .and. tpfile%tncdims%tdims(NMNHDIM_LEVEL)%nid == -1 ) then
+ call IO_Dim_find_create_nc4( tpfile, Int( kfield + 2 * JPVEXT, kind = CDFINT ), iidx, 'Z' )
+end if
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_N0
SUBROUTINE IO_Field_write_nc4_N1(TPFILE,TPFIELD,KFIELD,KRESP)
!
#if 0
-USE MODD_IO, ONLY: LPACK,L1D,L2D
+USE MODD_IO, ONLY: LPACK, L2D
USE MODD_PARAMETERS_ll, ONLY: JPHEXT, JPVEXT
#else
USE MODD_PARAMETERS_ll, ONLY: JPVEXT
@@ -922,53 +777,22 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
INTEGER, DIMENSION(:), INTENT(IN) :: KFIELD
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_N1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+KRESP = 0
!
-GEXISTED = .FALSE.
-!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (SIZE(KFIELD)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_N1','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
- KRESP = 0
- RETURN
- END IF
-
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=CDFINT), IVDIMS)
-
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHINT_NF90, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N1','NF90_DEF_VAR',trim(YVARNAME))
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_N1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tpfile, tpfield, kshape = Shape( kfield ), kvarid = ivarid, oisempty = gisempty )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED)
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, KFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N1','NF90_PUT_VAR',trim(YVARNAME),IRESP)
-
-IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, KFIELD)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_N1','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_N1
@@ -979,61 +803,25 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
INTEGER,DIMENSION(:,:),INTENT(IN) :: KFIELD ! array containing the data field
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
-!
-IRESP = 0
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_N2',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+KRESP = 0
!
-GEXISTED = .FALSE.
-!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (SIZE(KFIELD)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_N2','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
- KRESP = 0
- RETURN
- END IF
-
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=CDFINT), IVDIMS)
-
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHINT_NF90, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N2','NF90_DEF_VAR',trim(YVARNAME))
- ! Add compression if asked for
- IF (TPFILE%LNCCOMPRESS) THEN
- STATUS = NF90_DEF_VAR_DEFLATE(INCID, IVARID, SHUFFLE, DEFLATE, TPFILE%NNCCOMPRESS_LEVEL)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N2','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
- END IF
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_N2',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tpfile, tpfield, kshape = Shape( kfield ), kvarid = ivarid, oisempty = gisempty )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(KFIELD),KIND=CDFINT))
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, KFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N2','NF90_PUT_VAR',trim(YVARNAME),IRESP)
-
-IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, KFIELD)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_N2','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_N2
+
SUBROUTINE IO_Field_write_nc4_N3(TPFILE,TPFIELD,KFIELD,KRESP)
!
TYPE(TFILEDATA),TARGET, INTENT(IN) :: TPFILE
@@ -1041,110 +829,67 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
INTEGER,DIMENSION(:,:,:),INTENT(IN) :: KFIELD ! array containing the data field
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
-!
-IRESP = 0
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_N3',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-!
-GEXISTED = .FALSE.
+KRESP = 0
!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
+call IO_Field_create_nc4( tpfile, tpfield, kshape = Shape( kfield ), kvarid = ivarid, oisempty = gisempty )
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (SIZE(KFIELD)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_N3','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
- KRESP = 0
- RETURN
- END IF
-
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(KFIELD),KIND=CDFINT), IVDIMS)
-
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHINT_NF90, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N3','NF90_DEF_VAR',trim(YVARNAME))
- ! Add compression if asked for
- IF (TPFILE%LNCCOMPRESS) THEN
- STATUS = NF90_DEF_VAR_DEFLATE(INCID, IVARID, SHUFFLE, DEFLATE, TPFILE%NNCCOMPRESS_LEVEL)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N3','NF90_DEF_VAR_DEFLATE',trim(YVARNAME))
- END IF
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_N3',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+! Write the data
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, KFIELD)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_N3','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
+
+END SUBROUTINE IO_Field_write_nc4_N3
+
+
+SUBROUTINE IO_Field_write_nc4_N4(TPFILE,TPFIELD,KFIELD,KRESP)
+!
+TYPE(TFILEDATA),TARGET, INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+INTEGER,DIMENSION(:,:,:,:),INTENT(IN) :: KFIELD ! array containing the data field
+INTEGER, INTENT(OUT):: KRESP
+!
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_N4',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+!
+KRESP = 0
+!
+call IO_Field_create_nc4( tpfile, tpfield, kshape = Shape( kfield ), kvarid = ivarid, oisempty = gisempty )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED,KSHAPE=INT(SHAPE(KFIELD),KIND=CDFINT))
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, KFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_N3','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, KFIELD)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_N4','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
-IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
+END SUBROUTINE IO_Field_write_nc4_N4
-KRESP = IRESP
-END SUBROUTINE IO_Field_write_nc4_N3
SUBROUTINE IO_Field_write_nc4_L0(TPFILE,TPFIELD,OFIELD,KRESP)
!
-USE MODD_PARAMETERS_ll, ONLY: JPVEXT
-!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
LOGICAL, INTENT(IN) :: OFIELD
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER :: IFIELD
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+INTEGER :: IFIELD
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_L0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-!
-GEXISTED = .FALSE.
-!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
+KRESP = 0
!
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (TPFIELD%LTIMEDEP) THEN
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(OFIELD),KIND=CDFINT), IVDIMS)
- ! Define the variable
- ! Use of NF90_INT1 datatype (=NF90_BYTE) that is enough to store a boolean
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT1, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_L0','NF90_DEF_VAR',trim(YVARNAME))
- DEALLOCATE(IVDIMS)
- ELSE
- ! Define the scalar variable
- ! Use of NF90_INT1 datatype (=NF90_BYTE) that is enough to store a boolean
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT1, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_L0','NF90_DEF_VAR',trim(YVARNAME))
- END IF
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_L0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tpfile, tpfield, kvarid = ivarid )
!Convert LOGICAL to INTEGER (LOGICAL format not supported by netCDF files)
IF (OFIELD) THEN
@@ -1153,63 +898,30 @@ ELSE
IFIELD = 0
END IF
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED)
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, IFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_L0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, IFIELD)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_L0','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_L0
+
SUBROUTINE IO_Field_write_nc4_L1(TPFILE,TPFIELD,OFIELD,KRESP)
!
-USE MODD_PARAMETERS_ll, ONLY: JPVEXT
-!
TYPE(TFILEDATA), INTENT(IN) :: TPFILE
TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
LOGICAL, DIMENSION(:), INTENT(IN) :: OFIELD
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMS
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+INTEGER, DIMENSION(SIZE(OFIELD)) :: IFIELD
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_L1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-!
-GEXISTED = .FALSE.
+KRESP = 0
!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- IF (SIZE(OFIELD)==0) THEN
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_L1','ignoring variable with a zero size ('//TRIM(YVARNAME)//')')
- KRESP = 0
- RETURN
- END IF
-
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(OFIELD),KIND=CDFINT), IVDIMS)
-
- ! Define the variable
- ! Use of NF90_INT1 datatype (=NF90_BYTE) that is enough to store a boolean
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_INT1, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_L1','NF90_DEF_VAR',trim(YVARNAME))
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_L1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tpfile, tpfield, kshape = Shape( ofield ), kvarid = ivarid, oisempty = gisempty )
!Convert LOGICAL to INTEGER (LOGICAL format not supported by netCDF files)
WHERE (OFIELD)
@@ -1218,15 +930,12 @@ ELSEWHERE
IFIELD = 0
END WHERE
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED)
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, IFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_L1','NF90_PUT_VAR',trim(YVARNAME),IRESP)
-
-IF(ALLOCATED(IVDIMS)) DEALLOCATE(IVDIMS)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, IFIELD)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_L1','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_L1
@@ -1237,61 +946,35 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
CHARACTER(LEN=*), INTENT(IN) :: HFIELD
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(1) :: IVDIMS
-INTEGER :: IRESP, ILEN
-CHARACTER(LEN=:),ALLOCATABLE :: YFIELD
-LOGICAL :: GEXISTED !True if variable was already defined
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER :: ILEN
+CHARACTER(LEN=:), ALLOCATABLE :: YFIELD
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_C0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
+KRESP = 0
+
!Store the character string in a string of a size multiple of NSTRINGCHUNKSIZE
!This is done to limit the number of dimensions in the netCDF file
ILEN = ((LEN_TRIM(HFIELD)+NSTRINGCHUNKSIZE-1)/NSTRINGCHUNKSIZE)*NSTRINGCHUNKSIZE
!If the string is empty, create it anyway with a non-zero size (to prevent problems later)
IF (ILEN==0) ILEN = NSTRINGCHUNKSIZE
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-!
-GEXISTED = .FALSE.
-!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-!
-IF (TPFIELD%LTIMEDEP) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_C0',TRIM(TPFILE%CNAME)// &
- ': time dependent variable not (yet) possible for 0D variable '//TRIM(TPFIELD%CMNHNAME))
-!
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf string dimensions id
- IVDIMS(1) = IO_Strdimid_get_nc4(TPFILE,INT(ILEN,KIND=CDFINT))
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_CHAR, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_C0','NF90_DEF_VAR',trim(YVARNAME))
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_C0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+!PW: si ndimlist populated, pas besoin de passer kshape...
+call IO_Field_create_nc4( tpfile, tpfield, kshape = [ ilen ], kvarid = ivarid )
ALLOCATE(CHARACTER(LEN=ILEN)::YFIELD)
YFIELD(1:LEN_TRIM(HFIELD))=TRIM(HFIELD)
YFIELD(LEN_TRIM(HFIELD)+1:)=' '
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED)
+
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, YFIELD)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_C0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
-DEALLOCATE(YFIELD)
+istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, YFIELD)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_C0','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_C0
+
SUBROUTINE IO_Field_write_nc4_C1(TPFILE,TPFIELD,HFIELD,KRESP)
! Modif
! J.Escobar : 25/04/2018 : missing 'IF ALLOCATED(IVDIMSTMP)' DEALLOCATE
@@ -1303,61 +986,26 @@ INTEGER, INTENT(OUT) :: KRESP
!
INTEGER(KIND=CDFINT),PARAMETER :: IONE = 1
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(2) :: IVDIMS
-INTEGER(KIND=CDFINT), DIMENSION(:), ALLOCATABLE :: IVDIMSTMP
-INTEGER(KIND=CDFINT) :: ILEN, ISIZE
-INTEGER :: IRESP
-LOGICAL :: GEXISTED !True if variable was already defined
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+INTEGER(KIND=CDFINT) :: ILEN, ISIZE
+logical :: gisempty
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_C1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
+KRESP = 0
ILEN = LEN(HFIELD)
ISIZE = SIZE(HFIELD)
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-!
-GEXISTED = .FALSE.
-!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-!
-IF (TPFIELD%LTIMEDEP) THEN
- !This is an error (+return) and not a warning because IVDIMSTMP could be of size 2 if LTIMEDEP=T
- CALL PRINT_MSG(NVERB_ERROR,'IO','IO_Field_write_nc4_C1',TRIM(TPFILE%CNAME)// &
- ': time dependent variable not (yet) possible for '//TRIM(TPFIELD%CMNHNAME))
- RETURN
-END IF
-!
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf string dimensions id
- IVDIMS(1) = IO_Strdimid_get_nc4(TPFILE,ILEN)
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, (/ISIZE/), IVDIMSTMP)
- IVDIMS(2) = IVDIMSTMP(1)
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, NF90_CHAR, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_C1','NF90_DEF_VAR',trim(YVARNAME))
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_C1',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
+call IO_Field_create_nc4( tpfile, tpfield, kshape = Int ([ ilen, isize ], kind = Kind( 1 ) ), kvarid = ivarid, oisempty = gisempty )
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TPFIELD,IVARID,GEXISTED)
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, HFIELD(1:ISIZE)(1:ILEN), START=(/IONE,IONE/), COUNT=(/ILEN,ISIZE/))
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_C1','NF90_PUT_VAR',trim(YVARNAME),IRESP)
-
-IF(ALLOCATED(IVDIMSTMP)) DEALLOCATE(IVDIMSTMP)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, HFIELD(1:ISIZE)(1:ILEN), START=(/IONE,IONE/), COUNT=(/ILEN,ISIZE/))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_C1','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
-KRESP = IRESP
END SUBROUTINE IO_Field_write_nc4_C1
@@ -1373,452 +1021,1063 @@ TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
TYPE (DATE_TIME), INTENT(IN) :: TPDATA
INTEGER, INTENT(OUT):: KRESP
!
-INTEGER(KIND=CDFINT) :: STATUS
-INTEGER(KIND=CDFINT) :: INCID
-CHARACTER(LEN=LEN(TPFIELD%CMNHNAME)) :: YVARNAME
-INTEGER(KIND=CDFINT) :: IVARID
-INTEGER(KIND=CDFINT), DIMENSION(1) :: IVDIMS
-INTEGER :: IRESP
-TYPE(TFIELDDATA) :: TZFIELD
-CHARACTER(LEN=40) :: YUNITS
-LOGICAL :: GEXISTED !True if variable was already defined
-REAL :: ZDELTATIME !Distance in seconds since reference date and time
-TYPE(DATE_TIME) :: TZREF
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+TYPE(TFIELDDATA) :: TZFIELD
+CHARACTER(LEN=40) :: YUNITS
+REAL :: ZDELTATIME !Distance in seconds since reference date and time
+TYPE(DATE_TIME) :: TZREF
!
CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_T0',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
!
-IRESP = 0
+KRESP = 0
!
TZFIELD = TPFIELD
!
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
-!
-GEXISTED = .FALSE.
-!
-CALL IO_Mnhname_clean(TPFIELD%CMNHNAME,YVARNAME)
-!
-TZFIELD%CMNHNAME = TRIM(YVARNAME)
-!
! Model beginning date (TDTMOD%TDATE) is used as the reference date
! Reference time is set to 0.
IF (.NOT.ASSOCIATED(TDTMOD)) THEN
CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_T0',TRIM(TPFILE%CNAME)// &
': '//TRIM(TZFIELD%CMNHNAME)//': DTMOD is not associated and not known. Reference date set to 2000/01/01')
- TZREF%TDATE%YEAR = 2000
- TZREF%TDATE%MONTH = 1
- TZREF%TDATE%DAY = 1
- TZREF%TIME = 0.
+ TZREF%nyear = 2000
+ TZREF%nmonth = 1
+ TZREF%nday = 1
+ TZREF%xtime = 0.
ELSE
TZREF = TDTMOD
- TZREF%TIME = 0.
+ TZREF%xtime = 0.
END IF
WRITE(YUNITS,'( "seconds since ",I4.4,"-",I2.2,"-",I2.2," 00:00:00 +0:00" )') &
- TZREF%TDATE%YEAR, TZREF%TDATE%MONTH, TZREF%TDATE%DAY
+ TZREF%nyear, TZREF%nmonth, TZREF%nday
TZFIELD%CUNITS = TRIM(YUNITS)
!
-IF (TPFIELD%LTIMEDEP) &
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_T0',TRIM(TPFILE%CNAME)// &
- ': time dependent variable not (yet) possible for 0D variable '//TRIM(TPFIELD%CMNHNAME))
-!
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Define the scalar variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_T0','NF90_DEF_VAR',trim(YVARNAME))
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(YVARNAME)//' already defined')
-END IF
-
-! Write metadata
-CALL IO_Field_attr_write_nc4(TPFILE,TZFIELD,IVARID,GEXISTED,HCALENDAR='standard')
+call IO_Field_create_nc4( tpfile, tzfield, kvarid = ivarid, hcalendar = 'standard' )
!
! Compute the temporal distance from reference
CALL DATETIME_DISTANCE(TZREF,TPDATA,ZDELTATIME)
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, ZDELTATIME)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_T0','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+istatus = NF90_PUT_VAR(TPFILE%NNCID, IVARID, ZDELTATIME)
+IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_T0','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
-IF (IRESP/=0) THEN
- KRESP = IRESP
- RETURN
-END IF
+END SUBROUTINE IO_Field_write_nc4_T0
-#if 0
-!This part is to keep backward compatibility with MesoNH files
-!but date/time is not conform to CF convention
+
+SUBROUTINE IO_Field_write_nc4_T1(TPFILE,TPFIELD,TPDATA,KRESP)
!
-! Write date
+USE MODD_TIME_n, ONLY: TDTMOD
+USE MODD_TYPE_DATE
!
-TZFIELD%CMNHNAME = TRIM(YVARNAME)//'__TDATE'
-TZFIELD%CLONGNAME = TRIM(TPFIELD%CLONGNAME)//'%TDATE'
-TZFIELD%CUNITS = ''
-TZFIELD%CCOMMENT = 'YYYYMMDD'
-
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, TZFIELD%CMNHNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Get the netcdf dimensions
- CALL IO_Vdims_fill_nc4(TPFILE, TPFIELD, INT(SHAPE(ITDATE),KIND=CDFINT), IVDIMS)
-
- ! Define the variable
- STATUS = NF90_DEF_VAR(INCID, TZFIELD%CMNHNAME, NF90_INT, IVDIMS, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_T0','NF90_DEF_VAR',trim(TZFIELD%CMNHNAME))
- CALL IO_Field_attr_write_nc4(TPFILE,TZFIELD,IVARID,GEXISTED)
+USE MODE_DATETIME
+!
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE
+TYPE(TFIELDDATA), INTENT(IN) :: TPFIELD
+TYPE (DATE_TIME), DIMENSION(:), INTENT(IN) :: TPDATA
+INTEGER, INTENT(OUT):: KRESP
+!
+CHARACTER(LEN=40) :: YUNITS
+INTEGER :: JI
+INTEGER(KIND=CDFINT) :: istatus
+INTEGER(KIND=CDFINT) :: IVARID
+logical :: gisempty
+REAL, DIMENSION(:), ALLOCATABLE :: ZDELTATIME !Distance in seconds since reference date and time
+TYPE(DATE_TIME) :: TZREF
+TYPE(TFIELDDATA) :: TZFIELD
+!
+CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Field_write_nc4_T1',TRIM(TPFILE%CNAME)//': writing '//TRIM(TPFIELD%CMNHNAME))
+!
+KRESP = 0
+!
+TZFIELD = TPFIELD
+!
+! Model beginning date (TDTMOD%TDATE) is used as the reference date
+! Reference time is set to 0.
+IF (.NOT.ASSOCIATED(TDTMOD)) THEN
+ CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_T1',TRIM(TPFILE%CNAME)// &
+ ': '//TRIM(TZFIELD%CMNHNAME)//': DTMOD is not associated and not known. Reference date set to 2000/01/01')
+ TZREF%nyear = 2000
+ TZREF%nmonth = 1
+ TZREF%nday = 1
+ TZREF%xtime = 0.
ELSE
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(TZFIELD%CMNHNAME)//' already defined')
+ TZREF = TDTMOD
+ TZREF%xtime = 0.
END IF
+WRITE(YUNITS,'( "seconds since ",I4.4,"-",I2.2,"-",I2.2," 00:00:00 +0:00" )') &
+ TZREF%nyear, TZREF%nmonth, TZREF%nday
+TZFIELD%CUNITS = TRIM(YUNITS)
+!
+call IO_Field_create_nc4( tpfile, tzfield, kshape = Shape( tpdata), kvarid = ivarid, hcalendar = 'standard', oisempty = gisempty )
+!
+! Compute the temporal distances from reference
+ALLOCATE( ZDELTATIME( SIZE( TPDATA ) ) )
+
+DO JI = 1, SIZE( TPDATA )
+ CALL DATETIME_DISTANCE( TZREF, TPDATA(JI ), ZDELTATIME(JI) )
+END DO
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, ITDATE)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_T0','NF90_PUT_VAR',trim(TZFIELD%CMNHNAME),IRESP)
+if ( .not. gisempty ) then
+ istatus = NF90_PUT_VAR( TPFILE%NNCID, IVARID, ZDELTATIME(:) )
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_Field_write_nc4_T1','NF90_PUT_VAR',trim(TPFIELD%CMNHNAME),KRESP)
+end if
-IF (IRESP/=0) THEN
- KRESP = IRESP
- RETURN
-END IF
-!
-! Write time
-!
-TZFIELD%CMNHNAME = TRIM(YVARNAME)//'__TIME'
-TZFIELD%CLONGNAME = TRIM(TPFIELD%CLONGNAME)//'%TIME'
-TZFIELD%CUNITS = 's'
-TZFIELD%CCOMMENT = 'SECONDS'
+END SUBROUTINE IO_Field_write_nc4_T1
-! The variable should not already exist but who knows ?
-STATUS = NF90_INQ_VARID(INCID, TZFIELD%CMNHNAME, IVARID)
-IF (STATUS /= NF90_NOERR) THEN
- ! Define the scalar variable
- STATUS = NF90_DEF_VAR(INCID, TZFIELD%CMNHNAME, MNHREAL_NF90, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_T0','NF90_DEF_VAR',trim(TZFIELD%CMNHNAME))
- CALL IO_Field_attr_write_nc4(TPFILE,TZFIELD,IVARID,GEXISTED)
-ELSE
- GEXISTED = .TRUE.
- CALL PRINT_MSG(NVERB_WARNING,'IO','IO_Field_write_nc4_T0',TRIM(TPFILE%CNAME)//': '//TRIM(TZFIELD%CMNHNAME)//' already defined')
-END IF
+
+subroutine IO_Field_partial_write_nc4_X1( tpfile, tpfield, pfield, koffset, kresp )
+
+type(tfiledata), intent(in) :: tpfile
+type(tfielddata), intent(in) :: tpfield
+real, dimension(:), intent(in) :: pfield ! array containing the data field
+integer, dimension(1), intent(in) :: koffset
+integer, intent(out) :: kresp
+
+character(len=NMNHNAMELGTMAX) :: yvarname
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: ivarid
+integer(kind=CDFINT), dimension(1) :: istarts
+
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_Field_partial_write_nc4_X1',&
+ Trim( tpfile%cname ) // ': writing ' // Trim( tpfield%cmnhname ) )
+
+kresp = 0
+
+call IO_Mnhname_clean( tpfield%cmnhname, yvarname )
+
+istatus = NF90_INQ_VARID( tpfile%nncid, yvarname, ivarid )
+if ( istatus /= NF90_NOERR ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_partial_write_nc4_X1', 'variable ' // Trim( yvarname ) &
+ // ' not yet created (IO_Field_create not yet called?)' )
+end if
! Write the data
-STATUS = NF90_PUT_VAR(INCID, IVARID, TPDATA%TIME)
-IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'IO_Field_write_nc4_T0','NF90_PUT_VAR',trim(TZFIELD%CMNHNAME),IRESP)
-#endif
+if ( Size( pfield ) > 0 ) then
+ istarts(:) = koffset(:) + 1
+ istatus = NF90_PUT_VAR( tpfile%nncid, ivarid, pfield(:), start = istarts(:), count = Int( Shape( pfield ), kind = CDFINT ) )
+ if (istatus /= NF90_NOERR) &
+ call IO_Err_handle_nc4( istatus, 'IO_Field_partial_write_nc4_X1', 'NF90_PUT_VAR', Trim( tpfield%cmnhname ), kresp )
+end if
-KRESP = IRESP
-END SUBROUTINE IO_Field_write_nc4_T0
+end subroutine IO_Field_partial_write_nc4_X1
-SUBROUTINE IO_Coordvar_write_nc4(TPFILE,HPROGRAM_ORIG)
-USE MODD_CONF, ONLY: CPROGRAM, LCARTESIAN
-USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
-USE MODD_GRID, ONLY: XLATORI, XLONORI
-USE MODD_GRID_n, ONLY: LSLEVE, XXHAT, XYHAT, XZHAT
-use modd_netcdf, only: dimcdf
-USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
-
-USE MODE_FIELD, ONLY: TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
-USE MODE_GRIDPROJ
-USE MODE_NEST_ll, ONLY: GET_MODEL_NUMBER_ll, GO_TOMODEL_ll
-
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE
-CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: HPROGRAM_ORIG !To emulate a file coming from this program
-
-CHARACTER(LEN=:),ALLOCATABLE :: YSTDNAMEPREFIX
-CHARACTER(LEN=:),ALLOCATABLE :: YPROGRAM
-INTEGER :: IIU, IJU, IKU
-INTEGER :: ID, IID, IRESP
-INTEGER :: IMI
-INTEGER(KIND=CDFINT) :: INCID
-LOGICAL :: GCHANGEMODEL
-LOGICAL,POINTER :: GSLEVE
-REAL,DIMENSION(:),POINTER :: ZXHAT, ZYHAT, ZZHAT
-REAL,DIMENSION(:),ALLOCATABLE :: ZXHATM, ZYHATM,ZZHATM !Coordinates at mass points in the transformed space
-REAL,DIMENSION(:,:),POINTER :: ZLAT, ZLON
-type(dimcdf), pointer :: tzdim_ni, tzdim_nj, tzdim_ni_u, tzdim_nj_u, tzdim_ni_v, tzdim_nj_v
-TYPE(IOCDF), POINTER :: PIOCDF
-
-CALL PRINT_MSG(NVERB_DEBUG,'IO','IO_Coordvar_write_nc4','called for '//TRIM(TPFILE%CNAME))
-
-ZXHAT => NULL()
-ZYHAT => NULL()
-ZZHAT => NULL()
-
-PIOCDF => TPFILE%TNCDIMS
-
-GCHANGEMODEL = .FALSE.
-
-IF (PRESENT(HPROGRAM_ORIG)) THEN
- YPROGRAM = HPROGRAM_ORIG
-ELSE
- YPROGRAM = CPROGRAM
-ENDIF
-! Get the Netcdf file ID
-INCID = TPFILE%NNCID
+subroutine IO_Field_partial_write_nc4_X2( tpfile, tpfield, pfield, koffset, kresp, kvertlevel, kzfile )
-IF (TPFILE%NMODEL>0) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('XHAT',IID,IRESP)
- ZXHAT => TFIELDLIST(IID)%TFIELD_X1D(TPFILE%NMODEL)%DATA
- CALL FIND_FIELD_ID_FROM_MNHNAME('YHAT',IID,IRESP)
- ZYHAT => TFIELDLIST(IID)%TFIELD_X1D(TPFILE%NMODEL)%DATA
- CALL FIND_FIELD_ID_FROM_MNHNAME('ZHAT',IID,IRESP)
- ZZHAT => TFIELDLIST(IID)%TFIELD_X1D(TPFILE%NMODEL)%DATA
- CALL FIND_FIELD_ID_FROM_MNHNAME('SLEVE',IID,IRESP)
- GSLEVE => TFIELDLIST(IID)%TFIELD_L0D(TPFILE%NMODEL)%DATA
- !
- CALL GET_MODEL_NUMBER_ll(IMI)
- IF (IMI/=TPFILE%NMODEL) THEN
- !This is necessary to have correct domain sizes (used by GATHER_XXFIELD)
- CALL GO_TOMODEL_ll(TPFILE%NMODEL,IRESP)
- GCHANGEMODEL = .TRUE.
- END IF
-ELSE
- ZXHAT => XXHAT
- ZYHAT => XYHAT
- ZZHAT => XZHAT
- GSLEVE => LSLEVE
-END IF
+type(tfiledata), intent(in) :: tpfile
+type(tfielddata), intent(in) :: tpfield
+real, dimension(:,:), intent(in) :: pfield ! array containing the data field
+integer, dimension(2), intent(in) :: koffset
+integer, intent(out) :: kresp
+integer, optional, intent(in) :: kvertlevel ! Number of the vertical level (needed for Z-level split files)
+integer, optional, intent(in) :: kzfile ! Number of the Z-level split file
-IIU = SIZE(ZXHAT)
-IJU = SIZE(ZYHAT)
-ALLOCATE(ZXHATM(IIU),ZYHATM(IJU))
-!ZXHATM(IIU) and ZYHATM(IJU) are correct only on some processes
-!but it is OK due to the way GATHER_XXFIELD is done
-ZXHATM(1:IIU-1) = 0.5*(ZXHAT(1:IIU-1)+ZXHAT(2:IIU))
-ZXHATM(IIU) = 2.*ZXHAT(IIU)-ZXHATM(IIU-1)
-ZYHATM(1:IJU-1) = 0.5*(ZYHAT(1:IJU-1)+ZYHAT(2:IJU))
-ZYHATM(IJU) = 2.*ZYHAT(IJU)-ZYHATM(IJU-1)
-!
-IF (LCARTESIAN) THEN
- YSTDNAMEPREFIX = 'plane'
-ELSE
- YSTDNAMEPREFIX = 'projection'
-ENDIF
+character(len=4) :: ysuffix
+character(len=NMNHNAMELGTMAX) :: yvarname
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: ivarid
+integer(kind=CDFINT), dimension(2) :: istarts
+type(tfielddata), pointer :: tzfield
+type(tfiledata), pointer :: tzfile
+
+kresp = 0
+
+call IO_Select_split_file( tpfile, tpfield, tzfile, tzfield, kvertlevel, kzfile )
+
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_Field_partial_write_nc4_X2',&
+ Trim( tzfile%cname ) // ': writing ' // Trim( tzfield%cmnhname ) )
+
+call IO_Mnhname_clean( tzfield%cmnhname, yvarname )
+
+istatus = NF90_INQ_VARID( tzfile%nncid, yvarname, ivarid )
+if ( istatus /= NF90_NOERR ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_partial_write_nc4_X2', 'variable ' // Trim( yvarname ) &
+ // ' not yet created (IO_Field_create not yet called?)' )
+end if
+
+! Write the data
+if ( Size( pfield ) > 0 ) then
+ istarts(:) = koffset(:) + 1
+ istatus = NF90_PUT_VAR( tzfile%nncid, ivarid, pfield(:,:), start = istarts(:), count = Int( Shape( pfield ), kind = CDFINT ) )
+ if (istatus /= NF90_NOERR) &
+ call IO_Err_handle_nc4( istatus, 'IO_Field_partial_write_nc4_X2', 'NF90_PUT_VAR', Trim( tzfield%cmnhname ), kresp )
+end if
+
+if ( Present( kvertlevel ) ) deallocate( tzfield )
+
+end subroutine IO_Field_partial_write_nc4_X2
+
+
+subroutine IO_Field_partial_write_nc4_X3( tpfile, tpfield, pfield, koffset, kresp )
+
+type(tfiledata), intent(in) :: tpfile
+type(tfielddata), intent(in) :: tpfield
+real, dimension(:,:,:), intent(in) :: pfield ! array containing the data field
+integer, dimension(3), intent(in) :: koffset
+integer, intent(out) :: kresp
+
+character(len=NMNHNAMELGTMAX) :: yvarname
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: ivarid
+integer(kind=CDFINT), dimension(3) :: istarts
-if(associated(piocdf)) then
-tzdim_ni => piocdf%dim_ni
-tzdim_nj => piocdf%dim_nj
-tzdim_ni_u => piocdf%dim_ni_u
-tzdim_nj_u => piocdf%dim_nj_u
-tzdim_ni_v => piocdf%dim_ni_v
-tzdim_nj_v => piocdf%dim_nj_v
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_Field_partial_write_nc4_X3',&
+ Trim( tpfile%cname ) // ': writing ' // Trim( tpfield%cmnhname ) )
+
+kresp = 0
+
+call IO_Mnhname_clean( tpfield%cmnhname, yvarname )
+
+istatus = NF90_INQ_VARID( tpfile%nncid, yvarname, ivarid )
+if ( istatus /= NF90_NOERR ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_partial_write_nc4_X3', 'variable ' // Trim( yvarname ) &
+ // ' not yet created (IO_Field_create not yet called?)' )
+end if
+
+! Write the data
+if ( Size( pfield ) > 0 ) then
+ istarts(:) = koffset(:) + 1
+ istatus = NF90_PUT_VAR( tpfile%nncid, ivarid, pfield(:,:,:), start = istarts(:), count = Int( Shape( pfield ), kind = CDFINT ) )
+ if (istatus /= NF90_NOERR) &
+ call IO_Err_handle_nc4( istatus, 'IO_Field_partial_write_nc4_X3', 'NF90_PUT_VAR', Trim( tpfield%cmnhname ), kresp )
+end if
+
+end subroutine IO_Field_partial_write_nc4_X3
+
+
+subroutine IO_Field_partial_write_nc4_X4( tpfile, tpfield, pfield, koffset, kresp )
+
+type(tfiledata), intent(in) :: tpfile
+type(tfielddata), intent(in) :: tpfield
+real, dimension(:,:,:,:), intent(in) :: pfield ! array containing the data field
+integer, dimension(4), intent(in) :: koffset
+integer, intent(out) :: kresp
+
+character(len=NMNHNAMELGTMAX) :: yvarname
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: ivarid
+integer(kind=CDFINT), dimension(4) :: istarts
+
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_Field_partial_write_nc4_X4',&
+ Trim( tpfile%cname ) // ': writing ' // Trim( tpfield%cmnhname ) )
+
+kresp = 0
+
+call IO_Mnhname_clean( tpfield%cmnhname, yvarname )
+
+istatus = NF90_INQ_VARID( tpfile%nncid, yvarname, ivarid )
+if ( istatus /= NF90_NOERR ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_partial_write_nc4_X4', 'variable ' // Trim( yvarname ) &
+ // ' not yet created (IO_Field_create not yet called?)' )
+end if
+
+! Write the data
+if ( Size( pfield ) > 0 ) then
+ istarts(:) = koffset(:) + 1
+ istatus = NF90_PUT_VAR( tpfile%nncid, ivarid, pfield(:,:,:,:), start = istarts(:), count = Int( Shape( pfield ), kind = CDFINT ) )
+ if (istatus /= NF90_NOERR) &
+ call IO_Err_handle_nc4( istatus, 'IO_Field_partial_write_nc4_X4', 'NF90_PUT_VAR', Trim( tpfield%cmnhname ), kresp )
+end if
+
+end subroutine IO_Field_partial_write_nc4_X4
+
+
+subroutine IO_Field_partial_write_nc4_N2( tpfile, tpfield, kfield, koffset, kresp, kvertlevel, kzfile )
+
+type(tfiledata), intent(in) :: tpfile
+type(tfielddata), intent(in) :: tpfield
+integer, dimension(:,:), intent(in) :: kfield ! array containing the data field
+integer, dimension(2), intent(in) :: koffset
+integer, intent(out) :: kresp
+integer, optional, intent(in) :: kvertlevel ! Number of the vertical level (needed for Z-level split files)
+integer, optional, intent(in) :: kzfile ! Number of the Z-level split file
+
+character(len=4) :: ysuffix
+character(len=NMNHNAMELGTMAX) :: yvarname
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: ivarid
+integer(kind=CDFINT), dimension(2) :: istarts
+type(tfielddata), pointer :: tzfield
+type(tfiledata), pointer :: tzfile
+
+kresp = 0
+
+call IO_Select_split_file( tpfile, tpfield, tzfile, tzfield, kvertlevel, kzfile )
+
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_Field_partial_write_nc4_N2',&
+ Trim( tzfile%cname ) // ': writing ' // Trim( tzfield%cmnhname ) )
+
+call IO_Mnhname_clean( tzfield%cmnhname, yvarname )
+
+istatus = NF90_INQ_VARID( tzfile%nncid, yvarname, ivarid )
+if ( istatus /= NF90_NOERR ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_partial_write_nc4_N2', 'variable ' // Trim( yvarname ) &
+ // ' not yet created (IO_Field_create not yet called?)' )
+end if
+
+! Write the data
+if ( Size( kfield ) > 0 ) then
+ istarts(:) = koffset(:) + 1
+ istatus = NF90_PUT_VAR( tzfile%nncid, ivarid, kfield(:,:), start = istarts(:), count = Int( Shape( kfield ), kind = CDFINT ) )
+ if (istatus /= NF90_NOERR) &
+ call IO_Err_handle_nc4( istatus, 'IO_Field_partial_write_nc4_N2', 'NF90_PUT_VAR', Trim( tzfield%cmnhname ), kresp )
+end if
+
+if ( Present( kvertlevel ) ) deallocate( tzfield )
+
+end subroutine IO_Field_partial_write_nc4_N2
+
+
+subroutine IO_Field_partial_write_nc4_N3( tpfile, tpfield, kfield, koffset, kresp, kvertlevel, kzfile )
+
+type(tfiledata), intent(in) :: tpfile
+type(tfielddata), intent(in) :: tpfield
+integer, dimension(:,:,:), intent(in) :: kfield ! array containing the data field
+integer, dimension(3), intent(in) :: koffset
+integer, intent(out) :: kresp
+integer, optional, intent(in) :: kvertlevel ! Number of the vertical level (needed for Z-level split files)
+integer, optional, intent(in) :: kzfile ! Number of the Z-level split file
+
+character(len=4) :: ysuffix
+character(len=NMNHNAMELGTMAX) :: yvarname
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: ivarid
+integer(kind=CDFINT), dimension(3) :: istarts
+type(tfielddata), pointer :: tzfield
+type(tfiledata), pointer :: tzfile
+
+kresp = 0
+
+call IO_Select_split_file( tpfile, tpfield, tzfile, tzfield, kvertlevel, kzfile )
+
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_Field_partial_write_nc4_N3',&
+ Trim( tzfile%cname ) // ': writing ' // Trim( tzfield%cmnhname ) )
+
+call IO_Mnhname_clean( tzfield%cmnhname, yvarname )
+
+istatus = NF90_INQ_VARID( tzfile%nncid, yvarname, ivarid )
+if ( istatus /= NF90_NOERR ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_partial_write_nc4_N3', 'variable ' // Trim( yvarname ) &
+ // ' not yet created (IO_Field_create not yet called?)' )
+end if
+
+! Write the data
+if ( Size( kfield ) > 0 ) then
+ istarts(:) = koffset(:) + 1
+ istatus = NF90_PUT_VAR( tzfile%nncid, ivarid, kfield(:,:,:), start = istarts(:), count = Int( Shape( kfield ), kind = CDFINT ) )
+ if (istatus /= NF90_NOERR) &
+ call IO_Err_handle_nc4( istatus, 'IO_Field_partial_write_nc4_N3', 'NF90_PUT_VAR', Trim( tzfield%cmnhname ), kresp )
+end if
+
+if ( Present( kvertlevel ) ) deallocate( tzfield )
+
+end subroutine IO_Field_partial_write_nc4_N3
+
+
+subroutine IO_Field_partial_write_nc4_N4( tpfile, tpfield, kfield, koffset, kresp, kvertlevel, kzfile )
+
+type(tfiledata), intent(in) :: tpfile
+type(tfielddata), intent(in) :: tpfield
+integer, dimension(:,:,:,:), intent(in) :: kfield ! array containing the data field
+integer, dimension(4), intent(in) :: koffset
+integer, intent(out) :: kresp
+integer, optional, intent(in) :: kvertlevel ! Number of the vertical level (needed for Z-level split files)
+integer, optional, intent(in) :: kzfile ! Number of the Z-level split file
+
+character(len=4) :: ysuffix
+character(len=NMNHNAMELGTMAX) :: yvarname
+integer(kind=CDFINT) :: istatus
+integer(kind=CDFINT) :: ivarid
+integer(kind=CDFINT), dimension(4) :: istarts
+type(tfielddata), pointer :: tzfield
+type(tfiledata), pointer :: tzfile
+
+kresp = 0
+
+call IO_Select_split_file( tpfile, tpfield, tzfile, tzfield, kvertlevel, kzfile )
+
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_Field_partial_write_nc4_N4',&
+ Trim( tzfile%cname ) // ': writing ' // Trim( tzfield%cmnhname ) )
+
+call IO_Mnhname_clean( tzfield%cmnhname, yvarname )
+
+istatus = NF90_INQ_VARID( tzfile%nncid, yvarname, ivarid )
+if ( istatus /= NF90_NOERR ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'IO_Field_partial_write_nc4_N4', 'variable ' // Trim( yvarname ) &
+ // ' not yet created (IO_Field_create not yet called?)' )
+end if
+
+! Write the data
+if ( Size( kfield ) > 0 ) then
+ istarts(:) = koffset(:) + 1
+ istatus = NF90_PUT_VAR( tzfile%nncid, ivarid, kfield(:,:,:,:), start = istarts(:), count = Int( Shape( kfield ), kind = CDFINT ) )
+ if (istatus /= NF90_NOERR) &
+ call IO_Err_handle_nc4( istatus, 'IO_Field_partial_write_nc4_N4', 'NF90_PUT_VAR', Trim( tzfield%cmnhname ), kresp )
+end if
+
+if ( Present( kvertlevel ) ) deallocate( tzfield )
+
+end subroutine IO_Field_partial_write_nc4_N4
+
+
+subroutine IO_Coordvar_write_nc4( tpfile, hprogram_orig )
+use modd_aircraft_balloon
+use modd_budget, only: cbutype, lbu_icp, lbu_jcp, lbu_kcp, nbuih, nbuil, nbujh, nbujl, nbukh, nbukl, nbukmax, &
+ nbustep, nbutotwrite
+use modd_conf, only: cprogram, l2d, lcartesian
+use modd_conf_n, only: cstorage_type
+use modd_dim_n, only: nkmax
+use modd_dyn_n, only: xtstep
+use modd_field, only: NMNHDIM_NI, NMNHDIM_NJ, NMNHDIM_NI_U, NMNHDIM_NJ_U, NMNHDIM_NI_V, NMNHDIM_NJ_V, &
+ NMNHDIM_LEVEL, NMNHDIM_LEVEL_W, NMNHDIM_TIME, &
+ 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, &
+ NMNHDIM_BUDGET_MASK_LEVEL, NMNHDIM_BUDGET_MASK_LEVEL_W, &
+ NMNHDIM_BUDGET_TIME, NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_LES_AVG_TIME, &
+ NMNHDIM_BUDGET_LES_LEVEL, &
+ NMNHDIM_SPECTRA_2PTS_NI, NMNHDIM_SPECTRA_2PTS_NJ, NMNHDIM_SPECTRA_LEVEL, &
+ NMNHDIM_SERIES_LEVEL, NMNHDIM_SERIES_LEVEL_W, NMNHDIM_SERIES_TIME, &
+ NMNHDIM_PROFILER_TIME, NMNHDIM_STATION_TIME, &
+ tfieldlist
+use modd_grid, only: xlatori, xlonori
+use modd_grid_n, only: lsleve, xxhat, xyhat, xzhat
+use modd_les, only: cles_level_type, cspectra_level_type, nlesn_iinf, nlesn_isup, nlesn_jinf, nlesn_jsup, &
+ nles_k, nles_levels, nspectra_k, nspectra_levels, &
+ xles_altitudes, xles_temp_mean_start, xles_temp_mean_end, xles_temp_mean_step, &
+ xspectra_altitudes
+use modd_les_n, only: nles_times, nspectra_ni, nspectra_nj, tles_dates
+use modd_netcdf, only: tdimnc
+use modd_parameters, only: jphext, JPVEXT
+use modd_profiler_n, only: numbprofiler, tprofiler
+use modd_series, only: lseries
+use modd_series_n, only: nsnbstept, tpsdates
+use modd_station_n, only: numbstat, tstation
+use modd_time, only: tdtseg
+use modd_time_n, only: tdtcur
+use modd_type_date, only: date_time
+
+use mode_field, only: Find_field_id_from_mnhname
+use mode_gridproj, only: Sm_latlon
+use mode_nest_ll, only: Get_model_number_ll, Go_tomodel_ll
+use mode_time, only: tdtexp
+
+type(tfiledata), intent(in) :: tpfile
+character(len=*), optional, intent(in) :: hprogram_orig !To emulate a file coming from this program
+
+character(len=:), allocatable :: ystdnameprefix
+character(len=:), allocatable :: yprogram
+integer :: iiu, iju, iku
+integer :: id, iid, iresp
+integer :: imi
+integer :: iavg
+integer :: ji
+integer :: jt
+integer(kind=cdfint) :: incid
+logical :: gchangemodel
+logical :: gdealloc
+logical, pointer :: gsleve
+real :: zles_temp_mean_start, zles_temp_mean_end
+real, dimension(:), pointer :: zxhat, zyhat, zzhat
+real, dimension(:), allocatable :: zxhatm, zyhatm, zzhatm !Coordinates at mass points in the transformed space
+real, dimension(:), allocatable :: zles_levels
+real, dimension(:), allocatable :: zspectra_levels
+real, dimension(:,:), pointer :: zlat, zlon
+type(tdimnc), pointer :: tzdim_ni, tzdim_nj, tzdim_ni_u, tzdim_nj_u, tzdim_ni_v, tzdim_nj_v
+type(date_time), dimension(:), allocatable :: tzdates
+type(date_time), dimension(:,:), allocatable :: tzdates_bound
+
+!These variables are save: they are populated once for the master Z-split file and freed after the last file has been written
+real, dimension(:), pointer, save :: zxhat_glob => null(), zyhat_glob => null()
+real, dimension(:), pointer, save :: zxhatm_glob => null(), zyhatm_glob => null()
+real, dimension(:,:), pointer, save :: zlatm_glob => null(), zlonm_glob => null()
+real, dimension(:,:), pointer, save :: zlatu_glob => null(), zlonu_glob => null()
+real, dimension(:,:), pointer, save :: zlatv_glob => null(), zlonv_glob => null()
+real, dimension(:,:), pointer, save :: zlatf_glob => null(), zlonf_glob => null()
+
+
+call Print_msg( NVERB_DEBUG, 'IO', 'IO_Coordvar_write_nc4', 'called for ' // Trim( tpfile%cname ) )
+
+zxhat => null()
+zyhat => null()
+zzhat => null()
+
+gchangemodel = .false.
+
+if ( Present( hprogram_orig ) ) then
+ yprogram = hprogram_orig
else
-tzdim_ni => null()
-tzdim_nj => null()
-tzdim_ni_u => null()
-tzdim_nj_u => null()
-tzdim_ni_v => null()
-tzdim_nj_v => null()
+ yprogram = cprogram
+endif
+
+! Get the Netcdf file ID
+incid = tpfile%nncid
+
+call Get_model_number_ll( imi )
+
+if ( tpfile%nmodel > 0 ) then
+ call Find_field_id_from_mnhname( 'XHAT', iid, iresp )
+ zxhat => tfieldlist(iid)%tfield_x1d(tpfile%nmodel)%data
+ call Find_field_id_from_mnhname( 'YHAT', iid, iresp )
+ zyhat => tfieldlist(iid)%tfield_x1d(tpfile%nmodel)%data
+ call Find_field_id_from_mnhname( 'ZHAT', iid, iresp )
+ zzhat => tfieldlist(iid)%tfield_x1d(tpfile%nmodel)%data
+ call Find_field_id_from_mnhname( 'SLEVE', iid, iresp )
+ gsleve => tfieldlist(iid)%tfield_l0d(tpfile%nmodel)%data
+
+ if ( imi /= tpfile%nmodel ) then
+ !This is necessary to have correct domain sizes (used by Gather_xxfield)
+ call Go_tomodel_ll( tpfile%nmodel, iresp )
+ gchangemodel = .true.
+ end if
+else
+ zxhat => xxhat
+ zyhat => xyhat
+ zzhat => xzhat
+ gsleve => lsleve
end if
-CALL WRITE_HOR_COORD(tzdim_ni,'x-dimension of the grid',TRIM(YSTDNAMEPREFIX)//'_x_coordinate','X',0.,JPHEXT,JPHEXT,ZXHATM)
-CALL WRITE_HOR_COORD(tzdim_nj,'y-dimension of the grid',TRIM(YSTDNAMEPREFIX)//'_y_coordinate','Y',0.,JPHEXT,JPHEXT,ZYHATM)
-CALL WRITE_HOR_COORD(tzdim_ni_u,'x-dimension of the grid at u location', &
- TRIM(YSTDNAMEPREFIX)//'_x_coordinate_at_u_location','X',-0.5,JPHEXT,0, ZXHAT)
-CALL WRITE_HOR_COORD(tzdim_nj_u,'y-dimension of the grid at u location', &
- TRIM(YSTDNAMEPREFIX)//'_y_coordinate_at_u_location','Y', 0., JPHEXT,JPHEXT,ZYHATM)
-CALL WRITE_HOR_COORD(tzdim_ni_v,'x-dimension of the grid at v location', &
- TRIM(YSTDNAMEPREFIX)//'_x_coordinate_at_v_location','X', 0., JPHEXT,JPHEXT,ZXHATM)
-CALL WRITE_HOR_COORD(tzdim_nj_v,'y-dimension of the grid at v location', &
- TRIM(YSTDNAMEPREFIX)//'_y_coordinate_at_v_location','Y',-0.5,JPHEXT,0, ZYHAT)
-
-IF (.NOT.LCARTESIAN) THEN
- ALLOCATE(ZLAT(IIU,IJU),ZLON(IIU,IJU))
- !
+iiu = Size( zxhat )
+iju = Size( zyhat )
+Allocate( zxhatm(iiu), zyhatm(iju) )
+!zxhatm(iiu) and zyhatm(iju) are correct only on some processes
+!but it is OK due to the way Gather_xxfield is done
+zxhatm(1 : iiu - 1) = 0.5 * ( zxhat(1 : iiu - 1) + zxhat(2 : iiu) )
+zxhatm(iiu) = 2. * zxhat(iiu) - zxhatm(iiu - 1)
+zyhatm(1 : iju - 1) = 0.5 * ( zyhat(1 : iju - 1) + zyhat(2 : iju) )
+zyhatm(iju) = 2. * zyhat(iju) - zyhatm(iju - 1)
+
+if ( lcartesian ) then
+ ystdnameprefix = 'plane'
+else
+ ystdnameprefix = 'projection'
+endif
+
+if ( Associated( tpfile%tncdims ) ) then
+ tzdim_ni => tpfile%tncdims%tdims(NMNHDIM_NI)
+ tzdim_nj => tpfile%tncdims%tdims(NMNHDIM_NJ)
+ tzdim_ni_u => tpfile%tncdims%tdims(NMNHDIM_NI_U)
+ tzdim_nj_u => tpfile%tncdims%tdims(NMNHDIM_NJ_U)
+ tzdim_ni_v => tpfile%tncdims%tdims(NMNHDIM_NI_V)
+ tzdim_nj_v => tpfile%tncdims%tdims(NMNHDIM_NJ_V)
+else
+ tzdim_ni => Null()
+ tzdim_nj => Null()
+ tzdim_ni_u => Null()
+ tzdim_nj_u => Null()
+ tzdim_ni_v => Null()
+ tzdim_nj_v => Null()
+end if
+
+!If the file is a Z-split subfile, coordinates are already collected
+if ( .not. Associated( tpfile%tmainfile ) ) then
+ call Gather_hor_coord1d( 'X', zxhat, zxhat_glob )
+ call Gather_hor_coord1d( 'X', zxhatm, zxhatm_glob )
+ call Gather_hor_coord1d( 'Y', zyhat, zyhat_glob )
+ call Gather_hor_coord1d( 'Y', zyhatm, zyhatm_glob )
+end if
+
+call Write_hor_coord1d( tzdim_ni, 'x-dimension of the grid', &
+ trim(ystdnameprefix)//'_x_coordinate', 'X', 0., jphext, jphext, zxhatm_glob )
+call Write_hor_coord1d( tzdim_nj, 'y-dimension of the grid', &
+ trim(ystdnameprefix)//'_y_coordinate', 'Y', 0., jphext, jphext, zyhatm_glob )
+call Write_hor_coord1d( tzdim_ni_u, 'x-dimension of the grid at u location', &
+ trim(ystdnameprefix)//'_x_coordinate_at_u_location', 'X', -0.5, jphext, 0, zxhat_glob )
+call Write_hor_coord1d( tzdim_nj_u, 'y-dimension of the grid at u location', &
+ trim(ystdnameprefix)//'_y_coordinate_at_u_location', 'Y', 0., jphext, jphext, zyhatm_glob )
+call Write_hor_coord1d( tzdim_ni_v, 'x-dimension of the grid at v location', &
+ trim(ystdnameprefix)//'_x_coordinate_at_v_location', 'X', 0., jphext, jphext, zxhatm_glob )
+call Write_hor_coord1d( tzdim_nj_v, 'y-dimension of the grid at v location', &
+ trim(ystdnameprefix)//'_y_coordinate_at_v_location', 'Y', -0.5, jphext, 0, zyhat_glob )
+
+!The z?hat*_glob were allocated in Gather_hor_coord1d calls
+!Deallocate only if it is a non Z-split file or the last Z-split subfile
+gdealloc = .false.
+if ( Associated( tpfile%tmainfile ) ) then
+ if ( tpfile%cname == tpfile%tmainfile%tfiles_ioz(tpfile%tmainfile%nsubfiles_ioz)%tfile%cname ) gdealloc = .true.
+else if ( tpfile%nsubfiles_ioz == 0 .and. .not. Associated( tpfile%tmainfile ) ) then
+ gdealloc = .true.
+end if
+
+if ( .not. lcartesian ) then
!Compute latitude/longitude for the Arakawa points
- !
+ Allocate( zlat(iiu, iju), zlon(iiu, iju) )
+
+ !If the file is a Z-split subfile, coordinates are already collected
+ if ( .not. associated( tpfile%tmainfile ) ) then
+ call Gather_hor_coord2d( zxhatm, zyhatm, zlatm_glob, zlonm_glob )
+ call Gather_hor_coord2d( zxhat, zyhatm, zlatu_glob, zlonu_glob )
+ call Gather_hor_coord2d( zxhatm, zyhat, zlatv_glob, zlonv_glob )
+ call Gather_hor_coord2d( zxhat, zyhat, zlatf_glob, zlonf_glob )
+ end if
+
! Mass point
- CALL WRITE_HOR_2DCOORD(ZXHATM,ZYHATM,'latitude', 'longitude')
+ call Write_hor_coord2d( zlatm_glob, zlonm_glob, 'latitude', 'longitude')
! u point
- CALL WRITE_HOR_2DCOORD(ZXHAT, ZYHATM,'latitude_u','longitude_u')
+ call Write_hor_coord2d( zlatu_glob, zlonu_glob, 'latitude_u','longitude_u')
! v point
- CALL WRITE_HOR_2DCOORD(ZXHATM,ZYHAT, 'latitude_v','longitude_v')
+ call Write_hor_coord2d( zlatv_glob, zlonv_glob, 'latitude_v','longitude_v')
! xi vorticity point (=f point =uv point)
- CALL WRITE_HOR_2DCOORD(ZXHAT, ZYHAT, 'latitude_f','longitude_f')
- !
- DEALLOCATE(ZLAT,ZLON)
-END IF
-!
-DEALLOCATE(ZXHATM,ZYHATM)
-!
-IF (TPFILE%LMASTER) THEN !vertical coordinates in the transformed space are the same on all processes
- IF (TRIM(YPROGRAM)/='PGD' .AND. TRIM(YPROGRAM)/='NESPGD' .AND. TRIM(YPROGRAM)/='ZOOMPG' &
- .AND. .NOT.(TRIM(YPROGRAM)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
- !
- IKU = SIZE(ZZHAT)
- ALLOCATE(ZZHATM(IKU))
- ZZHATM(1:IKU-1) = 0.5 * (ZZHAT(2:IKU)+ZZHAT(1:IKU-1))
- ZZHATM(IKU) = 2.* ZZHAT(IKU) - ZZHATM(IKU-1)
- !
- CALL WRITE_VER_COORD(PIOCDF%DIM_LEVEL, 'position z in the transformed space', '', &
- 'altitude', 0., JPVEXT,JPVEXT,ZZHATM)
- !
- CALL WRITE_VER_COORD(PIOCDF%DIM_LEVEL_W,'position z in the transformed space at w location','', &
- 'altitude_at_w_location',-0.5,JPVEXT,0, ZZHAT)
- !
- DEALLOCATE(ZZHATM)
+ call Write_hor_coord2d( zlatf_glob, zlonf_glob, 'latitude_f','longitude_f')
+
+ Deallocate( zlat, zlon )
+
+ !The zlat/lon._glob were allocated in Gather_hor_coord2d calls
+ !Deallocate only if it is non Z-split file or the last Z-split subfile
+ if ( gdealloc ) Deallocate( zlatm_glob, zlonm_glob, zlatu_glob, zlonu_glob, zlatv_glob, zlonv_glob, zlatf_glob, zlonf_glob )
+end if
+
+Deallocate( zxhatm, zyhatm )
+
+if ( tpfile%lmaster ) then !vertical coordinates in the transformed space are the same on all processes
+ if ( Trim( yprogram ) /= 'PGD' .and. Trim( yprogram ) /= 'NESPGD' .and. Trim( yprogram ) /= 'ZOOMPG' &
+ .and. .not. ( Trim( yprogram ) == 'REAL' .and. cstorage_type == 'SU') ) then !condition to detect prep_surfex
+
+ iku = Size( zzhat )
+ Allocate( zzhatm(iku) )
+ zzhatm(1 : iku - 1) = 0.5 * ( zzhat(2 : iku) + zzhat(1 : iku - 1) )
+ zzhatm(iku) = 2.* zzhat(iku) - zzhatm(iku - 1)
+
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_LEVEL), 'position z in the transformed space', '', &
+ 'altitude', 0., JPVEXT, JPVEXT, ZZHATM )
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_LEVEL_W),'position z in the transformed space at w location','', &
+ 'altitude_at_w_location', -0.5, JPVEXT, 0, ZZHAT )
END IF
END IF
-!
+
!Write time scale
-IF (TPFILE%LMASTER) THEN !Time scale is the same on all processes
- IF (TRIM(YPROGRAM)/='PGD' .AND. TRIM(YPROGRAM)/='NESPGD' .AND. TRIM(YPROGRAM)/='ZOOMPG' &
- .AND. .NOT.(TRIM(YPROGRAM)=='REAL' .AND. CSTORAGE_TYPE=='SU') ) THEN !condition to detect PREP_SURFEX
- CALL WRITE_TIME_COORD(PIOCDF%DIMTIME)
- END IF
-END IF
+if ( tpfile%lmaster ) then !time scale is the same on all processes
+ if ( Trim( yprogram ) /= 'PGD' .and. Trim( yprogram ) /= 'NESPGD' .and. Trim( yprogram ) /= 'ZOOMPG' &
+ .and. .not. ( Trim( yprogram ) == 'REAL' .and. cstorage_type == 'SU' ) ) then !condition to detect prep_surfex
+ if ( tpfile%ctype /= 'MNHDIACHRONIC' .and. Associated( tdtcur ) ) &
+ call Write_time_coord( tpfile%tncdims%tdims(nmnhdim_time), 'time axis', [ tdtcur ] )
+ end if
+end if
+
+if ( tpfile%lmaster ) then
+ !Write coordinates used in diachronic files
+ if ( tpfile%ctype == 'MNHDIACHRONIC' ) then
+ if ( cbutype == 'CART' .or. cbutype == 'SKIP' ) then
+ !Coordinates for the budgets in cartesian boxes
+ if ( .not. lbu_icp ) &
+ call Write_hor_coord1d( tpfile%tncdims%tdims(NMNHDIM_BUDGET_CART_NI), 'x-dimension of the budget cartesian box', &
+ trim(ystdnameprefix)//'_x_coordinate', 'X', 0., 0, 0, zxhatm_glob(nbuil + jphext : nbuih + jphext) )
+ if ( .not. lbu_jcp ) &
+ call Write_hor_coord1d( tpfile%tncdims%tdims(NMNHDIM_BUDGET_CART_NJ), 'y-dimension of the budget cartesian box', &
+ trim(ystdnameprefix)//'_y_coordinate', 'Y', 0., 0, 0, zyhatm_glob(nbujl + jphext : nbujh + jphext) )
+ if ( .not. lbu_icp ) &
+ call Write_hor_coord1d( tpfile%tncdims%tdims(NMNHDIM_BUDGET_CART_NI_U), &
+ 'x-dimension of the budget cartesian box at u location', &
+ trim(ystdnameprefix)//'_x_coordinate_at_u_location', &
+ 'X', -0.5, 0, 0, zxhat_glob (nbuil + jphext : nbuih + jphext) )
+ if ( .not. lbu_jcp ) &
+ call Write_hor_coord1d( tpfile%tncdims%tdims(NMNHDIM_BUDGET_CART_NJ_U), &
+ 'y-dimension of the budget cartesian box at u location', &
+ trim(ystdnameprefix)//'_y_coordinate_at_u_location', &
+ 'Y', 0., 0, 0, zyhatm_glob(nbujl + jphext : nbujh + jphext) )
+ if ( .not. lbu_icp ) &
+ call Write_hor_coord1d( tpfile%tncdims%tdims(NMNHDIM_BUDGET_CART_NI_V), &
+ 'x-dimension of the budget cartesian box at v location', &
+ trim(ystdnameprefix)//'_x_coordinate_at_v_location', &
+ 'X', 0., 0, 0, zxhatm_glob(nbuil + jphext : nbuih + jphext) )
+ if ( .not. lbu_jcp ) &
+ call Write_hor_coord1d( tpfile%tncdims%tdims(NMNHDIM_BUDGET_CART_NJ_V), &
+ 'y-dimension of the budget cartesian box at v location', &
+ trim(ystdnameprefix)//'_y_coordinate_at_v_location', &
+ 'Y', -0.5, 0, 0, zyhat_glob (nbujl + jphext : nbujh + jphext) )
+ if ( .not. lbu_kcp ) &
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_BUDGET_CART_LEVEL), &
+ 'position z in the transformed space of the budget cartesian box', &
+ '', 'altitude', 0., 0, 0, zzhatm(nbukl + JPVEXT : nbukh + JPVEXT) )
+ if ( .not. lbu_kcp ) &
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_BUDGET_CART_LEVEL_W), &
+ 'position z in the transformed space at w location of the budget cartesian box', &
+ '', 'altitude_at_w_location', -0.5, 0, 0, zzhat (nbukl + JPVEXT : nbukh + JPVEXT) )
+ else if ( cbutype == 'MASK' ) then
+ !Coordinates for the budgets masks
+ if ( nbukmax > 0 ) &
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_BUDGET_MASK_LEVEL), &
+ 'position z in the transformed space of the budget mask', &
+ '', 'altitude', 0., 0, 0, zzhatm(nbukl + JPVEXT : nbukh + JPVEXT) )
+ if ( nbukmax > 0 ) &
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_BUDGET_MASK_LEVEL_W), &
+ 'position z in the transformed space at w location of the budget mask', &
+ '', 'altitude', -0.5, 0, 0, zzhat (nbukl + JPVEXT : nbukh + JPVEXT) )
+
+ !NMNHDIM_BUDGET_MASK_NBUMASK: not a true dimension
+ end if !cbutype
+
+ !Write time_budget coordinate + its boundaries
+ if ( nbutotwrite > 0 ) then
+ Allocate( tzdates(nbutotwrite) )
+ Allocate( tzdates_bound(2, nbutotwrite) )
+
+ do jt = 1, nbutotwrite
+ tzdates(jt)%nyear = tdtexp%nyear
+ tzdates(jt)%nmonth = tdtexp%nmonth
+ tzdates(jt)%nday = tdtexp%nday
+ tzdates(jt)%xtime = tdtexp%xtime + nbustep * ( ( jt - 1 ) + 0.5 ) * xtstep
+
+ tzdates_bound(1, jt)%nyear = tdtexp%nyear
+ tzdates_bound(1, jt)%nmonth = tdtexp%nmonth
+ tzdates_bound(1, jt)%nday = tdtexp%nday
+ tzdates_bound(1, jt)%xtime = tdtexp%xtime + nbustep * ( jt - 1 ) * xtstep
+
+ tzdates_bound(2, jt)%nyear = tdtexp%nyear
+ tzdates_bound(2, jt)%nmonth = tdtexp%nmonth
+ tzdates_bound(2, jt)%nday = tdtexp%nday
+ tzdates_bound(2, jt)%xtime = tdtexp%xtime + nbustep * jt * xtstep
+ end do
+
+ call Write_time_coord( tpfile%tncdims%tdims(NMNHDIM_BUDGET_TIME), 'time axis for budgets', tzdates, tzdates_bound )
+
+ Deallocate( tzdates_bound )
+ Deallocate( tzdates )
+ end if
+
+ !Coordinates for the number of LES budget time samplings
+ if ( nles_times > 0 ) &
+ call Write_time_coord( tpfile%tncdims%tdims(NMNHDIM_BUDGET_LES_TIME), 'time axis for LES budgets', tles_dates )
+
+ !Coordinates for the number of LES budget time averages
+ iavg = int( xles_temp_mean_end - 1.e-10 - xles_temp_mean_start ) / xles_temp_mean_step + 1
+ !Condition also on nles_times to not create this coordinate when not used (no time average if nles_times=0)
+ if ( nles_times > 0 .and. iavg > 0 ) then
+ Allocate( tzdates(iavg) )
+ Allocate( tzdates_bound(2, iavg) )
+
+ do jt = 1, iavg
+ zles_temp_mean_start = xles_temp_mean_start + ( jt - 1 ) * xles_temp_mean_step
+ zles_temp_mean_end = Min( xles_temp_mean_end, zles_temp_mean_start + xles_temp_mean_step )
+
+ tzdates(jt)%nyear = tdtseg%nyear
+ tzdates(jt)%nmonth = tdtseg%nmonth
+ tzdates(jt)%nday = tdtseg%nday
+ tzdates(jt)%xtime = tdtseg%xtime + ( zles_temp_mean_start + zles_temp_mean_end ) / 2.
+ !Not necessary: call Datetime_correctdate( tzdates(jt ) )
+
+ tzdates_bound(1, jt)%nyear = tdtseg%nyear
+ tzdates_bound(1, jt)%nmonth = tdtseg%nmonth
+ tzdates_bound(1, jt)%nday = tdtseg%nday
+ tzdates_bound(1, jt)%xtime = tdtseg%xtime + zles_temp_mean_start
+
+ tzdates_bound(2, jt)%nyear = tdtseg%nyear
+ tzdates_bound(2, jt)%nmonth = tdtseg%nmonth
+ tzdates_bound(2, jt)%nday = tdtseg%nday
+ tzdates_bound(2, jt)%xtime = tdtseg%xtime + zles_temp_mean_end
+ end do
+ call Write_time_coord( tpfile%tncdims%tdims(NMNHDIM_BUDGET_LES_AVG_TIME), 'time axis for LES budget time averages', &
+ tzdates, tzdates_bound )
+
+ Deallocate( tzdates_bound )
+ Deallocate( tzdates )
+ end if
+
+ !Coordinates for the number of vertical levels for local LES budgets
+ if ( nles_k > 0 ) then
+ if ( cles_level_type == 'K' ) then
+ Allocate( zles_levels(nles_k) )
+ do ji = 1, nles_k
+ zles_levels(ji) = zzhatm(nles_levels(ji) + JPVEXT)
+ end do
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_BUDGET_LES_LEVEL), &
+ 'position z in the transformed space of the LES budgets', &
+ '', 'altitude', 0., 0, 0, zles_levels(:) )
+ Deallocate( zles_levels )
+ else if ( cles_level_type == 'Z' ) then
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_BUDGET_LES_LEVEL), 'altitude levels for the LES budgets', &
+ 'altitude', '', 0., 0, 0, xles_altitudes(1:nles_k) )
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Coordvar_write_nc4','invalid cles_level_type' )
+ end if
+ end if
+
+ !NMNHDIM_BUDGET_LES_SV: not a true dimension
+
+ !Coordinates for the number of horizontal wavelengths for non-local LES budgets (2 points correlations)
+ if ( nspectra_ni > 0 ) &
+ call Write_hor_coord1d( tpfile%tncdims%tdims(NMNHDIM_SPECTRA_2PTS_NI), 'x-dimension of the LES budget cartesian box', &
+ trim(ystdnameprefix)//'_x_coordinate', 'X', 0., 0, 0, &
+ zxhatm_glob(nlesn_iinf(imi) + jphext : nlesn_isup(imi) + jphext) )
+ if ( nspectra_nj > 0 .and. .not. l2d ) &
+ call Write_hor_coord1d( tpfile%tncdims%tdims(NMNHDIM_SPECTRA_2PTS_NJ), 'y-dimension of the LES budget cartesian box', &
+ trim(ystdnameprefix)//'_y_coordinate', 'Y', 0., 0, 0, &
+ zyhatm_glob(nlesn_jinf(imi) + jphext : nlesn_jsup(imi) + jphext) )
+
+
+ !NMNHDIM_SPECTRA_SPEC_NI, NMNHDIM_SPECTRA_SPEC_NJ: not true dimensions: spectra wavelengths
+
+ !Coordinates for the number of vertical levels for non-local LES budgets
+ if ( nspectra_k > 0 ) then
+ if ( cspectra_level_type == 'K' ) then
+ Allocate( zspectra_levels(nspectra_k) )
+ do ji = 1, nspectra_k
+ zspectra_levels(ji) = zzhatm(nspectra_levels(ji) + JPVEXT)
+ end do
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_SPECTRA_LEVEL), &
+ 'position z in the transformed space of the non-local LES budgets', &
+ '', 'altitude', 0., 0, 0, zspectra_levels(:) )
+ Deallocate( zspectra_levels )
+ else if ( cspectra_level_type == 'Z' ) then
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_SPECTRA_LEVEL), 'altitude levels for the non-local LES budgets', &
+ 'altitude', '', 0., 0, 0, xspectra_altitudes(1 : nspectra_k) )
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'IO_Coordvar_write_nc4','invalid cspectra_level_type' )
+ end if
+ end if
+
+ !Coordinates for the number of profiler times
+ if ( numbprofiler > 0 ) &
+ call Write_time_coord( tpfile%tncdims%tdims(NMNHDIM_PROFILER_TIME), 'time axis for profilers', tprofiler%tpdates )
+
+ !Coordinates for the number of station times
+ if ( numbstat > 0 ) &
+ call Write_time_coord( tpfile%tncdims%tdims(NMNHDIM_STATION_TIME), 'time axis for stations', tstation%tpdates )
+
+ !Dimension for the number of series times
+ if ( lseries .and. nsnbstept > 0 ) then
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_SERIES_LEVEL), &
+ 'position z in the transformed space of the temporal series', &
+ '', 'altitude', 0., 0, 0, zzhatm(1 + JPVEXT : nkmax + JPVEXT) )
+ call Write_ver_coord( tpfile%tncdims%tdims(NMNHDIM_SERIES_LEVEL_W), &
+ 'position z in the transformed space at w location of the temporal series', &
+ '', 'altitude_at_w_location', -0.5, 0, 0, zzhat (1 + JPVEXT : nkmax + JPVEXT) )
+ call Write_time_coord( tpfile%tncdims%tdims(NMNHDIM_SERIES_TIME), 'time axis for temporal series', tpsdates )
+ end if
+
+ if ( lflyer ) then
+ call Write_flyer_time_coord( tballoon1 )
+ call Write_flyer_time_coord( tballoon2 )
+ call Write_flyer_time_coord( tballoon3 )
+ call Write_flyer_time_coord( tballoon4 )
+ call Write_flyer_time_coord( tballoon5 )
+ call Write_flyer_time_coord( tballoon6 )
+ call Write_flyer_time_coord( tballoon7 )
+ call Write_flyer_time_coord( tballoon8 )
+ call Write_flyer_time_coord( tballoon9 )
+
+ call Write_flyer_time_coord( taircraft1 )
+ call Write_flyer_time_coord( taircraft2 )
+ call Write_flyer_time_coord( taircraft3 )
+ call Write_flyer_time_coord( taircraft4 )
+ call Write_flyer_time_coord( taircraft5 )
+ call Write_flyer_time_coord( taircraft6 )
+ call Write_flyer_time_coord( taircraft7 )
+ call Write_flyer_time_coord( taircraft8 )
+ call Write_flyer_time_coord( taircraft9 )
+ call Write_flyer_time_coord( taircraft10 )
+ call Write_flyer_time_coord( taircraft11 )
+ call Write_flyer_time_coord( taircraft12 )
+ call Write_flyer_time_coord( taircraft13 )
+ call Write_flyer_time_coord( taircraft14 )
+ call Write_flyer_time_coord( taircraft15 )
+ call Write_flyer_time_coord( taircraft16 )
+ call Write_flyer_time_coord( taircraft17 )
+ call Write_flyer_time_coord( taircraft18 )
+ call Write_flyer_time_coord( taircraft19 )
+ call Write_flyer_time_coord( taircraft20 )
+ call Write_flyer_time_coord( taircraft21 )
+ call Write_flyer_time_coord( taircraft22 )
+ call Write_flyer_time_coord( taircraft23 )
+ call Write_flyer_time_coord( taircraft24 )
+ call Write_flyer_time_coord( taircraft25 )
+ call Write_flyer_time_coord( taircraft26 )
+ call Write_flyer_time_coord( taircraft27 )
+ call Write_flyer_time_coord( taircraft28 )
+ call Write_flyer_time_coord( taircraft29 )
+ call Write_flyer_time_coord( taircraft30 )
+ end if
+
+ end if !MNHDIACHRONIC
+
+end if
-IF (GCHANGEMODEL) CALL GO_TOMODEL_ll(IMI,IRESP)
+if ( gdealloc ) deallocate( zxhat_glob, zxhatm_glob, zyhat_glob, zyhatm_glob )
+
+if ( gchangemodel ) call Go_tomodel_ll( imi, iresp )
+
+
+contains
-CONTAINS
-SUBROUTINE WRITE_HOR_COORD(TDIM,HLONGNAME,HSTDNAME,HAXIS,PSHIFT,KBOUNDLOW,KBOUNDHIGH,PCOORDS)
+subroutine Gather_hor_coord1d( haxis, pcoords_loc, pcoords_glob )
+ use mode_allocbuffer_ll, only: Allocbuffer_ll
+ use mode_gather_ll, only: Gather_xxfield
+
+ character(len=*), intent(in) :: haxis
+ real, dimension(:), intent(in) :: pcoords_loc
+ real, dimension(:), pointer, intent(out) :: pcoords_glob
+
+ character(len=2) :: ydir
+ integer :: ierr
+ logical :: galloc
+
+ if ( haxis == 'X' ) then
+ ydir = 'XX'
+ else if ( haxis == 'Y' ) then
+ ydir = 'YY'
+ else
+ call Print_msg( NVERB_FATAL, 'IO', 'Gather_hor_coord1d', 'invalid haxis ('//trim(haxis)//')' )
+ end if
+
+ ! Allocate pcoords_glob
+ if ( gsmonoproc ) then ! sequential execution
+ allocate( pcoords_glob( size( pcoords_loc) ) )
+ else if ( tpfile%nsubfiles_ioz > 0 ) then
+ !If there are Z-split subfiles, all subfile writers need the coordinates
+ call Allocbuffer_ll( pcoords_glob, pcoords_loc, ydir, galloc )
+ else if ( .not. tpfile%lmaster ) then
+ allocate( pcoords_glob(0 ) ) !to prevent false positive with valgrind
+ else !Master process
+ call Allocbuffer_ll( pcoords_glob, pcoords_loc, ydir, galloc )
+ end if
+
+ !Gather coordinates
+ if ( gsmonoproc ) then ! sequential execution
+ pcoords_glob(: ) = pcoords_loc(: )
+ else ! multiprocesses execution
+ call Gather_xxfield( ydir, pcoords_loc, pcoords_glob, tpfile%nmaster_rank, tpfile%nmpicomm )
+ endif
+
+ !If the file has Z-split subfiles, broadcast the coordinates to all processes
+ !PW: TODO: broadcast only to subfile writers
+ if ( tpfile%nsubfiles_ioz > 0 ) &
+ call MPI_BCAST( pcoords_glob, size( pcoords_glob ), MNHREAL_MPI, tpfile%nmaster_rank - 1, tpfile%nmpicomm, ierr )
+end subroutine Gather_hor_coord1d
+
+
+subroutine Gather_hor_coord2d( px, py, plat_glob, plon_glob )
+ use mode_allocbuffer_ll, only: Allocbuffer_ll
+ use mode_gather_ll, only: Gather_xyfield
+
+ real,dimension(:), intent(in) :: px
+ real,dimension(:), intent(in) :: py
+ real, dimension(:,:), pointer, intent(out) :: plat_glob
+ real, dimension(:,:), pointer, intent(out) :: plon_glob
+
+ integer :: ierr
+ logical :: galloc1, galloc2
+
+ call Sm_latlon( xlatori, xlonori, &
+ spread( source = px, dim = 2, ncopies = iju), &
+ spread( source = py, dim = 1, ncopies = iiu), &
+ zlat, zlon )
+
+ ! Allocate coordinate arrays
+ if ( gsmonoproc ) then ! sequential execution
+ allocate( plat_glob( size( zlat, 1 ), size( zlat, 2 ) ) )
+ allocate( plon_glob( size( zlon, 1 ), size( zlon, 2 ) ) )
+ else if ( tpfile%nsubfiles_ioz > 0 ) then
+ !If there are Z-split subfiles, all subfile writers need the coordinates
+ call Allocbuffer_ll( plat_glob, zlat, 'XY', galloc1 )
+ call Allocbuffer_ll( plon_glob, zlon, 'XY', galloc2 )
+ else if ( .not. tpfile%lmaster ) then
+ allocate( plat_glob( 0, 0 ), plon_glob( 0, 0 ) ) !to prevent false positive with valgrind
+ else !Master process
+ call Allocbuffer_ll( plat_glob, zlat, 'XY', galloc1 )
+ call Allocbuffer_ll( plon_glob, zlon, 'XY', galloc2 )
+ end if
+
+ !Gather coordinates
+ if ( gsmonoproc ) then ! sequential execution
+ plat_glob(:, : ) = zlat(:, : )
+ plon_glob(:, : ) = zlon(:, : )
+ else ! multiprocesses execution
+ call Gather_xyfield( zlat, plat_glob, tpfile%nmaster_rank, tpfile%nmpicomm )
+ call Gather_xyfield( zlon, plon_glob, tpfile%nmaster_rank, tpfile%nmpicomm )
+ endif
+
+ !If the file has Z-split subfiles, broadcast the coordinates to all processes
+ !PW: TODO: broadcast only to subfile writers
+ if ( tpfile%nsubfiles_ioz > 0 ) then
+ call MPI_BCAST( plat_glob, size( plat_glob ), MNHREAL_MPI, tpfile%nmaster_rank - 1, tpfile%nmpicomm, ierr )
+ call MPI_BCAST( plon_glob, size( plon_glob ), MNHREAL_MPI, tpfile%nmaster_rank - 1, tpfile%nmpicomm, ierr )
+ end if
+end subroutine Gather_hor_coord2d
+
+
+subroutine Write_hor_coord1d(TDIM,HLONGNAME,HSTDNAME,HAXIS,PSHIFT,KBOUNDLOW,KBOUNDHIGH,PCOORDS)
USE MODE_ALLOCBUFFER_ll, ONLY: ALLOCBUFFER_ll
USE MODE_GATHER_ll, ONLY: GATHER_XXFIELD
- TYPE(DIMCDF), POINTER, INTENT(IN) :: TDIM
- CHARACTER(LEN=*), INTENT(IN) :: HLONGNAME
- CHARACTER(LEN=*), INTENT(IN) :: HSTDNAME
- CHARACTER(LEN=*), INTENT(IN) :: HAXIS
- REAL, INTENT(IN) :: PSHIFT
- INTEGER, INTENT(IN) :: KBOUNDLOW
- INTEGER, INTENT(IN) :: KBOUNDHIGH
- REAL,DIMENSION(:),TARGET,OPTIONAL,INTENT(IN) :: PCOORDS
+ TYPE(tdimnc), INTENT(IN) :: TDIM
+ CHARACTER(LEN=*), INTENT(IN) :: HLONGNAME
+ CHARACTER(LEN=*), INTENT(IN) :: HSTDNAME
+ CHARACTER(LEN=*), INTENT(IN) :: HAXIS
+ REAL, INTENT(IN) :: PSHIFT
+ INTEGER, INTENT(IN) :: KBOUNDLOW
+ INTEGER, INTENT(IN) :: KBOUNDHIGH
+ REAL, DIMENSION(:), TARGET, INTENT(IN) :: PCOORDS
- CHARACTER(LEN=2) :: YDIR
CHARACTER(LEN=64) :: YRANGE
CHARACTER(LEN=:),ALLOCATABLE :: YVARNAME
INTEGER :: IRESP
INTEGER :: ISIZE
- INTEGER :: JI
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: IVDIM
- INTEGER(KIND=CDFINT) :: STATUS
- LOGICAL :: GALLOC
- REAL,DIMENSION(:),POINTER :: ZTAB
-
- GALLOC = .FALSE.
- ZTAB => NULL()
-
- IF (HAXIS=='X') THEN
- YDIR = 'XX'
- ELSE IF (HAXIS=='Y') THEN
- YDIR = 'YY'
- ELSE
- CALL PRINT_MSG(NVERB_FATAL,'IO','WRITE_HOR_COORD','invalid HAXIS ('//TRIM(HAXIS)//')')
- END IF
+ INTEGER(KIND=CDFINT) :: ISTATUS
- IF (.NOT.TPFILE%LMASTER) THEN
- IF (PRESENT(PCOORDS)) THEN
- ALLOCATE(ZTAB(0)) !To prevent false positive with valgrind
- GALLOC = .TRUE.
- CALL GATHER_XXFIELD(YDIR,PCOORDS,ZTAB,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- END IF
- ELSE !TPFILE%LMASTER
- ISIZE = TDIM%LEN
- YVARNAME = TRIM(TDIM%NAME)
- IVDIM = TDIM%ID
-
- IF (.NOT.PRESENT(PCOORDS)) THEN
- ALLOCATE(ZTAB(ISIZE))
- GALLOC = .TRUE.
- DO JI=1,ISIZE
- ZTAB(JI) = REAL(JI,KIND=KIND(ZTAB(1)))+PSHIFT
- END DO
- ELSE
- IF (GSMONOPROC) THEN ! sequential execution
- ZTAB => PCOORDS
- ELSE ! multiprocesses execution
- CALL ALLOCBUFFER_ll(ZTAB,PCOORDS,YDIR,GALLOC)
- CALL GATHER_XXFIELD(YDIR,PCOORDS,ZTAB,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- ENDIF
- END IF
+ IF (TPFILE%LMASTER) THEN
+ isize = tdim%nlen
+ yvarname = Trim( tdim%cname )
+ ivdim = tdim%nid
- STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
- IF (STATUS /= NF90_NOERR) THEN
+ ISTATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+ IF (ISTATUS /= NF90_NOERR) THEN
! Define the coordinate variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIM, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_HOR_COORD','NF90_DEF_VAR',trim(YVARNAME))
+ ISTATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIM, IVARID)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'Write_hor_coord1d','NF90_DEF_VAR',trim(YVARNAME))
ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_HOR_COORD',TRIM(YVARNAME)//' already defined')
+ CALL PRINT_MSG(NVERB_ERROR,'IO','Write_hor_coord1d',TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name',HLONGNAME)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','long_name for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'standard_name',HSTDNAME)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','standard_name for '//trim(YVARNAME))
- IF (PRESENT(PCOORDS)) THEN
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'units','m')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','units for '//trim(YVARNAME))
- END IF
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'axis',HAXIS)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','axis for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_axis_shift',PSHIFT)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','c_grid_axis_shift for ' &
+ ISTATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name',HLONGNAME)
+ IF (ISTATUS /= NF90_NOERR) &
+ CALL IO_Err_handle_nc4(istatus,'Write_hor_coord1d','NF90_PUT_ATT','long_name for '//trim(YVARNAME))
+
+ ISTATUS = NF90_PUT_ATT(INCID, IVARID, 'standard_name',HSTDNAME)
+ IF (ISTATUS /= NF90_NOERR) &
+ CALL IO_Err_handle_nc4(istatus,'Write_hor_coord1d','NF90_PUT_ATT','standard_name for '//trim(YVARNAME))
+
+ ISTATUS = NF90_PUT_ATT(INCID, IVARID, 'units','m')
+ IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'Write_hor_coord1d','NF90_PUT_ATT','units for '//trim(YVARNAME))
+
+ ISTATUS = NF90_PUT_ATT(INCID, IVARID, 'axis',HAXIS)
+ IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'Write_hor_coord1d','NF90_PUT_ATT','axis for '//trim(YVARNAME))
+
+ ISTATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_axis_shift',PSHIFT)
+ IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'Write_hor_coord1d','NF90_PUT_ATT','c_grid_axis_shift for ' &
//trim(YVARNAME))
+
WRITE(YRANGE,'( I0,":",I0 )') 1+KBOUNDLOW,ISIZE-KBOUNDHIGH
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_dynamic_range',TRIM(YRANGE))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_HOR_COORD','NF90_PUT_ATT','c_grid_dynamic_range for ' &
+ ISTATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_dynamic_range',TRIM(YRANGE))
+ IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'Write_hor_coord1d','NF90_PUT_ATT','c_grid_dynamic_range for ' &
//trim(YVARNAME))
! Write the data
- STATUS = NF90_PUT_VAR(INCID, IVARID, ZTAB)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_HOR_COORD','NF90_PUT_VAR',trim(YVARNAME),IRESP)
+ ISTATUS = NF90_PUT_VAR(INCID, IVARID, PCOORDS)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'Write_hor_coord1d','NF90_PUT_VAR',trim(YVARNAME),IRESP)
END IF
+end subroutine Write_hor_coord1d
- IF (GALLOC) DEALLOCATE(ZTAB)
-END SUBROUTINE WRITE_HOR_COORD
-SUBROUTINE WRITE_HOR_2DCOORD(PX,PY,HLAT,HLON)
- USE MODE_ALLOCBUFFER_ll, ONLY: ALLOCBUFFER_ll
- USE MODE_GATHER_ll, ONLY: GATHER_XYFIELD
-
- REAL,DIMENSION(:), INTENT(IN) :: PX
- REAL,DIMENSION(:), INTENT(IN) :: PY
- CHARACTER(LEN=*), INTENT(IN) :: HLAT
- CHARACTER(LEN=*), INTENT(IN) :: HLON
-
- LOGICAL :: GALLOC1, GALLOC2
- REAL,DIMENSION(:,:),POINTER :: ZTAB1, ZTAB2
-
- GALLOC1 = .FALSE.
- GALLOC2 = .FALSE.
- ZTAB1 => NULL()
- ZTAB2 => NULL()
-
- CALL SM_LATLON(XLATORI,XLONORI, &
- SPREAD(SOURCE=PX,DIM=2,NCOPIES=IJU), &
- SPREAD(SOURCE=PY,DIM=1,NCOPIES=IIU), &
- ZLAT,ZLON)
-
- IF (.NOT.TPFILE%LMASTER) THEN
- ALLOCATE(ZTAB1(0,0),ZTAB2(0,0)) !To prevent false positive with valgrind
- GALLOC1 = .TRUE. ; GALLOC2 = .TRUE.
- CALL GATHER_XYFIELD(ZLAT,ZTAB1,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- CALL GATHER_XYFIELD(ZLON,ZTAB2,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- ELSE !TPFILE%LMASTER
- IF (GSMONOPROC) THEN ! sequential execution
- ZTAB1 => ZLAT
- ZTAB2 => ZLON
- ELSE ! multiprocesses execution
- CALL ALLOCBUFFER_ll(ZTAB1,ZLAT,'XY',GALLOC1)
- CALL ALLOCBUFFER_ll(ZTAB2,ZLON,'XY',GALLOC2)
- CALL GATHER_XYFIELD(ZLAT,ZTAB1,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- CALL GATHER_XYFIELD(ZLON,ZTAB2,TPFILE%NMASTER_RANK,TPFILE%NMPICOMM)
- ENDIF
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME(HLAT,ID,IRESP)
- CALL IO_Field_write_nc4_X2(TPFILE,TFIELDLIST(ID),ZTAB1,IRESP,OISCOORD=.TRUE.)
- CALL FIND_FIELD_ID_FROM_MNHNAME(HLON,ID,IRESP)
- CALL IO_Field_write_nc4_X2(TPFILE,TFIELDLIST(ID),ZTAB2,IRESP,OISCOORD=.TRUE.)
- END IF
+subroutine Write_hor_coord2d( plat, plon, hlat, hlon )
+ real,dimension(:,:), intent(in) :: plat
+ real,dimension(:,:), intent(in) :: plon
+ character(len=*), intent(in) :: hlat
+ character(len=*), intent(in) :: hlon
+
+ if ( tpfile%lmaster ) then
+ call Find_field_id_from_mnhname( hlat, id, iresp )
+ call IO_Field_write_nc4_x2( tpfile, tfieldlist(id ), plat, iresp, oiscoord = .true. )
+ call Find_field_id_from_mnhname( hlon, id, iresp )
+ call IO_Field_write_nc4_x2( tpfile, tfieldlist(id ), plon, iresp, oiscoord = .true. )
+ end if
+end subroutine Write_hor_coord2d
- IF (GALLOC1) DEALLOCATE(ZTAB1)
- IF (GALLOC2) DEALLOCATE(ZTAB2)
-END SUBROUTINE WRITE_HOR_2DCOORD
SUBROUTINE WRITE_VER_COORD(TDIM,HLONGNAME,HSTDNAME,HCOMPNAME,PSHIFT,KBOUNDLOW,KBOUNDHIGH,PCOORDS)
- TYPE(DIMCDF), POINTER, INTENT(IN) :: TDIM
+ TYPE(tdimnc), INTENT(IN) :: TDIM
CHARACTER(LEN=*), INTENT(IN) :: HLONGNAME
CHARACTER(LEN=*), INTENT(IN) :: HSTDNAME
CHARACTER(LEN=*), INTENT(IN) :: HCOMPNAME
@@ -1834,127 +2093,252 @@ SUBROUTINE WRITE_VER_COORD(TDIM,HLONGNAME,HSTDNAME,HCOMPNAME,PSHIFT,KBOUNDLOW,KB
INTEGER :: JI
INTEGER(KIND=CDFINT) :: IVARID
INTEGER(KIND=CDFINT) :: IVDIM
- INTEGER(KIND=CDFINT) :: STATUS
+ INTEGER(KIND=CDFINT) :: istatus
- ISIZE = TDIM%LEN
- YVARNAME = TRIM(TDIM%NAME)
- IVDIM = TDIM%ID
+ isize = tdim%nlen
+ yvarname = Trim( tdim%cname )
+ ivdim = tdim%nid
- STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
- IF (STATUS /= NF90_NOERR) THEN
+ istatus = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
+ IF (istatus /= NF90_NOERR) THEN
! Define the coordinate variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIM, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_DEF_VAR',trim(YVARNAME))
+ istatus = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIM, IVARID)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_DEF_VAR',trim(YVARNAME))
ELSE
CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_VER_COORD',TRIM(YVARNAME)//' already defined')
END IF
! Write metadata
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name',HLONGNAME)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','long_name for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'standard_name',HSTDNAME)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','standard_name for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'units','m')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','units for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'axis','Z')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','axis for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'positive','up')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','positive for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_axis_shift',PSHIFT)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','c_grid_axis_shift for ' &
+ istatus = NF90_PUT_ATT(INCID, IVARID, 'long_name',HLONGNAME)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','long_name for '//trim(YVARNAME))
+ if ( Len_trim( hstdname ) > 0 ) then
+ istatus = NF90_PUT_ATT(INCID, IVARID, 'standard_name',HSTDNAME)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','standard_name for '//trim(YVARNAME))
+ end if
+ istatus = NF90_PUT_ATT(INCID, IVARID, 'units','m')
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','units for '//trim(YVARNAME))
+ istatus = NF90_PUT_ATT(INCID, IVARID, 'axis','Z')
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','axis for '//trim(YVARNAME))
+ istatus = NF90_PUT_ATT(INCID, IVARID, 'positive','up')
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','positive for '//trim(YVARNAME))
+ istatus = NF90_PUT_ATT(INCID, IVARID, 'c_grid_axis_shift',PSHIFT)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','c_grid_axis_shift for ' &
//trim(YVARNAME))
WRITE(YRANGE,'( I0,":",I0 )') 1+KBOUNDLOW,ISIZE-KBOUNDHIGH
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'c_grid_dynamic_range',TRIM(YRANGE))
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','c_grid_dynamic_range for ' &
+ istatus = NF90_PUT_ATT(INCID, IVARID, 'c_grid_dynamic_range',TRIM(YRANGE))
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','c_grid_dynamic_range for ' &
//trim(YVARNAME))
!
- IF (GSLEVE) THEN
- !Remark: ZS, ZSMT and ZTOP in the formula are the same for mass point or flux point
- STATUS = NF90_PUT_ATT(INCID, IVARID,'formula_terms','s: '//TRIM(YVARNAME)// &
- ' height: ZTOP oro_ls: ZSMT oro: ZS len1: LEN1 len2: LEN2')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','formula_terms for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'formula_definition','z(n,k,j,i)=s(k)'// &
- '+ oro_ls(j,i)*sinh((height/len1)**1.35-(s(k)/len1)**1.35)/sinh((s(k)/len1)**1.35)'// &
- '+(oro(j,i)-oro_ls(j,i))*sinh((height/len2)**1.35-(s(k)/len2)**1.35)/sinh((s(k)/len2)**1.35)')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','formula_definition for ' &
- //trim(YVARNAME))
- ELSE
- !Remark: ZS and ZTOP in the formula are the same for mass point or flux point
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'formula_terms','s: '//TRIM(YVARNAME)//' height: ZTOP orog: ZS')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','formula_terms for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'formula_definition','z(n,k,j,i)=s(k)*(height-orog(j,i))/height+orog(j,i)')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','formula_definition for ' &
+ if ( Len_trim( hcompname ) > 0 ) then
+ IF (GSLEVE) THEN
+ !Remark: ZS, ZSMT and ZTOP in the formula are the same for mass point or flux point
+ istatus = NF90_PUT_ATT(INCID, IVARID,'formula_terms','s: '//TRIM(YVARNAME)// &
+ ' height: ZTOP oro_ls: ZSMT oro: ZS len1: LEN1 len2: LEN2')
+ IF (istatus /= NF90_NOERR) &
+ CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','formula_terms for '//trim(YVARNAME))
+ istatus = NF90_PUT_ATT(INCID, IVARID, 'formula_definition','z(n,k,j,i)=s(k)'// &
+ '+ oro_ls(j,i)*sinh((height/len1)**1.35-(s(k)/len1)**1.35)/sinh((s(k)/len1)**1.35)'// &
+ '+(oro(j,i)-oro_ls(j,i))*sinh((height/len2)**1.35-(s(k)/len2)**1.35)/sinh((s(k)/len2)**1.35)')
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','formula_definition for ' &
+ //trim(YVARNAME))
+ ELSE
+ !Remark: ZS and ZTOP in the formula are the same for mass point or flux point
+ istatus = NF90_PUT_ATT(INCID, IVARID, 'formula_terms','s: '//TRIM(YVARNAME)//' height: ZTOP orog: ZS')
+ IF (istatus /= NF90_NOERR) &
+ CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','formula_terms for '//trim(YVARNAME))
+ istatus = NF90_PUT_ATT(INCID, IVARID, 'formula_definition','z(n,k,j,i)=s(k)*(height-orog(j,i))/height+orog(j,i)')
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','formula_definition for ' &
+ //trim(YVARNAME))
+ ENDIF
+ !
+ istatus = NF90_PUT_ATT(INCID, IVARID, 'computed_standard_name',HCOMPNAME)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_ATT','computed_standard_name for ' &
//trim(YVARNAME))
- ENDIF
- !
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'computed_standard_name',HCOMPNAME)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_ATT','computed_standard_name for ' &
- //trim(YVARNAME))
+ end if
! Write the data
- STATUS = NF90_PUT_VAR(INCID, IVARID, PCOORDS)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_VER_COORD','NF90_PUT_VAR',trim(YVARNAME))
+ istatus = NF90_PUT_VAR(INCID, IVARID, PCOORDS)
+ IF (istatus /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'WRITE_VER_COORD','NF90_PUT_VAR',trim(YVARNAME))
END SUBROUTINE WRITE_VER_COORD
-SUBROUTINE WRITE_TIME_COORD(TDIM)
- USE MODD_TIME_n, ONLY: TDTMOD, TDTCUR
- USE MODD_TYPE_DATE
+subroutine Write_time_coord( tdim, hlongname, tpdates, tpdates_bound )
+ use modd_field, only: NMNHDIM_PAIR, tfieldlist
+ use modd_time_n, only: tdtmod
+ use modd_type_date, only: date_time
+
+ use mode_datetime, only: Datetime_distance
+ use mode_field, only: Find_field_id_from_mnhname
+
+ type(tdimnc), intent(in) :: tdim
+ character(len=*), intent(in) :: hlongname
+ type(date_time), dimension(:), intent(in) :: tpdates
+ type(date_time), dimension(:,:), optional, intent(in) :: tpdates_bound !Boundaries of the date intervals
+
+ character(len=40) :: yunits
+ character(len=:), allocatable :: yvarname
+ integer :: jt
+ integer(kind=CDFINT) :: ivarid
+ integer(kind=CDFINT) :: ivdim
+ integer(kind=CDFINT) :: istatus
+ integer(kind=CDFINT), dimension(2) :: ivdims
+ real, dimension(:), allocatable :: zdeltatimes_1d
+ real, dimension(:,:), allocatable :: zdeltatimes_2d
+ type(date_time) :: tzref
+
+ if ( Associated( tdtmod ) ) then
+ ! Model beginning date (tdtmod%tdate) is used as the reference date
+ ! Reference time is set to 0.
+ tzref = tdtmod
+ tzref%xtime = 0.
+ else
+ tzref%nyear = 2000
+ tzref%nmonth = 1
+ tzref%nday = 1
+ tzref%xtime = 0.
+ end if
- USE MODE_DATETIME
- USE MODE_FIELD, ONLY: TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
- USE MODE_GRIDPROJ
+ yvarname = Trim( tdim%cname )
+ ivdim = tdim%nid
- TYPE(DIMCDF), POINTER, INTENT(IN) :: TDIM
+ istatus = NF90_INQ_VARID( incid, yvarname, ivarid )
+ if ( istatus /= NF90_NOERR ) then
+ ! Define the coordinate variable
+ istatus = NF90_DEF_VAR( incid, yvarname, mnhreal_nf90, ivdim, ivarid )
+ if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'Write_time_coord', 'NF90_DEF_VAR', Trim( yvarname ) )
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_time_coord', Trim( yvarname ) // ' already defined' )
+ end if
- REAL :: ZDELTATIME
- CHARACTER(LEN=40) :: YUNITS
- CHARACTER(LEN=:),ALLOCATABLE :: YVARNAME
- INTEGER(KIND=CDFINT) :: IVARID
- INTEGER(KIND=CDFINT) :: IVDIM
- INTEGER(KIND=CDFINT) :: STATUS
- TYPE(DATE_TIME) :: TZREF
+ ! Write metadata
+ istatus = NF90_PUT_ATT( incid, ivarid, 'long_name', Trim( hlongname ) )
+ if ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'Write_time_coord', 'NF90_PUT_ATT', 'long_name for ' // Trim( yvarname ) )
+ istatus = NF90_PUT_ATT( incid, ivarid, 'standard_name','time' )
+ IF ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'Write_time_coord', 'NF90_PUT_ATT', 'standard_name for ' // Trim( yvarname ) )
+ Write( yunits, '( "seconds since ", i4.4, "-", i2.2, "-", i2.2, " 00:00:00 +0:00" )' ) &
+ tzref%nyear, tzref%nmonth, tzref%nday
+ istatus = NF90_PUT_ATT( incid, ivarid, 'units', yunits )
+ if ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'Write_time_coord', 'NF90_PUT_ATT', 'units for ' // Trim( yvarname ) )
+ istatus = NF90_PUT_ATT( incid, ivarid, 'axis', 'T' )
+ if ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'Write_time_coord', 'NF90_PUT_ATT', 'axis for ' // Trim( yvarname ) )
+ istatus = NF90_PUT_ATT( incid, ivarid, 'calendar', 'standard' )
+ if ( istatus /= NF90_NOERR ) &
+ call IO_Err_handle_nc4( istatus, 'Write_time_coord', 'NF90_PUT_ATT', 'calendar for ' // Trim( yvarname ) )
+ if ( Present( tpdates_bound ) ) then
+ istatus = NF90_PUT_ATT( incid, ivarid, 'bounds', Trim( yvarname ) // '_bounds' )
+ if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'Write_time_coord', 'NF90_PUT_ATT', &
+ 'bounds for ' // Trim( yvarname ) )
+ end if
+ ! Compute the temporal distance from reference
+ Allocate( zdeltatimes_1d(Size( tpdates )) )
+ do jt = 1, Size( tpdates )
+ call Datetime_distance( tzref, tpdates(jt), zdeltatimes_1d(jt) )
+ end do
- IF (ASSOCIATED(TDTCUR) .AND. ASSOCIATED(TDTMOD)) THEN
- YVARNAME = TRIM(TDIM%NAME)
- IVDIM = TDIM%ID
+ ! Write the data
+ istatus = NF90_PUT_VAR( incid, ivarid, zdeltatimes_1d )
+ if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'Write_time_coord', 'NF90_PUT_VAR', Trim( yvarname ) )
+
+ Deallocate( zdeltatimes_1d )
- STATUS = NF90_INQ_VARID(INCID, YVARNAME, IVARID)
- IF (STATUS /= NF90_NOERR) THEN
+ !Write the date interval boundaries (if provided)
+ if ( Present( tpdates_bound ) ) then
+ yvarname = Trim( tdim%cname ) // '_bounds'
+ istatus = NF90_INQ_VARID( incid, yvarname, ivarid )
+ if ( istatus /= NF90_NOERR ) then
! Define the coordinate variable
- STATUS = NF90_DEF_VAR(INCID, YVARNAME, MNHREAL_NF90, IVDIM, IVARID)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_TIME_COORD','NF90_DEF_VAR',trim(YVARNAME))
- ELSE
- CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_TIME_COORD',TRIM(YVARNAME)//' already defined')
- END IF
+ ivdims(1) = tpfile%tncdims%tdims(NMNHDIM_PAIR)%nid
+ ivdims(2) = tdim%nid
+ istatus = NF90_DEF_VAR( incid, yvarname, MNHREAL_NF90, ivdims, ivarid )
+ if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'Write_time_coord', 'NF90_DEF_VAR', Trim( yvarname ) )
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_time_coord', Trim( yvarname ) // ' already defined' )
+ end if
- ! Write metadata
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'long_name','time axis')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_TIME_COORD','NF90_PUT_ATT','long_name for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'standard_name','time')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_TIME_COORD','NF90_PUT_ATT','standard_name for '//trim(YVARNAME))
- WRITE(YUNITS,'( "seconds since ",I4.4,"-",I2.2,"-",I2.2," 00:00:00 +0:00" )') &
- TDTMOD%TDATE%YEAR,TDTMOD%TDATE%MONTH,TDTMOD%TDATE%DAY
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'units',YUNITS)
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_TIME_COORD','NF90_PUT_ATT','units for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID, 'axis','T')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_TIME_COORD','NF90_PUT_ATT','axis for '//trim(YVARNAME))
- STATUS = NF90_PUT_ATT(INCID, IVARID,'calendar','standard')
- IF (STATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_TIME_COORD','NF90_PUT_ATT','calendar for '//trim(YVARNAME))
-
- ! Model beginning date (TDTMOD%TDATE) is used as the reference date
- ! Reference time is set to 0.
- TZREF = TDTMOD
- TZREF%TIME = 0.
! Compute the temporal distance from reference
- CALL DATETIME_DISTANCE(TZREF,TDTCUR,ZDELTATIME)
+ Allocate( zdeltatimes_2d(2, Size( tpdates_bound, 2 )) )
+ do jt = 1, Size( tpdates_bound, 2 )
+ call Datetime_distance( tzref, tpdates_bound(1, jt), zdeltatimes_2d(1, jt) )
+ call Datetime_distance( tzref, tpdates_bound(2, jt), zdeltatimes_2d(2, jt) )
+ end do
+
! Write the data
- STATUS = NF90_PUT_VAR(INCID, IVARID, ZDELTATIME)
- IF (status /= NF90_NOERR) CALL IO_Err_handle_nc4(status,'WRITE_TIME_COORD','NF90_PUT_VAR',trim(YVARNAME))
- END IF
+ istatus = NF90_PUT_VAR( incid, ivarid, zdeltatimes_2d(:,:) )
+ if ( istatus /= NF90_NOERR ) call IO_Err_handle_nc4( istatus, 'Write_time_coord', 'NF90_PUT_VAR', Trim( yvarname ) )
+ end if
+
+end subroutine Write_time_coord
+
+
+subroutine Write_flyer_time_coord( tpflyer )
+ use NETCDF
+
+ use modd_aircraft_balloon
+ 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
-END SUBROUTINE WRITE_TIME_COORD
+ !Do it only if correct model level and has really flown
+ if ( tpflyer%nmodel == imi .and. Count( tpflyer%x /= XUNDEF) > 1 ) then
+ Allocate( tzdim )
+
+ 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 Flyers not found' )
+ end if
+
+ 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( ytype_clean ) // ' not found' )
+ end if
+
+ 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 ) // ' 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 ) // ' time_flyer dimension 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 )
+
+ Deallocate( tzdim )
+
+ !Restore file identifier to root group
+ incid = tpfile%nncid
+ end if
+
+end subroutine Write_flyer_time_coord
END SUBROUTINE IO_Coordvar_write_nc4
@@ -1987,6 +2371,12 @@ IF (TPFILE%LMASTER) THEN
#endif
IF (ISTATUS /= NF90_NOERR) CALL IO_Err_handle_nc4(istatus,'IO_FILE_WRITE_HEADER','NF90_PUT_ATT','MNH_INT')
+ if ( tpfile%ldimreduced ) then
+ istatus = NF90_PUT_ATT( tpfile%nncid, NF90_GLOBAL, 'MNH_REDUCE_DIMENSIONS_IN_FILES', '1')
+ else
+ istatus = NF90_PUT_ATT( tpfile%nncid, NF90_GLOBAL, 'MNH_REDUCE_DIMENSIONS_IN_FILES', '0')
+ endif
+
!title
!history
@@ -2062,6 +2452,38 @@ END IF
END SUBROUTINE IO_History_append_nc4
+subroutine IO_Select_split_file( tpfile, tpfield, tpfileout, tpfieldout, kvertlevel, kzfile )
+type(tfiledata), target, intent(in) :: tpfile
+type(tfielddata), target, intent(in) :: tpfield
+type(tfielddata), pointer, intent(out) :: tpfieldout
+type(tfiledata), pointer, intent(out) :: tpfileout
+integer, optional, intent(in) :: kvertlevel ! Number of the vertical level (needed for Z-level split files)
+integer, optional, intent(in) :: kzfile ! Number of the Z-level split file
+
+character(len=4) :: ysuffix
+
+if ( Present( kvertlevel ) ) then
+ if ( kvertlevel > 9999 ) call Print_msg( NVERB_FATAL, 'IO', 'IO_Select_split_file','too many vertical levels' )
+ if ( .not. Present( kzfile ) ) call Print_msg( NVERB_FATAL, 'IO', 'IO_Select_split_file', 'kzfile argument not provided' )
+ if ( kzfile > tpfile%nsubfiles_ioz ) call Print_msg( NVERB_FATAL, 'IO', 'IO_Select_split_file', 'kzfile value too high' )
+
+ Write( ysuffix, '( i4.4 )' ) kvertlevel
+ tpfileout => tpfile%tfiles_ioz(kzfile)%tfile
+ !Copy the values of tpfield to the pointer tpfieldout (new tfielddata)
+ Allocate( tpfieldout )
+ tpfieldout = tpfield
+ tpfieldout%cmnhname = Trim( tpfieldout%cmnhname ) // ysuffix
+ if ( Len_trim( tpfieldout%cstdname ) > 0 ) tpfieldout%cstdname = Trim( tpfieldout%cstdname ) // '_at_level_' // ysuffix
+ if ( Len_trim( tpfieldout%clongname ) > 0 ) tpfieldout%clongname = Trim( tpfieldout%clongname ) // ' at level ' // ysuffix
+ tpfieldout%ndims = 2
+else
+ tpfileout => tpfile
+ tpfieldout => tpfield
+endif
+
+end subroutine IO_Select_split_file
+
+
end module mode_io_write_nc4
#else
!
diff --git a/src/LIB/SURCOUCHE/src/mode_mnh_world.f90 b/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
index 30124a276c7604ef0c476633eb18d13e38e4bc10..7aaf82d86990e4c625d69ec289f045086845bc7d 100644
--- a/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
+++ b/src/LIB/SURCOUCHE/src/mode_mnh_world.f90
@@ -14,6 +14,7 @@
! P. Wautelet 10/07/2019: add identification of version 2.7 of OpenACC + print properties of ACC_DEVICE_HOST
! P. Wautelet 10/10/2019: remove ACC_DEVICE_RADEON and ACC_DEVICE_XEONPHI devices
! P. Wautelet 21/11/2019: bugfix: close call could be done on a non-opened file
+! J. Escobar 11/02/2020: For GA , replace MPI_INIT_THREAD -> MPI_INIT
!-----------------------------------------------------------------
MODULE MODE_MNH_WORLD
IMPLICIT NONE
@@ -77,7 +78,7 @@ CONTAINS
CALL MPI_INITIALIZED(GISINIT, KINFO_ll)
IF (.NOT. GISINIT) THEN
#ifdef MNH_GA
- CALL MPI_INIT_thread(REQUIRED,PROVIDED,KINFO_ll)
+ CALL MPI_INIT(KINFO_ll)
#else
CALL MPI_INIT(KINFO_ll)
#endif
diff --git a/src/LIB/SURCOUCHE/src/mode_msg.f90 b/src/LIB/SURCOUCHE/src/mode_msg.f90
index 6532afab8cc57e2d8df00593cb0bd3b520c9408f..80d2f6677cf7209871081707050fbf5b14de918a 100644
--- a/src/LIB/SURCOUCHE/src/mode_msg.f90
+++ b/src/LIB/SURCOUCHE/src/mode_msg.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2017-2019 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.
@@ -9,37 +9,95 @@
! P. Wautelet 27/02/2019: module extracted from mode_io.f90
! P. Wautelet 04/04/2019: force write on stderr for all processes in print_msg if abort
! P. Wautelet 02/07/2019: flush messages also for files opened with newunit (logical unit can be negative)
+! P. Wautelet 17/01/2020: add 'BUD' category for Print_msg
+! P. Wautelet 08/04/2020: add multiline Print_msg
+! P. Wautelet 01/07/2021: add counters for the number of prints + subroutine Msg_stats
!-----------------------------------------------------------------
-MODULE MODE_MSG
-!
-USE MODD_IO, ONLY: NVERB_FATAL, NVERB_ERROR, NVERB_WARNING, NVERB_INFO, NVERB_DEBUG
-!
-IMPLICIT NONE
-!
-CONTAINS
-!
-SUBROUTINE PRINT_MSG(KVERB,HDOMAIN,HSUBR,HMSG)
+module mode_msg
+
+use modd_io, only: NVERB_FATAL, NVERB_ERROR, NVERB_WARNING, NVERB_INFO, NVERB_DEBUG
+
+implicit none
+
+integer, parameter :: NMSGLGTMAX = 100 ! Maximum length for a message
+integer, parameter :: NMSGLLINEMAX = 10 ! Maximum number of lines for a message
+
+character(len=NMSGLGTMAX), dimension(NMSGLLINEMAX) :: cmnhmsg = ''
+
+integer, save :: nfatal = 0
+integer, save :: nerror = 0
+integer, save :: nwarning = 0
+integer, save :: ninfo = 0
+integer, save :: ndebug = 0
+
+interface Print_msg
+ module procedure Print_msg_1line, Print_msg_multi_cmnhmsg, Print_msg_multi
+end interface Print_msg
+
+
+contains
+
+subroutine Print_msg_1line( kverb, hdomain, hsubr, hmsg )
+ integer, intent(in) :: kverb !Verbosity level
+ character(len=*), intent(in) :: hdomain !Domain/category of message
+ character(len=*), intent(in) :: hsubr !Subroutine/function name
+ character(len=*), intent(in) :: hmsg !Message
+
+ call Print_msg_multi( kverb, hdomain, hsubr, [hmsg] )
+
+end subroutine Print_msg_1line
+
+
+subroutine Print_msg_multi_cmnhmsg( kverb, hdomain, hsubr )
+
+ integer, intent(in) :: kverb !Verbosity level
+ character(len=*), intent(in) :: hdomain !Domain/category of message
+ character(len=*), intent(in) :: hsubr !Subroutine/function name
+
+ integer :: ilines
+
+ !Find the last non empty line
+ ilines = size( cmnhmsg )
+ do while ( len_trim( cmnhmsg(ilines) ) == 0 )
+ ilines = ilines - 1
+ end do
+
+ call Print_msg_multi( kverb, hdomain, hsubr, cmnhmsg(1 : ilines) )
+
+ !Empty the message buffer
+ !This is necessary especially if the next call contain a shorter message
+ cmnhmsg(1 : ilines) = ''
+
+end subroutine Print_msg_multi_cmnhmsg
+
+
+subroutine Print_msg_multi( KVERB, HDOMAIN, HSUBR, HMSG )
!
USE ISO_FORTRAN_ENV, ONLY: ERROR_UNIT, OUTPUT_UNIT
!
USE MODD_CONF, ONLY: CPROGRAM
-USE MODD_IO, ONLY: NIO_VERB, NIO_ABORT_LEVEL, NGEN_VERB, NGEN_ABORT_LEVEL, &
+USE MODD_IO, ONLY: NBUD_VERB, NBUD_ABORT_LEVEL, NIO_VERB, NIO_ABORT_LEVEL, NGEN_VERB, NGEN_ABORT_LEVEL, &
LVERB_OUTLST, LVERB_STDOUT, LVERB_ALLPRC, TFILE_OUTPUTLISTING
USE MODD_LUNIT, ONLY: TLUOUT0
-USE MODD_VAR_ll, ONLY: IP, NMNH_COMM_WORLD
+USE MODD_VAR_ll, ONLY: IP, NMNH_COMM_WORLD, NPROC
!
use modi_tools_c
!
-INTEGER, INTENT(IN) :: KVERB !Verbosity level
-CHARACTER(LEN=*),INTENT(IN) :: HDOMAIN !Domain/category of message
-CHARACTER(LEN=*),INTENT(IN) :: HSUBR !Subroutine/function name
-CHARACTER(LEN=*),INTENT(IN) :: HMSG !Message
+INTEGER, INTENT(IN) :: KVERB !Verbosity level
+CHARACTER(LEN=*), INTENT(IN) :: HDOMAIN !Domain/category of message
+CHARACTER(LEN=*), INTENT(IN) :: HSUBR !Subroutine/function name
+CHARACTER(LEN=*), dimension(:), INTENT(IN) :: HMSG !Message
!
-CHARACTER(LEN=8) :: YPRC
+character(len=2) :: ysz
+CHARACTER(LEN=2) :: YPRC
+character(len=8) :: yprcnb
CHARACTER(LEN=9) :: YPRE
CHARACTER(LEN=30) :: YSUBR
+character(len=:), allocatable :: yformat
INTEGER :: IERR, IMAXVERB,IABORTLEVEL
INTEGER :: ILU
+integer :: ji
+integer :: ilines
LOGICAL :: GWRITE_OUTLST,GWRITE_STDOUT
!
!Determine if the process will write
@@ -67,6 +125,10 @@ ELSE
END IF
!
SELECT CASE(HDOMAIN)
+ CASE('BUD')
+ !Budget messages
+ IMAXVERB = NBUD_VERB
+ IABORTLEVEL = NBUD_ABORT_LEVEL
CASE('IO')
IMAXVERB = NIO_VERB
IABORTLEVEL = NIO_ABORT_LEVEL
@@ -80,40 +142,114 @@ SELECT CASE(HDOMAIN)
END SELECT
!
IF (KVERB>IMAXVERB) RETURN
-!
+
+ilines = size( hmsg )
+
SELECT CASE(KVERB)
CASE(NVERB_FATAL)
YPRE='FATAL: '
+ nfatal = nfatal + 1
CASE(NVERB_ERROR)
YPRE='ERROR: '
+ nerror = nerror + 1
CASE(NVERB_WARNING)
YPRE='WARNING: '
+ nwarning = nwarning + 1
CASE(NVERB_INFO)
YPRE='INFO: '
+ ninfo = ninfo + 1
CASE(NVERB_DEBUG)
YPRE='DEBUG: '
+ ndebug = ndebug + 1
CASE DEFAULT
IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'ERROR: PRINT_MSG: wrong verbosity level'
IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT=*) 'ERROR: PRINT_MSG: wrong verbosity level'
END SELECT
!
-WRITE(YPRC,'( I8 )') IP-1
-!
YSUBR=TRIM(HSUBR)//':'
-IF (LVERB_ALLPRC) THEN
- IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT="(A8,': ',A9,A30,A)") ADJUSTL(YPRC),YPRE,YSUBR,HMSG
- IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT="(A8,': ',A9,A30,A)") ADJUSTL(YPRC),YPRE,YSUBR,HMSG
-ELSE
- IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT="(A9,A30,A)") YPRE,YSUBR,HMSG
- IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT="(A9,A30,A)") YPRE,YSUBR,HMSG
-END IF
+
+if ( ilines < 10 ) then
+ ysz = 'I1'
+else if ( ilines < 100 ) then
+ ysz = 'I2'
+else if ( ilines < 1000 ) then
+ ysz = 'I3'
+else
+ ysz = 'I4'
+end if
+
+if ( lverb_allprc ) then
+ if ( nproc < 10 ) then
+ yprc = 'I1'
+ else if ( nproc < 100 ) then
+ yprc = 'I2'
+ else if ( nproc < 1000 ) then
+ yprc = 'I3'
+ else if ( nproc < 10000 ) then
+ yprc = 'I4'
+ else if ( nproc < 100000 ) then
+ yprc = 'I5'
+ else if ( nproc < 1000000 ) then
+ yprc = 'I6'
+ else if ( nproc < 10000000 ) then
+ yprc = 'I7'
+ else
+ yprc = 'I8'
+ end if
+
+ if ( gwrite_stdout ) then
+ if ( ilines == 1 ) then
+ yformat = '(' // yprc // ','': '',a9,a30,a)'
+ Write( unit = output_unit, fmt = yformat ) ip - 1, ypre, ysubr, hmsg
+ else
+ yformat = '(' // yprc // ','': '',a9,a30,' // ysz // ',''/'',' // ysz // ','': '',a)'
+ do ji = 1, ilines
+ Write( unit = output_unit, fmt = yformat ) ip - 1, ypre, ysubr, ji, ilines, Trim( hmsg(ji) )
+ end do
+ end if
+ end if
+ if ( gwrite_outlst ) then
+ if ( ilines == 1 ) then
+ yformat = '(' // yprc // ','': '',a9,a30,a)'
+ Write( unit = ilu, fmt = yformat) ip - 1, ypre, ysubr, hmsg
+ else
+ yformat = '(' // yprc // ','': '',a9,a30,' // ysz // ',''/'',' // ysz // ','': '',a)'
+ do ji = 1, ilines
+ Write( unit = ilu, fmt = yformat) ip - 1, ypre, ysubr, ji, ilines, Trim( hmsg(ji) )
+ end do
+ end if
+ end if
+else
+ if ( gwrite_stdout ) then
+ if ( ilines == 1 ) then
+ Write( unit = output_unit, fmt = "(a9,a30,a)" ) ypre, ysubr, Trim( hmsg(1) )
+ else
+ yformat = '(a9,a30,' // ysz // ',''/'',' // ysz // ','': '',a)'
+ do ji = 1, ilines
+ Write(unit = output_unit, fmt = yformat ) ypre, ysubr, ji, ilines, Trim( hmsg(ji) )
+ end do
+ end if
+ end if
+ if ( gwrite_outlst ) then
+ if ( ilines == 1 ) then
+ Write( unit = ilu, fmt = "(a9,a30,a)") ypre, ysubr, Trim( hmsg(1) )
+ else
+ yformat = '(a9,a30,' // ysz // ',''/'',' // ysz // ','': '',a)'
+ do ji = 1, ilines
+ Write( unit = ilu, fmt = yformat) ypre, ysubr, ji, ilines, Trim( hmsg(ji) )
+ end do
+ end if
+ end if
+end if
!
IF (KVERB<=IABORTLEVEL) THEN
+ Write( yprcnb, '( i8 )' ) ip - 1
+
IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'ABORT asked by application '//TRIM(CPROGRAM)
IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT=*) 'ABORT asked by application '//TRIM(CPROGRAM)
!Every process write on the error unit. This is necessary if the abort is done by an other process than 0.
- WRITE(UNIT=ERROR_UNIT,FMT="(A8,': ',A9,A30,A)") ADJUSTL(YPRC),YPRE,YSUBR,HMSG
- WRITE(UNIT=ERROR_UNIT,FMT="(A8,': ',A)") ADJUSTL(YPRC),'ABORT asked by application '//TRIM(CPROGRAM)
+ WRITE(UNIT=ERROR_UNIT,FMT="(A8,': ',A9,A30,A)") ADJUSTL(yprcnb),YPRE,YSUBR,HMSG
+ WRITE(UNIT=ERROR_UNIT,FMT="(A8,': ',A)") ADJUSTL(yprcnb),'ABORT asked by application '//TRIM(CPROGRAM)
#if 0
!Problem: loop dependency between MODE_MSG and MODE_FM (IO_FILE_CLOSE_ll call PRINT_MSG)
NIO_VERB = 0 !To not get further messages (ABORT should be the last for readability)
@@ -130,6 +266,33 @@ IF (KVERB<=IABORTLEVEL) THEN
CALL ABORT
END IF
!
-END SUBROUTINE PRINT_MSG
-!
-END MODULE MODE_MSG
+end subroutine Print_msg_multi
+
+
+subroutine Msg_stats()
+
+character(len=10) :: ydebug
+character(len=10) :: yinfo
+character(len=10) :: ywarning
+character(len=10) :: yerror
+character(len=10) :: yfatal
+
+Write( ydebug, '( I10 )' ) ndebug
+Write( yinfo, '( I10 )' ) ninfo
+Write( ywarning, '( I10 )' ) nwarning
+Write( yerror, '( I10 )' ) nerror
+Write( yfatal, '( I10 )' ) nfatal
+
+Write( cmnhmsg(1), '( A )' ) 'Number of calls to Print_msg (with actual printing):'
+Write( cmnhmsg(2), '( A, A10 )' ) ' Calls with level DEBUG: ', ydebug
+Write( cmnhmsg(3), '( A, A10 )' ) ' Calls with level INFO: ', yinfo
+Write( cmnhmsg(4), '( A, A10 )' ) ' Calls with level WARNING: ', ywarning
+Write( cmnhmsg(5), '( A, A10 )' ) ' Calls with level ERROR: ', yerror
+Write( cmnhmsg(6), '( A, A10 )' ) ' Calls with level FATAL: ', yfatal
+
+call Print_msg( NVERB_INFO, 'GEN', 'Msg_stats' )
+
+end subroutine Msg_stats
+
+
+end module mode_msg
diff --git a/src/LIB/SURCOUCHE/src/mode_scatter.f90 b/src/LIB/SURCOUCHE/src/mode_scatter.f90
index 32eaa729052794702023468e113cecabaa913449..b81b5a29422b5bdcd6e3fdb2f40eb2bd7cde2c1b 100644
--- a/src/LIB/SURCOUCHE/src/mode_scatter.f90
+++ b/src/LIB/SURCOUCHE/src/mode_scatter.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -7,6 +7,7 @@
! J. Escobar 10/02/2012: bug in MPI_RECV: replace MPI_STATUSES_IGNORE with MPI_STATUS_IGNORE
! P. Wautelet 26/04/2019: use modd_precision parameters for datatypes of MPI communications
! P. Wautelet 25/06/2019: added IO_Field_read for 3D integer arrays (SCATTERXX_N3 and SCATTERXY_N3)
+! J. Escobar 21/07/2020: for reduction of MPI_BUFFER_SIZE, in SCATTERXY_X3 replace MPI_BSEND -> MPI_ISEND
!-----------------------------------------------------------------
MODULE MODE_SCATTER_ll
@@ -467,7 +468,8 @@ END IF
END SUBROUTINE SCATTERXY_X2
SUBROUTINE SCATTERXY_X3(PSEND,PRECV,KROOT,KCOMM)
-USE MODD_IO, ONLY: ISP, ISNPROC
+USE MODD_IO, ONLY: ISP, ISNPROC
+USE MODD_VAR_ll, ONLY: MNH_STATUSES_IGNORE
REAL,DIMENSION(:,:,:),TARGET,INTENT(IN) :: PSEND
REAL,DIMENSION(:,:,:), INTENT(INOUT):: PRECV
@@ -475,25 +477,45 @@ INTEGER, INTENT(IN) :: KROOT
INTEGER, INTENT(IN) :: KCOMM
INTEGER :: IERR
-INTEGER :: JI
+INTEGER :: JI,JKU
INTEGER :: IXO,IXE,IYO,IYE
REAL,DIMENSION(:,:,:), POINTER :: TX3DP
+
+INTEGER,ALLOCATABLE,DIMENSION(:) :: REQ_TAB
+INTEGER :: NB_REQ
+TYPE TX_3DP
+ REAL,DIMENSION(:,:,:), POINTER :: X
+END TYPE TX_3DP
+TYPE(TX_3DP),ALLOCATABLE,DIMENSION(:) :: T_TX3DP
+
+JKU = SIZE(PSEND,3)
IF (ISP == KROOT) THEN
- DO JI = 1,ISNPROC
- CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
- TX3DP=>PSEND(IXO:IXE,IYO:IYE,:)
-
- IF (ISP /= JI) THEN
- CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
- & ,IERR)
- ELSE
- PRECV(:,:,:) = TX3DP(:,:,:)
- END IF
- END DO
+ NB_REQ=0
+ ALLOCATE(REQ_TAB(ISNPROC-1))
+ ALLOCATE(T_TX3DP(ISNPROC-1))
+ DO JI = 1,ISNPROC
+ CALL GET_DOMREAD_ll(JI,IXO,IXE,IYO,IYE)
+ TX3DP=>PSEND(IXO:IXE,IYO:IYE,:)
+ IF (ISP /= JI) THEN
+ NB_REQ = NB_REQ + 1
+ ALLOCATE(T_TX3DP(NB_REQ)%X(IXO:IXE,IYO:IYE,JKU))
+ T_TX3DP(NB_REQ)%X=TX3DP
+ CALL MPI_ISEND(T_TX3DP(NB_REQ)%X,SIZE(TX3DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
+ & ,REQ_TAB(NB_REQ),IERR)
+ !CALL MPI_BSEND(TX3DP,SIZE(TX3DP),MNHREAL_MPI,JI-1,199+KROOT,KCOMM&
+ ! & ,IERR)
+ ELSE
+ PRECV(:,:,:) = TX3DP(:,:,:)
+ END IF
+ END DO
+ IF (NB_REQ .GT.0 ) THEN
+ CALL MPI_WAITALL(NB_REQ,REQ_TAB,MNH_STATUSES_IGNORE,IERR)
+ DO JI=1,NB_REQ ; DEALLOCATE(T_TX3DP(JI)%X) ; ENDDO
+ END IF
ELSE
- CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
- & ,MPI_STATUS_IGNORE,IERR)
+ CALL MPI_RECV(PRECV,SIZE(PRECV),MNHREAL_MPI,KROOT-1,199+KROOT,KCOMM&
+ & ,MPI_STATUS_IGNORE,IERR)
END IF
END SUBROUTINE SCATTERXY_X3
diff --git a/src/LIB/SURCOUCHE/src/mode_tools_ll.f90 b/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
index b5fbe7198a2e4bd55d549e75aa671f105bef252e..6736a75bd4ce68d5d2d8060d0f123ac49991c54c 100644
--- a/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_tools_ll.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -2486,7 +2486,7 @@ ENDIF
!
INTEGER, INTENT(IN) :: K ! Number of elements of TPSPLIT
!
- TYPE(ZONE_ll), INTENT(IN) :: TPZONE ! Zone to be splitted
+ TYPE(ZONE_ll), INTENT(IN) :: TPZONE ! Zone to be split
!
TYPE(ZONE_ll), DIMENSION(:), INTENT(OUT) :: TPRES ! Splitting of the zone
!
diff --git a/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90 b/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90
index e76d24d1dee8d995cc60e06084eebba6a43518d4..ac917b4922addd7461f223efc7841c68e08d19ce 100644
--- a/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90
+++ b/src/LIB/SURCOUCHE/src/mode_toolsz_ll.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -1124,7 +1124,7 @@
!
INTEGER, INTENT(IN) :: K ! Number of elements of TPSPLIT
!
- TYPE(ZONE_ll), INTENT(IN) :: TPZONE ! Zone to be splitted
+ TYPE(ZONE_ll), INTENT(IN) :: TPZONE ! Zone to be split
!
TYPE(ZONE_ll), DIMENSION(:), INTENT(OUT) :: TPRES ! Splitting of the zone
!
diff --git a/src/LIB/SURCOUCHE/src/modn_confio.f90 b/src/LIB/SURCOUCHE/src/modn_confio.f90
index 8505a61f96ad0b37b485f5f7fe850abe34a72ec9..7c89947c1c47d3cd7a3b31dd8872df2d19bea917 100644
--- a/src/LIB/SURCOUCHE/src/modn_confio.f90
+++ b/src/LIB/SURCOUCHE/src/modn_confio.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2014-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2014-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -29,15 +29,16 @@
!! MODIFICATIONS
!! -------------
!! Original 31/03/2014
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! Philippe Wautelet: 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll to allow to disable writes (for bench purposes)
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 21/01/2019: add LIO_ALLOW_NO_BACKUP and LIO_NO_WRITE to modd_io_ll to allow to disable writes (for bench purposes)
+! P. Wautelet 17/01/2020: add 'BUD' category for Print_msg + corresponding namelist variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_IO, ONLY : LVERB_OUTLST, LVERB_STDOUT, LVERB_ALLPRC, &
- NIO_VERB, NIO_ABORT_LEVEL, NGEN_VERB, NGEN_ABORT_LEVEL, &
+ NBUD_VERB, NBUD_ABORT_LEVEL, NIO_VERB, NIO_ABORT_LEVEL, NGEN_VERB, NGEN_ABORT_LEVEL, &
CIO_DIR, LIO_ALLOW_NO_BACKUP, LIO_NO_WRITE
!
IMPLICIT NONE
@@ -49,6 +50,7 @@ LOGICAL,SAVE :: LLFIREAD = .FALSE. ! TRUE : enable LFI reading (disable NetCDF4
NAMELIST/NAM_CONFIO/LCDF4, LLFIOUT, LLFIREAD, &
LVERB_OUTLST, LVERB_STDOUT, LVERB_ALLPRC, &
+ NBUD_VERB, NBUD_ABORT_LEVEL, &
NIO_VERB, NIO_ABORT_LEVEL, &
NGEN_VERB, NGEN_ABORT_LEVEL, CIO_DIR, &
LIO_ALLOW_NO_BACKUP, LIO_NO_WRITE
diff --git a/src/LIB/SURCOUCHE/src/test_double_double.f90 b/src/LIB/SURCOUCHE/src/test_double_double.f90
index 59b0b2976b5efbf1a835a7da28bbf824b6354f7e..d5cacbcc3292a141a4b86cc4a60aaaef1b7f4de6 100644
--- a/src/LIB/SURCOUCHE/src/test_double_double.f90
+++ b/src/LIB/SURCOUCHE/src/test_double_double.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -13,7 +13,6 @@ PROGRAM TEST_DOUBLE_DOUBLE
IMPLICIT NONE
- !INCLUDE 'mpif.h'
INTEGER , PARAMETER :: n =1024
REAL array(n)
INTEGER myPE, totPEs, stat(MPI_STATUS_SIZE), ierr
diff --git a/src/LIB/eccodes-2.18.0-Source.tar.gz b/src/LIB/eccodes-2.18.0-Source.tar.gz
new file mode 100644
index 0000000000000000000000000000000000000000..f212b62eb2df59168e02d8377b4fd4a225c02db6
--- /dev/null
+++ b/src/LIB/eccodes-2.18.0-Source.tar.gz
@@ -0,0 +1,3 @@
+version https://git-lfs.github.com/spec/v1
+oid sha256:d88943df0f246843a1a062796edbf709ef911de7269648eef864be259e9704e3
+size 11525701
diff --git a/src/LIB/hdf5-1.12.0.tar.gz b/src/LIB/hdf5-1.12.0.tar.gz
new file mode 100644
index 0000000000000000000000000000000000000000..b61a243e0a1baa69da1ba494a00809af9cc32f4e
--- /dev/null
+++ b/src/LIB/hdf5-1.12.0.tar.gz
@@ -0,0 +1,3 @@
+version https://git-lfs.github.com/spec/v1
+oid sha256:a62dcb276658cb78e6795dd29bf926ed7a9bc4edf6e77025cd2c689a8f97c17a
+size 12580850
diff --git a/src/LIB/hdf5-1.8.20.tar.gz b/src/LIB/hdf5-1.8.20.tar.gz
deleted file mode 100644
index 447023d0e56d0d777591e73b0fedcf4e395f89a3..0000000000000000000000000000000000000000
--- a/src/LIB/hdf5-1.8.20.tar.gz
+++ /dev/null
@@ -1,3 +0,0 @@
-version https://git-lfs.github.com/spec/v1
-oid sha256:6ed660ccd2bc45aa808ea72e08f33cc64009e9dd4e3a372b53438b210312e8d9
-size 12475267
diff --git a/src/LIB/libaec-0.3.2.tar.gz b/src/LIB/libaec-0.3.2.tar.gz
deleted file mode 100644
index 3db97620e305b772c290ad9ee1bca700cbd1ad0e..0000000000000000000000000000000000000000
--- a/src/LIB/libaec-0.3.2.tar.gz
+++ /dev/null
@@ -1,3 +0,0 @@
-version https://git-lfs.github.com/spec/v1
-oid sha256:acb7cbf4e8f3c63a9ea1af1e1a2d0c9658f4831deb7327f110bdd5c187dc3441
-size 353185
diff --git a/src/LIB/libaec-0.3.4.tar.gz b/src/LIB/libaec-0.3.4.tar.gz
new file mode 100644
index 0000000000000000000000000000000000000000..f35f3df1af288e0354f300788a86d57583a287fd
--- /dev/null
+++ b/src/LIB/libaec-0.3.4.tar.gz
@@ -0,0 +1,3 @@
+version https://git-lfs.github.com/spec/v1
+oid sha256:62af371b50b9ee93fa1d0d038809f3b1ab4dc4b75c182982fcdcd90c1847666b
+size 1495364
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/LIB/netcdf-4.5.0.tar.gz b/src/LIB/netcdf-4.5.0.tar.gz
deleted file mode 100644
index 0a4c4e97f1205f13cced56a6f990769fc0e48d76..0000000000000000000000000000000000000000
--- a/src/LIB/netcdf-4.5.0.tar.gz
+++ /dev/null
@@ -1,3 +0,0 @@
-version https://git-lfs.github.com/spec/v1
-oid sha256:cbe70049cf1643c4ad7453f86510811436c9580cb7a1684ada2f32b95b00ca79
-size 5494644
diff --git a/src/LIB/netcdf-c-4.7.4.tar.gz b/src/LIB/netcdf-c-4.7.4.tar.gz
new file mode 100644
index 0000000000000000000000000000000000000000..e0062fbd761c0bb1ac3ef87e0e39e01339371ff9
--- /dev/null
+++ b/src/LIB/netcdf-c-4.7.4.tar.gz
@@ -0,0 +1,3 @@
+version https://git-lfs.github.com/spec/v1
+oid sha256:99930ad7b3c4c1a8e8831fb061cb02b2170fc8e5ccaeda733bd99c3b9d31666b
+size 19711158
diff --git a/src/LIB/netcdf-cxx-4.2.tar.gz b/src/LIB/netcdf-cxx-4.2.tar.gz
deleted file mode 100644
index 11c1c15536cf186d606f9de7d6468223a68e838d..0000000000000000000000000000000000000000
--- a/src/LIB/netcdf-cxx-4.2.tar.gz
+++ /dev/null
@@ -1,3 +0,0 @@
-version https://git-lfs.github.com/spec/v1
-oid sha256:95ed6ab49a0ee001255eac4e44aacb5ca4ea96ba850c08337a3e4c9a0872ccd1
-size 703482
diff --git a/src/LIB/netcdf-cxx4-4.3.1.tar.gz b/src/LIB/netcdf-cxx4-4.3.1.tar.gz
new file mode 100644
index 0000000000000000000000000000000000000000..900c4c472461ed192b58aeefa2437bd079dad0cb
--- /dev/null
+++ b/src/LIB/netcdf-cxx4-4.3.1.tar.gz
@@ -0,0 +1,3 @@
+version https://git-lfs.github.com/spec/v1
+oid sha256:6a1189a181eed043b5859e15d5c080c30d0e107406fbb212c8fb9814e90f3445
+size 598335
diff --git a/src/LIB/netcdf-fortran-4.4.4.tar.gz b/src/LIB/netcdf-fortran-4.4.4.tar.gz
deleted file mode 100644
index 9be947375c0f2c086b65cc306376e822cda7eb04..0000000000000000000000000000000000000000
--- a/src/LIB/netcdf-fortran-4.4.4.tar.gz
+++ /dev/null
@@ -1,3 +0,0 @@
-version https://git-lfs.github.com/spec/v1
-oid sha256:b2d395175f8d283e68c8be516e231a96b191ade67ad0caafaf7fa01b1e6b5d75
-size 1025980
diff --git a/src/LIB/netcdf-fortran-4.5.3.tar.gz b/src/LIB/netcdf-fortran-4.5.3.tar.gz
new file mode 100644
index 0000000000000000000000000000000000000000..8533eec91cf5a04b7a03244a9ff06aef193b0f55
--- /dev/null
+++ b/src/LIB/netcdf-fortran-4.5.3.tar.gz
@@ -0,0 +1,3 @@
+version https://git-lfs.github.com/spec/v1
+oid sha256:c6da30c2fe7e4e614c1dff4124e857afbd45355c6798353eccfa60c0702b495a
+size 1805683
diff --git a/src/MNH/addfluctuations.f90 b/src/MNH/addfluctuations.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0d7ae1ab637917c6745e8806f07b65a619e2eb98
--- /dev/null
+++ b/src/MNH/addfluctuations.f90
@@ -0,0 +1,177 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!#####################
+MODULE MODI_ADDFLUCTUATIONS
+!#####################
+!
+INTERFACE
+!
+ SUBROUTINE ADDFLUCTUATIONS ( &
+ HLBCX,HLBCY, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT, &
+ PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE, &
+ PFLUCTWTW,PFLUCTWTN,PFLUCTWTS,PFLUCTWTE )
+
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE ! tengential velocity fluctuations
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTWTN,PFLUCTWTW,PFLUCTWTS,PFLUCTWTE ! vertical tengential velocity fluctuations
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+END SUBROUTINE ADDFLUCTUATIONS
+!
+END INTERFACE
+!
+END MODULE MODI_ADDFLUCTUATIONS
+!
+!
+! ####################################################################
+SUBROUTINE ADDFLUCTUATIONS ( &
+ HLBCX,HLBCY, &
+ PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT, &
+ PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE, &
+ PFLUCTWTW,PFLUCTWTN,PFLUCTWTS,PFLUCTWTE )
+! ####################################################################
+!
+!!**** *ADDFLUCTUATIONS* - routine adding the velocity fluctuations to the
+!! Lateral Boundary Conditions for turbulence
+!! recycling purpose.
+!!
+!! PURPOSE
+!! -------
+!! EXTERNAL
+!! --------
+!! GET_INDICE_ll : get physical sub-domain bounds
+!! LWEAST_ll,LEAST_ll,LNORTH_ll,LSOUTH_ll : position functions
+!!
+!! AUTHORS
+!! ------
+!! T.Nagel, V.Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/2021
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS
+USE MODD_LBC_n, ONLY : XPOND
+USE MODD_RECYCL_PARAM_n
+USE MODE_MODELN_HANDLER
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!
+!* 0.1 declarations of arguments
+CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUTN,PFLUCTVTW,PFLUCTUTS,PFLUCTVTE ! tengential velocity fluctuations
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTWTN,PFLUCTWTW,PFLUCTWTS,PFLUCTWTE ! vertical tengential velocity fluctuations
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
+ ! Variables at t
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IIB ! indice I Beginning in x direction
+INTEGER :: IJB ! indice J Beginning in y direction
+INTEGER :: IKB ! indice K Beginning in z direction
+INTEGER :: IIE ! indice I End in x direction
+INTEGER :: IJE ! indice J End in y direction
+INTEGER :: IKE ! indice K End in z direction
+INTEGER :: JI,JJ
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
+! ----------------------------------------------
+CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+IKB = 1 + JPVEXT
+IKE = SIZE(PUT,3) - JPVEXT
+!
+!* 2. ADD FLUCTUATIONS THE X DIRECTION (LEFT WEST SIDE):
+! ------------------------------------------------
+IF (LRECYCLW) THEN
+ IF (LWEST_ll( )) THEN
+ SELECT CASE ( HLBCX(1) )
+ CASE ('OPEN')
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=JPHEXT,1,-1
+ PUT(JI,:,:)=0.
+ WHERE ( PUT(IIB,:,:) > 0. ) !INFLOW condition
+ PVT (JI,:,:) = PVT (JI,:,:)+XRCOEFF*PFLUCTVTW
+ PWT (JI,:,:) = PWT (JI,:,:)+XRCOEFF*PFLUCTWTW
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!* 3. ADD FLUCTUATIONS THE X DIRECTION (RIGHT EAST SIDE):
+! ------------------------------------------------
+IF (LRECYCLE) THEN
+ IF (LEAST_ll( )) THEN
+ SELECT CASE ( HLBCX(2) )
+ CASE ('OPEN')
+ IF(SIZE(PUT) /= 0) THEN
+ DO JI=1,JPHEXT
+ WHERE ( PUT(IIE+1,:,:) < 0. ) !INFLOW condition
+ PVT (IIE+JI,:,:) = PVT (IIE+JI,:,:)+XRCOEFF*PFLUCTVTE
+ PWT (IIE+JI,:,:) = PWT (IIE+JI,:,:)+XRCOEFF*PFLUCTWTE
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!* 4. ADD FLUCTUATIONS THE Y DIRECTION (BOTTOM SOUTH SIDE):
+! ------------------------------------------------
+IF (LRECYCLS) THEN
+ IF (LSOUTH_ll( )) THEN
+ SELECT CASE ( HLBCY(1) )
+ CASE ('OPEN')
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=JPHEXT,1,-1
+ PVT(:,JJ,:)=0.
+ WHERE ( PVT(:,IJB,:) > 0. ) !INFLOW condition
+ PUT (:,JJ,:) = PUT (:,JJ,:)+XRCOEFF*PFLUCTUTS
+ PWT (:,JJ,:) = PWT (:,JJ,:)+XRCOEFF*PFLUCTWTS
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!* 5. ADD FLUCTUATIONS THE Y DIRECTION (TOP NORTH SIDE):
+! ------------------------------------------------
+IF (LRECYCLN) THEN
+ IF (LNORTH_ll( )) THEN
+ SELECT CASE ( HLBCY(2) )
+ CASE ('OPEN')
+ IF(SIZE(PVT) /= 0) THEN
+ DO JJ=1,JPHEXT
+ WHERE ( PVT(:,IJE+1,:) < 0. ) !INFLOW condition
+ PUT (:,IJE+JJ,:) = PUT (:,IJE+JJ,:)+XRCOEFF*PFLUCTUTN
+ PWT (:,IJE+JJ,:) = PWT (:,IJE+JJ,:)+XRCOEFF*PFLUCTWTN
+ ENDWHERE
+ ENDDO
+ ENDIF
+ END SELECT
+ ENDIF
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE ADDFLUCTUATIONS
+
diff --git a/src/MNH/adjust_langlois.f90 b/src/MNH/adjust_langlois.f90
index ed6df1d2ac06b4b3574e5b8c5b2673e8f3bcac0f..531ccc9f7301f3b28e975affe1ea62fd684d6926 100644
--- a/src/MNH/adjust_langlois.f90
+++ b/src/MNH/adjust_langlois.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
! ######################
MODULE MODI_ADJUST_LANGLOIS
! ######################
@@ -85,7 +86,6 @@ END MODULE MODI_ADJUST_LANGLOIS
!! Module MODD_BUDGET:
!! NBUMOD
!! CBUTYPE
-!! NBUPROCCTR
!! LBU_RTH
!! LBU_RRV
!! LBU_RRC
@@ -114,10 +114,8 @@ END MODULE MODI_ADJUST_LANGLOIS
USE MODD_PARAMETERS
USE MODD_CST
USE MODD_CONF
-USE MODD_BUDGET
!
USE MODI_CONDENSATION
-USE MODI_BUDGET
!
IMPLICIT NONE
!
diff --git a/src/MNH/adv_forcingn.f90 b/src/MNH/adv_forcingn.f90
index 5a824682580112b59bb000187ea54dcb2bc9d01d..7b7605f1f27b7cdc786227e2128c79806f04c004 100644
--- a/src/MNH/adv_forcingn.f90
+++ b/src/MNH/adv_forcingn.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2010-2019 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.
+!-----------------------------------------------------------------
! #####################
MODULE MODI_ADV_FORCING_n
! #####################
@@ -52,12 +53,6 @@ END MODULE MODI_ADV_FORCING_n
!!
!! NB: For relaxation forcing, only mask=FIXE has been implemented for simplicity
!!
-!! DUMMIES: LDUMMY(2)=T allows ADV forcing
-!! LDUMMY3=T ------- REL -------
-!! with XDUMMY1=lower limit of relaxation (m)
-!! XDUMMY2=top limit of relxation (m)
-!! XDUMMY3=relaxation timsescale (s)
-!!
!! EXTERNAL
!! --------
!! Temporal_lt function (compare 2 TYPEd date_and_time data)
@@ -76,7 +71,6 @@ END MODULE MODI_ADV_FORCING_n
!! JPVEXT: define the number of marginal points out of the
!! physical domain along the vertical direction.
!! Module MODD_TIME: contains the structure of the TYPEd date_and_time
-!! Module MODD_BLANK: Uses LDUMMY(2)=T to activate the time varying adv frc
!!
!! REFERENCE
!! ---------
@@ -94,22 +88,22 @@ END MODULE MODI_ADV_FORCING_n
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 28/03/2018 P. Wautelet: replace TEMPORAL_DIST by DATETIME_DISTANCE
!! use overloaded comparison operator for date_time
-!!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_ADVFRC_n ! Modules for time evolving advfrc
-USE MODD_BUDGET
+use modd_budget, only: lbudget_rv, lbudget_th, NBUDGET_RV, NBUDGET_TH, tbudgets
USE MODD_DYN
USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_TIME
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_DATETIME
!
-USE MODI_BUDGET
USE MODI_SHUMAN
!
IMPLICIT NONE
@@ -146,7 +140,10 @@ LOGICAL,DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: GRELAX_MASK_FRC ! M
!
!* 1. PREPARATION OF FORCING
! ----------------------
-!
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), '2DADV', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), '2DADV', prrs (:, :, :, 1) )
+
ILUOUT0 = TLUOUT0%NLU
!
IF (GSFIRSTCALL) THEN
@@ -157,10 +154,10 @@ IF (GSFIRSTCALL) THEN
WRITE(UNIT=ILUOUT0,FMT='(" THERE ARE ",I2," ADV FORCING FIELDs AT:")') NADVFRC
DO JSX_ADV = 1 , NADVFRC
WRITE(UNIT=ILUOUT0,FMT='(F9.0, "s, date:", I3, "/", I3, "/", I5)') &
- TDTADVFRC(JSX_ADV)%TIME, &
- TDTADVFRC(JSX_ADV)%TDATE%DAY, &
- TDTADVFRC(JSX_ADV)%TDATE%MONTH, &
- TDTADVFRC(JSX_ADV)%TDATE%YEAR
+ TDTADVFRC(JSX_ADV)%xtime, &
+ TDTADVFRC(JSX_ADV)%nday, &
+ TDTADVFRC(JSX_ADV)%nmonth, &
+ TDTADVFRC(JSX_ADV)%nyear
END DO
!* 1.2 find first sounding to be used
@@ -216,7 +213,6 @@ END IF
! 2.2 Integration of the forcing in the source
! ------------------------------------------
-! 2.2.1 Advective forcing in LDUMMY(2)=T
DO JK=1,JPVEXT
ZXADVTHFRC(:,:,JK) = 0.
ZXADVRVFRC(:,:,JK) = 0.
@@ -227,8 +223,9 @@ END IF
!
!* 3. BUDGET CALLS
! ------------
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'2DADV_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'2DADV_BU_RRV')
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), '2DADV', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), '2DADV', prrs (:, :, :, 1) )
+
!----------------------------------------------------------------------------
!
END SUBROUTINE ADV_FORCING_n
diff --git a/src/MNH/advec_ppm_algo.f90 b/src/MNH/advec_ppm_algo.f90
index 87800519b5602b48be66a28d9b6d3ecf0048740a..6f4b449f5dd68ea0179e4df16d54bb57ff0a3828 100644
--- a/src/MNH/advec_ppm_algo.f90
+++ b/src/MNH/advec_ppm_algo.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -207,7 +207,7 @@ END IF
!$acc kernels present(PSRC,PFIELDT)
PSRC = PFIELDT
!$acc end kernels
-GFLAG = ABS(MOD(TPDTCUR%TIME/PTSTEP,2.)-1.) .LE. 0.5
+GFLAG = ABS(MOD(TPDTCUR%xtime/PTSTEP,2.)-1.) .LE. 0.5
!
SELECT CASE (HMET_ADV_SCHEME)
!
diff --git a/src/MNH/advecmet.f90 b/src/MNH/advecmet.f90
deleted file mode 100644
index f16414b4293bd0d32dd32859089d51afd0460c4a..0000000000000000000000000000000000000000
--- a/src/MNH/advecmet.f90
+++ /dev/null
@@ -1,240 +0,0 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_ADVECMET
-! #######################
-INTERFACE
- SUBROUTINE ADVECMET ( KRR, PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-END SUBROUTINE ADVECMET
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECMET
-!
-!
-!
-! ######################################################################
- SUBROUTINE ADVECMET ( KRR, PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-! ######################################################################
-!
-!!**** *ADVECMET * - routine to compute the advection tendancies of the
-!! meterological scalar fields.
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the total advection
-!! tendancies of the meteorological scalar fields, written in flux form.
-!! The advection velocity is taken as the contravariant form of
-!! the momentum for extension to non-cartesian geometry and
-!! conformal projection cases.
-!!
-!!
-!!** METHOD
-!! ------
-!! The left and right lateral EXTernal zones, have been previously
-!! prepared in routine LBC_S, to avoid particular cases close to the
-!! Lateral Boundaries in this routine.
-!! The Shuman functions are used to write the mean and finite
-!! differences operators.
-!! The different sources terms are stored for the budget
-!! computations.
-!!
-!! EXTERNAL
-!! --------
-!! MXM,MYM,MZM : Shuman functions (mean operators)
-!! DXM,DYM,DZM : Shuman functions (finite differences operators)
-!! BUDGET : Stores the different budget components
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RTH : logical for budget of RTH (potential temperature)
-!! .TRUE. = budget of RTH
-!! .FALSE. = no budget of RTH
-!! LBU_RTKE : logical for budget of RTKE (turbulent kinetic energy)
-!! .TRUE. = budget of RTKE
-!! .FALSE. = no budget of RTKE
-!! LBU_RRV : logical for budget of RRV (water vapor)
-!! .TRUE. = budget of RRV
-!! .FALSE. = no budget of RRV
-!! LBU_RRC : logical for budget of RRC (cloud water)
-!! .TRUE. = budget of RRC
-!! .FALSE. = no budget of RRC
-!! LBU_RRR : logical for budget of RRR (rain water)
-!! .TRUE. = budget of RRR
-!! .FALSE. = no budget of RRR
-!! LBU_RRI : logical for budget of RRI (ice)
-!! .TRUE. = budget of RRI
-!! .FALSE. = no budget of RRI
-!! LBU_RRS : logical for budget of RRS (snow)
-!! .TRUE. = budget of RRS
-!! .FALSE. = no budget of RRS
-!! LBU_RRG : logical for budget of RRG (graupel)
-!! .TRUE. = budget of RRG
-!! .FALSE. = no budget of RRG
-!! LBU_RRH : logical for budget of RRH (hail)
-!! .TRUE. = budget of RRH
-!! .FALSE. = no budget of RRH
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book2 of documentation ( routine ADVECMET )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/07/94
-!! Corrections 06/09/94 (J.-P. Lafore)
-!! 16/03/95 (J. Stein) remove R from the historical var.
-!! 01/04/95 (Ph. Hereil J. Nicolau) add the budget computation
-!! 16/10/95 (J. Stein) change the budget calls
-!! 19/12/96 (J.-P. Pinty) update the budget calls
-!! 07/11/02 (V. Masson) update the budget calls
-!! 24/04/06 (C.Lac) Split meteorological scalar and passive
-!! tracer routines
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET
-USE MODD_GRID_n
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JRR ! Loop index for moist variables
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTES THE ADVECTIVE TENDENCIES
-! ---------------------------------
-!
- ! Thermodynamical variable
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DXF( PRUCT(:,:,:) * MXM (PTHT(:,:,:)) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVX_BU_RTH')
-!
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DYF( PRVCT(:,:,:) * MYM (PTHT(:,:,:)) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVY_BU_RTH')
-!
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DZF( PRWCT(:,:,:) * MZM (PTHT(:,:,:)) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVZ_BU_RTH')
-!
- ! Case with KRR moist variables
-DO JRR=1,KRR
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DXF( PRUCT(:,:,:) * MXM (PRT(:,:,:,JRR)) )
-END DO
-!
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVX_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVX_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVX_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVX_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVX_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVX_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVX_BU_RRH')
-!
-DO JRR=1,KRR
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DYF( PRVCT(:,:,:) * MYM (PRT(:,:,:,JRR)) )
-END DO
-!
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVY_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVY_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVY_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVY_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVY_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVY_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVY_BU_RRH')
-!
-DO JRR=1,KRR
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DZF( PRWCT(:,:,:) * MZM (PRT(:,:,:,JRR)) )
-END DO
-!
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVZ_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVZ_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVZ_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVZ_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVZ_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVZ_BU_RRH')
-!
- ! TKE variable
-IF (SIZE(PTKET,1) /= 0) THEN
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DXF( PRUCT(:,:,:) * MXM (PTKET(:,:,:)) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVX_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DYF( PRVCT(:,:,:) * MYM (PTKET(:,:,:)) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVY_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DZF( PRWCT(:,:,:) * MZM (PTKET(:,:,:)) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVZ_BU_RTKE')
-END IF
-!
-!
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECMET
diff --git a/src/MNH/advecmet_4th.f90 b/src/MNH/advecmet_4th.f90
deleted file mode 100644
index a0bd62e1558285c84c566d92d73161dc5b1888d6..0000000000000000000000000000000000000000
--- a/src/MNH/advecmet_4th.f90
+++ /dev/null
@@ -1,315 +0,0 @@
-!MNH_LIC Copyright 2005-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ###############################
- MODULE MODI_ADVECMET_4TH
-! ###############################
-!
-INTERFACE
-!
- SUBROUTINE ADVECMET_4TH (HLBCX,HLBCY, KRR, &
- PRUCT, PRVCT, PRWCT, &
- PTHT, PTKET, PRT, &
- PRTHS, PRTKES, PRRS, TPHALO2LIST )
-!
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! Vars at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES! Source terms
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
-!
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
-!
-END SUBROUTINE ADVECMET_4TH
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECMET_4TH
-!
-! ######################################################################
- SUBROUTINE ADVECMET_4TH (HLBCX,HLBCY, KRR, &
- PRUCT, PRVCT, PRWCT, &
- PTHT, PTKET, PRT, &
- PRTHS, PRTKES, PRRS, TPHALO2LIST )
-! ######################################################################
-!
-!!**** *ADVEC_4TH_ORDER * - routine to compute the 4th order centered
-!! advection tendency of scalar variables
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to call the ADVEC_4TH_ORDER_ALGO
-!! routine for the horizontal advection and the MZM4 and MZF4 functions for
-!! the vertical advection of each prognostic variable. The code is
-!! parallelized and works for various boundary conditions.
-!!
-!!** METHOD
-!! ------
-!! For each prognostic variable the ADVEC_4TH_ORDER routine calls
-!! the ADVEC_4TH_ORDER_ALGO routine which computes the numerical advection
-!! of any 3D field.
-!! The following variables are passed as argument to ADVEC_4TH_ORDER_ALGO :
-!!
-!! -- The variable at t
-!! -- The second layer of the halo of the field at t
-!! -- The horizontal advection fluxes
-!! -- The localisation on the model grid :
-!!
-!! IGRID = 1 for mass grid point
-!! IGRID = 2 for U grid point
-!! IGRID = 3 for V grid point
-!! IGRID = 4 for w grid point
-!!
-!! EXTERNAL
-!! --------
-!! BUDGET : Stores the different budget components
-!! (not used in current version)
-!! ADVEC_4TH_ORDER_ALGO : computes the horizontal advection fluxes
-!! MZF4 and MZM4 : computes the vertical advection fluxes
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODULE MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! Switches for budgets activations:
-!!
-!! LBU_RU : logical for budget of RU (wind component along x)
-!!
-!! LBU_RU : logical for budget of RU (wind component along x)
-!! .TRUE. = budget of RU
-!! .FALSE. = no budget of RU
-!! LBU_RV : logical for budget of RV (wind component along y)
-!! .TRUE. = budget of RV
-!! .FALSE. = no budget of RV
-!! LBU_RW : logical for budget of RW (wind component along z)
-!! .TRUE. = budget of RW
-!! .FALSE. = no budget of RW
-!! LBU_RTH : logical for budget of RTH (potential temperature)
-!! .TRUE. = budget of RTH
-!! .FALSE. = no budget of RTH
-!! LBU_RTKE : logical for budget of RTKE (turbulent kinetic energy)
-!! .TRUE. = budget of RTKE
-!! .FALSE. = no budget of RTKE
-!! LBU_RRV : logical for budget of RRV (water vapor)
-!! .TRUE. = budget of RRV
-!! .FALSE. = no budget of RRV
-!! LBU_RRC : logical for budget of RRC (cloud water)
-!! .TRUE. = budget of RRC
-!! .FALSE. = no budget of RRC
-!! LBU_RRR : logical for budget of RRR (rain water)
-!! .TRUE. = budget of RRR
-!! .FALSE. = no budget of RRR
-!! LBU_RRI : logical for budget of RRI (ice)
-!! .TRUE. = budget of RRI
-!! .FALSE. = no budget of RRI
-!! LBU_RRS : logical for budget of RRS (snow)
-!! .TRUE. = budget of RRS
-!! .FALSE. = no budget of RRS
-!! LBU_RRG : logical for budget of RRG (graupel)
-!! .TRUE. = budget of RRG
-!! .FALSE. = no budget of RRG
-!! LBU_RRH : logical for budget of RRH (hail)
-!! .TRUE. = budget of RRH
-!! .FALSE. = no budget of RRH
-!!
-!! MODULE MODD_ARGSLIST
-!! HALO2LIST_ll : type for a list of "HALO2_lls"
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation ( routine ADVEC_4TH_ORDER )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 25/10/05
-!!
-!! Correction :
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODE_ll
-!
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_GRID_n
-USE MODD_BUDGET
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
-! incorporate ADVEC_4TH_ORDER_ALG, MZF4 and MZM4
-USE MODI_ADVEC_4TH_ORDER_AUX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! Vars at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES! Source terms
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
-!
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
-!
-!* 0.2 Declarations of local variables :
-!
-!
-INTEGER :: JRR ! Loop index for moist variables
-INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
-INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-!
-LOGICAL :: GTKEALLOC ! true if TKE arrays are not zero-sized
-!
-TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST
-!
-INTEGER :: IGRID ! localisation on the model grid
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: ZMEANX, ZMEANY ! fluxes
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTES THE DOMAIN DIMENSIONS
-! ------------------------------
-!
-CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
-!
-GTKEALLOC = SIZE(PTKET,1) /= 0
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. CALL THE ADVEC_4TH_ORDER_ALGO ROUTINE FOR EACH FIELD
-! ----------------------------------------------------
-!
-IGRID = 1
-!
-!!$IF (NHALO == 1) THEN
- TZHALO2LIST => TPHALO2LIST
- CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PTHT, IGRID, ZMEANX, ZMEANY, &
- TZHALO2LIST%HALO2 )
-!!$ELSE
-!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PTHT, IGRID, ZMEANX, ZMEANY)
-!!$ENDIF
-!
-! Thermodynamical variable
-!
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DXF( PRUCT(:,:,:) * ZMEANX(:,:,:) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVX_BU_RTH')
-!
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DYF( PRVCT(:,:,:) * ZMEANY(:,:,:) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVY_BU_RTH')
-!
-PRTHS(:,:,:) = PRTHS(:,:,:) &
- -DZF( PRWCT(:,:,:) * MZM4(PTHT(:,:,:)) )
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVZ_BU_RTH')
-!
-! Turbulence variables
-!
-IF ( GTKEALLOC ) THEN
-!!$ IF(NHALO == 1) THEN
- TZHALO2LIST => TZHALO2LIST%NEXT
- CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PTKET, IGRID, &
- ZMEANX, ZMEANY, TPHALO2=TZHALO2LIST%HALO2)
-!!$ ELSE
-!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PTKET, IGRID, ZMEANX, ZMEANY)
-!!$ ENDIF
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DXF( PRUCT(:,:,:) * ZMEANX(:,:,:) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVX_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DYF( PRVCT(:,:,:) * ZMEANY(:,:,:) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVY_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) &
- -DZF( PRWCT(:,:,:) * MZM4(PTKET(:,:,:)) )
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVZ_BU_RTKE')
-ENDIF
-!
-!
-! Case with KRR moist variables
-!
-DO JRR=1, KRR
-!!$ IF(NHALO == 1) THEN
- TZHALO2LIST => TZHALO2LIST%NEXT
- CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PRT(:,:,:,JRR), IGRID, &
- ZMEANX, ZMEANY,TPHALO2=TZHALO2LIST%HALO2 )
-!!$ ELSE
-!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PRT(:,:,:,JRR), IGRID, ZMEANX, ZMEANY)
-!!$ ENDIF
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DXF( PRUCT(:,:,:) * ZMEANX(:,:,:) )
- IF (JRR==1 .AND. LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVX_BU_RRV')
- IF (JRR==2 .AND. LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVX_BU_RRC')
- IF (JRR==3 .AND. LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVX_BU_RRR')
- IF (JRR==4 .AND. LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVX_BU_RRI')
- IF (JRR==5 .AND. LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVX_BU_RRS')
- IF (JRR==6 .AND. LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVX_BU_RRG')
- IF (JRR==7 .AND. LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVX_BU_RRH')
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DYF( PRVCT(:,:,:) * ZMEANY(:,:,:) )
- IF (JRR==1 .AND. LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVY_BU_RRV')
- IF (JRR==2 .AND. LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVY_BU_RRC')
- IF (JRR==3 .AND. LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVY_BU_RRR')
- IF (JRR==4 .AND. LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVY_BU_RRI')
- IF (JRR==5 .AND. LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVY_BU_RRS')
- IF (JRR==6 .AND. LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVY_BU_RRG')
- IF (JRR==7 .AND. LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVY_BU_RRH')
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) &
- -DZF( PRWCT(:,:,:) * MZM4(PRT(:,:,:,JRR)) )
- IF (JRR==1 .AND. LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
- IF (JRR==2 .AND. LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVZ_BU_RRC')
- IF (JRR==3 .AND. LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVZ_BU_RRR')
- IF (JRR==4 .AND. LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVZ_BU_RRI')
- IF (JRR==5 .AND. LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADVZ_BU_RRS')
- IF (JRR==6 .AND. LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADVZ_BU_RRG')
- IF (JRR==7 .AND. LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADVZ_BU_RRH')
-ENDDO
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECMET_4TH
-
-
diff --git a/src/MNH/advecscalar.f90 b/src/MNH/advecscalar.f90
deleted file mode 100644
index 44e315a3dd7a875ac3135a8bd00a0f62fe1ead87..0000000000000000000000000000000000000000
--- a/src/MNH/advecscalar.f90
+++ /dev/null
@@ -1,168 +0,0 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_ADVECSCALAR
-! #######################
-INTERFACE
- SUBROUTINE ADVECSCALAR ( KSV, PSVT, PRUCT, PRVCT, PRWCT, PRSVS )
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-END SUBROUTINE ADVECSCALAR
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECSCALAR
-!
-!
-!
-! ######################################################################
- SUBROUTINE ADVECSCALAR ( KSV, PSVT, PRUCT, PRVCT, PRWCT, PRSVS )
-! ######################################################################
-!
-!!**** *ADVECSCALAR * - routine to compute the advection tendancies of the
-!! tracer scalar fields.
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the total advection
-!! tendancies of all the scalar fields, written in flux form.
-!! The advection velocity is taken as the contravariant form of
-!! the momentum for extension to non-cartesian geometry and
-!! conformal projection cases.
-!!
-!!
-!!** METHOD
-!! ------
-!! The left and right lateral EXTernal zones, have been previously
-!! prepared in routine LBC_S, to avoid particular cases close to the
-!! Lateral Boundaries in this routine.
-!! The Shuman functions are used to write the mean and finite
-!! differences operators.
-!! The different sources terms are stored for the budget
-!! computations.
-!!
-!! EXTERNAL
-!! --------
-!! MXM,MYM,MZM : Shuman functions (mean operators)
-!! DXM,DYM,DZM : Shuman functions (finite differences operators)
-!! BUDGET : Stores the different budget components
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RSV : logical for budget of RSVx (scalar variables)
-!! .TRUE. = budget of RSV
-!! .FALSE. = no budget of RSV
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book2 of documentation ( routine ADVECSCALAR )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/07/94
-!! Corrections 06/09/94 (J.-P. Lafore)
-!! 16/03/95 (J. Stein) remove R from the historical var.
-!! 01/04/95 (Ph. Hereil J. Nicolau) add the budget computation
-!! 16/10/95 (J. Stein) change the budget calls
-!! 19/12/96 (J.-P. Pinty) update the budget calls
-!! 07/11/02 (V. Masson) update the budget calls
-!! 24/04/06 (C.Lac) Split scalar and passive
-!! tracer routines
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET
-USE MODD_GRID_n
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JSV ! Loop index for Scalar Variables
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTES THE ADVECTIVE TENDENCIES
-! ---------------------------------
-!
- ! Case with KSV Scalar Variables
-DO JSV=1,KSV
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DXF( PRUCT(:,:,:) * MXM (PSVT(:,:,:,JSV)) )
-END DO
-IF (LBUDGET_SV) THEN
- DO JSV=1,KSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVX_BU_RSV')
- END DO
-END IF
-!
-DO JSV=1,KSV
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DYF( PRVCT(:,:,:) * MYM (PSVT(:,:,:,JSV)) )
-END DO
-IF (LBUDGET_SV) THEN
- DO JSV=1,KSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVY_BU_RSV')
- END DO
-END IF
-!
-DO JSV=1,KSV
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DZF( PRWCT(:,:,:) * MZM (PSVT(:,:,:,JSV)) )
-END DO
-IF (LBUDGET_SV) THEN
- DO JSV=1,KSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVZ_BU_RSV')
- END DO
-END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECSCALAR
diff --git a/src/MNH/advecscalar_4th.f90 b/src/MNH/advecscalar_4th.f90
deleted file mode 100644
index 9fa8e7847713bf95c7a63f46a84f4018211238a3..0000000000000000000000000000000000000000
--- a/src/MNH/advecscalar_4th.f90
+++ /dev/null
@@ -1,204 +0,0 @@
-!MNH_LIC Copyright 2005-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ###############################
- MODULE MODI_ADVECSCALAR_4TH
-! ###############################
-!
-INTERFACE
-!
- SUBROUTINE ADVECSCALAR_4TH (HLBCX,HLBCY, KSV, PRUCT, PRVCT, PRWCT, &
- PSVT, PRSVS, TPHALO2LIST )
-!
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT !
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS !
-!
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
-!
-END SUBROUTINE ADVECSCALAR_4TH
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECSCALAR_4TH
-!
-! ######################################################################
- SUBROUTINE ADVECSCALAR_4TH (HLBCX,HLBCY, KSV, PRUCT, PRVCT, PRWCT, &
- PSVT, PRSVS, TPHALO2LIST )
-! ######################################################################
-!
-!!**** *ADVEC_4TH_ORDER * - routine to compute the 4th order centered
-!! advection tendency of scalar variables
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to call the ADVEC_4TH_ORDER_ALGO
-!! routine for the horizontal advection and the MZM4 and MZF4 functions for
-!! the vertical advection of each prognostic variable. The code is
-!! parallelized and works for various boundary conditions.
-!!
-!!** METHOD
-!! ------
-!! For each prognostic variable the ADVEC_4TH_ORDER routine calls
-!! the ADVEC_4TH_ORDER_ALGO routine which computes the numerical advection
-!! of any 3D field.
-!! The following variables are passed as argument to ADVEC_4TH_ORDER_ALGO :
-!!
-!! -- The variable at t
-!! -- The second layer of the halo of the field at t
-!! -- The horizontal advection fluxes
-!! -- The localisation on the model grid :
-!!
-!! IGRID = 1 for mass grid point
-!! IGRID = 2 for U grid point
-!! IGRID = 3 for V grid point
-!! IGRID = 4 for w grid point
-!!
-!! EXTERNAL
-!! --------
-!! BUDGET : Stores the different budget components
-!! (not used in current version)
-!! ADVEC_4TH_ORDER_ALGO : computes the horizontal advection fluxes
-!! MZF4 and MZM4 : computes the vertical advection fluxes
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODULE MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! Switches for budgets activations:
-!!
-!! LBU_RSV : logical for budget of RSVx (scalar variable)
-!! .TRUE. = budget of RSVx
-!! .FALSE. = no budget of RSVx
-!!
-!! MODULE MODD_ARGSLIST
-!! HALO2LIST_ll : type for a list of "HALO2_lls"
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation ( routine ADVEC_4TH_ORDER )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 25/10/05
-!!
-!! Correction :
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODE_ll
-!
-USE MODD_PARAMETERS
-USE MODD_GRID_n
-USE MODD_CONF
-USE MODD_BUDGET
-USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
-! incorporate ADVEC_4TH_ORDER_ALG, MZF4 and MZM4
-USE MODI_ADVEC_4TH_ORDER_AUX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! X direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! Y direction LBC type
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT !
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
-!
-TYPE(HALO2LIST_ll), POINTER :: TPHALO2LIST ! list for diffusion
-!
-!* 0.2 Declarations of local variables :
-!
-!
-INTEGER :: JSV ! Loop index for Scalar Variables
-INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
-INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-!
-TYPE(HALO2LIST_ll), POINTER :: TZHALO2LIST
-!
-INTEGER :: IGRID ! localisation on the model grid
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZMEANX, ZMEANY ! fluxes
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTES THE DOMAIN DIMENSIONS
-! ------------------------------
-!
-CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. CALL THE ADVEC_4TH_ORDER_ALGO ROUTINE FOR EACH FIELD
-! ----------------------------------------------------
-!
-IGRID = 1
-!
-!
-! Case with KSV tracers
-!
-DO JSV=1,KSV
-!
-!!$ IF(NHALO == 1) THEN
- TZHALO2LIST => TPHALO2LIST
- CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PSVT(:,:,:,JSV), IGRID, &
- ZMEANX, ZMEANY,TZHALO2LIST%HALO2 )
-!!$ ELSE
-!!$ CALL ADVEC_4TH_ORDER_ALGO(HLBCX, HLBCY, PSVT(:,:,:,JSV), IGRID, ZMEANX, ZMEANY)
-!!$ ENDIF
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DXF( PRUCT(:,:,:) * ZMEANX(:,:,:) )
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVX_BU_RSV')
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DYF( PRVCT(:,:,:) * ZMEANY(:,:,:) )
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVY_BU_RSV')
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) &
- -DZF( PRWCT(:,:,:) * MZM4(PSVT(:,:,:,JSV)) )
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVZ_BU_RSV')
-ENDDO
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECSCALAR_4TH
-
-
diff --git a/src/MNH/advection_metsv.f90 b/src/MNH/advection_metsv.f90
index abcc8301158a92794d8fe674f14f0185ef166566..5742179517a0c711441012d7d3841d90e3332ec0 100644
--- a/src/MNH/advection_metsv.f90
+++ b/src/MNH/advection_metsv.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.
@@ -8,7 +8,7 @@
! ###########################
!
INTERFACE
- SUBROUTINE ADVECTION_METSV (TPFILE, OCLOSE_OUT,HUVW_ADV_SCHEME, &
+ SUBROUTINE ADVECTION_METSV (TPFILE, HUVW_ADV_SCHEME, &
HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD, KSPLIT, &
OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
HLBCX, HLBCY, KRR, KSV, TPDTCUR, PTSTEP, &
@@ -17,11 +17,9 @@ INTERFACE
PRTHS, PRRS, PRTKES, PRSVS, &
PRTHS_CLD, PRRS_CLD, PRSVS_CLD, PRTKES_ADV )
!
-USE MODD_IO, ONLY: TFILEDATA
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_TYPE_DATE, ONLY: DATE_TIME
!
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
HSV_ADV_SCHEME, & ! scheme applied
@@ -64,7 +62,7 @@ END INTERFACE
!
END MODULE MODI_ADVECTION_METSV
! ##########################################################################
- SUBROUTINE ADVECTION_METSV (TPFILE, OCLOSE_OUT,HUVW_ADV_SCHEME, &
+ SUBROUTINE ADVECTION_METSV (TPFILE, HUVW_ADV_SCHEME, &
HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD, KSPLIT, &
OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT, &
HLBCX, HLBCY, KRR, KSV, TPDTCUR, PTSTEP, &
@@ -133,10 +131,14 @@ END MODULE MODI_ADVECTION_METSV
!! 04/2016 (C.Lac) : correction of negativity for KHKO
!! 10/2016 (C.Lac) Correction on the flag for Strang splitting
!! to insure reproducibility between START and RESTA
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! 07/2017 (V. Vionnet) : add advection of 2D variables at
-!! the surface for the blowing snow scheme
+! V. Vionnet 07/2017: add advection of 2D variables at the surface for the blowing snow scheme
+! 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
+! B. Vie 03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 11/06/2020: bugfix: correct PRSVS array indices
+! P. Wautelet + Benoît 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -147,51 +149,59 @@ USE MODD_MPIF
use modd_precision, only: MNHREAL_MPI
USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
#endif
-USE MODD_BUDGET
-USE MODD_CST
-USE MODD_CTURB, ONLY: XTKEMIN
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+use modd_budget, only: lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_TKE, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF, ONLY: LNEUTRAL,NHALO,L1D, L2D
+USE MODD_CST
+USE MODD_CTURB, ONLY: XTKEMIN
+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
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA
USE MODD_PARAM_n
+USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
USE MODD_TYPE_DATE, ONLY: DATE_TIME
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-USE MODD_PARAMETERS
!
use mode_argslist_ll, only: ADD3DFIELD_ll, ADD4DFIELD_ll, CLEANLIST_ll, LIST_ll
+use mode_budget, only: Budget_store_init, Budget_store_end
+#ifdef MNH_OPENACC
+USE MODE_DEVICE
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
+#endif
use mode_exchange_ll, only: UPDATE_HALO_ll
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
USE MODE_MSG
+use mode_sources_neg_correct, only: Sources_neg_correct
+#ifndef MNH_OPENACC
use mode_sum_ll, only: MAX_ll
+#endif
use mode_tools_ll, only: GET_INDICE_ll, lnorth_ll, lsouth_ll, least_ll, lwest_ll
!
USE MODI_ADV_BOUNDARIES
-USE MODI_BUDGET
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
USE MODI_CONTRAV
USE MODI_GET_HALO
USE MODI_PPM_RHODJ
USE MODI_PPM_MET
USE MODI_PPM_SCALAR
!
-#ifdef MNH_OPENACC
-USE MODE_DEVICE
-USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
-#endif
-#ifdef MNH_BITREP
-USE MODI_BITREP
-#endif
-!
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for synchronous
- ! file opening
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
CHARACTER(LEN=6), INTENT(IN) :: HMET_ADV_SCHEME, & ! Control of the
HSV_ADV_SCHEME, & ! scheme applied
@@ -367,16 +377,30 @@ allocate( ZCPH ( SIZE(PUT, 1), SIZE(PUT, 2), SIZE(PUT, 3) )
!
!* 0. INITIALIZATION
! --------------
-!
+
+GTKE=(SIZE(PTKET)/=0)
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'ADV', prths (:, :, :) )
+if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'ADV', prtkes(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'ADV', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC ), 'ADV', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR ), 'ADV', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI ), 'ADV', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS ), 'ADV', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG ), 'ADV', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH ), 'ADV', prrs (:, :, :, 7) )
+if ( lbudget_sv) then
+ do jsv = 1, ksv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv ), 'ADV', prsvs(:, :, :, jsv) )
+ end do
+end if
+
ILUOUT = TLUOUT%NLU
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IKB=1+JPVEXT
IKE=SIZE(PSVT,3) - JPVEXT
-!
-GTKE=(SIZE(PTKET)/=0)
-!
#ifdef MNH_OPENACC
CALL INIT_ON_HOST_AND_DEVICE(PRTKES_ADV,PVALUE=-1e99,HNAME='ADVECTION_METSV::PRTKES_ADV')
CALL INIT_ON_HOST_AND_DEVICE(ZRUCPPM,PVALUE=-1e90,HNAME='ADVECTION_METSV::ZRUCPPM')
@@ -455,6 +479,26 @@ IF (.NOT. L1D) THEN
ZCFLU(IIB:IIE,IJB:IJE,:) = ABS(ZRUCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
ZCFLV(IIB:IIE,IJB:IJE,:) = ABS(ZRVCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
ZCFLW(IIB:IIE,IJB:IJE,:) = ABS(ZRWCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
+ IF (LIBM) THEN
+#ifndef MNH_BITREP
+ ZCFLU(IIB:IIE,IJB:IJE,:) = ZCFLU(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,2)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+ ZCFLV(IIB:IIE,IJB:IJE,:) = ZCFLV(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,3)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+ ZCFLW(IIB:IIE,IJB:IJE,:) = ZCFLW(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,4)/&
+ (XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
+#else
+ ZCFLU(IIB:IIE,IJB:IJE,:) = ZCFLU(IIB:IIE,IJB:IJE,:)*(1.-Br_exp(-Br_pow(XIBM_LS(IIB:IIE,IJB:IJE,:,2)/&
+ Br_pow(XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:),1./3.)),2.))
+ ZCFLV(IIB:IIE,IJB:IJE,:) = ZCFLV(IIB:IIE,IJB:IJE,:)*(1.-Br_exp(-Br_pow(XIBM_LS(IIB:IIE,IJB:IJE,:,3)/&
+ Br_pow(XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:),1./3.)),2.))
+ ZCFLW(IIB:IIE,IJB:IJE,:) = ZCFLW(IIB:IIE,IJB:IJE,:)*(1.-Br_exp(-Br_pow(XIBM_LS(IIB:IIE,IJB:IJE,:,4)/&
+ Br_pow(XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:),1./3.)),2.))
+#endif
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,2).GT.(-XIBM_EPSI)) ZCFLU(IIB:IIE,IJB:IJE,:)=0.
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,3).GT.(-XIBM_EPSI)) ZCFLV(IIB:IIE,IJB:IJE,:)=0.
+ WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,4).GT.(-XIBM_EPSI)) ZCFLW(IIB:IIE,IJB:IJE,:)=0.
+ ENDIF
#ifndef MNH_BITREP
IF (.NOT. L2D) THEN
ZCFL(:,:,:) = SQRT(ZCFLU(:,:,:)**2+ZCFLV(:,:,:)**2+ZCFLW(:,:,:)**2)
@@ -481,7 +525,7 @@ END IF
!
!* prints in the file the 3D Courant numbers (one should flag this)
!
-IF (OCLOSE_OUT .AND. OCFL_WRIT .AND. (.NOT. L1D)) THEN
+IF ( tpfile%lopened .AND. OCFL_WRIT .AND. (.NOT. L1D) ) THEN
!$acc update host(ZCFLU,ZCFLV,ZCFLW,ZCFL)
TZFIELD%CMNHNAME = 'CFLU'
TZFIELD%CSTDNAME = ''
@@ -614,7 +658,7 @@ END IF
ZTSTEP_PPM = PTSTEP / REAL(KSPLIT)
!
!
-!* 2.4 normalized contravariant components for splitted PPM time-step
+!* 2.4 normalized contravariant components for split PPM time-step
!
!$acc kernels
ZRUCPPM(:,:,:) = ZRUCPPM(:,:,:)*ZTSTEP_PPM
@@ -876,84 +920,27 @@ END IF
!* 5. BUDGETS
! -------
!
-IF (LBUDGET_TH) THEN
-!$acc update self(PRTHS)
- CALL BUDGET (PRTHS,4,'ADV_BU_RTH')
-END IF
-IF (LBUDGET_TKE) THEN
-!$acc update self(PRTKES)
- CALL BUDGET (PRTKES,5,'ADV_BU_RTKE')
-END IF
-IF (KRR>=1.AND.LBUDGET_RV) THEN
-!$acc update self(PRRS(:,:,:,1))
- CALL BUDGET (PRRS(:,:,:,1),6,'ADV_BU_RRV')
-END IF
-IF (KRR>=2.AND.LBUDGET_RC) THEN
-!$acc update self(PRRS(:,:,:,2))
- CALL BUDGET (PRRS(:,:,:,2),7,'ADV_BU_RRC')
-END IF
-IF (KRR>=3.AND.LBUDGET_RR) THEN
-!$acc update self(PRRS(:,:,:,3))
- CALL BUDGET (PRRS(:,:,:,3),8,'ADV_BU_RRR')
-END IF
-IF (KRR>=4.AND.LBUDGET_RI) THEN
-!$acc update self(PRRS(:,:,:,4))
- CALL BUDGET (PRRS(:,:,:,4),9,'ADV_BU_RRI')
-END IF
-IF (KRR>=5.AND.LBUDGET_RS) THEN
-!$acc update self(PRRS(:,:,:,5))
- CALL BUDGET (PRRS(:,:,:,5),10,'ADV_BU_RRS')
-END IF
-IF (KRR>=6.AND.LBUDGET_RG) THEN
-!$acc update self(PRRS(:,:,:,6))
- CALL BUDGET (PRRS(:,:,:,6),11,'ADV_BU_RRG')
-END IF
-IF (KRR>=7.AND.LBUDGET_RH) THEN
-!$acc update self(PRRS(:,:,:,7))
- CALL BUDGET (PRRS(:,:,:,7),12,'ADV_BU_RRH')
-END IF
-IF (LBUDGET_SV) THEN
-!$acc update self(PRSVS)
- DO JSV=1,KSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADV_BU_RSV')
- END DO
-END IF
-!
-IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
-#ifdef MNH_OPENACC
- call Print_msg( NVERB_ERROR, 'GEN', 'ADVECTION_METSV', 'OpenACC: HCLOUD=''KHKO'' OR ''C2R2'' not yet implemented' )
-#endif
- ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
- ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
- ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
- ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
- ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
-! CALL GET_HALO(PRRS(:,:,:,2))
-! CALL GET_HALO(PRSVS(:,:,:,2))
-! CALL GET_HALO(PRSVS(:,:,:,3))
- WHERE (PRRS(:,:,:,2) < 0. .OR. PRSVS(:,:,:,2) < 0.)
- PRSVS(:,:,:,1) = 0.0
- END WHERE
- DO JSV = 2, 3
- WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,JSV) < 0.)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,JSV)
- PRTHS(:,:,:) = PRTHS(:,:,:) - PRRS(:,:,:,JSV) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / ZEXN(:,:,:)
- PRRS(:,:,:,JSV) = 0.0
- PRSVS(:,:,:,JSV) = 0.0
- END WHERE
- END DO
-!
- IF (LBUDGET_TH) CALL BUDGET (PRTHS(:,:,:) , 4,'NEADV_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1), 6,'NEADV_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2), 7,'NEADV_BU_RRC')
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'ADV', prths (:, :, :) )
+if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'ADV', prtkes(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'ADV', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'ADV', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'ADV', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'ADV', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'ADV', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'ADV', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'ADV', prrs (:, :, :, 7) )
+if ( lbudget_sv) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv ), 'ADV', prsvs(:, :, :, jsv) )
+ end do
+end if
+
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NEADV', krr, ptstep, ppabst, ptht, prt, prths, prrs, prsvs )
-END IF
-!
#ifdef MNH_OPENACC
CALL MNH_REL_ZT3D(IZ1, IZ2)
#endif
-!-------------------------------------------------------------------------------
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/advection_uvw.f90 b/src/MNH/advection_uvw.f90
index cb088d7356359c68790720e7ebd0ba8c763bb853..591497a744c8fd36243b5588aad37828877a8e6a 100644
--- a/src/MNH/advection_uvw.f90
+++ b/src/MNH/advection_uvw.f90
@@ -92,32 +92,34 @@ END MODULE MODI_ADVECTION_UVW
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! C.LAC 10/2016 : Add OSPLIT_WENO
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
-USE MODD_PARAMETERS, ONLY : JPVEXT
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, NBUDGET_U, NBUDGET_V, NBUDGET_W, tbudgets
USE MODD_CONF, ONLY : NHALO
-USE MODD_BUDGET
-!
+USE MODD_PARAMETERS, ONLY : JPVEXT
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_ll
+#ifdef MNH_OPENACC
+USE MODE_DEVICE
+USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D, MNH_GET_ZT4D , MNH_REL_ZT4D
+#endif
+use mode_mppdb
+
+USE MODI_ADV_BOUNDARIES
+USE MODI_ADVECUVW_RK
+USE MODI_CONTRAV
#ifndef MNH_OPENACC
USE MODI_SHUMAN
#else
USE MODI_SHUMAN_DEVICE
#endif
-USE MODI_CONTRAV
-USE MODI_ADVECUVW_RK
-USE MODI_ADV_BOUNDARIES
-USE MODI_BUDGET
!
-#ifdef MNH_OPENACC
-USE MODE_DEVICE
-USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D, MNH_GET_ZT4D , MNH_REL_ZT4D
-#endif
-use mode_mppdb
!
!-------------------------------------------------------------------------------
!
@@ -192,7 +194,7 @@ TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
!
#ifdef MNH_OPENACC
INTEGER :: ISPL, IZUT, IZVT, IZWT, IZ1, IZ2
-INTEGER :: IZRUSB, IZRUSE, IZRVSB, IZRVSE, IZRWSB, IZRWSE
+INTEGER :: IZRUSB, IZRUSE, IZRVSB, IZRVSE, IZRWSB, IZRWSE, IIBMS, IIBME
#endif
!
!
@@ -296,6 +298,7 @@ CALL MNH_GET_ZT3D(IZUT, IZVT, IZWT, IZ1, IZ2)
CALL MNH_GET_ZT4D(ISPL, IZRUSB, IZRUSE)
CALL MNH_GET_ZT4D(ISPL, IZRVSB, IZRVSE)
CALL MNH_GET_ZT4D(ISPL, IZRWSB, IZRWSE)
+CALL MNH_GET_ZT4D(3, IIBMS, IIBME)
#endif
!
IKE = SIZE(PWT,3) - JPVEXT
@@ -309,7 +312,11 @@ CALL MXM_DEVICE(PRHODJ,ZMXM_RHODJ)
CALL MYM_DEVICE(PRHODJ,ZMYM_RHODJ)
CALL MZM_DEVICE(PRHODJ,ZMZM_RHODJ)
#endif
-!
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'ADV', prws(:, :, :) )
+
!-------------------------------------------------------------------------------
!
!* 1. COMPUTES THE CONTRAVARIANT COMPONENTS
@@ -428,7 +435,7 @@ DO JSPL=1,ISPLIT
)
#else
,ZT3D(:,:,:,IZUT), ZT3D(:,:,:,IZVT), ZT3D(:,:,:,IZWT), &
- ZT3D(:,:,:,IZRUSB:IZRUSE), ZT3D(:,:,:,IZRVSB:IZRVSE), ZT3D(:,:,:,IZRWSB:IZRWSE) )
+ ZT3D(:,:,:,IZRUSB:IZRUSE), ZT3D(:,:,:,IZRVSB:IZRVSE), ZT3D(:,:,:,IZRWSB:IZRWSE), ZT3D(:,:,:,IIBMS:IIBME) )
#endif
!
! Tendencies on wind
@@ -476,18 +483,10 @@ END DO
!* 4. BUDGETS
! -------
!
-IF (LBUDGET_U) THEN
-!$acc update self(PRUS)
- CALL BUDGET (PRUS,1,'ADV_BU_RU')
-END IF
-IF (LBUDGET_V) THEN
-!$acc update self(PRVS)
- CALL BUDGET (PRVS,2,'ADV_BU_RV')
-END IF
-IF (LBUDGET_W) THEN
-!$acc update self(PRWS)
- CALL BUDGET (PRWS,3,'ADV_BU_RW')
-END IF
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ADV', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'ADV', prws(:, :, :) )
+
!-------------------------------------------------------------------------------
!
#ifdef MNH_OPENACC
diff --git a/src/MNH/advection_uvw_cen.f90 b/src/MNH/advection_uvw_cen.f90
index 31cdeeae716c3ab246577ab203467280886f714e..442c4547532e6ab846f08858eb34430699c9776a 100644
--- a/src/MNH/advection_uvw_cen.f90
+++ b/src/MNH/advection_uvw_cen.f90
@@ -88,38 +88,35 @@ END MODULE MODI_ADVECTION_UVW_CEN
!! Original 01/2013 (from ADVECTION routine)
!! Modif
!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!
+! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
-use mode_mppdb
USE MODD_ARGSLIST_ll, ONLY : LIST_ll, HALO2LIST_ll
USE MODD_CONF
-USE MODD_PARAMETERS
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, NBUDGET_U, NBUDGET_V, NBUDGET_W, tbudgets
USE MODD_GRID_n
-!
-#ifndef MNH_OPENACC
-USE MODI_SHUMAN
-#else
-USE MODI_SHUMAN_DEVICE
-#endif
-USE MODI_CONTRAV
-USE MODI_ADVECUVW_2ND
-USE MODI_ADVECUVW_4TH
-!
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_ll
#ifdef MNH_OPENACC
USE MODE_DEVICE
USE MODE_MNH_ZWORK, ONLY : ZT3D, MNH_GET_ZT3D , MNH_REL_ZT3D
use mode_msg
#endif
-!
+use mode_mppdb
+
+USE MODI_ADVECUVW_2ND
+USE MODI_ADVECUVW_4TH
+USE MODI_CONTRAV
+#ifndef MNH_OPENACC
+USE MODI_SHUMAN
+#else
+USE MODI_SHUMAN_DEVICE
+#endif
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
@@ -210,6 +207,10 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRWS,"ADVECTION_UVW_CEN beg:PRWS")
END IF
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'ADV', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'ADV', prws(:, :, :) )
+
allocate( zus ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zvs ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zws ( size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
@@ -248,7 +249,7 @@ CALL INIT_ON_HOST_AND_DEVICE(ZMZM_RHODJ,-3e97,'ADVECTION_UVW_CEN::ZMZM_RHODJ')
!
CALL MNH_GET_ZT3D(IZ1, IZ2)
#endif
-!
+
#ifndef MNH_OPENACC
ZMXM_RHODJ = MXM(PRHODJ)
ZMYM_RHODJ = MYM(PRHODJ)
@@ -343,11 +344,11 @@ PDUM(:,:,:) = ZUS(:,:,:) - PUM(:,:,:)
PDVM(:,:,:) = ZVS(:,:,:) - PVM(:,:,:)
PDWM(:,:,:) = ZWS(:,:,:) - PWM(:,:,:)
!$acc end kernels
-!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADV_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADV_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADV_BU_RW')
-!
+
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'ADV', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'ADV', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'ADV', prws(:, :, :) )
+
#ifdef MNH_OPENACC
CALL MNH_REL_ZT3D(IZ1, IZ2)
#endif
diff --git a/src/MNH/advecuvw.f90 b/src/MNH/advecuvw.f90
deleted file mode 100644
index 087ca0ecfbcaa4594dc2592cc07f4d7f7640a1c1..0000000000000000000000000000000000000000
--- a/src/MNH/advecuvw.f90
+++ /dev/null
@@ -1,177 +0,0 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ####################
- MODULE MODI_ADVECUVW
-! ####################
-!
-INTERFACE
-!
- SUBROUTINE ADVECUVW ( PUT, PVT, PWT, &
- PRUCT, PRVCT, PRWCT, &
- PRUS, PRVS, PRWS )
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Wind at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Sources of Momentum
-!
-END SUBROUTINE ADVECUVW
-!
-END INTERFACE
-!
-END MODULE MODI_ADVECUVW
-!
-!
-!
-! ###########################################################
- SUBROUTINE ADVECUVW ( PUT, PVT, PWT, &
- PRUCT, PRVCT, PRWCT, &
- PRUS, PRVS, PRWS )
-! ###########################################################
-!
-!!**** *ADVECUVW * - routine to compute the advection terms of momentum
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the three advection terms
-!! of each component of the momentum, written in flux form.
-!! The advection velocity is taken as the contravariant form of
-!! the momentum for extension to non-cartesian geometry and
-!! conformal projection cases. The different sources terms are stored for
-!! the budget computations.
-!!
-!!
-!!** METHOD
-!! ------
-!! The left and right lateral EXTernal zones, have been previously
-!! prepared in routine LBC_S, to avoid particular cases close to the
-!! Lateral Boundaries in this routine.
-!! The Shuman functions are used to write the mean and finite
-!! differences operators.
-!!
-!! EXTERNAL
-!! --------
-!! DXM,DYM,DZM : Shuman functions (finite differences operators)
-!! BUDGET : Stores the different budget components
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS: declaration of parameter variables
-!! JPVEXT: define the number of marginal points out of the
-!! physical domain along the vertical direction.
-!!
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RU : logical for budget of RU (wind component along x)
-!! .TRUE. = budget of RU
-!! .FALSE. = no budget of RU
-!! LBU_RV : logical for budget of RV (wind component along y)
-!! .TRUE. = budget of RV
-!! .FALSE. = no budget of RV
-!! LBU_RW : logical for budget of RW (wind component along z)
-!! .TRUE. = budget of RW
-!! .FALSE. = no budget of RW
-!!
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation ( routine ADVECUVW )
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 06/07/94
-!! Corrections 06/09/94 (J.-P. Lafore)
-!! 02/11/94 (J.Stein) extrapolation under the ground
-!! 16/03/95 (J.Stein) remove R from the historical variables
-!! 01/04/95 (Ph. Hereil J. Nicolau) add the budget computation
-!! 16/10/95 (J. Stein) change the budget calls
-!! 19/12/96 (J.-P. Pinty) update the budget calls
-!! 07/11/02 (V. Masson) update the budget calls
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_BUDGET
-USE MODD_GRID_n
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Wind at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Sources of Momentum
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTES THE ADVECTIVE TENDANCIES
-! ---------------------------------
-!
-PRUS(:,:,:) = PRUS(:,:,:) &
- -DXM( MXF(PRUCT(:,:,:))*MXF(PUT(:,:,:)) )
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVX_BU_RU')
-!
-PRUS(:,:,:) = PRUS(:,:,:) &
- -DYF( MXM(PRVCT(:,:,:))*MYM(PUT(:,:,:)) )
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVY_BU_RU')
-!
-PRUS(:,:,:) = PRUS(:,:,:) &
- -DZF( MXM(PRWCT(:,:,:))*MZM(PUT(:,:,:)) )
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ADVZ_BU_RU')
-!
-!
-PRVS(:,:,:) = PRVS(:,:,:) &
- -DXF( MYM(PRUCT(:,:,:))*MXM(PVT(:,:,:)) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVX_BU_RV')
-!
-PRVS(:,:,:) = PRVS(:,:,:) &
- -DYM( MYF(PRVCT(:,:,:))*MYF(PVT(:,:,:)) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVY_BU_RV')
-!
-PRVS(:,:,:) = PRVS(:,:,:) &
- -DZF( MYM(PRWCT(:,:,:))*MZM(PVT(:,:,:)) )
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ADVZ_BU_RV')
-!
-!
-PRWS(:,:,:) = PRWS(:,:,:) &
- -DXF( MZM(PRUCT(:,:,:))*MXM(PWT(:,:,:)) )
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVX_BU_RW')
-!
-PRWS(:,:,:) = PRWS(:,:,:) &
- -DYF( MZM(PRVCT(:,:,:))*MYM(PWT(:,:,:)) )
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVY_BU_RW')
-!
-PRWS(:,:,:) = PRWS(:,:,:) &
- -DZM( MZF(PRWCT(:,:,:))*MZF(PWT(:,:,:)) )
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ADVZ_BU_RW')
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE ADVECUVW
diff --git a/src/MNH/advecuvw_4th.f90 b/src/MNH/advecuvw_4th.f90
index c2a340ffe8ab39817529e94173ae285102ac3eb8..c9e254c8b1eab41ea77a6c1f5db67c6e9c3e480a 100644
--- a/src/MNH/advecuvw_4th.f90
+++ b/src/MNH/advecuvw_4th.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2005-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
diff --git a/src/MNH/advecuvw_rk.f90 b/src/MNH/advecuvw_rk.f90
index 62b012caafbdbd384945bab1439a49fdf5522257..e29b79ad5c57dd90db0cf74aa56235c883ea562a 100644
--- a/src/MNH/advecuvw_rk.f90
+++ b/src/MNH/advecuvw_rk.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.
@@ -20,7 +20,7 @@ INTERFACE
#ifndef MNH_OPENACC
)
#else
- ,ZUT, ZVT, ZWT, ZRUS, ZRVS, ZRWS)
+ , ZUT, ZVT, ZWT, ZRUS, ZRVS, ZRWS, ZIBM )
#endif
!
CHARACTER(LEN=6), INTENT(IN) :: HUVW_ADV_SCHEME! to the selected
@@ -49,8 +49,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_OTHER , PRVS_OTHER, PRWS_OTHER
! ! tendencies from other processes
#ifdef MNH_OPENACC
! Work arrays
-REAL, DIMENSION(:,:,:) :: ZUT, ZVT, ZWT
-REAL, DIMENSION(:,:,:,:) :: ZRUS,ZRVS,ZRWS
+REAL, DIMENSION(:,:,:) :: ZUT, ZVT, ZWT
+REAL, DIMENSION(:,:,:,:) :: ZRUS, ZRVS, ZRWS, ZIBM
#endif
!
!
@@ -72,7 +72,7 @@ END MODULE MODI_ADVECUVW_RK
#ifndef MNH_OPENACC
)
#else
- ,ZUT, ZVT, ZWT, ZRUS, ZRVS, ZRWS)
+ , ZUT, ZVT, ZWT, ZRUS, ZRVS, ZRWS, ZIBM )
#endif
! ##########################################################################
!
@@ -121,6 +121,7 @@ END MODULE MODI_ADVECUVW_RK
!! C.Lac 10/16 : Correction on RK loop
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! T. Nagel,F.Auguste 06/2021: add IBM
!!
!-------------------------------------------------------------------------------
!
@@ -129,16 +130,21 @@ END MODULE MODI_ADVECUVW_RK
!
USE MODD_ARGSLIST_ll, ONLY: LIST_ll, HALO2LIST_ll
USE MODD_CONF, ONLY: NHALO
+USE MODD_IBM_PARAM_n, ONLY: LIBM, CIBM_ADV, XIBM_LS, XIBM_EPSI
USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODD_SUB_MODEL_n, ONLY: XT_IBM_FORC
!
USE MODE_ll
USE MODE_MPPDB
use mode_msg
!
USE MODI_ADV_BOUNDARIES
+USE MODI_ADVECUVW_2ND
USE MODI_ADVECUVW_4TH
USE MODI_ADVECUVW_WENO_K
USE MODI_GET_HALO
+USE MODI_IBM_FORCING_ADV
+USE MODI_SECOND_MNH
USE MODI_SHUMAN
!
!
@@ -178,8 +184,8 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRUS_ADV , PRVS_ADV, PRWS_ADV
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUS_OTHER , PRVS_OTHER, PRWS_OTHER
! ! tendencies from other processes
#ifdef MNH_OPENACC
-REAL, DIMENSION(:,:,:) :: ZUT, ZVT, ZWT
-REAL, DIMENSION(:,:,:,:) :: ZRUS,ZRVS,ZRWS
+REAL, DIMENSION(:,:,:) :: ZUT, ZVT, ZWT
+REAL, DIMENSION(:,:,:,:) :: ZRUS, ZRVS, ZRWS, ZIBM
#endif
!
!
@@ -195,7 +201,7 @@ INTEGER :: IKE ! indice K End in z direction
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUT, ZVT, ZWT
! Intermediate Guesses inside the RK loop
!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRUS,ZRVS,ZRWS
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRUS,ZRVS,ZRWS,ZIBM
#endif
! Momentum tendencies due to advection
REAL, DIMENSION(:,:), ALLOCATABLE :: ZBUT ! Butcher array coefficients
@@ -222,10 +228,12 @@ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS0_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER :: TZFIELDS4_ll ! list of fields to exchange
!
+REAL :: ZTIME1,ZTIME2
!-------------------------------------------------------------------------------
-!$acc data present( PU, PV, PW, PUT, PVT, PWT, PMXM_RHODJ, PMYM_RHODJ, PMZM_RHODJ, &
-!$acc & PRUCT, PRVCT, PRWCT, PRUS_ADV, PRVS_ADV, PRWS_ADV, &
-!$acc & PRUS_OTHER, PRVS_OTHER, PRWS_OTHER, ZUT, ZVT, ZWT, ZRUS, ZRVS, ZRWS )
+!$acc data present( PU, PV, PW, PUT, PVT, PWT, PMXM_RHODJ, PMYM_RHODJ, PMZM_RHODJ, &
+!$acc & PRUCT, PRVCT, PRWCT, PRUS_ADV, PRVS_ADV, PRWS_ADV, &
+!$acc & PRUS_OTHER, PRVS_OTHER, PRWS_OTHER, ZUT, ZVT, ZWT, &
+!$acc & ZRUS, ZRVS, ZRWS, ZIBM )
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
@@ -245,9 +253,11 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRVS_OTHER,"ADVECUVW_RK beg:PRVS_OTHER")
CALL MPPDB_CHECK(PRWS_OTHER,"ADVECUVW_RK beg:PRWS_OTHER")
END IF
+
+if ( LIBM ) call Print_msg( NVERB_FATAL, 'GEN', 'ADVECUVW_RK', 'OpenACC: LIBM=T not yet implemented' )
!
-!* 0. INITIALIZATION
-! --------------
+!* 0. INITIALIZATION
+! ---------------------
!
#ifndef MNH_OPENACC
allocate(ZUT(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)))
@@ -389,8 +399,25 @@ 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))
#endif
+
+IF ( LIBM ) THEN
+#ifndef MNH_OPENACC
+ ALLOCATE( ZIBM(SIZE(PUT,1), SIZE(PUT,2), SIZE(PWT,3), 3) )
+#endif
+!$acc kernels
+ ZIBM(:,:,:,:) = 1.
+!$acc end kernels
+END IF
!
!$acc kernels present(PRUS_ADV,PRVS_ADV,PRWS_ADV) present(ZUT,ZVT,ZWT) present(PU,PV,PW)
+IF (LIBM .AND. CIBM_ADV=='FREEZE') THEN
+
+ WHERE (XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZIBM(:,:,:,1) = 0.
+ WHERE (XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZIBM(:,:,:,2) = 0.
+ WHERE (XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZIBM(:,:,:,3) = 0.
+
+ENDIF
+!
PRUS_ADV = 0.
PRVS_ADV = 0.
PRWS_ADV = 0.
@@ -398,7 +425,7 @@ PRWS_ADV = 0.
!-------------------------------------------------------------------------------
!
!* 2. Wind guess before RK loop
-! -------------------------
+! --------------------------------
!
ZUT = PU
ZVT = PV
@@ -435,29 +462,36 @@ ZRWS(:, :, :, : ) = 0.
!-------------------------------------------------------------------------------
!
!* 3. BEGINNING of Runge-Kutta loop
-! -----------------------------
+! ------------------------------------
!
- DO JS = 1, ISPL
+RKLOOP: DO JS = 1, ISPL
!
#ifndef MNH_OPENACC
- 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 ADV_BOUNDARIES (HLBCX, HLBCY, ZUT, PUT, 'U' )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZVT, PVT, 'V' )
+ CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZWT, PWT, 'W' )
#else
- CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZUT, PUT, 'U' )
- CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZVT, PVT, 'V' )
- CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZWT, PWT, 'W' )
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZUT, PUT, 'U' )
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZVT, PVT, 'V' )
+ CALL ADV_BOUNDARIES_DEVICE (HLBCX, HLBCY, ZWT, PWT, 'W' )
#endif
!
!$acc update self(ZUT,ZVT,ZWT)
- CALL UPDATE_HALO_ll(TZFIELDMT_ll,IINFO_ll)
- CALL UPDATE_HALO2_ll(TZFIELDMT_ll, TZHALO2MT_ll, IINFO_ll)
+ CALL UPDATE_HALO_ll(TZFIELDMT_ll,IINFO_ll)
+ CALL UPDATE_HALO2_ll(TZFIELDMT_ll, TZHALO2MT_ll, IINFO_ll)
!$acc update device(ZUT,ZVT,ZWT)
!
!* 4. Advection with WENO
-! -------------------
+! --------------------------
+!
+!$acc kernels
+ IF (LIBM .AND. CIBM_ADV=='LOWORD') THEN
+ ZIBM(:,:,:,1)=ZRUS(:,:,:,JS)
+ ZIBM(:,:,:,2)=ZRVS(:,:,:,JS)
+ ZIBM(:,:,:,3)=ZRWS(:,:,:,JS)
+ ENDIF
+!$acc end kernels
!
-
IF (HUVW_ADV_SCHEME=='WENO_K') THEN
CALL ADVECUVW_WENO_K (HLBCX, HLBCY, KWENO_ORDER, ZUT, ZVT, ZWT, &
PRUCT, PRVCT, PRWCT, &
@@ -474,28 +508,63 @@ ZRWS(:, :, :, : ) = 0.
TZHALO2MT_ll )
ENDIF
!
- NULLIFY(TZFIELDS4_ll)
+ IF (LIBM .AND. CIBM_ADV=='LOWORD') THEN
+ IF (HUVW_ADV_SCHEME=='WENO_K') THEN
+ CALL ADVECUVW_WENO_K (HLBCX, HLBCY, 3, ZUT, ZVT, ZWT, &
+ PRUCT, PRVCT, PRWCT, &
+ ZIBM(:,:,:,1), ZIBM(:,:,:,2), ZIBM(:,:,:,3) ,&
+ TZHALO2MT_ll )
+ ENDIF
+ IF (HUVW_ADV_SCHEME=='CEN4TH') THEN
+ CALL ADVECUVW_2ND (ZUT, ZVT, ZWT, PRUCT, PRVCT, PRWCT, &
+ ZIBM(:,:,:,1), ZIBM(:,:,:,2), ZIBM(:,:,:,3))
+ ENDIF
+ WHERE(XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZRUS(:,:,:,JS)=ZIBM(:,:,:,1)
+ WHERE(XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZRVS(:,:,:,JS)=ZIBM(:,:,:,2)
+ WHERE(XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZRWS(:,:,:,JS)=ZIBM(:,:,:,3)
+ ZIBM(:,:,:,:)=1.
+ ENDIF
+!
+ NULLIFY(TZFIELDS4_ll)
!
- write ( ynum, '( I3 )' ) js
- CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZRUS(:,:,:,JS), 'ADVECUVW_RK::ZRUS(:,:,:,'//trim( adjustl( ynum ) )//')' )
- CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZRVS(:,:,:,JS), 'ADVECUVW_RK::ZRVS(:,:,:,'//trim( adjustl( ynum ) )//')' )
- CALL ADD3DFIELD_ll( TZFIELDS4_ll, ZRWS(:,:,:,JS), 'ADVECUVW_RK::ZRWS(:,:,:,'//trim( adjustl( ynum ) )//')' )
- CALL UPDATE_HALO_ll(TZFIELDS4_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS4_ll)
+ 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)
!$acc update device(ZRUS(:,:,:,JS),ZRVS(:,:,:,JS),ZRWS(:,:,:,JS))
!
+ IF (LIBM .AND. CIBM_ADV=='FREEZE') THEN
+ WHERE(XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) ZRUS(:,:,:,JS)=ZUT(:,:,:)*PMXM_RHODJ(:,:,:)/PTSTEP
+ WHERE(XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) ZRVS(:,:,:,JS)=ZVT(:,:,:)*PMYM_RHODJ(:,:,:)/PTSTEP
+ WHERE(XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) ZRWS(:,:,:,JS)=ZWT(:,:,:)*PMZM_RHODJ(:,:,:)/PTSTEP
+ ENDIF
+
+ IF (LIBM .AND. CIBM_ADV=='FORCIN') THEN
+ CALL SECOND_MNH(ZTIME1)
+ CALL IBM_FORCING_ADV(ZRUS(:,:,:,JS),ZRVS(:,:,:,JS),ZRWS(:,:,:,JS))
+ CALL SECOND_MNH(ZTIME2)
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ ENDIF
!
! Guesses at the end of the RK loop
!
-!$acc kernels present(PRUS_ADV,PRVS_ADV,PRWS_ADV,ZBUTS) present(ZRUS,ZRVS,ZRWS)
- PRUS_ADV(:,:,:) = PRUS_ADV(:,:,:) + ZBUTS(JS) * ZRUS(:,:,:,JS)
- PRVS_ADV(:,:,:) = PRVS_ADV(:,:,:) + ZBUTS(JS) * ZRVS(:,:,:,JS)
- PRWS_ADV(:,:,:) = PRWS_ADV(:,:,:) + ZBUTS(JS) * ZRWS(:,:,:,JS)
+!$acc kernels present(PRUS_ADV,PRVS_ADV,PRWS_ADV,ZBUTS) present(ZRUS,ZRVS,ZRWS,ZIBM)
+ IF ( .NOT. LIBM ) THEN
+ PRUS_ADV(:,:,:) = PRUS_ADV(:,:,:) + ZBUTS(JS) * ZRUS(:,:,:,JS)
+ PRVS_ADV(:,:,:) = PRVS_ADV(:,:,:) + ZBUTS(JS) * ZRVS(:,:,:,JS)
+ PRWS_ADV(:,:,:) = PRWS_ADV(:,:,:) + ZBUTS(JS) * ZRWS(:,:,:,JS)
+ ELSE
+ 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 IF
!$acc end kernels
!
IF ( JS < ISPL ) THEN
-!$acc kernels present(ZUT,ZVT,ZWT) present(ZBUT) present(PU,PV,PW) &
-!$acc & present(ZRUS,ZRVS,ZRWS) present(PRUS_OTHER,PRVS_OTHER,PRWS_OTHER) &
+!$acc kernels present(ZUT,ZVT,ZWT) present(ZBUT) present(PU,PV,PW) &
+!$acc & present(ZRUS,ZRVS,ZRWS,ZIBM) present(PRUS_OTHER,PRVS_OTHER,PRWS_OTHER) &
!$acc & present(PMXM_RHODJ,PMYM_RHODJ,PMZM_RHODJ)
!
ZUT = PU
@@ -506,12 +575,21 @@ ZRWS(:, :, :, : ) = 0.
!
! Intermediate guesses inside the RK loop
!
- 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
+ IF ( .NOT. LIBM ) THEN
+ 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(:,:,:)
+ ELSE
+ 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 IF
!
END DO
!$acc end kernels
@@ -519,7 +597,7 @@ ZRWS(:, :, :, : ) = 0.
END IF
!
! End of the RK loop
- END DO
+ END DO RKLOOP
!
!
#ifdef MNH_OPENACC
diff --git a/src/MNH/advecuvw_weno_k.f90 b/src/MNH/advecuvw_weno_k.f90
index 96c6a85e5e6ea000a1a2508d7b2bc815c3fca85a..f328d2e3519b3e3fc059494ad0de380772c44c04 100644
--- a/src/MNH/advecuvw_weno_k.f90
+++ b/src/MNH/advecuvw_weno_k.f90
@@ -127,8 +127,8 @@ REAL, DIMENSION(:,:,:), allocatable :: ZMEAN, ZWORK
REAL, DIMENSION(:,:,:) :: ZMEAN, ZWORK
#endif
!
-INTEGER :: IKU
#ifdef MNH_OPENACC
+INTEGER :: IKU
INTEGER :: IZFPOS1, IZFPOS2, IZFPOS3
INTEGER :: IZFNEG1, IZFNEG2, IZFNEG3
INTEGER :: IZBPOS1, IZBPOS2, IZBPOS3
@@ -170,7 +170,9 @@ TZHALO2_UT => TPHALO2LIST ! 1rst add3dfield in model_n
TZHALO2_VT => TPHALO2LIST%NEXT ! 2nd add3dfield in model_n
TZHALO2_WT => TPHALO2LIST%NEXT%NEXT ! 3rst add3dfield in model_n
!
+#ifdef MNH_OPENACC
IKU=SIZE(PUT,3)
+#endif
! -------------------------------------------------------
!
SELECT CASE(KWENO_ORDER)
diff --git a/src/MNH/aerohb.f b/src/MNH/aerohb.f
deleted file mode 100644
index 5174f8a04d6456effbd8cb611021295305bdcbd5..0000000000000000000000000000000000000000
--- a/src/MNH/aerohb.f
+++ /dev/null
@@ -1,300 +0,0 @@
-!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! Modifications:
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-!-----------------------------------------------------------------
- subroutine aeroeq(gas,caero,tempk,rh,ICOLUMN,err)
-C***********************************************************************
-C main program for gas/particle equilibrium
-C Using the total bulk aerosol conc. and the gybrid method for dist.
-C calculation including crustal mateials written by Zhaoyue Meng. *
-C***********************************************************************
-C
-C...PROGRAM VARIABLES...
-C
-c Dp: particle diameter in unit of meter
-c OM: organic mass (ug/m3)
-C
-C INPUTS
-C ------
-C
-c gas(naspec): Bulk gas-phasec concentrations in units of micro g/m3
-c caero(nasect,naspec): aerosol concentrations in units of micro g/m3
-c
-c gas(1) : Not used in this module
-c gas(2) : H2SO4
-c gas(3) : NH3
-c gas(4) : HNO3
-c gas(5) : HCl
-c gas(21): SB1
-c gas(23): SB2
-c gas(25): SB3
-c gas(26): SB4
-c gas(27): SB5
-c gas(28): SA1
-c gas(31): SA2
-c gas(34): SA3
-c gas(35): SA4
-c gas(37): SA5
-c caero(1) : Na
-c caero(2) : SO4
-c caero(3) : NH4
-c caero(4) : NO3
-c caero(5) : Cl
-c caero(6) : K
-c caero(7) : Ca
-c caero(8) : Mg
-c caero(9) : H2CO3
-c caero(10): H2O
-c caero(11): other inorganic species
-c caero(12): EC
-c caero(13): POA1
-c caero(14): POA2
-c caero(15): POA3
-c caero(16): POA4
-c caero(17): POA5
-c caero(18): POA6
-c caero(19): POA7
-c caero(20): POA8
-c caero(21): SB1
-c caero(22): SB1-
-c caero(23): SB2
-c caero(24): SB2-
-c caero(25): SB3
-c caero(26): SB4
-c caero(27): SB5
-c caero(28): SA1
-c caero(29): SA1-
-c caero(30): SA1--
-c caero(31): SA2
-c caero(32): SA2-
-c caero(33): SA2--
-c caero(34): SA3
-c caero(35): SA4
-c caero(36): SA5
-c caero(37): SA5-
-c tempk : temperature in Kelvin
-c rh : relative humidity
-c ICOLUMN : Column index
-C
-C OUTPUTS
-C -------
-C The updated caero and gas based on equilibrium calculations.
-c
- include 'parameter.h'
- dimension gas(naspec),caero(nasect,naspec),caero0(nasect,naspec)
- real nh3,nitrate,magn,w(9),newvol,negconc,temp,hconc
- real mass(nasect),NN(nasect),Kn,csoa(nasect,17)
- real dmass(nasect),factor(nasect),lwc,zsrconc(10),dellwc
- real tollwc,denom(8),frac(8),dpindex(nasect)
- real cpart(10),cpt(8),sumsoa,ctsoa(17)
- real org(10),aq(10),am(10),ad(10),vp(10),mwpart(10)
- logical done
- common/cond/temp,lwc,hconc
- common/concsoa/cpart,cpt
- common/props/vp,mwpart
- common/fraccalc/NN,DPINDEX
- data Diffus,alfa/1.e-5, 0.01/
- data pi/3.1415926/
-c Calculate the bulk aerosol composition
- do j=1, 8
- w(j) = gas(j)
- do inasect = 1, nasect
- w(j) = w(j) + caero(inasect,j)
- enddo
- enddo
- do j=9, 10 !Use gas(9) and (10) hold the old total carbonate and wat.
- gas(j) = 0.
- do inasect = 1, nasect
- gas(j) = gas(j) + caero(inasect,j)
- enddo
- enddo
-c
- w(9) = 9.12e5
- call eq(iapart,iaopt,iaapp,iasec,iatx,aeps1,aeps2,tempk,rh,
- 1 w,ammon,sodium,sulfate,nitrate,chloride,bisulf,pott,calcium,
- 2 magn,nh3,hno3,hcl,rh2so4,hydro,roh,rna2so4,rnh42s4,rnh4cl,
- 3 rnacl,rnano3,rnh4no3,rclc,rnh4hso4,rnahso4,rkcl,rk2so4,rkhso4,
- 4 rkno3,rcacl2,rcaso4,rcano32,rmgcl2,rmgso4,rmgno32,rwater,
- 5 rna2co3,rnahco3,rk2co3,rkhco3,rcaco3,rmgco3,rcarbamate,rnh4hco3,
- 6 co2,rco2,carbonate,bicarbon,carbamation,rnh3,rhno3,rhcl,ierr,xh)
-c
- if(ierr .eq. 1) then
- write(6,*)w,dtdummy,deltat
- write(6,*)caero
- write(6,*)nn(inasect),mass(inasect),inasect
- return
- endif
-c Reserve the old aerosol concentrations
- do i = 1, nasect
- do j = 1, naspec
- caero0(i,j) = caero(i,j)
- enddo
- enddo
-c Calculate mass transport factor
- delmu=(alog(Dpup)-alog(Dplow))/real(nasect)
- fact = 0.
- do inasect = 1, nasect
- Dp=alog(Dplow)+(real(inasect)-0.5)*delmu
- Dp=exp(Dp)*1.e-6
- DPINDEX(INASECT) = dp
- totmass=0.
- do j=1,naspec
- totmass=totmass+caero(inasect,j)
- enddo
- mass(inasect)=pi/6.*Dp**3*densp*1.e12
- NN(inasect)=totmass/mass(inasect)
- NN(inasect) = max(NN(inasect),1.)
- call aeroparam(tempK-273.15,inasect,1.,Kn,Sc,St,Vsett)
- beta=Kn/alfa
-c Using the hybrid method to distribute sulfate
- factor(inasect) = 2.*pi*Dp*Diffus*NN(inasect)/(1.+beta)
- fact = fact + factor(inasect)
- enddo
- do i = 1, nasect
- factor(i) = factor(i)/fact
- caero(i,2)=caero(i,2) + gas(2)*factor(i)
- caero(i,3)=caero(i,3) + (gas(3)-nh3)*factor(i)
- caero(i,4)=caero(i,4) + (gas(4)-hno3)*factor(i)
- caero(i,5)=caero(i,5) + (gas(5)-hcl)*factor(i)
-c w(9) has been changed in 'eq' to for aerosol phase only.
- caero(i,9)=caero(i,9) + (w(9)-gas(9))*factor(i)
- caero(i,10)=caero(i,10) + (rwater-gas(10))*factor(i)
- enddo
- gas(2) = 0.
- gas(3) = nh3
- gas(4) = hno3
- gas(5) = hcl
-c Now if any particles have negative concentrations redistribute the
-c materials over other sized particles and set the minimum conc to 0.
- do j = 1, naspec
- negconc = 0.
- totconc = 0.
- do i = 1, nasect
- if(caero(i,j) .lt. 0.) then
- negconc = negconc + caero(i,j)
- caero(i,j) = 0.
- endif
- totconc = totconc + caero(i,j)
- totconc = max(1.e-6,totconc)
- enddo
- do i = 1, nasect
- caero(i,j) = caero(i,j)*(1.+negconc/totconc)
- enddo
- enddo
-c
-c if(icolumn .eq. 34) stop
-c if(icolumn .eq. 33) then
-c write(6,*) 'gas(2),gas(3),(4), (5) = ',(gas(i),i=2,5)
-c write(6,*) 'nh3,hno3,hcl = ',nh3,hno3,hcl
-c write(6,*) 'Inorganic aerosol conc = '
-c write(6,'(11e8.3)') (w(i),i=1,9),rh,rwater
-c endif
-c
-c
- 45 continue
-c
- do i = 1, nasect
- dmass(i) = 0.
- do j = 1, naspec
- dmass(i) = dmass(i) + caero(i,j) - caero0(i,j)
- enddo
- enddo
-c move the aerosol concentrations to caero0 and then redistribute the
-c moving sections to the fixed caero(i,j)
- do i = 1, nasect
- do j = 1, naspec
- caero0(i,j) = caero(i,j)
- caero(i,j) = 0.
- enddo
- enddo
-c
- do inasect = 1, nasect
- Dp=alog(Dplow)+(real(inasect)-0.5)*delmu
- Dp=exp(Dp)*1.e-6
- newvol = Dp**3 + 6./pi*dmass(inasect)/NN(inasect)*1.e-12/densp
- if(newvol .lt. 0.) newvol = 0.
- Dp1 = newvol**(1./3.)
- Dp1 = Dp1*1.e6
-c write(6,*)icolumn,inasect,Dp*1.e6,Dp1
- Dp1 = max(Dp1, Dplow)
- Dpmove = (alog(Dp1) - alog(Dplow))/delmu + 0.5
- if(Dpmove .lt. 1.) Dpmove = 1.000001
- if(Dpmove .gt. real(nasect)) Dpmove = real(nasect)+0.000001
- imove = int(Dpmove)
- distr = Dpmove - real(imove)
- do j = 1, naspec
- caero(imove,j)=caero(imove,j) + (1.-distr)*caero0(inasect,j)
- if(imove .ne. nasect) caero(imove+1,j) = caero(imove+1,j)
- & + distr*caero0(inasect,j)
- enddo
- enddo
-C
- do k = 13,20
- cpt(k-12) = 0.0
- do j = 1,nasect
- cpt(k-12) = cpt(k-12) + Caero(j,k)
- enddo
- enddo
-C
- CALL MAINPART(ORG,AQ,AM,AD,prevsol)
-C
- DO K = 1,10
- ZSRCONC(K) = AQ(K) + AM(K)*MWPART(K)/(MWPART(K)-1.) +
- + AD(K)*MWPART(K)/(MWPART(K)-2.)
- ENDDO
-C
-c
- CALL ZSR(ZSRCONC,RH,DELLWC)
-C
- CTSOA(1) = ORG(1) + AQ(1)
- CTSOA(2) = AM(1)*MWPART(1)/(MWPART(1)-1.)
- CTSOA(3) = ORG(2) + AQ(2)
- CTSOA(4) = AM(2)*MWPART(2)/(MWPART(2)-1.)
- CTSOA(5) = ORG(3) + AQ(3)
- CTSOA(6) = ORG(4) + AQ(4)
- CTSOA(7) = ORG(5) + AQ(5)
- CTSOA(8) = ORG(6) + AQ(6)
- CTSOA(9) = AM(6)*MWPART(6)/(MWPART(6)-1.)
- CTSOA(10) = AD(6)*MWPART(6)/(MWPART(6)-2.)
- CTSOA(11) = ORG(7) + AQ(7)
- CTSOA(12) = AM(7)*MWPART(7)/(MWPART(7)-1.)
- CTSOA(13) = AD(7)*MWPART(7)/(MWPART(7)-2.)
- CTSOA(14) = ORG(8) + AQ(8)
- CTSOA(15) = ORG(9) + AQ(9)
- CTSOA(16) = AM(9)*MWPART(9)/(MWPART(9)-1.)
- CTSOA(17) = ORG(10) + AQ(10)
-C
- DO J = 1,NASECT
- DENOM(J) = 0.0
- enddo
-C
- DO I = 1,NASECT
- DENOM(I) = PI*DPINDEX(I)*DPINDEX(I)*NN(I)
- ENDDO
-C
- BOT = 0.0
- DO I = 1,NASECT
- BOT = BOT + DENOM(I)
- ENDDO
-C
- DO I = 1,NASECT
- FRAC(I) = DENOM(I)/BOT
- ENDDO
-C
- DO I = 1,17
- DO J = 1,NASECT
- CSOA(J,I) = CTSOA(I)*FRAC(J)
- ENDDO
- ENDDO
-C
-C
- DO J = 1,NASECT
- CAERO(J,10) = CAERO(J,10) + DELLWC*FRAC(J)
- ENDDO
-C
- return
- end
diff --git a/src/MNH/aeroparam.f b/src/MNH/aeroparam.f
deleted file mode 100644
index 769c26d3c396ece84a9a57fb114b5c53469bcfca..0000000000000000000000000000000000000000
--- a/src/MNH/aeroparam.f
+++ /dev/null
@@ -1,104 +0,0 @@
-!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! Modifications:
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-!-----------------------------------------------------------------
- subroutine aeroparam(tempE, iaero, Ustar, Kn, Sc, St, Vsett)
-C This subroutine calculates the Knudson, Schmidt, and Stokes numbers
-C as a function of the inpput temperature and particle size.
-C Written by Zhaoyue Meng in May 1996 at Caltech.
-C
-C Inputs:
-C tempE : Temperature (Centigrade)
-C iaero : Aerosol size section index
-C Ustar : Friction velocity
-C
-C Outputs:
-C Kn : Knudson number
-C Sc : Particle Schmidt number
-C St : Stokes number
-C Vsett : Particle settling velocity
-C
-C Variables used:
-C p : Atmospheric pressure
-C Rgas : Gas constant
-C viscos : Viscosity of air
-C delmu : Interval of particle size sections on a logrithmic scale
-C Dp : Particle diameter (m)
-C mfp : Mean free path of air molecules
-C DiffuP : Diffusivity of particles
-C densP : Density of particles
-C densA : Density of air
-C Vsett : Particle settling velocity
-C Ustar : Friction velocity
-
- INCLUDE 'parameter.h'
- real Kn, Mwair, KBolzm, mfp
- common / mfp / mfp
- external fundiff
- data p,Rgas,Mwair/1.013e5,8.314,29.e-3/
- data pi/3.141593/
- data viscos/1.8e-5/ !in unit of kg/m/s
- data KBolzm,grav/1.38e-23, 9.80/
- data alfa,beta,gama/1.257,0.40,-1.10/
- tempK = tempE + 273.15
- delmu=(alog(Dpup)-alog(Dplow))/real(nasect)
- Dp1=alog(Dplow)+(real(iaero)-1.0)*delmu
- Dp2=Dp1+delmu
- Dp1=exp(Dp1)*1.e-6
- Dp2=exp(Dp2)*1.e-6
- mfp = viscos/0.499/p/sqrt(8.*Mwair/pi/Rgas/tempK)
- aa = DensP*1000.*grav/18./viscos
- Vsett = aa/2./delmu*((Dp2*Dp2-Dp1*Dp1) + 4.*mfp*alfa*(Dp2-Dp1)
- & +8.*beta*mfp*mfp/gama*(exp(gama*Dp2/2./mfp)
- & -exp(gama*Dp1/2./mfp)))
- Dp = sqrt(Dp1*Dp2)
- Kn = 2.*mfp/Dp
-c CcKn = Cc(Kn)
-c fff = 3.*pi*Dp*Viscos/CcKn
-c DiffuP1 = KBolzm*TempK/fff
-c Vsett1 = Dp*Dp*DensP*1000.*grav*CcKn/18./viscos
- densA = p/Rgas/tempK*Mwair
- St = Vsett/grav*Ustar*Ustar/Viscos*densA
- bb = KBolzm*TempK/(3.*pi*Viscos)
- call qgaus(fundiff,Dp1,Dp2,ss)
- DiffuP = bb/delmu*((1./Dp1-1./Dp2) +
- & alfa*mfp*(1./Dp1/Dp1-1./Dp2/Dp2) + 2.*mfp*beta*ss)
- SC = Viscos/densA/DiffuP
- return
- end
-C**********************
-c function Cc(Kn)
-c real Kn
-c data alfa,beta,gama/1.257,0.40,1.10/
-c Cc = 1. + Kn*(alfa + beta*exp(-gama/Kn))
-c return
-c end
-C**********************
- function fundiff(Dp)
- real mfp
- common / mfp / mfp
- data alfa,beta,gama/1.257,0.40,-1.10/
- fundiff = exp(gama*Dp/2./mfp)/Dp/Dp/Dp
- return
- end
-c Gaussian quadrature integration solver
- subroutine qgaus(func,a,b,ss)
- real a, b, ss, func
- external func
- real dx,xm,xr,w(5),x(5)
- data w/.2955242247,.2692667193,.2190863625,.1494513491,.066671344/
- data x/.1488743389,.4333953941,.6794095682,.8650633666,.973906529/
- xm = 0.5*(b+a)
- xr = 0.5*(b-a)
- ss = 0.
- do 11 j = 1, 5
- dx = xr*x(j)
- ss = ss + w(j)*(func(xm+dx)+func(xm-dx))
- 11 continue
- ss = xr*ss
- return
- end
diff --git a/src/MNH/aerozon.f90 b/src/MNH/aerozon.f90
index 190ff0298cf04f85457e0617205156d8fd0ed9c8..b2e6b6c9f9ee75dcde79d6a0e985c75c1a35b0d8 100644
--- a/src/MNH/aerozon.f90
+++ b/src/MNH/aerozon.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -273,19 +273,19 @@ DO JI=1,11
END DO
!
IF ( LFIX_DAT ) THEN
- IF( MOD(TPDTEXP%TDATE%YEAR,4).EQ.0 ) THEN
- ZDATE = REAL(TPDTEXP%TDATE%DAY + IBIS(TPDTEXP%TDATE%MONTH-1)) - 1
+ IF( MOD(TPDTEXP%nyear,4).EQ.0 ) THEN
+ ZDATE = REAL(TPDTEXP%nday + IBIS(TPDTEXP%nmonth-1)) - 1
ZAD = 2.0*XPI*ZDATE/366.0
ELSE
- ZDATE = REAL(TPDTEXP%TDATE%DAY + INOBIS(TPDTEXP%TDATE%MONTH-1)) - 1
+ ZDATE = REAL(TPDTEXP%nday + INOBIS(TPDTEXP%nmonth-1)) - 1
ZAD = 2.0*XPI*ZDATE/365.0
END IF
ELSE
- IF( MOD(TPDTCUR%TDATE%YEAR,4).EQ.0 ) THEN
- ZDATE = REAL(TPDTCUR%TDATE%DAY + IBIS(TPDTCUR%TDATE%MONTH-1)) - 1
+ IF( MOD(TPDTCUR%nyear,4).EQ.0 ) THEN
+ ZDATE = REAL(TPDTCUR%nday + IBIS(TPDTCUR%nmonth-1)) - 1
ZAD = 2.0*XPI*ZDATE/366.0
ELSE
- ZDATE = REAL(TPDTCUR%TDATE%DAY + INOBIS(TPDTCUR%TDATE%MONTH-1)) - 1
+ ZDATE = REAL(TPDTCUR%nday + INOBIS(TPDTCUR%nmonth-1)) - 1
ZAD = 2.0*XPI*ZDATE/365.0
END IF
END IF
@@ -404,11 +404,11 @@ END IF
ALLOCATE (ZOZON(KDLON,KFLEV))
!
IF (LFIX_DAT ) THEN
- ZYMD = TPDTEXP%TDATE%YEAR * 1E4 + TPDTEXP%TDATE%MONTH * 1E2 + TPDTEXP%TDATE%DAY
- ZHOURS = INT(TPDTCUR%TIME / 60.)
+ ZYMD = TPDTEXP%nyear * 1E4 + TPDTEXP%nmonth * 1E2 + TPDTEXP%nday
+ ZHOURS = INT(TPDTCUR%xtime / 60.)
ELSE
- ZYMD = TPDTCUR%TDATE%YEAR * 1E4 + TPDTCUR%TDATE%MONTH * 1E2 + TPDTCUR%TDATE%DAY
- ZHOURS = INT(TPDTCUR%TIME / 60.)
+ ZYMD = TPDTCUR%nyear * 1E4 + TPDTCUR%nmonth * 1E2 + TPDTCUR%nday
+ ZHOURS = INT(TPDTCUR%xtime / 60.)
END IF
!
! Fortuin langematz climatology loading
diff --git a/src/MNH/aircraft_balloon.f90 b/src/MNH/aircraft_balloon.f90
index fa1872b0a346dd3074eda9702937146475b5c50e..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.
!-----------------------------------------------------------------
! #####################
@@ -10,18 +10,12 @@ MODULE MODI_AIRCRAFT_BALLOON
INTERFACE
!
SUBROUTINE AIRCRAFT_BALLOON(PTSTEP, &
- TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
PXHAT, PYHAT, PZ, &
PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, &
PTS, PRHODREF, PCIT, PSEA)
!
-USE MODD_TYPE_DATE
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTEXP! experiment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTMOD! model start date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG! segment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTCUR! current date and time
REAL, DIMENSION(:), INTENT(IN) :: PXHAT ! x coordinate
REAL, DIMENSION(:), INTENT(IN) :: PYHAT ! y coordinate
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z
@@ -47,13 +41,19 @@ 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
!
! ###################################################################
SUBROUTINE AIRCRAFT_BALLOON(PTSTEP, &
- TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
PXHAT, PYHAT, PZ, &
PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, &
@@ -90,8 +90,9 @@ END MODULE MODI_AIRCRAFT_BALLOON
!! Original 15/05/2000
!!
!! March, 2008 (P.Lacarrere) Add 3D fluxes
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! --------------------------------------------------------------------------
+! 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
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -111,10 +112,6 @@ IMPLICIT NONE
!
!
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTEXP! experiment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTMOD! model start date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG! segment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTCUR! current date and time
REAL, DIMENSION(:), INTENT(IN) :: PXHAT ! x coordinate
REAL, DIMENSION(:), INTENT(IN) :: PYHAT ! y coordinate
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
@@ -148,237 +145,198 @@ IF(.NOT. ALLOCATED(XSVW_FLUX)) &
ALLOCATE(XSVW_FLUX(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)))
!
IF (TBALLOON1%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TBALLOON1, PSEA )
ENDIF
IF (TBALLOON2%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TBALLOON2, PSEA )
ENDIF
IF (TBALLOON3%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TBALLOON3, PSEA )
ENDIF
IF (TBALLOON4%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TBALLOON4, PSEA )
ENDIF
IF (TBALLOON5%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TBALLOON5, PSEA )
ENDIF
IF (TBALLOON6%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TBALLOON6, PSEA )
ENDIF
IF (TBALLOON7%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TBALLOON7, PSEA )
ENDIF
IF (TBALLOON8%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TBALLOON8, PSEA )
ENDIF
IF (TBALLOON9%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TBALLOON9, PSEA )
ENDIF
!
IF (TAIRCRAFT1%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT1, PSEA )
ENDIF
IF (TAIRCRAFT2%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT2, PSEA )
ENDIF
IF (TAIRCRAFT3%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT3, PSEA )
ENDIF
IF (TAIRCRAFT4%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT4, PSEA )
ENDIF
IF (TAIRCRAFT5%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT5, PSEA )
ENDIF
IF (TAIRCRAFT6%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT6, PSEA )
ENDIF
IF (TAIRCRAFT7%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT7, PSEA )
ENDIF
IF (TAIRCRAFT8%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT8, PSEA )
ENDIF
IF (TAIRCRAFT9%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT9, PSEA )
ENDIF
IF (TAIRCRAFT10%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT10, PSEA )
ENDIF
IF (TAIRCRAFT11%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT11, PSEA )
ENDIF
IF (TAIRCRAFT12%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT12, PSEA )
ENDIF
IF (TAIRCRAFT13%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT13, PSEA )
ENDIF
IF (TAIRCRAFT14%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT14, PSEA )
ENDIF
IF (TAIRCRAFT15%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT15, PSEA )
ENDIF
IF (TAIRCRAFT16%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT16, PSEA )
ENDIF
IF (TAIRCRAFT17%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT17, PSEA )
ENDIF
IF (TAIRCRAFT18%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT18, PSEA )
ENDIF
IF (TAIRCRAFT19%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT19, PSEA )
ENDIF
IF (TAIRCRAFT20%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT20, PSEA )
ENDIF
IF (TAIRCRAFT21%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT21, PSEA )
ENDIF
IF (TAIRCRAFT22%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT22, PSEA )
ENDIF
IF (TAIRCRAFT23%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT23, PSEA )
ENDIF
IF (TAIRCRAFT24%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT24, PSEA )
ENDIF
IF (TAIRCRAFT25%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT25, PSEA )
ENDIF
IF (TAIRCRAFT26%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT26, PSEA )
ENDIF
IF (TAIRCRAFT27%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT27, PSEA )
ENDIF
IF (TAIRCRAFT28%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT28, PSEA )
ENDIF
IF (TAIRCRAFT29%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT29, PSEA )
ENDIF
IF (TAIRCRAFT30%NMODEL /= 0) THEN
-CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
- PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
+CALL AIRCRAFT_BALLOON_EVOL(PTSTEP, PXHAT, PYHAT, PZ, PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, PTS, PRHODREF, PCIT, &
TAIRCRAFT30, PSEA )
ENDIF
@@ -386,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/aircraft_balloon_evol.f90 b/src/MNH/aircraft_balloon_evol.f90
index 12f4f595d6cf394d7379a31fabbf68d723013dba..9642bcc4e8de8a731373a2db1fc3b94934abb8ce 100644
--- a/src/MNH/aircraft_balloon_evol.f90
+++ b/src/MNH/aircraft_balloon_evol.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2019 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.
@@ -10,20 +10,14 @@ MODULE MODI_AIRCRAFT_BALLOON_EVOL
INTERFACE
!
SUBROUTINE AIRCRAFT_BALLOON_EVOL(PTSTEP, &
- TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
PXHAT, PYHAT, PZ, &
PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, &
PTS, PRHODREF, PCIT,TPFLYER, PSEA )
!
-USE MODD_TYPE_DATE
USE MODD_AIRCRAFT_BALLOON
!
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTEXP! experiment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTMOD! model start date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG! segment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTCUR! current date and time
REAL, DIMENSION(:), INTENT(IN) :: PXHAT ! x coordinate
REAL, DIMENSION(:), INTENT(IN) :: PYHAT ! y coordinate
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
@@ -55,7 +49,6 @@ END MODULE MODI_AIRCRAFT_BALLOON_EVOL
!
! ########################################################
SUBROUTINE AIRCRAFT_BALLOON_EVOL(PTSTEP, &
- TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
PXHAT, PYHAT, PZ, &
PMAP, PLONOR, PLATOR, &
PU, PV, PW, PP, PTH, PR, PSV, PTKE, &
@@ -128,7 +121,13 @@ END MODULE MODI_AIRCRAFT_BALLOON_EVOL
!! October, 2016 (G.DELAUTIER) LIMA
!! 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
+! P. Wautelet 01/10/2020: bugfix: initialize GSTORE
+! P. Wautelet 14/01/2021: bugfixes: -ZXCOEF and ZYCOEF were not computed if CVBALL
+! -PCIT was used if CCLOUD/=ICEx (not allocated)
+! -PSEA was always used even if not allocated (CSURF/=EXTE)
+! -do not use PMAP if cartesian domain
+!
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -153,7 +152,7 @@ USE MODD_PARAM_LIMA_MIXED, ONLY: XDG_L=>XDG,XLBEXG_L=>XLBEXG,XLBG_L=>XLBG,XCCG_L
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_PARAM_n, ONLY: CCLOUD
+USE MODD_PARAM_n, ONLY: CCLOUD, CSURF
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,&
@@ -167,9 +166,9 @@ USE MODD_RAIN_ICE_DESCR, ONLY: XALPHAR_I=>XALPHAR,XNUR_I=>XNUR,XLBEXR_I=>XLBEX
XLBI_I=>XLBI,XAI_I=>XAI,XBI_I=>XBI,XC_I_I=>XC_I,&
XRTMIN_I=>XRTMIN,XCONC_LAND,XCONC_SEA
USE MODD_REF_n, ONLY: XRHODREF
-USE MODD_TIME
+USE MODD_TIME, only: tdtexp
+USE MODD_TIME_n, only: tdtcur
USE MODD_TURB_FLUX_AIRCRAFT_BALLOON
-USE MODD_TYPE_DATE
!
USE MODE_DATETIME
USE MODE_FGAU, ONLY: GAULAG
@@ -188,10 +187,6 @@ IMPLICIT NONE
!
!
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTEXP! experiment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTMOD! model start date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG! segment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTCUR! current date and time
REAL, DIMENSION(:), INTENT(IN) :: PXHAT ! x coordinate
REAL, DIMENSION(:), INTENT(IN) :: PYHAT ! y coordinate
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
@@ -220,7 +215,6 @@ REAL, DIMENSION(:,:), INTENT(IN) :: PSEA
!
INTEGER :: IMI ! model index
REAL :: ZTHIS_PROC ! 1 if balloon is currently treated by this proc., else 0
-REAL :: ZTIMEEXP ! elpased time between start of experiment and segment
!
INTEGER :: IIB ! current processor domain sizes
INTEGER :: IJB
@@ -345,6 +339,7 @@ ALLOCATE(XSVW_FLUX(SIZE(PSV,1),SIZE(PSV,2),SIZE(PSV,3),SIZE(PSV,4)))
ILUOUT = TLUOUT%NLU
!
ZR = 0.
+GSTORE = .FALSE.
!
!* 1.0 initialization of processor test
! --------------------------------
@@ -398,7 +393,7 @@ ZYHATM( IJU )=1.5*PYHAT( IJU )-0.5*PYHAT( IJU-1)
!* 2.3 Compute time until launch by comparison of dates and times
! ----------------------------------------------------------
!
-CALL DATETIME_DISTANCE(TPFLYER%LAUNCH,TPDTCUR,ZTDIST)
+CALL DATETIME_DISTANCE(TPFLYER%LAUNCH,TDTCUR,ZTDIST)
!
!* 3. LAUNCH
! ------
@@ -412,7 +407,7 @@ IF (.NOT. TPFLYER%FLY) THEN
!* 3.1 comparison of dates and times
! -----------------------------
!
-! CALL DATETIME_DISTANCE(TPFLYER%LAUNCH,TPDTCUR,ZTDIST)
+! CALL DATETIME_DISTANCE(TPFLYER%LAUNCH,TDTCUR,ZTDIST)
!
!* 3.2 launch/takeoff is effective
! ---------------------------
@@ -445,9 +440,9 @@ IF (.NOT. TPFLYER%FLY) THEN
TPFLYER%CRASH=.FALSE.
IF (ZTDIST <= PTSTEP ) THEN
WRITE(ILUOUT,*) '-------------------------------------------------------------------'
- WRITE(ILUOUT,*) 'Aircraft ',TPFLYER%TITLE,' takes off the ', &
- TPDTCUR%TDATE%DAY,'/',TPDTCUR%TDATE%MONTH,'/', &
- TPDTCUR%TDATE%YEAR,' at ',NINT(TPDTCUR%TIME),' sec.'
+ WRITE(ILUOUT,*) 'Aircraft ',TPFLYER%TITLE,' takes off the ', &
+ TDTCUR%nday,'/',TDTCUR%nmonth,'/', &
+ TDTCUR%nyear,' at ',NINT(TDTCUR%xtime),' sec.'
WRITE(ILUOUT,*) '-------------------------------------------------------------------'
ENDIF
ENDIF
@@ -455,9 +450,9 @@ IF (.NOT. TPFLYER%FLY) THEN
TPFLYER%FLY = .TRUE.
GLAUNCH = .TRUE.
WRITE(ILUOUT,*) '-------------------------------------------------------------------'
- WRITE(ILUOUT,*) 'Balloon ',TPFLYER%TITLE,' is launched the ', &
- TPDTCUR%TDATE%DAY,'/',TPDTCUR%TDATE%MONTH,'/', &
- TPDTCUR%TDATE%YEAR,' at ',NINT(TPDTCUR%TIME),' sec.'
+ WRITE(ILUOUT,*) 'Balloon ',TPFLYER%TITLE,' is launched the ', &
+ TDTCUR%nday,'/',TDTCUR%nmonth,'/', &
+ TDTCUR%nyear,' at ',NINT(TDTCUR%xtime),' sec.'
WRITE(ILUOUT,*) '-------------------------------------------------------------------'
END IF
!
@@ -502,25 +497,14 @@ END IF
!
IF (GSTORE) THEN
IN = TPFLYER%N_CUR
- CALL DATETIME_DISTANCE(TDTEXP,TDTSEG,ZTIMEEXP)
- !
- TPFLYER%TIME(IN) = (IN-1) * TPFLYER%STEP + ZTIMEEXP
- TPFLYER%DATIME( 1,IN) = TPDTEXP%TDATE%YEAR
- TPFLYER%DATIME( 2,IN) = TPDTEXP%TDATE%MONTH
- TPFLYER%DATIME( 3,IN) = TPDTEXP%TDATE%DAY
- TPFLYER%DATIME( 4,IN) = TPDTEXP%TIME
- TPFLYER%DATIME( 5,IN) = TPDTSEG%TDATE%YEAR
- TPFLYER%DATIME( 6,IN) = TPDTSEG%TDATE%MONTH
- TPFLYER%DATIME( 7,IN) = TPDTSEG%TDATE%DAY
- TPFLYER%DATIME( 8,IN) = TPDTSEG%TIME
- TPFLYER%DATIME( 9,IN) = TPDTMOD%TDATE%YEAR
- TPFLYER%DATIME(10,IN) = TPDTMOD%TDATE%MONTH
- TPFLYER%DATIME(11,IN) = TPDTMOD%TDATE%DAY
- TPFLYER%DATIME(12,IN) = TPDTMOD%TIME
- TPFLYER%DATIME(13,IN) = TPDTCUR%TDATE%YEAR
- TPFLYER%DATIME(14,IN) = TPDTCUR%TDATE%MONTH
- TPFLYER%DATIME(15,IN) = TPDTCUR%TDATE%DAY
- TPFLYER%DATIME(16,IN) = TPDTCUR%TIME
+#if 0
+ tpflyer%tpdates(in)%nyear = tdtexp%nyear
+ tpflyer%tpdates(in)%nmonth = tdtexp%nmonth
+ tpflyer%tpdates(in)%nday = tdtexp%nday
+ tpflyer%tpdates(in)%xtime = tdtexp%xtime + ( in - 1 ) * tpflyer%step
+#else
+ tpflyer%tpdates(in) = tdtcur
+#endif
END IF
!
IF ( TPFLYER%FLY) THEN
@@ -648,6 +632,7 @@ IF ( TPFLYER%FLY) THEN
END DO
ZTHW_FLUX(:,:,:) = ZRHO(:,:,:)*XCPD *XTHW_FLUX(II:II+1,IJ:IJ+1,:)
ZRCW_FLUX(:,:,:) = ZRHO(:,:,:)*XLVTT*XRCW_FLUX(II:II+1,IJ:IJ+1,:)
+ ZSVW_FLUX(:,:,:,:) = XSVW_FLUX(II:II+1,IJ:IJ+1,:,:)
END IF
!
@@ -718,6 +703,10 @@ IF ( TPFLYER%FLY) THEN
!* 5.2.4 Constant Volume Balloon
!
IF (TPFLYER%TYPE=='CVBALL') THEN
+ ZXCOEF = (TPFLYER%X_CUR - ZXHATM(II)) / (ZXHATM(II+1) - ZXHATM(II))
+ ZXCOEF = MAX (0.,MIN(ZXCOEF,1.))
+ ZYCOEF = (TPFLYER%Y_CUR - ZYHATM(IJ)) / (ZYHATM(IJ+1) - ZYHATM(IJ))
+ ZYCOEF = MAX (0.,MIN(ZYCOEF,1.))
IF ( TPFLYER%ALT /= XUNDEF ) THEN
IK00 = MAX ( COUNT (TPFLYER%ALT >= ZZM(1,1,:)), 1)
IK01 = MAX ( COUNT (TPFLYER%ALT >= ZZM(1,2,:)), 1)
@@ -744,7 +733,7 @@ IF ( TPFLYER%FLY) THEN
IK10 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,1,:)), 1)
IK11 = MAX ( COUNT (ZFLYER_EXN <= ZEXN(2,2,:)), 1)
IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
- TPFLYER%Z_CUR = ZZM(1,1,IKB)
+ TPFLYER%Z_CUR = ZZM(1,1,IKB)
TPFLYER%Z_CUR = MAX ( TPFLYER%Z_CUR , ZZM(2,1,IKB) )
TPFLYER%Z_CUR = MAX ( TPFLYER%Z_CUR , ZZM(1,2,IKB) )
TPFLYER%Z_CUR = MAX ( TPFLYER%Z_CUR , ZZM(2,2,IKB) )
@@ -763,7 +752,7 @@ IF ( TPFLYER%FLY) THEN
IK10 = MAX ( COUNT (TPFLYER%RHO <= ZRHO(2,1,:)), 1)
IK11 = MAX ( COUNT (TPFLYER%RHO <= ZRHO(2,2,:)), 1)
IF (IK00*IK01*IK10*IK11 .EQ. 0) THEN
- TPFLYER%Z_CUR = ZZM(1,1,IKB)
+ TPFLYER%Z_CUR = ZZM(1,1,IKB)
TPFLYER%Z_CUR = MAX ( TPFLYER%Z_CUR , ZZM(2,1,IKB) )
TPFLYER%Z_CUR = MAX ( TPFLYER%Z_CUR , ZZM(1,2,IKB) )
TPFLYER%Z_CUR = MAX ( TPFLYER%Z_CUR , ZZM(2,2,IKB) )
@@ -829,19 +818,19 @@ IF ( TPFLYER%FLY) THEN
TPFLYER%FLY = .FALSE.
IF (TPFLYER%TYPE=='AIRCRA' .AND. .NOT. GLAUNCH ) THEN
WRITE(ILUOUT,*) 'Aircraft ',TPFLYER%TITLE,' flew out of the domain the ', &
- TPDTCUR%TDATE%DAY,'/',TPDTCUR%TDATE%MONTH,'/', &
- TPDTCUR%TDATE%YEAR,' at ',TPDTCUR%TIME,' sec.'
+ TDTCUR%nday,'/',TDTCUR%nmonth,'/', &
+ TDTCUR%nyear,' at ',TDTCUR%xtime,' sec.'
ELSE IF (TPFLYER%TYPE /= 'AIRCRA') THEN
WRITE(ILUOUT,*) 'Balloon ',TPFLYER%TITLE,' crashed the ', &
- TPDTCUR%TDATE%DAY,'/',TPDTCUR%TDATE%MONTH,'/', &
- TPDTCUR%TDATE%YEAR,' at ',TPDTCUR%TIME,' sec.'
+ TDTCUR%nday,'/',TDTCUR%nmonth,'/', &
+ TDTCUR%nyear,' at ',TDTCUR%xtime,' sec.'
END IF
ELSE
IF (TPFLYER%TYPE=='AIRCRA' .AND. .NOT. GLAUNCH .AND. ZTDIST > PTSTEP ) THEN
WRITE(ILUOUT,*) '-------------------------------------------------------------------'
WRITE(ILUOUT,*) 'Aircraft ',TPFLYER%TITLE,' flies in leg',TPFLYER%SEGCURN ,' the ', &
- TPDTCUR%TDATE%DAY,'/',TPDTCUR%TDATE%MONTH,'/', &
- TPDTCUR%TDATE%YEAR,' at ',NINT(TPDTCUR%TIME),' sec.'
+ TDTCUR%nday,'/',TDTCUR%nmonth,'/', &
+ TDTCUR%nyear,' at ',NINT(TDTCUR%xtime),' sec.'
WRITE(ILUOUT,*) '-------------------------------------------------------------------'
ENDIF
!
@@ -984,8 +973,8 @@ IF ( TPFLYER%FLY) THEN
TPFLYER%CIZ (IN,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NI))
TPFLYER%CCZ (IN,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NC))
TPFLYER%CRZ (IN,:) = FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NR))
- ELSE
- TPFLYER%CIZ (IN,:) = FLYER_INTERPZ(PCIT(:,:,:))
+ ELSE IF ( CCLOUD=="ICE3" .OR. CCLOUD=="ICE4" ) THEN
+ TPFLYER%CIZ (IN,:) = FLYER_INTERPZ(PCIT(:,:,:))
ENDIF
! initialization CRARE and CRARE_ATT + LWC and IWC
TPFLYER%CRARE(IN,:) = 0.
@@ -997,19 +986,28 @@ IF ( TPFLYER%FLY) THEN
TPFLYER%IWCZ (IN,:) = FLYER_INTERPZ((PR(:,:,:,4)+PR(:,:,:,5)+PR(:,:,:,6))*PRHODREF(:,:,:))
ZTEMPZ(:)=FLYER_INTERPZ(PTH(II:II+1,IJ:IJ+1,:) * ZEXN(:,:,:))
ZRHODREFZ(:)=FLYER_INTERPZ(PRHODREF(:,:,:))
- ZCIT(:)=FLYER_INTERPZ(PCIT(:,:,:))
IF (CCLOUD=="LIMA") THEN
ZCCI(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NI))
ZCCR(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NR))
ZCCC(:)=FLYER_INTERPZ(PSV(:,:,:,NSV_LIMA_NC))
+ ELSE
+ ZCIT(:)=FLYER_INTERPZ(PCIT(:,:,:))
ENDIF
DO JLOOP=3,6
ZRZ(:,JLOOP)=FLYER_INTERPZ(PR(:,:,:,JLOOP))
END DO
- DO JK=1,IKU
- ZRZ(JK,2)=FLYER_INTERP_2D(PR(:,:,JK,2)*PSEA(:,:)) ! becomes cloud mixing ratio over sea
- ZRZ(JK,7)=FLYER_INTERP_2D(PR(:,:,JK,2)*(1.-PSEA(:,:))) ! becomes cloud mixing ratio over land
- END DO
+ if ( csurf == 'EXTE' ) then
+ DO JK=1,IKU
+ ZRZ(JK,2)=FLYER_INTERP_2D(PR(:,:,JK,2)*PSEA(:,:)) ! becomes cloud mixing ratio over sea
+ ZRZ(JK,7)=FLYER_INTERP_2D(PR(:,:,JK,2)*(1.-PSEA(:,:))) ! becomes cloud mixing ratio over land
+ END DO
+ else
+ !if csurf/='EXTE', psea is not allocated
+ DO JK=1,IKU
+ ZRZ(JK,2)=FLYER_INTERP_2D(PR(:,:,JK,2))
+ ZRZ(JK,7) = 0.
+ END DO
+ end if
ALLOCATE(ZAELOC(IKU))
!
ZAELOC(:)=0.
@@ -1296,7 +1294,11 @@ IF ( TPFLYER%FLY) THEN
IF (TPFLYER%TYPE=='RADIOS' .OR. TPFLYER%TYPE=='ISODEN' .OR. TPFLYER%TYPE=='CVBALL') THEN
ZU_BAL = FLYER_INTERP_U(PU)
ZV_BAL = FLYER_INTERP_V(PV)
- ZMAP = FLYER_INTERP_2D(PMAP)
+ if ( .not. lcartesian ) then
+ ZMAP = FLYER_INTERP_2D(PMAP)
+ else
+ ZMAP = 1.
+ end if
!
TPFLYER%X_CUR = TPFLYER%X_CUR + ZU_BAL * PTSTEP * ZMAP
TPFLYER%Y_CUR = TPFLYER%Y_CUR + ZV_BAL * PTSTEP * ZMAP
@@ -1708,12 +1710,12 @@ IF (TPFLYER%NMODEL /= IMODEL) THEN
IF (NDAD(IMODEL) == TPFLYER%NMODEL) THEN
WRITE(ILUOUT,*) '-------------------------------------------------------------------'
WRITE(ILUOUT,*) TPFLYER%TITLE,' comes from model ',IMODEL,' in model ',&
- TPFLYER%NMODEL,' at ',NINT(TPDTCUR%TIME),' sec.'
+ TPFLYER%NMODEL,' at ',NINT(TDTCUR%xtime),' sec.'
WRITE(ILUOUT,*) '-------------------------------------------------------------------'
ELSE
WRITE(ILUOUT,*) '-------------------------------------------------------------------'
WRITE(ILUOUT,*) TPFLYER%TITLE,' goes from model ',IMODEL,' to model ',&
- TPFLYER%NMODEL,' at ',NINT(TPDTCUR%TIME),' sec.'
+ TPFLYER%NMODEL,' at ',NINT(TDTCUR%xtime),' sec.'
WRITE(ILUOUT,*) '-------------------------------------------------------------------'
ENDIF
ENDIF
diff --git a/src/MNH/anel_balancen.f90 b/src/MNH/anel_balancen.f90
index 743c5b5c7f57048cb103e29372c2e9748c70dd21..540e56b76eff1ad6c19ca1cf4fc79da078cb12ae 100644
--- a/src/MNH/anel_balancen.f90
+++ b/src/MNH/anel_balancen.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.
@@ -169,8 +169,6 @@ INTEGER :: IRRI ! Number of solid water variables
REAL :: ZDRYMASST ! Mass of dry air Md
REAL :: ZREFMASS ! Total mass of the ref. atmosphere
REAL :: ZMASS_O_PHI0 ! Mass / Phi0
-LOGICAL :: GCLOSE_OUT ! switch for the LFI writing
-CHARACTER (LEN= 28) :: YFMFILE ! virtual FM file
INTEGER :: IMI ! model index
!JUAN
INTEGER :: IIU_B,IJU_B,IKU
@@ -266,8 +264,6 @@ ZMASS_O_PHI0 = 1. ! | which is here not needed |
IRR = 0 ! | |
IRRL = 0 ! | |
IRRI = 0 ! ==============================================
-GCLOSE_OUT=.FALSE.
-YFMFILE='UNUSED'
!
IMI = GET_CURRENT_MODEL_INDEX()
CALL PRESSUREZ(CLBCX,CLBCY,CPRESOPT,NITR,LITRADJ,ITCOUNT,XRELAX,IMI, &
diff --git a/src/MNH/ares.f b/src/MNH/ares.f
index 3fd41e2b9bac4782d0b53f6df1eb606206cf6c31..2a300286f4320976d6edfc3de07d6ab24a574337 100644
--- a/src/MNH/ares.f
+++ b/src/MNH/ares.f
@@ -1071,12 +1071,14 @@ C ///////////////////////////////////
C ***
C234567
subroutine cubic(a2,a1,a0,nr,crutes)
+ use modd_precision, only: MNHREAL64
implicit none
integer nr
real a2,a1,a0,crutes(3)
- real*8 qq,rr,a2sq,theta, sqrt3, one3rd
- real*8 dum1,dum2,part1,part2,part3,rrsq,phi,yy1,yy2,yy3
- real*8 costh, sinth
+ real(kind=MNHREAL64) qq,rr,a2sq,theta, sqrt3, one3rd
+ real(kind=MNHREAL64) dum1,dum2,part1,part2,part3,rrsq,phi
+ real(kind=MNHREAL64) yy1,yy2,yy3
+ real(kind=MNHREAL64) costh, sinth
data sqrt3/1.732050808/, one3rd/0.333333333/
a2sq=a2*a2
qq=(a2sq-3.*a1)/9.
diff --git a/src/MNH/bl89.f90 b/src/MNH/bl89.f90
index e28f1cc0e73223cb604dffbf9368770284d44a53..d92be3851353028f4b87c86152e25dd56eaf91d2 100644
--- a/src/MNH/bl89.f90
+++ b/src/MNH/bl89.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1997-2019 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 for details. version 1.
@@ -68,14 +68,17 @@ END MODULE MODI_BL89
!! reversed vertical levels
!! Philippe 13/02/2018: use ifdef MNH_REAL to prevent problems with intrinsics on Blue Gene/Q
!! 01/2019 (Q. Rodier) support for RM17 mixing length
+!! 03/2021 (JL Redelsperger) Ocean model case
+!! 06/2021 (P. Marquet) correction of exponent on final length according to Lemarié et al. 2021
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CONF, ONLY: CPROGRAM
+USE MODD_CONF, ONLY: CPROGRAM
USE MODD_CST
USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_PARAMETERS
use modd_precision, only: MNHREAL
@@ -141,7 +144,7 @@ integer :: ji, jj
REAL :: ZRVORD ! Rv/Rd
REAL :: ZPOTE,ZLWORK1,ZLWORK2
REAL :: ZTEST,ZTEST0,ZTESTM ! test for vectorization
-REAL :: Z2SQRT2
+REAL :: Z2SQRT2,ZUSRBL89,ZBL89EXP
!-------------------------------------------------------------------------------
!$acc data present( pzz, pdzz, pthvref, pthlm, prm, ptkem, pshear, plm )
@@ -219,6 +222,7 @@ ELSE
ZSHEAR (:,JK) = RESHAPE(PSHEAR (:,:,JK),(/ IIU*IJU /) )
ZTKEM (:,JK) = RESHAPE(PTKEM (:,:,JK),(/ IIU*IJU /) )
ZG_O_THVREF(:,JK) = RESHAPE(XG/PTHVREF(:,:,JK),(/ IIU*IJU /) )
+ IF (LOCEAN) ZG_O_THVREF(:,JK) = XG * XALPHAOC
DO JRR=1,KRR
ZRM (:,JK,JRR) = RESHAPE(PRM (:,:,JK,JRR),(/ IIU*IJU /) )
END DO
@@ -253,8 +257,12 @@ END IF
!
#ifndef MNH_BITREP
ZSQRT_TKE = SQRT(ZTKEM)
+!ZBL89EXP is defined here because (and not in ini_cturb) because XCED is defined in read_exseg (depending on BL89/RM17)
+ZBL89EXP = LOG(16.)/(4.*LOG(XKARMAN)+LOG(XCED)-3.*LOG(XCMFS))
#else
zsqrt_tke(:, : ) = Br_pow( ztkem, 0.5 )
+!ZBL89EXP is defined here because (and not in ini_cturb) because XCED is defined in read_exseg (depending on BL89/RM17)
+ZBL89EXP = Br_log( 16. ) / ( 4. * Br_log( XKARMAN )+ Br_log( XCED ) - 3. * Br_log( XCMFS) )
#endif
!-------------------------------------------------------------------------------
!
@@ -443,11 +451,11 @@ DO JK=IKTB,IKTE
ZLWORK2=MAX(ZLWORK(J1D),1.E-10_MNHREAL)
ZPOTE = ZLWORK1 / ZLWORK2
#ifndef MNH_BITREP
- ZLWORK2=1.d0 + ZPOTE**(2./3.)
- ZLM(J1D,JK) = Z2SQRT2*ZLWORK1/(ZLWORK2*SQRT(ZLWORK2))
+ ZLWORK2=1.d0 + ZPOTE**ZBL89EXP
+ ZLM(J1D,JK) = ZLWORK1*(2./ZLWORK2)**ZUSRBL89
#else
- ZLWORK2=1.d0 + br_pow(ZPOTE,2./3.)
- ZLM(J1D,JK) = Z2SQRT2*ZLWORK1/(ZLWORK2*br_pow(ZLWORK2,0.5))
+ ZLWORK2=1.d0 + br_pow( ZPOTE, ZBL89EXP )
+ ZLM(J1D,JK) = ZLWORK1 * br_pow( 2. / ZLWORK2, ZUSRBL89 )
#endif
END DO
diff --git a/src/MNH/blowsnow.f90 b/src/MNH/blowsnow.f90
index 0c8943d036df28375d3bac85b262b04829b875f3..1bb69443c080ed425a3e753a5e243c8660f00940 100644
--- a/src/MNH/blowsnow.f90
+++ b/src/MNH/blowsnow.f90
@@ -1,7 +1,10 @@
-!MNH_LIC Copyright 1994-2018 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.
+!-----------------------------------------------------------------
+! Modifications:
+!-----------------------------------------------------------------
! ########################
MODULE MODI_BLOWSNOW
! ########################
@@ -9,10 +12,9 @@
!
INTERFACE
!
- SUBROUTINE BLOWSNOW(HLBCX,HLBCY,PTSTEP,KRR,PPABST,PTHT,PRT,PZZ,PRHODREF, &
+ SUBROUTINE BLOWSNOW(PTSTEP,KRR,PPABST,PTHT,PRT,PZZ,PRHODREF, &
PRHODJ,PEXNREF,PRS,PTHS,PSVT,PSVS,PSNWSUBL3D)
!
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
!
@@ -38,7 +40,7 @@ END INTERFACE
END MODULE MODI_BLOWSNOW
!
! ######################################################################
- SUBROUTINE BLOWSNOW(HLBCX,HLBCY,PTSTEP,KRR,PPABST,PTHT,PRT,PZZ,PRHODREF, &
+ SUBROUTINE BLOWSNOW(PTSTEP,KRR,PPABST,PTHT,PRT,PZZ,PRHODREF, &
PRHODJ,PEXNREF,PRS,PTHS,PSVT,PSVS,PSNWSUBL3D)
! ######################################################################
! ##########################################################################
@@ -84,25 +86,24 @@ END MODULE MODI_BLOWSNOW
!! Implementation in MNH 53 07/2017
!
!* 0. DECLARATIONS
-!
-USE MODE_ll
!
-USE MODD_NSV
-USE MODD_PARAMETERS
-USE MODD_BLOWSNOW_n
-USE MODD_BLOWSNOW
-!
-USE MODI_SUBL_BLOWSNOW
-USE MODI_SEDIM_BLOWSNOW
+USE MODD_BLOWSNOW_n, only: LSNOWSUBL
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
+USE MODD_NSV, only: NSV_SNWBEG, NSV_SNWEND
+USE MODD_PARAMETERS, only: JPHEXT, JPVEXT
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
USE MODI_BLOWSNOW_VELGRAV
-!
+USE MODI_SEDIM_BLOWSNOW
+USE MODI_SUBL_BLOWSNOW
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
!
-CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY ! X and Y-direc. LBC type
REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
!
@@ -133,8 +134,6 @@ INTEGER :: IJE !
INTEGER :: IKB !
INTEGER :: IKE !
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVS ! scalar tendency for microphysics only
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZVGK ! settling velocity for blowing snow variables
!------------------------------------------------------------------------------
!
@@ -148,13 +147,8 @@ IJE=SIZE(PZZ,2) - JPHEXT
IKB=1+JPVEXT
IKE=SIZE(PZZ,3) - JPVEXT
-
-ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),NSV_SNWEND - NSV_SNWBEG + 1))
-ALLOCATE(ZSVS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),NSV_SNWEND - NSV_SNWBEG + 1))
ALLOCATE(ZVGK(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),NSV_SNWEND - NSV_SNWBEG + 1))
-ZSVT = PSVT(:,:,:,NSV_SNWBEG:NSV_SNWEND)
-ZSVS = PSVS(:,:,:,NSV_SNWBEG:NSV_SNWEND)
ZVGK = 0.
!
!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
@@ -165,10 +159,9 @@ DO JRR = 1,KRR
PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:)
END DO
-DO JSV = 1,SIZE(ZSVS,4)
- ZSVS(:,:,:,JSV) = ZSVS(:,:,:,JSV) / PRHODJ(:,:,:)
+DO JSV = NSV_SNWBEG, NSV_SNWEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) / PRHODJ(:,:,:)
END DO
-
!
! complete the vertical boundaries
!
@@ -185,10 +178,10 @@ PRT(:,:,IKE+1,1) = PRT(:,:,IKE,1)
PRT(:,:,IKB-1,2:) = 0.0
PRT(:,:,IKE+1,2:) = 0.0
!
-ZSVS(:,:,IKB-1,:) = 0.0
-ZSVS(:,:,IKE+1,:) = 0.0
-ZSVT(:,:,IKB-1,:) = 0.0
-ZSVT(:,:,IKE+1,:) = 0.0
+PSVS(:,:,IKB-1,NSV_SNWBEG:NSV_SNWEND) = 0.0
+PSVS(:,:,IKE+1,NSV_SNWBEG:NSV_SNWEND) = 0.0
+PSVT(:,:,IKB-1,NSV_SNWBEG:NSV_SNWEND) = 0.0
+PSVT(:,:,IKE+1,NSV_SNWBEG:NSV_SNWEND) = 0.0
!
!------------------------------------------------------------------------------
!
@@ -199,7 +192,7 @@ ZSVT(:,:,IKE+1,:) = 0.0
! - sublimation as ventilation velocity
! - sedimentation
!
-CALL BLOWSNOW_VELGRAV(ZSVT(:,:,1:IKE+1,:),PTHT(:,:,1:IKE+1), &
+CALL BLOWSNOW_VELGRAV(PSVT(:,:,1:IKE+1,NSV_SNWBEG:NSV_SNWEND),PTHT(:,:,1:IKE+1), &
PPABST(:,:,1:IKE+1), &
PRHODREF(:,:,1:IKE+1),ZVGK(:,:,1:IKE+1,:))
@@ -208,27 +201,34 @@ CALL BLOWSNOW_VELGRAV(ZSVT(:,:,1:IKE+1,:),PTHT(:,:,1:IKE+1), &
!* 4. Sublimation (optional)
! ------------------------
!
-IF(LSNOWSUBL) THEN
+IF(LSNOWSUBL) THEN
! Initialize blowing snow sublimation profile
PSNWSUBL3D(:,:,:) = 0.
! Compute sublimation for MNH levels
CALL SUBL_BLOWSNOW(PZZ, PRHODJ,PRHODREF, PEXNREF, PPABST, &
PTHT, PRT(:,:,:,1), PRT(:,:,:,2),PRT(:,:,:,3), &
PRT(:,:,:,4), PRT(:,:,:,5),PRT(:,:,:,6), &
- ZSVT,PTHS,PRS(:,:,:,1),ZSVS,PSNWSUBL3D,ZVGK(:,:,:,2) )
+ PSVT(:,:,:,NSV_SNWBEG:NSV_SNWEND),PTHS,PRS(:,:,:,1),PSVS(:,:,:,NSV_SNWBEG:NSV_SNWEND), &
+ PSNWSUBL3D,ZVGK(:,:,:,2) )
END IF
!------------------------------------------------------------------------------
!
!* 5. Sedimentation
! ------------------------
!
+!Remark: budgets not done in SEDIM_BLOWSNOW because arrays are not complete in it
+if ( lbudget_sv ) then
+ do jsv = nsv_snwbeg, nsv_snwend
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'SNSED', psvs(:, :, :, jsv) * prhodj(:, :, :) )
+ end do
+end if
+
CALL SEDIM_BLOWSNOW(PTHT(IIB:IIE,IJB:IJE,IKB:IKE), PTSTEP,&
PRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
- PPABST(IIB:IIE,IJB:IJE,IKB:IKE), &
PZZ(IIB:IIE,IJB:IJE,IKB:IKE+1), &
- ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,:), &
- ZSVS(IIB:IIE,IJB:IJE,IKB:IKE,:),ZVGK(IIB:IIE,IJB:IJE,IKB:IKE,:))
-!
+ PSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_SNWBEG:NSV_SNWEND), &
+ PSVS(IIB:IIE,IJB:IJE,IKB:IKE,NSV_SNWBEG:NSV_SNWEND),ZVGK(IIB:IIE,IJB:IJE,IKB:IKE,:))
+!
!-------------------------------------------------------------------------------
!
!
@@ -241,15 +241,15 @@ DO JRR = 1,KRR
PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * PRHODJ(:,:,:)
END DO
-DO JSV = 1,SIZE(ZSVS,4)
- PSVS(:,:,:,JSV+NSV_SNWBEG-1) = ZSVS(:,:,:,JSV) * PRHODJ(:,:,:)
-END DO
-DO JSV = NSV_SNWBEG, NSV_SNWEND
- PSVT(:,:,:,JSV) = PSVS(:,:,:,JSV) * PTSTEP / PRHODJ(:,:,:)
+DO JSV = NSV_SNWBEG, NSV_SNWEND
+ PSVT(:,:,:,JSV) = PSVS(:,:,:,JSV) * PTSTEP
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
END DO
-
-DEALLOCATE(ZSVS)
-DEALLOCATE(ZSVT)
+if ( lbudget_sv ) then
+ do jsv = nsv_snwbeg, nsv_snwend
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'SNSED', psvs(:, :, :, jsv) )
+ end do
+end if
END SUBROUTINE BLOWSNOW
diff --git a/src/MNH/boundaries.f90 b/src/MNH/boundaries.f90
index 2e28cb605cbceda8bc384f44e16d4b7f5e1501e3..046a28af303cc6401540b799ad74289b7794fb3d 100644
--- a/src/MNH/boundaries.f90
+++ b/src/MNH/boundaries.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: /home/cvsroot/MNH-VX-Y-Z/src/MNH/boundaries.f90,v $ $Revision: 1.3.2.1.2.1.2.2.12.3 $ $Date: 2014/01/09 15:01:54 $
-!-----------------------------------------------------------------
!#####################
MODULE MODI_BOUNDARIES
!#####################
@@ -19,7 +15,7 @@ INTERFACE
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
- PRHODJ, &
+ PRHODJ,PRHODREF, &
PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
!
REAL, INTENT(IN) :: PTSTEP ! time step dt
@@ -51,6 +47,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-di
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
@@ -71,7 +68,7 @@ END MODULE MODI_BOUNDARIES
PLBYUM,PLBYVM,PLBYWM,PLBYTHM,PLBYTKEM,PLBYRM,PLBYSVM, &
PLBXUS,PLBXVS,PLBXWS,PLBXTHS,PLBXTKES,PLBXRS,PLBXSVS, &
PLBYUS,PLBYVS,PLBYWS,PLBYTHS,PLBYTKES,PLBYRS,PLBYSVS, &
- PRHODJ, &
+ PRHODJ,PRHODREF, &
PUT,PVT,PWT,PTHT,PTKET,PRT,PSVT,PSRCT )
! ####################################################################
!
@@ -173,44 +170,45 @@ END MODULE MODI_BOUNDARIES
!! Redelsperger & Pianezze : 08/2015 : add XPOND coefficient
!! Modification 01/2016 (JP Pinty) Add LIMA that is LBC for CCN and IFN
!! Modification 18/07/17 (Vionnet) Add blowing snow variables
-!! Modification 01/2018 (JL Redelsperger) Correction for TKE treatment
+!! Modification 01/2018 (JL Redelsperger) Correction for TKE treatment
+!! Modification 03/02/2020 (B. Vié) Correction for SV with LIMA
+! P. Wautelet 04/06/2020: correct call to Set_conc_lima
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
-USE MODD_PARAMETERS
-USE MODD_CTURB
-USE MODD_CONF
-USE MODD_NSV
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHIC
-USE MODD_CH_AEROSOL , ONLY : LORILAM
-USE MODD_DUST
-USE MODD_SALT, ONLY : LSALT
-USE MODD_PASPOL, ONLY : LPASPOL
-USE MODD_CONDSAMP, ONLY : LCONDSAMP
-USE MODD_ELEC_DESCR
-USE MODD_ELEC_n
USE MODD_BLOWSNOW, ONLY : LBLOWSNOW,NBLOWSNOW_2D
USE MODD_BLOWSNOW_n
-USE MODD_REF_n
-USE MODD_PARAM_n, ONLY : CELEC,CCLOUD
-USE MODD_LBC_n, ONLY : XPOND
-!
-USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, LBOUND, LWARM, LCOLD
-!
+USE MODD_CH_AEROSOL , ONLY : LORILAM
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHIC
+USE MODD_CONDSAMP, ONLY : LCONDSAMP
+USE MODD_CONF
+USE MODD_CTURB
+USE MODD_DUST
+USE MODD_GRID_n, ONLY : XZZ
+USE MODD_ELEC_DESCR
+USE MODD_ELEC_n
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE, ONLY : LFOREFIRE
#endif
+USE MODD_LBC_n, ONLY : XPOND
+USE MODE_ll
USE MODD_NESTING, ONLY : NDAD
-!
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, LBOUND, LWARM, LCOLD
+USE MODD_PARAM_n, ONLY : CELEC,CCLOUD
+USE MODD_PASPOL, ONLY : LPASPOL
+USE MODD_REF_n
+USE MODD_SALT, ONLY : LSALT
+
USE MODE_MODELN_HANDLER
-!
-USE MODI_ION_BOUNDARIES
+USE MODE_SET_CONC_LIMA
+
USE MODI_CH_BOUNDARIES
-!
-USE MODE_ll
-!
-!
+USE MODI_INIT_AEROSOL_CONCENTRATION
+USE MODI_ION_BOUNDARIES
+
IMPLICIT NONE
!
!
@@ -248,6 +246,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PLBYRS ,PLBYSVS ! in x and y-di
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Jacobian * dry density of
! the reference state
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUT,PVT,PWT,PTHT,PTKET,PSRCT
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT,PSVT
@@ -310,6 +309,9 @@ LOGICAL :: GFFTMP
!
INTEGER :: JI,JJ
!
+REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSVT
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) :: ZRT
+!
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE DIMENSIONS OF ARRAYS AND OTHER INDICES:
@@ -969,7 +971,11 @@ END SELECT
END IF
!
!
-IF (CCLOUD == 'LIMA' .AND. IMI == 1) THEN
+IF (CCLOUD == 'LIMA' .AND. IMI == 1 .AND. CPROGRAM=='MESONH') THEN
+
+ ZSVT=PSVT
+ ZRT=PRT
+
IF (GFIRSTCALLLIMA) THEN
ALLOCATE(GLIMABOUNDARY(NSV_LIMA))
GFIRSTCALLLIMA = .FALSE.
@@ -981,23 +987,52 @@ IF (CCLOUD == 'LIMA' .AND. IMI == 1) THEN
IF (LNORTH_ll().AND.HLBCY(2)=='OPEN') GCHTMP = GCHTMP .OR. ALL(PLBYSVM(:,ILBY-JPHEXT+1,:,JSV)==0)
GLIMABOUNDARY(JSV-NSV_LIMA_BEG+1) = GCHTMP
ENDDO
- ENDIF
+ 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_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)
+ PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
+ ENDIF
+ END DO
+ DO JSV=NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 ! LBC for IFN
+ 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)
+ PSVT(:,IJE+1,:,JSV)=ZSVT(:,IJE+1,:,JSV)
+ ENDIF
+ END DO
- DO JSV=NSV_LIMA_CCN_FREE,NSV_LIMA_CCN_FREE+NMOD_CCN-1 ! LBC for CCN from MACC
- IF (GLIMABOUNDARY(JSV-NSV_LIMA_CCN_FREE+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
- DO JSV=NSV_LIMA_IFN_FREE,NSV_LIMA_IFN_FREE+NMOD_IFN-1 ! LBC for IFN from MACC
- IF (GLIMABOUNDARY(JSV-NSV_LIMA_IFN_FREE+1)) THEN
- IF (SIZE(PSVT)>0) THEN
- CALL CH_BOUNDARIES (HLBCX,HLBCY,PUT,PVT,PSVT(:,:,:,JSV),XSVMIN(JSV))
- ENDIF
- ENDIF
- ENDDO
-ENDIF
+ 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-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)
+ PSVT(:,IJE+1,:,NSV_LIMA_NC)=ZSVT(:,IJE+1,:,NSV_LIMA_NC)
+ ENDIF
+ ENDIF
+ IF (NSV_LIMA_NR.GE.1) 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)
+ PSVT(:,IJE+1,:,NSV_LIMA_NR)=ZSVT(:,IJE+1,:,NSV_LIMA_NR)
+ ENDIF
+ ENDIF
+ IF (NSV_LIMA_NI.GE.1) 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
+!
!
IF (LUSECHEM .AND. IMI == 1) THEN
IF (GFIRSTCALL1) THEN
diff --git a/src/MNH/budget.f90 b/src/MNH/budget.f90
index bead348bf8baaeb46487fee30d58dfbd41f65c4e..13c746c4344cd996220e6905df3e2020bbf2fab9 100644
--- a/src/MNH/budget.f90
+++ b/src/MNH/budget.f90
@@ -1,493 +1,316 @@
-!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_BUDGET
-!##################
-!
-INTERFACE
-!
-SUBROUTINE BUDGET(PVARS,KBUDN,HBUVAR)
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
-INTEGER , INTENT(IN) :: KBUDN ! variable number
-CHARACTER (LEN=*) , INTENT(IN) :: HBUVAR ! Identifier of the Budget of the
- ! variable that is considered
-!
-END SUBROUTINE BUDGET
-!
-END INTERFACE
-!
-END MODULE MODI_BUDGET
-! #####################################
- SUBROUTINE BUDGET(PVARS,KBUDN,HBUVAR)
-! #####################################
-!
-!!**** *BUDGET* - routine to call the BUDGET routine.
-!!
-!!
-!! PURPOSE
-!! -------
-! This routine selects the variable RVAR, the budget of which is
-! processed in the inner routine BUDGET_CASE. !
-!!** METHOD
-!! ------
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!! CART_COMPRESS
-!! MASK_COMPRESS
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_BUDGET
-!! XBURU : budget array of the variable RU
-!! XBURV : budget array of the variable RV
-!! XBURW : budget array of the variable RW
-!! XBURTH : budget array of the variable RTH
-!! XBURTKE : budget array of the variable RTKE
-!! XBURRV : budget array of the variable RRV
-!! XBURRC : budget array of the variable RRC
-!! XBURRR : budget array of the variable RRR
-!! XBURRI : budget array of the variable RRI
-!! XBURRS : budget array of the variable RRS
-!! XBURRG : budget array of the variable RRG
-!! XBURRH : budget array of the variable RRH
-!! XBURTKE : budget array of the variable RTKE
-!! XBURSV(x) : budget array of the variable RSVx
-!!
-!! REFERENCE
-!! ---------
-!! None
-!!
-!! AUTHOR
-!! ------
-!! J. Nicolau * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/08/94
-!! J. Stein 26/06/96 add the 'OF','NO' option
-!! J.-P. Pinty 12/12/96 simplifies the coding
-!! V. Masson 06/10/02 add LES budgets
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! J.Escobar : 09/07/2019 : for bit reproductiblity use MPPDB_CHECK with PRECISION=0.0 error
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET
-USE MODD_LUNIT
-!USE MODD_CONF_n
-USE MODD_CONF, ONLY : LCHECK
-USE MODD_NSV, ONLY : NSV
-USE MODD_LES
-!
-USE MODE_MSG
-!
-USE MODI_LES_BUDGET
-USE MODI_CART_COMPRESS
-USE MODI_MASK_COMPRESS
-!
-USE MODE_MPPDB
-!
-USE MODI_SECOND_MNH
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 Declarations of arguments :
-!
-INTEGER , INTENT(IN) :: KBUDN ! variable number
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! source of the variable
-CHARACTER (LEN=*) , INTENT(IN) :: HBUVAR ! Identifier of the Budget of the
- ! variable that is considered
-INTEGER :: IBUSV ! Index of the SV
-!
-INTEGER :: ILUOUT0 ! Logical unit number for output-listing
-INTEGER :: IRESP ! Return code of FM-routines
-!
-REAL :: ZTIME1 ! CPU time counter
-REAL :: ZTIME2 ! CPU time counter
-!
-!-------------------------------------------------------------------------------
-!
-!* Reproductivity checks
-! Warning: requires an adaptation of the makefile in order to run two runs in
-! parallel for comparison
-!
-IF (LCHECK) THEN
- print*,'BUDGET :',HBUVAR
- CALL MPPDB_CHECK3D(PVARS,HBUVAR,PRECISION)
-END IF
-!
-!
-!* call to LES budgets
-!
-IF (LLES_CALL) CALL LES_BUDGET(PVARS,KBUDN,HBUVAR)
-!
-!* call to prognostic variables budgets
-!
-IF (.NOT. LBU_ENABLE) RETURN
-!
-SELECT CASE (KBUDN)
- CASE (1)
- IF (.NOT. LBU_RU) RETURN
- CASE (2)
- IF (.NOT. LBU_RV) RETURN
- CASE (3)
- IF (.NOT. LBU_RW) RETURN
- CASE (4)
- IF (.NOT. LBU_RTH) RETURN
- CASE (5)
- IF (.NOT. LBU_RTKE) RETURN
- CASE (6)
- IF (.NOT. LBU_RRV) RETURN
- CASE (7)
- IF (.NOT. LBU_RRC) RETURN
- CASE (8)
- IF (.NOT. LBU_RRR) RETURN
- CASE (9)
- IF (.NOT. LBU_RRI) RETURN
- CASE (10)
- IF (.NOT. LBU_RRS) RETURN
- CASE (11)
- IF (.NOT. LBU_RRG) RETURN
- CASE (12)
- IF (.NOT. LBU_RRH) RETURN
- CASE (13:)
- IF (.NOT. LBU_RSV) RETURN
-END SELECT
-!
-!-------------------------------------------------------------------------------
-!
-CALL SECOND_MNH(ZTIME1)
-!
-SELECT CASE (KBUDN)
-!
- CASE (1) ! ==> RU BUDGET
- CALL BUDGET_CASE(XBURU)
-!
- CASE (2) ! ==> RV BUDGET
- CALL BUDGET_CASE(XBURV)
-!
- CASE (3) ! ==> RW BUDGET
- CALL BUDGET_CASE(XBURW)
-!
- CASE (4) ! ==> RTH BUDGET
- CALL BUDGET_CASE(XBURTH)
-!
- CASE (5) ! ==> RTKE BUDGET
- CALL BUDGET_CASE(XBURTKE)
-!
- CASE (6) ! ==> RRV BUDGET
- CALL BUDGET_CASE(XBURRV)
-!
- CASE (7) ! ==> RRC BUDGET
- CALL BUDGET_CASE(XBURRC)
-!
- CASE (8) ! ==> RRR BUDGET
- CALL BUDGET_CASE(XBURRR)
-!
- CASE (9) ! ==> RRI BUDGET
- CALL BUDGET_CASE(XBURRI)
-!
- CASE (10) ! ==> RRS BUDGET
- CALL BUDGET_CASE(XBURRS)
-!
- CASE (11) ! ==> RRG BUDGET
- CALL BUDGET_CASE(XBURRG)
-!
- CASE (12) ! ==> RRH BUDGET
- CALL BUDGET_CASE(XBURRH)
-!
- CASE (13:)! ==> RSVx BUDGET
- IBUSV = KBUDN - 12
- IF( IBUSV <= NSV ) THEN
- CALL BUDGET_CASE(XBURSV(:,:,:,:,IBUSV))
- ELSE
- ILUOUT0 = TLUOUT0%NLU
- WRITE(UNIT=ILUOUT0,FMT='("BUDGET: SCALAR VARIABLE",I2," IS ABSENT !!")') &
- IBUSV
- WRITE(UNIT=ILUOUT0,FMT='("CHECK FOR THE CALL BUDGET OF THAT VARIABLE")')
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','BUDGET','')
- END IF
-END SELECT
-!
-CALL SECOND_MNH(ZTIME2)
-!
-XTIME_BU_PROCESS = XTIME_BU_PROCESS + ZTIME2 - ZTIME1
-XTIME_BU = XTIME_BU + ZTIME2 - ZTIME1
-!
-!----------------------------------------------------------------------
-CONTAINS
-!----------------------------------------------------------------------
-! ###############################
- SUBROUTINE BUDGET_CASE(PBURVAR)
-! ###############################
-!
-!!**** *BUDGET_CASE* - routine to call the BUDGET_CASE routine.
-!!
-!!
-!! PURPOSE
-!! -------
-! This routine chooses the right call to the functions CART_COMPRESS
-! or MASK_COMPRESS (which realize the compression of the source PVARS
-! in the different directions) and achieves in function of HACTION (which
-! determines the operations to be executed) the budget for the variable
-! corresponding to the number KBUDN. The budget process counter is
-! incremented by NBUINC depending on the number of active processes in the
-! model.
-!
-!!** METHOD
-!! ------
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!! CART_COMPRESS
-!! MASK_COMPRESS
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_BUDGET
-!! CBUACTION : type of operation
-!! CBUTYPE : budget type (CART,MASK or NONE)
-!! NBUTIME : number of the budget step
-!! NBUPROCCTR : process counter for each budget variable
-!! PBURVAR : budget array of the variable RVAR
-!!
-!! REFERENCE
-!! ---------
-!! None
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty *Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 12/12/96
-!! Modification 24/06/99 N. Asencio : budget // , the dimensions of the
-!! budget arrays are implicit
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
- USE MODI_CART_COMPRESS
- USE MODI_MASK_COMPRESS
-!
- IMPLICIT NONE
-!
-!
-!* 0.1 Declarations of arguments :
-!
- REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PBURVAR ! budget of variable RVAR
-!
-!* 0.2 Declarations of local variables :
- CHARACTER (LEN=99) :: YBUVAR_ADJUSTED ! Adjusted string
- CHARACTER (LEN=99) :: YBUCOMMENT_ADJUSTED ! Adjusted string
- CHARACTER (LEN=99) :: YBUVAR ! local string
- CHARACTER (LEN=99) :: YBUCOMMENT ! local string
-
- INTEGER :: ILEN ! Number of non-blank char.
-!
-!
-!* 1. SECURITY TEST
-! -------------
-!
- YBUVAR = HBUVAR
- YBUCOMMENT = CBUCOMMENT(KBUDN,NBUPROCCTR(KBUDN))
- YBUVAR_ADJUSTED = ADJUSTR(YBUVAR)
- YBUCOMMENT_ADJUSTED = ADJUSTR(YBUCOMMENT)
- ILEN = LEN_TRIM( ADJUSTL(YBUVAR))
-!
- IF( CBUACTION(KBUDN,NBUCTR_ACTV(KBUDN))/='NO'.AND. &
- CBUACTION(KBUDN,NBUCTR_ACTV(KBUDN))/='OF'.AND. &
- CBUACTION(KBUDN,NBUCTR_ACTV(KBUDN))/='CC' ) THEN
- IF( YBUVAR_ADJUSTED(100-ILEN:99) /= YBUCOMMENT_ADJUSTED(100-ILEN:99) &
- .OR. ILEN==0 ) THEN
- ILUOUT0 = TLUOUT0%NLU
- WRITE(UNIT=ILUOUT0,FMT='("BUDGET: WRONG BUDGET IDENTIFICATION !!")')
- WRITE(UNIT=ILUOUT0,FMT='("BUDGET: PRESENT VARIABLE: ",I2)') KBUDN
- WRITE(UNIT=ILUOUT0,FMT='("BUDGET: PRESENT IDENTIFIER: ",A99)') &
- YBUVAR_ADJUSTED
- WRITE(UNIT=ILUOUT0,FMT='("BUDGET: EXPECTED IDENTIFIER: ",A99)') &
- YBUCOMMENT_ADJUSTED
- WRITE(UNIT=ILUOUT0,FMT='("PLEASE CHECK THE CALL BUDGET OF THE VARIABLE")')
- WRITE(UNIT=ILUOUT0,FMT='("AND THE BUDGET PROCESS ORDER IN INI_BUDGET !")')
-!callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','BUDGET','')
- END IF
- END IF
-!
-! Budget integration in case of successful test
-!
- SELECT CASE (CBUTYPE)
-!
-!* 2. "CART" CASE
-! -----------
-!
- CASE ('CART')
-!
- SELECT CASE (CBUACTION(KBUDN,NBUCTR_ACTV(KBUDN)))
-!
-!* 2.1 Budget beginning : initial fields
-! filled in budget tabulars (NBUPROCCTR=1)
-!
- CASE('IG')
- PBURVAR(:,:,:,1)=CART_COMPRESS(PVARS)
-!
-!* 2.2 average tendancy filled every time
-! step in budget tabulars (NBUPROCCTR=3)
-!
- CASE('ES')
- PBURVAR(:,:,:,3)=PBURVAR(:,:,:,3)+CART_COMPRESS(PVARS)/NBUSTEP
-!
-!* 2.3 Cumul of the sources
-!
- CASE('CC')
- PBURVAR(:,:,:,2)=CART_COMPRESS(PVARS)
-!
-! advance the process counter
-!
- NBUCTR_ACTV(KBUDN) = NBUCTR_ACTV(KBUDN) &
- + NBUINC(KBUDN,NBUCTR_ACTV(KBUDN))
-!
-!* 2.4 Difference in order to compute the budget
-! for the process NBUPROCCTR
-!
- CASE('DD')
- PBURVAR(:,:,:,NBUPROCCTR(KBUDN))= PBURVAR(:,:,:,NBUPROCCTR(KBUDN)) &
- + CART_COMPRESS(PVARS) &
- - PBURVAR(:,:,:,2)
- NBUPROCCTR(KBUDN)=NBUPROCCTR(KBUDN)+1
-!
-! advance the process counter
-!
- NBUCTR_ACTV(KBUDN) = NBUCTR_ACTV(KBUDN) &
- + NBUINC(KBUDN,NBUCTR_ACTV(KBUDN))
-!
-!* 2.5 Difference in order to compute the budget for the
-! process NBUPROCCTR and Cumul of the sources (NBUPROCCTR=2)
-!
- CASE('DC')
- PBURVAR(:,:,:,NBUPROCCTR(KBUDN)) = PBURVAR(:,:,:,NBUPROCCTR(KBUDN))&
- + CART_COMPRESS(PVARS) &
- - PBURVAR(:,:,:,2)
- PBURVAR(:,:,:,2)=CART_COMPRESS(PVARS)
- NBUPROCCTR(KBUDN)=NBUPROCCTR(KBUDN)+1
-!
-! advance the process counter
-!
- NBUCTR_ACTV(KBUDN) = NBUCTR_ACTV(KBUDN) &
- + NBUINC(KBUDN,NBUCTR_ACTV(KBUDN))
- CASE('NO')
-!
-! advance the process counter
-!
- NBUCTR_ACTV(KBUDN) = NBUCTR_ACTV(KBUDN) &
- + NBUINC(KBUDN,NBUCTR_ACTV(KBUDN))
- CASE('OF')
-!
-! advance the process counter
-!
- NBUCTR_ACTV(KBUDN) = NBUCTR_ACTV(KBUDN) &
- + NBUINC(KBUDN,NBUCTR_ACTV(KBUDN))
- RETURN
- END SELECT
-!
-!* 3. "MASK" CASE
-! -----------
-!
- CASE ('MASK')
-!
- SELECT CASE (CBUACTION(KBUDN,NBUCTR_ACTV(KBUDN)))
-!
-!* 3.1 Budget beginning : initial fields
-! filled in budget tabulars (NBUPROC=1)
-!
- CASE('IG')
- PBURVAR(:,NBUTIME,:,1) = MASK_COMPRESS(PVARS)
-!
-!* 3.2 average tendancy filled every time
-! step in budget tabulars (NBUPROCCTR=3)
-!
- CASE('ES')
- PBURVAR(:,NBUTIME,:,3) = PBURVAR(:,NBUTIME,:,3) &
- + MASK_COMPRESS(PVARS)/NBUSTEP
-!
-!* 3.3 Cumul of the sources
-!
- CASE('CC')
- PBURVAR(:,NBUTIME,:,2)=MASK_COMPRESS(PVARS)
-!
-! advance the process counter
-!
- NBUCTR_ACTV(KBUDN) = NBUCTR_ACTV(KBUDN) &
- + NBUINC(KBUDN,NBUCTR_ACTV(KBUDN))
-!
-!* 3.4 Difference in order to compute the budget
-! for the process NBUPROCCTR
-!
- CASE('DD')
- PBURVAR(:,NBUTIME,:,NBUPROCCTR(KBUDN)) &
- = PBURVAR(:,NBUTIME,:,NBUPROCCTR(KBUDN)) &
- + MASK_COMPRESS(PVARS) &
- - PBURVAR(:,NBUTIME,:,2)
- NBUPROCCTR(KBUDN)=NBUPROCCTR(KBUDN)+1
-!
-! advance the process counter
-!
- NBUCTR_ACTV(KBUDN) = NBUCTR_ACTV(KBUDN) &
- + NBUINC(KBUDN,NBUCTR_ACTV(KBUDN))
-!
-!* 3.5 Difference in order to compute the budget for the
-! process NBUPROCCTR and Cumul of the sources (NBUPROCCTR=2)
-!
- CASE('DC')
- PBURVAR(:,NBUTIME,:,NBUPROCCTR(KBUDN)) &
- = PBURVAR(:,NBUTIME,:,NBUPROCCTR(KBUDN)) &
- +MASK_COMPRESS(PVARS) &
- -PBURVAR(:,NBUTIME,:,2)
- PBURVAR(:,NBUTIME,:,2)=MASK_COMPRESS(PVARS)
- NBUPROCCTR(KBUDN)=NBUPROCCTR(KBUDN)+1
-!
-! advance the process counter
-!
- NBUCTR_ACTV(KBUDN) = NBUCTR_ACTV(KBUDN) &
- + NBUINC(KBUDN,NBUCTR_ACTV(KBUDN))
- CASE('NO')
-!
-! advance the process counter
-!
- NBUCTR_ACTV(KBUDN) = NBUCTR_ACTV(KBUDN) &
- + NBUINC(KBUDN,NBUCTR_ACTV(KBUDN))
- CASE('OF')
-!
-! advance the process counter
-!
- NBUCTR_ACTV(KBUDN) = NBUCTR_ACTV(KBUDN) &
- + NBUINC(KBUDN,NBUCTR_ACTV(KBUDN))
- RETURN
- END SELECT
- END SELECT
-!
- END SUBROUTINE BUDGET_CASE
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE BUDGET
+! Modifications
+! P. Wautelet 28/01/2020: new subroutines: Budget_store_init, Budget_store_end and Budget_source_id_find in new module mode_budget
+! P. Wautelet 17/08/2020: treat LES budgets correctly
+! P. Wautelet 05/03/2021: measure cpu_time for budgets
+!-----------------------------------------------------------------
+
+!#################
+module mode_budget
+!#################
+
+use modd_budget, only: cbutype, nbutime, tbudgetdata, xtime_bu, xtime_bu_process
+use modd_les_budget, only: xtime_les_bu, xtime_les_bu_process
+
+use modi_cart_compress, only: Cart_compress
+use modi_mask_compress, only: Mask_compress
+use modi_second_mnh, only: Second_mnh
+
+use mode_msg
+
+implicit none
+
+private
+
+public :: Budget_store_init
+public :: Budget_store_end
+public :: Budget_store_add
+
+real :: ztime1, ztime2
+
+contains
+
+subroutine Budget_store_init( tpbudget, hsource, pvars )
+ use modd_les, only: lles_call
+
+ type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure
+ character(len=*), intent(in) :: hsource ! Name of the source term
+ real, dimension(:,:,:), intent(in) :: pvars ! Current value to be stored
+
+ integer :: iid ! Reference number of the current source term
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_init', trim( tpbudget%cname )//':'//trim( hsource ) )
+
+ if ( lles_call ) then
+ call Second_mnh( ztime1 )
+
+ if ( allocated( tpbudget%xtmplesstore ) ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init', 'xtmplesstore already allocated' )
+ else
+ allocate( tpbudget%xtmplesstore( Size( pvars, 1 ), Size( pvars, 2 ), Size ( pvars, 3 ) ) )
+ end if
+ tpbudget%xtmplesstore(:, :, :) = pvars(:, :, :)
+
+ tpbudget%clessource = hsource
+
+ call Second_mnh( ztime2 )
+ xtime_les_bu = xtime_les_bu + ztime2 - ztime1
+ xtime_les_bu_process = xtime_les_bu_process + ztime2 - ztime1
+ end if
+
+ ! Nothing else to do if budgets are not enabled
+ if ( .not. tpbudget%lenabled ) return
+
+ call Second_mnh( ztime1 )
+
+ call Budget_source_id_find( tpbudget, hsource, iid )
+
+ if ( tpbudget%ntmpstoresource /= 0 ) then
+ cmnhmsg(1) = 'ntmpstoresource already set (previous call to '//'Budget_store_end missing?)'
+ cmnhmsg(2) = 'Set for: ' // Trim( tpbudget%cname ) // ':' // Trim( tpbudget%tsources(tpbudget%ntmpstoresource)%cmnhname )
+ cmnhmsg(3) = 'Working on: ' // Trim( tpbudget%cname ) // ':' // Trim( hsource )
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init' )
+ end if
+
+ if ( tpbudget%tsources(iid)%ldonotinit ) then
+ ! If ldonotinit is set, this subroutine should not be called
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init', 'should not be called for ' &
+ //trim( tpbudget%cname )//':'//trim( hsource ) )
+ return
+ end if
+
+ if ( tpbudget%tsources(iid)%lenabled ) then
+ if ( tpbudget%ntmpstoresource /= 0 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init', 'xtmpstore already used by ' &
+ //trim( tpbudget%tsources(tpbudget%ntmpstoresource)%cmnhname ) )
+ return
+ end if
+
+ tpbudget%ntmpstoresource = iid
+
+ !Store data into the budget temporary array
+ !This value will be subtracted from the next one (in Budget_store_end) to get the evolution of the array between the 2 calls
+ if ( cbutype == 'CART' ) then
+ tpbudget%xtmpstore(:, :, :) = Cart_compress( pvars(:, :, :) )
+ else if ( cbutype == 'MASK' ) then
+ tpbudget%xtmpstore(:, nbutime, :) = Mask_compress( pvars(:, :, :) )
+ else
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_init', 'unknown cbutype: '//trim( cbutype ) )
+ end if
+ end if
+
+ call Second_mnh( ztime2 )
+ xtime_bu = xtime_bu + ztime2 - ztime1
+ xtime_bu_process = xtime_bu_process + ztime2 - ztime1
+
+ end subroutine Budget_store_init
+
+
+subroutine Budget_store_end( tpbudget, hsource, pvars )
+ use modd_les, only: lles_call
+
+ use modi_les_budget, only: Les_budget
+
+ type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure
+ character(len=*), intent(in) :: hsource ! Name of the source term
+ real, dimension(:,:,:), intent(in) :: pvars ! Current value to be stored
+
+ integer :: iid ! Reference number of the current source term
+ integer :: igroup ! Number of the group where to store the source term
+ real, dimension(:,:,:), allocatable :: zvars_add
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_end', trim( tpbudget%cname )//':'//trim( hsource ) )
+
+ if ( lles_call ) then
+ if ( hsource /= tpbudget%clessource ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Budget_store_end', 'hsource not the same as in Budget_store_init (' &
+ // Trim( hsource ) // ' / ' // Trim( tpbudget%clessource ) // ')' )
+
+ tpbudget%clessource = 'reset'
+
+ if ( allocated( tpbudget%xtmplesstore ) ) then
+ ! Do the call to Les_budget with oadd=.true.
+ ! This is necessary when the call to Budget_store_init was done with pvars not strictly
+ ! equal to the source term
+ Allocate( zvars_add( Size( pvars, 1 ), Size( pvars, 2 ), Size ( pvars, 3 ) ) )
+ zvars_add(:, :, :) = pvars(:, :, :) - tpbudget%xtmplesstore(:, :, :)
+ call Les_budget( zvars_add, tpbudget%nid, hsource, oadd = .true. )
+ Deallocate( zvars_add )
+ Deallocate( tpbudget%xtmplesstore )
+ else
+ call Les_budget( pvars, tpbudget%nid, hsource, oadd = .false. )
+ end if
+ end if
+
+ ! Nothing to do if budgets are not enabled
+ if ( .not. tpbudget%lenabled ) return
+
+ call Second_mnh( ztime1 )
+
+ call Budget_source_id_find( tpbudget, hsource, iid )
+
+ if ( tpbudget%tsources(iid)%lenabled ) then
+ if ( iid /= tpbudget%ntmpstoresource .and. .not.tpbudget%tsources(iid)%ldonotinit ) then
+ if ( tpbudget%ntmpstoresource == 0 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_end', 'ntmpstoresource not set for ' &
+ //trim( tpbudget%tsources(iid)%cmnhname ) )
+ else
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_end', 'xtmpstore used by an other source: ' &
+ //trim( tpbudget%tsources(tpbudget%ntmpstoresource)%cmnhname )//', expected: ' &
+ //trim( tpbudget%tsources(iid)%cmnhname ) )
+ end if
+ end if
+
+ !Store data into the budget array
+ !The values are computed by the difference between the values stored in the temporary array (filled in Budget_store_init)
+ !and the current values added to the already stored ones.
+ !Except if ldonotinit is true. In that case, overwrite the array.
+ igroup = tpbudget%tsources(iid)%ngroup
+ if ( cbutype == 'CART' ) then
+ if ( tpbudget%tsources(iid)%ldonotinit ) then
+ if ( tpbudget%tsources(iid)%loverwrite ) then
+ tpbudget%tgroups(igroup)%xdata(:, :, :) = Cart_compress( pvars(:, :, :) )
+ else
+ tpbudget%tgroups(igroup)%xdata(:, :, :) = tpbudget%tgroups(igroup)%xdata(:, :, :) &
+ + Cart_compress( pvars(:, :, :) )
+ end if
+ else
+ if ( tpbudget%tsources(iid)%loverwrite ) then
+ tpbudget%tgroups(igroup)%xdata(:, :, :) = Cart_compress( pvars(:, :, :) ) &
+ - tpbudget%xtmpstore(:, :, :)
+ else
+ tpbudget%tgroups(igroup)%xdata(:, :, :) = tpbudget%tgroups(igroup)%xdata(:, :, :) &
+ + Cart_compress( pvars(:, :, :) ) &
+ - tpbudget%xtmpstore(:, :, :)
+ end if
+ end if
+ else if ( cbutype == 'MASK' ) then
+ if ( tpbudget%tsources(iid)%ldonotinit ) then
+ if ( tpbudget%tsources(iid)%loverwrite ) then
+ tpbudget%tgroups(igroup)%xdata(:, nbutime, :) = Mask_compress( pvars(:, :, :) )
+ else
+ tpbudget%tgroups(igroup)%xdata(:, nbutime, :) = tpbudget%tgroups(igroup)%xdata(:, nbutime, :) &
+ + Mask_compress( pvars(:, :, :) )
+ end if
+ else
+ if ( tpbudget%tsources(iid)%loverwrite ) then
+ tpbudget%tgroups(igroup)%xdata(:, nbutime, :) = Mask_compress( pvars(:, :, :) ) &
+ - tpbudget%xtmpstore(:, nbutime, :)
+ else
+ tpbudget%tgroups(igroup)%xdata(:, nbutime, :) = tpbudget%tgroups(igroup)%xdata(:, nbutime, :) &
+ + Mask_compress( pvars(:, :, :) ) &
+ - tpbudget%xtmpstore(:, nbutime, :)
+ end if
+ end if
+ else
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_end', 'unknown cbutype: '//trim( cbutype ) )
+ end if
+
+ ! Release the budget temporary array
+ tpbudget%ntmpstoresource = 0
+ end if
+
+ call Second_mnh( ztime2 )
+ xtime_bu = xtime_bu + ztime2 - ztime1
+ xtime_bu_process = xtime_bu_process + ztime2 - ztime1
+
+end subroutine Budget_store_end
+
+
+subroutine Budget_store_add( tpbudget, hsource, pvars )
+ use modd_les, only: lles_call
+
+ use modi_les_budget, only: Les_budget
+
+ type(tbudgetdata), intent(inout) :: tpbudget ! Budget datastructure
+ character(len=*), intent(in) :: hsource ! Name of the source term
+ real, dimension(:,:,:), intent(in) :: pvars ! Current value to be stored
+
+ integer :: iid ! Reference number of the current source term
+ integer :: igroup ! Number of the group where to store the source term
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_store_add', trim( tpbudget%cname )//':'//trim( hsource ) )
+
+ if ( tpbudget%ntmpstoresource /= 0 ) &
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_add', 'inside a Budget_store_init/Budget_store_end zone' )
+
+ if ( lles_call ) call Les_budget( pvars, tpbudget%nid, hsource, oadd = .true. )
+
+ ! Nothing to do if budgets are not enabled
+ if ( .not. tpbudget%lenabled ) return
+
+ call Second_mnh( ztime1 )
+
+ call Budget_source_id_find( tpbudget, hsource, iid )
+
+ if ( tpbudget%tsources(iid)%lenabled ) then
+ if ( tpbudget%tsources(iid)%loverwrite ) &
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_add', 'loverwrite=.true. is not allowed' )
+
+ !Store data into the budget array
+ igroup = tpbudget%tsources(iid)%ngroup
+ if ( cbutype == 'CART' ) then
+ tpbudget%tgroups(igroup)%xdata(:, :, :) = tpbudget%tgroups(igroup)%xdata(:, :, :) &
+ + Cart_compress( pvars(:, :, :) )
+ else if ( cbutype == 'MASK' ) then
+ tpbudget%tgroups(igroup)%xdata(:, nbutime, :) = tpbudget%tgroups(igroup)%xdata(:, nbutime, :) &
+ + Mask_compress( pvars(:, :, :) )
+ else
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_store_add', 'unknown cbutype: '//trim( cbutype ) )
+ end if
+ end if
+
+ call Second_mnh( ztime2 )
+ xtime_bu = xtime_bu + ztime2 - ztime1
+ xtime_bu_process = xtime_bu_process + ztime2 - ztime1
+
+end subroutine Budget_store_add
+
+
+subroutine Budget_source_id_find( tpbudget, hsource, kid )
+ type(tbudgetdata), intent(in) :: tpbudget ! Budget datastructure
+ character(len=*), intent(in) :: hsource ! Name of the source term
+ integer, intent(out) :: kid ! Reference number of the current source term
+
+ integer :: iid
+ integer :: ji
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_source_id_find', trim( tpbudget%cname )//':'//trim( hsource ) )
+
+ iid = 0
+ do ji = 1, tpbudget%nsources
+ if ( trim( hsource ) == trim( tpbudget%tsources(ji)%cmnhname ) ) then
+ iid = ji
+ exit
+ end if
+ end do
+
+ if ( iid > 0 ) then
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_source_id_find', trim( tpbudget%cname )//':'//trim( hsource )//' found' )
+ else
+ !Search also in the non-available source term list
+ do ji = tpbudget%nsources + 1, tpbudget%nsourcesmax
+ if ( trim( hsource ) == trim( tpbudget%tsources(ji)%cmnhname ) ) then
+ iid = ji
+ exit
+ end if
+ end do
+
+ if ( iid == 0 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_source_id_find', trim( tpbudget%cname )//':'//trim( hsource )//' not found' )
+ else
+ cmnhmsg(1) = Trim( tpbudget%cname ) // ':' // Trim( hsource ) // ' found'
+ cmnhmsg(2) = 'in non-available source term list.'
+ cmnhmsg(3) = 'Check availability condition in Ini_budget.'
+ call Print_msg( NVERB_ERROR, 'BUD', 'Budget_source_id_find' )
+ end if
+ end if
+
+ kid = iid
+end subroutine Budget_source_id_find
+
+end module mode_budget
diff --git a/src/MNH/budget_flags.f90 b/src/MNH/budget_flags.f90
index 00a1f85283f97dc7c20dfa9fb88c927d293766e7..ba8cdde35ed366b879cf9eaa0b87b721d7e84bca 100644
--- a/src/MNH/budget_flags.f90
+++ b/src/MNH/budget_flags.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 budget 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!##################
MODULE MODI_BUDGET_FLAGS
!##################
@@ -67,16 +62,18 @@ SUBROUTINE BUDGET_FLAGS(OUSERV, OUSERC, OUSERR, &
!! MODIFICATIONS
!! -------------
!! Original 09/10/02
-!!
+! P. Wautelet 06/03/2020: add condition on NRR for hydrometeor variables and cturb for TKE
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_BUDGET
-USE MODD_NSV, ONLY : NSV
-USE MODD_LES
-USE MODD_CONF, ONLY : LCHECK
+USE MODD_CONF, ONLY: LCHECK
+use modd_conf_n, only: nrr
+USE MODD_LES, only: LLES_CALL
+USE MODD_NSV, ONLY: NSV
+use modd_param_n, only: cturb
!
IMPLICIT NONE
!
@@ -95,19 +92,19 @@ LOGICAL, INTENT(IN) :: OUSERH ! flag to use hail
!
!-------------------------------------------------------------------------------
!
-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 )
-LBUDGET_RV = (LBU_ENABLE .AND. LBU_RRV ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERV)
-LBUDGET_RC = (LBU_ENABLE .AND. LBU_RRC ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERC)
-LBUDGET_RR = (LBU_ENABLE .AND. LBU_RRR ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERR)
-LBUDGET_RI = (LBU_ENABLE .AND. LBU_RRI ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERI)
-LBUDGET_RS = (LBU_ENABLE .AND. LBU_RRS ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERS)
-LBUDGET_RG = (LBU_ENABLE .AND. LBU_RRG ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERG)
-LBUDGET_RH = (LBU_ENABLE .AND. LBU_RRH ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERH)
-LBUDGET_SV = (LBU_ENABLE .AND. LBU_RSV ) .OR. ((LLES_CALL .OR. LCHECK ).AND. NSV>0 )
+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 == '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
+LBUDGET_RI = ( (LBU_ENABLE .AND. LBU_RRI ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERI) ) .AND. NRR >= 4
+LBUDGET_RS = ( (LBU_ENABLE .AND. LBU_RRS ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERS) ) .AND. NRR >= 5
+LBUDGET_RG = ( (LBU_ENABLE .AND. LBU_RRG ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERG) ) .AND. NRR >= 6
+LBUDGET_RH = ( (LBU_ENABLE .AND. LBU_RRH ) .OR. ((LLES_CALL .OR. LCHECK ).AND. OUSERH) ) .AND. NRR >= 7
+LBUDGET_SV = (LBU_ENABLE .AND. LBU_RSV ) .OR. ((LLES_CALL .OR. LCHECK ).AND. NSV>0 )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/c2r2_adjust.f90 b/src/MNH/c2r2_adjust.f90
index 265452f1681cfa2797ae482ccd843fc3ce233e4b..b97914d1af619016ef85478e6aa2c275eb31421c 100644
--- a/src/MNH/c2r2_adjust.f90
+++ b/src/MNH/c2r2_adjust.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.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE C2R2_ADJUST(KRR, TPFILE, HRAD, &
- HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
+ HTURBDIM, OSUBG_COND, PTSTEP, &
PRHODJ, PSIGS, PPABST, &
PTHS, PRVS, PRCS, PCNUCS, &
PCCS, PSRCS, PCLDFR, PRRS )
@@ -21,7 +21,6 @@ INTEGER, INTENT(IN) :: KRR ! Number of moist
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) :: OCLOSE_OUT ! Conditional closure of the OUTPUT file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid condensation
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
!
@@ -46,7 +45,7 @@ END INTERFACE
END MODULE MODI_C2R2_ADJUST
! ##########################################################################
SUBROUTINE C2R2_ADJUST(KRR, TPFILE, HRAD, &
- HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
+ HTURBDIM, OSUBG_COND, PTSTEP, &
PRHODJ, PSIGS, PPABST, &
PTHS, PRVS, PRCS, PCNUCS, &
PCCS, PSRCS, PCLDFR, PRRS )
@@ -90,7 +89,6 @@ END MODULE MODI_C2R2_ADJUST
!! Module MODD_BUDGET:
!! NBUMOD
!! CBUTYPE
-!! NBUPROCCTR
!! LBU_RTH
!! LBU_RRV
!! LBU_RRC
@@ -136,27 +134,29 @@ END MODULE MODI_C2R2_ADJUST
!! March 2006 (O.Geoffroy) Add KHKO scheme
!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
!! change of YCOMMENT
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, 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, ONLY: NSV_C2R2BEG
USE MODD_PARAMETERS
!
-USE MODE_FIELD
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
!
USE MODI_CONDENS
-USE MODI_BUDGET
!
IMPLICIT NONE
!
@@ -166,7 +166,6 @@ INTEGER, INTENT(IN) :: KRR ! Number of moist
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) :: OCLOSE_OUT ! Conditional closure of the OUTPUT file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid condensation
REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
!
@@ -205,6 +204,14 @@ TYPE(TFIELDDATA) :: TZFIELD
!* 1. PRELIMINARIES
! -------------
!
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'CEVA', pcnucs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'CEVA', pccs (:, :, :) * prhodj(:, :, :) )
+end if
+
ILUOUT = TLUOUT%NLU
ZEPS= XMV / XMD
!
@@ -397,7 +404,7 @@ IF ( HRAD /= 'NONE' ) THEN
PCLDFR(:,:,:) = ZW1(:,:,:)
END IF
!
-IF ( OCLOSE_OUT ) THEN
+IF ( tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'NEB'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'NEB'
@@ -419,15 +426,14 @@ END IF
!* 7. STORE THE BUDGET TERMS
! ----------------------
!
-!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),6,'COND_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),7,'COND_BU_RRC')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),4,'COND_BU_RTH')
-IF (LBUDGET_SV) THEN
- CALL BUDGET (PCNUCS(:,:,:) * PRHODJ(:,:,:),13+(NSV_C2R2BEG-1),'CEVA_BU_RSV') ! RCN
- CALL BUDGET (PCCS(:,:,:) * PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),'CEVA_BU_RSV') ! RCC
-END IF
-!
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'CEVA', pcnucs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'CEVA', pccs (:, :, :) * prhodj(:, :, :) )
+end if
+
!------------------------------------------------------------------------------
!
!
diff --git a/src/MNH/c3r5_adjust.f90 b/src/MNH/c3r5_adjust.f90
deleted file mode 100644
index b286ac8c7bcf1b09dad24c2ffcb17d1b7077e254..0000000000000000000000000000000000000000
--- a/src/MNH/c3r5_adjust.f90
+++ /dev/null
@@ -1,166 +0,0 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_C3R5_ADJUST
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE C3R5_ADJUST( KRR, KMI, HRAD, &
- HTURBDIM, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PSIGS, PPABST, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
- PCCT, PCIT, PCNUCS, PCCS, PINUCS, PCIS, &
- PTHS, PSRCS, PCLDFR )
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-INTEGER, INTENT(IN) :: KMI ! Model index
-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
-!
-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) :: PSIGS ! Sigma_s at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute Pressure at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRST ! Aggregate m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRGT ! Graupel m.r. at t
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRRS ! Rain water m.r. at t+1
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Cloud ice m.r. at t+1
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRSS ! Aggregate m.r. at t+1
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRGS ! Graupel m.r. at t+1
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHS ! Hail m.r. at t+1
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water conc. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Cloud ice conc. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCNUCS ! Nucl. aero. conc. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water conc. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINUCS ! Ice Nucl. conc. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Cloud ice conc. source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSRCS ! Second-order flux: s'rc'/2Sigma_s2 at time t+1 times Lambda_3
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! Cloud fraction
-!
-END SUBROUTINE C3R5_ADJUST
-!
-END INTERFACE
-!
-END MODULE MODI_C3R5_ADJUST
-!
-! ##########################################################################
- SUBROUTINE C3R5_ADJUST( KRR, KMI, HRAD, &
- HTURBDIM, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PSIGS, PPABST, &
- PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
- PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
- PCCT, PCIT, PCNUCS, PCCS, PINUCS, PCIS, &
- PTHS, PSRCS, PCLDFR )
-! ##########################################################################
-!
-!!**** *C3R5_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).
-!!
-!! 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
-!! NBUPROCCTR
-!! 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*
-!!
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 20/12/94
-!! Modifications: March 1, 1995 (J.M. Carriere)
-!! Introduction of cloud water with order 1
-!! formulation
-!! Modifications: June 8, 1995 ( J.Stein )
-!! Cleaning
-!! Modifications: August 30, 1995 ( J.Stein )
-!! add Lambda3 for the subgrid condensation
-!!
-!! October 16, 1995 (J. Stein) change the budget calls
-!! March 16, 1996 (J. Stein) store the cloud fraction
-!! April 03, 1996 (J. Stein) displace the nebulosity
-!! computation in the all and nothing case
-!! April 15, 1996 (J. Stein) displace the lambda 3
-!! multiplication and change the nebulosity threshold
-!! September 16, 1996 (J. Stein) bug in the SG cond for
-!! the M computation
-!! October 10, 1996 (J. Stein) reformulate the Subgrid
-!! condensation scheme
-!! October 8, 1996 (Cuxart,Sanchez) Cloud frac. LES diag (XNA)
-!! December 6, 1996 (J.-P. Pinty) correction of Delta_2
-!! November 5, 1996 (J. Stein) remove Rnp<0 values
-!! November 13 1996 (V. Masson) add prints in test above
-!! March 11, 1997 (J.-M. Cohard) C2R2 option
-!! April 6, 2001 (J.-P. Pinty) C3R5 option
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!!
-!-------------------------------------------------------------------------------
-!
-!implicit none
-!
-use mode_msg
-!
-call Print_msg(NVERB_FATAL,'GEN','C3R5_ADJUST','not yet developed')
-!
-END SUBROUTINE C3R5_ADJUST
diff --git a/src/MNH/calcsound.f90 b/src/MNH/calcsound.f90
index a0b1c5fa1e0deb61f7723d6ac1fba400a2b49707..03acbaba22fb11a10921e2f67dafe4474c8137c0 100644
--- a/src/MNH/calcsound.f90
+++ b/src/MNH/calcsound.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! masdev4_7 BUG1 2007/06/15 17:47:17
-!-----------------------------------------------------------------
! #####################
MODULE MODI_CALCSOUND
! #####################
@@ -43,7 +38,7 @@ END MODULE MODI_CALCSOUND
!!
!!** METHOD
!! ------
-!! The horizontal dimensions of model arrays are splitted in arrays of
+!! The horizontal dimensions of model arrays are split in arrays of
!! 1000 columns. If there is at least 1000 elements, computation is
!! made in a static way, otherwise in a dynamical way.
!!
diff --git a/src/MNH/call_rttov11.f90 b/src/MNH/call_rttov11.f90
index 254bc976c84de483419ce3623ca315b8bbc96a90..e9eda58c83d726d4d3b27d595189f32abf9aadfd 100644
--- a/src/MNH/call_rttov11.f90
+++ b/src/MNH/call_rttov11.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2003-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed 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.
@@ -82,7 +82,8 @@ SUBROUTINE CALL_RTTOV11(KDLON, KFLEV, PEMIS, PTSRAD, &
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! JP Chaboureau 30/05/2017 exclude the first layer when considering clouds
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! JP Chaboureau 26/10/2020: calculate all IR intruments; deallocate MW tabs
!!----------------------------------------------------------------------------
!!
!!* 0. DECLARATIONS
@@ -92,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
@@ -102,7 +104,6 @@ USE MODN_CONF
USE MODI_DETER_ANGLE
USE MODI_PINTER
!
-USE MODE_FIELD
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
USE MODE_MSG
@@ -110,7 +111,7 @@ USE MODE_POS
!
#ifdef MNH_RTTOV_11
USE rttov_const, ONLY : &
- & sensor_id_ir, sensor_id_hi, sensor_id_mw, &
+ & sensor_id, sensor_id_ir, sensor_id_hi, sensor_id_mw, &
& q_mixratio_to_ppmv, tmin, tmax, qmin, qmax, pmin, pmax
USE rttov_types
USE parkind1, ONLY: jpim, jprb, jplm
@@ -193,8 +194,8 @@ REAL :: ZZH, zdeg_to_rad, zrad_to_deg, zbeta, zalpha
! REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOSZEN, ZSINZEN, ZAZIMSOL
! -----------------------------------------------------------------------------
-REAL, DIMENSION(:), ALLOCATABLE :: ZANGL !Satellite zenith angle (deg)
-REAL, DIMENSION(:), ALLOCATABLE :: ZANGS !Solar zenith angle (deg)
+REAL, DIMENSION(1) :: ZANGL, ZLON, ZLAT !Satellite zenith angle, longitude, latitude (deg)
+REAL :: ZANGS !Solar zenith angle (deg)
! -----------------------------------------------------------------------------
! INDEXES AND TEMPORAL ARRAYS FOR VECTORIZATION
INTEGER :: JIS, IBEG, IEND, IDIM, ICPT
@@ -297,9 +298,7 @@ DO JSAT=1,IJSAT ! loop over sensors
instrument(3)=KRTTOVINFO(3,JSAT)
! PRINT *,' JSAT=',JSAT, instrument
-!!! METEOSAT, GOES, OR MSG PLATFORM
- IF (KRTTOVINFO(1,JSAT) == 3 .OR. KRTTOVINFO(1,JSAT) == 4 &
- .OR. KRTTOVINFO(1,JSAT) == 12) THEN
+ IF( sensor_id( instrument(3) ) /= sensor_id_mw) THEN
opts % rt_ir % addsolar = .FALSE. ! Do not include solar radiation
opts % interpolation % addinterp = .TRUE. ! Allow interpolation of input profile
opts % interpolation % interp_mode = 1 ! Set interpolation method
@@ -343,7 +342,7 @@ DO JSAT=1,IJSAT ! loop over sensors
ALLOCATE(ZBT(IIU,IJU,nchannels))
ZBT(:,:,:)=999.
-! PRINT *,'ncan=',nchan,' nchannels=',nchannels
+! PRINT *,'ncan=',nchan,' nchannels=',nchannels
ALLOCATE (chanprof (nchannels))
ALLOCATE (frequencies (nchannels))
@@ -355,9 +354,7 @@ DO JSAT=1,IJSAT ! loop over sensors
calcemis = .TRUE.
emissivity % emis_in = 0.0_JPRB
-!!! METEOSAT, GOES, OR MSG PLATFORM
- IF (KRTTOVINFO(1,JSAT) == 3 .OR. KRTTOVINFO(1,JSAT) == 4 &
- .OR. KRTTOVINFO(1,JSAT) == 12) calcemis = .FALSE.
+ IF( coef_rttov%coef% id_sensor /= sensor_id_mw) calcemis = .FALSE.
! IF( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
! ! Allocate arrays for surface reflectance
@@ -427,18 +424,41 @@ DO JSAT=1,IJSAT ! loop over sensors
!! opts%interpolation%reg_limit_extrap = .TRUE.
!! profiles(1)%gas_units = 1 ! kg/kg over moist air
-!PRINT *,'nlev=',nlev,' tmax=',tmax,' tmin=',tmin,' qmax=',qmax,' qmin=',qmin
-!PRINT *, coef_rttov%coef % nlevels
+! PRINT *,'nlev=',nlev,' tmax=',tmax,' tmin=',tmin,' qmax=',qmax,' qmin=',qmin
+! PRINT *, coef_rttov%coef % nlevels
DO JI=IIB,IIE
DO JJ=IJB,IJE
+ 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)*180./XPI
+ 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)*180./XPI
+ 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)*180./XPI
+ ELSEIF (KRTTOVINFO(1,JSAT) == 7) THEN ! TRMM PLATFORM
+ ZANGL=52.3
+ ELSE
+ ZANGL=0.
+ ENDIF
+! Coefficients computed from transmittances for 6 viewing angles in the range
+! 0 to 63.6 deg (Saunders, 2002, RTTOV7 - science/validation rep., page 3)
+ profiles(1) % zenangle = MIN(ZANGL(1),65.)
+
DO JK=IKB,IKE ! nlevels
JKRAD = nlev-JK+2 !INVERSION OF VERTICAL LEVELS!
-!PRINT *,'jk=',jk,' jkrad=',jkrad
+! PRINT *,'jk=',jk,' jkrad=',jkrad
profiles(1) % p(JKRAD) = PPABST(JI,JJ,JK)*0.01
profiles(1) % t(JKRAD) = MIN(tmax,MAX(tmin,ZTEMP(JI,JJ,JK)))
-!PRINT *,'jk=',JK,' ZTEMP=',ZTEMP(JI,JJ,JK),' t=',profiles(1) % t(JKRAD)
+! PRINT *,'jk=',JK,' ZTEMP=',ZTEMP(JI,JJ,JK),' t=',profiles(1) % t(JKRAD)
profiles(1) % q(JKRAD) = MIN(qmax,MAX(qmin,PRT(JI,JJ,JK,1)*q_mixratio_to_ppmv))
-! PRINT *,JK,profiles(1) % p(JKRAD) ,profiles(1) % t(JKRAD) ,profiles(1) % q(JKRAD)
+! PRINT *,JK,profiles(1) % p(JKRAD) ,profiles(1) % t(JKRAD) ,profiles(1) % q(JKRAD)
END DO
profiles(1) % elevation = 0.5*( PZZ(JI,JJ,1)+PZZ(JI,JJ,IKB) )
profiles(1) % skin % t = MIN(tmax,MAX(tmin,PTSRAD(JI,JJ)))
@@ -469,7 +489,7 @@ DO JSAT=1,IJSAT ! loop over sensors
ELSE
DO JK=IKB,IKE
JKRAD = nlev-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) %ph (JKRAD) = 0.5*( PPABST(JI,JJ,JK) + PPABST(JI,JJ,JK+1) )*0.01
cld_profiles(1) %cc(JKRAD) = PCLDFR(JI,JJ,JK)
cld_profiles(1) %clw(JKRAD) = MIN(ZRCMAX,PRT(JI,JJ,JK,2))
cld_profiles(1) %rain(JKRAD) = MIN(ZRRMAX,PRT(JI,JJ,JK,3))
@@ -479,14 +499,14 @@ DO JSAT=1,IJSAT ! loop over sensors
END IF
END DO
cld_profiles (1) % ph (nlev+1) = profiles (1) % s2m % p
-! PRINT *,nlev+1,' cld_profiles(1) % ph (nlev+1) =',cld_profiles(1) % ph (nlev+1)
+! PRINT *,nlev+1,' cld_profiles(1) % ph (nlev+1) =',cld_profiles(1) % ph (nlev+1)
END IF
DO JCH=1,nchannels
IF (.NOT.calcemis(JCH)) emissivity(JCH)%emis_in = PEMIS(JI,JJ)
END DO
-!write(*,*) 'Calling forward model'
+! write(*,*) 'Calling forward model'
! Forward model run
IF ( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
@@ -523,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
@@ -574,12 +600,18 @@ DO JSAT=1,IJSAT ! loop over sensors
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
- TZFIELD%LTIMEDEP = .FALSE.
+ TZFIELD%LTIMEDEP = .TRUE.
! PRINT *,'YRECFM='//TRIM(TZFIELD%CMNHNAME)
CALL IO_Field_write(TPFILE,TZFIELD,ZBT(:,:,JCH))
END DO
- DEALLOCATE(chanprof,frequencies,emissivity,calcemis,profiles,cld_profiles)
+ DEALLOCATE(chanprof,frequencies,emissivity,calcemis,profiles)
DEALLOCATE(ZBT)
+ IF( coef_rttov%coef% id_sensor == sensor_id_mw) THEN
+ CALL rttov_alloc_scatt_prof(nprof, cld_profiles, nlev, .FALSE., 0_jpim)
+ CALL rttov_dealloc_scattcoeffs(coef_scatt)
+ END IF
+ DEALLOCATE(cld_profiles)
+ CALL rttov_dealloc_coefs(errorstatus, coef_rttov)
! IF( coef_rttov%coef% id_sensor /= sensor_id_mw) THEN
! DEALLOCATE(calcrefl,reflectance)
! END IF
diff --git a/src/MNH/call_rttov13.f90 b/src/MNH/call_rttov13.f90
new file mode 100644
index 0000000000000000000000000000000000000000..97ccf20af2a1a608ad00478b2f05046572cef425
--- /dev/null
+++ b/src/MNH/call_rttov13.f90
@@ -0,0 +1,731 @@
+!MNH_LIC Copyright 2003-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed 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/call_rttov8.f90 b/src/MNH/call_rttov8.f90
index 6180ec0f976c350520fcea3c780c413ffedcef51..946021f408ea475fedeb5baeea3d2576a05df475 100644
--- a/src/MNH/call_rttov8.f90
+++ b/src/MNH/call_rttov8.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2003-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -104,7 +104,6 @@ USE MODD_RAD_TRANSF
USE MODI_DETER_ANGLE
USE MODI_PINTER
!
-USE MODE_FIELD
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
USE MODE_MSG
diff --git a/src/MNH/ch_aer_eqm_initn.f90 b/src/MNH/ch_aer_eqm_initn.f90
index acece90b873e701417f00e2f778e8936bca66df6..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.
@@ -59,7 +59,6 @@ USE MODD_NSV
USE MODD_CONF
USE MODE_ll
USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_BLANK , ONLY : CDUMMY1
USE MODD_CST, ONLY : &
XMNH_TINY &
,XAVOGADRO & ![molec/mol] avogadros number
diff --git a/src/MNH/ch_aqueous_check.f90 b/src/MNH/ch_aqueous_check.f90
index d99d0caa9956f1c29ce0495ad19954b3f7feade2..e422cecfa11c3cac2a9748ca032379b924c7a4aa 100644
--- a/src/MNH/ch_aqueous_check.f90
+++ b/src/MNH/ch_aqueous_check.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2007-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -94,7 +94,7 @@ REAL, INTENT(IN) :: PRTMIN_AQ ! LWC threshold liq. chem.
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS ! water m.r. source
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS ! water m.r. source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! S.V. source
!
INTEGER, INTENT(IN) :: KRRL ! Number of liq. variables
diff --git a/src/MNH/ch_aqueous_sedim2mom.f90 b/src/MNH/ch_aqueous_sedim2mom.f90
index 55b2d3090a8c75b977136d0b3a2dc601335f2bea..603228ecd288aee3dd0f88498f0d84a9ad18af12 100644
--- a/src/MNH/ch_aqueous_sedim2mom.f90
+++ b/src/MNH/ch_aqueous_sedim2mom.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2008-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2008-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -23,7 +23,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. source
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRS ! Rain water C. source
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Precip. aq. species at t
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Precip. aq. species source
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR ! instantaneaous precip.
diff --git a/src/MNH/ch_aqueous_sedimc2r2.f90JPP b/src/MNH/ch_aqueous_sedimc2r2.f90JPP
deleted file mode 100644
index 2627365be22072d9707bfb55193fbbd6078b49ec..0000000000000000000000000000000000000000
--- a/src/MNH/ch_aqueous_sedimc2r2.f90JPP
+++ /dev/null
@@ -1,310 +0,0 @@
-!MNH_LIC Copyright 2008-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ################################
- MODULE MODI_CH_AQUEOUS_SEDIMC2R2
-! ################################
-!
-INTERFACE
- SUBROUTINE CH_AQUEOUS_SEDIMC2R2 (PTIME, PTSTEP, PZZ, PRHODREF, PRHODJ, &
- PRRM, PRRS, PCRM, PCRS, PSVT, PRSVS )
-!
-REAL, INTENT(IN) :: PTIME ! Current time
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRM ! Rain water C at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Precip. aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Precip. aq. species source
-!
-END SUBROUTINE CH_AQUEOUS_SEDIMC2R2
-END INTERFACE
-END MODULE MODI_CH_AQUEOUS_SEDIMC2R2
-!
-! #######################################################################
- SUBROUTINE CH_AQUEOUS_SEDIMC2R2 (PTIME,PTSTEP, PZZ, PRHODREF, PRHODJ, &
- PRRM, PRRS, PCRM, PCRS, PSVT, PRSVS )
-! #######################################################################
-!
-!!**** * - compute the explicit microphysical sources
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the sedimentation of chemical
-!! species in the raindrops for the C2R2 and C3R5 cloud microphysical schemes.
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process). see rain_c2r2.f90
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!! Module MODD_CONF :
-!! CCONF configuration of the model for the first time step
-!!
-!! REFERENCE
-!! ---------
-!! Book1 of the documentation ( routine CH_AQUEOUS_SEDIMC2R2 )
-!!
-!! AUTHOR
-!! ------
-!! M. Leriche & J.P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/10/08
-!!
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_LUNIT_n
-
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_RAIN_C2R2_DESCR, ONLY : XCEXVT, XRTMIN, XCTMIN, &
- XLBR, XLBEXR, XDR
-USE MODD_RAIN_C2R2_PARAM, ONLY : XFSEDRR, XFSEDCR
-USE MODD_CH_MNHC_n, ONLY: XRTMIN_AQ
-!
-use mode_tools, only: Countjv
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-REAL, INTENT(IN) :: PTIME ! Current time
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRM ! Rain water C at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Precip. aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Precip. aq. species source
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JK,JI,JJ ! Vertical loop index for the rain sedimentation
-INTEGER :: JN ! Temporal loop index for the rain sedimentation
-INTEGER :: IIB ! Define the domain where is
-INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IKB !
-INTEGER :: IKE !
-!
-REAL :: ZTSPLITR ! Small time step for rain sedimentation
-!
-INTEGER :: ISEDIM ! Case number of sedimentation
-LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: GSEDIM ! where to compute the SED processes
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZZRRS ! rain water m.r.source for sedim
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZZCRS ! rain water C source for sedim
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRRS ! Rain water m.r. source phys.tendency (*dt)
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZCRS ! Rain water C source phys.tendency
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZWLBDR3, ZWLBDR ! Slope parameter of the raindrops distribution
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZW ! work array
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZWSEDR, ZWSEDC ! sedimentation fluxes
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRR_SEDIM ! Drain/Dt sur ZTSPLIT
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZCR_SEDIM ! Drain/Dt sur ZTSPLIT
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZSV_SEDIM_FACT ! Cumul des Dsv/DT
-REAL, DIMENSION(:), ALLOCATABLE :: ZZZRRS ! Rain water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZZZCRS ! Rain water C source
-REAL, DIMENSION(:), ALLOCATABLE :: ZLBDR ! slope parameter
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
- ZZW1, ZZW2, ZZW3 ! Work array
-REAL, SAVE :: ZRTMIN, ZCTMIN
-!
-REAL :: ZVTRMAX, ZDZMIN, ZT
-LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
-INTEGER, SAVE :: ISPLITR
-!
-INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-
-
-INTEGER :: ILUOUT ! logical unit
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- !in LFI subroutines at the open of the file
-
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
-!
-IIB=1+JPHEXT
-IIE=SIZE(PZZ,1) - JPHEXT
-IJB=1+JPHEXT
-IJE=SIZE(PZZ,2) - JPHEXT
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-!-------------------------------------------------------------------------------
-!
-!!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
-! ---------------------------------------
-!
-ZRRS(:,:,:) = PRRS(:,:,:) / PRHODJ(:,:,:)
-ZCRS(:,:,:) = PCRS(:,:,:) / PRHODJ(:,:,:)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE SEDIMENTATION (RS) SOURCE
-! -------------------------------------
-!
-!* 3.1 splitting factor for high Courant number C=v_fall*(del_Z/del_T)
-!
-firstcall : IF (GSFIRSTCALL) THEN
- GSFIRSTCALL = .FALSE.
- ZVTRMAX = 30. !cf. ini_rain_c2r2.f90
- ZDZMIN = MINVAL(PZZ(IIB:IIE,IJB:IJE,IKB+1:IKE+1)-PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
- ISPLITR = 1
- SPLIT : DO
- ZT = PTSTEP / REAL(ISPLITR)
- IF ( ZT * ZVTRMAX / ZDZMIN .LT. 1.) EXIT SPLIT
- ISPLITR = ISPLITR + 1
- END DO SPLIT
- ZRTMIN = XRTMIN(3) / PTSTEP
- ZCTMIN = XCTMIN(3) / PTSTEP
-END IF firstcall
-!
-!* 3.2 Compute the slope parameter
-!
- ZWLBDR3(:,:,:) = 1.E30
- ZWLBDR(:,:,:) = 1.E10
-! WHERE (ZRRS(:,:,:)>0.0.AND.ZCRS(:,:,:)>0.0 )
- WHERE ( ZRRS(:,:,:)>ZRTMIN .AND. ZCRS(:,:,:)>ZCTMIN )
- ZWLBDR3(:,:,:) = XLBR * ZCRS(:,:,:) / (PRHODREF(:,:,:) * ZRRS(:,:,:))
- ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
- END WHERE
-!
-!* 3.3 time splitting loop initialization
-!
-ZTSPLITR = PTSTEP / REAL(ISPLITR) ! Small time step
-!
-!* 3.4 compute the fluxes
-!
-! optimization by looking for locations where
-! the precipitating fields are larger than a minimal value only !!!
-!
-ZSV_SEDIM_FACT(:,:,:) = 1.0
-ZZRRS(:,:,:) = ZRRS(:,:,:) * PTSTEP
-ZZCRS(:,:,:) = ZCRS(:,:,:) * PTSTEP
-!
-DO JN = 1 , ISPLITR
- GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZRRS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN
- ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- IF( ISEDIM >= 1 ) THEN
- IF( JN==1 ) THEN
- ZW(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZW(:,:,JK) =ZTSPLITR/(PZZ(:,:,JK+1)-PZZ(:,:,JK))
- END DO
- END IF
- ALLOCATE(ZRHODREF(ISEDIM))
- ALLOCATE(ZZZRRS(ISEDIM))
- ALLOCATE(ZZZCRS(ISEDIM))
- ALLOCATE(ZLBDR(ISEDIM))
- DO JL=1,ISEDIM
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZZRRS(JL) = ZZRRS(I1(JL),I2(JL),I3(JL))
- ZZZCRS(JL) = ZZCRS(I1(JL),I2(JL),I3(JL))
- ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL))
- ENDDO
- ALLOCATE(ZZW1(ISEDIM)) ; ZZW1(:) = 0.0
- ALLOCATE(ZZW2(ISEDIM)) ; ZZW2(:) = 0.0
- ALLOCATE(ZZW3(ISEDIM)) ; ZZW3(:) = 0.0
-!
-!* for rain
-!
- WHERE( ZZZRRS(:)>XRTMIN(3) )
- ZZW3(:) = ZRHODREF(:)**(-XCEXVT) * (ZLBDR(:)**(-XDR))
- ZZW1(:) = XFSEDRR * ZZZRRS(:)* ZZW3(:) * ZRHODREF(:)
- ZZW2(:) = XFSEDCR * ZZZCRS(:)* ZZW3(:)
- END WHERE
- ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDC(:,:,:) = UNPACK( ZZW2(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK)) &
- /PRHODREF(:,:,JK)
- ZCR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSEDC(:,:,JK+1)-ZWSEDC(:,:,JK))
- END DO
- ZZRRS(:,:,:) = ZZRRS(:,:,:) + ZRR_SEDIM(:,:,:)
- ZZCRS(:,:,:) = ZZCRS(:,:,:) + ZCR_SEDIM(:,:,:)
-!
- WHERE( ZZZRRS(:)>XRTMIN(3) )
- ZZW1(:) = XFSEDRR * ZZW3(:) * ZRHODREF(:)
- END WHERE
- ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZRR_SEDIM(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK))
- END DO
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZZRRS)
- DEALLOCATE(ZZZCRS)
- DEALLOCATE(ZLBDR)
- DEALLOCATE(ZZW1)
- DEALLOCATE(ZZW2)
- DEALLOCATE(ZZW3)
- ZSV_SEDIM_FACT(:,:,:) = ZSV_SEDIM_FACT(:,:,:) * (1.0 + ZRR_SEDIM(:,:,:))
-!! (1.0 + ZRR_SEDIM(:,:,:)/MAX(ZZRRS(:,:,:),XRTMIN_AQ))
- END IF
-END DO
-!
-! Apply the rain sedimentation rate to the WR_xxx aqueous species
-!
-!ILUOUT = TLUOUT%NLU
-!WRITE(ILUOUT,*) 'valuers ZSV_SEDIM_FACT TIME =', PTIME-59400.
-!DO JI=IIB,IIE
-! DO JJ = IJB,IJE
-! DO JK= IKB,IKE
-!IF(ZSV_SEDIM_FACT(jI,jJ,jK)>5.) WRITE(ILUOUT,*) JI,JJ,JK,ZSV_SEDIM_FACT(ji,jj,jk)
-! ENDDO
-! ENDDO
-!ENDDO
-DO JL= 1, SIZE(PRSVS,4)
- PRSVS(:,:,:,JL) = MAX( 0.0,ZSV_SEDIM_FACT(:,:,:)*PRSVS(:,:,:,JL) )
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE CH_AQUEOUS_SEDIMC2R2
-
diff --git a/src/MNH/ch_convect_linox.f90 b/src/MNH/ch_convect_linox.f90
index 2642f84c38c4134c53e6616d4cec6f4ade1fc582..aae2b7345d1c1a9d6f824a6adde3133486b027b8 100644
--- a/src/MNH/ch_convect_linox.f90
+++ b/src/MNH/ch_convect_linox.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 chimie 2006/07/12 18:36:21
-!-----------------------------------------------------------------
! ############################
MODULE MODI_CH_CONVECT_LINOX
! ############################
@@ -115,7 +110,6 @@ END MODULE MODI_CH_CONVECT_LINOX
USE MODD_CST
USE MODD_PARAMETERS
USE MODD_CONVPAREXT
-USE MODD_NSV, ONLY : NSV_CHEMBEG, NSV_CHEMEND
!
!
USE MODE_ll
diff --git a/src/MNH/ch_f77.fx90 b/src/MNH/ch_f77.fx90
index 25e86d2cdf4ce98bdf846ef9e14eb25250567380..3200d175726131af689d38f771d08362e669850b 100644
--- a/src/MNH/ch_f77.fx90
+++ b/src/MNH/ch_f77.fx90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1989-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1989-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -25,6 +25,7 @@ C + wrong use of an non initialized
C**MODIFIED: P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
C P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
C P. Wautelet 21/11/2019: replace several CONTINUE (workaround of problems with gfortran OpenACC)
+C P. Wautelet 17/08/2020: small correction in call to LEPOLY
C!
C!
C!
@@ -13478,7 +13479,7 @@ c cosines
NCOS = 1
ANGCOS = -UMU0
- CALL LEPOLY( NCOS, MAZIM, MXCMU, NSTR - 1, ANGCOS, YLM0 )
+ CALL LEPOLY( NCOS, MAZIM, MXCMU, NSTR - 1, [ANGCOS], YLM0 )
END IF
diff --git a/src/MNH/ch_init_budgetn.f90 b/src/MNH/ch_init_budgetn.f90
index d84ff1f7584f5f3346a4691330d6b43a9ad0cdee..5f64490410f01cae1581577c943051601aff7e59 100644
--- a/src/MNH/ch_init_budgetn.f90
+++ b/src/MNH/ch_init_budgetn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2016-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2016-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -120,7 +120,7 @@ IF (YWORKSTR /= '') THEN
END IF
END DO
IF (GCHECKFAILED) THEN
- call Print_msg( NVERB_FATAL, 'GEN', 'CH_INIT_BUDGET_n', 'wrong (misspelled) CSPEC_BUDGET encountered' )
+ call Print_msg( NVERB_FATAL, 'BUD', 'CH_INIT_BUDGET_n', 'wrong (misspelled) CSPEC_BUDGET encountered' )
END IF
ELSE
DEALLOCATE(CNAMES_BUDGET)
diff --git a/src/MNH/ch_monitorn.f90 b/src/MNH/ch_monitorn.f90
index 30ea347667318cda050a7dd246ab9396b5635e95..eee756dfbcdba0278206e33b4255e2cd1212b6c1 100644
--- a/src/MNH/ch_monitorn.f90
+++ b/src/MNH/ch_monitorn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -116,6 +116,7 @@ END MODULE MODI_CH_MONITOR_n
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 12/02/2019: bugfix: ZINPRR was not initialized all the time
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!!
!! EXTERNAL
!! --------
@@ -125,7 +126,6 @@ USE MODI_CH_SET_RATES
USE MODI_CH_SET_PHOTO_RATES
USE MODI_CH_SOLVER_n
USE MODI_CH_UPDATE_JVALUES
-USE MODI_BUDGET
USE MODI_CH_INIT_ICE
USE MODI_CH_AQUEOUS_TMICICE
USE MODI_CH_AQUEOUS_TMICKESS
@@ -142,6 +142,7 @@ USE MODI_CH_AER_EQM_CORMASS
USE MODI_CH_AER_SURF
USE MODI_CH_AER_DEPOS
!
+use mode_budget, only: Budget_store_end, Budget_store_init
USE MODE_ll
USE MODE_MODELN_HANDLER
use mode_msg
@@ -154,7 +155,7 @@ USE MODI_CH_PRODLOSS
! IMPLICIT ARGUMENTS
! ------------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
USE MODD_LUNIT_n
USE MODD_NSV, ONLY : NSV_CHEMBEG,NSV_CHEMEND,NSV_CHEM,& ! index for chemical SV
NSV_CHACBEG,NSV_CHACEND,NSV_CHAC,& ! index for aqueous SV
@@ -389,8 +390,8 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZRV, ZDENAIR, ZPRESSURE, ZTEMP, ZRC
REAL, DIMENSION(:,:), ALLOCATABLE :: ZRHOP0, ZOM, ZSOLORG
REAL, DIMENSION(:), ALLOCATABLE :: ZLAMBDA, ZMU, ZSO4RAT
-REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)) :: ZSVT
-REAL,DIMENSION(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSV_AER) :: ZCWETAERO
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZCWETAERO
!
!-------------------------------------------------------------------------------
! variables for AQueous/NAQueous cases
@@ -403,7 +404,13 @@ REAL, DIMENSION(SIZE(XRT,1), SIZE(XRT,2)) :: ZINPRR! Rain instant precip
!-------------------------------------------------------------------------------
!
! get model index
- IMI = GET_CURRENT_MODEL_INDEX()
+IMI = GET_CURRENT_MODEL_INDEX()
+
+if ( lbudget_sv ) then
+ do jsv = nsv_chembeg, nsv_chemend
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'CHEM', xrsvs(:, :, :, jsv) )
+ enddo
+endif
!
!* 1. PREPARE MONITOR
! ---------------
@@ -601,10 +608,16 @@ ZDTSOLVER = PTSTEP / NCH_SUBSTEPS
!
!
IF (LORILAM) THEN
-
- DO JSV = 1, SIZE(XSVT,4)
- ZSVT(:,:,:,JSV) = XRSVS(:,:,:,JSV) *PTSTEP / XRHODJ(:,:,:)
- END DO
+ ALLOCATE( ZSVT(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)) )
+ 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)
!
@@ -632,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
@@ -700,7 +711,7 @@ END IF
IF (KTCOUNT==1 .OR. &
(MOD(ISTCOUNT, MAX(1, INT(XCH_TUV_TUPDATE/XTSTEP)) ) .EQ. 0)) THEN
!
- WRITE(KLUOUT,*)"TIME call update jvalue: ",TDTCUR%TIME
+ WRITE(KLUOUT,*)"TIME call update jvalue: ",TDTCUR%xtime
!
IF (.NOT.ASSOCIATED(XJVALUES)) &
ALLOCATE(XJVALUES(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),JPJVMAX))
@@ -708,7 +719,7 @@ IF (KTCOUNT==1 .OR. &
CALL CH_UPDATE_JVALUES(KLUOUT, XZENITH, XRT, &
XALBUV, XZS, XZZ, XLAT0, XLON0, &
SIZE(XZZ,1), SIZE(XZZ,2), SIZE(XZZ,3), NRR, &
- TDTCUR%TDATE%DAY, TDTCUR%TDATE%MONTH, TDTCUR%TDATE%YEAR, TDTCUR%TIME,&
+ TDTCUR%nday, TDTCUR%nmonth, TDTCUR%nyear, TDTCUR%xtime, &
LCH_TUV_ONLINE, CCH_TUV_CLOUDS, &
XCH_TUV_ALBNEW, XCH_TUV_DOBNEW, XRHODREF, XJVALUES, &
IIB,IIE,IJB,IJE,IIU,IJU, KVERB )
@@ -724,7 +735,7 @@ ISTCOUNT = ISTCOUNT + 1
!* 3.1 sedimentation term and wet deposition for aerosols tendency (XSEDA)
!
IF (LORILAM) THEN
- ZTIME = TDTCUR%TIME ! need for ch_orilam
+ ZTIME = TDTCUR%xtime ! need for ch_orilam
XSEDA(:,:,:,:) = 0.
ZSEDA(:,:) = 0.
! dry sedimentation
@@ -737,6 +748,7 @@ IF (LORILAM) THEN
ENDIF
! implicit wet deposition
IF ((LCH_CONV_SCAV).AND.(CPROGRAM/='DIAG ')) THEN
+ ALLOCATE( ZCWETAERO(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),NSV_AER) )
DO JN=1,NSV_AER
ZCWETAERO(:,:,:,JN) = (XRSVS(:,:,:,JN+NSV_AERBEG-1)+PWETDEPAER(:,:,:,JN))*PTSTEP / XRHODJ(:,:,:)
END DO
@@ -745,6 +757,7 @@ IF (LORILAM) THEN
CALL CH_AER_WETDEP_n(PTSTEP, ZSVT(IIB:IIE,IJB:IJE,IKB:IKE,NSV_AERBEG:NSV_AEREND), &
ZCWETAERO(IIB:IIE,IJB:IJE,IKB:IKE,:), XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE), &
XSEDA(IIB:IIE,IJB:IJE,IKB:IKE,:))
+ DEALLOCATE( ZCWETAERO )
ENDIF
! explicit wet deposition
IF ((LDEPOS_AER(IMI)).AND.(CPROGRAM/='DIAG ')) THEN
@@ -766,6 +779,8 @@ IF (LORILAM) THEN
DO JSV = 1, SIZE(XSVT,4)
XRSVS(:,:,:,JSV) = ZSVT(:,:,:,JSV) * XRHODJ(:,:,:) / PTSTEP
END DO
+
+ DEALLOCATE( ZSVT )
ENDIF
!
!* 3.2 check where aqueous concentration>0 + micropĥysics term
@@ -983,14 +998,14 @@ DO JL=1,ISVECNMASK
CASE ('NONE','KESS','ICE3','ICE4')
IF (GSPLIT) THEN ! LWC and LWR computed from tendencies
CALL CH_METEO_TRANS_KESS(JL, XRHODJ, XRHODREF, XRRS, XTHT, XPABST, &
- ISVECNPT, ISVECMASK, TZM, TDTCUR%TDATE%DAY, &
- TDTCUR%TDATE%MONTH, TDTCUR%TDATE%YEAR, &
+ ISVECNPT, ISVECMASK, TZM, TDTCUR%nday, &
+ TDTCUR%nmonth, TDTCUR%nyear, &
XLAT, XLON, XLAT0, XLON0, LUSERV, LUSERC, &
LUSERR, KLUOUT, CCLOUD, PTSTEP )
ELSE
CALL CH_METEO_TRANS_KESS(JL, XRHODJ, XRHODREF, XRT, XTHT, XPABST, &
- ISVECNPT, ISVECMASK, TZM, TDTCUR%TDATE%DAY, &
- TDTCUR%TDATE%MONTH, TDTCUR%TDATE%YEAR, &
+ ISVECNPT, ISVECMASK, TZM, TDTCUR%nday, &
+ TDTCUR%nmonth, TDTCUR%nyear, &
XLAT, XLON, XLAT0, XLON0, LUSERV, LUSERC, &
LUSERR, KLUOUT, CCLOUD )
ENDIF
@@ -999,14 +1014,14 @@ DO JL=1,ISVECNMASK
IF (GSPLIT) THEN ! LWC and LWR computed from tendencies
CALL CH_METEO_TRANS_C2R2(JL, XRHODJ, XRHODREF, XRRS, XRSVS(:,:,:,NSV_C2R2BEG+1), &
XRSVS(:,:,:,NSV_C2R2BEG+2), XTHT, XPABST, ISVECNPT, &
- ISVECMASK, TZM, TDTCUR%TDATE%DAY, TDTCUR%TDATE%MONTH, &
- TDTCUR%TDATE%YEAR, XLAT,XLON, XLAT0, XLON0, LUSERV, &
+ ISVECMASK, TZM, TDTCUR%nday, TDTCUR%nmonth, &
+ TDTCUR%nyear, XLAT,XLON, XLAT0, XLON0, LUSERV, &
LUSERC, LUSERR, KLUOUT, CCLOUD, PTSTEP )
ELSE
CALL CH_METEO_TRANS_C2R2(JL, XRHODJ, XRHODREF, XRT, XSVT(:,:,:,NSV_C2R2BEG+1), &
XSVT(:,:,:,NSV_C2R2BEG+2), XTHT, XPABST, ISVECNPT, &
- ISVECMASK, TZM, TDTCUR%TDATE%DAY, TDTCUR%TDATE%MONTH, &
- TDTCUR%TDATE%YEAR, XLAT,XLON, XLAT0, XLON0, LUSERV, &
+ ISVECMASK, TZM, TDTCUR%nday, TDTCUR%nmonth, &
+ TDTCUR%nyear, XLAT,XLON, XLAT0, XLON0, LUSERV, &
LUSERC, LUSERR, KLUOUT, CCLOUD )
ENDIF
END SELECT
@@ -1032,13 +1047,13 @@ DO JL=1,ISVECNMASK
END DO
END SELECT
CALL CH_SET_RATES &
- (TDTCUR%TIME, ZCHEM, TZM, IMI, KLUOUT, KVERB, ISVECNPT, NEQ, NRRL, ZPH)
+ (TDTCUR%xtime, ZCHEM, TZM, IMI, KLUOUT, KVERB, ISVECNPT, NEQ, NRRL, ZPH)
ELSE
CALL CH_SET_RATES &
- (TDTCUR%TIME, ZCHEM, TZM, IMI, KLUOUT, KVERB, ISVECNPT, NEQ, NRRL)
+ (TDTCUR%xtime, ZCHEM, TZM, IMI, KLUOUT, KVERB, ISVECNPT, NEQ, NRRL)
ENDIF
!
- CALL CH_SET_PHOTO_RATES( TDTCUR%TIME, ZCHEM, JL, TZM, IMI, KLUOUT, KVERB, &
+ CALL CH_SET_PHOTO_RATES( TDTCUR%xtime, ZCHEM, JL, TZM, IMI, KLUOUT, KVERB, &
ISVECNPT, ISVECMASK, NEQ, XJVALUES)
!
!* 4.4 initialize aerosol parameters and moments of 0th,
@@ -1061,7 +1076,7 @@ DO JL=1,ISVECNMASK
ZOLDCHEM(:,:) = ZCHEM(:,:)
DO JM = 1, NCH_SUBSTEPS
CALL CH_SOLVER_n &
- (TDTCUR%TIME, ZDTSOLVER, ZCHEM, ZNEWCHEM, NEQ, ISVECNPT, IMI)
+ (TDTCUR%xtime, ZDTSOLVER, ZCHEM, ZNEWCHEM, NEQ, ISVECNPT, IMI)
ZCHEM(:,:) = MAX(0.0,ZNEWCHEM(:,:))
END DO
IF (CSOLVER(1:2)=="RO" .AND. NEQAQ>0) THEN ! aqueous chemistry case rosenbrock solver
@@ -1127,7 +1142,7 @@ DO JL=1,ISVECNMASK
! selected species
!
IF (NEQ_PLT>0) THEN
- CALL CH_PRODLOSS(TDTCUR%TIME,ZCHEM,ZPRODTOT,ZLOSSTOT,IMI,ISVECNPT,NEQ)
+ CALL CH_PRODLOSS(TDTCUR%xtime,ZCHEM,ZPRODTOT,ZLOSSTOT,IMI,ISVECNPT,NEQ)
DO JM=1, NEQ_PLT
DO JN=1,ISVECNPT
ZPROD(JN,JM)=ZPRODTOT(JN,NIND_SPEC(JM))
@@ -1141,7 +1156,7 @@ DO JL=1,ISVECNMASK
! filter selected species
!
IF (NEQ_BUDGET>0) THEN
- CALL CH_TERMS(TDTCUR%TIME,ZCHEM,ZTCHEMTOT,IMI,ISVECNPT,NEQ,NREAC)
+ CALL CH_TERMS(TDTCUR%xtime,ZCHEM,ZTCHEMTOT,IMI,ISVECNPT,NEQ,NREAC)
DO JM=1,NEQ_BUDGET
DO JN=1,ISVECNPT
JS=1
@@ -1276,12 +1291,12 @@ DO JSV = 1, SIZE(XSVT,4)
XRSVS(:,:,:,JSV) = MAX((XRSVS(:,:,:,JSV)),XSVMIN(JSV))
END DO
!
-IF (LBUDGET_SV) THEN
- DO JSV=NSV_CHEMBEG,NSV_CHEMEND
- CALL BUDGET(XRSVS(:,:,:,JSV),JSV+12,'CHEM_BU_RSV')
- ENDDO
-ENDIF
-!
+if ( lbudget_sv ) then
+ do jsv = nsv_chembeg, nsv_chemend
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'CHEM', xrsvs(:, :, :, jsv) )
+ enddo
+endif
+
!----------------------------------------------------------------------
!
IF ((CPROGRAM =='DIAG ').OR.(L1D)) THEN
diff --git a/src/MNH/ch_read_meteo.f90 b/src/MNH/ch_read_meteo.f90
deleted file mode 100644
index 8dc06a98dd27c05f5e30a085a47944a0e3f1327f..0000000000000000000000000000000000000000
--- a/src/MNH/ch_read_meteo.f90
+++ /dev/null
@@ -1,83 +0,0 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed 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_CH_READ_METEO
-!! #########################
-!
-INTERFACE
-SUBROUTINE CH_READ_METEO(TPM)
-USE MODD_CH_M9_n, ONLY: METEOTRANSTYPE
-IMPLICIT NONE
-TYPE(METEOTRANSTYPE), INTENT(INOUT) :: TPM
-END SUBROUTINE CH_READ_METEO
-END INTERFACE
-END MODULE MODI_CH_READ_METEO
-!!
-!! #############################
- SUBROUTINE CH_READ_METEO(TPM)
-!! #############################
-!!
-!!*** *CH_READ_METEO*
-!!
-!! PURPOSE
-!! -------
-!! Read a set of meteo variables
-!!
-!!** METHOD
-!! ------
-!! read NMETEOVARS values and the time for the next update XTNEXTMETEO
-!!
-!! AUTHOR
-!! ------
-!! K. Suhre
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 21/04/95
-!! 27/07/96 (K. Suhre) restructured
-!! 01/12/03 (D. Gazen) change Chemical scheme interface
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-USE MODD_CH_MODEL0D, ONLY: TMETEOFILE, XTNEXTMETEO, NVERB
-USE MODD_CH_M9_n, ONLY: NMETEOVARS, METEOTRANSTYPE
-!!
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! -----------------
-IMPLICIT NONE
-!
-!* 0.1 declaration of arguments
-!
-TYPE(METEOTRANSTYPE), INTENT(INOUT) :: TPM ! the meteo variables
-!
-!* 0.2 declaration of local variables
-! ----------------
-INTEGER :: JI ! loop control
-!
-!------------------------------------------------------------------------------
-!
-!* EXECUTABLE STATEMENTS
-! ---------------------
-!
-! read meteo variables and time of next update
-READ(TMETEOFILE%NLU,*) (TPM%XMETEOVAR(JI), JI = 1, NMETEOVARS)
-READ(TMETEOFILE%NLU,*) XTNEXTMETEO
-!
-! print what has been read
-IF (NVERB >= 7) THEN
- PRINT *, 'CH_READ_METEO: new set of meteo variables has been read:'
- DO JI = 1, NMETEOVARS
- PRINT *, TPM%CMETEOVAR(JI), ': ', TPM%XMETEOVAR(JI)
- ENDDO
-END IF
-IF (NVERB >= 5) THEN
- PRINT *, 'CH_READ_METEO: next update at XTNEXTMETEO = ', XTNEXTMETEO
-END IF
-!
-END SUBROUTINE CH_READ_METEO
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/compare_dad.f90 b/src/MNH/compare_dad.f90
index 4efd6a8f42c57b2b6a6e606bbdd3f4fba22d9ebe..fe145cee49c3dc81433344f9e26cebddcc46f57c 100644
--- a/src/MNH/compare_dad.f90
+++ b/src/MNH/compare_dad.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2004-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -66,11 +66,12 @@ END MODULE MODI_COMPARE_DAD
!
!
USE MODD_CONF
+use modd_field, only: tfielddata, tfieldlist
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, NMNHNAMELGTMAX
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_GRIDPROJ
diff --git a/src/MNH/compute_entr_detr.f90 b/src/MNH/compute_entr_detr.f90
index b003c68304cf06fbe4ea46b95511b79bda407fd6..80a9d68db57ef58f31574c47e144887ab441ce7a 100644
--- a/src/MNH/compute_entr_detr.f90
+++ b/src/MNH/compute_entr_detr.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.
@@ -120,20 +120,21 @@ END MODULE MODI_COMPUTE_ENTR_DETR
!! improvement of continuity at the condensation level
!! S. Riette Nov 2013: protection against zero divide for min value of dry PDETR
!! R.Honnert Oct 2016 : Update with AROME
-! P. Wautelet 08/02/2019: bug fix: compute ZEPSI_CLOUD only once and only when it is needed
+! P. Wautelet 08/02/2019: bugfix: compute ZEPSI_CLOUD only once and only when it is needed
+! P. Wautelet 10/02/2021: bugfix: initialized PPART_DRY everywhere
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST
-!
USE MODD_PARAM_MFSHALL_n
-!
-USE MODI_TH_R_FROM_THL_RT_1D
+USE MODD_PARAMETERS, ONLY: XUNDEF
USE MODE_THERMO
+USE MODI_TH_R_FROM_THL_RT_1D
+
IMPLICIT NONE
!
!
@@ -234,6 +235,10 @@ INTEGER :: JI,JLOOP
ZMIXTHL(:)=0.1
ZMIXRT(:)=0.1
+ !Initialize PPART_DRY everywhere to prevent access to non-initialized values
+ ! (intent(out) arrays have undefined values at subroutine entry)
+ PPART_DRY(:) = XUNDEF
+
! 1.4 Estimation of PPART_DRY
DO JLOOP=1,SIZE(OTEST)
IF(OTEST(JLOOP) .AND. OTESTLCL(JLOOP)) THEN
diff --git a/src/MNH/compute_mf_cloud.f90 b/src/MNH/compute_mf_cloud.f90
index 28ce08a6cd318ccd58bf8cf8460a1ae1fe0eff3c..23f94bce58fd8595d043f8050b86189873745c78 100644
--- a/src/MNH/compute_mf_cloud.f90
+++ b/src/MNH/compute_mf_cloud.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2009-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -180,7 +180,7 @@ ELSEIF (HMF_CLOUD == 'STAT') THEN
ELSEIF (HMF_CLOUD == 'BIGA') THEN
!Statistical scheme using the bi-gaussian PDF proposed by E. Perraud.
CALL COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
- &PRC_UP, PRI_UP, PEMF, PDEPTH,&
+ &PEMF, PDEPTH,&
&PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
&PRTM, PTHM, PTHVM,&
&PDZZ, PZZ, PRHODREF,&
diff --git a/src/MNH/compute_mf_cloud_bigaus.f90 b/src/MNH/compute_mf_cloud_bigaus.f90
index 8d158567b1cd1203644c0c27d2763aa05a0b8959..b080f9923a6aff7ef04af89ddcaba2d4a6ca6405 100644
--- a/src/MNH/compute_mf_cloud_bigaus.f90
+++ b/src/MNH/compute_mf_cloud_bigaus.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
! ###################################
@@ -9,7 +10,7 @@
INTERFACE
! #################################################################
SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
- PRC_UP, PRI_UP, PEMF, PDEPTH,&
+ PEMF, PDEPTH,&
PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
PRTM, PTHM, PTHVM,&
PDZZ, PZZ, PRHODREF,&
@@ -24,7 +25,7 @@ INTEGER, INTENT(IN) :: KKB ! near ground physical inde
INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
@@ -40,8 +41,8 @@ END INTERFACE
!
END MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
! ######spl
- SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU,KKL,&
- PRC_UP, PRI_UP, PEMF, PDEPTH,&
+ SUBROUTINE COMPUTE_MF_CLOUD_BIGAUS(KKA, KKB, KKE, KKU, KKL,&
+ PEMF, PDEPTH,&
PRT_UP, PTHV_UP, PFRAC_ICE_UP, PRSAT_UP,&
PRTM, PTHM, PTHVM,&
PDZZ, PZZ, PRHODREF,&
@@ -83,6 +84,7 @@ END MODULE MODI_COMPUTE_MF_CLOUD_BIGAUS
!! -------------
!! Original 25 Aug 2011
!! S. Riette Jan 2012: support for both order of vertical levels
+!! S. Riette Jun 2019: remove unused PRC_UP and PRI_UP, use SIGN in ERFC computation
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -105,7 +107,7 @@ INTEGER, INTENT(IN) :: KKB ! near ground physical inde
INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-REAL, DIMENSION(:,:), INTENT(IN) :: PRC_UP,PRI_UP,PEMF ! updraft characteritics
+REAL, DIMENSION(:,:), INTENT(IN) :: PEMF ! updraft characteritics
REAL, DIMENSION(:), INTENT(IN) :: PDEPTH ! Deepness of cloud
REAL, DIMENSION(:,:), INTENT(IN) :: PTHV_UP, PRSAT_UP, PRT_UP ! updraft characteritics
REAL, DIMENSION(:,:), INTENT(IN) :: PFRAC_ICE_UP ! liquid/ice fraction in updraft
@@ -125,8 +127,7 @@ REAL, DIMENSION(SIZE(PTHM,1)) :: ZOMEGA_UP_M !
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW1 ! working array
INTEGER :: JK ! vertical loop control
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZEMF_M, ZTHV_UP_M, & !
- & ZRSAT_UP_M, ZRC_UP_M,& ! Interpolation on mass points
- & ZRI_UP_M, ZRT_UP_M,& !
+ & ZRSAT_UP_M, ZRT_UP_M,& ! Interpolation on mass points
& ZFRAC_ICE_UP_M !
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOND ! condensate
REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZA, ZGAM ! used for integration
@@ -146,8 +147,6 @@ ZGRAD_Z_RT(:,:)=MZF_MF(KKA,KKU,KKL, ZW1(:,:))
!Interpolation on mass points
ZTHV_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PTHV_UP(:,:))
ZRSAT_UP_M(:,:)= MZF_MF(KKA,KKU,KKL, PRSAT_UP(:,:))
-ZRC_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRC_UP(:,:))
-ZRI_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRI_UP(:,:))
ZRT_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PRT_UP(:,:))
ZEMF_M(:,:) = MZF_MF(KKA,KKU,KKL, PEMF(:,:))
ZFRAC_ICE_UP_M(:,:) = MZF_MF(KKA,KKU,KKL, PFRAC_ICE_UP(:,:))
@@ -194,25 +193,8 @@ ZSIGMF(:,:)=SQRT(MAX(ABS(ZSIGMF(:,:)), 1.E-40))
!Computation of ZA and ZGAM (=efrc(ZA)) coefficient
ZA(:,:)=(ZRSAT_UP_M(:,:)-ZRT_UP_M(:,:))/(sqrt(2.)*ZSIGMF(:,:))
-!erf computed by an incomplete gamma function approximation
-!DO JK=KKA,KKU,KKL
-! DO JI=1, SIZE(PCF_MF,1)
-! IF(ZA(JI,JK)>1E-20) THEN
-! ZGAM(JI,JK)=1-GAMMA_INC(0.5,ZA(JI,JK)**2)
-! ELSEIF(ZA(JI,JK)<-1E-20) THEN
-! ZGAM(JI,JK)=1+GAMMA_INC(0.5,ZA(JI,JK)**2)
-! ELSE
-! ZGAM(JI,JK)=1
-! ENDIF
-! ENDDO
-!ENDDO
-
-!alternative approximation of erf function (better for vectorisation)
-WHERE(ZA(:,:)>0)
- ZGAM(:,:)=1-SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
-ELSEWHERE
- ZGAM(:,:)=1+SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
-ENDWHERE
+!Approximation of erf function
+ZGAM(:,:)=1-SIGN(1., ZA(:,:))*SQRT(1-EXP(-4*ZA(:,:)**2/XPI))
!computation of cloud fraction
PCF_MF(:,:)=MAX( 0., MIN(1.,0.5*ZGAM(:,:) * ZALPHA_UP_M(:,:)))
diff --git a/src/MNH/compute_press_from_oceanbot.f90 b/src/MNH/compute_press_from_oceanbot.f90
new file mode 100644
index 0000000000000000000000000000000000000000..56c8f6b6e48442061e3278906a0641f7f935b942
--- /dev/null
+++ b/src/MNH/compute_press_from_oceanbot.f90
@@ -0,0 +1,225 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #####################################
+ MODULE MODI_COMPUTE_PRESS_FROM_OCEANBOT
+! #####################################
+INTERFACE COMPUTE_PRESS_FROM_OCEANBOT
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D(PRHO,PZFLUX,PSURF2D, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:), INTENT(IN) :: PSURF2D ! bottom pressure
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! press at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! press at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D
+!
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT1D(PRHO,PZFLUX,PSURF, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHO ! virtual potential temperature
+REAL, DIMENSION(:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, INTENT(IN) :: PSURF ! botttom press function
+REAL, DIMENSION(:), INTENT(OUT) :: PFLUX ! press at flux points
+REAL, DIMENSION(:), INTENT(OUT) :: PMASS ! press at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT1D
+!
+END INTERFACE
+END MODULE MODI_COMPUTE_PRESS_FROM_OCEANBOT
+! ######################################
+ MODULE MODI_COMPUTE_PRESS_FROM_OCEANBOT3D
+! ######################################
+INTERFACE
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D(PRHO,PZFLUX,PSURF2D, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:), INTENT(IN) :: PSURF2D! bot press function
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! bot press at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! bot press at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D
+!
+END INTERFACE
+END MODULE MODI_COMPUTE_PRESS_FROM_OCEANBOT3D
+! ########################################################################
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D(PRHO,PZFLUX,PSURF2D,PFLUX,PMASS)
+! ########################################################################
+!
+!!**** *COMPUTE_EXNER_FROM_OCEANBOT3D* - computation of hydrostatic
+!! pressure from ocean bottom
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! 1 The local pressure is computed at flux points by integration of the hydrostatic
+!! relation from ground (PSURF2D) to top.
+!!
+!! dP= -g rho dz
+!!
+!! 2 The pressure at mass level is computed as follows and linearly
+!! extrapolated for the uppest non-physical level:
+!!
+!! ~ P(k+1)-P(k)
+!! P(k) = -----------------------
+!! lnP(k+1)-lnP(k)
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CST : contains physical constants
+!! XG : gravity constant
+!! Module MODD_PARAMETERS
+!! JPVEXT
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! JLR
+!! MODIFICATIONS
+!! -------------
+!! Original Fev2021
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XG
+USE MODD_PARAMETERS, ONLY : JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:) , INTENT(IN) :: PSURF2D! bottom pressuren
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! pres at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! pres at mass points
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+INTEGER :: IKB,IKU,JK
+!-------------------------------------------------------------------------------
+!* 1. INITIALIZATIONS
+! ---------------
+IKB=JPVEXT+1
+IKU=SIZE(PZFLUX,3)
+!-------------------------------------------------------------------------------
+!* 2. COMPUTATION OF PRESSURE AT FLUX POINTS
+! ------------------------------------------------
+PFLUX(:,:,IKB)=PSURF2D(:,:)
+!
+ DO JK=IKB+1,IKU
+ PFLUX(:,:,JK)=PFLUX(:,:,JK-1) + XG*PRHO(:,:,JK-1)*(PZFLUX(:,:,JK-1)-PZFLUX(:,:,JK))
+ END DO
+ DO JK=IKB-1,1,-1
+ PFLUX(:,:,JK)=PFLUX(:,:,JK+1) + XG*PRHO(:,:,JK) *(PZFLUX(:,:,JK+1)-PZFLUX(:,:,JK))
+ END DO
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTATION OF Pressure AT MASS POINTS
+! --------------------------------------------
+ PMASS(:,:,1:IKU-1)=(PFLUX(:,:,1:IKU-1)+PFLUX(:,:,2:IKU))*.5
+! (PFLUX(:,:,1:IKU-1)-PFLUX(:,:,2:IKU)) &
+! /(LOG(PFLUX(:,:,1:IKU-1))-LOG(PFLUX(:,:,2:IKU)))
+!
+!accute extrapolation not possible as level IKU is in atmosphere. Assume rho_air=1.2
+ PMASS(:,:,IKU)= PMASS(:,:,IKU-1) - XG*1.2 * ( PZFLUX(:,:,IKU)-PZFLUX(:,:,IKU-1) )
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT3D
+! ######################################################################
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT1D(PRHO,PZFLUX,PSURF,PFLUX,PMASS)
+! ######################################################################
+!
+!!**** *COMPUTE_PRESS_FROM_OCEANBOT1D* - computation of hydrostatic press eq
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! V.Masson Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/03/96
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_COMPUTE_PRESS_FROM_OCEANBOT3D
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHO ! virtual potential temperature
+REAL, DIMENSION(:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, INTENT(IN) :: PSURF ! ground Exner function
+REAL, DIMENSION(:), INTENT(OUT) :: PFLUX ! Exner function at flux points
+REAL, DIMENSION(:), INTENT(OUT) :: PMASS ! Exner function at mass points
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+REAL, DIMENSION(1,1,SIZE(PZFLUX)) :: ZRHO ! virtual potential temperature
+REAL, DIMENSION(1,1,SIZE(PZFLUX)) :: ZZFLUX ! altitude of flux points
+REAL, DIMENSION(1,1) :: ZPSURF ! ground Exner function
+REAL, DIMENSION(1,1,SIZE(PZFLUX)) :: ZPFLUX ! Exner function at flux points
+REAL, DIMENSION(1,1,SIZE(PZFLUX)) :: ZPMASS ! Exner function at mass points
+!
+!-------------------------------------------------------------------------------
+!
+ZRHO(1,1,:)=PRHO(:)
+ZZFLUX(1,1,:)=PZFLUX(:)
+ZPSURF(1,1)=PSURF
+!
+CALL COMPUTE_PRESS_FROM_OCEANBOT3D(ZRHO,ZZFLUX,ZPSURF,ZPFLUX,ZPMASS)
+!
+PFLUX(:)=ZPFLUX(1,1,:)
+PMASS(:)=ZPMASS(1,1,:)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANBOT1D
+
diff --git a/src/MNH/compute_press_from_oceansfc.f90 b/src/MNH/compute_press_from_oceansfc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d9ec184431ff06f994644c61d5acd7203bac6eaf
--- /dev/null
+++ b/src/MNH/compute_press_from_oceansfc.f90
@@ -0,0 +1,238 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##################################
+ MODULE MODI_COMPUTE_PRESS_FROM_OCEANSFC
+! ##################################
+INTERFACE COMPUTE_PRESS_FROM_OCEANSFC
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D(PRHO,PZFLUX,PTOP2D, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:) , INTENT(IN) :: PTOP2D ! 2D Pressure at domain top
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! Pressure at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! Pressure at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D
+!
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC1D(PRHO,PZFLUX,PTOP, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, INTENT(IN) :: PTOP ! Pressure at domain top
+REAL, DIMENSION(:), INTENT(OUT) :: PFLUX ! Pressure at flux points
+REAL, DIMENSION(:), INTENT(OUT) :: PMASS ! Pressure at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC1D
+END INTERFACE
+END MODULE MODI_COMPUTE_PRESS_FROM_OCEANSFC
+! ####################################
+ MODULE MODI_COMPUTE_PRESS_FROM_OCEANSFC3D
+! ####################################
+INTERFACE
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D(PRHO,PZFLUX,PTOP2D, &
+ PFLUX,PMASS)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:) , INTENT(IN) :: PTOP2D ! Pressure at top domain
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! Pressure at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! Pressure at mass points
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D
+END INTERFACE
+END MODULE MODI_COMPUTE_PRESS_FROM_OCEANSFC3D
+! ####################################################################
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D(PRHO,PZFLUX,PTOP2D,PFLUX,PMASS)
+! ####################################################################
+!
+!!**** *COMPUTE_PRESS_FROM_OCEANSFC3D* - computation of hydrostatic
+!! from model top
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! 1 The local Exner function in computed by integration of the hydrostatic
+!! relation from top (PEXNTOP2D) to bottom.
+!!
+!! dPI= -g/(Cpd thetav) dz
+!!
+!! 2 The Exner function at mass level is computed as follows and linearly
+!! extrapolated for the uppest non-physical level:
+!!
+!! ~ PI(k+1)-PI(k)
+!! PI(k) = -----------------------
+!! lnPI(k+1)-lnPI(k)
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF : contains configuration variables for all models.
+!! NVERB : verbosity level for output-listing
+!! LTHINSHELL : logical for thinshell approximation
+!! Module MODD_LUNIT : contains logical unit names for all models
+!! CLUOUT0 : name of output-listing
+!! Module MODD_CST : contains physical constants
+!! XG : gravity constant
+!! XCPD: specific heat for dry air at constant pressure
+!! XRD : gas constant for dry air
+!! Module MODD_PARAMETERS
+!! JPVEXT,JPHEXT
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!! JLR
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/01/21
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XG
+USE MODD_PARAMETERS, ONLY : JPVEXT
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO ! density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, DIMENSION(:,:) , INTENT(IN) :: PTOP2D ! Pressure at domain
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFLUX ! Pressure at flux points
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMASS ! Pressure at mass points
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: IKB,IKE,IKU,JK
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZATIONS
+! ---------------
+!
+IKB=JPVEXT+1
+IKE=SIZE(PZFLUX,3)-JPVEXT
+IKU=SIZE(PZFLUX,3)
+!-------------------------------------------------------------------------------
+!* 2. COMPUTATION OF PRESSURE AT FLUX POINTS
+! ------------------------------------------------
+PFLUX(:,:,IKE+1)=PTOP2D(:,:)
+!
+ DO JK=IKE,1,-1
+ PFLUX(:,:,JK) = PFLUX(:,:,JK+1) + XG*PRHO(:,:,JK)*(PZFLUX(:,:,JK+1)-PZFLUX(:,:,JK))
+ END DO
+ DO JK=IKE+2,SIZE(PFLUX,3)
+ PFLUX(:,:,JK) = PFLUX(:,:,JK-1) + XG*PRHO(:,:,JK-1)*(PZFLUX(:,:,JK-1)-PZFLUX(:,:,JK))
+ END DO
+!-------------------------------------------------------------------------------
+!
+!* 3. COMPUTATION OF PRESSURE AT MASS POINTS
+! --------------------------------------------
+ PMASS(:,:,1:IKU-1)=(PFLUX(:,:,1:IKU-1)-PFLUX(:,:,2:IKU)) &
+ /(LOG(PFLUX(:,:,1:IKU-1))-LOG(PFLUX(:,:,2:IKU)))
+!accute extrapolation not possible as level IKU is in atmosphere. Assume rho_air=1.2
+ PMASS(:,:,IKU)= PMASS(:,:,IKU-1) - XG*1.2 * ( PZFLUX(:,:,IKU)-PZFLUX(:,:,IKU-1) )
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC3D
+! ##################################################################
+ SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC1D(PRHOD,PZFLUX,PTOP,PFLUX,PMASS)
+! ##################################################################
+!
+!!**** *COMPUTE_PRESS_FROM_OCEANSFC1D* - computation of hydrostatic
+!! Pressure from model top
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! JLR
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/01/21
+!-----------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODI_COMPUTE_PRESS_FROM_OCEANSFC3D
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRHOD ! virtual potential temperature
+REAL, DIMENSION(:), INTENT(IN) :: PZFLUX ! altitude of flux points
+REAL, INTENT(IN) :: PTOP ! top pressure
+REAL, DIMENSION(:), INTENT(OUT) :: PFLUX ! Pressure at flux points
+REAL, DIMENSION(:), INTENT(OUT) :: PMASS ! Pressure at mass points
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+!JUAN
+REAL, DIMENSION(3,1,SIZE(PZFLUX)) :: ZRHOD ! virtual potential temperature
+REAL, DIMENSION(3,1,SIZE(PZFLUX)) :: ZZFLUX ! altitude of flux points
+REAL, DIMENSION(3,1) :: ZPTOP ! top pressure
+REAL, DIMENSION(3,1,SIZE(PZFLUX)) :: ZPFLUX ! Pressure at flux points
+REAL, DIMENSION(3,1,SIZE(PZFLUX)) :: ZPMASS ! Pressure at mass points
+INTEGER :: JI ! loop index in I
+!JUAN
+!
+!-------------------------------------------------------------------------------
+!
+!JUAN
+DO JI=1,3
+ZRHOD(JI,1,:)=PRHOD(:)
+ZZFLUX(JI,1,:)=PZFLUX(:)
+ZPTOP(JI,1)=PTOP
+END DO
+!JUAN
+
+!
+CALL COMPUTE_PRESS_FROM_OCEANSFC3D(ZRHOD,ZZFLUX,ZPTOP,ZPFLUX,ZPMASS)
+!
+PFLUX(:)=ZPFLUX(2,1,:)
+PMASS(:)=ZPMASS(2,1,:)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE COMPUTE_PRESS_FROM_OCEANSFC1D
diff --git a/src/MNH/compute_r00.f90 b/src/MNH/compute_r00.f90
index f04fff457b412175924dfa7147d68667846ae4f9..692fb3a1e0d1b8c90710f2d086f5bd37565c2962 100644
--- a/src/MNH/compute_r00.f90
+++ b/src/MNH/compute_r00.f90
@@ -65,6 +65,7 @@ END MODULE MODI_COMPUTE_R00
!
USE MODD_CONF
USE MODD_GRID_n
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_FIELD_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n
@@ -74,7 +75,6 @@ USE MODD_STO_FILE
USE MODD_TYPE_DATE
USE MODD_VAR_ll
!
-USE MODE_FIELD
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
@@ -256,12 +256,12 @@ DO JFILECUR=1,NFILES
IF (GSTART) THEN
!
CALL IO_Field_read(TZTRACFILE,'DTCUR',TDTCUR_START)
- IHOUR = INT(TDTCUR_START%TIME/3600.)
- ZREMAIN = MOD(TDTCUR_START%TIME,3600.)
+ IHOUR = INT(TDTCUR_START%xtime/3600.)
+ ZREMAIN = MOD(TDTCUR_START%xtime,3600.)
IMINUTE = INT(ZREMAIN/60.)
ZSECOND = MOD(ZREMAIN,60.)
WRITE(YDATE,FMT='(1X,I4.4,I2.2,I2.2,2X,I2.2,"H",I2.2,"M", &
- & F5.2,"S")') TDTCUR_START%TDATE, IHOUR,IMINUTE,ZSECOND
+ & F5.2,"S")') TDTCUR_START%nyear, TDTCUR_START%nmonth, TDTCUR_START%nday, IHOUR,IMINUTE,ZSECOND
!
CALL IO_Field_read(TZTRACFILE,'THT',ZTH0(:,:,:))
!
diff --git a/src/MNH/compute_updraft_hrio.f90 b/src/MNH/compute_updraft_hrio.f90
deleted file mode 100644
index adccc8ca9fe3a2469fb42f78e4b15aa2268aef7a..0000000000000000000000000000000000000000
--- a/src/MNH/compute_updraft_hrio.f90
+++ /dev/null
@@ -1,868 +0,0 @@
-!MNH_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######spl
- MODULE MODI_COMPUTE_UPDRAFT_HRIO
-! ###########################
-!
-INTERFACE
-!
-! #################################################################
- SUBROUTINE COMPUTE_UPDRAFT_HRIO(KKA,KKB,KKE,KKU,KKL, HFRAC_ICE, &
- OENTR_DETR,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PZZ,PDZZ, &
- PSFTH,PSFRV, &
- PPABSM,PRHODREF,PUM,PVM,PTKEM,PWM,&
- PTHM,PRVM,PTHLM,PRTM, &
- PSVM,PTHL_UP,PRT_UP, &
- PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
- PW_UP,PU_UP, PV_UP, PSV_UP, &
- PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
- PTHL_DO, PTHV_DO, PRT_DO, &
- PU_DO, PV_DO, PSV_DO, &
- PEMF,PDETR,PENTR, &
- PBUO_INTEG,KKLCL,KKETL,KKCTL, &
- PDEPTH)
-! #################################################################
-!
-!* 1.1 Declaration of Arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
-LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
-INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
-INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
-
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
-! normal surface fluxes of theta,rv,(u,v) parallel to the orography
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PWM ! w mean wind
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
- PRI_UP,PTHV_UP,& ! updraft ri, THv
- PW_UP,PFRAC_UP,& ! updraft w, fraction
- PFRAC_ICE_UP,& ! liquid/solid fraction in updraft
- PRSAT_UP ! Rsat
-REAL, DIMENSION(:,:), INTENT(INOUT):: PTHL_DO,PTHV_DO,PRT_DO,PU_DO,PV_DO
-
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_DO ! downdraft scalar var.
-
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
- ! entrainment, detrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT):: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
-
-
-END SUBROUTINE COMPUTE_UPDRAFT_HRIO
-
-END INTERFACE
-!
-END MODULE MODI_COMPUTE_UPDRAFT_HRIO! ######spl
- SUBROUTINE COMPUTE_UPDRAFT_HRIO(KKA,KKB,KKE,KKU,KKL,HFRAC_ICE, &
- OENTR_DETR,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PZZ,PDZZ, &
- PSFTH,PSFRV, &
- PPABSM,PRHODREF,PUM,PVM,PTKEM,PWM, &
- PTHM,PRVM,PTHLM,PRTM, &
- PSVM,PTHL_UP,PRT_UP, &
- PRV_UP,PRC_UP,PRI_UP,PTHV_UP, &
- PW_UP,PU_UP, PV_UP, PSV_UP, &
- PFRAC_UP,PFRAC_ICE_UP,PRSAT_UP, &
- PTHL_DO, PTHV_DO, PRT_DO, &
- PU_DO, PV_DO, PSV_DO, &
- PEMF,PDETR,PENTR, &
- PBUO_INTEG,KKLCL,KKETL,KKCTL, &
- PDEPTH )
-! #################################################################
-!!
-!!**** *COMPUTE_UPDRAFT_HRIO* - calculates caracteristics of the updraft
-!!
-!!
-!! PURPOSE
-!! -------
-!!**** The purpose of this routine is to build the updraft model
-!!
-!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! !! REFERENCE
-!! ---------
-!! Book 1 of Meso-NH documentation (chapter Turbulence)
-!! Soares et al. 2004 QJ
-!!
-!! AUTHOR
-!! ------
-!! J.Pergaud
-!! V.Masson : Optimization 07/2010
-!! S. Riette : 07/2010 : modification for reproducibility
-!! S. Riette may 2011: ice added, interface modified
-!! S. Riette Jan 2012: support for both order of vertical levels
-!! V.Masson, C.Lac : 02/2011 : SV_UP initialized by a non-zero value
-!! Q.Rodier 01/2019 : support RM17 mixing length
-! P. Wautelet 12/04/2019: replace ABORT and STOP calls by Print_msg
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_PARAM_MFSHALL_n, ONLY : XPRES_UV,XALP_PERT,XCMF,XFRAC_UP_MAX,XA1,XB,&
- XC,XBETA1
-!USE MODD_CMFSHALL, ONLY : XPRES_UV,XALP_PERT,XCMF,XFRAC_UP_MAX,XA1,XALPHA_SEUIL,LNORM_RESOL,&
-! XCOEF1,XCOEF2,XCOEF3,NBUOY,XB,&
-! XC,XBETA1
-USE MODD_GRID_n, ONLY : XDXHAT, XDYHAT
-USE MODD_BLANK
-USE MODD_TURB_n, ONLY :CTURBLEN
-
-use mode_msg
-
-!USE MODI_COMPUTE_ENTR_DETR
-USE MODI_TH_R_FROM_THL_RT_1D
-USE MODI_SHUMAN_MF
-
-USE MODI_COMPUTE_BL89_ML
-
-IMPLICIT NONE
-
-!* 1.1 Declaration of Arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KKA ! near ground array index
-INTEGER, INTENT(IN) :: KKB ! near ground physical index
-INTEGER, INTENT(IN) :: KKE ! uppest atmosphere physical index
-INTEGER, INTENT(IN) :: KKU ! uppest atmosphere array index
-INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
-CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE ! partition liquid/ice scheme
-LOGICAL, INTENT(IN) :: OENTR_DETR! flag to recompute entrainment, detrainment and mass flux
-LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: ONOMIXLG ! False if mixing of lagrangian tracer
-INTEGER, INTENT(IN) :: KSV_LGBEG ! first index of lag. tracer
-INTEGER, INTENT(IN) :: KSV_LGEND ! last index of lag. tracer
-! FAUX dans AROME, mais pas grave dans la paramétrisation
-REAL, DIMENSION(:,:), INTENT(IN) :: PZZ ! Height at the flux point
-REAL, DIMENSION(:,:), INTENT(IN) :: PDZZ ! Metrics coefficient
-
-REAL, DIMENSION(:), INTENT(IN) :: PSFTH,PSFRV
-! normal surface fluxes of theta,rv,(u,v) parallel to the orography
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PPABSM ! Pressure at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRHODREF ! dry density of the
- ! reference state
-REAL, DIMENSION(:,:), INTENT(IN) :: PUM ! u mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PVM ! v mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PWM ! w mean wind
-REAL, DIMENSION(:,:), INTENT(IN) :: PTKEM ! TKE at t-dt
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHM ! liquid pot. temp. at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PRVM ! vapor mixing ratio at t-dt
-REAL, DIMENSION(:,:), INTENT(IN) :: PTHLM,PRTM ! cons. var. at t-dt
-
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVM ! scalar var. at t-dt
-
-REAL, DIMENSION(:,:), INTENT(OUT) :: PTHL_UP,PRT_UP ! updraft properties
-REAL, DIMENSION(:,:), INTENT(OUT) :: PU_UP, PV_UP ! updraft wind components
-REAL, DIMENSION(:,:), INTENT(INOUT):: PRV_UP,PRC_UP, & ! updraft rv, rc
- PRI_UP,PTHV_UP,& ! updraft ri, THv
- PW_UP,PFRAC_UP,& ! updraft w, fraction
- PFRAC_ICE_UP,& ! liquid/solid fraction in updraft
- PRSAT_UP ! Rsat
-REAL, DIMENSION(:,:), INTENT(INOUT):: PTHL_DO,PTHV_DO,PRT_DO,PU_DO,PV_DO ! environment var.
-
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_UP ! updraft scalar var.
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSV_DO ! environment scalar var.
-
-REAL, DIMENSION(:,:), INTENT(INOUT):: PEMF,PDETR,PENTR ! Mass_flux,
- ! detrainment,entrainment
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PBUO_INTEG ! Integrated Buoyancy
-INTEGER, DIMENSION(:), INTENT(INOUT) :: KKLCL,KKETL,KKCTL! LCL, ETL, CTL
-REAL, DIMENSION(:), INTENT(OUT) :: PDEPTH ! Deepness of cloud
-! 1.2 Declaration of local variables
-!
-!
-! Mean environment variables at t-dt at flux point
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
- ZTHM_F,ZRVM_F ! Theta,rv of
- ! updraft environnement
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
- ZRTM_F, ZTHLM_F, ZTKEM_F,& ! rt, thetal,TKE,pressure,
- ZUM_F,ZVM_F,ZRHO_F, & ! density,momentum
- ZPRES_F,ZTHVM_F,ZTHVM, & ! interpolated at the flux point
- ZG_O_THVREF, & ! g*ThetaV ref
- ZW_UP2 ! w**2 of the updraft
-!==================================================================================
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZW_UP ! w of the updraft
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZWM_M ! w at mass levels
-
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PTHM,2),SIZE(PSVM,3)) :: &
- ZSVM_F ! scalar variables
-
-
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: &
- ZTH_UP, & ! updraft THETA
- ZRC_MIX, ZRI_MIX ! guess of Rc and Ri for KF mixture
-!==================================================================================
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: PTHVREF ! THv de référence
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZBUO ! Buoyancy
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZZDZ ! Dz
-!==================================================================================
-
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZCOEF ! diminution coefficient for too high clouds
-
-REAL, DIMENSION(SIZE(PSFTH,1) ) :: ZWTHVSURF ! Surface w'thetav'
-
-REAL :: ZRDORV ! RD/RV
-REAL :: ZRVORD ! RV/RD
-
-
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZMIX1,ZMIX2
-
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZLUP ! Upward Mixing length from the ground
-
-INTEGER :: ISV ! Number of scalar variables
-INTEGER :: JK,JI,JSV ! loop counters
-
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GTEST,GTESTLCL,GTESTETL
- ! Test if the ascent continue, if LCL or ETL is reached
-LOGICAL :: GLMIX
- ! To choose upward or downward mixing length
-LOGICAL, DIMENSION(SIZE(PTHM,1)) :: GWORK1
-LOGICAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: GWORK2
-
-INTEGER :: ITEST
-
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZRC_UP, ZRI_UP, ZRV_UP, ZRSATW, ZRSATI
-!==================================================================================
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZWUP_MEAN !
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZCOE,ZWCOE,ZBUCOE
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZDETR_BUO, ZDETR_RT
-!==================================================================================
-
-REAL :: ZDEPTH_MAX1, ZDEPTH_MAX2 ! control auto-extinction process
-REAL :: XFRAC_LIM ! surface maximale du thermique
-
-REAL :: ZTMAX,ZRMAX, ZEPS ! control value
-
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2)) :: ZSHEAR,ZDUDZ,ZDVDZ ! vertical wind shear
-! pour le calcul de la resolution normalisée
-REAL, DIMENSION(SIZE(PTHM,1)) :: ZA1, ZRESOL_NORM
-REAL :: ZRESOL_GRID
-REAL, DIMENSION(SIZE(PTHM,1)) :: MODIF
-!
-
-INTEGER :: KTCOUNT_MF ! current model time-step
-REAL, DIMENSION (:), ALLOCATABLE :: ZWORK
-!
-!* 0.3 Declaration of namelists
-! ------------------------
-!
-!----------------------------------------------------------------------------
-
-! Thresholds for the perturbation of
-! theta_l and r_t at the first level of the updraft
-
-ZTMAX=2.0
-ZRMAX=1.E-3
-ZEPS=1.E-15
-XFRAC_LIM=0.5
-!
-!------------------------------------------------------------------------
-
-! INITIALISATION
-
-! Initialisation of the constants
-ZRDORV = XRD / XRV !=0.622
-ZRVORD = (XRV / XRD)
-
-ZDEPTH_MAX1=3000. ! clouds with depth inferior to this value are keeped untouched
-ZDEPTH_MAX2=4000. ! clouds with depth superior to this value are suppressed
-
-! Local variables, internal domain
-! Internal Domain
-
-!number of scalar variables
-ISV=SIZE(PSVM,3)
-
-IF (OENTR_DETR) THEN
- ! si on prend en compte la résolution
- ! dans le calcul de l'entrainement et du détrainement
- !IF(LNORM_RESOL) THEN
- !grid resolution in the AROME CASE
- ZRESOL_GRID=sqrt(XDXHAT(1)*XDYHAT(1))
- !ENDIF
-
-! Initialisation of intersesting Level :LCL,ETL,CTL
- KKLCL(:)=KKE
- KKETL(:)=KKE
- KKCTL(:)=KKE
-
- !
- ! Initialisation
- !* udraft governing variables
- PEMF(:,:)=0.
- PDETR(:,:)=0.
- PENTR(:,:)=0.
-
- ! Initialisation
- !* updraft core variables
- PRV_UP(:,:)=0.
- PRC_UP(:,:)=0.
- PRI_UP(:,:)=0.
- PW_UP(:,:)=0.
- ZTH_UP(:,:)=0.
- PFRAC_UP(:,:)=0.
- PTHV_UP(:,:)=0.
-
- PBUO_INTEG=0.
- ZBUO =0.
-
- PFRAC_ICE_UP(:,:)=0.
- PRSAT_UP(:,:)=PRVM(:,:) ! should be initialised correctly but is (normaly) not used
-
- !cloud/dry air mixture cloud content
- ZRC_MIX = 0.
- ZRI_MIX = 0.
-
-END IF
-
-! Initialisation of environment variables at t-dt
-! variables at flux level
-ZTHLM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTHLM(:,:))
-ZRTM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRTM(:,:))
-ZUM_F (:,:) = MZM_MF(KKA,KKU,KKL,PUM(:,:))
-ZVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PVM(:,:))
-ZTKEM_F(:,:) = MZM_MF(KKA,KKU,KKL,PTKEM(:,:))
-
-DO JSV=1,ISV
- IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
- ZSVM_F(:,:,JSV) = MZM_MF(KKA,KKU,KKL,PSVM(:,:,JSV))
-END DO
-!
-! Initialisation of updraft characteristics
-PTHL_UP(:,:)=ZTHLM_F(:,:)
-PRT_UP(:,:)=ZRTM_F(:,:)
-PU_UP(:,:)=ZUM_F(:,:)
-PV_UP(:,:)=ZVM_F(:,:)
-PSV_UP(:,:,:)=ZSVM_F(:,:,:)
-PSV_DO(:,:,:)=ZSVM_F(:,:,:)
-PTHL_DO(:,:)=ZTHLM_F(:,:)
-PRT_DO(:,:)=ZRTM_F(:,:)
-PU_DO(:,:)=ZUM_F(:,:)
-PV_DO(:,:)=ZVM_F(:,:)
-PSV_DO(:,:,:)=0.
-
- ! initiation de l'équation de la dynamique
- !vertical velocity at mass level
- ZWM_M(:,:)=MZF_MF(KKA,KKU,KKL,PWM(:,:))
-! Computation or initialisation of updraft characteristics at the KKB level
-! thetal_up,rt_up,thetaV_up, w2,Buoyancy term and mass flux (PEMF)
-
-PTHL_UP(:,KKB)= ZTHLM_F(:,KKB)+MAX(0.,MIN(ZTMAX,(PSFTH(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
-PRT_UP(:,KKB) = ZRTM_F(:,KKB)+MAX(0.,MIN(ZRMAX,(PSFRV(:)/SQRT(ZTKEM_F(:,KKB)))*XALP_PERT))
-!------------------------
-! print*,OENTR_DETR
-!------------------------
-IF (OENTR_DETR) THEN
- ZTHM_F (:,:) = MZM_MF(KKA,KKU,KKL,PTHM (:,:))
- ZPRES_F(:,:) = MZM_MF(KKA,KKU,KKL,PPABSM(:,:))
- ZRHO_F (:,:) = MZM_MF(KKA,KKU,KKL,PRHODREF(:,:))
- ZRVM_F (:,:) = MZM_MF(KKA,KKU,KKL,PRVM(:,:))
-
- ! thetav at mass and flux levels
- ZTHVM_F(:,:)=ZTHM_F(:,:)*((1.+ZRVORD*ZRVM_F(:,:))/(1.+ZRTM_F(:,:)))
- ZTHVM(:,:)=PTHM(:,:)*((1.+ZRVORD*PRVM(:,:))/(1.+PRTM(:,:)))
-
- PTHV_UP(:,:)=ZTHVM_F(:,:)
-
- ZW_UP2(:,:)=ZEPS
- ZW_UP2(:,KKB) = MAX(0.0001,(2./3.)*ZTKEM_F(:,KKB))
-
- ! initiation de l'équation de la dynamique
- ! initialisation du vent de l'updraft pour la zone grise
- ZW_UP(:,:)=SQRT(ZW_UP2)
-
- ! Computation of non conservative variable for the KKB level of the updraft
- ! (all or nothing ajustement)
- PRC_UP(:,KKB)=0.
- PRI_UP(:,KKB)=0.
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,KKB),ZPRES_F(:,KKB), &
- PTHL_UP(:,KKB),PRT_UP(:,KKB),ZTH_UP(:,KKB), &
- PRV_UP(:,KKB),PRC_UP(:,KKB),PRI_UP(:,KKB),ZRSATW(:),ZRSATI(:))
-
- ! compute updraft thevav and buoyancy term at KKB level
- PTHV_UP(:,KKB) = ZTH_UP(:,KKB)*((1+ZRVORD*PRV_UP(:,KKB))/(1+PRT_UP(:,KKB)))
- ! compute mean rsat in updraft
- PRSAT_UP(:,KKB) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,KKB)) + ZRSATI(:)*PFRAC_ICE_UP(:,KKB)
-
- ! Closure assumption for mass flux at KKB level
- !
- ! calcul différent de la flottabilité
- PTHVREF=300.
- ! c'est la meilleure flottabilité !
- !NBUOY=0.
- !IF(NBUOY == 0.) THEN
- ZG_O_THVREF=XG/ZTHVM_F
- !ELSE
- ! ! in AROME XTHVREF does not exist ici 300
- ! ZG_O_THVREF=XG/PTHVREF(1,1) ! on revient à l'état de référence et pas ZTHVM_F
- !ENDIF
- ! Calcul de la fermeture de Julien Pergaut comme limite max de PHY
-
- DO JK=KKB,KKE-KKL,KKL ! Vertical loop
- ZZDZ(:,JK) = MAX(ZEPS,PZZ(:,JK+KKL)-PZZ(:,JK)) ! <== Delta Z between two flux level
- ENDDO
-
- ! compute L_up
- GLMIX=.TRUE.
- ZTKEM_F(:,KKB)=0.
- IF(CTURBLEN=='RM17') THEN
- ZDUDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PUM,PDZZ))
- ZDVDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PVM,PDZZ))
- ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
- ELSE
- ZSHEAR = 0. !no shear in bl89 mixing length
- END IF
- CALL COMPUTE_BL89_ML(KKA,KKB,KKE,KKU,KKL,PDZZ,ZTKEM_F(:,KKB),ZG_O_THVREF(:,KKB), &
- ZTHVM_F,KKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
- ZLUP(:)=MAX(ZLUP(:),1.E-10)
-
- ! Compute Buoyancy flux at the ground
- ZWTHVSURF(:) = (ZTHVM_F(:,KKB)/ZTHM_F(:,KKB))*PSFTH(:)+ &
- (0.61*ZTHM_F(:,KKB))*PSFRV(:)
-
- ! Mass flux at KKB level (updraft triggered if PSFTH>0.)
- !elefant>
- MODIF(:)=tanh(1.83*sqrt(XDXHAT(1)*XDYHAT(1))/ZLUP)
- WHERE (ZWTHVSURF(:)>0.)
- PEMF(:,KKB) = XCMF * MODIF(:) * ZRHO_F(:,KKB) *&
- ((ZG_O_THVREF(:,KKB))*ZWTHVSURF*ZLUP)**(1./3.)
- PFRAC_UP(:,KKB)=MIN(PEMF(:,KKB)/(SQRT(ZW_UP2(:,KKB))*ZRHO_F(:,KKB)),XFRAC_UP_MAX)
- ZW_UP2(:,KKB)=(PEMF(:,KKB)/(PFRAC_UP(:,KKB)*ZRHO_F(:,KKB)))**2
- GTEST(:)=.TRUE.
- ELSEWHERE
- PEMF(:,KKB) =0.
- GTEST(:)=.FALSE.
- ENDWHERE
- !elefant<
-ELSE
- GTEST(:)=PEMF(:,KKB+KKL)>0.
-END IF
-
-!--------------------------------------------------------------------------
-
-! 3. Vertical ascending loop
-! -----------------------
-!
-! If GTEST = T the updraft starts from the KKB level and stops when GTEST becomes F
-!
-!
-GTESTLCL(:)=.FALSE.
-GTESTETL(:)=.FALSE.
-
- ! CALCUL DE LA RESOLUTION NORMALISEE
-
- !IF(NLES_DTCOUNT .EQ. 0.)THEN
- ! print*,"PROBLEME NLES_DTCOUNT"
- ! print*,"NLES_DTCOUNT doit être 1."
- !STOP
- !ENDIF
-
- WHERE (GTEST .AND. ZLUP(:)>0. )
- ! hauteur des thermiques du pas de temps precedent
- ! dans cette version ZLUP depend du flux de masse dans chaque
- ! colonne, il serait peut-être plus simple de faire une variable
- ! globale sur le domaine
- ZRESOL_NORM(:)=ZRESOL_GRID/(ZLUP(:))
- ELSEWHERE
- ZRESOL_NORM(:)=0.5 ! ARBITRAIRE
- ENDWHERE
-
-! Loop on vertical level
-DO JK=KKB,KKE-KKL,KKL
-
-! IF the updraft top is reached for all column, stop the loop on levels
- ITEST=COUNT(GTEST)
- !IF (ITEST==0) print*,"cycle"
- IF (ITEST==0) CYCLE
-! Computation of entrainment and detrainment with KF90
-! parameterization in clouds and LR01 in subcloud layer
-
-
-! to find the LCL (check if JK is LCL or not)
-
- WHERE ((PRC_UP(:,JK)+PRI_UP(:,JK)>0.).AND.(.NOT.(GTESTLCL)))
- KKLCL(:) = JK
- GTESTLCL(:)=.TRUE.
- ENDWHERE
-
-! Buoyancy is computed on "flux" levels where updraft variables are known
- !================================================================================
- ! CALCUL DE LA FLOTTABILITE
- !================================================================================
-
- ! Compute theta_v of updraft at flux level JK
-
- ZRC_UP(:) =PRC_UP(:,JK) ! guess
- ZRI_UP(:) =PRI_UP(:,JK) ! guess
- ZRV_UP(:) =PRV_UP(:,JK)
-
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
- PPABSM(:,JK),PTHL_UP(:,JK),PRT_UP(:,JK),&
- ZTH_UP(:,JK),ZRV_UP,ZRC_UP,ZRI_UP,ZRSATW(:),ZRSATI(:))
-
- WHERE (GTEST)
- PTHV_UP (:,JK) = ZTH_UP(:,JK)*(1.+ZRVORD*ZRV_UP(:))/(1.+PRT_UP(:,JK))
- ENDWHERE ! fin temporaire de GTEST
-
- ! test sur le calcul de la flottabilité de 2 manières
- ! le calcul de la flottabilité est super important
- ! c'est ce qui decide de Wup
- !IF(NBUOY==1) THEN
- ! !WHERE (GTEST) ! comme dans EDKF, mais c'est toujours positif
- ! ! du coup le thermique ne s'arrète pas
- ! ZBUO (:,JK) = ZG_O_THVREF(:,JK)*(PTHV_UP(:,JK) - PTHVREF(:,JK))
- ! !ENDWHERE ! fin temporaire de GTEST
- ! IF(LDUMMY1) THEN
- ! print*,"ZBUO_1(:,",JK,")=",minval(ZBUO(:,JK)),maxval(ZBUO(:,JK))
- !END IF
- !ELSEIF(NBUOY==2) THEN
- ! !WHERE (GTEST)! comme ca devrait être mais trop restrictif, le thermique
- ! !s'arrete d'emblée
- ! ZBUO (:,JK) = ZG_O_THVREF(:,JK)*(PTHV_UP(:,JK) -2.*ZTHVM_F(:,JK) + PTHVREF(:,JK))
- ! !ENDWHERE ! fin temporaire de GTEST
- ! IF(LDUMMY1) THEN
- ! print*,"ZBUO_2(:,",JK,")=",minval(ZBUO(:,JK)),maxval(ZBUO(:,JK))
- !END IF
- !ELSEIF(NBUOY==3) THEN
- ! !WHERE (GTEST) ! un peu plus rigoureux que celle du dessus, mais trop restrictif, le thermique
- ! !s'arrete d'emblée
- ! ZBUO (:,JK) = XG/ZTHVM_F(:,JK)*(PTHV_UP(:,JK)-ZTHVM_F(:,JK))-&
- ! XG/PTHVREF(:,JK)*(ZTHVM_F(:,JK)-PTHVREF(:,JK))
- ! !ENDWHERE ! fin temporaire de GTEST
- !IF(LDUMMY1) THEN
- ! print*,"ZBUO_3(:,",JK,")=",minval(ZBUO(:,JK)),maxval(ZBUO(:,JK))
- !END IF
- !ELSEIF(NBUOY==4) THEN
- ! devrait être plus proche de EDKF que NBUOY==0, mais ce n'est pas le cas.
- ! IF(JK/=KKB) THEN
- ! ZRC_MIX(:,JK) = ZRC_MIX(:,JK-KKL) ! guess of Rc of mixture
- ! ZRI_MIX(:,JK) = ZRI_MIX(:,JK-KKL) ! guess of Ri of mixture
- ! ENDIF
- ! CALL COMPUTE_ENTR_DETR(JK,KKB,KKE,KKL,GTEST,GTESTLCL,HFRAC_ICE,PFRAC_ICE_UP(:,JK),&
- ! PPABSM(:,:),PZZ(:,:),PDZZ(:,:),ZTHVM(:,:), &
- ! PTHLM(:,JK),PRTM(:,JK),ZW_UP2(:,:), &
- ! PTHL_UP(:,JK),PRT_UP(:,JK),ZLUP(:), &
- ! PRC_UP(:,JK),PRI_UP(:,JK),ZRC_MIX(:,JK),ZRI_MIX(:,JK), &
- ! PENTR(:,JK),PDETR(:,JK),ZBUO(:,JK) )
- !
-
- !IF(LDUMMY1) THEN
- ! print*,"ZBUO_4(:,",JK,")=",minval(PBUO_INTEG(:,JK)),maxval(PBUO_INTEG(:,JK))
- !END IF
-
- !ELSE
- !WHERE (GTEST) ! une dernière possibilité
- ZBUO (:,JK) = ZG_O_THVREF(:,JK)*(PTHV_UP(:,JK) - ZTHVM_F(:,JK))
- !ENDWHERE ! fin temporaire de GTEST
- !IF(LDUMMY1) THEN
- ! print*,"ZBUO_0(:,",JK,")=",minval(ZBUO(:,JK)),maxval(ZBUO(:,JK))
- !END IF
- !ENDIF
-
- !WHERE (GTEST)
- ! anomalie de flottabilité * DZ
- PBUO_INTEG(:,JK) = ZBUO(:,JK)*(PZZ(:,JK+KKL)-PZZ(:,JK))
- ! uniquement pour le calcul de l'ancienne vitesse verticale
- !ENDWHERE ! fin temporaire de GTEST
-
- !================================================================================
- ! CALCUL DE ZA1
- !================================================================================
-
- ! si on a besoin d'un calcul spécifique de ZA1 vs XA1 (constante)
- ! - LNORM_RESOL = calcul de ZA1 en prenant en compte la résolution normalisée
-
- ZA1(:)=XA1
- !IF (LNORM_RESOL) THEN
- ! WHERE (GTEST)
- ! ZA1(:)=XCOEF1+XCOEF2*ZRESOL_NORM(:)**(-1*XCOEF3)
- ! ENDWHERE
- !ELSEIF (.NOT. XDUMMY1 == 0. ) THEN
- ! WHERE (GTEST)
- ! ZA1(:)=XDUMMY1
- ! ENDWHERE
- !END IF
- !
-
- !================================================================================
- ! EQUATION DE LA DYNAMIQUE
- !================================================================================
- ! on calcule le vent vertical du thermique dans la zone grise
- ! ZA1 depend de la méthode utilisée
- ALLOCATE(ZWORK(SIZE(ZW_UP,1)))
- ZWORK(:)=0.
- !WHERE (GTEST .AND. PFRAC_UP(:,JK)>0 .AND. PFRAC_UP(:,JK)<=XFRAC_LIM)
- WHERE (GTEST .AND. PFRAC_UP(:,JK)>0 )
- !hypothse => alpha(k)=alpha(k+1)
- ZWCOE(:) = (1.-PFRAC_UP(:,JK))/(1.-PFRAC_UP(:,JK)+XBETA1)
- ZBUCOE(:) = 2.*ZWCOE(:)*ZA1
- ZWORK(:)=(ZW_UP(:,JK)-(1.-ZWCOE(:))*PWM(:,JK)-ZWCOE(:)*ZWM_M(:,JK))*&
- (ZW_UP(:,JK)-(1.-ZWCOE(:))*PWM(:,JK)-ZWCOE(:)*ZWM_M(:,JK))+&
- ZBUCOE(:)*PBUO_INTEG(:,JK)
- ELSEWHERE
- ZWORK(:)=0
- ENDWHERE
- !
- WHERE (GTEST)
- WHERE(ZWORK>=0.)
- ! il s'agit bien de Wu et non pas de Wu-Wm
- ZW_UP(:,JK+KKL)=(1.-ZWCOE(:))*PWM(:,JK+KKL)+ZWCOE(:)*ZWM_M(:,JK)+SQRT(ZWORK(:))
- ELSEWHERE
- ZW_UP(:,JK+KKL)=0.
- ENDWHERE
- ZW_UP2(:,JK+KKL) = MAX(0.,ZW_UP(:,JK+KKL)*ZW_UP(:,JK+KKL))
- ZWUP_MEAN(:) = MAX(ZEPS,0.5*(ZW_UP(:,JK+KKL)+ZW_UP(:,JK))-ZWM_M(:,JK))
- ENDWHERE
- DEALLOCATE(ZWORK)
- !
- !================================================================================
- ! CALCUL DE L ENTRAINEMENT ET DU DETRAINEMENT
- !================================================================================
- ! Hypothèse alpha jk= alpha point de masse
- !WHERE (GTEST .AND. PFRAC_UP(:,JK)>0. .AND. PFRAC_UP(:,JK)<XFRAC_LIM )
- WHERE (GTEST .AND. PFRAC_UP(:,JK)>0. .AND. ZWUP_MEAN(:)>0 )
- ! ZWUP_MEAN est Wu-Wm au point de masse
- PENTR(:,JK) = MAX(0., ((1.-PFRAC_UP(:,JK))*XBETA1)/(1.-PFRAC_UP(:,JK)+XBETA1)*(ZA1*ZBUO(:,JK)/&
- (ZWUP_MEAN(:)*ZWUP_MEAN(:))&
- - XB &
- - 1./(ZWUP_MEAN(:))*(PWM(:,JK+KKL)-PWM(:,JK))/(PZZ(:,JK+KKL)-PZZ(:,JK)))&
- )
- ZDETR_BUO(:) = MAX(0., -((1.-PFRAC_UP(:,JK))*XBETA1)/(1.-PFRAC_UP(:,JK)+XBETA1)*(ZA1*ZBUO(:,JK)/&
- (ZWUP_MEAN(:)*ZWUP_MEAN(:))))
- ZDETR_RT(:) = XC*SQRT(MAX(0.,(PRT_UP(:,JK) - ZRTM_F(:,JK)))/MAX(ZEPS,ZRTM_F(:,JK))/ ZWUP_MEAN(:))
- PDETR(:,JK) = ZDETR_RT(:)+ZDETR_BUO(:)
- ENDWHERE
-!
- !================================================================================
- ! VARIABLES THERMODYNAMIQUES
- !================================================================================
- ! computation of the updraft characteritics at jk+1
- ! WHERE (GTEST .AND. PFRAC_UP(:,JK)>0. .AND. PFRAC_UP(:,JK)<XFRAC_LIM)
- WHERE (GTEST .AND. PFRAC_UP(:,JK)>0.)
- ZMIX2(:) = (PZZ(:,JK+KKL)-PZZ(:,JK))*PENTR(:,JK)/(1.-PFRAC_UP(:,JK)) !&
- ELSEWHERE
- ZMIX2(:) = 0. !&
- ENDWHERE ! GTEST
-
-
-! If the updraft did not stop, compute cons updraft characteritics at jk+KKL
- WHERE (GTEST)
- PTHL_UP(:,JK+KKL)=(PTHL_UP(:,JK)*(1.-0.5*ZMIX2(:)) + PTHLM(:,JK)*ZMIX2(:)) &
- /(1.+0.5*ZMIX2(:))
- PRT_UP(:,JK+KKL) =(PRT_UP (:,JK)*(1.-0.5*ZMIX2(:)) + PRTM(:,JK)*ZMIX2(:)) &
- /(1.+0.5*ZMIX2(:))
- ENDWHERE
-
-
- IF(OMIXUV) THEN
- IF(JK/=KKB) THEN
- WHERE(GTEST)
- PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)+&
- (PUM(:,JK)-PUM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
- PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)+&
- (PVM(:,JK)-PVM(:,JK-KKL))/PDZZ(:,JK)) ) &
- /(1+0.5*ZMIX2(:))
- ENDWHERE
- ELSE
- WHERE(GTEST)
- PU_UP(:,JK+KKL) = (PU_UP (:,JK)*(1-0.5*ZMIX2(:)) + PUM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PUM(:,JK+KKL)-PUM(:,JK))/PDZZ(:,JK+KKL)) ) &
- /(1+0.5*ZMIX2(:))
- PV_UP(:,JK+KKL) = (PV_UP (:,JK)*(1-0.5*ZMIX2(:)) + PVM(:,JK)*ZMIX2(:)+ &
- 0.5*XPRES_UV*(PZZ(:,JK+KKL)-PZZ(:,JK))*&
- ((PVM(:,JK+KKL)-PVM(:,JK))/PDZZ(:,JK+KKL)) ) &
- /(1+0.5*ZMIX2(:))
- ENDWHERE
-
- ENDIF
- ENDIF
- DO JSV=1,ISV
- IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
- WHERE(GTEST)
- PSV_UP(:,JK+KKL,JSV) = (PSV_UP (:,JK,JSV)*(1-0.5*ZMIX2(:)) + &
- PSVM(:,JK,JSV)*ZMIX2(:)) /(1+0.5*ZMIX2(:))
- ENDWHERE
- END DO
-
-! Compute non cons. var. at level JK+KKL
- ZRC_UP(:)=PRC_UP(:,JK) ! guess = level just below
- ZRI_UP(:)=PRI_UP(:,JK) ! guess = level just below
- CALL TH_R_FROM_THL_RT_1D(HFRAC_ICE,PFRAC_ICE_UP(:,JK+KKL),ZPRES_F(:,JK+KKL), &
- PTHL_UP(:,JK+KKL),PRT_UP(:,JK+KKL),ZTH_UP(:,JK+KKL), &
- ZRV_UP(:),ZRC_UP(:),ZRI_UP(:),ZRSATW(:),ZRSATI(:))
- WHERE(GTEST)
- PRC_UP(:,JK+KKL)=ZRC_UP(:)
- PRV_UP(:,JK+KKL)=ZRV_UP(:)
- PRI_UP(:,JK+KKL)=ZRI_UP(:)
- PRSAT_UP(:,JK+KKL) = ZRSATW(:)*(1-PFRAC_ICE_UP(:,JK+KKL)) + ZRSATI(:)*PFRAC_ICE_UP(:,JK+KKL)
- ENDWHERE
-
-
-! Compute the updraft theta_v, buoyancy and w**2 for level JK+KKL
- WHERE(GTEST)
- PTHV_UP(:,JK+KKL) = ZTH_UP(:,JK+KKL)*((1+ZRVORD*PRV_UP(:,JK+KKL))/(1+PRT_UP(:,JK+KKL)))
- ENDWHERE
- !================================================================================
- ! CALCUL DU FLUX DE MASSE
- !================================================================================
- ZMIX1(:)=0.
- WHERE(GTEST)
- ! identique dans Rio, EDKF ou dans la zone grise
- ZMIX1(:)=ZZDZ(:,JK)*(PENTR(:,JK)-PDETR(:,JK))
- PEMF(:,JK+KKL)=PEMF(:,JK)*EXP(ZMIX1(:))
- ENDWHERE
- !================================================================================
- ! FRACTION DE THERMIQUE
- !================================================================================
- ! on cherche à savoir s'il y a des vitesses verticales non définies
- ! je n'utilise que ZW_UP2 pour pouvoir avoir une valeur si ZW_UP
- ! n'est pas défini
-IF (maxval(ZW_UP2(:,JK+KKL)) .NE. maxval(ZW_UP2(:,JK+KKL))) &
- call Print_msg( NVERB_FATAL, 'GEN', 'COMPUTE_UPDRAFT_HRIO', 'maxval(ZW_UP2(:,JK+KKL)) /= maxval(ZW_UP2(:,JK+KKL))' )
-! si on est dans la zone grise la définition du flux de masse change
-! donc celle de alpha aussi
-WHERE(GTEST)
- !attention je ne suis pas au point de masse
-WHERE ((SQRT(ZW_UP2(:,JK+KKL))-PWM(:,JK+KKL))>ZEPS)
- PFRAC_UP(:,JK+KKL)=PEMF(:,JK+KKL)/((SQRT(ZW_UP2(:,JK+KKL))-PWM(:,JK+KKL))*ZRHO_F(:,JK+KKL))
-ELSEWHERE
- PFRAC_UP(:,JK+KKL)=0.
-ENDWHERE
- PFRAC_UP(:,JK+KKL)=MIN(PFRAC_UP(:,JK+KKL),XFRAC_LIM)
-ENDWHERE
-
-
-! calcul des termes environmentaux au point de flux
- WHERE(GTEST)
- !WHERE(PFRAC_UP(:,JK+KKL)>0 .AND. PFRAC_UP(:,JK+KKL)< XFRAC_LIM)
- WHERE( PFRAC_UP(:,JK+KKL)>0 )
- PTHL_DO(:,JK+KKL)=((PTHLM(:,JK)+PTHLM(:,JK+KKL))*0.5-PFRAC_UP(:,JK+KKL)*PTHL_UP(:,JK+KKL)) &
- /(1.-PFRAC_UP(:,JK+KKL))
- PRT_DO(:,JK+KKL) =((PRTM(:,JK)+PRTM(:,JK+KKL))*0.5-PFRAC_UP(:,JK+KKL)*PRT_UP(:,JK+KKL)) &
- /(1.-PFRAC_UP(:,JK+KKL))
- PU_DO(:,JK+KKL) = ((PUM(:,JK)+PUM(:,JK+KKL))*0.5-PFRAC_UP(:,JK+KKL)*PU_UP(:,JK+KKL)) &
- /(1.-PFRAC_UP(:,JK+KKL))
- PV_DO(:,JK+KKL) = ((PVM(:,JK)+PVM(:,JK+KKL))*0.5-PFRAC_UP(:,JK+KKL)*PV_UP(:,JK+KKL)) &
- /(1.-PFRAC_UP(:,JK+KKL))
- PTHV_DO(:,JK+KKL)=(ZTHVM_F(:,JK+KKL)-PFRAC_UP(:,JK+KKL)*PTHV_UP(:,JK+KKL))&
- /(1.-PFRAC_UP(:,JK+KKL))
- ENDWHERE
- ENDWHERE
- DO JSV=1,ISV
- IF (ONOMIXLG .AND. JSV >= KSV_LGBEG .AND. JSV<= KSV_LGEND) CYCLE
- WHERE(GTEST)
- !WHERE(PFRAC_UP(:,JK+KKL)>0 .AND. PFRAC_UP(:,JK+KKL)<= XFRAC_LIM)
- WHERE(PFRAC_UP(:,JK+KKL)>0 )
- PSV_DO(:,JK+KKL,JSV) = ((PSVM(:,JK,JSV)+PSVM(:,JK+1,JSV))*0.5-PFRAC_UP(:,JK+KKL)*PSV_UP(:,JK+KKL,JSV))&
- /(1.-PFRAC_UP(:,JK+KKL))
- ENDWHERE
- ENDWHERE
- ENDDO
-
- WHERE(GTEST)
- PFRAC_UP(:,JK+KKL)=MIN(XFRAC_UP_MAX,PFRAC_UP(:,JK+KKL))
- ENDWHERE
-! Test if the updraft has reach the ETL
- GTESTETL(:)=.FALSE.
- WHERE (GTEST.AND.(PBUO_INTEG(:,JK)<=0.))
- KKETL(:) = JK+KKL
- GTESTETL(:)=.TRUE.
- ENDWHERE
-
-! Test is we have reached the top of the updraft
-
-! WHERE (GTEST.AND.((ZW_UP2(:,JK+KKL)<=ZEPS).OR.(PEMF(:,JK+KKL)<=ZEPS) .OR. PFRAC_UP(:,JK+KKL)<= XALPHA_SEUIL))
- WHERE ( GTEST .AND. ( (ZW_UP2(:,JK+KKL)<=10E-5) .OR. (PEMF(:,JK+KKL)<=10E-5)) )
- ZW_UP2 (:,JK+KKL)=0.
- PEMF (:,JK+KKL)=0.
- GTEST (:) =.FALSE.
- PTHL_UP (:,JK+KKL)=ZTHLM_F(:,JK+KKL)
- PRT_UP (:,JK+KKL)=ZRTM_F(:,JK+KKL)
- PRC_UP (:,JK+KKL)=0.
- PRI_UP (:,JK+KKL)=0.
- PRV_UP (:,JK+KKL)=ZRVM_F (:,JK+KKL)
- PTHV_UP (:,JK+KKL)=ZTHVM_F(:,JK+KKL)
-
- PFRAC_UP (:,JK+KKL)=0.
- KKCTL (:) =JK+KKL
- PTHL_DO (:,JK+KKL)=ZTHLM_F(:,JK+KKL)
- PRT_DO (:,JK+KKL)=ZRTM_F(:,JK+KKL)
- PTHV_DO (:,JK+KKL)=ZTHVM_F(:,JK+KKL)
- ENDWHERE
-
-ENDDO ! boucle JK
-!STOP
- PW_UP(:,:)=SQRT(ZW_UP2(:,:))
-
- PEMF(:,KKB) =0.
-
-! Limits the shallow convection scheme when cloud heigth is higher than 3000m.
-! To do this, mass flux is multiplied by a coefficient decreasing linearly
-! from 1 (for clouds of ZDEPTH_MAX1 m of depth) to 0 (for clouds of ZDEPTH_MAX2 m of depth).
-! This way, all MF fluxes are diminished by this amount.
-! Diagnosed cloud fraction is also multiplied by the same coefficient.
-!
- DO JI=1,SIZE(PTHM,1)
- PDEPTH(JI) = MAX(0., PZZ(JI,KKCTL(JI)) - PZZ(JI,KKLCL(JI)) )
- END DO
-
-GWORK1(:)= (GTESTLCL(:) .AND. (PDEPTH(:) > ZDEPTH_MAX1) )
-GWORK2(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=MAX(KKU,KKA) )
-ZCOEF(:,:) = SPREAD( (1.-(PDEPTH(:)-ZDEPTH_MAX1)/(ZDEPTH_MAX2-ZDEPTH_MAX1)), DIM=2, NCOPIES=SIZE(ZCOEF,2))
-! print*,"je sors de compute_updraft"
-
-END SUBROUTINE COMPUTE_UPDRAFT_HRIO
diff --git a/src/MNH/condensation.f90 b/src/MNH/condensation.f90
index a2db1a0884c229308ba12596f51ed9500e19ac47..990a125aca2c5148a38af0d067ae8af383e49948 100644
--- a/src/MNH/condensation.f90
+++ b/src/MNH/condensation.f90
@@ -1,18 +1,18 @@
-!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-------------------------------------------------------------------------------
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_CONDENSATION
! ########################
!
INTERFACE
!
- SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
- HFRAC_ICE, &
- PPABS, PZZ, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
- OSIGMAS, PSIGQSAT, PLV, PLS, PCPH)
+ SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL,&
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABS, PZZ, PRHODREF, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
+ OSIGMAS, PSIGQSAT, PLV, PLS, PCPH, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF)
!
INTEGER, INTENT(IN) :: KIU ! horizontal dimension in x
INTEGER, INTENT(IN) :: KJU ! horizontal dimension in y
@@ -25,28 +25,35 @@ INTEGER, INTENT(IN) :: KKB ! value of the first point
INTEGER, INTENT(IN) :: KKE ! value of the last point in z
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABS ! pressure (Pa)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of model levels (m)
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PT ! grid scale T (K)
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRV ! grid scale water vapor mixing ratio (kg/kg)
+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)
+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)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
+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)
- ! multiplied by PSIGQSAT
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRC ! grid scale r_c mixing ratio (kg/kg)
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRI ! grid scale r_i (kg/kg)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PLV
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PLS
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCPH
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLV
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PLS
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(IN) :: PCPH
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HRC !cloud water content in precipitating part
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLC_HCF !precipitating part
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HRI !
+REAL, DIMENSION(KIU,KJU,KKU), OPTIONAL, INTENT(OUT) :: PHLI_HCF !
+
END SUBROUTINE CONDENSATION
!
END INTERFACE
@@ -54,9 +61,9 @@ END INTERFACE
END MODULE MODI_CONDENSATION
! ######spl
SUBROUTINE CONDENSATION( KIU, KJU, KKU, KIB, KIE, KJB, KJE, KKB, KKE, KKL, &
- HFRAC_ICE, &
- PPABS, PZZ, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
- OSIGMAS, PSIGQSAT, PLV, PLS, PCPH )
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABS, PZZ, PRHODREF, PT, PRV, PRC, PRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSIGRC, OUSERI,&
+ OSIGMAS, PSIGQSAT, PLV, PLS, PCPH, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
! ################################################################################
!
!!
@@ -127,14 +134,17 @@ END MODULE MODI_CONDENSATION
!
USE MODD_CST
USE MODD_PARAMETERS
+USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
!
USE MODE_MPPDB
+use mode_msg
!
USE MODI_COMPUTE_FRAC_ICE
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
!
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -151,28 +161,36 @@ INTEGER, INTENT(IN) :: KKB ! value of the first point
INTEGER, INTENT(IN) :: KKE ! value of the last point in z
INTEGER, INTENT(IN) :: KKL ! +1 if grid goes from ground to atmosphere top, -1 otherwise
CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABS ! pressure (Pa)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of model levels (m)
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PT ! grid scale T (K)
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRV ! grid scale water vapor mixing ratio (kg/kg)
+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)
+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)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
+REAL, DIMENSION(KIU,KJU,KKU), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
+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
+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)
- ! multiplied by PSIGQSAT
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRC ! grid scale r_c mixing ratio (kg/kg)
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRI ! grid scale r_i (kg/kg)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRS ! grid scale mixing ration of snow (kg/kg)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRG ! grid scale mixing ration of graupel (kg/kg)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s from turbulence scheme
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV! convective mass flux (kg /s m^2)
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PCLDFR ! cloud fraction
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PSIGRC ! s r_c / sig_s^2
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PLV
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PLS
-REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PCPH
+
!
!
!* 0.2 Declarations of local variables :
@@ -181,13 +199,17 @@ INTEGER :: JI, JJ, JK, JKP, JKM, IKTB, IKTE ! loop index
REAL, DIMENSION(:,:,:), allocatable :: ZTLK, ZRT ! work arrays for T_l and total water mixing ratio
REAL, DIMENSION(:,:,:), allocatable :: ZL ! length scale
REAL, DIMENSION(:,:,:), allocatable :: ZFRAC ! Ice fraction
+REAL :: ZCRIAUTI !
INTEGER, DIMENSION(:,:), allocatable :: ITPL ! top levels of troposphere
REAL, DIMENSION(:,:), allocatable :: ZTMIN ! minimum Temp. related to ITPL
!
REAL, DIMENSION(:,:,:), allocatable :: ZLV, ZLS, ZCPD
-REAL :: ZTEMP, ZPV, ZQSL, ZPIV, ZQSI, ZCOND, ZLVS ! thermodynamics
+REAL :: ZCOND
+REAL :: ZGCOND, ZSBAR, ZSBARC, ZQ1, ZAUTC, ZAUTI, ZGAUV, ZGAUC, ZGAUI, ZGAUTC, ZGAUTI ! Used for integration in Gaussian Probability Density Function
+REAL :: ZTEMP, ZPV, ZQSL, ZPIV, ZQSI, ZLVS ! thermodynamics
REAL :: ZLL, DZZ, ZZZ ! used for length scales
-REAL :: ZAH, ZA, ZB, ZSBAR, ZQ1, ZSIGMA, ZDRW, ZDTL, ZSIG_CONV ! related to computation of Sig_s
+REAL :: ZAH, ZA, ZB, ZSIGMA, ZDRW, ZDTL, ZSIG_CONV ! related to computation of Sig_s
+REAL :: ZRCOLD, ZRIOLD
INTEGER :: INQ1
REAL :: ZINC
LOGICAL :: GPRESENT_PLV, GPRESENT_PLS, GPRESENT_PCPH
@@ -441,30 +463,96 @@ DO JK=IKTB,IKTE
! normalized saturation deficit
ZQ1 = ZSBAR/ZSIGMA
- ! cloud fraction
+ IF(HCONDENS == 'GAUS')THEN
+ ! Gaussian Probability Density Function around ZQ1
+ ! Computation of ZG and ZGAM(=erf(ZG))
+ ZGCOND = -ZQ1/SQRT(2.)
+
+ !Approximation of erf function for Gaussian distribution
+ ZGAUV = 1 - SIGN(1., ZGCOND) * SQRT(1-EXP(-4*ZGCOND**2/XPI))
+
+ !Computation Cloud Fraction
+ PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUV))
+
+ !Computation of condensate
+ ZCOND = (EXP(-ZGCOND**2)-ZGCOND*SQRT(XPI)*ZGAUV)*ZSIGMA/SQRT(2.*XPI)
+ ZCOND = MAX(ZCOND, 0.)
+
+ PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK)
+
+ !Computation warm/cold Cloud Fraction and content in high water content part
+ IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
+ IF(1-ZFRAC(JI,JJ,JK) > 1.E-20)THEN
+ ZAUTC = (ZSBAR - XCRIAUTC/(PRHODREF(JI,JJ,JK)*(1-ZFRAC(JI,JJ,JK))))/ZSIGMA
+ ZGAUTC = -ZAUTC/SQRT(2.)
+ !Approximation of erf function for Gaussian distribution
+ ZGAUC = 1 - SIGN(1., ZGAUTC) * SQRT(1-EXP(-4*ZGAUTC**2/XPI))
+ PHLC_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUC))
+ PHLC_HRC(JI,JJ,JK) = (1-ZFRAC(JI,JJ,JK))*(EXP(-ZGAUTC**2)-ZGAUTC*SQRT(XPI)*ZGAUC)*ZSIGMA/SQRT(2.*XPI)
+ PHLC_HRC(JI,JJ,JK) = PHLC_HRC(JI,JJ,JK) + XCRIAUTC/PRHODREF(JI,JJ,JK) * PHLC_HCF(JI,JJ,JK)
+ PHLC_HRC(JI,JJ,JK) = MAX(PHLC_HRC(JI,JJ,JK), 0.)
+ ELSE
+ PHLC_HCF(JI,JJ,JK)=0.
+ PHLC_HRC(JI,JJ,JK)=0.
+ ENDIF
+ ENDIF
+
+ IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
+ IF(ZFRAC(JI,JJ,JK) > 1.E-20)THEN
+ ZCRIAUTI=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(JI,JJ,JK)-XTT)+XBCRIAUTI))
+ ZAUTI = (ZSBAR - ZCRIAUTI/ZFRAC(JI,JJ,JK))/ZSIGMA
+ ZGAUTI = -ZAUTI/SQRT(2.)
+ !Approximation of erf function for Gaussian distribution
+ ZGAUI = 1 - SIGN(1., ZGAUTI) * SQRT(1-EXP(-4*ZGAUTI**2/XPI))
+ PHLI_HCF(JI,JJ,JK) = MAX( 0., MIN(1.,0.5*ZGAUI))
+ PHLI_HRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK)*(EXP(-ZGAUTI**2)-ZGAUTI*SQRT(XPI)*ZGAUI)*ZSIGMA/SQRT(2.*XPI)
+ PHLI_HRI(JI,JJ,JK) = PHLI_HRI(JI,JJ,JK) + ZCRIAUTI*PHLI_HCF(JI,JJ,JK)
+ PHLI_HRI(JI,JJ,JK) = MAX(PHLI_HRI(JI,JJ,JK), 0.)
+ ELSE
+ PHLI_HCF(JI,JJ,JK)=0.
+ PHLI_HRI(JI,JJ,JK)=0.
+ ENDIF
+ ENDIF
+
+ ELSEIF(HCONDENS == 'CB02')THEN
+ !Cloud fraction
#ifndef MNH_BITREP
- PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5+0.36*ATAN(1.55*ZQ1)) )
+ PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5+0.36*ATAN(1.55*ZQ1)) )
#else
- PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5+0.36*BR_ATAN(1.55*ZQ1)) )
+ PCLDFR(JI,JJ,JK) = MAX( 0., MIN(1.,0.5+0.36*BR_ATAN(1.55*ZQ1)) )
#endif
- ! total condensate
- IF (ZQ1 > 0. .AND. ZQ1 <= 2 ) THEN
+ !Total condensate
+ IF (ZQ1 > 0. .AND. ZQ1 <= 2 ) THEN
#ifndef MNH_BITREP
- ZCOND = MIN(EXP(-1.)+.66*ZQ1+.086*ZQ1**2, 2.) ! We use the MIN function for continuity
+ ZCOND = MIN(EXP(-1.)+.66*ZQ1+.086*ZQ1**2, 2.) ! We use the MIN function for continuity
#else
- ZCOND = MIN(BR_EXP(-1.)+.66*ZQ1+.086*BR_P2(ZQ1), 2.) ! We use the MIN function for continuity
+ ZCOND = MIN(BR_EXP(-1.)+.66*ZQ1+.086*BR_P2(ZQ1), 2.) ! We use the MIN function for continuity
#endif
- ELSE IF (ZQ1 > 2.) THEN
- ZCOND = ZQ1
- ELSE
+ ELSE IF (ZQ1 > 2.) THEN
+ ZCOND = ZQ1
+ ELSE
#ifndef MNH_BITREP
- ZCOND = EXP( 1.2*ZQ1-1. )
+ ZCOND = EXP( 1.2*ZQ1-1. )
#else
- ZCOND = BR_EXP( 1.2*ZQ1-1. )
+ ZCOND = BR_EXP( 1.2*ZQ1-1. )
#endif
+ END IF
+
+ INQ1 = MIN( MAX(-22,FLOOR(MIN(100., MAX(-100., 2*ZQ1))) ), 10) !inner min/max prevents sigfpe when 2*zq1 does not fit into an int
+ ZINC = 2.*ZQ1 - INQ1
+
+ PSIGRC(JI,JJ,JK) = MIN(1.,(1.-ZINC)*ZSRC_1D(INQ1)+ZINC*ZSRC_1D(INQ1+1))
+
+ IF(PRESENT(PHLC_HCF) .AND. PRESENT(PHLC_HRC))THEN
+ PHLC_HCF(JI,JJ,JK)=0.
+ PHLC_HRC(JI,JJ,JK)=0.
+ ENDIF
+ IF(PRESENT(PHLI_HCF) .AND. PRESENT(PHLI_HRI))THEN
+ PHLI_HCF(JI,JJ,JK)=0.
+ PHLI_HRI(JI,JJ,JK)=0.
+ ENDIF
ENDIF
- ZCOND = ZCOND * ZSIGMA
IF ( ZCOND < 1.E-12 ) THEN
ZCOND = 0.
@@ -474,14 +562,17 @@ DO JK=IKTB,IKTE
ZCOND=0.
ENDIF
- PT(JI,JJ,JK) = PT(JI,JJ,JK) + (((1.-ZFRAC(JI,JJ,JK))*ZCOND-PRC(JI,JJ,JK))*ZLV(JI,JJ,JK) + &
- &(ZFRAC(JI,JJ,JK) *ZCOND-PRI(JI,JJ,JK))*ZLS(JI,JJ,JK) ) &
- & /ZCPD(JI,JJ,JK)
+ ZRCOLD=PRC(JI,JJ,JK)
+ ZRIOLD=PRI(JI,JJ,JK)
+
PRC(JI,JJ,JK) = (1.-ZFRAC(JI,JJ,JK)) * ZCOND ! liquid condensate
PRI(JI,JJ,JK) = ZFRAC(JI,JJ,JK) * ZCOND ! solid condensate
+
+ PT(JI,JJ,JK) = PT(JI,JJ,JK) + ((PRC(JI,JJ,JK)-ZRCOLD)*ZLV(JI,JJ,JK) + &
+ &(PRI(JI,JJ,JK)-ZRIOLD)*ZLS(JI,JJ,JK) ) &
+ & /ZCPD(JI,JJ,JK)
PRV(JI,JJ,JK) = ZRT(JI,JJ,JK) - PRC(JI,JJ,JK) - PRI(JI,JJ,JK)
-
! s r_c/ sig_s^2
! PSIGRC(JI,JJ,JK) = PCLDFR(JI,JJ,JK) ! use simple Gaussian relation
!
@@ -489,14 +580,13 @@ DO JK=IKTB,IKTE
!
! PSIGRC(JI,JJ,JK) = 2.*PCLDFR(JI,JJ,JK) * MIN( 3. , MAX(1.,1.-ZQ1) )
! in the 3D case lambda_3 = 1.
-! INQ1 = MIN( MAX(-22,FLOOR(2*ZQ1) ), 10)
- INQ1 = MIN( MAX(-22,FLOOR(MIN(100.,MAX(-100.,2*ZQ1))) ), 10)
- !inner min/max prevent sigfpe when 2*zq1 does not fit into an int
- ZINC = 2.*ZQ1 - INQ1
-
- PSIGRC(JI,JJ,JK) = MIN(1.,(1.-ZINC)*ZSRC_1D(INQ1)+ZINC*ZSRC_1D(INQ1+1))
- PSIGRC(JI,JJ,JK) = PSIGRC(JI,JJ,JK)* MIN( 3. , MAX(1.,1.-ZQ1) )
+ IF(HLAMBDA3=='CB')THEN
+ PSIGRC(JI,JJ,JK) = PSIGRC(JI,JJ,JK)* MIN( 3. , MAX(1.,1.-ZQ1) )
+ ELSEIF(HLAMBDA3=='NONE') THEN
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'CONDENSATION', 'invalid value for HLAMBDA3: ' // TRIM( HLAMBDA3 ) )
+ ENDIF
END DO
END DO
diff --git a/src/MNH/contrav.f90 b/src/MNH/contrav.f90
index bcfab6069af65f513ca497c7095c97acb9e0ebed..99cfde5f47679858d6dc242b10ba602478179428 100644
--- a/src/MNH/contrav.f90
+++ b/src/MNH/contrav.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/data_aersr.f b/src/MNH/data_aersr.f
deleted file mode 100644
index 0ea62bd856e4b50c4cbad59bc91a772e93152ef3..0000000000000000000000000000000000000000
--- a/src/MNH/data_aersr.f
+++ /dev/null
@@ -1,96 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 data_aersr.f 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-C=======================================================================
-C
-C *** ISORROPIA CODE
-C *** BLOCK DATA AERSR
-C *** CONTAINS DATA FOR AEROSOL SULFATE RATIO ARRAY NEEDED IN FUNCTION
-C GETASR
-C
-C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
-C *** WRITTEN BY ATHANASIOS NENES
-C
-C=======================================================================
-C
- BLOCK DATA AERSR
- PARAMETER (NSO4S=14, NRHS=20, NASRD=NSO4S*NRHS)
- COMMON /ASRC/ ASRAT(NASRD), ASSO4(NSO4S)
-C
- DATA ASSO4/1.0E-9, 2.5E-9, 5.0E-9, 7.5E-9, 1.0E-8,
- & 2.5E-8, 5.0E-8, 7.5E-8, 1.0E-7, 2.5E-7,
- & 5.0E-7, 7.5E-7, 1.0E-6, 5.0E-6/
-C
- DATA (ASRAT(I), I=1,100)/
- & 1.020464, 0.9998130, 0.9960167, 0.9984423, 1.004004,
- & 1.010885, 1.018356, 1.026726, 1.034268, 1.043846,
- & 1.052933, 1.062230, 1.062213, 1.080050, 1.088350,
- & 1.096603, 1.104289, 1.111745, 1.094662, 1.121594,
- & 1.268909, 1.242444, 1.233815, 1.232088, 1.234020,
- & 1.238068, 1.243455, 1.250636, 1.258734, 1.267543,
- & 1.276948, 1.286642, 1.293337, 1.305592, 1.314726,
- & 1.323463, 1.333258, 1.343604, 1.344793, 1.355571,
- & 1.431463, 1.405204, 1.395791, 1.393190, 1.394403,
- & 1.398107, 1.403811, 1.411744, 1.420560, 1.429990,
- & 1.439742, 1.449507, 1.458986, 1.468403, 1.477394,
- & 1.487373, 1.495385, 1.503854, 1.512281, 1.520394,
- & 1.514464, 1.489699, 1.480686, 1.478187, 1.479446,
- & 1.483310, 1.489316, 1.497517, 1.506501, 1.515816,
- & 1.524724, 1.533950, 1.542758, 1.551730, 1.559587,
- & 1.568343, 1.575610, 1.583140, 1.590440, 1.596481,
- & 1.567743, 1.544426, 1.535928, 1.533645, 1.535016,
- & 1.539003, 1.545124, 1.553283, 1.561886, 1.570530,
- & 1.579234, 1.587813, 1.595956, 1.603901, 1.611349,
- & 1.618833, 1.625819, 1.632543, 1.639032, 1.645276/
-
- DATA (ASRAT(I), I=101,200)/
- & 1.707390, 1.689553, 1.683198, 1.681810, 1.683490,
- & 1.687477, 1.693148, 1.700084, 1.706917, 1.713507,
- & 1.719952, 1.726190, 1.731985, 1.737544, 1.742673,
- & 1.747756, 1.752431, 1.756890, 1.761141, 1.765190,
- & 1.785657, 1.771851, 1.767063, 1.766229, 1.767901,
- & 1.771455, 1.776223, 1.781769, 1.787065, 1.792081,
- & 1.796922, 1.801561, 1.805832, 1.809896, 1.813622,
- & 1.817292, 1.820651, 1.823841, 1.826871, 1.829745,
- & 1.822215, 1.810497, 1.806496, 1.805898, 1.807480,
- & 1.810684, 1.814860, 1.819613, 1.824093, 1.828306,
- & 1.832352, 1.836209, 1.839748, 1.843105, 1.846175,
- & 1.849192, 1.851948, 1.854574, 1.857038, 1.859387,
- & 1.844588, 1.834208, 1.830701, 1.830233, 1.831727,
- & 1.834665, 1.838429, 1.842658, 1.846615, 1.850321,
- & 1.853869, 1.857243, 1.860332, 1.863257, 1.865928,
- & 1.868550, 1.870942, 1.873208, 1.875355, 1.877389,
- & 1.899556, 1.892637, 1.890367, 1.890165, 1.891317,
- & 1.893436, 1.896036, 1.898872, 1.901485, 1.903908,
- & 1.906212, 1.908391, 1.910375, 1.912248, 1.913952,
- & 1.915621, 1.917140, 1.918576, 1.919934, 1.921220/
-
- DATA (ASRAT(I), I=201,280)/
- & 1.928264, 1.923245, 1.921625, 1.921523, 1.922421,
- & 1.924016, 1.925931, 1.927991, 1.929875, 1.931614,
- & 1.933262, 1.934816, 1.936229, 1.937560, 1.938769,
- & 1.939951, 1.941026, 1.942042, 1.943003, 1.943911,
- & 1.941205, 1.937060, 1.935734, 1.935666, 1.936430,
- & 1.937769, 1.939359, 1.941061, 1.942612, 1.944041,
- & 1.945393, 1.946666, 1.947823, 1.948911, 1.949900,
- & 1.950866, 1.951744, 1.952574, 1.953358, 1.954099,
- & 1.948985, 1.945372, 1.944221, 1.944171, 1.944850,
- & 1.946027, 1.947419, 1.948902, 1.950251, 1.951494,
- & 1.952668, 1.953773, 1.954776, 1.955719, 1.956576,
- & 1.957413, 1.958174, 1.958892, 1.959571, 1.960213,
- & 1.977193, 1.975540, 1.975023, 1.975015, 1.975346,
- & 1.975903, 1.976547, 1.977225, 1.977838, 1.978401,
- & 1.978930, 1.979428, 1.979879, 1.980302, 1.980686,
- & 1.981060, 1.981401, 1.981722, 1.982025, 1.982312/
-C
-C *** END OF BLOCK DATA AERSR ******************************************
-C
- END
-
diff --git a/src/MNH/data_blkiso.f b/src/MNH/data_blkiso.f
deleted file mode 100644
index d36a25d6f850d58aa8a4f09bca4919e3ea17f1c1..0000000000000000000000000000000000000000
--- a/src/MNH/data_blkiso.f
+++ /dev/null
@@ -1,180 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 data_blkiso.f 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-C=======================================================================
-C
-C *** ISORROPIA CODE
-C *** BLOCK DATA BLKISO
-C *** THIS SUBROUTINE PROVIDES INITIAL (DEFAULT) VALUES TO PROGRAM
-C PARAMETERS VIA DATA STATEMENTS
-C
-C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
-C *** WRITTEN BY ATHANASIOS NENES
-C
-C=======================================================================
-C
- BLOCK DATA BLKISO
- INCLUDE 'isrpia.inc'
-C
-C *** DEFAULT VALUES *************************************************
-C
- DATA TEMP/298.0/, R/82.0567D-6/, RH/0.9D0/, EPS/1D-6/, MAXIT/100/,
- & TINY/1D-20/, GREAT/1D10/, ZERO/0.0D0/, ONE/1.0D0/,NSWEEP/4/,
- & TINY2/1D-11/,NDIV/5/
-C
- DATA MOLAL/NIONS*0.0D0/, MOLALR/NPAIR*0.0D0/, GAMA/NPAIR*0.1D0/,
- & GAMOU/NPAIR*1D10/, GAMIN/NPAIR*1D10/, CALAIN/.TRUE./,
- & CALAOU/.TRUE./, EPSACT/5D-2/, ICLACT/0/,
- & IACALC/1/, WFTYP/2/
-C
- DATA ERRSTK/NERRMX*0/, ERRMSG/NERRMX*' '/, NOFER/0/,
- & STKOFL/.FALSE./
-C
- DATA IPROB/0/, METSTBL/0/
-C
- DATA VERSION /'1.5 (12/03/03)'/
-C
-C *** OTHER PARAMETERS ***********************************************
-C
- DATA SMW/58.5,142.,85.0,132.,80.0,53.5,98.0,98.0,115.,63.0,
- & 36.5,120.,247./
- & IMW/ 1.0,23.0,18.0,35.5,96.0,97.0,63.0/,
- & WMW/23.0,98.0,17.0,63.0,36.5/
-C
- DATA ZZ/1,2,1,2,1,1,2,1,1,1,1,1,2/, Z /1,1,1,1,2,1,1/
-C
-C *** ZSR RELATIONSHIP PARAMETERS **************************************
-C
-C awas= ammonium sulfate
-C
- DATA AWAS/33*100.,30,30,30,29.54,28.25,27.06,25.94,
- & 24.89,23.90,22.97,22.10,21.27,20.48,19.73,19.02,18.34,17.69,
- & 17.07,16.48,15.91,15.37,14.85,14.34,13.86,13.39,12.94,12.50,
- & 12.08,11.67,11.27,10.88,10.51,10.14, 9.79, 9.44, 9.10, 8.78,
- & 8.45, 8.14, 7.83, 7.53, 7.23, 6.94, 6.65, 6.36, 6.08, 5.81,
- & 5.53, 5.26, 4.99, 4.72, 4.46, 4.19, 3.92, 3.65, 3.38, 3.11,
- & 2.83, 2.54, 2.25, 1.95, 1.63, 1.31, 0.97, 0.63, 0.30, 0.001/
-C
-C awsn= sodium nitrate
-C
- DATA AWSN/ 9*1.e5,685.59,
- & 451.00,336.46,268.48,223.41,191.28,
- & 167.20,148.46,133.44,121.12,110.83,
- & 102.09,94.57,88.03,82.29,77.20,72.65,68.56,64.87,61.51,58.44,
- & 55.62,53.03,50.63,48.40,46.32,44.39,42.57,40.87,39.27,37.76,
- & 36.33,34.98,33.70,32.48,31.32,30.21,29.16,28.14,27.18,26.25,
- & 25.35,24.50,23.67,22.87,22.11,21.36,20.65,19.95,19.28,18.62,
- & 17.99,17.37,16.77,16.18,15.61,15.05,14.51,13.98,13.45,12.94,
- & 12.44,11.94,11.46,10.98,10.51,10.04, 9.58, 9.12, 8.67, 8.22,
- & 7.77, 7.32, 6.88, 6.43, 5.98, 5.53, 5.07, 4.61, 4.15, 3.69,
- & 3.22, 2.76, 2.31, 1.87, 1.47, 1.10, 0.77, 0.48, 0.23, 0.001/
-C
-C awsc= sodium chloride
-C
- DATA AWSC/
- & 100., 100., 100., 100., 100., 100., 100., 100., 100., 100.,
- & 100., 100., 100., 100., 100., 100., 100., 100., 100.,16.34,
- & 16.28,16.22,16.15,16.09,16.02,15.95,15.88,15.80,15.72,15.64,
- & 15.55,15.45,15.36,15.25,15.14,15.02,14.89,14.75,14.60,14.43,
- & 14.25,14.04,13.81,13.55,13.25,12.92,12.56,12.19,11.82,11.47,
- & 11.13,10.82,10.53,10.26,10.00, 9.76, 9.53, 9.30, 9.09, 8.88,
- & 8.67, 8.48, 8.28, 8.09, 7.90, 7.72, 7.54, 7.36, 7.17, 6.99,
- & 6.81, 6.63, 6.45, 6.27, 6.09, 5.91, 5.72, 5.53, 5.34, 5.14,
- & 4.94, 4.74, 4.53, 4.31, 4.09, 3.86, 3.62, 3.37, 3.12, 2.85,
- & 2.58, 2.30, 2.01, 1.72, 1.44, 1.16, 0.89, 0.64, 0.40, 0.18/
-C
-C awac= ammonium chloride
-C
- DATA AWAC/
- & 100., 100., 100., 100., 100., 100., 100., 100., 100., 100.,
- & 100., 100., 100., 100., 100., 100., 100., 100., 100.,31.45,
- & 31.30,31.14,30.98,30.82,30.65,30.48,30.30,30.11,29.92,29.71,
- & 29.50,29.29,29.06,28.82,28.57,28.30,28.03,27.78,27.78,27.77,
- & 27.77,27.43,27.07,26.67,26.21,25.73,25.18,24.56,23.84,23.01,
- & 22.05,20.97,19.85,18.77,17.78,16.89,16.10,15.39,14.74,14.14,
- & 13.59,13.06,12.56,12.09,11.65,11.22,10.81,10.42,10.03, 9.66,
- & 9.30, 8.94, 8.59, 8.25, 7.92, 7.59, 7.27, 6.95, 6.63, 6.32,
- & 6.01, 5.70, 5.39, 5.08, 4.78, 4.47, 4.17, 3.86, 3.56, 3.25,
- & 2.94, 2.62, 2.30, 1.98, 1.65, 1.32, 0.97, 0.62, 0.26, 0.13/
-C
-C awss= sodium sulfate
-C
- DATA AWSS/34*1.e5,23*14.30,14.21,12.53,11.47,
- & 10.66,10.01, 9.46, 8.99, 8.57, 8.19, 7.85, 7.54, 7.25, 6.98,
- & 6.74, 6.50, 6.29, 6.08, 5.88, 5.70, 5.52, 5.36, 5.20, 5.04,
- & 4.90, 4.75, 4.54, 4.34, 4.14, 3.93, 3.71, 3.49, 3.26, 3.02,
- & 2.76, 2.49, 2.20, 1.89, 1.55, 1.18, 0.82, 0.49, 0.22, 0.001/
-C
-C awab= ammonium bisulfate
-C
- DATA AWAB/356.45,296.51,253.21,220.47,194.85,
- & 174.24,157.31,143.16,131.15,120.82,
- & 111.86,103.99,97.04,90.86,85.31,80.31,75.78,71.66,67.90,64.44,
- & 61.25,58.31,55.58,53.04,50.68,48.47,46.40,44.46,42.63,40.91,
- & 39.29,37.75,36.30,34.92,33.61,32.36,31.18,30.04,28.96,27.93,
- & 26.94,25.99,25.08,24.21,23.37,22.57,21.79,21.05,20.32,19.63,
- & 18.96,18.31,17.68,17.07,16.49,15.92,15.36,14.83,14.31,13.80,
- & 13.31,12.83,12.36,11.91,11.46,11.03,10.61,10.20, 9.80, 9.41,
- & 9.02, 8.64, 8.28, 7.91, 7.56, 7.21, 6.87, 6.54, 6.21, 5.88,
- & 5.56, 5.25, 4.94, 4.63, 4.33, 4.03, 3.73, 3.44, 3.14, 2.85,
- & 2.57, 2.28, 1.99, 1.71, 1.42, 1.14, 0.86, 0.57, 0.29, 0.001/
-C
-C awsa= sulfuric acid
-C
- DATA AWSA/
- & 34.0,33.56,29.22,26.55,24.61,23.11,21.89,20.87,19.99,
- & 19.21,18.51,17.87,17.29,16.76,16.26,15.8,15.37,14.95,14.56,
- & 14.20,13.85,13.53,13.22,12.93,12.66,12.40,12.14,11.90,11.67,
- & 11.44,11.22,11.01,10.8,10.60,10.4,10.2,10.01,9.83,9.65,9.47,
- & 9.3,9.13,8.96,8.81,8.64,8.48,8.33,8.17,8.02,7.87,7.72,7.58,
- & 7.44,7.30,7.16,7.02,6.88,6.75,6.61,6.48,6.35,6.21,6.08,5.95,
- & 5.82,5.69,5.56,5.44,5.31,5.18,5.05,4.92,4.79,4.66,4.53,4.40,
- & 4.27,4.14,4.,3.87,3.73,3.6,3.46,3.31,3.17,3.02,2.87,2.72,
- & 2.56,2.4,2.23,2.05,1.87,1.68,1.48,1.27,1.05,0.807,0.552,0.281/
-C
-C awlc= (NH4)3H(SO4)2
-C
- DATA AWLC/34*1.e5,17.0,16.5,15.94,15.31,14.71,14.14,
- & 13.60,13.08,12.59,12.12,11.68,11.25,10.84,10.44,10.07, 9.71,
- & 9.36, 9.02, 8.70, 8.39, 8.09, 7.80, 7.52, 7.25, 6.99, 6.73,
- & 6.49, 6.25, 6.02, 5.79, 5.57, 5.36, 5.15, 4.95, 4.76, 4.56,
- & 4.38, 4.20, 4.02, 3.84, 3.67, 3.51, 3.34, 3.18, 3.02, 2.87,
- & 2.72, 2.57, 2.42, 2.28, 2.13, 1.99, 1.85, 1.71, 1.57, 1.43,
- & 1.30, 1.16, 1.02, 0.89, 0.75, 0.61, 0.46, 0.32, 0.16, 0.001/
-C
-C awan= ammonium nitrate
-C
- DATA AWAN/31*1.e5,
- & 97.17,92.28,87.66,83.15,78.87,74.84,70.98,67.46,64.11,
- & 60.98,58.07,55.37,52.85,50.43,48.24,46.19,44.26,42.40,40.70,
- & 39.10,37.54,36.10,34.69,33.35,32.11,30.89,29.71,28.58,27.46,
- & 26.42,25.37,24.33,23.89,22.42,21.48,20.56,19.65,18.76,17.91,
- & 17.05,16.23,15.40,14.61,13.82,13.03,12.30,11.55,10.83,10.14,
- & 9.44, 8.79, 8.13, 7.51, 6.91, 6.32, 5.75, 5.18, 4.65, 4.14,
- & 3.65, 3.16, 2.71, 2.26, 1.83, 1.42, 1.03, 0.66, 0.30, 0.001/
-C
-C awsb= sodium bisulfate
-C
- DATA AWSB/173.72,156.88,142.80,130.85,120.57,
- & 111.64,103.80,96.88,90.71,85.18,
- & 80.20,75.69,71.58,67.82,64.37,61.19,58.26,55.53,53.00,50.64,
- & 48.44,46.37,44.44,42.61,40.90,39.27,37.74,36.29,34.91,33.61,
- & 32.36,31.18,30.05,28.97,27.94,26.95,26.00,25.10,24.23,23.39,
- & 22.59,21.81,21.07,20.35,19.65,18.98,18.34,17.71,17.11,16.52,
- & 15.95,15.40,14.87,14.35,13.85,13.36,12.88,12.42,11.97,11.53,
- & 11.10,10.69,10.28, 9.88, 9.49, 9.12, 8.75, 8.38, 8.03, 7.68,
- & 7.34, 7.01, 6.69, 6.37, 6.06, 5.75, 5.45, 5.15, 4.86, 4.58,
- & 4.30, 4.02, 3.76, 3.49, 3.23, 2.98, 2.73, 2.48, 2.24, 2.01,
- & 1.78, 1.56, 1.34, 1.13, 0.92, 0.73, 0.53, 0.35, 0.17, 0.001/
-C
-C *** END OF BLOCK DATA SUBPROGRAM *************************************
-C
- END
-
diff --git a/src/MNH/data_expon.f b/src/MNH/data_expon.f
deleted file mode 100644
index aa5f4ddd696b164238f45eb83a3e0068db0045f7..0000000000000000000000000000000000000000
--- a/src/MNH/data_expon.f
+++ /dev/null
@@ -1,88 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 data_expon.f 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-C=======================================================================
-C
-C *** ISORROPIA CODE
-C *** BLOCK DATA EXPON
-C *** CONTAINS DATA FOR EXPONENT ARRAYS NEEDED IN FUNCTION EXP10
-C
-C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
-C *** WRITTEN BY ATHANASIOS NENES
-C
-C=======================================================================
-C
- BLOCK DATA EXPON
-C
-C *** Common block definition
-C
- REAL AINT10, ADEC10
- COMMON /EXPNC/ AINT10(20), ADEC10(200)
-C
-C *** Integer part
-C
- DATA AINT10/
- & 0.1000E-08, 0.1000E-07, 0.1000E-06, 0.1000E-05, 0.1000E-04,
- & 0.1000E-03, 0.1000E-02, 0.1000E-01, 0.1000E+00, 0.1000E+01,
- & 0.1000E+02, 0.1000E+03, 0.1000E+04, 0.1000E+05, 0.1000E+06,
- & 0.1000E+07, 0.1000E+08, 0.1000E+09, 0.1000E+10, 0.1000E+11
- & /
-C
-C *** decimal part
-C
- DATA (ADEC10(I),I=1,100)/
- & 0.1023E+00, 0.1047E+00, 0.1072E+00, 0.1096E+00, 0.1122E+00,
- & 0.1148E+00, 0.1175E+00, 0.1202E+00, 0.1230E+00, 0.1259E+00,
- & 0.1288E+00, 0.1318E+00, 0.1349E+00, 0.1380E+00, 0.1413E+00,
- & 0.1445E+00, 0.1479E+00, 0.1514E+00, 0.1549E+00, 0.1585E+00,
- & 0.1622E+00, 0.1660E+00, 0.1698E+00, 0.1738E+00, 0.1778E+00,
- & 0.1820E+00, 0.1862E+00, 0.1905E+00, 0.1950E+00, 0.1995E+00,
- & 0.2042E+00, 0.2089E+00, 0.2138E+00, 0.2188E+00, 0.2239E+00,
- & 0.2291E+00, 0.2344E+00, 0.2399E+00, 0.2455E+00, 0.2512E+00,
- & 0.2570E+00, 0.2630E+00, 0.2692E+00, 0.2754E+00, 0.2818E+00,
- & 0.2884E+00, 0.2951E+00, 0.3020E+00, 0.3090E+00, 0.3162E+00,
- & 0.3236E+00, 0.3311E+00, 0.3388E+00, 0.3467E+00, 0.3548E+00,
- & 0.3631E+00, 0.3715E+00, 0.3802E+00, 0.3890E+00, 0.3981E+00,
- & 0.4074E+00, 0.4169E+00, 0.4266E+00, 0.4365E+00, 0.4467E+00,
- & 0.4571E+00, 0.4677E+00, 0.4786E+00, 0.4898E+00, 0.5012E+00,
- & 0.5129E+00, 0.5248E+00, 0.5370E+00, 0.5495E+00, 0.5623E+00,
- & 0.5754E+00, 0.5888E+00, 0.6026E+00, 0.6166E+00, 0.6310E+00,
- & 0.6457E+00, 0.6607E+00, 0.6761E+00, 0.6918E+00, 0.7079E+00,
- & 0.7244E+00, 0.7413E+00, 0.7586E+00, 0.7762E+00, 0.7943E+00,
- & 0.8128E+00, 0.8318E+00, 0.8511E+00, 0.8710E+00, 0.8913E+00,
- & 0.9120E+00, 0.9333E+00, 0.9550E+00, 0.9772E+00, 0.1000E+01/
-
- DATA (ADEC10(I),I=101,200)/
- & 0.1023E+01, 0.1047E+01, 0.1072E+01, 0.1096E+01, 0.1122E+01,
- & 0.1148E+01, 0.1175E+01, 0.1202E+01, 0.1230E+01, 0.1259E+01,
- & 0.1288E+01, 0.1318E+01, 0.1349E+01, 0.1380E+01, 0.1413E+01,
- & 0.1445E+01, 0.1479E+01, 0.1514E+01, 0.1549E+01, 0.1585E+01,
- & 0.1622E+01, 0.1660E+01, 0.1698E+01, 0.1738E+01, 0.1778E+01,
- & 0.1820E+01, 0.1862E+01, 0.1905E+01, 0.1950E+01, 0.1995E+01,
- & 0.2042E+01, 0.2089E+01, 0.2138E+01, 0.2188E+01, 0.2239E+01,
- & 0.2291E+01, 0.2344E+01, 0.2399E+01, 0.2455E+01, 0.2512E+01,
- & 0.2570E+01, 0.2630E+01, 0.2692E+01, 0.2754E+01, 0.2818E+01,
- & 0.2884E+01, 0.2951E+01, 0.3020E+01, 0.3090E+01, 0.3162E+01,
- & 0.3236E+01, 0.3311E+01, 0.3388E+01, 0.3467E+01, 0.3548E+01,
- & 0.3631E+01, 0.3715E+01, 0.3802E+01, 0.3890E+01, 0.3981E+01,
- & 0.4074E+01, 0.4169E+01, 0.4266E+01, 0.4365E+01, 0.4467E+01,
- & 0.4571E+01, 0.4677E+01, 0.4786E+01, 0.4898E+01, 0.5012E+01,
- & 0.5129E+01, 0.5248E+01, 0.5370E+01, 0.5495E+01, 0.5623E+01,
- & 0.5754E+01, 0.5888E+01, 0.6026E+01, 0.6166E+01, 0.6310E+01,
- & 0.6457E+01, 0.6607E+01, 0.6761E+01, 0.6918E+01, 0.7079E+01,
- & 0.7244E+01, 0.7413E+01, 0.7586E+01, 0.7762E+01, 0.7943E+01,
- & 0.8128E+01, 0.8318E+01, 0.8511E+01, 0.8710E+01, 0.8913E+01,
- & 0.9120E+01, 0.9333E+01, 0.9550E+01, 0.9772E+01, 0.1000E+02
- & /
-C
-C *** END OF BLOCK DATA EXPON ******************************************
-C
- END
-
diff --git a/src/MNH/data_kmcf198.f b/src/MNH/data_kmcf198.f
deleted file mode 100644
index fb04f2530ef35c42d75fbbc591f2d2ea5d27d91b..0000000000000000000000000000000000000000
--- a/src/MNH/data_kmcf198.f
+++ /dev/null
@@ -1,2205 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 data_kmcf198.f 2006/05/18 13:07:25
-!-----------------------------------------------------------------
- BLOCK DATA KMCF198
-C
-C *** Common block definition
-C
- COMMON /KMC198/
- &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741),
- &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741),
- &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741),
- &BNC13M( 741)
-C
-C *** NaCl
-C
- DATA (BNC01M(I),I=1,100)/
- &-0.49640E-01,-0.10303E+00,-0.12698E+00,-0.14245E+00,-0.15358E+00,
- &-0.16202E+00,-0.16860E+00,-0.17383E+00,-0.17802E+00,-0.18139E+00,
- &-0.18410E+00,-0.18626E+00,-0.18796E+00,-0.18927E+00,-0.19024E+00,
- &-0.19093E+00,-0.19135E+00,-0.19156E+00,-0.19156E+00,-0.19139E+00,
- &-0.19106E+00,-0.19059E+00,-0.18999E+00,-0.18928E+00,-0.18846E+00,
- &-0.18756E+00,-0.18657E+00,-0.18550E+00,-0.18436E+00,-0.18316E+00,
- &-0.18191E+00,-0.18060E+00,-0.17925E+00,-0.17786E+00,-0.17643E+00,
- &-0.17496E+00,-0.17347E+00,-0.17194E+00,-0.17040E+00,-0.16883E+00,
- &-0.16724E+00,-0.16563E+00,-0.16401E+00,-0.16238E+00,-0.16073E+00,
- &-0.15908E+00,-0.15741E+00,-0.15574E+00,-0.15406E+00,-0.15237E+00,
- &-0.15068E+00,-0.14899E+00,-0.14729E+00,-0.14558E+00,-0.14388E+00,
- &-0.14217E+00,-0.14046E+00,-0.13874E+00,-0.13702E+00,-0.13530E+00,
- &-0.13357E+00,-0.13184E+00,-0.13011E+00,-0.12837E+00,-0.12663E+00,
- &-0.12488E+00,-0.12312E+00,-0.12136E+00,-0.11959E+00,-0.11781E+00,
- &-0.11603E+00,-0.11423E+00,-0.11243E+00,-0.11061E+00,-0.10878E+00,
- &-0.10694E+00,-0.10509E+00,-0.10322E+00,-0.10134E+00,-0.99450E-01,
- &-0.97542E-01,-0.95618E-01,-0.93679E-01,-0.91723E-01,-0.89752E-01,
- &-0.87764E-01,-0.85759E-01,-0.83737E-01,-0.81699E-01,-0.79643E-01,
- &-0.77570E-01,-0.75481E-01,-0.73375E-01,-0.71252E-01,-0.69113E-01,
- &-0.66957E-01,-0.64786E-01,-0.62600E-01,-0.60399E-01,-0.58183E-01/
-
- DATA (BNC01M(I),I=101,200)/
- &-0.55953E-01,-0.53709E-01,-0.51453E-01,-0.49184E-01,-0.46903E-01,
- &-0.44610E-01,-0.42307E-01,-0.39994E-01,-0.37670E-01,-0.35338E-01,
- &-0.32997E-01,-0.30649E-01,-0.28293E-01,-0.25931E-01,-0.23562E-01,
- &-0.21188E-01,-0.18808E-01,-0.16424E-01,-0.14036E-01,-0.11644E-01,
- &-0.92495E-02,-0.68520E-02,-0.44521E-02,-0.20502E-02, 0.35305E-03,
- & 0.27576E-02, 0.51630E-02, 0.75689E-02, 0.99750E-02, 0.12381E-01,
- & 0.14787E-01, 0.17192E-01, 0.19597E-01, 0.22000E-01, 0.24402E-01,
- & 0.26803E-01, 0.29203E-01, 0.31600E-01, 0.33996E-01, 0.36390E-01,
- & 0.38782E-01, 0.41172E-01, 0.43559E-01, 0.45944E-01, 0.48326E-01,
- & 0.50706E-01, 0.53083E-01, 0.55458E-01, 0.57830E-01, 0.60198E-01,
- & 0.62564E-01, 0.64927E-01, 0.67287E-01, 0.69644E-01, 0.71998E-01,
- & 0.74349E-01, 0.76696E-01, 0.79041E-01, 0.81382E-01, 0.83719E-01,
- & 0.86054E-01, 0.88385E-01, 0.90713E-01, 0.93037E-01, 0.95358E-01,
- & 0.97676E-01, 0.99990E-01, 0.10230E+00, 0.10461E+00, 0.10691E+00,
- & 0.10921E+00, 0.11151E+00, 0.11380E+00, 0.11609E+00, 0.11837E+00,
- & 0.12066E+00, 0.12293E+00, 0.12521E+00, 0.12748E+00, 0.12975E+00,
- & 0.13201E+00, 0.13427E+00, 0.13653E+00, 0.13878E+00, 0.14103E+00,
- & 0.14327E+00, 0.14551E+00, 0.14775E+00, 0.14998E+00, 0.15221E+00,
- & 0.15444E+00, 0.15666E+00, 0.15888E+00, 0.16109E+00, 0.16330E+00,
- & 0.16551E+00, 0.16771E+00, 0.16991E+00, 0.17211E+00, 0.17430E+00/
-
- DATA (BNC01M(I),I=201,300)/
- & 0.17649E+00, 0.17867E+00, 0.18085E+00, 0.18302E+00, 0.18520E+00,
- & 0.18736E+00, 0.18953E+00, 0.19169E+00, 0.19384E+00, 0.19600E+00,
- & 0.19814E+00, 0.20029E+00, 0.20243E+00, 0.20457E+00, 0.20670E+00,
- & 0.20883E+00, 0.21095E+00, 0.21307E+00, 0.21519E+00, 0.21730E+00,
- & 0.21941E+00, 0.22151E+00, 0.22362E+00, 0.22571E+00, 0.22781E+00,
- & 0.22990E+00, 0.23198E+00, 0.23406E+00, 0.23614E+00, 0.23821E+00,
- & 0.24028E+00, 0.24235E+00, 0.24441E+00, 0.24647E+00, 0.24852E+00,
- & 0.25057E+00, 0.25262E+00, 0.25466E+00, 0.25670E+00, 0.25873E+00,
- & 0.26076E+00, 0.26279E+00, 0.26481E+00, 0.26683E+00, 0.26885E+00,
- & 0.27086E+00, 0.27286E+00, 0.27487E+00, 0.27687E+00, 0.27886E+00,
- & 0.28085E+00, 0.28284E+00, 0.28483E+00, 0.28681E+00, 0.28878E+00,
- & 0.29075E+00, 0.29272E+00, 0.29469E+00, 0.29665E+00, 0.29861E+00,
- & 0.30056E+00, 0.30251E+00, 0.30445E+00, 0.30640E+00, 0.30833E+00,
- & 0.31027E+00, 0.31220E+00, 0.31412E+00, 0.31605E+00, 0.31797E+00,
- & 0.31988E+00, 0.32179E+00, 0.32370E+00, 0.32561E+00, 0.32751E+00,
- & 0.32940E+00, 0.33129E+00, 0.33318E+00, 0.33507E+00, 0.33695E+00,
- & 0.33883E+00, 0.34070E+00, 0.34257E+00, 0.34444E+00, 0.34630E+00,
- & 0.34816E+00, 0.35002E+00, 0.35187E+00, 0.35372E+00, 0.35556E+00,
- & 0.35741E+00, 0.35924E+00, 0.36108E+00, 0.36291E+00, 0.36473E+00,
- & 0.36656E+00, 0.36838E+00, 0.37019E+00, 0.37200E+00, 0.37381E+00/
-
- DATA (BNC01M(I),I=301,400)/
- & 0.37562E+00, 0.37742E+00, 0.37922E+00, 0.38101E+00, 0.38280E+00,
- & 0.38459E+00, 0.38637E+00, 0.38815E+00, 0.38993E+00, 0.39170E+00,
- & 0.39347E+00, 0.39524E+00, 0.39700E+00, 0.39876E+00, 0.40052E+00,
- & 0.40227E+00, 0.40402E+00, 0.40576E+00, 0.40751E+00, 0.40924E+00,
- & 0.41098E+00, 0.41271E+00, 0.41444E+00, 0.41616E+00, 0.41788E+00,
- & 0.41960E+00, 0.42132E+00, 0.42303E+00, 0.42474E+00, 0.42644E+00,
- & 0.42814E+00, 0.42984E+00, 0.43153E+00, 0.43322E+00, 0.43491E+00,
- & 0.43659E+00, 0.43828E+00, 0.43995E+00, 0.44163E+00, 0.44330E+00,
- & 0.44497E+00, 0.44663E+00, 0.44829E+00, 0.44995E+00, 0.45160E+00,
- & 0.45325E+00, 0.45490E+00, 0.45655E+00, 0.45819E+00, 0.45983E+00,
- & 0.46146E+00, 0.46309E+00, 0.46472E+00, 0.46635E+00, 0.46797E+00,
- & 0.46959E+00, 0.47120E+00, 0.47282E+00, 0.47442E+00, 0.47603E+00,
- & 0.47763E+00, 0.47923E+00, 0.48083E+00, 0.48242E+00, 0.48401E+00,
- & 0.48560E+00, 0.48719E+00, 0.48877E+00, 0.49035E+00, 0.49192E+00,
- & 0.49349E+00, 0.49506E+00, 0.49663E+00, 0.49819E+00, 0.49975E+00,
- & 0.50130E+00, 0.50286E+00, 0.50441E+00, 0.50596E+00, 0.50750E+00,
- & 0.50904E+00, 0.51058E+00, 0.51212E+00, 0.51365E+00, 0.51518E+00,
- & 0.51670E+00, 0.51823E+00, 0.51975E+00, 0.52126E+00, 0.52278E+00,
- & 0.52429E+00, 0.52580E+00, 0.52730E+00, 0.52881E+00, 0.53031E+00,
- & 0.53180E+00, 0.53330E+00, 0.53479E+00, 0.53628E+00, 0.53776E+00/
-
- DATA (BNC01M(I),I=401,500)/
- & 0.53924E+00, 0.54072E+00, 0.54220E+00, 0.54367E+00, 0.54514E+00,
- & 0.54661E+00, 0.54808E+00, 0.54954E+00, 0.55100E+00, 0.55246E+00,
- & 0.55391E+00, 0.55536E+00, 0.55681E+00, 0.55825E+00, 0.55970E+00,
- & 0.56114E+00, 0.56257E+00, 0.56401E+00, 0.56544E+00, 0.56687E+00,
- & 0.56829E+00, 0.56972E+00, 0.57114E+00, 0.57256E+00, 0.57397E+00,
- & 0.57538E+00, 0.57679E+00, 0.57820E+00, 0.57960E+00, 0.58101E+00,
- & 0.58240E+00, 0.58380E+00, 0.58519E+00, 0.58659E+00, 0.58797E+00,
- & 0.58936E+00, 0.59074E+00, 0.59212E+00, 0.59350E+00, 0.59487E+00,
- & 0.59625E+00, 0.59762E+00, 0.59898E+00, 0.60035E+00, 0.60171E+00,
- & 0.60307E+00, 0.60442E+00, 0.60578E+00, 0.60713E+00, 0.60848E+00,
- & 0.60982E+00, 0.61117E+00, 0.61251E+00, 0.61385E+00, 0.61518E+00,
- & 0.61652E+00, 0.61785E+00, 0.61918E+00, 0.62050E+00, 0.62183E+00,
- & 0.62315E+00, 0.62447E+00, 0.62578E+00, 0.62709E+00, 0.62841E+00,
- & 0.62971E+00, 0.63102E+00, 0.63232E+00, 0.63362E+00, 0.63492E+00,
- & 0.63622E+00, 0.63751E+00, 0.63880E+00, 0.64009E+00, 0.64138E+00,
- & 0.64266E+00, 0.64394E+00, 0.64522E+00, 0.64650E+00, 0.64777E+00,
- & 0.64905E+00, 0.65032E+00, 0.65158E+00, 0.65285E+00, 0.65411E+00,
- & 0.65537E+00, 0.65663E+00, 0.65788E+00, 0.65913E+00, 0.66039E+00,
- & 0.66163E+00, 0.66288E+00, 0.66412E+00, 0.66536E+00, 0.66660E+00,
- & 0.66784E+00, 0.66907E+00, 0.67031E+00, 0.67153E+00, 0.67276E+00/
-
- DATA (BNC01M(I),I=501,600)/
- & 0.67399E+00, 0.67521E+00, 0.67643E+00, 0.67765E+00, 0.67886E+00,
- & 0.68008E+00, 0.68129E+00, 0.68250E+00, 0.68371E+00, 0.68491E+00,
- & 0.68611E+00, 0.68731E+00, 0.68851E+00, 0.68971E+00, 0.69090E+00,
- & 0.69209E+00, 0.69328E+00, 0.69447E+00, 0.69565E+00, 0.69683E+00,
- & 0.69801E+00, 0.69919E+00, 0.70037E+00, 0.70154E+00, 0.70271E+00,
- & 0.70388E+00, 0.70505E+00, 0.70621E+00, 0.70738E+00, 0.70854E+00,
- & 0.70970E+00, 0.71085E+00, 0.71201E+00, 0.71316E+00, 0.71431E+00,
- & 0.71546E+00, 0.71660E+00, 0.71775E+00, 0.71889E+00, 0.72003E+00,
- & 0.72117E+00, 0.72230E+00, 0.72343E+00, 0.72456E+00, 0.72569E+00,
- & 0.72682E+00, 0.72795E+00, 0.72907E+00, 0.73019E+00, 0.73131E+00,
- & 0.73242E+00, 0.73354E+00, 0.73465E+00, 0.73576E+00, 0.73687E+00,
- & 0.73798E+00, 0.73908E+00, 0.74019E+00, 0.74129E+00, 0.74238E+00,
- & 0.74348E+00, 0.74457E+00, 0.74567E+00, 0.74676E+00, 0.74785E+00,
- & 0.74893E+00, 0.75002E+00, 0.75110E+00, 0.75218E+00, 0.75326E+00,
- & 0.75434E+00, 0.75541E+00, 0.75648E+00, 0.75755E+00, 0.75862E+00,
- & 0.75969E+00, 0.76075E+00, 0.76182E+00, 0.76288E+00, 0.76394E+00,
- & 0.76500E+00, 0.76605E+00, 0.76710E+00, 0.76816E+00, 0.76921E+00,
- & 0.77025E+00, 0.77130E+00, 0.77234E+00, 0.77339E+00, 0.77443E+00,
- & 0.77546E+00, 0.77650E+00, 0.77754E+00, 0.77857E+00, 0.77960E+00,
- & 0.78063E+00, 0.78165E+00, 0.78268E+00, 0.78370E+00, 0.78473E+00/
-
- DATA (BNC01M(I),I=601,700)/
- & 0.79565E+00, 0.80557E+00, 0.81531E+00, 0.82489E+00, 0.83429E+00,
- & 0.84353E+00, 0.85261E+00, 0.86153E+00, 0.87029E+00, 0.87890E+00,
- & 0.88737E+00, 0.89568E+00, 0.90385E+00, 0.91188E+00, 0.91978E+00,
- & 0.92754E+00, 0.93516E+00, 0.94265E+00, 0.95002E+00, 0.95726E+00,
- & 0.96438E+00, 0.97138E+00, 0.97825E+00, 0.98501E+00, 0.99166E+00,
- & 0.99819E+00, 0.10046E+01, 0.10109E+01, 0.10171E+01, 0.10232E+01,
- & 0.10292E+01, 0.10351E+01, 0.10409E+01, 0.10466E+01, 0.10522E+01,
- & 0.10577E+01, 0.10632E+01, 0.10685E+01, 0.10737E+01, 0.10788E+01,
- & 0.10839E+01, 0.10889E+01, 0.10938E+01, 0.10986E+01, 0.11033E+01,
- & 0.11079E+01, 0.11125E+01, 0.11169E+01, 0.11213E+01, 0.11257E+01,
- & 0.11299E+01, 0.11341E+01, 0.11382E+01, 0.11422E+01, 0.11462E+01,
- & 0.11501E+01, 0.11539E+01, 0.11577E+01, 0.11613E+01, 0.11650E+01,
- & 0.11685E+01, 0.11720E+01, 0.11754E+01, 0.11788E+01, 0.11821E+01,
- & 0.11853E+01, 0.11885E+01, 0.11917E+01, 0.11947E+01, 0.11977E+01,
- & 0.12007E+01, 0.12036E+01, 0.12064E+01, 0.12092E+01, 0.12119E+01,
- & 0.12146E+01, 0.12172E+01, 0.12198E+01, 0.12223E+01, 0.12248E+01,
- & 0.12272E+01, 0.12296E+01, 0.12319E+01, 0.12342E+01, 0.12364E+01,
- & 0.12386E+01, 0.12407E+01, 0.12428E+01, 0.12449E+01, 0.12469E+01,
- & 0.12488E+01, 0.12507E+01, 0.12526E+01, 0.12544E+01, 0.12562E+01,
- & 0.12579E+01, 0.12596E+01, 0.12613E+01, 0.12629E+01, 0.12645E+01/
-
- DATA (BNC01M(I),I=701,741)/
- & 0.12660E+01, 0.12675E+01, 0.12690E+01, 0.12704E+01, 0.12718E+01,
- & 0.12731E+01, 0.12744E+01, 0.12757E+01, 0.12769E+01, 0.12781E+01,
- & 0.12793E+01, 0.12804E+01, 0.12815E+01, 0.12825E+01, 0.12836E+01,
- & 0.12846E+01, 0.12855E+01, 0.12864E+01, 0.12873E+01, 0.12882E+01,
- & 0.12890E+01, 0.12898E+01, 0.12906E+01, 0.12913E+01, 0.12920E+01,
- & 0.12927E+01, 0.12933E+01, 0.12939E+01, 0.12945E+01, 0.12951E+01,
- & 0.12956E+01, 0.12961E+01, 0.12966E+01, 0.12970E+01, 0.12974E+01,
- & 0.12978E+01, 0.12981E+01, 0.12985E+01, 0.12988E+01, 0.12991E+01,
- & 0.12993E+01
- & /
-C
-C *** Na2SO4
-C
- DATA (BNC02M(I),I=1,100)/
- &-0.10289E+00,-0.22546E+00,-0.28765E+00,-0.33213E+00,-0.36741E+00,
- &-0.39691E+00,-0.42240E+00,-0.44495E+00,-0.46522E+00,-0.48367E+00,
- &-0.50064E+00,-0.51637E+00,-0.53106E+00,-0.54484E+00,-0.55785E+00,
- &-0.57017E+00,-0.58189E+00,-0.59306E+00,-0.60376E+00,-0.61401E+00,
- &-0.62387E+00,-0.63337E+00,-0.64254E+00,-0.65140E+00,-0.65998E+00,
- &-0.66830E+00,-0.67639E+00,-0.68424E+00,-0.69189E+00,-0.69934E+00,
- &-0.70661E+00,-0.71370E+00,-0.72063E+00,-0.72740E+00,-0.73403E+00,
- &-0.74052E+00,-0.74688E+00,-0.75312E+00,-0.75923E+00,-0.76524E+00,
- &-0.77113E+00,-0.77693E+00,-0.78262E+00,-0.78822E+00,-0.79373E+00,
- &-0.79915E+00,-0.80450E+00,-0.80976E+00,-0.81494E+00,-0.82005E+00,
- &-0.82509E+00,-0.83006E+00,-0.83497E+00,-0.83981E+00,-0.84459E+00,
- &-0.84931E+00,-0.85398E+00,-0.85859E+00,-0.86315E+00,-0.86766E+00,
- &-0.87211E+00,-0.87652E+00,-0.88089E+00,-0.88521E+00,-0.88948E+00,
- &-0.89372E+00,-0.89791E+00,-0.90207E+00,-0.90619E+00,-0.91027E+00,
- &-0.91432E+00,-0.91833E+00,-0.92231E+00,-0.92626E+00,-0.93018E+00,
- &-0.93406E+00,-0.93792E+00,-0.94175E+00,-0.94556E+00,-0.94933E+00,
- &-0.95308E+00,-0.95681E+00,-0.96051E+00,-0.96419E+00,-0.96785E+00,
- &-0.97149E+00,-0.97510E+00,-0.97869E+00,-0.98226E+00,-0.98582E+00,
- &-0.98935E+00,-0.99286E+00,-0.99636E+00,-0.99984E+00,-0.10033E+01,
- &-0.10067E+01,-0.10102E+01,-0.10136E+01,-0.10170E+01,-0.10203E+01/
-
- DATA (BNC02M(I),I=101,200)/
- &-0.10237E+01,-0.10271E+01,-0.10304E+01,-0.10337E+01,-0.10370E+01,
- &-0.10403E+01,-0.10436E+01,-0.10468E+01,-0.10501E+01,-0.10533E+01,
- &-0.10565E+01,-0.10597E+01,-0.10629E+01,-0.10661E+01,-0.10692E+01,
- &-0.10724E+01,-0.10755E+01,-0.10787E+01,-0.10818E+01,-0.10849E+01,
- &-0.10880E+01,-0.10911E+01,-0.10941E+01,-0.10972E+01,-0.11002E+01,
- &-0.11033E+01,-0.11063E+01,-0.11093E+01,-0.11123E+01,-0.11153E+01,
- &-0.11182E+01,-0.11212E+01,-0.11242E+01,-0.11271E+01,-0.11301E+01,
- &-0.11330E+01,-0.11359E+01,-0.11388E+01,-0.11417E+01,-0.11446E+01,
- &-0.11475E+01,-0.11503E+01,-0.11532E+01,-0.11560E+01,-0.11589E+01,
- &-0.11617E+01,-0.11645E+01,-0.11673E+01,-0.11701E+01,-0.11729E+01,
- &-0.11757E+01,-0.11785E+01,-0.11813E+01,-0.11840E+01,-0.11868E+01,
- &-0.11895E+01,-0.11923E+01,-0.11950E+01,-0.11977E+01,-0.12004E+01,
- &-0.12032E+01,-0.12059E+01,-0.12085E+01,-0.12112E+01,-0.12139E+01,
- &-0.12166E+01,-0.12192E+01,-0.12219E+01,-0.12246E+01,-0.12272E+01,
- &-0.12298E+01,-0.12325E+01,-0.12351E+01,-0.12377E+01,-0.12403E+01,
- &-0.12429E+01,-0.12455E+01,-0.12481E+01,-0.12507E+01,-0.12533E+01,
- &-0.12558E+01,-0.12584E+01,-0.12610E+01,-0.12635E+01,-0.12661E+01,
- &-0.12686E+01,-0.12712E+01,-0.12737E+01,-0.12762E+01,-0.12787E+01,
- &-0.12813E+01,-0.12838E+01,-0.12863E+01,-0.12888E+01,-0.12913E+01,
- &-0.12937E+01,-0.12962E+01,-0.12987E+01,-0.13012E+01,-0.13036E+01/
-
- DATA (BNC02M(I),I=201,300)/
- &-0.13061E+01,-0.13086E+01,-0.13110E+01,-0.13135E+01,-0.13159E+01,
- &-0.13183E+01,-0.13208E+01,-0.13232E+01,-0.13256E+01,-0.13280E+01,
- &-0.13305E+01,-0.13329E+01,-0.13353E+01,-0.13377E+01,-0.13401E+01,
- &-0.13425E+01,-0.13449E+01,-0.13472E+01,-0.13496E+01,-0.13520E+01,
- &-0.13544E+01,-0.13567E+01,-0.13591E+01,-0.13614E+01,-0.13638E+01,
- &-0.13661E+01,-0.13685E+01,-0.13708E+01,-0.13732E+01,-0.13755E+01,
- &-0.13778E+01,-0.13802E+01,-0.13825E+01,-0.13848E+01,-0.13871E+01,
- &-0.13894E+01,-0.13917E+01,-0.13940E+01,-0.13963E+01,-0.13986E+01,
- &-0.14009E+01,-0.14032E+01,-0.14055E+01,-0.14078E+01,-0.14100E+01,
- &-0.14123E+01,-0.14146E+01,-0.14168E+01,-0.14191E+01,-0.14214E+01,
- &-0.14236E+01,-0.14259E+01,-0.14281E+01,-0.14304E+01,-0.14326E+01,
- &-0.14349E+01,-0.14371E+01,-0.14393E+01,-0.14415E+01,-0.14438E+01,
- &-0.14460E+01,-0.14482E+01,-0.14504E+01,-0.14526E+01,-0.14549E+01,
- &-0.14571E+01,-0.14593E+01,-0.14615E+01,-0.14637E+01,-0.14659E+01,
- &-0.14681E+01,-0.14702E+01,-0.14724E+01,-0.14746E+01,-0.14768E+01,
- &-0.14790E+01,-0.14812E+01,-0.14833E+01,-0.14855E+01,-0.14877E+01,
- &-0.14898E+01,-0.14920E+01,-0.14941E+01,-0.14963E+01,-0.14985E+01,
- &-0.15006E+01,-0.15028E+01,-0.15049E+01,-0.15070E+01,-0.15092E+01,
- &-0.15113E+01,-0.15134E+01,-0.15156E+01,-0.15177E+01,-0.15198E+01,
- &-0.15220E+01,-0.15241E+01,-0.15262E+01,-0.15283E+01,-0.15304E+01/
-
- DATA (BNC02M(I),I=301,400)/
- &-0.15325E+01,-0.15347E+01,-0.15368E+01,-0.15389E+01,-0.15410E+01,
- &-0.15431E+01,-0.15452E+01,-0.15473E+01,-0.15493E+01,-0.15514E+01,
- &-0.15535E+01,-0.15556E+01,-0.15577E+01,-0.15598E+01,-0.15618E+01,
- &-0.15639E+01,-0.15660E+01,-0.15681E+01,-0.15701E+01,-0.15722E+01,
- &-0.15743E+01,-0.15763E+01,-0.15784E+01,-0.15805E+01,-0.15825E+01,
- &-0.15846E+01,-0.15866E+01,-0.15887E+01,-0.15907E+01,-0.15928E+01,
- &-0.15948E+01,-0.15968E+01,-0.15989E+01,-0.16009E+01,-0.16030E+01,
- &-0.16050E+01,-0.16070E+01,-0.16090E+01,-0.16111E+01,-0.16131E+01,
- &-0.16151E+01,-0.16171E+01,-0.16192E+01,-0.16212E+01,-0.16232E+01,
- &-0.16252E+01,-0.16272E+01,-0.16292E+01,-0.16312E+01,-0.16332E+01,
- &-0.16352E+01,-0.16372E+01,-0.16392E+01,-0.16412E+01,-0.16432E+01,
- &-0.16452E+01,-0.16472E+01,-0.16492E+01,-0.16512E+01,-0.16532E+01,
- &-0.16552E+01,-0.16572E+01,-0.16591E+01,-0.16611E+01,-0.16631E+01,
- &-0.16651E+01,-0.16671E+01,-0.16690E+01,-0.16710E+01,-0.16730E+01,
- &-0.16749E+01,-0.16769E+01,-0.16789E+01,-0.16808E+01,-0.16828E+01,
- &-0.16847E+01,-0.16867E+01,-0.16887E+01,-0.16906E+01,-0.16926E+01,
- &-0.16945E+01,-0.16965E+01,-0.16984E+01,-0.17004E+01,-0.17023E+01,
- &-0.17042E+01,-0.17062E+01,-0.17081E+01,-0.17101E+01,-0.17120E+01,
- &-0.17139E+01,-0.17159E+01,-0.17178E+01,-0.17197E+01,-0.17217E+01,
- &-0.17236E+01,-0.17255E+01,-0.17274E+01,-0.17294E+01,-0.17313E+01/
-
- DATA (BNC02M(I),I=401,500)/
- &-0.17332E+01,-0.17351E+01,-0.17370E+01,-0.17390E+01,-0.17409E+01,
- &-0.17428E+01,-0.17447E+01,-0.17466E+01,-0.17485E+01,-0.17504E+01,
- &-0.17523E+01,-0.17542E+01,-0.17561E+01,-0.17580E+01,-0.17599E+01,
- &-0.17618E+01,-0.17637E+01,-0.17656E+01,-0.17675E+01,-0.17694E+01,
- &-0.17713E+01,-0.17732E+01,-0.17751E+01,-0.17770E+01,-0.17788E+01,
- &-0.17807E+01,-0.17826E+01,-0.17845E+01,-0.17864E+01,-0.17883E+01,
- &-0.17901E+01,-0.17920E+01,-0.17939E+01,-0.17958E+01,-0.17976E+01,
- &-0.17995E+01,-0.18014E+01,-0.18032E+01,-0.18051E+01,-0.18070E+01,
- &-0.18088E+01,-0.18107E+01,-0.18126E+01,-0.18144E+01,-0.18163E+01,
- &-0.18181E+01,-0.18200E+01,-0.18218E+01,-0.18237E+01,-0.18256E+01,
- &-0.18274E+01,-0.18293E+01,-0.18311E+01,-0.18330E+01,-0.18348E+01,
- &-0.18367E+01,-0.18385E+01,-0.18403E+01,-0.18422E+01,-0.18440E+01,
- &-0.18459E+01,-0.18477E+01,-0.18495E+01,-0.18514E+01,-0.18532E+01,
- &-0.18550E+01,-0.18569E+01,-0.18587E+01,-0.18605E+01,-0.18624E+01,
- &-0.18642E+01,-0.18660E+01,-0.18679E+01,-0.18697E+01,-0.18715E+01,
- &-0.18733E+01,-0.18751E+01,-0.18770E+01,-0.18788E+01,-0.18806E+01,
- &-0.18824E+01,-0.18842E+01,-0.18861E+01,-0.18879E+01,-0.18897E+01,
- &-0.18915E+01,-0.18933E+01,-0.18951E+01,-0.18969E+01,-0.18987E+01,
- &-0.19005E+01,-0.19023E+01,-0.19041E+01,-0.19060E+01,-0.19078E+01,
- &-0.19096E+01,-0.19114E+01,-0.19132E+01,-0.19150E+01,-0.19167E+01/
-
- DATA (BNC02M(I),I=501,600)/
- &-0.19185E+01,-0.19203E+01,-0.19221E+01,-0.19239E+01,-0.19257E+01,
- &-0.19275E+01,-0.19293E+01,-0.19311E+01,-0.19329E+01,-0.19347E+01,
- &-0.19365E+01,-0.19382E+01,-0.19400E+01,-0.19418E+01,-0.19436E+01,
- &-0.19454E+01,-0.19472E+01,-0.19489E+01,-0.19507E+01,-0.19525E+01,
- &-0.19543E+01,-0.19560E+01,-0.19578E+01,-0.19596E+01,-0.19614E+01,
- &-0.19631E+01,-0.19649E+01,-0.19667E+01,-0.19684E+01,-0.19702E+01,
- &-0.19720E+01,-0.19737E+01,-0.19755E+01,-0.19773E+01,-0.19790E+01,
- &-0.19808E+01,-0.19826E+01,-0.19843E+01,-0.19861E+01,-0.19878E+01,
- &-0.19896E+01,-0.19914E+01,-0.19931E+01,-0.19949E+01,-0.19966E+01,
- &-0.19984E+01,-0.20001E+01,-0.20019E+01,-0.20036E+01,-0.20054E+01,
- &-0.20071E+01,-0.20089E+01,-0.20106E+01,-0.20124E+01,-0.20141E+01,
- &-0.20159E+01,-0.20176E+01,-0.20193E+01,-0.20211E+01,-0.20228E+01,
- &-0.20246E+01,-0.20263E+01,-0.20281E+01,-0.20298E+01,-0.20315E+01,
- &-0.20333E+01,-0.20350E+01,-0.20367E+01,-0.20385E+01,-0.20402E+01,
- &-0.20419E+01,-0.20437E+01,-0.20454E+01,-0.20471E+01,-0.20489E+01,
- &-0.20506E+01,-0.20523E+01,-0.20540E+01,-0.20558E+01,-0.20575E+01,
- &-0.20592E+01,-0.20609E+01,-0.20627E+01,-0.20644E+01,-0.20661E+01,
- &-0.20678E+01,-0.20695E+01,-0.20713E+01,-0.20730E+01,-0.20747E+01,
- &-0.20764E+01,-0.20781E+01,-0.20798E+01,-0.20816E+01,-0.20833E+01,
- &-0.20850E+01,-0.20867E+01,-0.20884E+01,-0.20901E+01,-0.20918E+01/
-
- DATA (BNC02M(I),I=601,700)/
- &-0.21103E+01,-0.21272E+01,-0.21441E+01,-0.21610E+01,-0.21778E+01,
- &-0.21945E+01,-0.22111E+01,-0.22277E+01,-0.22442E+01,-0.22607E+01,
- &-0.22771E+01,-0.22934E+01,-0.23097E+01,-0.23260E+01,-0.23422E+01,
- &-0.23583E+01,-0.23744E+01,-0.23904E+01,-0.24064E+01,-0.24224E+01,
- &-0.24383E+01,-0.24541E+01,-0.24699E+01,-0.24857E+01,-0.25014E+01,
- &-0.25171E+01,-0.25327E+01,-0.25483E+01,-0.25639E+01,-0.25794E+01,
- &-0.25949E+01,-0.26104E+01,-0.26258E+01,-0.26412E+01,-0.26565E+01,
- &-0.26718E+01,-0.26871E+01,-0.27023E+01,-0.27175E+01,-0.27327E+01,
- &-0.27479E+01,-0.27630E+01,-0.27781E+01,-0.27931E+01,-0.28082E+01,
- &-0.28232E+01,-0.28381E+01,-0.28531E+01,-0.28680E+01,-0.28829E+01,
- &-0.28977E+01,-0.29125E+01,-0.29274E+01,-0.29421E+01,-0.29569E+01,
- &-0.29716E+01,-0.29863E+01,-0.30010E+01,-0.30157E+01,-0.30303E+01,
- &-0.30449E+01,-0.30595E+01,-0.30740E+01,-0.30886E+01,-0.31031E+01,
- &-0.31176E+01,-0.31321E+01,-0.31465E+01,-0.31610E+01,-0.31754E+01,
- &-0.31898E+01,-0.32042E+01,-0.32185E+01,-0.32328E+01,-0.32472E+01,
- &-0.32614E+01,-0.32757E+01,-0.32900E+01,-0.33042E+01,-0.33184E+01,
- &-0.33326E+01,-0.33468E+01,-0.33610E+01,-0.33751E+01,-0.33893E+01,
- &-0.34034E+01,-0.34175E+01,-0.34316E+01,-0.34456E+01,-0.34597E+01,
- &-0.34737E+01,-0.34877E+01,-0.35017E+01,-0.35157E+01,-0.35297E+01,
- &-0.35436E+01,-0.35576E+01,-0.35715E+01,-0.35854E+01,-0.35993E+01/
-
- DATA (BNC02M(I),I=701,741)/
- &-0.36132E+01,-0.36270E+01,-0.36409E+01,-0.36547E+01,-0.36685E+01,
- &-0.36823E+01,-0.36961E+01,-0.37099E+01,-0.37237E+01,-0.37374E+01,
- &-0.37512E+01,-0.37649E+01,-0.37786E+01,-0.37923E+01,-0.38060E+01,
- &-0.38197E+01,-0.38333E+01,-0.38470E+01,-0.38606E+01,-0.38743E+01,
- &-0.38879E+01,-0.39015E+01,-0.39151E+01,-0.39286E+01,-0.39422E+01,
- &-0.39558E+01,-0.39693E+01,-0.39828E+01,-0.39964E+01,-0.40099E+01,
- &-0.40234E+01,-0.40369E+01,-0.40503E+01,-0.40638E+01,-0.40773E+01,
- &-0.40907E+01,-0.41041E+01,-0.41176E+01,-0.41310E+01,-0.41444E+01,
- &-0.41578E+01
- & /
-C
-C *** NaNO3
-C
- DATA (BNC03M(I),I=1,100)/
- &-0.51619E-01,-0.11367E+00,-0.14547E+00,-0.16839E+00,-0.18667E+00,
- &-0.20205E+00,-0.21542E+00,-0.22729E+00,-0.23802E+00,-0.24783E+00,
- &-0.25689E+00,-0.26532E+00,-0.27322E+00,-0.28066E+00,-0.28771E+00,
- &-0.29440E+00,-0.30079E+00,-0.30691E+00,-0.31277E+00,-0.31841E+00,
- &-0.32385E+00,-0.32910E+00,-0.33418E+00,-0.33911E+00,-0.34388E+00,
- &-0.34853E+00,-0.35304E+00,-0.35744E+00,-0.36173E+00,-0.36592E+00,
- &-0.37001E+00,-0.37401E+00,-0.37792E+00,-0.38175E+00,-0.38550E+00,
- &-0.38918E+00,-0.39279E+00,-0.39633E+00,-0.39981E+00,-0.40323E+00,
- &-0.40658E+00,-0.40989E+00,-0.41313E+00,-0.41633E+00,-0.41948E+00,
- &-0.42258E+00,-0.42563E+00,-0.42864E+00,-0.43161E+00,-0.43454E+00,
- &-0.43743E+00,-0.44028E+00,-0.44309E+00,-0.44587E+00,-0.44861E+00,
- &-0.45133E+00,-0.45401E+00,-0.45666E+00,-0.45928E+00,-0.46187E+00,
- &-0.46443E+00,-0.46697E+00,-0.46948E+00,-0.47197E+00,-0.47443E+00,
- &-0.47688E+00,-0.47929E+00,-0.48169E+00,-0.48407E+00,-0.48643E+00,
- &-0.48877E+00,-0.49109E+00,-0.49339E+00,-0.49567E+00,-0.49794E+00,
- &-0.50020E+00,-0.50243E+00,-0.50466E+00,-0.50687E+00,-0.50906E+00,
- &-0.51124E+00,-0.51341E+00,-0.51557E+00,-0.51771E+00,-0.51985E+00,
- &-0.52197E+00,-0.52408E+00,-0.52618E+00,-0.52827E+00,-0.53035E+00,
- &-0.53242E+00,-0.53448E+00,-0.53654E+00,-0.53858E+00,-0.54062E+00,
- &-0.54264E+00,-0.54466E+00,-0.54667E+00,-0.54867E+00,-0.55066E+00/
-
- DATA (BNC03M(I),I=101,200)/
- &-0.55265E+00,-0.55463E+00,-0.55660E+00,-0.55856E+00,-0.56051E+00,
- &-0.56246E+00,-0.56440E+00,-0.56633E+00,-0.56826E+00,-0.57018E+00,
- &-0.57209E+00,-0.57399E+00,-0.57589E+00,-0.57778E+00,-0.57966E+00,
- &-0.58154E+00,-0.58341E+00,-0.58527E+00,-0.58713E+00,-0.58898E+00,
- &-0.59082E+00,-0.59265E+00,-0.59448E+00,-0.59631E+00,-0.59812E+00,
- &-0.59993E+00,-0.60174E+00,-0.60353E+00,-0.60532E+00,-0.60711E+00,
- &-0.60888E+00,-0.61066E+00,-0.61242E+00,-0.61418E+00,-0.61593E+00,
- &-0.61768E+00,-0.61942E+00,-0.62116E+00,-0.62289E+00,-0.62461E+00,
- &-0.62633E+00,-0.62805E+00,-0.62975E+00,-0.63146E+00,-0.63315E+00,
- &-0.63484E+00,-0.63653E+00,-0.63821E+00,-0.63988E+00,-0.64155E+00,
- &-0.64322E+00,-0.64488E+00,-0.64653E+00,-0.64818E+00,-0.64983E+00,
- &-0.65147E+00,-0.65310E+00,-0.65473E+00,-0.65636E+00,-0.65798E+00,
- &-0.65960E+00,-0.66121E+00,-0.66282E+00,-0.66442E+00,-0.66602E+00,
- &-0.66761E+00,-0.66920E+00,-0.67079E+00,-0.67237E+00,-0.67395E+00,
- &-0.67552E+00,-0.67709E+00,-0.67865E+00,-0.68021E+00,-0.68177E+00,
- &-0.68332E+00,-0.68487E+00,-0.68641E+00,-0.68795E+00,-0.68949E+00,
- &-0.69102E+00,-0.69255E+00,-0.69408E+00,-0.69560E+00,-0.69712E+00,
- &-0.69863E+00,-0.70014E+00,-0.70165E+00,-0.70316E+00,-0.70466E+00,
- &-0.70615E+00,-0.70765E+00,-0.70914E+00,-0.71062E+00,-0.71211E+00,
- &-0.71358E+00,-0.71506E+00,-0.71653E+00,-0.71800E+00,-0.71947E+00/
-
- DATA (BNC03M(I),I=201,300)/
- &-0.72093E+00,-0.72239E+00,-0.72385E+00,-0.72531E+00,-0.72676E+00,
- &-0.72820E+00,-0.72965E+00,-0.73109E+00,-0.73253E+00,-0.73397E+00,
- &-0.73540E+00,-0.73683E+00,-0.73825E+00,-0.73968E+00,-0.74110E+00,
- &-0.74252E+00,-0.74393E+00,-0.74535E+00,-0.74676E+00,-0.74816E+00,
- &-0.74957E+00,-0.75097E+00,-0.75237E+00,-0.75376E+00,-0.75516E+00,
- &-0.75655E+00,-0.75794E+00,-0.75932E+00,-0.76071E+00,-0.76209E+00,
- &-0.76346E+00,-0.76484E+00,-0.76621E+00,-0.76758E+00,-0.76895E+00,
- &-0.77032E+00,-0.77168E+00,-0.77304E+00,-0.77440E+00,-0.77575E+00,
- &-0.77711E+00,-0.77846E+00,-0.77981E+00,-0.78115E+00,-0.78250E+00,
- &-0.78384E+00,-0.78518E+00,-0.78652E+00,-0.78785E+00,-0.78918E+00,
- &-0.79051E+00,-0.79184E+00,-0.79317E+00,-0.79449E+00,-0.79581E+00,
- &-0.79713E+00,-0.79845E+00,-0.79977E+00,-0.80108E+00,-0.80239E+00,
- &-0.80370E+00,-0.80500E+00,-0.80631E+00,-0.80761E+00,-0.80891E+00,
- &-0.81021E+00,-0.81151E+00,-0.81280E+00,-0.81410E+00,-0.81539E+00,
- &-0.81667E+00,-0.81796E+00,-0.81925E+00,-0.82053E+00,-0.82181E+00,
- &-0.82309E+00,-0.82437E+00,-0.82564E+00,-0.82691E+00,-0.82819E+00,
- &-0.82946E+00,-0.83072E+00,-0.83199E+00,-0.83325E+00,-0.83452E+00,
- &-0.83578E+00,-0.83703E+00,-0.83829E+00,-0.83955E+00,-0.84080E+00,
- &-0.84205E+00,-0.84330E+00,-0.84455E+00,-0.84580E+00,-0.84704E+00,
- &-0.84828E+00,-0.84952E+00,-0.85076E+00,-0.85200E+00,-0.85324E+00/
-
- DATA (BNC03M(I),I=301,400)/
- &-0.85447E+00,-0.85571E+00,-0.85694E+00,-0.85817E+00,-0.85939E+00,
- &-0.86062E+00,-0.86185E+00,-0.86307E+00,-0.86429E+00,-0.86551E+00,
- &-0.86673E+00,-0.86795E+00,-0.86916E+00,-0.87038E+00,-0.87159E+00,
- &-0.87280E+00,-0.87401E+00,-0.87522E+00,-0.87642E+00,-0.87763E+00,
- &-0.87883E+00,-0.88003E+00,-0.88123E+00,-0.88243E+00,-0.88363E+00,
- &-0.88482E+00,-0.88602E+00,-0.88721E+00,-0.88840E+00,-0.88959E+00,
- &-0.89078E+00,-0.89197E+00,-0.89315E+00,-0.89434E+00,-0.89552E+00,
- &-0.89670E+00,-0.89788E+00,-0.89906E+00,-0.90024E+00,-0.90142E+00,
- &-0.90259E+00,-0.90376E+00,-0.90494E+00,-0.90611E+00,-0.90728E+00,
- &-0.90845E+00,-0.90961E+00,-0.91078E+00,-0.91194E+00,-0.91310E+00,
- &-0.91427E+00,-0.91543E+00,-0.91659E+00,-0.91774E+00,-0.91890E+00,
- &-0.92006E+00,-0.92121E+00,-0.92236E+00,-0.92351E+00,-0.92466E+00,
- &-0.92581E+00,-0.92696E+00,-0.92811E+00,-0.92925E+00,-0.93040E+00,
- &-0.93154E+00,-0.93268E+00,-0.93382E+00,-0.93496E+00,-0.93610E+00,
- &-0.93724E+00,-0.93837E+00,-0.93951E+00,-0.94064E+00,-0.94177E+00,
- &-0.94290E+00,-0.94404E+00,-0.94516E+00,-0.94629E+00,-0.94742E+00,
- &-0.94854E+00,-0.94967E+00,-0.95079E+00,-0.95191E+00,-0.95303E+00,
- &-0.95416E+00,-0.95527E+00,-0.95639E+00,-0.95751E+00,-0.95862E+00,
- &-0.95974E+00,-0.96085E+00,-0.96196E+00,-0.96308E+00,-0.96419E+00,
- &-0.96530E+00,-0.96640E+00,-0.96751E+00,-0.96862E+00,-0.96972E+00/
-
- DATA (BNC03M(I),I=401,500)/
- &-0.97083E+00,-0.97193E+00,-0.97303E+00,-0.97413E+00,-0.97523E+00,
- &-0.97633E+00,-0.97743E+00,-0.97852E+00,-0.97962E+00,-0.98072E+00,
- &-0.98181E+00,-0.98290E+00,-0.98399E+00,-0.98508E+00,-0.98617E+00,
- &-0.98726E+00,-0.98835E+00,-0.98944E+00,-0.99052E+00,-0.99161E+00,
- &-0.99269E+00,-0.99378E+00,-0.99486E+00,-0.99594E+00,-0.99702E+00,
- &-0.99810E+00,-0.99918E+00,-0.10003E+01,-0.10013E+01,-0.10024E+01,
- &-0.10035E+01,-0.10046E+01,-0.10056E+01,-0.10067E+01,-0.10078E+01,
- &-0.10088E+01,-0.10099E+01,-0.10110E+01,-0.10120E+01,-0.10131E+01,
- &-0.10142E+01,-0.10152E+01,-0.10163E+01,-0.10174E+01,-0.10184E+01,
- &-0.10195E+01,-0.10206E+01,-0.10216E+01,-0.10227E+01,-0.10237E+01,
- &-0.10248E+01,-0.10258E+01,-0.10269E+01,-0.10280E+01,-0.10290E+01,
- &-0.10301E+01,-0.10311E+01,-0.10322E+01,-0.10332E+01,-0.10343E+01,
- &-0.10353E+01,-0.10364E+01,-0.10374E+01,-0.10385E+01,-0.10395E+01,
- &-0.10405E+01,-0.10416E+01,-0.10426E+01,-0.10437E+01,-0.10447E+01,
- &-0.10458E+01,-0.10468E+01,-0.10478E+01,-0.10489E+01,-0.10499E+01,
- &-0.10509E+01,-0.10520E+01,-0.10530E+01,-0.10541E+01,-0.10551E+01,
- &-0.10561E+01,-0.10572E+01,-0.10582E+01,-0.10592E+01,-0.10602E+01,
- &-0.10613E+01,-0.10623E+01,-0.10633E+01,-0.10644E+01,-0.10654E+01,
- &-0.10664E+01,-0.10674E+01,-0.10685E+01,-0.10695E+01,-0.10705E+01,
- &-0.10715E+01,-0.10725E+01,-0.10736E+01,-0.10746E+01,-0.10756E+01/
-
- DATA (BNC03M(I),I=501,600)/
- &-0.10766E+01,-0.10776E+01,-0.10787E+01,-0.10797E+01,-0.10807E+01,
- &-0.10817E+01,-0.10827E+01,-0.10837E+01,-0.10847E+01,-0.10857E+01,
- &-0.10868E+01,-0.10878E+01,-0.10888E+01,-0.10898E+01,-0.10908E+01,
- &-0.10918E+01,-0.10928E+01,-0.10938E+01,-0.10948E+01,-0.10958E+01,
- &-0.10968E+01,-0.10978E+01,-0.10988E+01,-0.10998E+01,-0.11008E+01,
- &-0.11018E+01,-0.11028E+01,-0.11038E+01,-0.11048E+01,-0.11058E+01,
- &-0.11068E+01,-0.11078E+01,-0.11088E+01,-0.11098E+01,-0.11108E+01,
- &-0.11118E+01,-0.11128E+01,-0.11138E+01,-0.11148E+01,-0.11158E+01,
- &-0.11168E+01,-0.11178E+01,-0.11188E+01,-0.11197E+01,-0.11207E+01,
- &-0.11217E+01,-0.11227E+01,-0.11237E+01,-0.11247E+01,-0.11257E+01,
- &-0.11267E+01,-0.11276E+01,-0.11286E+01,-0.11296E+01,-0.11306E+01,
- &-0.11316E+01,-0.11326E+01,-0.11335E+01,-0.11345E+01,-0.11355E+01,
- &-0.11365E+01,-0.11374E+01,-0.11384E+01,-0.11394E+01,-0.11404E+01,
- &-0.11414E+01,-0.11423E+01,-0.11433E+01,-0.11443E+01,-0.11453E+01,
- &-0.11462E+01,-0.11472E+01,-0.11482E+01,-0.11491E+01,-0.11501E+01,
- &-0.11511E+01,-0.11521E+01,-0.11530E+01,-0.11540E+01,-0.11550E+01,
- &-0.11559E+01,-0.11569E+01,-0.11579E+01,-0.11588E+01,-0.11598E+01,
- &-0.11608E+01,-0.11617E+01,-0.11627E+01,-0.11636E+01,-0.11646E+01,
- &-0.11656E+01,-0.11665E+01,-0.11675E+01,-0.11685E+01,-0.11694E+01,
- &-0.11704E+01,-0.11713E+01,-0.11723E+01,-0.11732E+01,-0.11742E+01/
-
- DATA (BNC03M(I),I=601,700)/
- &-0.11845E+01,-0.11940E+01,-0.12034E+01,-0.12128E+01,-0.12222E+01,
- &-0.12315E+01,-0.12407E+01,-0.12499E+01,-0.12591E+01,-0.12682E+01,
- &-0.12773E+01,-0.12863E+01,-0.12953E+01,-0.13043E+01,-0.13132E+01,
- &-0.13221E+01,-0.13310E+01,-0.13398E+01,-0.13486E+01,-0.13573E+01,
- &-0.13660E+01,-0.13747E+01,-0.13834E+01,-0.13920E+01,-0.14006E+01,
- &-0.14092E+01,-0.14177E+01,-0.14262E+01,-0.14347E+01,-0.14432E+01,
- &-0.14516E+01,-0.14600E+01,-0.14684E+01,-0.14768E+01,-0.14851E+01,
- &-0.14934E+01,-0.15017E+01,-0.15099E+01,-0.15182E+01,-0.15264E+01,
- &-0.15346E+01,-0.15427E+01,-0.15509E+01,-0.15590E+01,-0.15671E+01,
- &-0.15752E+01,-0.15833E+01,-0.15913E+01,-0.15993E+01,-0.16073E+01,
- &-0.16153E+01,-0.16233E+01,-0.16313E+01,-0.16392E+01,-0.16471E+01,
- &-0.16550E+01,-0.16629E+01,-0.16707E+01,-0.16786E+01,-0.16864E+01,
- &-0.16942E+01,-0.17020E+01,-0.17098E+01,-0.17176E+01,-0.17253E+01,
- &-0.17331E+01,-0.17408E+01,-0.17485E+01,-0.17562E+01,-0.17639E+01,
- &-0.17715E+01,-0.17792E+01,-0.17868E+01,-0.17944E+01,-0.18021E+01,
- &-0.18096E+01,-0.18172E+01,-0.18248E+01,-0.18324E+01,-0.18399E+01,
- &-0.18474E+01,-0.18550E+01,-0.18625E+01,-0.18700E+01,-0.18774E+01,
- &-0.18849E+01,-0.18924E+01,-0.18998E+01,-0.19073E+01,-0.19147E+01,
- &-0.19221E+01,-0.19295E+01,-0.19369E+01,-0.19443E+01,-0.19516E+01,
- &-0.19590E+01,-0.19664E+01,-0.19737E+01,-0.19810E+01,-0.19883E+01/
-
- DATA (BNC03M(I),I=701,741)/
- &-0.19957E+01,-0.20030E+01,-0.20102E+01,-0.20175E+01,-0.20248E+01,
- &-0.20321E+01,-0.20393E+01,-0.20466E+01,-0.20538E+01,-0.20610E+01,
- &-0.20682E+01,-0.20754E+01,-0.20826E+01,-0.20898E+01,-0.20970E+01,
- &-0.21042E+01,-0.21113E+01,-0.21185E+01,-0.21256E+01,-0.21328E+01,
- &-0.21399E+01,-0.21470E+01,-0.21542E+01,-0.21613E+01,-0.21684E+01,
- &-0.21754E+01,-0.21825E+01,-0.21896E+01,-0.21967E+01,-0.22037E+01,
- &-0.22108E+01,-0.22178E+01,-0.22249E+01,-0.22319E+01,-0.22389E+01,
- &-0.22459E+01,-0.22530E+01,-0.22600E+01,-0.22670E+01,-0.22739E+01,
- &-0.22809E+01
- & /
-C
-C *** (NH4)2SO4
-C
- DATA (BNC04M(I),I=1,100)/
- &-0.10300E+00,-0.22602E+00,-0.28863E+00,-0.33351E+00,-0.36917E+00,
- &-0.39905E+00,-0.42491E+00,-0.44782E+00,-0.46843E+00,-0.48723E+00,
- &-0.50454E+00,-0.52061E+00,-0.53563E+00,-0.54974E+00,-0.56307E+00,
- &-0.57571E+00,-0.58774E+00,-0.59923E+00,-0.61023E+00,-0.62079E+00,
- &-0.63096E+00,-0.64075E+00,-0.65021E+00,-0.65937E+00,-0.66824E+00,
- &-0.67685E+00,-0.68522E+00,-0.69335E+00,-0.70128E+00,-0.70900E+00,
- &-0.71654E+00,-0.72390E+00,-0.73110E+00,-0.73814E+00,-0.74503E+00,
- &-0.75178E+00,-0.75839E+00,-0.76488E+00,-0.77125E+00,-0.77750E+00,
- &-0.78364E+00,-0.78967E+00,-0.79561E+00,-0.80144E+00,-0.80719E+00,
- &-0.81284E+00,-0.81841E+00,-0.82390E+00,-0.82931E+00,-0.83464E+00,
- &-0.83990E+00,-0.84509E+00,-0.85021E+00,-0.85527E+00,-0.86026E+00,
- &-0.86519E+00,-0.87007E+00,-0.87488E+00,-0.87964E+00,-0.88435E+00,
- &-0.88901E+00,-0.89362E+00,-0.89818E+00,-0.90270E+00,-0.90717E+00,
- &-0.91160E+00,-0.91599E+00,-0.92033E+00,-0.92464E+00,-0.92891E+00,
- &-0.93315E+00,-0.93735E+00,-0.94152E+00,-0.94565E+00,-0.94975E+00,
- &-0.95383E+00,-0.95787E+00,-0.96188E+00,-0.96587E+00,-0.96983E+00,
- &-0.97377E+00,-0.97768E+00,-0.98156E+00,-0.98543E+00,-0.98927E+00,
- &-0.99308E+00,-0.99688E+00,-0.10007E+01,-0.10044E+01,-0.10081E+01,
- &-0.10119E+01,-0.10156E+01,-0.10192E+01,-0.10229E+01,-0.10265E+01,
- &-0.10302E+01,-0.10338E+01,-0.10374E+01,-0.10409E+01,-0.10445E+01/
-
- DATA (BNC04M(I),I=101,200)/
- &-0.10480E+01,-0.10516E+01,-0.10551E+01,-0.10586E+01,-0.10621E+01,
- &-0.10655E+01,-0.10690E+01,-0.10724E+01,-0.10759E+01,-0.10793E+01,
- &-0.10827E+01,-0.10861E+01,-0.10894E+01,-0.10928E+01,-0.10961E+01,
- &-0.10995E+01,-0.11028E+01,-0.11061E+01,-0.11094E+01,-0.11127E+01,
- &-0.11159E+01,-0.11192E+01,-0.11224E+01,-0.11257E+01,-0.11289E+01,
- &-0.11321E+01,-0.11353E+01,-0.11385E+01,-0.11417E+01,-0.11448E+01,
- &-0.11480E+01,-0.11511E+01,-0.11543E+01,-0.11574E+01,-0.11605E+01,
- &-0.11636E+01,-0.11667E+01,-0.11697E+01,-0.11728E+01,-0.11759E+01,
- &-0.11789E+01,-0.11819E+01,-0.11850E+01,-0.11880E+01,-0.11910E+01,
- &-0.11940E+01,-0.11970E+01,-0.12000E+01,-0.12029E+01,-0.12059E+01,
- &-0.12088E+01,-0.12118E+01,-0.12147E+01,-0.12176E+01,-0.12206E+01,
- &-0.12235E+01,-0.12264E+01,-0.12293E+01,-0.12321E+01,-0.12350E+01,
- &-0.12379E+01,-0.12407E+01,-0.12436E+01,-0.12464E+01,-0.12493E+01,
- &-0.12521E+01,-0.12549E+01,-0.12577E+01,-0.12605E+01,-0.12633E+01,
- &-0.12661E+01,-0.12689E+01,-0.12717E+01,-0.12745E+01,-0.12772E+01,
- &-0.12800E+01,-0.12827E+01,-0.12855E+01,-0.12882E+01,-0.12909E+01,
- &-0.12936E+01,-0.12964E+01,-0.12991E+01,-0.13018E+01,-0.13045E+01,
- &-0.13072E+01,-0.13098E+01,-0.13125E+01,-0.13152E+01,-0.13179E+01,
- &-0.13205E+01,-0.13232E+01,-0.13258E+01,-0.13285E+01,-0.13311E+01,
- &-0.13337E+01,-0.13364E+01,-0.13390E+01,-0.13416E+01,-0.13442E+01/
-
- DATA (BNC04M(I),I=201,300)/
- &-0.13468E+01,-0.13494E+01,-0.13520E+01,-0.13546E+01,-0.13572E+01,
- &-0.13597E+01,-0.13623E+01,-0.13649E+01,-0.13674E+01,-0.13700E+01,
- &-0.13726E+01,-0.13751E+01,-0.13776E+01,-0.13802E+01,-0.13827E+01,
- &-0.13852E+01,-0.13878E+01,-0.13903E+01,-0.13928E+01,-0.13953E+01,
- &-0.13978E+01,-0.14003E+01,-0.14028E+01,-0.14053E+01,-0.14078E+01,
- &-0.14102E+01,-0.14127E+01,-0.14152E+01,-0.14177E+01,-0.14201E+01,
- &-0.14226E+01,-0.14250E+01,-0.14275E+01,-0.14299E+01,-0.14324E+01,
- &-0.14348E+01,-0.14373E+01,-0.14397E+01,-0.14421E+01,-0.14445E+01,
- &-0.14469E+01,-0.14494E+01,-0.14518E+01,-0.14542E+01,-0.14566E+01,
- &-0.14590E+01,-0.14614E+01,-0.14638E+01,-0.14662E+01,-0.14685E+01,
- &-0.14709E+01,-0.14733E+01,-0.14757E+01,-0.14780E+01,-0.14804E+01,
- &-0.14828E+01,-0.14851E+01,-0.14875E+01,-0.14898E+01,-0.14922E+01,
- &-0.14945E+01,-0.14969E+01,-0.14992E+01,-0.15015E+01,-0.15039E+01,
- &-0.15062E+01,-0.15085E+01,-0.15108E+01,-0.15131E+01,-0.15155E+01,
- &-0.15178E+01,-0.15201E+01,-0.15224E+01,-0.15247E+01,-0.15270E+01,
- &-0.15293E+01,-0.15316E+01,-0.15338E+01,-0.15361E+01,-0.15384E+01,
- &-0.15407E+01,-0.15430E+01,-0.15452E+01,-0.15475E+01,-0.15498E+01,
- &-0.15520E+01,-0.15543E+01,-0.15566E+01,-0.15588E+01,-0.15611E+01,
- &-0.15633E+01,-0.15656E+01,-0.15678E+01,-0.15700E+01,-0.15723E+01,
- &-0.15745E+01,-0.15767E+01,-0.15790E+01,-0.15812E+01,-0.15834E+01/
-
- DATA (BNC04M(I),I=301,400)/
- &-0.15857E+01,-0.15879E+01,-0.15901E+01,-0.15923E+01,-0.15945E+01,
- &-0.15967E+01,-0.15989E+01,-0.16011E+01,-0.16033E+01,-0.16055E+01,
- &-0.16077E+01,-0.16099E+01,-0.16121E+01,-0.16143E+01,-0.16165E+01,
- &-0.16187E+01,-0.16208E+01,-0.16230E+01,-0.16252E+01,-0.16274E+01,
- &-0.16295E+01,-0.16317E+01,-0.16339E+01,-0.16360E+01,-0.16382E+01,
- &-0.16403E+01,-0.16425E+01,-0.16446E+01,-0.16468E+01,-0.16489E+01,
- &-0.16511E+01,-0.16532E+01,-0.16554E+01,-0.16575E+01,-0.16597E+01,
- &-0.16618E+01,-0.16639E+01,-0.16661E+01,-0.16682E+01,-0.16703E+01,
- &-0.16724E+01,-0.16746E+01,-0.16767E+01,-0.16788E+01,-0.16809E+01,
- &-0.16830E+01,-0.16851E+01,-0.16872E+01,-0.16893E+01,-0.16914E+01,
- &-0.16935E+01,-0.16956E+01,-0.16977E+01,-0.16998E+01,-0.17019E+01,
- &-0.17040E+01,-0.17061E+01,-0.17082E+01,-0.17103E+01,-0.17124E+01,
- &-0.17145E+01,-0.17165E+01,-0.17186E+01,-0.17207E+01,-0.17228E+01,
- &-0.17248E+01,-0.17269E+01,-0.17290E+01,-0.17310E+01,-0.17331E+01,
- &-0.17352E+01,-0.17372E+01,-0.17393E+01,-0.17413E+01,-0.17434E+01,
- &-0.17455E+01,-0.17475E+01,-0.17496E+01,-0.17516E+01,-0.17536E+01,
- &-0.17557E+01,-0.17577E+01,-0.17598E+01,-0.17618E+01,-0.17638E+01,
- &-0.17659E+01,-0.17679E+01,-0.17699E+01,-0.17720E+01,-0.17740E+01,
- &-0.17760E+01,-0.17781E+01,-0.17801E+01,-0.17821E+01,-0.17841E+01,
- &-0.17861E+01,-0.17881E+01,-0.17902E+01,-0.17922E+01,-0.17942E+01/
-
- DATA (BNC04M(I),I=401,500)/
- &-0.17962E+01,-0.17982E+01,-0.18002E+01,-0.18022E+01,-0.18042E+01,
- &-0.18062E+01,-0.18082E+01,-0.18102E+01,-0.18122E+01,-0.18142E+01,
- &-0.18162E+01,-0.18182E+01,-0.18202E+01,-0.18222E+01,-0.18241E+01,
- &-0.18261E+01,-0.18281E+01,-0.18301E+01,-0.18321E+01,-0.18341E+01,
- &-0.18360E+01,-0.18380E+01,-0.18400E+01,-0.18420E+01,-0.18439E+01,
- &-0.18459E+01,-0.18479E+01,-0.18498E+01,-0.18518E+01,-0.18538E+01,
- &-0.18557E+01,-0.18577E+01,-0.18596E+01,-0.18616E+01,-0.18636E+01,
- &-0.18655E+01,-0.18675E+01,-0.18694E+01,-0.18714E+01,-0.18733E+01,
- &-0.18753E+01,-0.18772E+01,-0.18792E+01,-0.18811E+01,-0.18830E+01,
- &-0.18850E+01,-0.18869E+01,-0.18889E+01,-0.18908E+01,-0.18927E+01,
- &-0.18947E+01,-0.18966E+01,-0.18985E+01,-0.19005E+01,-0.19024E+01,
- &-0.19043E+01,-0.19062E+01,-0.19082E+01,-0.19101E+01,-0.19120E+01,
- &-0.19139E+01,-0.19158E+01,-0.19178E+01,-0.19197E+01,-0.19216E+01,
- &-0.19235E+01,-0.19254E+01,-0.19273E+01,-0.19292E+01,-0.19311E+01,
- &-0.19331E+01,-0.19350E+01,-0.19369E+01,-0.19388E+01,-0.19407E+01,
- &-0.19426E+01,-0.19445E+01,-0.19464E+01,-0.19483E+01,-0.19502E+01,
- &-0.19521E+01,-0.19539E+01,-0.19558E+01,-0.19577E+01,-0.19596E+01,
- &-0.19615E+01,-0.19634E+01,-0.19653E+01,-0.19672E+01,-0.19691E+01,
- &-0.19709E+01,-0.19728E+01,-0.19747E+01,-0.19766E+01,-0.19785E+01,
- &-0.19803E+01,-0.19822E+01,-0.19841E+01,-0.19860E+01,-0.19878E+01/
-
- DATA (BNC04M(I),I=501,600)/
- &-0.19897E+01,-0.19916E+01,-0.19934E+01,-0.19953E+01,-0.19972E+01,
- &-0.19990E+01,-0.20009E+01,-0.20028E+01,-0.20046E+01,-0.20065E+01,
- &-0.20084E+01,-0.20102E+01,-0.20121E+01,-0.20139E+01,-0.20158E+01,
- &-0.20176E+01,-0.20195E+01,-0.20213E+01,-0.20232E+01,-0.20250E+01,
- &-0.20269E+01,-0.20287E+01,-0.20306E+01,-0.20324E+01,-0.20343E+01,
- &-0.20361E+01,-0.20380E+01,-0.20398E+01,-0.20416E+01,-0.20435E+01,
- &-0.20453E+01,-0.20472E+01,-0.20490E+01,-0.20508E+01,-0.20527E+01,
- &-0.20545E+01,-0.20563E+01,-0.20582E+01,-0.20600E+01,-0.20618E+01,
- &-0.20637E+01,-0.20655E+01,-0.20673E+01,-0.20691E+01,-0.20710E+01,
- &-0.20728E+01,-0.20746E+01,-0.20764E+01,-0.20782E+01,-0.20801E+01,
- &-0.20819E+01,-0.20837E+01,-0.20855E+01,-0.20873E+01,-0.20891E+01,
- &-0.20910E+01,-0.20928E+01,-0.20946E+01,-0.20964E+01,-0.20982E+01,
- &-0.21000E+01,-0.21018E+01,-0.21036E+01,-0.21054E+01,-0.21072E+01,
- &-0.21090E+01,-0.21109E+01,-0.21127E+01,-0.21145E+01,-0.21163E+01,
- &-0.21181E+01,-0.21199E+01,-0.21217E+01,-0.21234E+01,-0.21252E+01,
- &-0.21270E+01,-0.21288E+01,-0.21306E+01,-0.21324E+01,-0.21342E+01,
- &-0.21360E+01,-0.21378E+01,-0.21396E+01,-0.21414E+01,-0.21432E+01,
- &-0.21449E+01,-0.21467E+01,-0.21485E+01,-0.21503E+01,-0.21521E+01,
- &-0.21539E+01,-0.21556E+01,-0.21574E+01,-0.21592E+01,-0.21610E+01,
- &-0.21628E+01,-0.21645E+01,-0.21663E+01,-0.21681E+01,-0.21699E+01/
-
- DATA (BNC04M(I),I=601,700)/
- &-0.21890E+01,-0.22066E+01,-0.22241E+01,-0.22416E+01,-0.22589E+01,
- &-0.22762E+01,-0.22935E+01,-0.23106E+01,-0.23277E+01,-0.23448E+01,
- &-0.23617E+01,-0.23786E+01,-0.23955E+01,-0.24122E+01,-0.24290E+01,
- &-0.24456E+01,-0.24622E+01,-0.24788E+01,-0.24953E+01,-0.25117E+01,
- &-0.25281E+01,-0.25445E+01,-0.25608E+01,-0.25770E+01,-0.25932E+01,
- &-0.26094E+01,-0.26255E+01,-0.26415E+01,-0.26575E+01,-0.26735E+01,
- &-0.26894E+01,-0.27053E+01,-0.27212E+01,-0.27370E+01,-0.27528E+01,
- &-0.27685E+01,-0.27842E+01,-0.27998E+01,-0.28155E+01,-0.28310E+01,
- &-0.28466E+01,-0.28621E+01,-0.28776E+01,-0.28930E+01,-0.29084E+01,
- &-0.29238E+01,-0.29392E+01,-0.29545E+01,-0.29698E+01,-0.29850E+01,
- &-0.30002E+01,-0.30154E+01,-0.30306E+01,-0.30457E+01,-0.30608E+01,
- &-0.30759E+01,-0.30910E+01,-0.31060E+01,-0.31210E+01,-0.31360E+01,
- &-0.31509E+01,-0.31658E+01,-0.31807E+01,-0.31956E+01,-0.32104E+01,
- &-0.32252E+01,-0.32400E+01,-0.32548E+01,-0.32696E+01,-0.32843E+01,
- &-0.32990E+01,-0.33137E+01,-0.33283E+01,-0.33430E+01,-0.33576E+01,
- &-0.33722E+01,-0.33867E+01,-0.34013E+01,-0.34158E+01,-0.34303E+01,
- &-0.34448E+01,-0.34593E+01,-0.34737E+01,-0.34882E+01,-0.35026E+01,
- &-0.35170E+01,-0.35313E+01,-0.35457E+01,-0.35600E+01,-0.35743E+01,
- &-0.35886E+01,-0.36029E+01,-0.36172E+01,-0.36314E+01,-0.36456E+01,
- &-0.36599E+01,-0.36741E+01,-0.36882E+01,-0.37024E+01,-0.37165E+01/
-
- DATA (BNC04M(I),I=701,741)/
- &-0.37307E+01,-0.37448E+01,-0.37589E+01,-0.37730E+01,-0.37870E+01,
- &-0.38011E+01,-0.38151E+01,-0.38291E+01,-0.38431E+01,-0.38571E+01,
- &-0.38711E+01,-0.38850E+01,-0.38990E+01,-0.39129E+01,-0.39268E+01,
- &-0.39407E+01,-0.39546E+01,-0.39685E+01,-0.39824E+01,-0.39962E+01,
- &-0.40100E+01,-0.40239E+01,-0.40377E+01,-0.40515E+01,-0.40653E+01,
- &-0.40790E+01,-0.40928E+01,-0.41065E+01,-0.41203E+01,-0.41340E+01,
- &-0.41477E+01,-0.41614E+01,-0.41751E+01,-0.41887E+01,-0.42024E+01,
- &-0.42160E+01,-0.42297E+01,-0.42433E+01,-0.42569E+01,-0.42705E+01,
- &-0.42841E+01
- & /
-C
-C *** NH4NO3
-C
- DATA (BNC05M(I),I=1,100)/
- &-0.52307E-01,-0.11745E+00,-0.15210E+00,-0.17773E+00,-0.19864E+00,
- &-0.21658E+00,-0.23244E+00,-0.24676E+00,-0.25988E+00,-0.27205E+00,
- &-0.28343E+00,-0.29415E+00,-0.30431E+00,-0.31398E+00,-0.32322E+00,
- &-0.33209E+00,-0.34063E+00,-0.34886E+00,-0.35683E+00,-0.36454E+00,
- &-0.37203E+00,-0.37931E+00,-0.38640E+00,-0.39330E+00,-0.40004E+00,
- &-0.40662E+00,-0.41306E+00,-0.41936E+00,-0.42552E+00,-0.43157E+00,
- &-0.43749E+00,-0.44330E+00,-0.44901E+00,-0.45461E+00,-0.46012E+00,
- &-0.46553E+00,-0.47085E+00,-0.47609E+00,-0.48124E+00,-0.48631E+00,
- &-0.49130E+00,-0.49622E+00,-0.50107E+00,-0.50584E+00,-0.51055E+00,
- &-0.51519E+00,-0.51977E+00,-0.52429E+00,-0.52875E+00,-0.53315E+00,
- &-0.53750E+00,-0.54179E+00,-0.54603E+00,-0.55022E+00,-0.55436E+00,
- &-0.55846E+00,-0.56250E+00,-0.56651E+00,-0.57047E+00,-0.57439E+00,
- &-0.57828E+00,-0.58212E+00,-0.58593E+00,-0.58970E+00,-0.59344E+00,
- &-0.59715E+00,-0.60083E+00,-0.60448E+00,-0.60810E+00,-0.61169E+00,
- &-0.61526E+00,-0.61880E+00,-0.62232E+00,-0.62582E+00,-0.62930E+00,
- &-0.63275E+00,-0.63619E+00,-0.63960E+00,-0.64300E+00,-0.64639E+00,
- &-0.64976E+00,-0.65311E+00,-0.65645E+00,-0.65977E+00,-0.66308E+00,
- &-0.66638E+00,-0.66966E+00,-0.67294E+00,-0.67620E+00,-0.67945E+00,
- &-0.68269E+00,-0.68592E+00,-0.68914E+00,-0.69236E+00,-0.69556E+00,
- &-0.69875E+00,-0.70193E+00,-0.70511E+00,-0.70827E+00,-0.71143E+00/
-
- DATA (BNC05M(I),I=101,200)/
- &-0.71457E+00,-0.71771E+00,-0.72084E+00,-0.72396E+00,-0.72707E+00,
- &-0.73017E+00,-0.73326E+00,-0.73635E+00,-0.73942E+00,-0.74248E+00,
- &-0.74554E+00,-0.74859E+00,-0.75162E+00,-0.75465E+00,-0.75766E+00,
- &-0.76067E+00,-0.76367E+00,-0.76665E+00,-0.76963E+00,-0.77260E+00,
- &-0.77555E+00,-0.77850E+00,-0.78143E+00,-0.78436E+00,-0.78727E+00,
- &-0.79018E+00,-0.79307E+00,-0.79596E+00,-0.79883E+00,-0.80169E+00,
- &-0.80455E+00,-0.80739E+00,-0.81022E+00,-0.81304E+00,-0.81586E+00,
- &-0.81866E+00,-0.82145E+00,-0.82423E+00,-0.82700E+00,-0.82976E+00,
- &-0.83252E+00,-0.83526E+00,-0.83799E+00,-0.84071E+00,-0.84343E+00,
- &-0.84613E+00,-0.84882E+00,-0.85151E+00,-0.85418E+00,-0.85685E+00,
- &-0.85950E+00,-0.86215E+00,-0.86479E+00,-0.86742E+00,-0.87004E+00,
- &-0.87265E+00,-0.87525E+00,-0.87785E+00,-0.88043E+00,-0.88301E+00,
- &-0.88558E+00,-0.88814E+00,-0.89069E+00,-0.89323E+00,-0.89577E+00,
- &-0.89829E+00,-0.90081E+00,-0.90332E+00,-0.90583E+00,-0.90832E+00,
- &-0.91081E+00,-0.91329E+00,-0.91576E+00,-0.91822E+00,-0.92068E+00,
- &-0.92313E+00,-0.92557E+00,-0.92800E+00,-0.93043E+00,-0.93284E+00,
- &-0.93526E+00,-0.93766E+00,-0.94006E+00,-0.94245E+00,-0.94483E+00,
- &-0.94721E+00,-0.94958E+00,-0.95194E+00,-0.95429E+00,-0.95664E+00,
- &-0.95898E+00,-0.96132E+00,-0.96365E+00,-0.96597E+00,-0.96828E+00,
- &-0.97059E+00,-0.97290E+00,-0.97519E+00,-0.97748E+00,-0.97976E+00/
-
- DATA (BNC05M(I),I=201,300)/
- &-0.98204E+00,-0.98431E+00,-0.98657E+00,-0.98883E+00,-0.99108E+00,
- &-0.99333E+00,-0.99557E+00,-0.99780E+00,-0.10000E+01,-0.10023E+01,
- &-0.10045E+01,-0.10067E+01,-0.10089E+01,-0.10111E+01,-0.10133E+01,
- &-0.10155E+01,-0.10176E+01,-0.10198E+01,-0.10220E+01,-0.10242E+01,
- &-0.10263E+01,-0.10285E+01,-0.10306E+01,-0.10328E+01,-0.10349E+01,
- &-0.10370E+01,-0.10392E+01,-0.10413E+01,-0.10434E+01,-0.10455E+01,
- &-0.10476E+01,-0.10497E+01,-0.10518E+01,-0.10539E+01,-0.10560E+01,
- &-0.10581E+01,-0.10601E+01,-0.10622E+01,-0.10643E+01,-0.10663E+01,
- &-0.10684E+01,-0.10704E+01,-0.10725E+01,-0.10745E+01,-0.10766E+01,
- &-0.10786E+01,-0.10806E+01,-0.10826E+01,-0.10847E+01,-0.10867E+01,
- &-0.10887E+01,-0.10907E+01,-0.10927E+01,-0.10947E+01,-0.10967E+01,
- &-0.10987E+01,-0.11006E+01,-0.11026E+01,-0.11046E+01,-0.11066E+01,
- &-0.11085E+01,-0.11105E+01,-0.11124E+01,-0.11144E+01,-0.11163E+01,
- &-0.11183E+01,-0.11202E+01,-0.11221E+01,-0.11241E+01,-0.11260E+01,
- &-0.11279E+01,-0.11298E+01,-0.11317E+01,-0.11337E+01,-0.11356E+01,
- &-0.11375E+01,-0.11394E+01,-0.11413E+01,-0.11431E+01,-0.11450E+01,
- &-0.11469E+01,-0.11488E+01,-0.11507E+01,-0.11525E+01,-0.11544E+01,
- &-0.11563E+01,-0.11581E+01,-0.11600E+01,-0.11618E+01,-0.11637E+01,
- &-0.11655E+01,-0.11673E+01,-0.11692E+01,-0.11710E+01,-0.11728E+01,
- &-0.11747E+01,-0.11765E+01,-0.11783E+01,-0.11801E+01,-0.11819E+01/
-
- DATA (BNC05M(I),I=301,400)/
- &-0.11837E+01,-0.11855E+01,-0.11873E+01,-0.11891E+01,-0.11909E+01,
- &-0.11927E+01,-0.11945E+01,-0.11963E+01,-0.11981E+01,-0.11998E+01,
- &-0.12016E+01,-0.12034E+01,-0.12051E+01,-0.12069E+01,-0.12087E+01,
- &-0.12104E+01,-0.12122E+01,-0.12139E+01,-0.12157E+01,-0.12174E+01,
- &-0.12192E+01,-0.12209E+01,-0.12226E+01,-0.12244E+01,-0.12261E+01,
- &-0.12278E+01,-0.12295E+01,-0.12312E+01,-0.12330E+01,-0.12347E+01,
- &-0.12364E+01,-0.12381E+01,-0.12398E+01,-0.12415E+01,-0.12432E+01,
- &-0.12449E+01,-0.12466E+01,-0.12482E+01,-0.12499E+01,-0.12516E+01,
- &-0.12533E+01,-0.12550E+01,-0.12566E+01,-0.12583E+01,-0.12600E+01,
- &-0.12616E+01,-0.12633E+01,-0.12650E+01,-0.12666E+01,-0.12683E+01,
- &-0.12699E+01,-0.12716E+01,-0.12732E+01,-0.12748E+01,-0.12765E+01,
- &-0.12781E+01,-0.12798E+01,-0.12814E+01,-0.12830E+01,-0.12846E+01,
- &-0.12863E+01,-0.12879E+01,-0.12895E+01,-0.12911E+01,-0.12927E+01,
- &-0.12943E+01,-0.12959E+01,-0.12975E+01,-0.12991E+01,-0.13007E+01,
- &-0.13023E+01,-0.13039E+01,-0.13055E+01,-0.13071E+01,-0.13087E+01,
- &-0.13103E+01,-0.13119E+01,-0.13134E+01,-0.13150E+01,-0.13166E+01,
- &-0.13182E+01,-0.13197E+01,-0.13213E+01,-0.13229E+01,-0.13244E+01,
- &-0.13260E+01,-0.13275E+01,-0.13291E+01,-0.13306E+01,-0.13322E+01,
- &-0.13337E+01,-0.13353E+01,-0.13368E+01,-0.13384E+01,-0.13399E+01,
- &-0.13414E+01,-0.13430E+01,-0.13445E+01,-0.13460E+01,-0.13476E+01/
-
- DATA (BNC05M(I),I=401,500)/
- &-0.13491E+01,-0.13506E+01,-0.13521E+01,-0.13536E+01,-0.13552E+01,
- &-0.13567E+01,-0.13582E+01,-0.13597E+01,-0.13612E+01,-0.13627E+01,
- &-0.13642E+01,-0.13657E+01,-0.13672E+01,-0.13687E+01,-0.13702E+01,
- &-0.13717E+01,-0.13732E+01,-0.13747E+01,-0.13761E+01,-0.13776E+01,
- &-0.13791E+01,-0.13806E+01,-0.13821E+01,-0.13835E+01,-0.13850E+01,
- &-0.13865E+01,-0.13879E+01,-0.13894E+01,-0.13909E+01,-0.13923E+01,
- &-0.13938E+01,-0.13953E+01,-0.13967E+01,-0.13982E+01,-0.13996E+01,
- &-0.14011E+01,-0.14025E+01,-0.14040E+01,-0.14054E+01,-0.14068E+01,
- &-0.14083E+01,-0.14097E+01,-0.14112E+01,-0.14126E+01,-0.14140E+01,
- &-0.14155E+01,-0.14169E+01,-0.14183E+01,-0.14197E+01,-0.14212E+01,
- &-0.14226E+01,-0.14240E+01,-0.14254E+01,-0.14268E+01,-0.14283E+01,
- &-0.14297E+01,-0.14311E+01,-0.14325E+01,-0.14339E+01,-0.14353E+01,
- &-0.14367E+01,-0.14381E+01,-0.14395E+01,-0.14409E+01,-0.14423E+01,
- &-0.14437E+01,-0.14451E+01,-0.14465E+01,-0.14479E+01,-0.14492E+01,
- &-0.14506E+01,-0.14520E+01,-0.14534E+01,-0.14548E+01,-0.14562E+01,
- &-0.14575E+01,-0.14589E+01,-0.14603E+01,-0.14616E+01,-0.14630E+01,
- &-0.14644E+01,-0.14658E+01,-0.14671E+01,-0.14685E+01,-0.14698E+01,
- &-0.14712E+01,-0.14726E+01,-0.14739E+01,-0.14753E+01,-0.14766E+01,
- &-0.14780E+01,-0.14793E+01,-0.14807E+01,-0.14820E+01,-0.14834E+01,
- &-0.14847E+01,-0.14861E+01,-0.14874E+01,-0.14887E+01,-0.14901E+01/
-
- DATA (BNC05M(I),I=501,600)/
- &-0.14914E+01,-0.14927E+01,-0.14941E+01,-0.14954E+01,-0.14967E+01,
- &-0.14981E+01,-0.14994E+01,-0.15007E+01,-0.15020E+01,-0.15034E+01,
- &-0.15047E+01,-0.15060E+01,-0.15073E+01,-0.15086E+01,-0.15099E+01,
- &-0.15113E+01,-0.15126E+01,-0.15139E+01,-0.15152E+01,-0.15165E+01,
- &-0.15178E+01,-0.15191E+01,-0.15204E+01,-0.15217E+01,-0.15230E+01,
- &-0.15243E+01,-0.15256E+01,-0.15269E+01,-0.15282E+01,-0.15295E+01,
- &-0.15308E+01,-0.15321E+01,-0.15334E+01,-0.15346E+01,-0.15359E+01,
- &-0.15372E+01,-0.15385E+01,-0.15398E+01,-0.15411E+01,-0.15423E+01,
- &-0.15436E+01,-0.15449E+01,-0.15462E+01,-0.15474E+01,-0.15487E+01,
- &-0.15500E+01,-0.15512E+01,-0.15525E+01,-0.15538E+01,-0.15550E+01,
- &-0.15563E+01,-0.15576E+01,-0.15588E+01,-0.15601E+01,-0.15613E+01,
- &-0.15626E+01,-0.15639E+01,-0.15651E+01,-0.15664E+01,-0.15676E+01,
- &-0.15689E+01,-0.15701E+01,-0.15714E+01,-0.15726E+01,-0.15739E+01,
- &-0.15751E+01,-0.15764E+01,-0.15776E+01,-0.15788E+01,-0.15801E+01,
- &-0.15813E+01,-0.15825E+01,-0.15838E+01,-0.15850E+01,-0.15862E+01,
- &-0.15875E+01,-0.15887E+01,-0.15899E+01,-0.15912E+01,-0.15924E+01,
- &-0.15936E+01,-0.15948E+01,-0.15961E+01,-0.15973E+01,-0.15985E+01,
- &-0.15997E+01,-0.16010E+01,-0.16022E+01,-0.16034E+01,-0.16046E+01,
- &-0.16058E+01,-0.16070E+01,-0.16082E+01,-0.16094E+01,-0.16107E+01,
- &-0.16119E+01,-0.16131E+01,-0.16143E+01,-0.16155E+01,-0.16167E+01/
-
- DATA (BNC05M(I),I=601,700)/
- &-0.16296E+01,-0.16415E+01,-0.16532E+01,-0.16649E+01,-0.16764E+01,
- &-0.16878E+01,-0.16992E+01,-0.17104E+01,-0.17216E+01,-0.17327E+01,
- &-0.17437E+01,-0.17546E+01,-0.17654E+01,-0.17761E+01,-0.17868E+01,
- &-0.17974E+01,-0.18079E+01,-0.18184E+01,-0.18287E+01,-0.18391E+01,
- &-0.18493E+01,-0.18595E+01,-0.18696E+01,-0.18796E+01,-0.18896E+01,
- &-0.18996E+01,-0.19094E+01,-0.19193E+01,-0.19290E+01,-0.19387E+01,
- &-0.19484E+01,-0.19580E+01,-0.19675E+01,-0.19770E+01,-0.19865E+01,
- &-0.19959E+01,-0.20053E+01,-0.20146E+01,-0.20238E+01,-0.20331E+01,
- &-0.20423E+01,-0.20514E+01,-0.20605E+01,-0.20695E+01,-0.20786E+01,
- &-0.20875E+01,-0.20965E+01,-0.21054E+01,-0.21143E+01,-0.21231E+01,
- &-0.21319E+01,-0.21407E+01,-0.21494E+01,-0.21581E+01,-0.21667E+01,
- &-0.21754E+01,-0.21840E+01,-0.21925E+01,-0.22011E+01,-0.22096E+01,
- &-0.22180E+01,-0.22265E+01,-0.22349E+01,-0.22433E+01,-0.22517E+01,
- &-0.22600E+01,-0.22683E+01,-0.22766E+01,-0.22848E+01,-0.22931E+01,
- &-0.23013E+01,-0.23095E+01,-0.23176E+01,-0.23257E+01,-0.23338E+01,
- &-0.23419E+01,-0.23500E+01,-0.23580E+01,-0.23661E+01,-0.23741E+01,
- &-0.23820E+01,-0.23900E+01,-0.23979E+01,-0.24058E+01,-0.24137E+01,
- &-0.24216E+01,-0.24294E+01,-0.24373E+01,-0.24451E+01,-0.24529E+01,
- &-0.24607E+01,-0.24684E+01,-0.24762E+01,-0.24839E+01,-0.24916E+01,
- &-0.24993E+01,-0.25070E+01,-0.25146E+01,-0.25223E+01,-0.25299E+01/
-
- DATA (BNC05M(I),I=701,741)/
- &-0.25375E+01,-0.25451E+01,-0.25526E+01,-0.25602E+01,-0.25677E+01,
- &-0.25753E+01,-0.25828E+01,-0.25903E+01,-0.25978E+01,-0.26052E+01,
- &-0.26127E+01,-0.26201E+01,-0.26276E+01,-0.26350E+01,-0.26424E+01,
- &-0.26498E+01,-0.26571E+01,-0.26645E+01,-0.26718E+01,-0.26792E+01,
- &-0.26865E+01,-0.26938E+01,-0.27011E+01,-0.27084E+01,-0.27157E+01,
- &-0.27229E+01,-0.27302E+01,-0.27374E+01,-0.27446E+01,-0.27519E+01,
- &-0.27591E+01,-0.27663E+01,-0.27734E+01,-0.27806E+01,-0.27878E+01,
- &-0.27949E+01,-0.28021E+01,-0.28092E+01,-0.28163E+01,-0.28234E+01,
- &-0.28305E+01
- & /
-C
-C *** NH4Cl
-C
- DATA (BNC06M(I),I=1,100)/
- &-0.50630E-01,-0.10830E+00,-0.13610E+00,-0.15521E+00,-0.16983E+00,
- &-0.18165E+00,-0.19155E+00,-0.20002E+00,-0.20740E+00,-0.21392E+00,
- &-0.21974E+00,-0.22498E+00,-0.22973E+00,-0.23406E+00,-0.23803E+00,
- &-0.24168E+00,-0.24506E+00,-0.24819E+00,-0.25111E+00,-0.25383E+00,
- &-0.25638E+00,-0.25876E+00,-0.26101E+00,-0.26312E+00,-0.26512E+00,
- &-0.26700E+00,-0.26879E+00,-0.27049E+00,-0.27210E+00,-0.27363E+00,
- &-0.27509E+00,-0.27649E+00,-0.27782E+00,-0.27910E+00,-0.28032E+00,
- &-0.28149E+00,-0.28262E+00,-0.28371E+00,-0.28475E+00,-0.28576E+00,
- &-0.28673E+00,-0.28767E+00,-0.28858E+00,-0.28946E+00,-0.29032E+00,
- &-0.29115E+00,-0.29195E+00,-0.29273E+00,-0.29350E+00,-0.29424E+00,
- &-0.29496E+00,-0.29566E+00,-0.29635E+00,-0.29702E+00,-0.29767E+00,
- &-0.29831E+00,-0.29894E+00,-0.29955E+00,-0.30014E+00,-0.30073E+00,
- &-0.30130E+00,-0.30185E+00,-0.30240E+00,-0.30293E+00,-0.30345E+00,
- &-0.30396E+00,-0.30445E+00,-0.30494E+00,-0.30541E+00,-0.30587E+00,
- &-0.30632E+00,-0.30675E+00,-0.30718E+00,-0.30759E+00,-0.30799E+00,
- &-0.30838E+00,-0.30876E+00,-0.30912E+00,-0.30948E+00,-0.30982E+00,
- &-0.31015E+00,-0.31046E+00,-0.31077E+00,-0.31106E+00,-0.31134E+00,
- &-0.31161E+00,-0.31187E+00,-0.31212E+00,-0.31235E+00,-0.31257E+00,
- &-0.31279E+00,-0.31299E+00,-0.31318E+00,-0.31336E+00,-0.31352E+00,
- &-0.31368E+00,-0.31383E+00,-0.31397E+00,-0.31410E+00,-0.31422E+00/
-
- DATA (BNC06M(I),I=101,200)/
- &-0.31433E+00,-0.31443E+00,-0.31452E+00,-0.31461E+00,-0.31469E+00,
- &-0.31475E+00,-0.31482E+00,-0.31487E+00,-0.31492E+00,-0.31496E+00,
- &-0.31499E+00,-0.31502E+00,-0.31505E+00,-0.31506E+00,-0.31508E+00,
- &-0.31508E+00,-0.31509E+00,-0.31509E+00,-0.31508E+00,-0.31507E+00,
- &-0.31506E+00,-0.31504E+00,-0.31502E+00,-0.31500E+00,-0.31497E+00,
- &-0.31494E+00,-0.31491E+00,-0.31487E+00,-0.31483E+00,-0.31479E+00,
- &-0.31475E+00,-0.31471E+00,-0.31466E+00,-0.31461E+00,-0.31456E+00,
- &-0.31451E+00,-0.31446E+00,-0.31441E+00,-0.31435E+00,-0.31430E+00,
- &-0.31424E+00,-0.31418E+00,-0.31412E+00,-0.31406E+00,-0.31400E+00,
- &-0.31393E+00,-0.31387E+00,-0.31381E+00,-0.31374E+00,-0.31367E+00,
- &-0.31361E+00,-0.31354E+00,-0.31347E+00,-0.31340E+00,-0.31334E+00,
- &-0.31327E+00,-0.31320E+00,-0.31313E+00,-0.31305E+00,-0.31298E+00,
- &-0.31291E+00,-0.31284E+00,-0.31277E+00,-0.31270E+00,-0.31262E+00,
- &-0.31255E+00,-0.31248E+00,-0.31240E+00,-0.31233E+00,-0.31226E+00,
- &-0.31218E+00,-0.31211E+00,-0.31204E+00,-0.31196E+00,-0.31189E+00,
- &-0.31182E+00,-0.31174E+00,-0.31167E+00,-0.31159E+00,-0.31152E+00,
- &-0.31145E+00,-0.31137E+00,-0.31130E+00,-0.31123E+00,-0.31115E+00,
- &-0.31108E+00,-0.31101E+00,-0.31094E+00,-0.31086E+00,-0.31079E+00,
- &-0.31072E+00,-0.31065E+00,-0.31058E+00,-0.31050E+00,-0.31043E+00,
- &-0.31036E+00,-0.31029E+00,-0.31022E+00,-0.31015E+00,-0.31008E+00/
-
- DATA (BNC06M(I),I=201,300)/
- &-0.31001E+00,-0.30994E+00,-0.30988E+00,-0.30981E+00,-0.30974E+00,
- &-0.30967E+00,-0.30960E+00,-0.30954E+00,-0.30947E+00,-0.30941E+00,
- &-0.30934E+00,-0.30928E+00,-0.30921E+00,-0.30915E+00,-0.30908E+00,
- &-0.30902E+00,-0.30896E+00,-0.30889E+00,-0.30883E+00,-0.30877E+00,
- &-0.30871E+00,-0.30865E+00,-0.30859E+00,-0.30853E+00,-0.30847E+00,
- &-0.30841E+00,-0.30835E+00,-0.30830E+00,-0.30824E+00,-0.30818E+00,
- &-0.30813E+00,-0.30807E+00,-0.30802E+00,-0.30796E+00,-0.30791E+00,
- &-0.30786E+00,-0.30780E+00,-0.30775E+00,-0.30770E+00,-0.30765E+00,
- &-0.30760E+00,-0.30755E+00,-0.30750E+00,-0.30745E+00,-0.30740E+00,
- &-0.30736E+00,-0.30731E+00,-0.30726E+00,-0.30722E+00,-0.30717E+00,
- &-0.30713E+00,-0.30708E+00,-0.30704E+00,-0.30700E+00,-0.30696E+00,
- &-0.30692E+00,-0.30687E+00,-0.30683E+00,-0.30680E+00,-0.30676E+00,
- &-0.30672E+00,-0.30668E+00,-0.30664E+00,-0.30661E+00,-0.30657E+00,
- &-0.30654E+00,-0.30650E+00,-0.30647E+00,-0.30644E+00,-0.30640E+00,
- &-0.30637E+00,-0.30634E+00,-0.30631E+00,-0.30628E+00,-0.30625E+00,
- &-0.30622E+00,-0.30620E+00,-0.30617E+00,-0.30614E+00,-0.30612E+00,
- &-0.30609E+00,-0.30607E+00,-0.30604E+00,-0.30602E+00,-0.30600E+00,
- &-0.30598E+00,-0.30595E+00,-0.30593E+00,-0.30591E+00,-0.30590E+00,
- &-0.30588E+00,-0.30586E+00,-0.30584E+00,-0.30583E+00,-0.30581E+00,
- &-0.30579E+00,-0.30578E+00,-0.30577E+00,-0.30575E+00,-0.30574E+00/
-
- DATA (BNC06M(I),I=301,400)/
- &-0.30573E+00,-0.30572E+00,-0.30571E+00,-0.30570E+00,-0.30569E+00,
- &-0.30568E+00,-0.30567E+00,-0.30567E+00,-0.30566E+00,-0.30565E+00,
- &-0.30565E+00,-0.30564E+00,-0.30564E+00,-0.30564E+00,-0.30563E+00,
- &-0.30563E+00,-0.30563E+00,-0.30563E+00,-0.30563E+00,-0.30563E+00,
- &-0.30564E+00,-0.30564E+00,-0.30564E+00,-0.30564E+00,-0.30565E+00,
- &-0.30565E+00,-0.30566E+00,-0.30567E+00,-0.30567E+00,-0.30568E+00,
- &-0.30569E+00,-0.30570E+00,-0.30571E+00,-0.30572E+00,-0.30573E+00,
- &-0.30574E+00,-0.30575E+00,-0.30577E+00,-0.30578E+00,-0.30580E+00,
- &-0.30581E+00,-0.30583E+00,-0.30584E+00,-0.30586E+00,-0.30588E+00,
- &-0.30590E+00,-0.30592E+00,-0.30594E+00,-0.30596E+00,-0.30598E+00,
- &-0.30600E+00,-0.30602E+00,-0.30605E+00,-0.30607E+00,-0.30609E+00,
- &-0.30612E+00,-0.30614E+00,-0.30617E+00,-0.30620E+00,-0.30623E+00,
- &-0.30625E+00,-0.30628E+00,-0.30631E+00,-0.30634E+00,-0.30637E+00,
- &-0.30641E+00,-0.30644E+00,-0.30647E+00,-0.30650E+00,-0.30654E+00,
- &-0.30657E+00,-0.30661E+00,-0.30665E+00,-0.30668E+00,-0.30672E+00,
- &-0.30676E+00,-0.30680E+00,-0.30684E+00,-0.30688E+00,-0.30692E+00,
- &-0.30696E+00,-0.30700E+00,-0.30704E+00,-0.30709E+00,-0.30713E+00,
- &-0.30717E+00,-0.30722E+00,-0.30726E+00,-0.30731E+00,-0.30736E+00,
- &-0.30741E+00,-0.30745E+00,-0.30750E+00,-0.30755E+00,-0.30760E+00,
- &-0.30765E+00,-0.30770E+00,-0.30776E+00,-0.30781E+00,-0.30786E+00/
-
- DATA (BNC06M(I),I=401,500)/
- &-0.30792E+00,-0.30797E+00,-0.30803E+00,-0.30808E+00,-0.30814E+00,
- &-0.30820E+00,-0.30825E+00,-0.30831E+00,-0.30837E+00,-0.30843E+00,
- &-0.30849E+00,-0.30855E+00,-0.30861E+00,-0.30867E+00,-0.30874E+00,
- &-0.30880E+00,-0.30886E+00,-0.30893E+00,-0.30899E+00,-0.30906E+00,
- &-0.30912E+00,-0.30919E+00,-0.30926E+00,-0.30932E+00,-0.30939E+00,
- &-0.30946E+00,-0.30953E+00,-0.30960E+00,-0.30967E+00,-0.30974E+00,
- &-0.30982E+00,-0.30989E+00,-0.30996E+00,-0.31004E+00,-0.31011E+00,
- &-0.31019E+00,-0.31026E+00,-0.31034E+00,-0.31041E+00,-0.31049E+00,
- &-0.31057E+00,-0.31065E+00,-0.31073E+00,-0.31081E+00,-0.31089E+00,
- &-0.31097E+00,-0.31105E+00,-0.31113E+00,-0.31121E+00,-0.31130E+00,
- &-0.31138E+00,-0.31146E+00,-0.31155E+00,-0.31163E+00,-0.31172E+00,
- &-0.31181E+00,-0.31189E+00,-0.31198E+00,-0.31207E+00,-0.31216E+00,
- &-0.31225E+00,-0.31234E+00,-0.31243E+00,-0.31252E+00,-0.31261E+00,
- &-0.31270E+00,-0.31279E+00,-0.31289E+00,-0.31298E+00,-0.31308E+00,
- &-0.31317E+00,-0.31327E+00,-0.31336E+00,-0.31346E+00,-0.31356E+00,
- &-0.31365E+00,-0.31375E+00,-0.31385E+00,-0.31395E+00,-0.31405E+00,
- &-0.31415E+00,-0.31425E+00,-0.31435E+00,-0.31445E+00,-0.31456E+00,
- &-0.31466E+00,-0.31476E+00,-0.31487E+00,-0.31497E+00,-0.31508E+00,
- &-0.31518E+00,-0.31529E+00,-0.31539E+00,-0.31550E+00,-0.31561E+00,
- &-0.31572E+00,-0.31583E+00,-0.31594E+00,-0.31605E+00,-0.31616E+00/
-
- DATA (BNC06M(I),I=501,600)/
- &-0.31627E+00,-0.31638E+00,-0.31649E+00,-0.31660E+00,-0.31672E+00,
- &-0.31683E+00,-0.31694E+00,-0.31706E+00,-0.31717E+00,-0.31729E+00,
- &-0.31740E+00,-0.31752E+00,-0.31764E+00,-0.31776E+00,-0.31787E+00,
- &-0.31799E+00,-0.31811E+00,-0.31823E+00,-0.31835E+00,-0.31847E+00,
- &-0.31859E+00,-0.31871E+00,-0.31884E+00,-0.31896E+00,-0.31908E+00,
- &-0.31921E+00,-0.31933E+00,-0.31945E+00,-0.31958E+00,-0.31971E+00,
- &-0.31983E+00,-0.31996E+00,-0.32009E+00,-0.32021E+00,-0.32034E+00,
- &-0.32047E+00,-0.32060E+00,-0.32073E+00,-0.32086E+00,-0.32099E+00,
- &-0.32112E+00,-0.32125E+00,-0.32138E+00,-0.32151E+00,-0.32165E+00,
- &-0.32178E+00,-0.32191E+00,-0.32205E+00,-0.32218E+00,-0.32232E+00,
- &-0.32246E+00,-0.32259E+00,-0.32273E+00,-0.32287E+00,-0.32300E+00,
- &-0.32314E+00,-0.32328E+00,-0.32342E+00,-0.32356E+00,-0.32370E+00,
- &-0.32384E+00,-0.32398E+00,-0.32412E+00,-0.32426E+00,-0.32440E+00,
- &-0.32455E+00,-0.32469E+00,-0.32483E+00,-0.32498E+00,-0.32512E+00,
- &-0.32527E+00,-0.32541E+00,-0.32556E+00,-0.32571E+00,-0.32585E+00,
- &-0.32600E+00,-0.32615E+00,-0.32630E+00,-0.32644E+00,-0.32659E+00,
- &-0.32674E+00,-0.32689E+00,-0.32704E+00,-0.32719E+00,-0.32735E+00,
- &-0.32750E+00,-0.32765E+00,-0.32780E+00,-0.32796E+00,-0.32811E+00,
- &-0.32826E+00,-0.32842E+00,-0.32857E+00,-0.32873E+00,-0.32888E+00,
- &-0.32904E+00,-0.32920E+00,-0.32935E+00,-0.32951E+00,-0.32967E+00/
-
- DATA (BNC06M(I),I=601,700)/
- &-0.33140E+00,-0.33305E+00,-0.33474E+00,-0.33647E+00,-0.33824E+00,
- &-0.34005E+00,-0.34190E+00,-0.34379E+00,-0.34571E+00,-0.34767E+00,
- &-0.34966E+00,-0.35169E+00,-0.35376E+00,-0.35586E+00,-0.35799E+00,
- &-0.36016E+00,-0.36235E+00,-0.36458E+00,-0.36684E+00,-0.36913E+00,
- &-0.37146E+00,-0.37381E+00,-0.37619E+00,-0.37859E+00,-0.38103E+00,
- &-0.38349E+00,-0.38598E+00,-0.38850E+00,-0.39105E+00,-0.39361E+00,
- &-0.39621E+00,-0.39883E+00,-0.40147E+00,-0.40414E+00,-0.40684E+00,
- &-0.40955E+00,-0.41229E+00,-0.41506E+00,-0.41784E+00,-0.42065E+00,
- &-0.42348E+00,-0.42633E+00,-0.42920E+00,-0.43209E+00,-0.43500E+00,
- &-0.43793E+00,-0.44089E+00,-0.44386E+00,-0.44685E+00,-0.44986E+00,
- &-0.45289E+00,-0.45594E+00,-0.45901E+00,-0.46209E+00,-0.46519E+00,
- &-0.46831E+00,-0.47145E+00,-0.47460E+00,-0.47777E+00,-0.48096E+00,
- &-0.48416E+00,-0.48738E+00,-0.49062E+00,-0.49387E+00,-0.49713E+00,
- &-0.50042E+00,-0.50371E+00,-0.50702E+00,-0.51035E+00,-0.51369E+00,
- &-0.51705E+00,-0.52042E+00,-0.52380E+00,-0.52720E+00,-0.53061E+00,
- &-0.53403E+00,-0.53747E+00,-0.54092E+00,-0.54438E+00,-0.54786E+00,
- &-0.55135E+00,-0.55485E+00,-0.55836E+00,-0.56189E+00,-0.56543E+00,
- &-0.56898E+00,-0.57254E+00,-0.57611E+00,-0.57970E+00,-0.58329E+00,
- &-0.58690E+00,-0.59052E+00,-0.59415E+00,-0.59779E+00,-0.60144E+00,
- &-0.60510E+00,-0.60877E+00,-0.61245E+00,-0.61614E+00,-0.61985E+00/
-
- DATA (BNC06M(I),I=701,741)/
- &-0.62356E+00,-0.62728E+00,-0.63101E+00,-0.63475E+00,-0.63851E+00,
- &-0.64227E+00,-0.64604E+00,-0.64982E+00,-0.65360E+00,-0.65740E+00,
- &-0.66121E+00,-0.66502E+00,-0.66885E+00,-0.67268E+00,-0.67652E+00,
- &-0.68037E+00,-0.68423E+00,-0.68809E+00,-0.69197E+00,-0.69585E+00,
- &-0.69974E+00,-0.70364E+00,-0.70755E+00,-0.71146E+00,-0.71539E+00,
- &-0.71932E+00,-0.72325E+00,-0.72720E+00,-0.73115E+00,-0.73511E+00,
- &-0.73908E+00,-0.74305E+00,-0.74703E+00,-0.75102E+00,-0.75502E+00,
- &-0.75902E+00,-0.76303E+00,-0.76705E+00,-0.77107E+00,-0.77510E+00,
- &-0.77914E+00
- & /
-C
-C *** (2H,SO4)
-C
- DATA (BNC07M(I),I=1,100)/
- &-0.10274E+00,-0.22462E+00,-0.28619E+00,-0.33008E+00,-0.36478E+00,
- &-0.39372E+00,-0.41868E+00,-0.44069E+00,-0.46044E+00,-0.47838E+00,
- &-0.49484E+00,-0.51007E+00,-0.52427E+00,-0.53757E+00,-0.55009E+00,
- &-0.56194E+00,-0.57319E+00,-0.58390E+00,-0.59414E+00,-0.60394E+00,
- &-0.61335E+00,-0.62240E+00,-0.63113E+00,-0.63956E+00,-0.64771E+00,
- &-0.65561E+00,-0.66327E+00,-0.67070E+00,-0.67794E+00,-0.68498E+00,
- &-0.69184E+00,-0.69853E+00,-0.70506E+00,-0.71145E+00,-0.71769E+00,
- &-0.72379E+00,-0.72977E+00,-0.73563E+00,-0.74138E+00,-0.74701E+00,
- &-0.75254E+00,-0.75798E+00,-0.76331E+00,-0.76856E+00,-0.77372E+00,
- &-0.77880E+00,-0.78380E+00,-0.78872E+00,-0.79357E+00,-0.79835E+00,
- &-0.80306E+00,-0.80771E+00,-0.81229E+00,-0.81682E+00,-0.82128E+00,
- &-0.82569E+00,-0.83005E+00,-0.83435E+00,-0.83860E+00,-0.84281E+00,
- &-0.84697E+00,-0.85108E+00,-0.85515E+00,-0.85917E+00,-0.86316E+00,
- &-0.86710E+00,-0.87101E+00,-0.87488E+00,-0.87871E+00,-0.88251E+00,
- &-0.88628E+00,-0.89001E+00,-0.89371E+00,-0.89738E+00,-0.90102E+00,
- &-0.90463E+00,-0.90821E+00,-0.91176E+00,-0.91529E+00,-0.91879E+00,
- &-0.92227E+00,-0.92572E+00,-0.92915E+00,-0.93256E+00,-0.93594E+00,
- &-0.93930E+00,-0.94264E+00,-0.94596E+00,-0.94926E+00,-0.95253E+00,
- &-0.95579E+00,-0.95903E+00,-0.96225E+00,-0.96546E+00,-0.96864E+00,
- &-0.97181E+00,-0.97496E+00,-0.97810E+00,-0.98121E+00,-0.98432E+00/
-
- DATA (BNC07M(I),I=101,200)/
- &-0.98740E+00,-0.99047E+00,-0.99353E+00,-0.99657E+00,-0.99960E+00,
- &-0.10026E+01,-0.10056E+01,-0.10086E+01,-0.10116E+01,-0.10145E+01,
- &-0.10175E+01,-0.10204E+01,-0.10233E+01,-0.10262E+01,-0.10291E+01,
- &-0.10320E+01,-0.10349E+01,-0.10377E+01,-0.10406E+01,-0.10434E+01,
- &-0.10462E+01,-0.10490E+01,-0.10518E+01,-0.10546E+01,-0.10574E+01,
- &-0.10601E+01,-0.10629E+01,-0.10656E+01,-0.10684E+01,-0.10711E+01,
- &-0.10738E+01,-0.10765E+01,-0.10792E+01,-0.10819E+01,-0.10846E+01,
- &-0.10872E+01,-0.10899E+01,-0.10926E+01,-0.10952E+01,-0.10978E+01,
- &-0.11004E+01,-0.11031E+01,-0.11057E+01,-0.11083E+01,-0.11108E+01,
- &-0.11134E+01,-0.11160E+01,-0.11186E+01,-0.11211E+01,-0.11237E+01,
- &-0.11262E+01,-0.11287E+01,-0.11313E+01,-0.11338E+01,-0.11363E+01,
- &-0.11388E+01,-0.11413E+01,-0.11438E+01,-0.11463E+01,-0.11487E+01,
- &-0.11512E+01,-0.11537E+01,-0.11561E+01,-0.11586E+01,-0.11610E+01,
- &-0.11634E+01,-0.11659E+01,-0.11683E+01,-0.11707E+01,-0.11731E+01,
- &-0.11755E+01,-0.11779E+01,-0.11803E+01,-0.11827E+01,-0.11851E+01,
- &-0.11874E+01,-0.11898E+01,-0.11922E+01,-0.11945E+01,-0.11969E+01,
- &-0.11992E+01,-0.12016E+01,-0.12039E+01,-0.12062E+01,-0.12086E+01,
- &-0.12109E+01,-0.12132E+01,-0.12155E+01,-0.12178E+01,-0.12201E+01,
- &-0.12224E+01,-0.12247E+01,-0.12270E+01,-0.12293E+01,-0.12315E+01,
- &-0.12338E+01,-0.12361E+01,-0.12383E+01,-0.12406E+01,-0.12428E+01/
-
- DATA (BNC07M(I),I=201,300)/
- &-0.12451E+01,-0.12473E+01,-0.12496E+01,-0.12518E+01,-0.12540E+01,
- &-0.12563E+01,-0.12585E+01,-0.12607E+01,-0.12629E+01,-0.12651E+01,
- &-0.12673E+01,-0.12695E+01,-0.12717E+01,-0.12739E+01,-0.12761E+01,
- &-0.12783E+01,-0.12805E+01,-0.12827E+01,-0.12848E+01,-0.12870E+01,
- &-0.12892E+01,-0.12913E+01,-0.12935E+01,-0.12956E+01,-0.12978E+01,
- &-0.12999E+01,-0.13021E+01,-0.13042E+01,-0.13064E+01,-0.13085E+01,
- &-0.13106E+01,-0.13128E+01,-0.13149E+01,-0.13170E+01,-0.13191E+01,
- &-0.13212E+01,-0.13233E+01,-0.13254E+01,-0.13275E+01,-0.13296E+01,
- &-0.13317E+01,-0.13338E+01,-0.13359E+01,-0.13380E+01,-0.13401E+01,
- &-0.13422E+01,-0.13443E+01,-0.13463E+01,-0.13484E+01,-0.13505E+01,
- &-0.13526E+01,-0.13546E+01,-0.13567E+01,-0.13587E+01,-0.13608E+01,
- &-0.13628E+01,-0.13649E+01,-0.13669E+01,-0.13690E+01,-0.13710E+01,
- &-0.13731E+01,-0.13751E+01,-0.13771E+01,-0.13792E+01,-0.13812E+01,
- &-0.13832E+01,-0.13852E+01,-0.13873E+01,-0.13893E+01,-0.13913E+01,
- &-0.13933E+01,-0.13953E+01,-0.13973E+01,-0.13993E+01,-0.14013E+01,
- &-0.14033E+01,-0.14053E+01,-0.14073E+01,-0.14093E+01,-0.14113E+01,
- &-0.14133E+01,-0.14153E+01,-0.14173E+01,-0.14192E+01,-0.14212E+01,
- &-0.14232E+01,-0.14252E+01,-0.14271E+01,-0.14291E+01,-0.14311E+01,
- &-0.14330E+01,-0.14350E+01,-0.14370E+01,-0.14389E+01,-0.14409E+01,
- &-0.14428E+01,-0.14448E+01,-0.14467E+01,-0.14487E+01,-0.14506E+01/
-
- DATA (BNC07M(I),I=301,400)/
- &-0.14526E+01,-0.14545E+01,-0.14564E+01,-0.14584E+01,-0.14603E+01,
- &-0.14622E+01,-0.14642E+01,-0.14661E+01,-0.14680E+01,-0.14700E+01,
- &-0.14719E+01,-0.14738E+01,-0.14757E+01,-0.14776E+01,-0.14795E+01,
- &-0.14815E+01,-0.14834E+01,-0.14853E+01,-0.14872E+01,-0.14891E+01,
- &-0.14910E+01,-0.14929E+01,-0.14948E+01,-0.14967E+01,-0.14986E+01,
- &-0.15005E+01,-0.15024E+01,-0.15043E+01,-0.15062E+01,-0.15080E+01,
- &-0.15099E+01,-0.15118E+01,-0.15137E+01,-0.15156E+01,-0.15174E+01,
- &-0.15193E+01,-0.15212E+01,-0.15231E+01,-0.15249E+01,-0.15268E+01,
- &-0.15287E+01,-0.15305E+01,-0.15324E+01,-0.15343E+01,-0.15361E+01,
- &-0.15380E+01,-0.15399E+01,-0.15417E+01,-0.15436E+01,-0.15454E+01,
- &-0.15473E+01,-0.15491E+01,-0.15510E+01,-0.15528E+01,-0.15547E+01,
- &-0.15565E+01,-0.15583E+01,-0.15602E+01,-0.15620E+01,-0.15639E+01,
- &-0.15657E+01,-0.15675E+01,-0.15694E+01,-0.15712E+01,-0.15730E+01,
- &-0.15749E+01,-0.15767E+01,-0.15785E+01,-0.15803E+01,-0.15822E+01,
- &-0.15840E+01,-0.15858E+01,-0.15876E+01,-0.15894E+01,-0.15913E+01,
- &-0.15931E+01,-0.15949E+01,-0.15967E+01,-0.15985E+01,-0.16003E+01,
- &-0.16021E+01,-0.16039E+01,-0.16057E+01,-0.16075E+01,-0.16093E+01,
- &-0.16111E+01,-0.16129E+01,-0.16147E+01,-0.16165E+01,-0.16183E+01,
- &-0.16201E+01,-0.16219E+01,-0.16237E+01,-0.16255E+01,-0.16273E+01,
- &-0.16291E+01,-0.16309E+01,-0.16326E+01,-0.16344E+01,-0.16362E+01/
-
- DATA (BNC07M(I),I=401,500)/
- &-0.16380E+01,-0.16398E+01,-0.16415E+01,-0.16433E+01,-0.16451E+01,
- &-0.16469E+01,-0.16486E+01,-0.16504E+01,-0.16522E+01,-0.16540E+01,
- &-0.16557E+01,-0.16575E+01,-0.16593E+01,-0.16610E+01,-0.16628E+01,
- &-0.16646E+01,-0.16663E+01,-0.16681E+01,-0.16698E+01,-0.16716E+01,
- &-0.16734E+01,-0.16751E+01,-0.16769E+01,-0.16786E+01,-0.16804E+01,
- &-0.16821E+01,-0.16839E+01,-0.16856E+01,-0.16874E+01,-0.16891E+01,
- &-0.16909E+01,-0.16926E+01,-0.16944E+01,-0.16961E+01,-0.16978E+01,
- &-0.16996E+01,-0.17013E+01,-0.17031E+01,-0.17048E+01,-0.17065E+01,
- &-0.17083E+01,-0.17100E+01,-0.17117E+01,-0.17135E+01,-0.17152E+01,
- &-0.17169E+01,-0.17187E+01,-0.17204E+01,-0.17221E+01,-0.17238E+01,
- &-0.17256E+01,-0.17273E+01,-0.17290E+01,-0.17307E+01,-0.17325E+01,
- &-0.17342E+01,-0.17359E+01,-0.17376E+01,-0.17393E+01,-0.17411E+01,
- &-0.17428E+01,-0.17445E+01,-0.17462E+01,-0.17479E+01,-0.17496E+01,
- &-0.17513E+01,-0.17530E+01,-0.17547E+01,-0.17565E+01,-0.17582E+01,
- &-0.17599E+01,-0.17616E+01,-0.17633E+01,-0.17650E+01,-0.17667E+01,
- &-0.17684E+01,-0.17701E+01,-0.17718E+01,-0.17735E+01,-0.17752E+01,
- &-0.17769E+01,-0.17786E+01,-0.17803E+01,-0.17820E+01,-0.17836E+01,
- &-0.17853E+01,-0.17870E+01,-0.17887E+01,-0.17904E+01,-0.17921E+01,
- &-0.17938E+01,-0.17955E+01,-0.17972E+01,-0.17988E+01,-0.18005E+01,
- &-0.18022E+01,-0.18039E+01,-0.18056E+01,-0.18073E+01,-0.18089E+01/
-
- DATA (BNC07M(I),I=501,600)/
- &-0.18106E+01,-0.18123E+01,-0.18140E+01,-0.18157E+01,-0.18173E+01,
- &-0.18190E+01,-0.18207E+01,-0.18223E+01,-0.18240E+01,-0.18257E+01,
- &-0.18274E+01,-0.18290E+01,-0.18307E+01,-0.18324E+01,-0.18340E+01,
- &-0.18357E+01,-0.18374E+01,-0.18390E+01,-0.18407E+01,-0.18424E+01,
- &-0.18440E+01,-0.18457E+01,-0.18474E+01,-0.18490E+01,-0.18507E+01,
- &-0.18523E+01,-0.18540E+01,-0.18556E+01,-0.18573E+01,-0.18590E+01,
- &-0.18606E+01,-0.18623E+01,-0.18639E+01,-0.18656E+01,-0.18672E+01,
- &-0.18689E+01,-0.18705E+01,-0.18722E+01,-0.18738E+01,-0.18755E+01,
- &-0.18771E+01,-0.18788E+01,-0.18804E+01,-0.18821E+01,-0.18837E+01,
- &-0.18854E+01,-0.18870E+01,-0.18886E+01,-0.18903E+01,-0.18919E+01,
- &-0.18936E+01,-0.18952E+01,-0.18968E+01,-0.18985E+01,-0.19001E+01,
- &-0.19018E+01,-0.19034E+01,-0.19050E+01,-0.19067E+01,-0.19083E+01,
- &-0.19099E+01,-0.19116E+01,-0.19132E+01,-0.19148E+01,-0.19165E+01,
- &-0.19181E+01,-0.19197E+01,-0.19214E+01,-0.19230E+01,-0.19246E+01,
- &-0.19262E+01,-0.19279E+01,-0.19295E+01,-0.19311E+01,-0.19327E+01,
- &-0.19344E+01,-0.19360E+01,-0.19376E+01,-0.19392E+01,-0.19408E+01,
- &-0.19425E+01,-0.19441E+01,-0.19457E+01,-0.19473E+01,-0.19489E+01,
- &-0.19506E+01,-0.19522E+01,-0.19538E+01,-0.19554E+01,-0.19570E+01,
- &-0.19586E+01,-0.19602E+01,-0.19619E+01,-0.19635E+01,-0.19651E+01,
- &-0.19667E+01,-0.19683E+01,-0.19699E+01,-0.19715E+01,-0.19731E+01/
-
- DATA (BNC07M(I),I=601,700)/
- &-0.19905E+01,-0.20065E+01,-0.20224E+01,-0.20383E+01,-0.20541E+01,
- &-0.20698E+01,-0.20856E+01,-0.21012E+01,-0.21168E+01,-0.21324E+01,
- &-0.21479E+01,-0.21634E+01,-0.21788E+01,-0.21942E+01,-0.22096E+01,
- &-0.22249E+01,-0.22401E+01,-0.22554E+01,-0.22705E+01,-0.22857E+01,
- &-0.23008E+01,-0.23159E+01,-0.23309E+01,-0.23459E+01,-0.23609E+01,
- &-0.23758E+01,-0.23907E+01,-0.24056E+01,-0.24204E+01,-0.24352E+01,
- &-0.24500E+01,-0.24647E+01,-0.24795E+01,-0.24941E+01,-0.25088E+01,
- &-0.25234E+01,-0.25380E+01,-0.25526E+01,-0.25672E+01,-0.25817E+01,
- &-0.25962E+01,-0.26107E+01,-0.26251E+01,-0.26395E+01,-0.26539E+01,
- &-0.26683E+01,-0.26827E+01,-0.26970E+01,-0.27113E+01,-0.27256E+01,
- &-0.27399E+01,-0.27541E+01,-0.27683E+01,-0.27825E+01,-0.27967E+01,
- &-0.28109E+01,-0.28250E+01,-0.28391E+01,-0.28532E+01,-0.28673E+01,
- &-0.28814E+01,-0.28954E+01,-0.29094E+01,-0.29235E+01,-0.29374E+01,
- &-0.29514E+01,-0.29654E+01,-0.29793E+01,-0.29932E+01,-0.30071E+01,
- &-0.30210E+01,-0.30349E+01,-0.30487E+01,-0.30626E+01,-0.30764E+01,
- &-0.30902E+01,-0.31040E+01,-0.31178E+01,-0.31315E+01,-0.31453E+01,
- &-0.31590E+01,-0.31727E+01,-0.31864E+01,-0.32001E+01,-0.32138E+01,
- &-0.32274E+01,-0.32411E+01,-0.32547E+01,-0.32683E+01,-0.32819E+01,
- &-0.32955E+01,-0.33091E+01,-0.33226E+01,-0.33362E+01,-0.33497E+01,
- &-0.33632E+01,-0.33767E+01,-0.33902E+01,-0.34037E+01,-0.34172E+01/
-
- DATA (BNC07M(I),I=701,741)/
- &-0.34307E+01,-0.34441E+01,-0.34576E+01,-0.34710E+01,-0.34844E+01,
- &-0.34978E+01,-0.35112E+01,-0.35246E+01,-0.35380E+01,-0.35513E+01,
- &-0.35647E+01,-0.35780E+01,-0.35913E+01,-0.36046E+01,-0.36179E+01,
- &-0.36312E+01,-0.36445E+01,-0.36578E+01,-0.36711E+01,-0.36843E+01,
- &-0.36976E+01,-0.37108E+01,-0.37240E+01,-0.37372E+01,-0.37504E+01,
- &-0.37636E+01,-0.37768E+01,-0.37900E+01,-0.38032E+01,-0.38163E+01,
- &-0.38295E+01,-0.38426E+01,-0.38557E+01,-0.38689E+01,-0.38820E+01,
- &-0.38951E+01,-0.39082E+01,-0.39213E+01,-0.39343E+01,-0.39474E+01,
- &-0.39605E+01
- & /
-C
-C *** (H,HSO4)
-C
- DATA (BNC08M(I),I=1,100)/
- &-0.47406E-01,-0.92542E-01,-0.10989E+00,-0.11949E+00,-0.12516E+00,
- &-0.12837E+00,-0.12988E+00,-0.13012E+00,-0.12936E+00,-0.12778E+00,
- &-0.12553E+00,-0.12268E+00,-0.11932E+00,-0.11550E+00,-0.11127E+00,
- &-0.10666E+00,-0.10171E+00,-0.96432E-01,-0.90858E-01,-0.85004E-01,
- &-0.78885E-01,-0.72517E-01,-0.65912E-01,-0.59082E-01,-0.52037E-01,
- &-0.44788E-01,-0.37343E-01,-0.29710E-01,-0.21898E-01,-0.13914E-01,
- &-0.57643E-02, 0.25435E-02, 0.11003E-01, 0.19609E-01, 0.28355E-01,
- & 0.37235E-01, 0.46244E-01, 0.55377E-01, 0.64628E-01, 0.73993E-01,
- & 0.83468E-01, 0.93047E-01, 0.10273E+00, 0.11250E+00, 0.12237E+00,
- & 0.13232E+00, 0.14236E+00, 0.15248E+00, 0.16268E+00, 0.17295E+00,
- & 0.18330E+00, 0.19371E+00, 0.20419E+00, 0.21473E+00, 0.22534E+00,
- & 0.23600E+00, 0.24672E+00, 0.25750E+00, 0.26834E+00, 0.27922E+00,
- & 0.29016E+00, 0.30116E+00, 0.31220E+00, 0.32330E+00, 0.33445E+00,
- & 0.34564E+00, 0.35689E+00, 0.36820E+00, 0.37955E+00, 0.39095E+00,
- & 0.40241E+00, 0.41392E+00, 0.42549E+00, 0.43711E+00, 0.44879E+00,
- & 0.46052E+00, 0.47232E+00, 0.48417E+00, 0.49608E+00, 0.50805E+00,
- & 0.52009E+00, 0.53219E+00, 0.54435E+00, 0.55657E+00, 0.56886E+00,
- & 0.58121E+00, 0.59362E+00, 0.60610E+00, 0.61865E+00, 0.63125E+00,
- & 0.64392E+00, 0.65665E+00, 0.66945E+00, 0.68230E+00, 0.69522E+00,
- & 0.70819E+00, 0.72121E+00, 0.73429E+00, 0.74743E+00, 0.76061E+00/
-
- DATA (BNC08M(I),I=101,200)/
- & 0.77385E+00, 0.78713E+00, 0.80045E+00, 0.81382E+00, 0.82722E+00,
- & 0.84066E+00, 0.85414E+00, 0.86765E+00, 0.88119E+00, 0.89476E+00,
- & 0.90835E+00, 0.92196E+00, 0.93559E+00, 0.94924E+00, 0.96290E+00,
- & 0.97658E+00, 0.99027E+00, 0.10040E+01, 0.10177E+01, 0.10314E+01,
- & 0.10451E+01, 0.10588E+01, 0.10725E+01, 0.10862E+01, 0.10999E+01,
- & 0.11136E+01, 0.11273E+01, 0.11409E+01, 0.11546E+01, 0.11682E+01,
- & 0.11819E+01, 0.11955E+01, 0.12091E+01, 0.12227E+01, 0.12363E+01,
- & 0.12498E+01, 0.12633E+01, 0.12769E+01, 0.12904E+01, 0.13038E+01,
- & 0.13173E+01, 0.13307E+01, 0.13441E+01, 0.13575E+01, 0.13709E+01,
- & 0.13842E+01, 0.13976E+01, 0.14108E+01, 0.14241E+01, 0.14374E+01,
- & 0.14506E+01, 0.14638E+01, 0.14769E+01, 0.14901E+01, 0.15032E+01,
- & 0.15163E+01, 0.15294E+01, 0.15424E+01, 0.15554E+01, 0.15684E+01,
- & 0.15814E+01, 0.15943E+01, 0.16072E+01, 0.16201E+01, 0.16329E+01,
- & 0.16458E+01, 0.16586E+01, 0.16713E+01, 0.16841E+01, 0.16968E+01,
- & 0.17095E+01, 0.17221E+01, 0.17348E+01, 0.17474E+01, 0.17599E+01,
- & 0.17725E+01, 0.17850E+01, 0.17975E+01, 0.18100E+01, 0.18224E+01,
- & 0.18348E+01, 0.18472E+01, 0.18596E+01, 0.18719E+01, 0.18842E+01,
- & 0.18965E+01, 0.19087E+01, 0.19210E+01, 0.19332E+01, 0.19453E+01,
- & 0.19575E+01, 0.19696E+01, 0.19817E+01, 0.19937E+01, 0.20057E+01,
- & 0.20177E+01, 0.20297E+01, 0.20417E+01, 0.20536E+01, 0.20655E+01/
-
- DATA (BNC08M(I),I=201,300)/
- & 0.20773E+01, 0.20892E+01, 0.21010E+01, 0.21128E+01, 0.21245E+01,
- & 0.21363E+01, 0.21480E+01, 0.21597E+01, 0.21713E+01, 0.21829E+01,
- & 0.21945E+01, 0.22061E+01, 0.22177E+01, 0.22292E+01, 0.22407E+01,
- & 0.22521E+01, 0.22636E+01, 0.22750E+01, 0.22864E+01, 0.22978E+01,
- & 0.23091E+01, 0.23204E+01, 0.23317E+01, 0.23430E+01, 0.23542E+01,
- & 0.23654E+01, 0.23766E+01, 0.23878E+01, 0.23989E+01, 0.24100E+01,
- & 0.24211E+01, 0.24322E+01, 0.24432E+01, 0.24542E+01, 0.24652E+01,
- & 0.24762E+01, 0.24871E+01, 0.24980E+01, 0.25089E+01, 0.25198E+01,
- & 0.25306E+01, 0.25414E+01, 0.25522E+01, 0.25630E+01, 0.25737E+01,
- & 0.25845E+01, 0.25952E+01, 0.26058E+01, 0.26165E+01, 0.26271E+01,
- & 0.26377E+01, 0.26483E+01, 0.26589E+01, 0.26694E+01, 0.26799E+01,
- & 0.26904E+01, 0.27009E+01, 0.27113E+01, 0.27217E+01, 0.27321E+01,
- & 0.27425E+01, 0.27528E+01, 0.27632E+01, 0.27735E+01, 0.27838E+01,
- & 0.27940E+01, 0.28043E+01, 0.28145E+01, 0.28247E+01, 0.28348E+01,
- & 0.28450E+01, 0.28551E+01, 0.28652E+01, 0.28753E+01, 0.28854E+01,
- & 0.28954E+01, 0.29055E+01, 0.29155E+01, 0.29254E+01, 0.29354E+01,
- & 0.29453E+01, 0.29552E+01, 0.29651E+01, 0.29750E+01, 0.29849E+01,
- & 0.29947E+01, 0.30045E+01, 0.30143E+01, 0.30241E+01, 0.30338E+01,
- & 0.30436E+01, 0.30533E+01, 0.30630E+01, 0.30726E+01, 0.30823E+01,
- & 0.30919E+01, 0.31015E+01, 0.31111E+01, 0.31207E+01, 0.31302E+01/
-
- DATA (BNC08M(I),I=301,400)/
- & 0.31398E+01, 0.31493E+01, 0.31588E+01, 0.31682E+01, 0.31777E+01,
- & 0.31871E+01, 0.31966E+01, 0.32059E+01, 0.32153E+01, 0.32247E+01,
- & 0.32340E+01, 0.32433E+01, 0.32526E+01, 0.32619E+01, 0.32712E+01,
- & 0.32804E+01, 0.32897E+01, 0.32989E+01, 0.33081E+01, 0.33172E+01,
- & 0.33264E+01, 0.33355E+01, 0.33446E+01, 0.33537E+01, 0.33628E+01,
- & 0.33719E+01, 0.33809E+01, 0.33899E+01, 0.33989E+01, 0.34079E+01,
- & 0.34169E+01, 0.34259E+01, 0.34348E+01, 0.34437E+01, 0.34526E+01,
- & 0.34615E+01, 0.34704E+01, 0.34792E+01, 0.34881E+01, 0.34969E+01,
- & 0.35057E+01, 0.35145E+01, 0.35232E+01, 0.35320E+01, 0.35407E+01,
- & 0.35494E+01, 0.35581E+01, 0.35668E+01, 0.35755E+01, 0.35841E+01,
- & 0.35928E+01, 0.36014E+01, 0.36100E+01, 0.36186E+01, 0.36271E+01,
- & 0.36357E+01, 0.36442E+01, 0.36527E+01, 0.36612E+01, 0.36697E+01,
- & 0.36782E+01, 0.36866E+01, 0.36951E+01, 0.37035E+01, 0.37119E+01,
- & 0.37203E+01, 0.37287E+01, 0.37370E+01, 0.37454E+01, 0.37537E+01,
- & 0.37620E+01, 0.37703E+01, 0.37786E+01, 0.37869E+01, 0.37951E+01,
- & 0.38034E+01, 0.38116E+01, 0.38198E+01, 0.38280E+01, 0.38362E+01,
- & 0.38443E+01, 0.38525E+01, 0.38606E+01, 0.38687E+01, 0.38768E+01,
- & 0.38849E+01, 0.38930E+01, 0.39011E+01, 0.39091E+01, 0.39171E+01,
- & 0.39252E+01, 0.39332E+01, 0.39411E+01, 0.39491E+01, 0.39571E+01,
- & 0.39650E+01, 0.39730E+01, 0.39809E+01, 0.39888E+01, 0.39967E+01/
-
- DATA (BNC08M(I),I=401,500)/
- & 0.40045E+01, 0.40124E+01, 0.40202E+01, 0.40281E+01, 0.40359E+01,
- & 0.40437E+01, 0.40515E+01, 0.40593E+01, 0.40670E+01, 0.40748E+01,
- & 0.40825E+01, 0.40903E+01, 0.40980E+01, 0.41057E+01, 0.41133E+01,
- & 0.41210E+01, 0.41287E+01, 0.41363E+01, 0.41440E+01, 0.41516E+01,
- & 0.41592E+01, 0.41668E+01, 0.41743E+01, 0.41819E+01, 0.41895E+01,
- & 0.41970E+01, 0.42045E+01, 0.42120E+01, 0.42195E+01, 0.42270E+01,
- & 0.42345E+01, 0.42420E+01, 0.42494E+01, 0.42569E+01, 0.42643E+01,
- & 0.42717E+01, 0.42791E+01, 0.42865E+01, 0.42939E+01, 0.43012E+01,
- & 0.43086E+01, 0.43159E+01, 0.43232E+01, 0.43306E+01, 0.43379E+01,
- & 0.43452E+01, 0.43524E+01, 0.43597E+01, 0.43670E+01, 0.43742E+01,
- & 0.43814E+01, 0.43886E+01, 0.43959E+01, 0.44030E+01, 0.44102E+01,
- & 0.44174E+01, 0.44246E+01, 0.44317E+01, 0.44388E+01, 0.44460E+01,
- & 0.44531E+01, 0.44602E+01, 0.44673E+01, 0.44743E+01, 0.44814E+01,
- & 0.44885E+01, 0.44955E+01, 0.45025E+01, 0.45096E+01, 0.45166E+01,
- & 0.45236E+01, 0.45306E+01, 0.45375E+01, 0.45445E+01, 0.45515E+01,
- & 0.45584E+01, 0.45653E+01, 0.45723E+01, 0.45792E+01, 0.45861E+01,
- & 0.45930E+01, 0.45998E+01, 0.46067E+01, 0.46135E+01, 0.46204E+01,
- & 0.46272E+01, 0.46341E+01, 0.46409E+01, 0.46477E+01, 0.46545E+01,
- & 0.46612E+01, 0.46680E+01, 0.46748E+01, 0.46815E+01, 0.46883E+01,
- & 0.46950E+01, 0.47017E+01, 0.47084E+01, 0.47151E+01, 0.47218E+01/
-
- DATA (BNC08M(I),I=501,600)/
- & 0.47285E+01, 0.47351E+01, 0.47418E+01, 0.47484E+01, 0.47551E+01,
- & 0.47617E+01, 0.47683E+01, 0.47749E+01, 0.47815E+01, 0.47881E+01,
- & 0.47947E+01, 0.48012E+01, 0.48078E+01, 0.48143E+01, 0.48209E+01,
- & 0.48274E+01, 0.48339E+01, 0.48404E+01, 0.48469E+01, 0.48534E+01,
- & 0.48598E+01, 0.48663E+01, 0.48728E+01, 0.48792E+01, 0.48857E+01,
- & 0.48921E+01, 0.48985E+01, 0.49049E+01, 0.49113E+01, 0.49177E+01,
- & 0.49241E+01, 0.49304E+01, 0.49368E+01, 0.49431E+01, 0.49495E+01,
- & 0.49558E+01, 0.49621E+01, 0.49685E+01, 0.49748E+01, 0.49811E+01,
- & 0.49873E+01, 0.49936E+01, 0.49999E+01, 0.50061E+01, 0.50124E+01,
- & 0.50186E+01, 0.50249E+01, 0.50311E+01, 0.50373E+01, 0.50435E+01,
- & 0.50497E+01, 0.50559E+01, 0.50621E+01, 0.50682E+01, 0.50744E+01,
- & 0.50805E+01, 0.50867E+01, 0.50928E+01, 0.50989E+01, 0.51050E+01,
- & 0.51111E+01, 0.51172E+01, 0.51233E+01, 0.51294E+01, 0.51355E+01,
- & 0.51415E+01, 0.51476E+01, 0.51536E+01, 0.51597E+01, 0.51657E+01,
- & 0.51717E+01, 0.51777E+01, 0.51837E+01, 0.51897E+01, 0.51957E+01,
- & 0.52017E+01, 0.52076E+01, 0.52136E+01, 0.52196E+01, 0.52255E+01,
- & 0.52314E+01, 0.52374E+01, 0.52433E+01, 0.52492E+01, 0.52551E+01,
- & 0.52610E+01, 0.52669E+01, 0.52727E+01, 0.52786E+01, 0.52845E+01,
- & 0.52903E+01, 0.52962E+01, 0.53020E+01, 0.53078E+01, 0.53137E+01,
- & 0.53195E+01, 0.53253E+01, 0.53311E+01, 0.53369E+01, 0.53426E+01/
-
- DATA (BNC08M(I),I=601,700)/
- & 0.54046E+01, 0.54611E+01, 0.55169E+01, 0.55719E+01, 0.56263E+01,
- & 0.56799E+01, 0.57328E+01, 0.57851E+01, 0.58367E+01, 0.58877E+01,
- & 0.59380E+01, 0.59878E+01, 0.60369E+01, 0.60855E+01, 0.61334E+01,
- & 0.61809E+01, 0.62277E+01, 0.62740E+01, 0.63198E+01, 0.63651E+01,
- & 0.64099E+01, 0.64542E+01, 0.64979E+01, 0.65413E+01, 0.65841E+01,
- & 0.66265E+01, 0.66684E+01, 0.67099E+01, 0.67509E+01, 0.67916E+01,
- & 0.68318E+01, 0.68715E+01, 0.69109E+01, 0.69499E+01, 0.69885E+01,
- & 0.70267E+01, 0.70646E+01, 0.71020E+01, 0.71391E+01, 0.71759E+01,
- & 0.72123E+01, 0.72483E+01, 0.72840E+01, 0.73194E+01, 0.73544E+01,
- & 0.73891E+01, 0.74235E+01, 0.74576E+01, 0.74914E+01, 0.75248E+01,
- & 0.75580E+01, 0.75909E+01, 0.76234E+01, 0.76557E+01, 0.76877E+01,
- & 0.77195E+01, 0.77509E+01, 0.77821E+01, 0.78130E+01, 0.78437E+01,
- & 0.78741E+01, 0.79042E+01, 0.79341E+01, 0.79637E+01, 0.79931E+01,
- & 0.80223E+01, 0.80512E+01, 0.80799E+01, 0.81083E+01, 0.81365E+01,
- & 0.81645E+01, 0.81923E+01, 0.82199E+01, 0.82472E+01, 0.82743E+01,
- & 0.83012E+01, 0.83279E+01, 0.83544E+01, 0.83807E+01, 0.84068E+01,
- & 0.84327E+01, 0.84584E+01, 0.84839E+01, 0.85093E+01, 0.85344E+01,
- & 0.85593E+01, 0.85841E+01, 0.86087E+01, 0.86331E+01, 0.86573E+01,
- & 0.86813E+01, 0.87052E+01, 0.87289E+01, 0.87524E+01, 0.87758E+01,
- & 0.87990E+01, 0.88220E+01, 0.88449E+01, 0.88676E+01, 0.88902E+01/
-
- DATA (BNC08M(I),I=701,741)/
- & 0.89126E+01, 0.89348E+01, 0.89569E+01, 0.89789E+01, 0.90006E+01,
- & 0.90223E+01, 0.90438E+01, 0.90651E+01, 0.90863E+01, 0.91074E+01,
- & 0.91283E+01, 0.91491E+01, 0.91698E+01, 0.91903E+01, 0.92107E+01,
- & 0.92309E+01, 0.92510E+01, 0.92710E+01, 0.92909E+01, 0.93106E+01,
- & 0.93302E+01, 0.93497E+01, 0.93690E+01, 0.93883E+01, 0.94074E+01,
- & 0.94264E+01, 0.94452E+01, 0.94640E+01, 0.94826E+01, 0.95011E+01,
- & 0.95195E+01, 0.95378E+01, 0.95560E+01, 0.95741E+01, 0.95920E+01,
- & 0.96099E+01, 0.96276E+01, 0.96452E+01, 0.96628E+01, 0.96802E+01,
- & 0.96975E+01
- & /
-C
-C *** NH4HSO4
-C
- DATA (BNC09M(I),I=1,100)/
- &-0.50187E-01,-0.10669E+00,-0.13390E+00,-0.15267E+00,-0.16708E+00,
- &-0.17876E+00,-0.18855E+00,-0.19694E+00,-0.20423E+00,-0.21065E+00,
- &-0.21635E+00,-0.22143E+00,-0.22598E+00,-0.23007E+00,-0.23375E+00,
- &-0.23707E+00,-0.24005E+00,-0.24274E+00,-0.24514E+00,-0.24730E+00,
- &-0.24921E+00,-0.25090E+00,-0.25238E+00,-0.25366E+00,-0.25476E+00,
- &-0.25568E+00,-0.25644E+00,-0.25703E+00,-0.25747E+00,-0.25776E+00,
- &-0.25791E+00,-0.25793E+00,-0.25781E+00,-0.25758E+00,-0.25722E+00,
- &-0.25674E+00,-0.25615E+00,-0.25546E+00,-0.25466E+00,-0.25376E+00,
- &-0.25276E+00,-0.25167E+00,-0.25049E+00,-0.24922E+00,-0.24787E+00,
- &-0.24644E+00,-0.24492E+00,-0.24333E+00,-0.24167E+00,-0.23994E+00,
- &-0.23813E+00,-0.23626E+00,-0.23433E+00,-0.23233E+00,-0.23027E+00,
- &-0.22816E+00,-0.22599E+00,-0.22376E+00,-0.22148E+00,-0.21915E+00,
- &-0.21677E+00,-0.21434E+00,-0.21186E+00,-0.20934E+00,-0.20677E+00,
- &-0.20415E+00,-0.20150E+00,-0.19880E+00,-0.19606E+00,-0.19328E+00,
- &-0.19046E+00,-0.18760E+00,-0.18470E+00,-0.18176E+00,-0.17878E+00,
- &-0.17577E+00,-0.17272E+00,-0.16963E+00,-0.16651E+00,-0.16334E+00,
- &-0.16015E+00,-0.15692E+00,-0.15365E+00,-0.15035E+00,-0.14701E+00,
- &-0.14364E+00,-0.14024E+00,-0.13681E+00,-0.13334E+00,-0.12984E+00,
- &-0.12631E+00,-0.12274E+00,-0.11915E+00,-0.11553E+00,-0.11188E+00,
- &-0.10820E+00,-0.10450E+00,-0.10077E+00,-0.97011E-01,-0.93232E-01/
-
- DATA (BNC09M(I),I=101,200)/
- &-0.89429E-01,-0.85605E-01,-0.81759E-01,-0.77893E-01,-0.74009E-01,
- &-0.70107E-01,-0.66188E-01,-0.62254E-01,-0.58306E-01,-0.54343E-01,
- &-0.50369E-01,-0.46384E-01,-0.42388E-01,-0.38383E-01,-0.34370E-01,
- &-0.30350E-01,-0.26323E-01,-0.22291E-01,-0.18255E-01,-0.14216E-01,
- &-0.10173E-01,-0.61287E-02,-0.20831E-02, 0.19630E-02, 0.60090E-02,
- & 0.10054E-01, 0.14098E-01, 0.18140E-01, 0.22179E-01, 0.26215E-01,
- & 0.30247E-01, 0.34276E-01, 0.38300E-01, 0.42319E-01, 0.46333E-01,
- & 0.50341E-01, 0.54344E-01, 0.58340E-01, 0.62330E-01, 0.66313E-01,
- & 0.70289E-01, 0.74258E-01, 0.78219E-01, 0.82173E-01, 0.86120E-01,
- & 0.90058E-01, 0.93988E-01, 0.97910E-01, 0.10182E+00, 0.10573E+00,
- & 0.10962E+00, 0.11351E+00, 0.11739E+00, 0.12126E+00, 0.12512E+00,
- & 0.12897E+00, 0.13282E+00, 0.13665E+00, 0.14048E+00, 0.14429E+00,
- & 0.14810E+00, 0.15189E+00, 0.15568E+00, 0.15946E+00, 0.16323E+00,
- & 0.16698E+00, 0.17073E+00, 0.17447E+00, 0.17820E+00, 0.18192E+00,
- & 0.18563E+00, 0.18934E+00, 0.19303E+00, 0.19671E+00, 0.20038E+00,
- & 0.20404E+00, 0.20770E+00, 0.21134E+00, 0.21497E+00, 0.21860E+00,
- & 0.22221E+00, 0.22582E+00, 0.22941E+00, 0.23300E+00, 0.23658E+00,
- & 0.24014E+00, 0.24370E+00, 0.24725E+00, 0.25078E+00, 0.25431E+00,
- & 0.25783E+00, 0.26134E+00, 0.26484E+00, 0.26833E+00, 0.27181E+00,
- & 0.27528E+00, 0.27875E+00, 0.28220E+00, 0.28564E+00, 0.28908E+00/
-
- DATA (BNC09M(I),I=201,300)/
- & 0.29250E+00, 0.29592E+00, 0.29932E+00, 0.30272E+00, 0.30611E+00,
- & 0.30949E+00, 0.31286E+00, 0.31622E+00, 0.31957E+00, 0.32291E+00,
- & 0.32625E+00, 0.32957E+00, 0.33289E+00, 0.33620E+00, 0.33949E+00,
- & 0.34278E+00, 0.34606E+00, 0.34934E+00, 0.35260E+00, 0.35585E+00,
- & 0.35910E+00, 0.36234E+00, 0.36557E+00, 0.36879E+00, 0.37200E+00,
- & 0.37520E+00, 0.37839E+00, 0.38158E+00, 0.38476E+00, 0.38793E+00,
- & 0.39109E+00, 0.39424E+00, 0.39738E+00, 0.40052E+00, 0.40365E+00,
- & 0.40677E+00, 0.40988E+00, 0.41298E+00, 0.41608E+00, 0.41916E+00,
- & 0.42224E+00, 0.42531E+00, 0.42838E+00, 0.43143E+00, 0.43448E+00,
- & 0.43752E+00, 0.44055E+00, 0.44357E+00, 0.44659E+00, 0.44960E+00,
- & 0.45260E+00, 0.45559E+00, 0.45857E+00, 0.46155E+00, 0.46452E+00,
- & 0.46748E+00, 0.47044E+00, 0.47339E+00, 0.47633E+00, 0.47926E+00,
- & 0.48218E+00, 0.48510E+00, 0.48801E+00, 0.49092E+00, 0.49381E+00,
- & 0.49670E+00, 0.49958E+00, 0.50246E+00, 0.50532E+00, 0.50818E+00,
- & 0.51104E+00, 0.51388E+00, 0.51672E+00, 0.51955E+00, 0.52238E+00,
- & 0.52519E+00, 0.52800E+00, 0.53081E+00, 0.53361E+00, 0.53640E+00,
- & 0.53918E+00, 0.54196E+00, 0.54473E+00, 0.54749E+00, 0.55025E+00,
- & 0.55300E+00, 0.55574E+00, 0.55848E+00, 0.56121E+00, 0.56393E+00,
- & 0.56665E+00, 0.56936E+00, 0.57206E+00, 0.57476E+00, 0.57745E+00,
- & 0.58013E+00, 0.58281E+00, 0.58548E+00, 0.58815E+00, 0.59081E+00/
-
- DATA (BNC09M(I),I=301,400)/
- & 0.59346E+00, 0.59611E+00, 0.59875E+00, 0.60138E+00, 0.60401E+00,
- & 0.60663E+00, 0.60925E+00, 0.61186E+00, 0.61446E+00, 0.61706E+00,
- & 0.61965E+00, 0.62223E+00, 0.62481E+00, 0.62739E+00, 0.62996E+00,
- & 0.63252E+00, 0.63507E+00, 0.63762E+00, 0.64017E+00, 0.64270E+00,
- & 0.64524E+00, 0.64776E+00, 0.65028E+00, 0.65280E+00, 0.65531E+00,
- & 0.65781E+00, 0.66031E+00, 0.66280E+00, 0.66529E+00, 0.66777E+00,
- & 0.67024E+00, 0.67271E+00, 0.67518E+00, 0.67764E+00, 0.68009E+00,
- & 0.68254E+00, 0.68498E+00, 0.68742E+00, 0.68985E+00, 0.69227E+00,
- & 0.69470E+00, 0.69711E+00, 0.69952E+00, 0.70192E+00, 0.70432E+00,
- & 0.70672E+00, 0.70911E+00, 0.71149E+00, 0.71387E+00, 0.71624E+00,
- & 0.71861E+00, 0.72097E+00, 0.72333E+00, 0.72568E+00, 0.72803E+00,
- & 0.73037E+00, 0.73271E+00, 0.73504E+00, 0.73737E+00, 0.73969E+00,
- & 0.74201E+00, 0.74432E+00, 0.74662E+00, 0.74893E+00, 0.75122E+00,
- & 0.75352E+00, 0.75580E+00, 0.75809E+00, 0.76036E+00, 0.76263E+00,
- & 0.76490E+00, 0.76717E+00, 0.76942E+00, 0.77168E+00, 0.77393E+00,
- & 0.77617E+00, 0.77841E+00, 0.78064E+00, 0.78287E+00, 0.78510E+00,
- & 0.78732E+00, 0.78953E+00, 0.79174E+00, 0.79395E+00, 0.79615E+00,
- & 0.79835E+00, 0.80054E+00, 0.80273E+00, 0.80491E+00, 0.80709E+00,
- & 0.80927E+00, 0.81144E+00, 0.81360E+00, 0.81576E+00, 0.81792E+00,
- & 0.82007E+00, 0.82222E+00, 0.82436E+00, 0.82650E+00, 0.82864E+00/
-
- DATA (BNC09M(I),I=401,500)/
- & 0.83077E+00, 0.83289E+00, 0.83501E+00, 0.83713E+00, 0.83924E+00,
- & 0.84135E+00, 0.84346E+00, 0.84556E+00, 0.84765E+00, 0.84974E+00,
- & 0.85183E+00, 0.85391E+00, 0.85599E+00, 0.85807E+00, 0.86014E+00,
- & 0.86220E+00, 0.86427E+00, 0.86632E+00, 0.86838E+00, 0.87043E+00,
- & 0.87247E+00, 0.87451E+00, 0.87655E+00, 0.87859E+00, 0.88061E+00,
- & 0.88264E+00, 0.88466E+00, 0.88668E+00, 0.88869E+00, 0.89070E+00,
- & 0.89271E+00, 0.89471E+00, 0.89671E+00, 0.89870E+00, 0.90069E+00,
- & 0.90268E+00, 0.90466E+00, 0.90664E+00, 0.90861E+00, 0.91058E+00,
- & 0.91255E+00, 0.91451E+00, 0.91647E+00, 0.91842E+00, 0.92037E+00,
- & 0.92232E+00, 0.92426E+00, 0.92620E+00, 0.92814E+00, 0.93007E+00,
- & 0.93200E+00, 0.93393E+00, 0.93585E+00, 0.93777E+00, 0.93968E+00,
- & 0.94159E+00, 0.94350E+00, 0.94540E+00, 0.94730E+00, 0.94919E+00,
- & 0.95108E+00, 0.95297E+00, 0.95486E+00, 0.95674E+00, 0.95862E+00,
- & 0.96049E+00, 0.96236E+00, 0.96423E+00, 0.96609E+00, 0.96795E+00,
- & 0.96981E+00, 0.97166E+00, 0.97351E+00, 0.97536E+00, 0.97720E+00,
- & 0.97904E+00, 0.98087E+00, 0.98270E+00, 0.98453E+00, 0.98636E+00,
- & 0.98818E+00, 0.99000E+00, 0.99181E+00, 0.99362E+00, 0.99543E+00,
- & 0.99724E+00, 0.99904E+00, 0.10008E+01, 0.10026E+01, 0.10044E+01,
- & 0.10062E+01, 0.10080E+01, 0.10098E+01, 0.10116E+01, 0.10133E+01,
- & 0.10151E+01, 0.10169E+01, 0.10186E+01, 0.10204E+01, 0.10222E+01/
-
- DATA (BNC09M(I),I=501,600)/
- & 0.10239E+01, 0.10257E+01, 0.10274E+01, 0.10292E+01, 0.10309E+01,
- & 0.10326E+01, 0.10344E+01, 0.10361E+01, 0.10378E+01, 0.10396E+01,
- & 0.10413E+01, 0.10430E+01, 0.10447E+01, 0.10464E+01, 0.10482E+01,
- & 0.10499E+01, 0.10516E+01, 0.10533E+01, 0.10550E+01, 0.10567E+01,
- & 0.10584E+01, 0.10600E+01, 0.10617E+01, 0.10634E+01, 0.10651E+01,
- & 0.10668E+01, 0.10684E+01, 0.10701E+01, 0.10718E+01, 0.10735E+01,
- & 0.10751E+01, 0.10768E+01, 0.10784E+01, 0.10801E+01, 0.10817E+01,
- & 0.10834E+01, 0.10850E+01, 0.10867E+01, 0.10883E+01, 0.10899E+01,
- & 0.10916E+01, 0.10932E+01, 0.10948E+01, 0.10965E+01, 0.10981E+01,
- & 0.10997E+01, 0.11013E+01, 0.11029E+01, 0.11045E+01, 0.11062E+01,
- & 0.11078E+01, 0.11094E+01, 0.11110E+01, 0.11126E+01, 0.11142E+01,
- & 0.11157E+01, 0.11173E+01, 0.11189E+01, 0.11205E+01, 0.11221E+01,
- & 0.11237E+01, 0.11252E+01, 0.11268E+01, 0.11284E+01, 0.11299E+01,
- & 0.11315E+01, 0.11331E+01, 0.11346E+01, 0.11362E+01, 0.11377E+01,
- & 0.11393E+01, 0.11408E+01, 0.11424E+01, 0.11439E+01, 0.11454E+01,
- & 0.11470E+01, 0.11485E+01, 0.11501E+01, 0.11516E+01, 0.11531E+01,
- & 0.11546E+01, 0.11562E+01, 0.11577E+01, 0.11592E+01, 0.11607E+01,
- & 0.11622E+01, 0.11637E+01, 0.11652E+01, 0.11667E+01, 0.11682E+01,
- & 0.11697E+01, 0.11712E+01, 0.11727E+01, 0.11742E+01, 0.11757E+01,
- & 0.11772E+01, 0.11787E+01, 0.11801E+01, 0.11816E+01, 0.11831E+01/
-
- DATA (BNC09M(I),I=601,700)/
- & 0.11989E+01, 0.12132E+01, 0.12273E+01, 0.12412E+01, 0.12549E+01,
- & 0.12683E+01, 0.12816E+01, 0.12946E+01, 0.13074E+01, 0.13200E+01,
- & 0.13324E+01, 0.13446E+01, 0.13566E+01, 0.13685E+01, 0.13801E+01,
- & 0.13916E+01, 0.14029E+01, 0.14141E+01, 0.14250E+01, 0.14358E+01,
- & 0.14465E+01, 0.14570E+01, 0.14673E+01, 0.14775E+01, 0.14875E+01,
- & 0.14974E+01, 0.15072E+01, 0.15168E+01, 0.15262E+01, 0.15356E+01,
- & 0.15448E+01, 0.15538E+01, 0.15628E+01, 0.15716E+01, 0.15803E+01,
- & 0.15888E+01, 0.15973E+01, 0.16056E+01, 0.16138E+01, 0.16219E+01,
- & 0.16299E+01, 0.16378E+01, 0.16455E+01, 0.16532E+01, 0.16608E+01,
- & 0.16682E+01, 0.16756E+01, 0.16828E+01, 0.16900E+01, 0.16970E+01,
- & 0.17040E+01, 0.17108E+01, 0.17176E+01, 0.17243E+01, 0.17308E+01,
- & 0.17373E+01, 0.17438E+01, 0.17501E+01, 0.17563E+01, 0.17625E+01,
- & 0.17685E+01, 0.17745E+01, 0.17804E+01, 0.17863E+01, 0.17920E+01,
- & 0.17977E+01, 0.18033E+01, 0.18088E+01, 0.18142E+01, 0.18196E+01,
- & 0.18249E+01, 0.18302E+01, 0.18353E+01, 0.18404E+01, 0.18454E+01,
- & 0.18504E+01, 0.18553E+01, 0.18601E+01, 0.18649E+01, 0.18695E+01,
- & 0.18742E+01, 0.18787E+01, 0.18832E+01, 0.18877E+01, 0.18921E+01,
- & 0.18964E+01, 0.19007E+01, 0.19049E+01, 0.19090E+01, 0.19131E+01,
- & 0.19171E+01, 0.19211E+01, 0.19250E+01, 0.19289E+01, 0.19327E+01,
- & 0.19365E+01, 0.19402E+01, 0.19439E+01, 0.19475E+01, 0.19510E+01/
-
- DATA (BNC09M(I),I=701,741)/
- & 0.19545E+01, 0.19580E+01, 0.19614E+01, 0.19647E+01, 0.19681E+01,
- & 0.19713E+01, 0.19745E+01, 0.19777E+01, 0.19808E+01, 0.19839E+01,
- & 0.19869E+01, 0.19899E+01, 0.19929E+01, 0.19958E+01, 0.19986E+01,
- & 0.20014E+01, 0.20042E+01, 0.20069E+01, 0.20096E+01, 0.20123E+01,
- & 0.20149E+01, 0.20175E+01, 0.20200E+01, 0.20225E+01, 0.20249E+01,
- & 0.20273E+01, 0.20297E+01, 0.20320E+01, 0.20343E+01, 0.20366E+01,
- & 0.20388E+01, 0.20410E+01, 0.20432E+01, 0.20453E+01, 0.20473E+01,
- & 0.20494E+01, 0.20514E+01, 0.20534E+01, 0.20553E+01, 0.20572E+01,
- & 0.20591E+01
- & /
-C
-C *** (H,NO3)
-C
- DATA (BNC10M(I),I=1,100)/
- &-0.49409E-01,-0.10182E+00,-0.12490E+00,-0.13957E+00,-0.14992E+00,
- &-0.15759E+00,-0.16343E+00,-0.16794E+00,-0.17141E+00,-0.17407E+00,
- &-0.17608E+00,-0.17754E+00,-0.17855E+00,-0.17917E+00,-0.17946E+00,
- &-0.17946E+00,-0.17921E+00,-0.17873E+00,-0.17806E+00,-0.17722E+00,
- &-0.17621E+00,-0.17507E+00,-0.17380E+00,-0.17242E+00,-0.17094E+00,
- &-0.16937E+00,-0.16771E+00,-0.16598E+00,-0.16418E+00,-0.16232E+00,
- &-0.16041E+00,-0.15845E+00,-0.15644E+00,-0.15439E+00,-0.15230E+00,
- &-0.15019E+00,-0.14804E+00,-0.14587E+00,-0.14368E+00,-0.14146E+00,
- &-0.13923E+00,-0.13699E+00,-0.13473E+00,-0.13245E+00,-0.13017E+00,
- &-0.12788E+00,-0.12559E+00,-0.12329E+00,-0.12098E+00,-0.11867E+00,
- &-0.11635E+00,-0.11404E+00,-0.11172E+00,-0.10939E+00,-0.10707E+00,
- &-0.10475E+00,-0.10242E+00,-0.10009E+00,-0.97766E-01,-0.95435E-01,
- &-0.93102E-01,-0.90766E-01,-0.88427E-01,-0.86084E-01,-0.83737E-01,
- &-0.81385E-01,-0.79027E-01,-0.76663E-01,-0.74291E-01,-0.71912E-01,
- &-0.69524E-01,-0.67126E-01,-0.64718E-01,-0.62299E-01,-0.59868E-01,
- &-0.57424E-01,-0.54967E-01,-0.52495E-01,-0.50009E-01,-0.47506E-01,
- &-0.44988E-01,-0.42453E-01,-0.39901E-01,-0.37331E-01,-0.34744E-01,
- &-0.32138E-01,-0.29513E-01,-0.26869E-01,-0.24207E-01,-0.21526E-01,
- &-0.18825E-01,-0.16106E-01,-0.13368E-01,-0.10611E-01,-0.78361E-02,
- &-0.50430E-02,-0.22323E-02, 0.59576E-03, 0.34406E-02, 0.63019E-02/
-
- DATA (BNC10M(I),I=101,200)/
- & 0.91788E-02, 0.12071E-01, 0.14978E-01, 0.17899E-01, 0.20833E-01,
- & 0.23781E-01, 0.26740E-01, 0.29711E-01, 0.32692E-01, 0.35683E-01,
- & 0.38684E-01, 0.41694E-01, 0.44711E-01, 0.47736E-01, 0.50768E-01,
- & 0.53805E-01, 0.56848E-01, 0.59896E-01, 0.62949E-01, 0.66005E-01,
- & 0.69064E-01, 0.72126E-01, 0.75190E-01, 0.78257E-01, 0.81324E-01,
- & 0.84392E-01, 0.87461E-01, 0.90530E-01, 0.93599E-01, 0.96668E-01,
- & 0.99735E-01, 0.10280E+00, 0.10587E+00, 0.10893E+00, 0.11199E+00,
- & 0.11505E+00, 0.11811E+00, 0.12117E+00, 0.12422E+00, 0.12727E+00,
- & 0.13031E+00, 0.13336E+00, 0.13640E+00, 0.13944E+00, 0.14247E+00,
- & 0.14550E+00, 0.14853E+00, 0.15155E+00, 0.15457E+00, 0.15759E+00,
- & 0.16060E+00, 0.16361E+00, 0.16662E+00, 0.16962E+00, 0.17262E+00,
- & 0.17561E+00, 0.17860E+00, 0.18158E+00, 0.18456E+00, 0.18754E+00,
- & 0.19051E+00, 0.19348E+00, 0.19644E+00, 0.19940E+00, 0.20235E+00,
- & 0.20530E+00, 0.20825E+00, 0.21119E+00, 0.21413E+00, 0.21706E+00,
- & 0.21998E+00, 0.22291E+00, 0.22583E+00, 0.22874E+00, 0.23165E+00,
- & 0.23455E+00, 0.23745E+00, 0.24035E+00, 0.24324E+00, 0.24612E+00,
- & 0.24900E+00, 0.25188E+00, 0.25475E+00, 0.25762E+00, 0.26048E+00,
- & 0.26334E+00, 0.26619E+00, 0.26903E+00, 0.27188E+00, 0.27471E+00,
- & 0.27755E+00, 0.28037E+00, 0.28320E+00, 0.28602E+00, 0.28883E+00,
- & 0.29164E+00, 0.29444E+00, 0.29724E+00, 0.30003E+00, 0.30282E+00/
-
- DATA (BNC10M(I),I=201,300)/
- & 0.30560E+00, 0.30838E+00, 0.31116E+00, 0.31393E+00, 0.31669E+00,
- & 0.31945E+00, 0.32220E+00, 0.32495E+00, 0.32769E+00, 0.33043E+00,
- & 0.33317E+00, 0.33590E+00, 0.33862E+00, 0.34134E+00, 0.34405E+00,
- & 0.34676E+00, 0.34947E+00, 0.35217E+00, 0.35486E+00, 0.35755E+00,
- & 0.36024E+00, 0.36291E+00, 0.36559E+00, 0.36826E+00, 0.37092E+00,
- & 0.37358E+00, 0.37624E+00, 0.37889E+00, 0.38153E+00, 0.38417E+00,
- & 0.38681E+00, 0.38944E+00, 0.39206E+00, 0.39468E+00, 0.39730E+00,
- & 0.39991E+00, 0.40251E+00, 0.40511E+00, 0.40771E+00, 0.41030E+00,
- & 0.41288E+00, 0.41546E+00, 0.41804E+00, 0.42061E+00, 0.42317E+00,
- & 0.42574E+00, 0.42829E+00, 0.43084E+00, 0.43339E+00, 0.43593E+00,
- & 0.43847E+00, 0.44100E+00, 0.44353E+00, 0.44605E+00, 0.44856E+00,
- & 0.45108E+00, 0.45358E+00, 0.45609E+00, 0.45858E+00, 0.46108E+00,
- & 0.46357E+00, 0.46605E+00, 0.46853E+00, 0.47100E+00, 0.47347E+00,
- & 0.47594E+00, 0.47840E+00, 0.48085E+00, 0.48330E+00, 0.48575E+00,
- & 0.48819E+00, 0.49062E+00, 0.49305E+00, 0.49548E+00, 0.49790E+00,
- & 0.50032E+00, 0.50273E+00, 0.50514E+00, 0.50754E+00, 0.50994E+00,
- & 0.51233E+00, 0.51472E+00, 0.51711E+00, 0.51949E+00, 0.52186E+00,
- & 0.52423E+00, 0.52660E+00, 0.52896E+00, 0.53132E+00, 0.53367E+00,
- & 0.53602E+00, 0.53836E+00, 0.54070E+00, 0.54303E+00, 0.54536E+00,
- & 0.54769E+00, 0.55001E+00, 0.55232E+00, 0.55464E+00, 0.55694E+00/
-
- DATA (BNC10M(I),I=301,400)/
- & 0.55925E+00, 0.56154E+00, 0.56384E+00, 0.56613E+00, 0.56841E+00,
- & 0.57069E+00, 0.57297E+00, 0.57524E+00, 0.57751E+00, 0.57977E+00,
- & 0.58203E+00, 0.58428E+00, 0.58653E+00, 0.58878E+00, 0.59102E+00,
- & 0.59325E+00, 0.59549E+00, 0.59771E+00, 0.59994E+00, 0.60216E+00,
- & 0.60437E+00, 0.60658E+00, 0.60879E+00, 0.61099E+00, 0.61319E+00,
- & 0.61538E+00, 0.61757E+00, 0.61976E+00, 0.62194E+00, 0.62411E+00,
- & 0.62629E+00, 0.62845E+00, 0.63062E+00, 0.63278E+00, 0.63493E+00,
- & 0.63709E+00, 0.63923E+00, 0.64138E+00, 0.64351E+00, 0.64565E+00,
- & 0.64778E+00, 0.64991E+00, 0.65203E+00, 0.65415E+00, 0.65626E+00,
- & 0.65837E+00, 0.66048E+00, 0.66258E+00, 0.66468E+00, 0.66678E+00,
- & 0.66887E+00, 0.67095E+00, 0.67304E+00, 0.67511E+00, 0.67719E+00,
- & 0.67926E+00, 0.68132E+00, 0.68339E+00, 0.68545E+00, 0.68750E+00,
- & 0.68955E+00, 0.69160E+00, 0.69364E+00, 0.69568E+00, 0.69771E+00,
- & 0.69975E+00, 0.70177E+00, 0.70380E+00, 0.70582E+00, 0.70783E+00,
- & 0.70984E+00, 0.71185E+00, 0.71386E+00, 0.71586E+00, 0.71785E+00,
- & 0.71985E+00, 0.72184E+00, 0.72382E+00, 0.72580E+00, 0.72778E+00,
- & 0.72975E+00, 0.73172E+00, 0.73369E+00, 0.73565E+00, 0.73761E+00,
- & 0.73957E+00, 0.74152E+00, 0.74347E+00, 0.74541E+00, 0.74735E+00,
- & 0.74929E+00, 0.75122E+00, 0.75315E+00, 0.75508E+00, 0.75700E+00,
- & 0.75892E+00, 0.76084E+00, 0.76275E+00, 0.76466E+00, 0.76656E+00/
-
- DATA (BNC10M(I),I=401,500)/
- & 0.76846E+00, 0.77036E+00, 0.77225E+00, 0.77414E+00, 0.77603E+00,
- & 0.77791E+00, 0.77979E+00, 0.78167E+00, 0.78354E+00, 0.78541E+00,
- & 0.78728E+00, 0.78914E+00, 0.79100E+00, 0.79285E+00, 0.79471E+00,
- & 0.79656E+00, 0.79840E+00, 0.80024E+00, 0.80208E+00, 0.80391E+00,
- & 0.80575E+00, 0.80757E+00, 0.80940E+00, 0.81122E+00, 0.81304E+00,
- & 0.81485E+00, 0.81666E+00, 0.81847E+00, 0.82028E+00, 0.82208E+00,
- & 0.82387E+00, 0.82567E+00, 0.82746E+00, 0.82925E+00, 0.83103E+00,
- & 0.83281E+00, 0.83459E+00, 0.83637E+00, 0.83814E+00, 0.83991E+00,
- & 0.84167E+00, 0.84343E+00, 0.84519E+00, 0.84695E+00, 0.84870E+00,
- & 0.85045E+00, 0.85219E+00, 0.85394E+00, 0.85568E+00, 0.85741E+00,
- & 0.85914E+00, 0.86087E+00, 0.86260E+00, 0.86432E+00, 0.86604E+00,
- & 0.86776E+00, 0.86948E+00, 0.87119E+00, 0.87290E+00, 0.87460E+00,
- & 0.87630E+00, 0.87800E+00, 0.87970E+00, 0.88139E+00, 0.88308E+00,
- & 0.88476E+00, 0.88645E+00, 0.88813E+00, 0.88980E+00, 0.89148E+00,
- & 0.89315E+00, 0.89482E+00, 0.89648E+00, 0.89815E+00, 0.89980E+00,
- & 0.90146E+00, 0.90311E+00, 0.90476E+00, 0.90641E+00, 0.90806E+00,
- & 0.90970E+00, 0.91134E+00, 0.91297E+00, 0.91460E+00, 0.91623E+00,
- & 0.91786E+00, 0.91948E+00, 0.92110E+00, 0.92272E+00, 0.92434E+00,
- & 0.92595E+00, 0.92756E+00, 0.92917E+00, 0.93077E+00, 0.93237E+00,
- & 0.93397E+00, 0.93556E+00, 0.93716E+00, 0.93875E+00, 0.94033E+00/
-
- DATA (BNC10M(I),I=501,600)/
- & 0.94192E+00, 0.94350E+00, 0.94508E+00, 0.94665E+00, 0.94822E+00,
- & 0.94979E+00, 0.95136E+00, 0.95292E+00, 0.95449E+00, 0.95604E+00,
- & 0.95760E+00, 0.95915E+00, 0.96070E+00, 0.96225E+00, 0.96380E+00,
- & 0.96534E+00, 0.96688E+00, 0.96842E+00, 0.96995E+00, 0.97148E+00,
- & 0.97301E+00, 0.97454E+00, 0.97606E+00, 0.97758E+00, 0.97910E+00,
- & 0.98062E+00, 0.98213E+00, 0.98364E+00, 0.98515E+00, 0.98665E+00,
- & 0.98815E+00, 0.98965E+00, 0.99115E+00, 0.99265E+00, 0.99414E+00,
- & 0.99563E+00, 0.99711E+00, 0.99860E+00, 0.10001E+01, 0.10016E+01,
- & 0.10030E+01, 0.10045E+01, 0.10060E+01, 0.10074E+01, 0.10089E+01,
- & 0.10104E+01, 0.10118E+01, 0.10133E+01, 0.10148E+01, 0.10162E+01,
- & 0.10177E+01, 0.10191E+01, 0.10206E+01, 0.10220E+01, 0.10234E+01,
- & 0.10249E+01, 0.10263E+01, 0.10277E+01, 0.10292E+01, 0.10306E+01,
- & 0.10320E+01, 0.10335E+01, 0.10349E+01, 0.10363E+01, 0.10377E+01,
- & 0.10391E+01, 0.10405E+01, 0.10420E+01, 0.10434E+01, 0.10448E+01,
- & 0.10462E+01, 0.10476E+01, 0.10490E+01, 0.10504E+01, 0.10518E+01,
- & 0.10531E+01, 0.10545E+01, 0.10559E+01, 0.10573E+01, 0.10587E+01,
- & 0.10601E+01, 0.10614E+01, 0.10628E+01, 0.10642E+01, 0.10655E+01,
- & 0.10669E+01, 0.10683E+01, 0.10696E+01, 0.10710E+01, 0.10724E+01,
- & 0.10737E+01, 0.10751E+01, 0.10764E+01, 0.10778E+01, 0.10791E+01,
- & 0.10805E+01, 0.10818E+01, 0.10831E+01, 0.10845E+01, 0.10858E+01/
-
- DATA (BNC10M(I),I=601,700)/
- & 0.11001E+01, 0.11131E+01, 0.11259E+01, 0.11384E+01, 0.11508E+01,
- & 0.11629E+01, 0.11749E+01, 0.11867E+01, 0.11983E+01, 0.12097E+01,
- & 0.12209E+01, 0.12319E+01, 0.12428E+01, 0.12535E+01, 0.12640E+01,
- & 0.12744E+01, 0.12846E+01, 0.12946E+01, 0.13045E+01, 0.13142E+01,
- & 0.13238E+01, 0.13333E+01, 0.13426E+01, 0.13517E+01, 0.13607E+01,
- & 0.13696E+01, 0.13784E+01, 0.13870E+01, 0.13955E+01, 0.14038E+01,
- & 0.14121E+01, 0.14202E+01, 0.14282E+01, 0.14361E+01, 0.14438E+01,
- & 0.14515E+01, 0.14590E+01, 0.14664E+01, 0.14738E+01, 0.14810E+01,
- & 0.14881E+01, 0.14951E+01, 0.15020E+01, 0.15088E+01, 0.15155E+01,
- & 0.15221E+01, 0.15286E+01, 0.15350E+01, 0.15413E+01, 0.15475E+01,
- & 0.15536E+01, 0.15597E+01, 0.15656E+01, 0.15715E+01, 0.15773E+01,
- & 0.15830E+01, 0.15886E+01, 0.15942E+01, 0.15996E+01, 0.16050E+01,
- & 0.16103E+01, 0.16155E+01, 0.16207E+01, 0.16258E+01, 0.16308E+01,
- & 0.16357E+01, 0.16406E+01, 0.16453E+01, 0.16501E+01, 0.16547E+01,
- & 0.16593E+01, 0.16638E+01, 0.16682E+01, 0.16726E+01, 0.16769E+01,
- & 0.16812E+01, 0.16854E+01, 0.16895E+01, 0.16936E+01, 0.16976E+01,
- & 0.17015E+01, 0.17054E+01, 0.17092E+01, 0.17130E+01, 0.17167E+01,
- & 0.17204E+01, 0.17240E+01, 0.17275E+01, 0.17310E+01, 0.17345E+01,
- & 0.17379E+01, 0.17412E+01, 0.17445E+01, 0.17477E+01, 0.17509E+01,
- & 0.17540E+01, 0.17571E+01, 0.17601E+01, 0.17631E+01, 0.17660E+01/
-
- DATA (BNC10M(I),I=701,741)/
- & 0.17689E+01, 0.17718E+01, 0.17746E+01, 0.17773E+01, 0.17800E+01,
- & 0.17827E+01, 0.17853E+01, 0.17879E+01, 0.17904E+01, 0.17929E+01,
- & 0.17953E+01, 0.17977E+01, 0.18001E+01, 0.18024E+01, 0.18047E+01,
- & 0.18069E+01, 0.18091E+01, 0.18113E+01, 0.18134E+01, 0.18155E+01,
- & 0.18175E+01, 0.18195E+01, 0.18215E+01, 0.18234E+01, 0.18253E+01,
- & 0.18271E+01, 0.18290E+01, 0.18307E+01, 0.18325E+01, 0.18342E+01,
- & 0.18359E+01, 0.18375E+01, 0.18391E+01, 0.18407E+01, 0.18423E+01,
- & 0.18438E+01, 0.18453E+01, 0.18467E+01, 0.18481E+01, 0.18495E+01,
- & 0.18509E+01
- & /
-C
-C *** (H,Cl)
-C
- DATA (BNC11M(I),I=1,100)/
- &-0.47849E-01,-0.94150E-01,-0.11209E+00,-0.12203E+00,-0.12791E+00,
- &-0.13126E+00,-0.13288E+00,-0.13320E+00,-0.13253E+00,-0.13106E+00,
- &-0.12892E+00,-0.12624E+00,-0.12307E+00,-0.11949E+00,-0.11555E+00,
- &-0.11128E+00,-0.10671E+00,-0.10189E+00,-0.96822E-01,-0.91537E-01,
- &-0.86052E-01,-0.80381E-01,-0.74539E-01,-0.68539E-01,-0.62391E-01,
- &-0.56107E-01,-0.49696E-01,-0.43167E-01,-0.36526E-01,-0.29783E-01,
- &-0.22944E-01,-0.16015E-01,-0.90018E-02,-0.19110E-02, 0.52525E-02,
- & 0.12484E-01, 0.19778E-01, 0.27131E-01, 0.34538E-01, 0.41996E-01,
- & 0.49501E-01, 0.57049E-01, 0.64637E-01, 0.72262E-01, 0.79922E-01,
- & 0.87613E-01, 0.95334E-01, 0.10308E+00, 0.11085E+00, 0.11865E+00,
- & 0.12647E+00, 0.13431E+00, 0.14217E+00, 0.15004E+00, 0.15794E+00,
- & 0.16585E+00, 0.17377E+00, 0.18172E+00, 0.18967E+00, 0.19765E+00,
- & 0.20564E+00, 0.21364E+00, 0.22167E+00, 0.22971E+00, 0.23776E+00,
- & 0.24584E+00, 0.25394E+00, 0.26206E+00, 0.27020E+00, 0.27836E+00,
- & 0.28655E+00, 0.29476E+00, 0.30301E+00, 0.31128E+00, 0.31958E+00,
- & 0.32791E+00, 0.33628E+00, 0.34468E+00, 0.35311E+00, 0.36158E+00,
- & 0.37009E+00, 0.37864E+00, 0.38723E+00, 0.39586E+00, 0.40453E+00,
- & 0.41324E+00, 0.42200E+00, 0.43079E+00, 0.43963E+00, 0.44852E+00,
- & 0.45744E+00, 0.46641E+00, 0.47542E+00, 0.48448E+00, 0.49357E+00,
- & 0.50270E+00, 0.51188E+00, 0.52109E+00, 0.53034E+00, 0.53963E+00/
-
- DATA (BNC11M(I),I=101,200)/
- & 0.54895E+00, 0.55830E+00, 0.56769E+00, 0.57710E+00, 0.58655E+00,
- & 0.59602E+00, 0.60551E+00, 0.61503E+00, 0.62458E+00, 0.63414E+00,
- & 0.64372E+00, 0.65332E+00, 0.66293E+00, 0.67256E+00, 0.68220E+00,
- & 0.69184E+00, 0.70150E+00, 0.71117E+00, 0.72084E+00, 0.73051E+00,
- & 0.74019E+00, 0.74987E+00, 0.75955E+00, 0.76923E+00, 0.77890E+00,
- & 0.78858E+00, 0.79825E+00, 0.80791E+00, 0.81757E+00, 0.82722E+00,
- & 0.83687E+00, 0.84651E+00, 0.85613E+00, 0.86575E+00, 0.87536E+00,
- & 0.88496E+00, 0.89454E+00, 0.90412E+00, 0.91368E+00, 0.92323E+00,
- & 0.93277E+00, 0.94229E+00, 0.95180E+00, 0.96129E+00, 0.97078E+00,
- & 0.98024E+00, 0.98969E+00, 0.99913E+00, 0.10086E+01, 0.10180E+01,
- & 0.10273E+01, 0.10367E+01, 0.10461E+01, 0.10554E+01, 0.10647E+01,
- & 0.10741E+01, 0.10833E+01, 0.10926E+01, 0.11019E+01, 0.11111E+01,
- & 0.11203E+01, 0.11296E+01, 0.11387E+01, 0.11479E+01, 0.11571E+01,
- & 0.11662E+01, 0.11753E+01, 0.11844E+01, 0.11935E+01, 0.12026E+01,
- & 0.12116E+01, 0.12207E+01, 0.12297E+01, 0.12387E+01, 0.12477E+01,
- & 0.12566E+01, 0.12656E+01, 0.12745E+01, 0.12834E+01, 0.12923E+01,
- & 0.13012E+01, 0.13100E+01, 0.13189E+01, 0.13277E+01, 0.13365E+01,
- & 0.13453E+01, 0.13540E+01, 0.13628E+01, 0.13715E+01, 0.13802E+01,
- & 0.13889E+01, 0.13976E+01, 0.14062E+01, 0.14149E+01, 0.14235E+01,
- & 0.14321E+01, 0.14407E+01, 0.14492E+01, 0.14578E+01, 0.14663E+01/
-
- DATA (BNC11M(I),I=201,300)/
- & 0.14748E+01, 0.14833E+01, 0.14918E+01, 0.15003E+01, 0.15087E+01,
- & 0.15171E+01, 0.15255E+01, 0.15339E+01, 0.15423E+01, 0.15506E+01,
- & 0.15589E+01, 0.15673E+01, 0.15756E+01, 0.15838E+01, 0.15921E+01,
- & 0.16003E+01, 0.16086E+01, 0.16168E+01, 0.16250E+01, 0.16331E+01,
- & 0.16413E+01, 0.16494E+01, 0.16576E+01, 0.16657E+01, 0.16737E+01,
- & 0.16818E+01, 0.16899E+01, 0.16979E+01, 0.17059E+01, 0.17139E+01,
- & 0.17219E+01, 0.17299E+01, 0.17378E+01, 0.17457E+01, 0.17536E+01,
- & 0.17615E+01, 0.17694E+01, 0.17773E+01, 0.17851E+01, 0.17930E+01,
- & 0.18008E+01, 0.18086E+01, 0.18164E+01, 0.18241E+01, 0.18319E+01,
- & 0.18396E+01, 0.18473E+01, 0.18550E+01, 0.18627E+01, 0.18703E+01,
- & 0.18780E+01, 0.18856E+01, 0.18932E+01, 0.19008E+01, 0.19084E+01,
- & 0.19160E+01, 0.19235E+01, 0.19311E+01, 0.19386E+01, 0.19461E+01,
- & 0.19536E+01, 0.19611E+01, 0.19685E+01, 0.19759E+01, 0.19834E+01,
- & 0.19908E+01, 0.19982E+01, 0.20055E+01, 0.20129E+01, 0.20203E+01,
- & 0.20276E+01, 0.20349E+01, 0.20422E+01, 0.20495E+01, 0.20568E+01,
- & 0.20640E+01, 0.20713E+01, 0.20785E+01, 0.20857E+01, 0.20929E+01,
- & 0.21001E+01, 0.21072E+01, 0.21144E+01, 0.21215E+01, 0.21286E+01,
- & 0.21357E+01, 0.21428E+01, 0.21499E+01, 0.21570E+01, 0.21640E+01,
- & 0.21710E+01, 0.21781E+01, 0.21851E+01, 0.21921E+01, 0.21990E+01,
- & 0.22060E+01, 0.22129E+01, 0.22199E+01, 0.22268E+01, 0.22337E+01/
-
- DATA (BNC11M(I),I=301,400)/
- & 0.22406E+01, 0.22475E+01, 0.22543E+01, 0.22612E+01, 0.22680E+01,
- & 0.22748E+01, 0.22816E+01, 0.22884E+01, 0.22952E+01, 0.23020E+01,
- & 0.23087E+01, 0.23155E+01, 0.23222E+01, 0.23289E+01, 0.23356E+01,
- & 0.23423E+01, 0.23490E+01, 0.23556E+01, 0.23623E+01, 0.23689E+01,
- & 0.23755E+01, 0.23821E+01, 0.23887E+01, 0.23953E+01, 0.24019E+01,
- & 0.24084E+01, 0.24149E+01, 0.24215E+01, 0.24280E+01, 0.24345E+01,
- & 0.24410E+01, 0.24475E+01, 0.24539E+01, 0.24604E+01, 0.24668E+01,
- & 0.24732E+01, 0.24796E+01, 0.24860E+01, 0.24924E+01, 0.24988E+01,
- & 0.25052E+01, 0.25115E+01, 0.25179E+01, 0.25242E+01, 0.25305E+01,
- & 0.25368E+01, 0.25431E+01, 0.25494E+01, 0.25557E+01, 0.25619E+01,
- & 0.25681E+01, 0.25744E+01, 0.25806E+01, 0.25868E+01, 0.25930E+01,
- & 0.25992E+01, 0.26054E+01, 0.26115E+01, 0.26177E+01, 0.26238E+01,
- & 0.26299E+01, 0.26360E+01, 0.26421E+01, 0.26482E+01, 0.26543E+01,
- & 0.26604E+01, 0.26664E+01, 0.26725E+01, 0.26785E+01, 0.26845E+01,
- & 0.26906E+01, 0.26966E+01, 0.27025E+01, 0.27085E+01, 0.27145E+01,
- & 0.27204E+01, 0.27264E+01, 0.27323E+01, 0.27382E+01, 0.27442E+01,
- & 0.27501E+01, 0.27560E+01, 0.27618E+01, 0.27677E+01, 0.27736E+01,
- & 0.27794E+01, 0.27852E+01, 0.27911E+01, 0.27969E+01, 0.28027E+01,
- & 0.28085E+01, 0.28143E+01, 0.28200E+01, 0.28258E+01, 0.28316E+01,
- & 0.28373E+01, 0.28430E+01, 0.28488E+01, 0.28545E+01, 0.28602E+01/
-
- DATA (BNC11M(I),I=401,500)/
- & 0.28659E+01, 0.28715E+01, 0.28772E+01, 0.28829E+01, 0.28885E+01,
- & 0.28942E+01, 0.28998E+01, 0.29054E+01, 0.29110E+01, 0.29166E+01,
- & 0.29222E+01, 0.29278E+01, 0.29334E+01, 0.29389E+01, 0.29445E+01,
- & 0.29500E+01, 0.29555E+01, 0.29611E+01, 0.29666E+01, 0.29721E+01,
- & 0.29776E+01, 0.29831E+01, 0.29885E+01, 0.29940E+01, 0.29995E+01,
- & 0.30049E+01, 0.30103E+01, 0.30158E+01, 0.30212E+01, 0.30266E+01,
- & 0.30320E+01, 0.30374E+01, 0.30428E+01, 0.30481E+01, 0.30535E+01,
- & 0.30588E+01, 0.30642E+01, 0.30695E+01, 0.30748E+01, 0.30802E+01,
- & 0.30855E+01, 0.30908E+01, 0.30961E+01, 0.31013E+01, 0.31066E+01,
- & 0.31119E+01, 0.31171E+01, 0.31224E+01, 0.31276E+01, 0.31328E+01,
- & 0.31380E+01, 0.31433E+01, 0.31485E+01, 0.31536E+01, 0.31588E+01,
- & 0.31640E+01, 0.31692E+01, 0.31743E+01, 0.31795E+01, 0.31846E+01,
- & 0.31897E+01, 0.31949E+01, 0.32000E+01, 0.32051E+01, 0.32102E+01,
- & 0.32153E+01, 0.32204E+01, 0.32254E+01, 0.32305E+01, 0.32356E+01,
- & 0.32406E+01, 0.32456E+01, 0.32507E+01, 0.32557E+01, 0.32607E+01,
- & 0.32657E+01, 0.32707E+01, 0.32757E+01, 0.32807E+01, 0.32857E+01,
- & 0.32906E+01, 0.32956E+01, 0.33005E+01, 0.33055E+01, 0.33104E+01,
- & 0.33153E+01, 0.33202E+01, 0.33252E+01, 0.33301E+01, 0.33350E+01,
- & 0.33398E+01, 0.33447E+01, 0.33496E+01, 0.33545E+01, 0.33593E+01,
- & 0.33642E+01, 0.33690E+01, 0.33738E+01, 0.33787E+01, 0.33835E+01/
-
- DATA (BNC11M(I),I=501,600)/
- & 0.33883E+01, 0.33931E+01, 0.33979E+01, 0.34027E+01, 0.34074E+01,
- & 0.34122E+01, 0.34170E+01, 0.34217E+01, 0.34265E+01, 0.34312E+01,
- & 0.34360E+01, 0.34407E+01, 0.34454E+01, 0.34501E+01, 0.34548E+01,
- & 0.34595E+01, 0.34642E+01, 0.34689E+01, 0.34736E+01, 0.34782E+01,
- & 0.34829E+01, 0.34876E+01, 0.34922E+01, 0.34968E+01, 0.35015E+01,
- & 0.35061E+01, 0.35107E+01, 0.35153E+01, 0.35199E+01, 0.35245E+01,
- & 0.35291E+01, 0.35337E+01, 0.35383E+01, 0.35428E+01, 0.35474E+01,
- & 0.35520E+01, 0.35565E+01, 0.35611E+01, 0.35656E+01, 0.35701E+01,
- & 0.35746E+01, 0.35792E+01, 0.35837E+01, 0.35882E+01, 0.35927E+01,
- & 0.35971E+01, 0.36016E+01, 0.36061E+01, 0.36106E+01, 0.36150E+01,
- & 0.36195E+01, 0.36239E+01, 0.36284E+01, 0.36328E+01, 0.36372E+01,
- & 0.36416E+01, 0.36461E+01, 0.36505E+01, 0.36549E+01, 0.36593E+01,
- & 0.36636E+01, 0.36680E+01, 0.36724E+01, 0.36768E+01, 0.36811E+01,
- & 0.36855E+01, 0.36898E+01, 0.36942E+01, 0.36985E+01, 0.37028E+01,
- & 0.37072E+01, 0.37115E+01, 0.37158E+01, 0.37201E+01, 0.37244E+01,
- & 0.37287E+01, 0.37330E+01, 0.37373E+01, 0.37415E+01, 0.37458E+01,
- & 0.37501E+01, 0.37543E+01, 0.37586E+01, 0.37628E+01, 0.37670E+01,
- & 0.37713E+01, 0.37755E+01, 0.37797E+01, 0.37839E+01, 0.37881E+01,
- & 0.37923E+01, 0.37965E+01, 0.38007E+01, 0.38049E+01, 0.38091E+01,
- & 0.38133E+01, 0.38174E+01, 0.38216E+01, 0.38257E+01, 0.38299E+01/
-
- DATA (BNC11M(I),I=601,700)/
- & 0.38743E+01, 0.39148E+01, 0.39548E+01, 0.39942E+01, 0.40331E+01,
- & 0.40715E+01, 0.41094E+01, 0.41467E+01, 0.41836E+01, 0.42200E+01,
- & 0.42560E+01, 0.42915E+01, 0.43265E+01, 0.43611E+01, 0.43953E+01,
- & 0.44291E+01, 0.44624E+01, 0.44954E+01, 0.45280E+01, 0.45601E+01,
- & 0.45919E+01, 0.46234E+01, 0.46544E+01, 0.46852E+01, 0.47155E+01,
- & 0.47456E+01, 0.47752E+01, 0.48046E+01, 0.48336E+01, 0.48624E+01,
- & 0.48908E+01, 0.49189E+01, 0.49467E+01, 0.49742E+01, 0.50014E+01,
- & 0.50283E+01, 0.50550E+01, 0.50814E+01, 0.51075E+01, 0.51333E+01,
- & 0.51589E+01, 0.51842E+01, 0.52093E+01, 0.52341E+01, 0.52587E+01,
- & 0.52830E+01, 0.53071E+01, 0.53309E+01, 0.53546E+01, 0.53780E+01,
- & 0.54011E+01, 0.54241E+01, 0.54468E+01, 0.54694E+01, 0.54917E+01,
- & 0.55138E+01, 0.55357E+01, 0.55574E+01, 0.55789E+01, 0.56002E+01,
- & 0.56214E+01, 0.56423E+01, 0.56630E+01, 0.56836E+01, 0.57040E+01,
- & 0.57242E+01, 0.57442E+01, 0.57640E+01, 0.57837E+01, 0.58032E+01,
- & 0.58226E+01, 0.58417E+01, 0.58608E+01, 0.58796E+01, 0.58983E+01,
- & 0.59168E+01, 0.59352E+01, 0.59534E+01, 0.59715E+01, 0.59894E+01,
- & 0.60072E+01, 0.60248E+01, 0.60423E+01, 0.60597E+01, 0.60769E+01,
- & 0.60940E+01, 0.61109E+01, 0.61277E+01, 0.61444E+01, 0.61609E+01,
- & 0.61773E+01, 0.61936E+01, 0.62097E+01, 0.62257E+01, 0.62416E+01,
- & 0.62574E+01, 0.62731E+01, 0.62886E+01, 0.63040E+01, 0.63193E+01/
-
- DATA (BNC11M(I),I=701,741)/
- & 0.63345E+01, 0.63496E+01, 0.63645E+01, 0.63794E+01, 0.63941E+01,
- & 0.64087E+01, 0.64232E+01, 0.64376E+01, 0.64519E+01, 0.64661E+01,
- & 0.64802E+01, 0.64942E+01, 0.65081E+01, 0.65218E+01, 0.65355E+01,
- & 0.65491E+01, 0.65626E+01, 0.65760E+01, 0.65893E+01, 0.66025E+01,
- & 0.66156E+01, 0.66286E+01, 0.66415E+01, 0.66543E+01, 0.66671E+01,
- & 0.66797E+01, 0.66923E+01, 0.67047E+01, 0.67171E+01, 0.67294E+01,
- & 0.67416E+01, 0.67538E+01, 0.67658E+01, 0.67778E+01, 0.67897E+01,
- & 0.68015E+01, 0.68132E+01, 0.68248E+01, 0.68364E+01, 0.68479E+01,
- & 0.68593E+01
- & /
-C
-C *** NaHSO4
-C
- DATA (BNC12M(I),I=1,100)/
- &-0.49197E-01,-0.10142E+00,-0.12478E+00,-0.13991E+00,-0.15083E+00,
- &-0.15912E+00,-0.16560E+00,-0.17074E+00,-0.17485E+00,-0.17812E+00,
- &-0.18070E+00,-0.18270E+00,-0.18421E+00,-0.18528E+00,-0.18597E+00,
- &-0.18631E+00,-0.18635E+00,-0.18610E+00,-0.18560E+00,-0.18485E+00,
- &-0.18389E+00,-0.18272E+00,-0.18136E+00,-0.17982E+00,-0.17811E+00,
- &-0.17624E+00,-0.17421E+00,-0.17204E+00,-0.16973E+00,-0.16730E+00,
- &-0.16473E+00,-0.16205E+00,-0.15925E+00,-0.15634E+00,-0.15333E+00,
- &-0.15021E+00,-0.14700E+00,-0.14370E+00,-0.14031E+00,-0.13683E+00,
- &-0.13327E+00,-0.12964E+00,-0.12592E+00,-0.12214E+00,-0.11829E+00,
- &-0.11437E+00,-0.11038E+00,-0.10634E+00,-0.10223E+00,-0.98072E-01,
- &-0.93855E-01,-0.89586E-01,-0.85265E-01,-0.80895E-01,-0.76477E-01,
- &-0.72014E-01,-0.67505E-01,-0.62952E-01,-0.58357E-01,-0.53721E-01,
- &-0.49044E-01,-0.44327E-01,-0.39571E-01,-0.34777E-01,-0.29944E-01,
- &-0.25074E-01,-0.20167E-01,-0.15222E-01,-0.10240E-01,-0.52212E-02,
- &-0.16537E-03, 0.49275E-02, 0.10057E-01, 0.15225E-01, 0.20429E-01,
- & 0.25672E-01, 0.30952E-01, 0.36270E-01, 0.41626E-01, 0.47021E-01,
- & 0.52455E-01, 0.57927E-01, 0.63438E-01, 0.68988E-01, 0.74576E-01,
- & 0.80203E-01, 0.85868E-01, 0.91572E-01, 0.97314E-01, 0.10309E+00,
- & 0.10891E+00, 0.11476E+00, 0.12065E+00, 0.12657E+00, 0.13253E+00,
- & 0.13852E+00, 0.14455E+00, 0.15060E+00, 0.15669E+00, 0.16280E+00/
-
- DATA (BNC12M(I),I=101,200)/
- & 0.16895E+00, 0.17512E+00, 0.18131E+00, 0.18753E+00, 0.19377E+00,
- & 0.20004E+00, 0.20632E+00, 0.21262E+00, 0.21894E+00, 0.22528E+00,
- & 0.23163E+00, 0.23799E+00, 0.24437E+00, 0.25075E+00, 0.25715E+00,
- & 0.26355E+00, 0.26996E+00, 0.27637E+00, 0.28279E+00, 0.28921E+00,
- & 0.29563E+00, 0.30206E+00, 0.30848E+00, 0.31491E+00, 0.32133E+00,
- & 0.32775E+00, 0.33417E+00, 0.34058E+00, 0.34699E+00, 0.35339E+00,
- & 0.35979E+00, 0.36618E+00, 0.37256E+00, 0.37893E+00, 0.38530E+00,
- & 0.39166E+00, 0.39801E+00, 0.40435E+00, 0.41068E+00, 0.41700E+00,
- & 0.42331E+00, 0.42961E+00, 0.43590E+00, 0.44218E+00, 0.44844E+00,
- & 0.45470E+00, 0.46094E+00, 0.46717E+00, 0.47339E+00, 0.47960E+00,
- & 0.48580E+00, 0.49198E+00, 0.49815E+00, 0.50431E+00, 0.51046E+00,
- & 0.51659E+00, 0.52271E+00, 0.52882E+00, 0.53491E+00, 0.54099E+00,
- & 0.54706E+00, 0.55312E+00, 0.55916E+00, 0.56519E+00, 0.57121E+00,
- & 0.57721E+00, 0.58320E+00, 0.58918E+00, 0.59514E+00, 0.60109E+00,
- & 0.60703E+00, 0.61295E+00, 0.61886E+00, 0.62476E+00, 0.63065E+00,
- & 0.63652E+00, 0.64237E+00, 0.64822E+00, 0.65405E+00, 0.65987E+00,
- & 0.66567E+00, 0.67146E+00, 0.67724E+00, 0.68301E+00, 0.68876E+00,
- & 0.69450E+00, 0.70022E+00, 0.70593E+00, 0.71163E+00, 0.71732E+00,
- & 0.72299E+00, 0.72865E+00, 0.73430E+00, 0.73993E+00, 0.74555E+00,
- & 0.75116E+00, 0.75675E+00, 0.76233E+00, 0.76790E+00, 0.77346E+00/
-
- DATA (BNC12M(I),I=201,300)/
- & 0.77900E+00, 0.78453E+00, 0.79005E+00, 0.79555E+00, 0.80105E+00,
- & 0.80653E+00, 0.81199E+00, 0.81745E+00, 0.82289E+00, 0.82832E+00,
- & 0.83373E+00, 0.83914E+00, 0.84453E+00, 0.84991E+00, 0.85528E+00,
- & 0.86063E+00, 0.86597E+00, 0.87130E+00, 0.87662E+00, 0.88193E+00,
- & 0.88722E+00, 0.89250E+00, 0.89777E+00, 0.90303E+00, 0.90827E+00,
- & 0.91351E+00, 0.91873E+00, 0.92394E+00, 0.92914E+00, 0.93432E+00,
- & 0.93950E+00, 0.94466E+00, 0.94981E+00, 0.95495E+00, 0.96008E+00,
- & 0.96519E+00, 0.97030E+00, 0.97539E+00, 0.98047E+00, 0.98554E+00,
- & 0.99060E+00, 0.99565E+00, 0.10007E+01, 0.10057E+01, 0.10107E+01,
- & 0.10157E+01, 0.10207E+01, 0.10257E+01, 0.10307E+01, 0.10356E+01,
- & 0.10406E+01, 0.10455E+01, 0.10504E+01, 0.10554E+01, 0.10603E+01,
- & 0.10652E+01, 0.10700E+01, 0.10749E+01, 0.10798E+01, 0.10846E+01,
- & 0.10895E+01, 0.10943E+01, 0.10991E+01, 0.11039E+01, 0.11087E+01,
- & 0.11135E+01, 0.11183E+01, 0.11230E+01, 0.11278E+01, 0.11326E+01,
- & 0.11373E+01, 0.11420E+01, 0.11467E+01, 0.11514E+01, 0.11561E+01,
- & 0.11608E+01, 0.11655E+01, 0.11702E+01, 0.11748E+01, 0.11795E+01,
- & 0.11841E+01, 0.11887E+01, 0.11933E+01, 0.11980E+01, 0.12025E+01,
- & 0.12071E+01, 0.12117E+01, 0.12163E+01, 0.12208E+01, 0.12254E+01,
- & 0.12299E+01, 0.12345E+01, 0.12390E+01, 0.12435E+01, 0.12480E+01,
- & 0.12525E+01, 0.12570E+01, 0.12614E+01, 0.12659E+01, 0.12704E+01/
-
- DATA (BNC12M(I),I=301,400)/
- & 0.12748E+01, 0.12792E+01, 0.12837E+01, 0.12881E+01, 0.12925E+01,
- & 0.12969E+01, 0.13013E+01, 0.13057E+01, 0.13101E+01, 0.13144E+01,
- & 0.13188E+01, 0.13231E+01, 0.13275E+01, 0.13318E+01, 0.13361E+01,
- & 0.13404E+01, 0.13447E+01, 0.13490E+01, 0.13533E+01, 0.13576E+01,
- & 0.13619E+01, 0.13661E+01, 0.13704E+01, 0.13746E+01, 0.13788E+01,
- & 0.13831E+01, 0.13873E+01, 0.13915E+01, 0.13957E+01, 0.13999E+01,
- & 0.14041E+01, 0.14083E+01, 0.14124E+01, 0.14166E+01, 0.14207E+01,
- & 0.14249E+01, 0.14290E+01, 0.14331E+01, 0.14373E+01, 0.14414E+01,
- & 0.14455E+01, 0.14496E+01, 0.14537E+01, 0.14577E+01, 0.14618E+01,
- & 0.14659E+01, 0.14699E+01, 0.14740E+01, 0.14780E+01, 0.14820E+01,
- & 0.14861E+01, 0.14901E+01, 0.14941E+01, 0.14981E+01, 0.15021E+01,
- & 0.15061E+01, 0.15101E+01, 0.15140E+01, 0.15180E+01, 0.15219E+01,
- & 0.15259E+01, 0.15298E+01, 0.15338E+01, 0.15377E+01, 0.15416E+01,
- & 0.15455E+01, 0.15494E+01, 0.15533E+01, 0.15572E+01, 0.15611E+01,
- & 0.15650E+01, 0.15688E+01, 0.15727E+01, 0.15765E+01, 0.15804E+01,
- & 0.15842E+01, 0.15881E+01, 0.15919E+01, 0.15957E+01, 0.15995E+01,
- & 0.16033E+01, 0.16071E+01, 0.16109E+01, 0.16147E+01, 0.16185E+01,
- & 0.16222E+01, 0.16260E+01, 0.16297E+01, 0.16335E+01, 0.16372E+01,
- & 0.16410E+01, 0.16447E+01, 0.16484E+01, 0.16521E+01, 0.16558E+01,
- & 0.16595E+01, 0.16632E+01, 0.16669E+01, 0.16706E+01, 0.16743E+01/
-
- DATA (BNC12M(I),I=401,500)/
- & 0.16779E+01, 0.16816E+01, 0.16852E+01, 0.16889E+01, 0.16925E+01,
- & 0.16962E+01, 0.16998E+01, 0.17034E+01, 0.17070E+01, 0.17106E+01,
- & 0.17142E+01, 0.17178E+01, 0.17214E+01, 0.17250E+01, 0.17286E+01,
- & 0.17321E+01, 0.17357E+01, 0.17393E+01, 0.17428E+01, 0.17464E+01,
- & 0.17499E+01, 0.17534E+01, 0.17569E+01, 0.17605E+01, 0.17640E+01,
- & 0.17675E+01, 0.17710E+01, 0.17745E+01, 0.17780E+01, 0.17815E+01,
- & 0.17849E+01, 0.17884E+01, 0.17919E+01, 0.17953E+01, 0.17988E+01,
- & 0.18022E+01, 0.18057E+01, 0.18091E+01, 0.18125E+01, 0.18159E+01,
- & 0.18194E+01, 0.18228E+01, 0.18262E+01, 0.18296E+01, 0.18330E+01,
- & 0.18364E+01, 0.18397E+01, 0.18431E+01, 0.18465E+01, 0.18498E+01,
- & 0.18532E+01, 0.18566E+01, 0.18599E+01, 0.18632E+01, 0.18666E+01,
- & 0.18699E+01, 0.18732E+01, 0.18766E+01, 0.18799E+01, 0.18832E+01,
- & 0.18865E+01, 0.18898E+01, 0.18931E+01, 0.18964E+01, 0.18996E+01,
- & 0.19029E+01, 0.19062E+01, 0.19094E+01, 0.19127E+01, 0.19160E+01,
- & 0.19192E+01, 0.19224E+01, 0.19257E+01, 0.19289E+01, 0.19321E+01,
- & 0.19354E+01, 0.19386E+01, 0.19418E+01, 0.19450E+01, 0.19482E+01,
- & 0.19514E+01, 0.19546E+01, 0.19577E+01, 0.19609E+01, 0.19641E+01,
- & 0.19673E+01, 0.19704E+01, 0.19736E+01, 0.19767E+01, 0.19799E+01,
- & 0.19830E+01, 0.19862E+01, 0.19893E+01, 0.19924E+01, 0.19955E+01,
- & 0.19987E+01, 0.20018E+01, 0.20049E+01, 0.20080E+01, 0.20111E+01/
-
- DATA (BNC12M(I),I=501,600)/
- & 0.20142E+01, 0.20173E+01, 0.20203E+01, 0.20234E+01, 0.20265E+01,
- & 0.20295E+01, 0.20326E+01, 0.20357E+01, 0.20387E+01, 0.20418E+01,
- & 0.20448E+01, 0.20478E+01, 0.20509E+01, 0.20539E+01, 0.20569E+01,
- & 0.20599E+01, 0.20630E+01, 0.20660E+01, 0.20690E+01, 0.20720E+01,
- & 0.20750E+01, 0.20780E+01, 0.20809E+01, 0.20839E+01, 0.20869E+01,
- & 0.20899E+01, 0.20928E+01, 0.20958E+01, 0.20987E+01, 0.21017E+01,
- & 0.21046E+01, 0.21076E+01, 0.21105E+01, 0.21135E+01, 0.21164E+01,
- & 0.21193E+01, 0.21222E+01, 0.21251E+01, 0.21281E+01, 0.21310E+01,
- & 0.21339E+01, 0.21368E+01, 0.21397E+01, 0.21425E+01, 0.21454E+01,
- & 0.21483E+01, 0.21512E+01, 0.21541E+01, 0.21569E+01, 0.21598E+01,
- & 0.21626E+01, 0.21655E+01, 0.21683E+01, 0.21712E+01, 0.21740E+01,
- & 0.21769E+01, 0.21797E+01, 0.21825E+01, 0.21853E+01, 0.21882E+01,
- & 0.21910E+01, 0.21938E+01, 0.21966E+01, 0.21994E+01, 0.22022E+01,
- & 0.22050E+01, 0.22078E+01, 0.22106E+01, 0.22133E+01, 0.22161E+01,
- & 0.22189E+01, 0.22216E+01, 0.22244E+01, 0.22272E+01, 0.22299E+01,
- & 0.22327E+01, 0.22354E+01, 0.22382E+01, 0.22409E+01, 0.22436E+01,
- & 0.22464E+01, 0.22491E+01, 0.22518E+01, 0.22545E+01, 0.22572E+01,
- & 0.22600E+01, 0.22627E+01, 0.22654E+01, 0.22681E+01, 0.22708E+01,
- & 0.22734E+01, 0.22761E+01, 0.22788E+01, 0.22815E+01, 0.22842E+01,
- & 0.22868E+01, 0.22895E+01, 0.22922E+01, 0.22948E+01, 0.22975E+01/
-
- DATA (BNC12M(I),I=601,700)/
- & 0.23259E+01, 0.23518E+01, 0.23774E+01, 0.24026E+01, 0.24274E+01,
- & 0.24519E+01, 0.24761E+01, 0.24999E+01, 0.25234E+01, 0.25466E+01,
- & 0.25694E+01, 0.25920E+01, 0.26142E+01, 0.26362E+01, 0.26579E+01,
- & 0.26793E+01, 0.27004E+01, 0.27213E+01, 0.27419E+01, 0.27622E+01,
- & 0.27823E+01, 0.28022E+01, 0.28218E+01, 0.28411E+01, 0.28602E+01,
- & 0.28791E+01, 0.28978E+01, 0.29162E+01, 0.29344E+01, 0.29524E+01,
- & 0.29702E+01, 0.29878E+01, 0.30052E+01, 0.30224E+01, 0.30393E+01,
- & 0.30561E+01, 0.30727E+01, 0.30891E+01, 0.31054E+01, 0.31214E+01,
- & 0.31373E+01, 0.31530E+01, 0.31685E+01, 0.31838E+01, 0.31990E+01,
- & 0.32140E+01, 0.32289E+01, 0.32436E+01, 0.32581E+01, 0.32725E+01,
- & 0.32868E+01, 0.33008E+01, 0.33148E+01, 0.33286E+01, 0.33422E+01,
- & 0.33557E+01, 0.33691E+01, 0.33823E+01, 0.33954E+01, 0.34084E+01,
- & 0.34212E+01, 0.34339E+01, 0.34465E+01, 0.34589E+01, 0.34712E+01,
- & 0.34834E+01, 0.34955E+01, 0.35075E+01, 0.35193E+01, 0.35310E+01,
- & 0.35426E+01, 0.35541E+01, 0.35655E+01, 0.35768E+01, 0.35880E+01,
- & 0.35990E+01, 0.36100E+01, 0.36208E+01, 0.36316E+01, 0.36422E+01,
- & 0.36527E+01, 0.36632E+01, 0.36735E+01, 0.36838E+01, 0.36939E+01,
- & 0.37040E+01, 0.37139E+01, 0.37238E+01, 0.37336E+01, 0.37432E+01,
- & 0.37528E+01, 0.37623E+01, 0.37718E+01, 0.37811E+01, 0.37903E+01,
- & 0.37995E+01, 0.38086E+01, 0.38176E+01, 0.38265E+01, 0.38353E+01/
-
- DATA (BNC12M(I),I=701,741)/
- & 0.38441E+01, 0.38528E+01, 0.38614E+01, 0.38699E+01, 0.38783E+01,
- & 0.38867E+01, 0.38950E+01, 0.39032E+01, 0.39113E+01, 0.39194E+01,
- & 0.39274E+01, 0.39353E+01, 0.39432E+01, 0.39510E+01, 0.39587E+01,
- & 0.39664E+01, 0.39740E+01, 0.39815E+01, 0.39889E+01, 0.39963E+01,
- & 0.40037E+01, 0.40109E+01, 0.40181E+01, 0.40253E+01, 0.40323E+01,
- & 0.40393E+01, 0.40463E+01, 0.40532E+01, 0.40600E+01, 0.40668E+01,
- & 0.40735E+01, 0.40802E+01, 0.40867E+01, 0.40933E+01, 0.40998E+01,
- & 0.41062E+01, 0.41126E+01, 0.41189E+01, 0.41252E+01, 0.41314E+01,
- & 0.41375E+01
- & /
-C
-C *** (NH4)3H(SO4)2
-C
- DATA (BNC13M(I),I=1,100)/
- &-0.81873E-01,-0.17829E+00,-0.22674E+00,-0.26117E+00,-0.28833E+00,
- &-0.31093E+00,-0.33037E+00,-0.34746E+00,-0.36275E+00,-0.37660E+00,
- &-0.38926E+00,-0.40094E+00,-0.41177E+00,-0.42187E+00,-0.43134E+00,
- &-0.44025E+00,-0.44867E+00,-0.45663E+00,-0.46420E+00,-0.47139E+00,
- &-0.47826E+00,-0.48481E+00,-0.49108E+00,-0.49709E+00,-0.50285E+00,
- &-0.50838E+00,-0.51370E+00,-0.51882E+00,-0.52375E+00,-0.52851E+00,
- &-0.53309E+00,-0.53751E+00,-0.54179E+00,-0.54591E+00,-0.54990E+00,
- &-0.55376E+00,-0.55750E+00,-0.56111E+00,-0.56461E+00,-0.56800E+00,
- &-0.57129E+00,-0.57447E+00,-0.57756E+00,-0.58056E+00,-0.58346E+00,
- &-0.58628E+00,-0.58902E+00,-0.59167E+00,-0.59425E+00,-0.59676E+00,
- &-0.59919E+00,-0.60156E+00,-0.60386E+00,-0.60609E+00,-0.60827E+00,
- &-0.61038E+00,-0.61243E+00,-0.61443E+00,-0.61638E+00,-0.61827E+00,
- &-0.62011E+00,-0.62191E+00,-0.62365E+00,-0.62535E+00,-0.62701E+00,
- &-0.62862E+00,-0.63019E+00,-0.63172E+00,-0.63321E+00,-0.63466E+00,
- &-0.63607E+00,-0.63745E+00,-0.63879E+00,-0.64009E+00,-0.64136E+00,
- &-0.64260E+00,-0.64381E+00,-0.64498E+00,-0.64613E+00,-0.64724E+00,
- &-0.64832E+00,-0.64937E+00,-0.65040E+00,-0.65140E+00,-0.65237E+00,
- &-0.65331E+00,-0.65422E+00,-0.65512E+00,-0.65598E+00,-0.65682E+00,
- &-0.65764E+00,-0.65843E+00,-0.65920E+00,-0.65995E+00,-0.66068E+00,
- &-0.66138E+00,-0.66206E+00,-0.66273E+00,-0.66337E+00,-0.66399E+00/
-
- DATA (BNC13M(I),I=101,200)/
- &-0.66460E+00,-0.66519E+00,-0.66576E+00,-0.66631E+00,-0.66685E+00,
- &-0.66737E+00,-0.66787E+00,-0.66836E+00,-0.66884E+00,-0.66930E+00,
- &-0.66975E+00,-0.67019E+00,-0.67062E+00,-0.67103E+00,-0.67143E+00,
- &-0.67182E+00,-0.67220E+00,-0.67258E+00,-0.67294E+00,-0.67329E+00,
- &-0.67364E+00,-0.67397E+00,-0.67430E+00,-0.67462E+00,-0.67494E+00,
- &-0.67524E+00,-0.67555E+00,-0.67584E+00,-0.67613E+00,-0.67641E+00,
- &-0.67669E+00,-0.67696E+00,-0.67723E+00,-0.67750E+00,-0.67775E+00,
- &-0.67801E+00,-0.67826E+00,-0.67851E+00,-0.67875E+00,-0.67899E+00,
- &-0.67923E+00,-0.67946E+00,-0.67969E+00,-0.67992E+00,-0.68015E+00,
- &-0.68037E+00,-0.68059E+00,-0.68081E+00,-0.68103E+00,-0.68124E+00,
- &-0.68145E+00,-0.68166E+00,-0.68187E+00,-0.68208E+00,-0.68228E+00,
- &-0.68249E+00,-0.68269E+00,-0.68289E+00,-0.68309E+00,-0.68329E+00,
- &-0.68349E+00,-0.68368E+00,-0.68388E+00,-0.68408E+00,-0.68427E+00,
- &-0.68446E+00,-0.68465E+00,-0.68485E+00,-0.68504E+00,-0.68523E+00,
- &-0.68542E+00,-0.68561E+00,-0.68580E+00,-0.68599E+00,-0.68618E+00,
- &-0.68636E+00,-0.68655E+00,-0.68674E+00,-0.68693E+00,-0.68712E+00,
- &-0.68730E+00,-0.68749E+00,-0.68768E+00,-0.68787E+00,-0.68805E+00,
- &-0.68824E+00,-0.68843E+00,-0.68862E+00,-0.68880E+00,-0.68899E+00,
- &-0.68918E+00,-0.68937E+00,-0.68956E+00,-0.68975E+00,-0.68994E+00,
- &-0.69013E+00,-0.69032E+00,-0.69051E+00,-0.69070E+00,-0.69089E+00/
-
- DATA (BNC13M(I),I=201,300)/
- &-0.69108E+00,-0.69128E+00,-0.69147E+00,-0.69166E+00,-0.69186E+00,
- &-0.69205E+00,-0.69225E+00,-0.69244E+00,-0.69264E+00,-0.69283E+00,
- &-0.69303E+00,-0.69323E+00,-0.69343E+00,-0.69363E+00,-0.69383E+00,
- &-0.69403E+00,-0.69423E+00,-0.69443E+00,-0.69463E+00,-0.69484E+00,
- &-0.69504E+00,-0.69524E+00,-0.69545E+00,-0.69566E+00,-0.69586E+00,
- &-0.69607E+00,-0.69628E+00,-0.69649E+00,-0.69670E+00,-0.69691E+00,
- &-0.69712E+00,-0.69733E+00,-0.69754E+00,-0.69776E+00,-0.69797E+00,
- &-0.69818E+00,-0.69840E+00,-0.69862E+00,-0.69883E+00,-0.69905E+00,
- &-0.69927E+00,-0.69949E+00,-0.69971E+00,-0.69993E+00,-0.70016E+00,
- &-0.70038E+00,-0.70060E+00,-0.70083E+00,-0.70106E+00,-0.70128E+00,
- &-0.70151E+00,-0.70174E+00,-0.70197E+00,-0.70220E+00,-0.70243E+00,
- &-0.70266E+00,-0.70289E+00,-0.70313E+00,-0.70336E+00,-0.70360E+00,
- &-0.70383E+00,-0.70407E+00,-0.70431E+00,-0.70455E+00,-0.70479E+00,
- &-0.70503E+00,-0.70527E+00,-0.70551E+00,-0.70575E+00,-0.70600E+00,
- &-0.70624E+00,-0.70649E+00,-0.70674E+00,-0.70698E+00,-0.70723E+00,
- &-0.70748E+00,-0.70773E+00,-0.70798E+00,-0.70824E+00,-0.70849E+00,
- &-0.70874E+00,-0.70900E+00,-0.70925E+00,-0.70951E+00,-0.70977E+00,
- &-0.71002E+00,-0.71028E+00,-0.71054E+00,-0.71080E+00,-0.71107E+00,
- &-0.71133E+00,-0.71159E+00,-0.71186E+00,-0.71212E+00,-0.71239E+00,
- &-0.71266E+00,-0.71292E+00,-0.71319E+00,-0.71346E+00,-0.71373E+00/
-
- DATA (BNC13M(I),I=301,400)/
- &-0.71401E+00,-0.71428E+00,-0.71455E+00,-0.71483E+00,-0.71510E+00,
- &-0.71538E+00,-0.71565E+00,-0.71593E+00,-0.71621E+00,-0.71649E+00,
- &-0.71677E+00,-0.71705E+00,-0.71733E+00,-0.71762E+00,-0.71790E+00,
- &-0.71818E+00,-0.71847E+00,-0.71876E+00,-0.71904E+00,-0.71933E+00,
- &-0.71962E+00,-0.71991E+00,-0.72020E+00,-0.72049E+00,-0.72079E+00,
- &-0.72108E+00,-0.72137E+00,-0.72167E+00,-0.72196E+00,-0.72226E+00,
- &-0.72256E+00,-0.72286E+00,-0.72316E+00,-0.72346E+00,-0.72376E+00,
- &-0.72406E+00,-0.72436E+00,-0.72466E+00,-0.72497E+00,-0.72527E+00,
- &-0.72558E+00,-0.72589E+00,-0.72619E+00,-0.72650E+00,-0.72681E+00,
- &-0.72712E+00,-0.72743E+00,-0.72774E+00,-0.72806E+00,-0.72837E+00,
- &-0.72868E+00,-0.72900E+00,-0.72932E+00,-0.72963E+00,-0.72995E+00,
- &-0.73027E+00,-0.73059E+00,-0.73091E+00,-0.73123E+00,-0.73155E+00,
- &-0.73187E+00,-0.73220E+00,-0.73252E+00,-0.73284E+00,-0.73317E+00,
- &-0.73350E+00,-0.73382E+00,-0.73415E+00,-0.73448E+00,-0.73481E+00,
- &-0.73514E+00,-0.73547E+00,-0.73580E+00,-0.73614E+00,-0.73647E+00,
- &-0.73680E+00,-0.73714E+00,-0.73747E+00,-0.73781E+00,-0.73815E+00,
- &-0.73849E+00,-0.73882E+00,-0.73916E+00,-0.73951E+00,-0.73985E+00,
- &-0.74019E+00,-0.74053E+00,-0.74087E+00,-0.74122E+00,-0.74156E+00,
- &-0.74191E+00,-0.74226E+00,-0.74260E+00,-0.74295E+00,-0.74330E+00,
- &-0.74365E+00,-0.74400E+00,-0.74435E+00,-0.74470E+00,-0.74506E+00/
-
- DATA (BNC13M(I),I=401,500)/
- &-0.74541E+00,-0.74576E+00,-0.74612E+00,-0.74647E+00,-0.74683E+00,
- &-0.74719E+00,-0.74755E+00,-0.74790E+00,-0.74826E+00,-0.74862E+00,
- &-0.74898E+00,-0.74935E+00,-0.74971E+00,-0.75007E+00,-0.75043E+00,
- &-0.75080E+00,-0.75116E+00,-0.75153E+00,-0.75190E+00,-0.75226E+00,
- &-0.75263E+00,-0.75300E+00,-0.75337E+00,-0.75374E+00,-0.75411E+00,
- &-0.75448E+00,-0.75485E+00,-0.75523E+00,-0.75560E+00,-0.75597E+00,
- &-0.75635E+00,-0.75673E+00,-0.75710E+00,-0.75748E+00,-0.75786E+00,
- &-0.75824E+00,-0.75861E+00,-0.75899E+00,-0.75937E+00,-0.75976E+00,
- &-0.76014E+00,-0.76052E+00,-0.76090E+00,-0.76129E+00,-0.76167E+00,
- &-0.76206E+00,-0.76244E+00,-0.76283E+00,-0.76322E+00,-0.76361E+00,
- &-0.76399E+00,-0.76438E+00,-0.76477E+00,-0.76517E+00,-0.76556E+00,
- &-0.76595E+00,-0.76634E+00,-0.76673E+00,-0.76713E+00,-0.76752E+00,
- &-0.76792E+00,-0.76831E+00,-0.76871E+00,-0.76911E+00,-0.76951E+00,
- &-0.76991E+00,-0.77030E+00,-0.77070E+00,-0.77111E+00,-0.77151E+00,
- &-0.77191E+00,-0.77231E+00,-0.77271E+00,-0.77312E+00,-0.77352E+00,
- &-0.77393E+00,-0.77433E+00,-0.77474E+00,-0.77515E+00,-0.77555E+00,
- &-0.77596E+00,-0.77637E+00,-0.77678E+00,-0.77719E+00,-0.77760E+00,
- &-0.77801E+00,-0.77842E+00,-0.77884E+00,-0.77925E+00,-0.77966E+00,
- &-0.78008E+00,-0.78049E+00,-0.78091E+00,-0.78133E+00,-0.78174E+00,
- &-0.78216E+00,-0.78258E+00,-0.78300E+00,-0.78342E+00,-0.78384E+00/
-
- DATA (BNC13M(I),I=501,600)/
- &-0.78426E+00,-0.78468E+00,-0.78510E+00,-0.78552E+00,-0.78594E+00,
- &-0.78637E+00,-0.78679E+00,-0.78722E+00,-0.78764E+00,-0.78807E+00,
- &-0.78849E+00,-0.78892E+00,-0.78935E+00,-0.78978E+00,-0.79021E+00,
- &-0.79064E+00,-0.79107E+00,-0.79150E+00,-0.79193E+00,-0.79236E+00,
- &-0.79279E+00,-0.79323E+00,-0.79366E+00,-0.79409E+00,-0.79453E+00,
- &-0.79496E+00,-0.79540E+00,-0.79583E+00,-0.79627E+00,-0.79671E+00,
- &-0.79715E+00,-0.79759E+00,-0.79803E+00,-0.79846E+00,-0.79891E+00,
- &-0.79935E+00,-0.79979E+00,-0.80023E+00,-0.80067E+00,-0.80112E+00,
- &-0.80156E+00,-0.80200E+00,-0.80245E+00,-0.80289E+00,-0.80334E+00,
- &-0.80379E+00,-0.80423E+00,-0.80468E+00,-0.80513E+00,-0.80558E+00,
- &-0.80603E+00,-0.80648E+00,-0.80693E+00,-0.80738E+00,-0.80783E+00,
- &-0.80828E+00,-0.80873E+00,-0.80919E+00,-0.80964E+00,-0.81009E+00,
- &-0.81055E+00,-0.81100E+00,-0.81146E+00,-0.81191E+00,-0.81237E+00,
- &-0.81283E+00,-0.81329E+00,-0.81374E+00,-0.81420E+00,-0.81466E+00,
- &-0.81512E+00,-0.81558E+00,-0.81604E+00,-0.81650E+00,-0.81697E+00,
- &-0.81743E+00,-0.81789E+00,-0.81836E+00,-0.81882E+00,-0.81928E+00,
- &-0.81975E+00,-0.82021E+00,-0.82068E+00,-0.82115E+00,-0.82161E+00,
- &-0.82208E+00,-0.82255E+00,-0.82302E+00,-0.82349E+00,-0.82396E+00,
- &-0.82443E+00,-0.82490E+00,-0.82537E+00,-0.82584E+00,-0.82631E+00,
- &-0.82678E+00,-0.82726E+00,-0.82773E+00,-0.82820E+00,-0.82868E+00/
-
- DATA (BNC13M(I),I=601,700)/
- &-0.83384E+00,-0.83866E+00,-0.84353E+00,-0.84845E+00,-0.85341E+00,
- &-0.85841E+00,-0.86346E+00,-0.86856E+00,-0.87369E+00,-0.87886E+00,
- &-0.88408E+00,-0.88933E+00,-0.89463E+00,-0.89996E+00,-0.90532E+00,
- &-0.91073E+00,-0.91617E+00,-0.92164E+00,-0.92715E+00,-0.93270E+00,
- &-0.93828E+00,-0.94389E+00,-0.94953E+00,-0.95520E+00,-0.96091E+00,
- &-0.96664E+00,-0.97241E+00,-0.97820E+00,-0.98402E+00,-0.98987E+00,
- &-0.99575E+00,-0.10017E+01,-0.10076E+01,-0.10136E+01,-0.10195E+01,
- &-0.10256E+01,-0.10316E+01,-0.10377E+01,-0.10437E+01,-0.10499E+01,
- &-0.10560E+01,-0.10621E+01,-0.10683E+01,-0.10745E+01,-0.10808E+01,
- &-0.10870E+01,-0.10933E+01,-0.10996E+01,-0.11059E+01,-0.11122E+01,
- &-0.11186E+01,-0.11249E+01,-0.11313E+01,-0.11377E+01,-0.11442E+01,
- &-0.11506E+01,-0.11571E+01,-0.11636E+01,-0.11701E+01,-0.11766E+01,
- &-0.11831E+01,-0.11897E+01,-0.11963E+01,-0.12028E+01,-0.12095E+01,
- &-0.12161E+01,-0.12227E+01,-0.12294E+01,-0.12360E+01,-0.12427E+01,
- &-0.12494E+01,-0.12561E+01,-0.12629E+01,-0.12696E+01,-0.12764E+01,
- &-0.12831E+01,-0.12899E+01,-0.12967E+01,-0.13035E+01,-0.13104E+01,
- &-0.13172E+01,-0.13241E+01,-0.13309E+01,-0.13378E+01,-0.13447E+01,
- &-0.13516E+01,-0.13585E+01,-0.13655E+01,-0.13724E+01,-0.13794E+01,
- &-0.13863E+01,-0.13933E+01,-0.14003E+01,-0.14073E+01,-0.14143E+01,
- &-0.14213E+01,-0.14284E+01,-0.14354E+01,-0.14424E+01,-0.14495E+01/
-
- DATA (BNC13M(I),I=701,741)/
- &-0.14566E+01,-0.14637E+01,-0.14708E+01,-0.14779E+01,-0.14850E+01,
- &-0.14921E+01,-0.14992E+01,-0.15064E+01,-0.15135E+01,-0.15207E+01,
- &-0.15279E+01,-0.15351E+01,-0.15422E+01,-0.15494E+01,-0.15567E+01,
- &-0.15639E+01,-0.15711E+01,-0.15783E+01,-0.15856E+01,-0.15928E+01,
- &-0.16001E+01,-0.16073E+01,-0.16146E+01,-0.16219E+01,-0.16292E+01,
- &-0.16365E+01,-0.16438E+01,-0.16511E+01,-0.16584E+01,-0.16657E+01,
- &-0.16731E+01,-0.16804E+01,-0.16878E+01,-0.16951E+01,-0.17025E+01,
- &-0.17099E+01,-0.17172E+01,-0.17246E+01,-0.17320E+01,-0.17394E+01,
- &-0.17468E+01
- & /
- END
-
diff --git a/src/MNH/data_kmcf223a.f b/src/MNH/data_kmcf223a.f
deleted file mode 100644
index 0679986154228fb4d3c9f210b634f26e75145a9b..0000000000000000000000000000000000000000
--- a/src/MNH/data_kmcf223a.f
+++ /dev/null
@@ -1,2217 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 data_kmcf223a.f 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-C=======================================================================
-C
-C *** ISORROPIA CODE
-C *** BLOCK DATA KMCF223A
-C *** CONTAINS THE DATA FOR KUSSIK-MEISNER BINARY COEFFICIENT ARRAYS
-C NEEDED IN SUBROUTINE KM
-C
-C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
-C *** WRITTEN BY ATHANASIOS NENES
-C
-C=======================================================================
-C
- BLOCK DATA KMCF223
-C
-C *** Common block definition
-C
- COMMON /KMC223/
- &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741),
- &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741),
- &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741),
- &BNC13M( 741)
-C
-C *** NaCl
-C
- DATA (BNC01M(I),I=1,100)/
- &-0.48562E-01,-0.10092E+00,-0.12448E+00,-0.13974E+00,-0.15075E+00,
- &-0.15911E+00,-0.16566E+00,-0.17088E+00,-0.17509E+00,-0.17849E+00,
- &-0.18124E+00,-0.18345E+00,-0.18522E+00,-0.18659E+00,-0.18764E+00,
- &-0.18840E+00,-0.18891E+00,-0.18920E+00,-0.18930E+00,-0.18922E+00,
- &-0.18898E+00,-0.18861E+00,-0.18811E+00,-0.18750E+00,-0.18678E+00,
- &-0.18598E+00,-0.18509E+00,-0.18412E+00,-0.18309E+00,-0.18199E+00,
- &-0.18084E+00,-0.17964E+00,-0.17839E+00,-0.17709E+00,-0.17576E+00,
- &-0.17440E+00,-0.17300E+00,-0.17158E+00,-0.17013E+00,-0.16865E+00,
- &-0.16716E+00,-0.16565E+00,-0.16412E+00,-0.16258E+00,-0.16102E+00,
- &-0.15946E+00,-0.15788E+00,-0.15629E+00,-0.15470E+00,-0.15310E+00,
- &-0.15149E+00,-0.14988E+00,-0.14826E+00,-0.14664E+00,-0.14501E+00,
- &-0.14338E+00,-0.14174E+00,-0.14010E+00,-0.13846E+00,-0.13681E+00,
- &-0.13516E+00,-0.13350E+00,-0.13184E+00,-0.13017E+00,-0.12850E+00,
- &-0.12682E+00,-0.12514E+00,-0.12344E+00,-0.12174E+00,-0.12003E+00,
- &-0.11832E+00,-0.11659E+00,-0.11485E+00,-0.11311E+00,-0.11135E+00,
- &-0.10958E+00,-0.10780E+00,-0.10600E+00,-0.10420E+00,-0.10237E+00,
- &-0.10054E+00,-0.98688E-01,-0.96823E-01,-0.94943E-01,-0.93048E-01,
- &-0.91136E-01,-0.89209E-01,-0.87266E-01,-0.85307E-01,-0.83332E-01,
- &-0.81341E-01,-0.79334E-01,-0.77312E-01,-0.75274E-01,-0.73220E-01,
- &-0.71151E-01,-0.69068E-01,-0.66970E-01,-0.64858E-01,-0.62732E-01/
-
- DATA (BNC01M(I),I=101,200)/
- &-0.60593E-01,-0.58441E-01,-0.56277E-01,-0.54101E-01,-0.51914E-01,
- &-0.49716E-01,-0.47508E-01,-0.45291E-01,-0.43064E-01,-0.40828E-01,
- &-0.38585E-01,-0.36334E-01,-0.34076E-01,-0.31812E-01,-0.29542E-01,
- &-0.27266E-01,-0.24986E-01,-0.22701E-01,-0.20412E-01,-0.18120E-01,
- &-0.15825E-01,-0.13526E-01,-0.11226E-01,-0.89235E-02,-0.66195E-02,
- &-0.43141E-02,-0.20079E-02, 0.29912E-03, 0.26064E-02, 0.49139E-02,
- & 0.72212E-02, 0.95283E-02, 0.11835E-01, 0.14140E-01, 0.16445E-01,
- & 0.18749E-01, 0.21052E-01, 0.23353E-01, 0.25652E-01, 0.27950E-01,
- & 0.30246E-01, 0.32540E-01, 0.34833E-01, 0.37123E-01, 0.39411E-01,
- & 0.41697E-01, 0.43980E-01, 0.46261E-01, 0.48540E-01, 0.50816E-01,
- & 0.53090E-01, 0.55361E-01, 0.57630E-01, 0.59895E-01, 0.62158E-01,
- & 0.64419E-01, 0.66676E-01, 0.68931E-01, 0.71182E-01, 0.73431E-01,
- & 0.75677E-01, 0.77920E-01, 0.80160E-01, 0.82397E-01, 0.84631E-01,
- & 0.86861E-01, 0.89089E-01, 0.91314E-01, 0.93535E-01, 0.95754E-01,
- & 0.97969E-01, 0.10018E+00, 0.10239E+00, 0.10459E+00, 0.10680E+00,
- & 0.10900E+00, 0.11119E+00, 0.11338E+00, 0.11557E+00, 0.11776E+00,
- & 0.11994E+00, 0.12212E+00, 0.12430E+00, 0.12647E+00, 0.12864E+00,
- & 0.13080E+00, 0.13297E+00, 0.13512E+00, 0.13728E+00, 0.13943E+00,
- & 0.14158E+00, 0.14373E+00, 0.14587E+00, 0.14801E+00, 0.15014E+00,
- & 0.15227E+00, 0.15440E+00, 0.15652E+00, 0.15864E+00, 0.16076E+00/
-
- DATA (BNC01M(I),I=201,300)/
- & 0.16288E+00, 0.16499E+00, 0.16709E+00, 0.16920E+00, 0.17129E+00,
- & 0.17339E+00, 0.17548E+00, 0.17757E+00, 0.17966E+00, 0.18174E+00,
- & 0.18382E+00, 0.18589E+00, 0.18796E+00, 0.19003E+00, 0.19210E+00,
- & 0.19416E+00, 0.19621E+00, 0.19827E+00, 0.20032E+00, 0.20236E+00,
- & 0.20441E+00, 0.20644E+00, 0.20848E+00, 0.21051E+00, 0.21254E+00,
- & 0.21457E+00, 0.21659E+00, 0.21860E+00, 0.22062E+00, 0.22263E+00,
- & 0.22464E+00, 0.22664E+00, 0.22864E+00, 0.23064E+00, 0.23263E+00,
- & 0.23462E+00, 0.23660E+00, 0.23859E+00, 0.24056E+00, 0.24254E+00,
- & 0.24451E+00, 0.24648E+00, 0.24844E+00, 0.25040E+00, 0.25236E+00,
- & 0.25431E+00, 0.25627E+00, 0.25821E+00, 0.26015E+00, 0.26209E+00,
- & 0.26403E+00, 0.26596E+00, 0.26789E+00, 0.26982E+00, 0.27174E+00,
- & 0.27366E+00, 0.27557E+00, 0.27748E+00, 0.27939E+00, 0.28130E+00,
- & 0.28320E+00, 0.28510E+00, 0.28699E+00, 0.28888E+00, 0.29077E+00,
- & 0.29265E+00, 0.29453E+00, 0.29641E+00, 0.29828E+00, 0.30015E+00,
- & 0.30202E+00, 0.30388E+00, 0.30574E+00, 0.30760E+00, 0.30945E+00,
- & 0.31130E+00, 0.31314E+00, 0.31499E+00, 0.31683E+00, 0.31866E+00,
- & 0.32049E+00, 0.32232E+00, 0.32415E+00, 0.32597E+00, 0.32779E+00,
- & 0.32961E+00, 0.33142E+00, 0.33323E+00, 0.33503E+00, 0.33683E+00,
- & 0.33863E+00, 0.34043E+00, 0.34222E+00, 0.34401E+00, 0.34579E+00,
- & 0.34758E+00, 0.34936E+00, 0.35113E+00, 0.35290E+00, 0.35467E+00/
-
- DATA (BNC01M(I),I=301,400)/
- & 0.35644E+00, 0.35820E+00, 0.35996E+00, 0.36172E+00, 0.36347E+00,
- & 0.36522E+00, 0.36696E+00, 0.36871E+00, 0.37045E+00, 0.37218E+00,
- & 0.37392E+00, 0.37565E+00, 0.37737E+00, 0.37910E+00, 0.38082E+00,
- & 0.38254E+00, 0.38425E+00, 0.38596E+00, 0.38767E+00, 0.38937E+00,
- & 0.39108E+00, 0.39277E+00, 0.39447E+00, 0.39616E+00, 0.39785E+00,
- & 0.39954E+00, 0.40122E+00, 0.40290E+00, 0.40458E+00, 0.40625E+00,
- & 0.40792E+00, 0.40959E+00, 0.41125E+00, 0.41291E+00, 0.41457E+00,
- & 0.41623E+00, 0.41788E+00, 0.41953E+00, 0.42117E+00, 0.42281E+00,
- & 0.42445E+00, 0.42609E+00, 0.42773E+00, 0.42936E+00, 0.43098E+00,
- & 0.43261E+00, 0.43423E+00, 0.43585E+00, 0.43747E+00, 0.43908E+00,
- & 0.44069E+00, 0.44230E+00, 0.44390E+00, 0.44550E+00, 0.44710E+00,
- & 0.44869E+00, 0.45029E+00, 0.45188E+00, 0.45346E+00, 0.45505E+00,
- & 0.45663E+00, 0.45820E+00, 0.45978E+00, 0.46135E+00, 0.46292E+00,
- & 0.46449E+00, 0.46605E+00, 0.46761E+00, 0.46917E+00, 0.47072E+00,
- & 0.47228E+00, 0.47383E+00, 0.47537E+00, 0.47692E+00, 0.47846E+00,
- & 0.47999E+00, 0.48153E+00, 0.48306E+00, 0.48459E+00, 0.48612E+00,
- & 0.48764E+00, 0.48916E+00, 0.49068E+00, 0.49220E+00, 0.49371E+00,
- & 0.49522E+00, 0.49673E+00, 0.49824E+00, 0.49974E+00, 0.50124E+00,
- & 0.50273E+00, 0.50423E+00, 0.50572E+00, 0.50721E+00, 0.50869E+00,
- & 0.51018E+00, 0.51166E+00, 0.51314E+00, 0.51461E+00, 0.51608E+00/
-
- DATA (BNC01M(I),I=401,500)/
- & 0.51755E+00, 0.51902E+00, 0.52049E+00, 0.52195E+00, 0.52341E+00,
- & 0.52487E+00, 0.52632E+00, 0.52777E+00, 0.52922E+00, 0.53067E+00,
- & 0.53211E+00, 0.53355E+00, 0.53499E+00, 0.53643E+00, 0.53786E+00,
- & 0.53929E+00, 0.54072E+00, 0.54215E+00, 0.54357E+00, 0.54499E+00,
- & 0.54641E+00, 0.54782E+00, 0.54924E+00, 0.55065E+00, 0.55206E+00,
- & 0.55346E+00, 0.55487E+00, 0.55627E+00, 0.55767E+00, 0.55906E+00,
- & 0.56046E+00, 0.56185E+00, 0.56323E+00, 0.56462E+00, 0.56600E+00,
- & 0.56739E+00, 0.56876E+00, 0.57014E+00, 0.57151E+00, 0.57289E+00,
- & 0.57425E+00, 0.57562E+00, 0.57699E+00, 0.57835E+00, 0.57971E+00,
- & 0.58106E+00, 0.58242E+00, 0.58377E+00, 0.58512E+00, 0.58647E+00,
- & 0.58781E+00, 0.58916E+00, 0.59050E+00, 0.59183E+00, 0.59317E+00,
- & 0.59450E+00, 0.59583E+00, 0.59716E+00, 0.59849E+00, 0.59981E+00,
- & 0.60114E+00, 0.60245E+00, 0.60377E+00, 0.60509E+00, 0.60640E+00,
- & 0.60771E+00, 0.60902E+00, 0.61032E+00, 0.61163E+00, 0.61293E+00,
- & 0.61423E+00, 0.61552E+00, 0.61682E+00, 0.61811E+00, 0.61940E+00,
- & 0.62069E+00, 0.62198E+00, 0.62326E+00, 0.62454E+00, 0.62582E+00,
- & 0.62710E+00, 0.62837E+00, 0.62964E+00, 0.63091E+00, 0.63218E+00,
- & 0.63345E+00, 0.63471E+00, 0.63597E+00, 0.63723E+00, 0.63849E+00,
- & 0.63974E+00, 0.64100E+00, 0.64225E+00, 0.64350E+00, 0.64474E+00,
- & 0.64599E+00, 0.64723E+00, 0.64847E+00, 0.64971E+00, 0.65094E+00/
-
- DATA (BNC01M(I),I=501,600)/
- & 0.65218E+00, 0.65341E+00, 0.65464E+00, 0.65586E+00, 0.65709E+00,
- & 0.65831E+00, 0.65953E+00, 0.66075E+00, 0.66197E+00, 0.66318E+00,
- & 0.66440E+00, 0.66561E+00, 0.66682E+00, 0.66802E+00, 0.66923E+00,
- & 0.67043E+00, 0.67163E+00, 0.67283E+00, 0.67403E+00, 0.67522E+00,
- & 0.67641E+00, 0.67760E+00, 0.67879E+00, 0.67998E+00, 0.68116E+00,
- & 0.68235E+00, 0.68353E+00, 0.68471E+00, 0.68588E+00, 0.68706E+00,
- & 0.68823E+00, 0.68940E+00, 0.69057E+00, 0.69174E+00, 0.69290E+00,
- & 0.69406E+00, 0.69523E+00, 0.69638E+00, 0.69754E+00, 0.69870E+00,
- & 0.69985E+00, 0.70100E+00, 0.70215E+00, 0.70330E+00, 0.70444E+00,
- & 0.70559E+00, 0.70673E+00, 0.70787E+00, 0.70901E+00, 0.71014E+00,
- & 0.71128E+00, 0.71241E+00, 0.71354E+00, 0.71467E+00, 0.71579E+00,
- & 0.71692E+00, 0.71804E+00, 0.71916E+00, 0.72028E+00, 0.72140E+00,
- & 0.72252E+00, 0.72363E+00, 0.72474E+00, 0.72585E+00, 0.72696E+00,
- & 0.72807E+00, 0.72917E+00, 0.73027E+00, 0.73137E+00, 0.73247E+00,
- & 0.73357E+00, 0.73467E+00, 0.73576E+00, 0.73685E+00, 0.73794E+00,
- & 0.73903E+00, 0.74012E+00, 0.74120E+00, 0.74228E+00, 0.74337E+00,
- & 0.74444E+00, 0.74552E+00, 0.74660E+00, 0.74767E+00, 0.74875E+00,
- & 0.74982E+00, 0.75088E+00, 0.75195E+00, 0.75302E+00, 0.75408E+00,
- & 0.75514E+00, 0.75620E+00, 0.75726E+00, 0.75832E+00, 0.75937E+00,
- & 0.76043E+00, 0.76148E+00, 0.76253E+00, 0.76358E+00, 0.76462E+00/
-
- DATA (BNC01M(I),I=601,700)/
- & 0.77583E+00, 0.78602E+00, 0.79605E+00, 0.80593E+00, 0.81565E+00,
- & 0.82522E+00, 0.83463E+00, 0.84391E+00, 0.85304E+00, 0.86203E+00,
- & 0.87088E+00, 0.87959E+00, 0.88818E+00, 0.89663E+00, 0.90496E+00,
- & 0.91316E+00, 0.92124E+00, 0.92920E+00, 0.93704E+00, 0.94477E+00,
- & 0.95238E+00, 0.95988E+00, 0.96727E+00, 0.97455E+00, 0.98173E+00,
- & 0.98880E+00, 0.99577E+00, 0.10026E+01, 0.10094E+01, 0.10161E+01,
- & 0.10227E+01, 0.10292E+01, 0.10355E+01, 0.10418E+01, 0.10481E+01,
- & 0.10542E+01, 0.10602E+01, 0.10662E+01, 0.10721E+01, 0.10778E+01,
- & 0.10835E+01, 0.10892E+01, 0.10947E+01, 0.11002E+01, 0.11056E+01,
- & 0.11109E+01, 0.11162E+01, 0.11213E+01, 0.11264E+01, 0.11315E+01,
- & 0.11364E+01, 0.11413E+01, 0.11462E+01, 0.11509E+01, 0.11556E+01,
- & 0.11603E+01, 0.11648E+01, 0.11693E+01, 0.11738E+01, 0.11782E+01,
- & 0.11825E+01, 0.11867E+01, 0.11909E+01, 0.11951E+01, 0.11992E+01,
- & 0.12032E+01, 0.12072E+01, 0.12111E+01, 0.12150E+01, 0.12188E+01,
- & 0.12226E+01, 0.12263E+01, 0.12299E+01, 0.12335E+01, 0.12371E+01,
- & 0.12406E+01, 0.12441E+01, 0.12475E+01, 0.12508E+01, 0.12542E+01,
- & 0.12574E+01, 0.12607E+01, 0.12638E+01, 0.12670E+01, 0.12701E+01,
- & 0.12731E+01, 0.12761E+01, 0.12791E+01, 0.12820E+01, 0.12849E+01,
- & 0.12877E+01, 0.12905E+01, 0.12933E+01, 0.12960E+01, 0.12987E+01,
- & 0.13013E+01, 0.13039E+01, 0.13065E+01, 0.13090E+01, 0.13115E+01/
-
- DATA (BNC01M(I),I=701,741)/
- & 0.13139E+01, 0.13163E+01, 0.13187E+01, 0.13211E+01, 0.13234E+01,
- & 0.13256E+01, 0.13279E+01, 0.13301E+01, 0.13323E+01, 0.13344E+01,
- & 0.13365E+01, 0.13386E+01, 0.13406E+01, 0.13426E+01, 0.13446E+01,
- & 0.13465E+01, 0.13485E+01, 0.13503E+01, 0.13522E+01, 0.13540E+01,
- & 0.13558E+01, 0.13576E+01, 0.13593E+01, 0.13610E+01, 0.13627E+01,
- & 0.13643E+01, 0.13660E+01, 0.13675E+01, 0.13691E+01, 0.13706E+01,
- & 0.13722E+01, 0.13736E+01, 0.13751E+01, 0.13765E+01, 0.13779E+01,
- & 0.13793E+01, 0.13807E+01, 0.13820E+01, 0.13833E+01, 0.13846E+01,
- & 0.13858E+01
- & /
-C
-C *** Na2SO4
-C
- DATA (BNC02M(I),I=1,100)/
- &-0.10044E+00,-0.21963E+00,-0.27984E+00,-0.32277E+00,-0.35672E+00,
- &-0.38502E+00,-0.40943E+00,-0.43096E+00,-0.45026E+00,-0.46780E+00,
- &-0.48389E+00,-0.49877E+00,-0.51264E+00,-0.52563E+00,-0.53787E+00,
- &-0.54943E+00,-0.56041E+00,-0.57086E+00,-0.58084E+00,-0.59040E+00,
- &-0.59957E+00,-0.60840E+00,-0.61689E+00,-0.62510E+00,-0.63303E+00,
- &-0.64071E+00,-0.64816E+00,-0.65538E+00,-0.66241E+00,-0.66924E+00,
- &-0.67590E+00,-0.68239E+00,-0.68872E+00,-0.69490E+00,-0.70094E+00,
- &-0.70684E+00,-0.71262E+00,-0.71828E+00,-0.72382E+00,-0.72926E+00,
- &-0.73459E+00,-0.73982E+00,-0.74495E+00,-0.75000E+00,-0.75496E+00,
- &-0.75983E+00,-0.76463E+00,-0.76935E+00,-0.77399E+00,-0.77856E+00,
- &-0.78307E+00,-0.78751E+00,-0.79188E+00,-0.79620E+00,-0.80045E+00,
- &-0.80465E+00,-0.80880E+00,-0.81289E+00,-0.81693E+00,-0.82093E+00,
- &-0.82487E+00,-0.82877E+00,-0.83263E+00,-0.83644E+00,-0.84021E+00,
- &-0.84394E+00,-0.84763E+00,-0.85129E+00,-0.85491E+00,-0.85849E+00,
- &-0.86204E+00,-0.86556E+00,-0.86905E+00,-0.87250E+00,-0.87593E+00,
- &-0.87932E+00,-0.88269E+00,-0.88604E+00,-0.88935E+00,-0.89264E+00,
- &-0.89591E+00,-0.89915E+00,-0.90237E+00,-0.90557E+00,-0.90875E+00,
- &-0.91190E+00,-0.91503E+00,-0.91815E+00,-0.92124E+00,-0.92432E+00,
- &-0.92737E+00,-0.93041E+00,-0.93343E+00,-0.93644E+00,-0.93942E+00,
- &-0.94239E+00,-0.94534E+00,-0.94828E+00,-0.95120E+00,-0.95411E+00/
-
- DATA (BNC02M(I),I=101,200)/
- &-0.95700E+00,-0.95988E+00,-0.96274E+00,-0.96559E+00,-0.96842E+00,
- &-0.97124E+00,-0.97405E+00,-0.97684E+00,-0.97962E+00,-0.98239E+00,
- &-0.98514E+00,-0.98788E+00,-0.99061E+00,-0.99333E+00,-0.99603E+00,
- &-0.99872E+00,-0.10014E+01,-0.10041E+01,-0.10067E+01,-0.10094E+01,
- &-0.10120E+01,-0.10146E+01,-0.10172E+01,-0.10198E+01,-0.10224E+01,
- &-0.10250E+01,-0.10276E+01,-0.10301E+01,-0.10327E+01,-0.10352E+01,
- &-0.10377E+01,-0.10402E+01,-0.10427E+01,-0.10452E+01,-0.10477E+01,
- &-0.10502E+01,-0.10527E+01,-0.10551E+01,-0.10576E+01,-0.10600E+01,
- &-0.10624E+01,-0.10649E+01,-0.10673E+01,-0.10697E+01,-0.10721E+01,
- &-0.10745E+01,-0.10768E+01,-0.10792E+01,-0.10816E+01,-0.10839E+01,
- &-0.10863E+01,-0.10886E+01,-0.10909E+01,-0.10933E+01,-0.10956E+01,
- &-0.10979E+01,-0.11002E+01,-0.11025E+01,-0.11048E+01,-0.11070E+01,
- &-0.11093E+01,-0.11116E+01,-0.11138E+01,-0.11161E+01,-0.11183E+01,
- &-0.11206E+01,-0.11228E+01,-0.11250E+01,-0.11272E+01,-0.11294E+01,
- &-0.11316E+01,-0.11338E+01,-0.11360E+01,-0.11382E+01,-0.11404E+01,
- &-0.11426E+01,-0.11447E+01,-0.11469E+01,-0.11490E+01,-0.11512E+01,
- &-0.11533E+01,-0.11555E+01,-0.11576E+01,-0.11597E+01,-0.11618E+01,
- &-0.11640E+01,-0.11661E+01,-0.11682E+01,-0.11703E+01,-0.11724E+01,
- &-0.11745E+01,-0.11765E+01,-0.11786E+01,-0.11807E+01,-0.11828E+01,
- &-0.11848E+01,-0.11869E+01,-0.11889E+01,-0.11910E+01,-0.11930E+01/
-
- DATA (BNC02M(I),I=201,300)/
- &-0.11951E+01,-0.11971E+01,-0.11991E+01,-0.12012E+01,-0.12032E+01,
- &-0.12052E+01,-0.12072E+01,-0.12092E+01,-0.12112E+01,-0.12132E+01,
- &-0.12152E+01,-0.12172E+01,-0.12192E+01,-0.12212E+01,-0.12232E+01,
- &-0.12251E+01,-0.12271E+01,-0.12291E+01,-0.12310E+01,-0.12330E+01,
- &-0.12349E+01,-0.12369E+01,-0.12388E+01,-0.12408E+01,-0.12427E+01,
- &-0.12446E+01,-0.12466E+01,-0.12485E+01,-0.12504E+01,-0.12523E+01,
- &-0.12543E+01,-0.12562E+01,-0.12581E+01,-0.12600E+01,-0.12619E+01,
- &-0.12638E+01,-0.12657E+01,-0.12676E+01,-0.12694E+01,-0.12713E+01,
- &-0.12732E+01,-0.12751E+01,-0.12770E+01,-0.12788E+01,-0.12807E+01,
- &-0.12826E+01,-0.12844E+01,-0.12863E+01,-0.12881E+01,-0.12900E+01,
- &-0.12918E+01,-0.12937E+01,-0.12955E+01,-0.12973E+01,-0.12992E+01,
- &-0.13010E+01,-0.13028E+01,-0.13047E+01,-0.13065E+01,-0.13083E+01,
- &-0.13101E+01,-0.13119E+01,-0.13138E+01,-0.13156E+01,-0.13174E+01,
- &-0.13192E+01,-0.13210E+01,-0.13228E+01,-0.13246E+01,-0.13263E+01,
- &-0.13281E+01,-0.13299E+01,-0.13317E+01,-0.13335E+01,-0.13353E+01,
- &-0.13370E+01,-0.13388E+01,-0.13406E+01,-0.13423E+01,-0.13441E+01,
- &-0.13459E+01,-0.13476E+01,-0.13494E+01,-0.13511E+01,-0.13529E+01,
- &-0.13546E+01,-0.13564E+01,-0.13581E+01,-0.13599E+01,-0.13616E+01,
- &-0.13633E+01,-0.13651E+01,-0.13668E+01,-0.13685E+01,-0.13703E+01,
- &-0.13720E+01,-0.13737E+01,-0.13754E+01,-0.13772E+01,-0.13789E+01/
-
- DATA (BNC02M(I),I=301,400)/
- &-0.13806E+01,-0.13823E+01,-0.13840E+01,-0.13857E+01,-0.13874E+01,
- &-0.13891E+01,-0.13908E+01,-0.13925E+01,-0.13942E+01,-0.13959E+01,
- &-0.13976E+01,-0.13993E+01,-0.14010E+01,-0.14027E+01,-0.14043E+01,
- &-0.14060E+01,-0.14077E+01,-0.14094E+01,-0.14111E+01,-0.14127E+01,
- &-0.14144E+01,-0.14161E+01,-0.14177E+01,-0.14194E+01,-0.14211E+01,
- &-0.14227E+01,-0.14244E+01,-0.14260E+01,-0.14277E+01,-0.14293E+01,
- &-0.14310E+01,-0.14326E+01,-0.14343E+01,-0.14359E+01,-0.14376E+01,
- &-0.14392E+01,-0.14409E+01,-0.14425E+01,-0.14441E+01,-0.14458E+01,
- &-0.14474E+01,-0.14490E+01,-0.14506E+01,-0.14523E+01,-0.14539E+01,
- &-0.14555E+01,-0.14571E+01,-0.14588E+01,-0.14604E+01,-0.14620E+01,
- &-0.14636E+01,-0.14652E+01,-0.14668E+01,-0.14684E+01,-0.14700E+01,
- &-0.14717E+01,-0.14733E+01,-0.14749E+01,-0.14765E+01,-0.14781E+01,
- &-0.14797E+01,-0.14813E+01,-0.14828E+01,-0.14844E+01,-0.14860E+01,
- &-0.14876E+01,-0.14892E+01,-0.14908E+01,-0.14924E+01,-0.14940E+01,
- &-0.14955E+01,-0.14971E+01,-0.14987E+01,-0.15003E+01,-0.15018E+01,
- &-0.15034E+01,-0.15050E+01,-0.15066E+01,-0.15081E+01,-0.15097E+01,
- &-0.15113E+01,-0.15128E+01,-0.15144E+01,-0.15160E+01,-0.15175E+01,
- &-0.15191E+01,-0.15206E+01,-0.15222E+01,-0.15237E+01,-0.15253E+01,
- &-0.15268E+01,-0.15284E+01,-0.15299E+01,-0.15315E+01,-0.15330E+01,
- &-0.15346E+01,-0.15361E+01,-0.15377E+01,-0.15392E+01,-0.15407E+01/
-
- DATA (BNC02M(I),I=401,500)/
- &-0.15423E+01,-0.15438E+01,-0.15453E+01,-0.15469E+01,-0.15484E+01,
- &-0.15499E+01,-0.15515E+01,-0.15530E+01,-0.15545E+01,-0.15561E+01,
- &-0.15576E+01,-0.15591E+01,-0.15606E+01,-0.15621E+01,-0.15637E+01,
- &-0.15652E+01,-0.15667E+01,-0.15682E+01,-0.15697E+01,-0.15712E+01,
- &-0.15727E+01,-0.15743E+01,-0.15758E+01,-0.15773E+01,-0.15788E+01,
- &-0.15803E+01,-0.15818E+01,-0.15833E+01,-0.15848E+01,-0.15863E+01,
- &-0.15878E+01,-0.15893E+01,-0.15908E+01,-0.15923E+01,-0.15938E+01,
- &-0.15953E+01,-0.15968E+01,-0.15982E+01,-0.15997E+01,-0.16012E+01,
- &-0.16027E+01,-0.16042E+01,-0.16057E+01,-0.16072E+01,-0.16086E+01,
- &-0.16101E+01,-0.16116E+01,-0.16131E+01,-0.16146E+01,-0.16160E+01,
- &-0.16175E+01,-0.16190E+01,-0.16205E+01,-0.16219E+01,-0.16234E+01,
- &-0.16249E+01,-0.16263E+01,-0.16278E+01,-0.16293E+01,-0.16307E+01,
- &-0.16322E+01,-0.16337E+01,-0.16351E+01,-0.16366E+01,-0.16381E+01,
- &-0.16395E+01,-0.16410E+01,-0.16424E+01,-0.16439E+01,-0.16453E+01,
- &-0.16468E+01,-0.16482E+01,-0.16497E+01,-0.16512E+01,-0.16526E+01,
- &-0.16541E+01,-0.16555E+01,-0.16569E+01,-0.16584E+01,-0.16598E+01,
- &-0.16613E+01,-0.16627E+01,-0.16642E+01,-0.16656E+01,-0.16670E+01,
- &-0.16685E+01,-0.16699E+01,-0.16714E+01,-0.16728E+01,-0.16742E+01,
- &-0.16757E+01,-0.16771E+01,-0.16785E+01,-0.16800E+01,-0.16814E+01,
- &-0.16828E+01,-0.16843E+01,-0.16857E+01,-0.16871E+01,-0.16885E+01/
-
- DATA (BNC02M(I),I=501,600)/
- &-0.16900E+01,-0.16914E+01,-0.16928E+01,-0.16942E+01,-0.16957E+01,
- &-0.16971E+01,-0.16985E+01,-0.16999E+01,-0.17013E+01,-0.17027E+01,
- &-0.17042E+01,-0.17056E+01,-0.17070E+01,-0.17084E+01,-0.17098E+01,
- &-0.17112E+01,-0.17126E+01,-0.17140E+01,-0.17155E+01,-0.17169E+01,
- &-0.17183E+01,-0.17197E+01,-0.17211E+01,-0.17225E+01,-0.17239E+01,
- &-0.17253E+01,-0.17267E+01,-0.17281E+01,-0.17295E+01,-0.17309E+01,
- &-0.17323E+01,-0.17337E+01,-0.17351E+01,-0.17365E+01,-0.17379E+01,
- &-0.17393E+01,-0.17407E+01,-0.17421E+01,-0.17435E+01,-0.17448E+01,
- &-0.17462E+01,-0.17476E+01,-0.17490E+01,-0.17504E+01,-0.17518E+01,
- &-0.17532E+01,-0.17546E+01,-0.17559E+01,-0.17573E+01,-0.17587E+01,
- &-0.17601E+01,-0.17615E+01,-0.17629E+01,-0.17642E+01,-0.17656E+01,
- &-0.17670E+01,-0.17684E+01,-0.17698E+01,-0.17711E+01,-0.17725E+01,
- &-0.17739E+01,-0.17753E+01,-0.17766E+01,-0.17780E+01,-0.17794E+01,
- &-0.17807E+01,-0.17821E+01,-0.17835E+01,-0.17848E+01,-0.17862E+01,
- &-0.17876E+01,-0.17889E+01,-0.17903E+01,-0.17917E+01,-0.17930E+01,
- &-0.17944E+01,-0.17958E+01,-0.17971E+01,-0.17985E+01,-0.17999E+01,
- &-0.18012E+01,-0.18026E+01,-0.18039E+01,-0.18053E+01,-0.18067E+01,
- &-0.18080E+01,-0.18094E+01,-0.18107E+01,-0.18121E+01,-0.18134E+01,
- &-0.18148E+01,-0.18161E+01,-0.18175E+01,-0.18188E+01,-0.18202E+01,
- &-0.18215E+01,-0.18229E+01,-0.18242E+01,-0.18256E+01,-0.18269E+01/
-
- DATA (BNC02M(I),I=601,700)/
- &-0.18414E+01,-0.18548E+01,-0.18681E+01,-0.18813E+01,-0.18945E+01,
- &-0.19076E+01,-0.19207E+01,-0.19337E+01,-0.19467E+01,-0.19596E+01,
- &-0.19724E+01,-0.19852E+01,-0.19980E+01,-0.20107E+01,-0.20233E+01,
- &-0.20359E+01,-0.20485E+01,-0.20610E+01,-0.20735E+01,-0.20859E+01,
- &-0.20983E+01,-0.21107E+01,-0.21230E+01,-0.21353E+01,-0.21475E+01,
- &-0.21598E+01,-0.21719E+01,-0.21841E+01,-0.21962E+01,-0.22082E+01,
- &-0.22203E+01,-0.22323E+01,-0.22442E+01,-0.22562E+01,-0.22681E+01,
- &-0.22800E+01,-0.22918E+01,-0.23036E+01,-0.23154E+01,-0.23272E+01,
- &-0.23389E+01,-0.23506E+01,-0.23623E+01,-0.23740E+01,-0.23856E+01,
- &-0.23972E+01,-0.24088E+01,-0.24204E+01,-0.24319E+01,-0.24434E+01,
- &-0.24549E+01,-0.24663E+01,-0.24778E+01,-0.24892E+01,-0.25006E+01,
- &-0.25119E+01,-0.25233E+01,-0.25346E+01,-0.25459E+01,-0.25572E+01,
- &-0.25685E+01,-0.25797E+01,-0.25910E+01,-0.26022E+01,-0.26134E+01,
- &-0.26245E+01,-0.26357E+01,-0.26468E+01,-0.26579E+01,-0.26690E+01,
- &-0.26801E+01,-0.26912E+01,-0.27022E+01,-0.27132E+01,-0.27242E+01,
- &-0.27352E+01,-0.27462E+01,-0.27572E+01,-0.27681E+01,-0.27790E+01,
- &-0.27900E+01,-0.28009E+01,-0.28117E+01,-0.28226E+01,-0.28335E+01,
- &-0.28443E+01,-0.28551E+01,-0.28659E+01,-0.28767E+01,-0.28875E+01,
- &-0.28983E+01,-0.29090E+01,-0.29198E+01,-0.29305E+01,-0.29412E+01,
- &-0.29519E+01,-0.29626E+01,-0.29733E+01,-0.29839E+01,-0.29946E+01/
-
- DATA (BNC02M(I),I=701,741)/
- &-0.30052E+01,-0.30158E+01,-0.30264E+01,-0.30370E+01,-0.30476E+01,
- &-0.30582E+01,-0.30688E+01,-0.30793E+01,-0.30899E+01,-0.31004E+01,
- &-0.31109E+01,-0.31214E+01,-0.31319E+01,-0.31424E+01,-0.31529E+01,
- &-0.31633E+01,-0.31738E+01,-0.31842E+01,-0.31946E+01,-0.32051E+01,
- &-0.32155E+01,-0.32259E+01,-0.32363E+01,-0.32466E+01,-0.32570E+01,
- &-0.32674E+01,-0.32777E+01,-0.32881E+01,-0.32984E+01,-0.33087E+01,
- &-0.33190E+01,-0.33293E+01,-0.33396E+01,-0.33499E+01,-0.33602E+01,
- &-0.33705E+01,-0.33807E+01,-0.33910E+01,-0.34012E+01,-0.34114E+01,
- &-0.34217E+01
- & /
-C
-C *** NaNO3
-C
- DATA (BNC03M(I),I=1,100)/
- &-0.50377E-01,-0.11068E+00,-0.14143E+00,-0.16351E+00,-0.18108E+00,
- &-0.19581E+00,-0.20858E+00,-0.21990E+00,-0.23009E+00,-0.23939E+00,
- &-0.24796E+00,-0.25592E+00,-0.26337E+00,-0.27037E+00,-0.27698E+00,
- &-0.28326E+00,-0.28923E+00,-0.29494E+00,-0.30041E+00,-0.30566E+00,
- &-0.31071E+00,-0.31558E+00,-0.32029E+00,-0.32484E+00,-0.32925E+00,
- &-0.33353E+00,-0.33769E+00,-0.34174E+00,-0.34568E+00,-0.34952E+00,
- &-0.35327E+00,-0.35692E+00,-0.36050E+00,-0.36399E+00,-0.36741E+00,
- &-0.37076E+00,-0.37405E+00,-0.37726E+00,-0.38042E+00,-0.38352E+00,
- &-0.38656E+00,-0.38955E+00,-0.39248E+00,-0.39537E+00,-0.39821E+00,
- &-0.40100E+00,-0.40375E+00,-0.40646E+00,-0.40912E+00,-0.41175E+00,
- &-0.41434E+00,-0.41690E+00,-0.41942E+00,-0.42190E+00,-0.42435E+00,
- &-0.42677E+00,-0.42917E+00,-0.43153E+00,-0.43386E+00,-0.43617E+00,
- &-0.43845E+00,-0.44070E+00,-0.44293E+00,-0.44514E+00,-0.44732E+00,
- &-0.44949E+00,-0.45163E+00,-0.45375E+00,-0.45585E+00,-0.45793E+00,
- &-0.45999E+00,-0.46204E+00,-0.46407E+00,-0.46608E+00,-0.46808E+00,
- &-0.47006E+00,-0.47203E+00,-0.47398E+00,-0.47592E+00,-0.47785E+00,
- &-0.47976E+00,-0.48167E+00,-0.48356E+00,-0.48543E+00,-0.48730E+00,
- &-0.48916E+00,-0.49100E+00,-0.49284E+00,-0.49467E+00,-0.49648E+00,
- &-0.49829E+00,-0.50009E+00,-0.50188E+00,-0.50366E+00,-0.50543E+00,
- &-0.50719E+00,-0.50895E+00,-0.51070E+00,-0.51244E+00,-0.51417E+00/
-
- DATA (BNC03M(I),I=101,200)/
- &-0.51590E+00,-0.51761E+00,-0.51932E+00,-0.52103E+00,-0.52272E+00,
- &-0.52441E+00,-0.52609E+00,-0.52777E+00,-0.52944E+00,-0.53110E+00,
- &-0.53275E+00,-0.53440E+00,-0.53604E+00,-0.53767E+00,-0.53930E+00,
- &-0.54092E+00,-0.54254E+00,-0.54414E+00,-0.54575E+00,-0.54734E+00,
- &-0.54893E+00,-0.55051E+00,-0.55209E+00,-0.55366E+00,-0.55522E+00,
- &-0.55678E+00,-0.55833E+00,-0.55988E+00,-0.56142E+00,-0.56295E+00,
- &-0.56448E+00,-0.56600E+00,-0.56752E+00,-0.56903E+00,-0.57053E+00,
- &-0.57203E+00,-0.57352E+00,-0.57501E+00,-0.57649E+00,-0.57797E+00,
- &-0.57944E+00,-0.58091E+00,-0.58237E+00,-0.58383E+00,-0.58528E+00,
- &-0.58672E+00,-0.58816E+00,-0.58960E+00,-0.59103E+00,-0.59246E+00,
- &-0.59388E+00,-0.59529E+00,-0.59671E+00,-0.59811E+00,-0.59952E+00,
- &-0.60091E+00,-0.60231E+00,-0.60370E+00,-0.60508E+00,-0.60646E+00,
- &-0.60784E+00,-0.60921E+00,-0.61058E+00,-0.61194E+00,-0.61330E+00,
- &-0.61465E+00,-0.61600E+00,-0.61735E+00,-0.61869E+00,-0.62003E+00,
- &-0.62137E+00,-0.62270E+00,-0.62402E+00,-0.62535E+00,-0.62667E+00,
- &-0.62798E+00,-0.62930E+00,-0.63060E+00,-0.63191E+00,-0.63321E+00,
- &-0.63451E+00,-0.63580E+00,-0.63709E+00,-0.63838E+00,-0.63966E+00,
- &-0.64094E+00,-0.64222E+00,-0.64349E+00,-0.64476E+00,-0.64603E+00,
- &-0.64730E+00,-0.64856E+00,-0.64981E+00,-0.65107E+00,-0.65232E+00,
- &-0.65357E+00,-0.65481E+00,-0.65605E+00,-0.65729E+00,-0.65853E+00/
-
- DATA (BNC03M(I),I=201,300)/
- &-0.65976E+00,-0.66099E+00,-0.66222E+00,-0.66344E+00,-0.66466E+00,
- &-0.66588E+00,-0.66710E+00,-0.66831E+00,-0.66952E+00,-0.67072E+00,
- &-0.67193E+00,-0.67313E+00,-0.67433E+00,-0.67552E+00,-0.67672E+00,
- &-0.67791E+00,-0.67910E+00,-0.68028E+00,-0.68147E+00,-0.68265E+00,
- &-0.68382E+00,-0.68500E+00,-0.68617E+00,-0.68734E+00,-0.68851E+00,
- &-0.68967E+00,-0.69084E+00,-0.69200E+00,-0.69316E+00,-0.69431E+00,
- &-0.69546E+00,-0.69662E+00,-0.69776E+00,-0.69891E+00,-0.70005E+00,
- &-0.70120E+00,-0.70234E+00,-0.70347E+00,-0.70461E+00,-0.70574E+00,
- &-0.70687E+00,-0.70800E+00,-0.70912E+00,-0.71025E+00,-0.71137E+00,
- &-0.71249E+00,-0.71361E+00,-0.71472E+00,-0.71584E+00,-0.71695E+00,
- &-0.71806E+00,-0.71916E+00,-0.72027E+00,-0.72137E+00,-0.72247E+00,
- &-0.72357E+00,-0.72467E+00,-0.72576E+00,-0.72686E+00,-0.72795E+00,
- &-0.72904E+00,-0.73012E+00,-0.73121E+00,-0.73229E+00,-0.73337E+00,
- &-0.73445E+00,-0.73553E+00,-0.73661E+00,-0.73768E+00,-0.73875E+00,
- &-0.73983E+00,-0.74089E+00,-0.74196E+00,-0.74303E+00,-0.74409E+00,
- &-0.74515E+00,-0.74621E+00,-0.74727E+00,-0.74832E+00,-0.74938E+00,
- &-0.75043E+00,-0.75148E+00,-0.75253E+00,-0.75358E+00,-0.75463E+00,
- &-0.75567E+00,-0.75671E+00,-0.75776E+00,-0.75880E+00,-0.75983E+00,
- &-0.76087E+00,-0.76190E+00,-0.76294E+00,-0.76397E+00,-0.76500E+00,
- &-0.76603E+00,-0.76705E+00,-0.76808E+00,-0.76910E+00,-0.77012E+00/
-
- DATA (BNC03M(I),I=301,400)/
- &-0.77115E+00,-0.77216E+00,-0.77318E+00,-0.77420E+00,-0.77521E+00,
- &-0.77623E+00,-0.77724E+00,-0.77825E+00,-0.77926E+00,-0.78026E+00,
- &-0.78127E+00,-0.78227E+00,-0.78328E+00,-0.78428E+00,-0.78528E+00,
- &-0.78628E+00,-0.78727E+00,-0.78827E+00,-0.78926E+00,-0.79026E+00,
- &-0.79125E+00,-0.79224E+00,-0.79323E+00,-0.79422E+00,-0.79520E+00,
- &-0.79619E+00,-0.79717E+00,-0.79815E+00,-0.79913E+00,-0.80011E+00,
- &-0.80109E+00,-0.80207E+00,-0.80304E+00,-0.80402E+00,-0.80499E+00,
- &-0.80596E+00,-0.80694E+00,-0.80790E+00,-0.80887E+00,-0.80984E+00,
- &-0.81081E+00,-0.81177E+00,-0.81273E+00,-0.81369E+00,-0.81466E+00,
- &-0.81562E+00,-0.81657E+00,-0.81753E+00,-0.81849E+00,-0.81944E+00,
- &-0.82039E+00,-0.82135E+00,-0.82230E+00,-0.82325E+00,-0.82420E+00,
- &-0.82514E+00,-0.82609E+00,-0.82704E+00,-0.82798E+00,-0.82892E+00,
- &-0.82987E+00,-0.83081E+00,-0.83175E+00,-0.83269E+00,-0.83362E+00,
- &-0.83456E+00,-0.83549E+00,-0.83643E+00,-0.83736E+00,-0.83829E+00,
- &-0.83923E+00,-0.84016E+00,-0.84108E+00,-0.84201E+00,-0.84294E+00,
- &-0.84386E+00,-0.84479E+00,-0.84571E+00,-0.84663E+00,-0.84756E+00,
- &-0.84848E+00,-0.84940E+00,-0.85031E+00,-0.85123E+00,-0.85215E+00,
- &-0.85306E+00,-0.85398E+00,-0.85489E+00,-0.85580E+00,-0.85672E+00,
- &-0.85763E+00,-0.85853E+00,-0.85944E+00,-0.86035E+00,-0.86126E+00,
- &-0.86216E+00,-0.86307E+00,-0.86397E+00,-0.86487E+00,-0.86578E+00/
-
- DATA (BNC03M(I),I=401,500)/
- &-0.86668E+00,-0.86758E+00,-0.86847E+00,-0.86937E+00,-0.87027E+00,
- &-0.87117E+00,-0.87206E+00,-0.87295E+00,-0.87385E+00,-0.87474E+00,
- &-0.87563E+00,-0.87652E+00,-0.87741E+00,-0.87830E+00,-0.87919E+00,
- &-0.88008E+00,-0.88096E+00,-0.88185E+00,-0.88273E+00,-0.88361E+00,
- &-0.88450E+00,-0.88538E+00,-0.88626E+00,-0.88714E+00,-0.88802E+00,
- &-0.88890E+00,-0.88977E+00,-0.89065E+00,-0.89153E+00,-0.89240E+00,
- &-0.89328E+00,-0.89415E+00,-0.89502E+00,-0.89589E+00,-0.89676E+00,
- &-0.89763E+00,-0.89850E+00,-0.89937E+00,-0.90024E+00,-0.90110E+00,
- &-0.90197E+00,-0.90283E+00,-0.90370E+00,-0.90456E+00,-0.90542E+00,
- &-0.90629E+00,-0.90715E+00,-0.90801E+00,-0.90887E+00,-0.90973E+00,
- &-0.91058E+00,-0.91144E+00,-0.91230E+00,-0.91315E+00,-0.91401E+00,
- &-0.91486E+00,-0.91572E+00,-0.91657E+00,-0.91742E+00,-0.91827E+00,
- &-0.91912E+00,-0.91997E+00,-0.92082E+00,-0.92167E+00,-0.92251E+00,
- &-0.92336E+00,-0.92421E+00,-0.92505E+00,-0.92590E+00,-0.92674E+00,
- &-0.92758E+00,-0.92842E+00,-0.92927E+00,-0.93011E+00,-0.93095E+00,
- &-0.93179E+00,-0.93262E+00,-0.93346E+00,-0.93430E+00,-0.93514E+00,
- &-0.93597E+00,-0.93681E+00,-0.93764E+00,-0.93848E+00,-0.93931E+00,
- &-0.94014E+00,-0.94097E+00,-0.94180E+00,-0.94263E+00,-0.94346E+00,
- &-0.94429E+00,-0.94512E+00,-0.94595E+00,-0.94678E+00,-0.94760E+00,
- &-0.94843E+00,-0.94925E+00,-0.95008E+00,-0.95090E+00,-0.95172E+00/
-
- DATA (BNC03M(I),I=501,600)/
- &-0.95255E+00,-0.95337E+00,-0.95419E+00,-0.95501E+00,-0.95583E+00,
- &-0.95665E+00,-0.95747E+00,-0.95828E+00,-0.95910E+00,-0.95992E+00,
- &-0.96073E+00,-0.96155E+00,-0.96236E+00,-0.96318E+00,-0.96399E+00,
- &-0.96480E+00,-0.96562E+00,-0.96643E+00,-0.96724E+00,-0.96805E+00,
- &-0.96886E+00,-0.96967E+00,-0.97048E+00,-0.97128E+00,-0.97209E+00,
- &-0.97290E+00,-0.97371E+00,-0.97451E+00,-0.97532E+00,-0.97612E+00,
- &-0.97692E+00,-0.97773E+00,-0.97853E+00,-0.97933E+00,-0.98013E+00,
- &-0.98093E+00,-0.98173E+00,-0.98253E+00,-0.98333E+00,-0.98413E+00,
- &-0.98493E+00,-0.98573E+00,-0.98652E+00,-0.98732E+00,-0.98812E+00,
- &-0.98891E+00,-0.98971E+00,-0.99050E+00,-0.99129E+00,-0.99209E+00,
- &-0.99288E+00,-0.99367E+00,-0.99446E+00,-0.99525E+00,-0.99604E+00,
- &-0.99683E+00,-0.99762E+00,-0.99841E+00,-0.99920E+00,-0.99999E+00,
- &-0.10008E+01,-0.10016E+01,-0.10023E+01,-0.10031E+01,-0.10039E+01,
- &-0.10047E+01,-0.10055E+01,-0.10063E+01,-0.10070E+01,-0.10078E+01,
- &-0.10086E+01,-0.10094E+01,-0.10102E+01,-0.10110E+01,-0.10117E+01,
- &-0.10125E+01,-0.10133E+01,-0.10141E+01,-0.10148E+01,-0.10156E+01,
- &-0.10164E+01,-0.10172E+01,-0.10180E+01,-0.10187E+01,-0.10195E+01,
- &-0.10203E+01,-0.10210E+01,-0.10218E+01,-0.10226E+01,-0.10234E+01,
- &-0.10241E+01,-0.10249E+01,-0.10257E+01,-0.10264E+01,-0.10272E+01,
- &-0.10280E+01,-0.10288E+01,-0.10295E+01,-0.10303E+01,-0.10311E+01/
-
- DATA (BNC03M(I),I=601,700)/
- &-0.10393E+01,-0.10469E+01,-0.10545E+01,-0.10620E+01,-0.10694E+01,
- &-0.10769E+01,-0.10842E+01,-0.10916E+01,-0.10989E+01,-0.11062E+01,
- &-0.11134E+01,-0.11206E+01,-0.11277E+01,-0.11349E+01,-0.11420E+01,
- &-0.11490E+01,-0.11560E+01,-0.11630E+01,-0.11700E+01,-0.11769E+01,
- &-0.11838E+01,-0.11907E+01,-0.11976E+01,-0.12044E+01,-0.12112E+01,
- &-0.12180E+01,-0.12247E+01,-0.12314E+01,-0.12381E+01,-0.12448E+01,
- &-0.12514E+01,-0.12581E+01,-0.12647E+01,-0.12713E+01,-0.12778E+01,
- &-0.12843E+01,-0.12909E+01,-0.12974E+01,-0.13038E+01,-0.13103E+01,
- &-0.13167E+01,-0.13231E+01,-0.13295E+01,-0.13359E+01,-0.13423E+01,
- &-0.13486E+01,-0.13549E+01,-0.13612E+01,-0.13675E+01,-0.13738E+01,
- &-0.13800E+01,-0.13863E+01,-0.13925E+01,-0.13987E+01,-0.14049E+01,
- &-0.14111E+01,-0.14172E+01,-0.14234E+01,-0.14295E+01,-0.14356E+01,
- &-0.14417E+01,-0.14478E+01,-0.14539E+01,-0.14599E+01,-0.14660E+01,
- &-0.14720E+01,-0.14780E+01,-0.14840E+01,-0.14900E+01,-0.14960E+01,
- &-0.15020E+01,-0.15079E+01,-0.15139E+01,-0.15198E+01,-0.15257E+01,
- &-0.15316E+01,-0.15375E+01,-0.15434E+01,-0.15493E+01,-0.15551E+01,
- &-0.15610E+01,-0.15668E+01,-0.15727E+01,-0.15785E+01,-0.15843E+01,
- &-0.15901E+01,-0.15959E+01,-0.16017E+01,-0.16074E+01,-0.16132E+01,
- &-0.16189E+01,-0.16247E+01,-0.16304E+01,-0.16361E+01,-0.16418E+01,
- &-0.16475E+01,-0.16532E+01,-0.16589E+01,-0.16646E+01,-0.16703E+01/
-
- DATA (BNC03M(I),I=701,741)/
- &-0.16759E+01,-0.16816E+01,-0.16872E+01,-0.16928E+01,-0.16985E+01,
- &-0.17041E+01,-0.17097E+01,-0.17153E+01,-0.17209E+01,-0.17265E+01,
- &-0.17320E+01,-0.17376E+01,-0.17432E+01,-0.17487E+01,-0.17543E+01,
- &-0.17598E+01,-0.17653E+01,-0.17709E+01,-0.17764E+01,-0.17819E+01,
- &-0.17874E+01,-0.17929E+01,-0.17984E+01,-0.18039E+01,-0.18093E+01,
- &-0.18148E+01,-0.18203E+01,-0.18257E+01,-0.18312E+01,-0.18366E+01,
- &-0.18420E+01,-0.18475E+01,-0.18529E+01,-0.18583E+01,-0.18637E+01,
- &-0.18691E+01,-0.18745E+01,-0.18799E+01,-0.18853E+01,-0.18907E+01,
- &-0.18960E+01
- & /
-C
-C *** (NH4)2SO4
-C
- DATA (BNC04M(I),I=1,100)/
- &-0.10053E+00,-0.22014E+00,-0.28074E+00,-0.32404E+00,-0.35833E+00,
- &-0.38699E+00,-0.41173E+00,-0.43358E+00,-0.45321E+00,-0.47106E+00,
- &-0.48747E+00,-0.50266E+00,-0.51683E+00,-0.53012E+00,-0.54265E+00,
- &-0.55451E+00,-0.56578E+00,-0.57652E+00,-0.58678E+00,-0.59662E+00,
- &-0.60607E+00,-0.61516E+00,-0.62393E+00,-0.63241E+00,-0.64060E+00,
- &-0.64855E+00,-0.65625E+00,-0.66374E+00,-0.67102E+00,-0.67810E+00,
- &-0.68501E+00,-0.69174E+00,-0.69832E+00,-0.70474E+00,-0.71102E+00,
- &-0.71716E+00,-0.72317E+00,-0.72906E+00,-0.73483E+00,-0.74049E+00,
- &-0.74605E+00,-0.75150E+00,-0.75686E+00,-0.76212E+00,-0.76729E+00,
- &-0.77238E+00,-0.77738E+00,-0.78231E+00,-0.78716E+00,-0.79194E+00,
- &-0.79664E+00,-0.80128E+00,-0.80586E+00,-0.81037E+00,-0.81482E+00,
- &-0.81921E+00,-0.82355E+00,-0.82783E+00,-0.83205E+00,-0.83623E+00,
- &-0.84036E+00,-0.84444E+00,-0.84848E+00,-0.85247E+00,-0.85642E+00,
- &-0.86033E+00,-0.86420E+00,-0.86803E+00,-0.87182E+00,-0.87558E+00,
- &-0.87930E+00,-0.88299E+00,-0.88665E+00,-0.89028E+00,-0.89387E+00,
- &-0.89744E+00,-0.90098E+00,-0.90449E+00,-0.90798E+00,-0.91144E+00,
- &-0.91487E+00,-0.91828E+00,-0.92167E+00,-0.92503E+00,-0.92838E+00,
- &-0.93170E+00,-0.93500E+00,-0.93828E+00,-0.94154E+00,-0.94479E+00,
- &-0.94801E+00,-0.95122E+00,-0.95440E+00,-0.95757E+00,-0.96073E+00,
- &-0.96387E+00,-0.96699E+00,-0.97009E+00,-0.97318E+00,-0.97626E+00/
-
- DATA (BNC04M(I),I=101,200)/
- &-0.97931E+00,-0.98236E+00,-0.98539E+00,-0.98840E+00,-0.99141E+00,
- &-0.99439E+00,-0.99737E+00,-0.10003E+01,-0.10033E+01,-0.10062E+01,
- &-0.10091E+01,-0.10120E+01,-0.10149E+01,-0.10178E+01,-0.10207E+01,
- &-0.10235E+01,-0.10264E+01,-0.10292E+01,-0.10320E+01,-0.10348E+01,
- &-0.10376E+01,-0.10404E+01,-0.10432E+01,-0.10460E+01,-0.10487E+01,
- &-0.10515E+01,-0.10542E+01,-0.10569E+01,-0.10596E+01,-0.10623E+01,
- &-0.10650E+01,-0.10677E+01,-0.10703E+01,-0.10730E+01,-0.10756E+01,
- &-0.10783E+01,-0.10809E+01,-0.10835E+01,-0.10861E+01,-0.10887E+01,
- &-0.10913E+01,-0.10938E+01,-0.10964E+01,-0.10990E+01,-0.11015E+01,
- &-0.11041E+01,-0.11066E+01,-0.11091E+01,-0.11116E+01,-0.11141E+01,
- &-0.11166E+01,-0.11191E+01,-0.11216E+01,-0.11241E+01,-0.11265E+01,
- &-0.11290E+01,-0.11314E+01,-0.11339E+01,-0.11363E+01,-0.11387E+01,
- &-0.11411E+01,-0.11435E+01,-0.11459E+01,-0.11483E+01,-0.11507E+01,
- &-0.11531E+01,-0.11555E+01,-0.11578E+01,-0.11602E+01,-0.11625E+01,
- &-0.11649E+01,-0.11672E+01,-0.11696E+01,-0.11719E+01,-0.11742E+01,
- &-0.11765E+01,-0.11788E+01,-0.11811E+01,-0.11834E+01,-0.11857E+01,
- &-0.11880E+01,-0.11903E+01,-0.11925E+01,-0.11948E+01,-0.11970E+01,
- &-0.11993E+01,-0.12015E+01,-0.12038E+01,-0.12060E+01,-0.12082E+01,
- &-0.12105E+01,-0.12127E+01,-0.12149E+01,-0.12171E+01,-0.12193E+01,
- &-0.12215E+01,-0.12237E+01,-0.12259E+01,-0.12280E+01,-0.12302E+01/
-
- DATA (BNC04M(I),I=201,300)/
- &-0.12324E+01,-0.12345E+01,-0.12367E+01,-0.12389E+01,-0.12410E+01,
- &-0.12432E+01,-0.12453E+01,-0.12474E+01,-0.12496E+01,-0.12517E+01,
- &-0.12538E+01,-0.12559E+01,-0.12580E+01,-0.12601E+01,-0.12622E+01,
- &-0.12643E+01,-0.12664E+01,-0.12685E+01,-0.12706E+01,-0.12727E+01,
- &-0.12748E+01,-0.12768E+01,-0.12789E+01,-0.12810E+01,-0.12830E+01,
- &-0.12851E+01,-0.12871E+01,-0.12892E+01,-0.12912E+01,-0.12932E+01,
- &-0.12953E+01,-0.12973E+01,-0.12993E+01,-0.13014E+01,-0.13034E+01,
- &-0.13054E+01,-0.13074E+01,-0.13094E+01,-0.13114E+01,-0.13134E+01,
- &-0.13154E+01,-0.13174E+01,-0.13194E+01,-0.13214E+01,-0.13234E+01,
- &-0.13253E+01,-0.13273E+01,-0.13293E+01,-0.13313E+01,-0.13332E+01,
- &-0.13352E+01,-0.13371E+01,-0.13391E+01,-0.13410E+01,-0.13430E+01,
- &-0.13449E+01,-0.13469E+01,-0.13488E+01,-0.13507E+01,-0.13527E+01,
- &-0.13546E+01,-0.13565E+01,-0.13584E+01,-0.13604E+01,-0.13623E+01,
- &-0.13642E+01,-0.13661E+01,-0.13680E+01,-0.13699E+01,-0.13718E+01,
- &-0.13737E+01,-0.13756E+01,-0.13775E+01,-0.13794E+01,-0.13813E+01,
- &-0.13831E+01,-0.13850E+01,-0.13869E+01,-0.13888E+01,-0.13906E+01,
- &-0.13925E+01,-0.13944E+01,-0.13962E+01,-0.13981E+01,-0.13999E+01,
- &-0.14018E+01,-0.14036E+01,-0.14055E+01,-0.14073E+01,-0.14092E+01,
- &-0.14110E+01,-0.14129E+01,-0.14147E+01,-0.14165E+01,-0.14183E+01,
- &-0.14202E+01,-0.14220E+01,-0.14238E+01,-0.14256E+01,-0.14275E+01/
-
- DATA (BNC04M(I),I=301,400)/
- &-0.14293E+01,-0.14311E+01,-0.14329E+01,-0.14347E+01,-0.14365E+01,
- &-0.14383E+01,-0.14401E+01,-0.14419E+01,-0.14437E+01,-0.14455E+01,
- &-0.14473E+01,-0.14491E+01,-0.14508E+01,-0.14526E+01,-0.14544E+01,
- &-0.14562E+01,-0.14580E+01,-0.14597E+01,-0.14615E+01,-0.14633E+01,
- &-0.14650E+01,-0.14668E+01,-0.14686E+01,-0.14703E+01,-0.14721E+01,
- &-0.14738E+01,-0.14756E+01,-0.14773E+01,-0.14791E+01,-0.14808E+01,
- &-0.14826E+01,-0.14843E+01,-0.14861E+01,-0.14878E+01,-0.14895E+01,
- &-0.14913E+01,-0.14930E+01,-0.14947E+01,-0.14965E+01,-0.14982E+01,
- &-0.14999E+01,-0.15016E+01,-0.15034E+01,-0.15051E+01,-0.15068E+01,
- &-0.15085E+01,-0.15102E+01,-0.15119E+01,-0.15136E+01,-0.15153E+01,
- &-0.15171E+01,-0.15188E+01,-0.15205E+01,-0.15222E+01,-0.15239E+01,
- &-0.15255E+01,-0.15272E+01,-0.15289E+01,-0.15306E+01,-0.15323E+01,
- &-0.15340E+01,-0.15357E+01,-0.15374E+01,-0.15390E+01,-0.15407E+01,
- &-0.15424E+01,-0.15441E+01,-0.15457E+01,-0.15474E+01,-0.15491E+01,
- &-0.15508E+01,-0.15524E+01,-0.15541E+01,-0.15557E+01,-0.15574E+01,
- &-0.15591E+01,-0.15607E+01,-0.15624E+01,-0.15640E+01,-0.15657E+01,
- &-0.15673E+01,-0.15690E+01,-0.15706E+01,-0.15723E+01,-0.15739E+01,
- &-0.15756E+01,-0.15772E+01,-0.15788E+01,-0.15805E+01,-0.15821E+01,
- &-0.15838E+01,-0.15854E+01,-0.15870E+01,-0.15887E+01,-0.15903E+01,
- &-0.15919E+01,-0.15935E+01,-0.15952E+01,-0.15968E+01,-0.15984E+01/
-
- DATA (BNC04M(I),I=401,500)/
- &-0.16000E+01,-0.16016E+01,-0.16032E+01,-0.16049E+01,-0.16065E+01,
- &-0.16081E+01,-0.16097E+01,-0.16113E+01,-0.16129E+01,-0.16145E+01,
- &-0.16161E+01,-0.16177E+01,-0.16193E+01,-0.16209E+01,-0.16225E+01,
- &-0.16241E+01,-0.16257E+01,-0.16273E+01,-0.16289E+01,-0.16305E+01,
- &-0.16321E+01,-0.16337E+01,-0.16353E+01,-0.16368E+01,-0.16384E+01,
- &-0.16400E+01,-0.16416E+01,-0.16432E+01,-0.16448E+01,-0.16463E+01,
- &-0.16479E+01,-0.16495E+01,-0.16511E+01,-0.16526E+01,-0.16542E+01,
- &-0.16558E+01,-0.16573E+01,-0.16589E+01,-0.16605E+01,-0.16620E+01,
- &-0.16636E+01,-0.16652E+01,-0.16667E+01,-0.16683E+01,-0.16698E+01,
- &-0.16714E+01,-0.16729E+01,-0.16745E+01,-0.16761E+01,-0.16776E+01,
- &-0.16792E+01,-0.16807E+01,-0.16823E+01,-0.16838E+01,-0.16853E+01,
- &-0.16869E+01,-0.16884E+01,-0.16900E+01,-0.16915E+01,-0.16931E+01,
- &-0.16946E+01,-0.16961E+01,-0.16977E+01,-0.16992E+01,-0.17007E+01,
- &-0.17023E+01,-0.17038E+01,-0.17053E+01,-0.17069E+01,-0.17084E+01,
- &-0.17099E+01,-0.17114E+01,-0.17130E+01,-0.17145E+01,-0.17160E+01,
- &-0.17175E+01,-0.17190E+01,-0.17206E+01,-0.17221E+01,-0.17236E+01,
- &-0.17251E+01,-0.17266E+01,-0.17281E+01,-0.17297E+01,-0.17312E+01,
- &-0.17327E+01,-0.17342E+01,-0.17357E+01,-0.17372E+01,-0.17387E+01,
- &-0.17402E+01,-0.17417E+01,-0.17432E+01,-0.17447E+01,-0.17462E+01,
- &-0.17477E+01,-0.17492E+01,-0.17507E+01,-0.17522E+01,-0.17537E+01/
-
- DATA (BNC04M(I),I=501,600)/
- &-0.17552E+01,-0.17567E+01,-0.17582E+01,-0.17597E+01,-0.17612E+01,
- &-0.17626E+01,-0.17641E+01,-0.17656E+01,-0.17671E+01,-0.17686E+01,
- &-0.17701E+01,-0.17715E+01,-0.17730E+01,-0.17745E+01,-0.17760E+01,
- &-0.17775E+01,-0.17789E+01,-0.17804E+01,-0.17819E+01,-0.17834E+01,
- &-0.17848E+01,-0.17863E+01,-0.17878E+01,-0.17893E+01,-0.17907E+01,
- &-0.17922E+01,-0.17937E+01,-0.17951E+01,-0.17966E+01,-0.17981E+01,
- &-0.17995E+01,-0.18010E+01,-0.18025E+01,-0.18039E+01,-0.18054E+01,
- &-0.18068E+01,-0.18083E+01,-0.18098E+01,-0.18112E+01,-0.18127E+01,
- &-0.18141E+01,-0.18156E+01,-0.18170E+01,-0.18185E+01,-0.18199E+01,
- &-0.18214E+01,-0.18228E+01,-0.18243E+01,-0.18257E+01,-0.18272E+01,
- &-0.18286E+01,-0.18301E+01,-0.18315E+01,-0.18330E+01,-0.18344E+01,
- &-0.18358E+01,-0.18373E+01,-0.18387E+01,-0.18402E+01,-0.18416E+01,
- &-0.18430E+01,-0.18445E+01,-0.18459E+01,-0.18473E+01,-0.18488E+01,
- &-0.18502E+01,-0.18516E+01,-0.18531E+01,-0.18545E+01,-0.18559E+01,
- &-0.18574E+01,-0.18588E+01,-0.18602E+01,-0.18616E+01,-0.18631E+01,
- &-0.18645E+01,-0.18659E+01,-0.18673E+01,-0.18688E+01,-0.18702E+01,
- &-0.18716E+01,-0.18730E+01,-0.18744E+01,-0.18759E+01,-0.18773E+01,
- &-0.18787E+01,-0.18801E+01,-0.18815E+01,-0.18829E+01,-0.18844E+01,
- &-0.18858E+01,-0.18872E+01,-0.18886E+01,-0.18900E+01,-0.18914E+01,
- &-0.18928E+01,-0.18942E+01,-0.18956E+01,-0.18970E+01,-0.18984E+01/
-
- DATA (BNC04M(I),I=601,700)/
- &-0.19136E+01,-0.19275E+01,-0.19414E+01,-0.19552E+01,-0.19689E+01,
- &-0.19826E+01,-0.19962E+01,-0.20097E+01,-0.20232E+01,-0.20366E+01,
- &-0.20500E+01,-0.20633E+01,-0.20766E+01,-0.20897E+01,-0.21029E+01,
- &-0.21160E+01,-0.21290E+01,-0.21420E+01,-0.21550E+01,-0.21679E+01,
- &-0.21807E+01,-0.21935E+01,-0.22063E+01,-0.22190E+01,-0.22317E+01,
- &-0.22443E+01,-0.22569E+01,-0.22695E+01,-0.22820E+01,-0.22945E+01,
- &-0.23069E+01,-0.23193E+01,-0.23317E+01,-0.23440E+01,-0.23563E+01,
- &-0.23686E+01,-0.23808E+01,-0.23930E+01,-0.24052E+01,-0.24173E+01,
- &-0.24294E+01,-0.24415E+01,-0.24535E+01,-0.24655E+01,-0.24775E+01,
- &-0.24895E+01,-0.25014E+01,-0.25133E+01,-0.25252E+01,-0.25370E+01,
- &-0.25488E+01,-0.25606E+01,-0.25724E+01,-0.25841E+01,-0.25959E+01,
- &-0.26076E+01,-0.26192E+01,-0.26309E+01,-0.26425E+01,-0.26541E+01,
- &-0.26657E+01,-0.26772E+01,-0.26887E+01,-0.27002E+01,-0.27117E+01,
- &-0.27232E+01,-0.27346E+01,-0.27461E+01,-0.27575E+01,-0.27688E+01,
- &-0.27802E+01,-0.27915E+01,-0.28029E+01,-0.28142E+01,-0.28255E+01,
- &-0.28367E+01,-0.28480E+01,-0.28592E+01,-0.28704E+01,-0.28816E+01,
- &-0.28928E+01,-0.29039E+01,-0.29151E+01,-0.29262E+01,-0.29373E+01,
- &-0.29484E+01,-0.29595E+01,-0.29705E+01,-0.29816E+01,-0.29926E+01,
- &-0.30036E+01,-0.30146E+01,-0.30256E+01,-0.30366E+01,-0.30475E+01,
- &-0.30585E+01,-0.30694E+01,-0.30803E+01,-0.30912E+01,-0.31021E+01/
-
- DATA (BNC04M(I),I=701,741)/
- &-0.31129E+01,-0.31238E+01,-0.31346E+01,-0.31454E+01,-0.31562E+01,
- &-0.31670E+01,-0.31778E+01,-0.31886E+01,-0.31993E+01,-0.32101E+01,
- &-0.32208E+01,-0.32315E+01,-0.32423E+01,-0.32529E+01,-0.32636E+01,
- &-0.32743E+01,-0.32850E+01,-0.32956E+01,-0.33062E+01,-0.33169E+01,
- &-0.33275E+01,-0.33381E+01,-0.33487E+01,-0.33592E+01,-0.33698E+01,
- &-0.33804E+01,-0.33909E+01,-0.34015E+01,-0.34120E+01,-0.34225E+01,
- &-0.34330E+01,-0.34435E+01,-0.34540E+01,-0.34644E+01,-0.34749E+01,
- &-0.34854E+01,-0.34958E+01,-0.35062E+01,-0.35166E+01,-0.35271E+01,
- &-0.35375E+01
- & /
-C
-C *** NH4NO3
-C
- DATA (BNC05M(I),I=1,100)/
- &-0.51007E-01,-0.11414E+00,-0.14751E+00,-0.17208E+00,-0.19205E+00,
- &-0.20913E+00,-0.22418E+00,-0.23774E+00,-0.25013E+00,-0.26159E+00,
- &-0.27229E+00,-0.28235E+00,-0.29187E+00,-0.30091E+00,-0.30954E+00,
- &-0.31781E+00,-0.32575E+00,-0.33340E+00,-0.34079E+00,-0.34794E+00,
- &-0.35487E+00,-0.36160E+00,-0.36815E+00,-0.37452E+00,-0.38073E+00,
- &-0.38679E+00,-0.39271E+00,-0.39849E+00,-0.40415E+00,-0.40969E+00,
- &-0.41512E+00,-0.42044E+00,-0.42566E+00,-0.43078E+00,-0.43581E+00,
- &-0.44075E+00,-0.44560E+00,-0.45037E+00,-0.45506E+00,-0.45968E+00,
- &-0.46422E+00,-0.46869E+00,-0.47309E+00,-0.47742E+00,-0.48169E+00,
- &-0.48590E+00,-0.49005E+00,-0.49414E+00,-0.49817E+00,-0.50215E+00,
- &-0.50607E+00,-0.50995E+00,-0.51378E+00,-0.51755E+00,-0.52129E+00,
- &-0.52498E+00,-0.52862E+00,-0.53223E+00,-0.53579E+00,-0.53931E+00,
- &-0.54280E+00,-0.54626E+00,-0.54968E+00,-0.55306E+00,-0.55642E+00,
- &-0.55974E+00,-0.56303E+00,-0.56630E+00,-0.56954E+00,-0.57276E+00,
- &-0.57595E+00,-0.57911E+00,-0.58226E+00,-0.58538E+00,-0.58849E+00,
- &-0.59157E+00,-0.59464E+00,-0.59769E+00,-0.60072E+00,-0.60373E+00,
- &-0.60673E+00,-0.60972E+00,-0.61269E+00,-0.61565E+00,-0.61860E+00,
- &-0.62153E+00,-0.62445E+00,-0.62737E+00,-0.63027E+00,-0.63316E+00,
- &-0.63604E+00,-0.63891E+00,-0.64177E+00,-0.64462E+00,-0.64746E+00,
- &-0.65029E+00,-0.65312E+00,-0.65593E+00,-0.65874E+00,-0.66154E+00/
-
- DATA (BNC05M(I),I=101,200)/
- &-0.66433E+00,-0.66711E+00,-0.66988E+00,-0.67265E+00,-0.67540E+00,
- &-0.67815E+00,-0.68089E+00,-0.68361E+00,-0.68633E+00,-0.68905E+00,
- &-0.69175E+00,-0.69444E+00,-0.69713E+00,-0.69980E+00,-0.70247E+00,
- &-0.70513E+00,-0.70777E+00,-0.71041E+00,-0.71304E+00,-0.71566E+00,
- &-0.71827E+00,-0.72087E+00,-0.72346E+00,-0.72604E+00,-0.72861E+00,
- &-0.73117E+00,-0.73372E+00,-0.73627E+00,-0.73880E+00,-0.74132E+00,
- &-0.74383E+00,-0.74634E+00,-0.74883E+00,-0.75132E+00,-0.75379E+00,
- &-0.75626E+00,-0.75871E+00,-0.76116E+00,-0.76360E+00,-0.76603E+00,
- &-0.76844E+00,-0.77085E+00,-0.77325E+00,-0.77565E+00,-0.77803E+00,
- &-0.78040E+00,-0.78277E+00,-0.78512E+00,-0.78747E+00,-0.78981E+00,
- &-0.79214E+00,-0.79446E+00,-0.79677E+00,-0.79908E+00,-0.80138E+00,
- &-0.80366E+00,-0.80594E+00,-0.80822E+00,-0.81048E+00,-0.81274E+00,
- &-0.81498E+00,-0.81723E+00,-0.81946E+00,-0.82168E+00,-0.82390E+00,
- &-0.82611E+00,-0.82831E+00,-0.83051E+00,-0.83269E+00,-0.83487E+00,
- &-0.83705E+00,-0.83921E+00,-0.84137E+00,-0.84352E+00,-0.84567E+00,
- &-0.84780E+00,-0.84993E+00,-0.85206E+00,-0.85417E+00,-0.85628E+00,
- &-0.85839E+00,-0.86048E+00,-0.86257E+00,-0.86466E+00,-0.86673E+00,
- &-0.86880E+00,-0.87087E+00,-0.87292E+00,-0.87497E+00,-0.87702E+00,
- &-0.87906E+00,-0.88109E+00,-0.88312E+00,-0.88514E+00,-0.88715E+00,
- &-0.88916E+00,-0.89116E+00,-0.89315E+00,-0.89514E+00,-0.89713E+00/
-
- DATA (BNC05M(I),I=201,300)/
- &-0.89911E+00,-0.90108E+00,-0.90305E+00,-0.90501E+00,-0.90696E+00,
- &-0.90891E+00,-0.91086E+00,-0.91280E+00,-0.91473E+00,-0.91666E+00,
- &-0.91858E+00,-0.92050E+00,-0.92241E+00,-0.92431E+00,-0.92621E+00,
- &-0.92811E+00,-0.93000E+00,-0.93188E+00,-0.93376E+00,-0.93564E+00,
- &-0.93751E+00,-0.93937E+00,-0.94123E+00,-0.94309E+00,-0.94494E+00,
- &-0.94678E+00,-0.94862E+00,-0.95046E+00,-0.95229E+00,-0.95411E+00,
- &-0.95593E+00,-0.95775E+00,-0.95956E+00,-0.96136E+00,-0.96317E+00,
- &-0.96496E+00,-0.96676E+00,-0.96854E+00,-0.97033E+00,-0.97210E+00,
- &-0.97388E+00,-0.97565E+00,-0.97741E+00,-0.97917E+00,-0.98093E+00,
- &-0.98268E+00,-0.98443E+00,-0.98617E+00,-0.98791E+00,-0.98965E+00,
- &-0.99138E+00,-0.99310E+00,-0.99483E+00,-0.99654E+00,-0.99826E+00,
- &-0.99997E+00,-0.10017E+01,-0.10034E+01,-0.10051E+01,-0.10068E+01,
- &-0.10085E+01,-0.10101E+01,-0.10118E+01,-0.10135E+01,-0.10152E+01,
- &-0.10168E+01,-0.10185E+01,-0.10202E+01,-0.10218E+01,-0.10235E+01,
- &-0.10251E+01,-0.10268E+01,-0.10284E+01,-0.10301E+01,-0.10317E+01,
- &-0.10333E+01,-0.10350E+01,-0.10366E+01,-0.10382E+01,-0.10398E+01,
- &-0.10414E+01,-0.10430E+01,-0.10446E+01,-0.10462E+01,-0.10478E+01,
- &-0.10494E+01,-0.10510E+01,-0.10526E+01,-0.10542E+01,-0.10558E+01,
- &-0.10574E+01,-0.10589E+01,-0.10605E+01,-0.10621E+01,-0.10636E+01,
- &-0.10652E+01,-0.10668E+01,-0.10683E+01,-0.10699E+01,-0.10714E+01/
-
- DATA (BNC05M(I),I=301,400)/
- &-0.10730E+01,-0.10745E+01,-0.10760E+01,-0.10776E+01,-0.10791E+01,
- &-0.10806E+01,-0.10822E+01,-0.10837E+01,-0.10852E+01,-0.10867E+01,
- &-0.10882E+01,-0.10898E+01,-0.10913E+01,-0.10928E+01,-0.10943E+01,
- &-0.10958E+01,-0.10973E+01,-0.10988E+01,-0.11002E+01,-0.11017E+01,
- &-0.11032E+01,-0.11047E+01,-0.11062E+01,-0.11076E+01,-0.11091E+01,
- &-0.11106E+01,-0.11121E+01,-0.11135E+01,-0.11150E+01,-0.11164E+01,
- &-0.11179E+01,-0.11193E+01,-0.11208E+01,-0.11222E+01,-0.11237E+01,
- &-0.11251E+01,-0.11266E+01,-0.11280E+01,-0.11294E+01,-0.11309E+01,
- &-0.11323E+01,-0.11337E+01,-0.11351E+01,-0.11365E+01,-0.11380E+01,
- &-0.11394E+01,-0.11408E+01,-0.11422E+01,-0.11436E+01,-0.11450E+01,
- &-0.11464E+01,-0.11478E+01,-0.11492E+01,-0.11506E+01,-0.11520E+01,
- &-0.11534E+01,-0.11548E+01,-0.11561E+01,-0.11575E+01,-0.11589E+01,
- &-0.11603E+01,-0.11617E+01,-0.11630E+01,-0.11644E+01,-0.11658E+01,
- &-0.11671E+01,-0.11685E+01,-0.11698E+01,-0.11712E+01,-0.11726E+01,
- &-0.11739E+01,-0.11753E+01,-0.11766E+01,-0.11779E+01,-0.11793E+01,
- &-0.11806E+01,-0.11820E+01,-0.11833E+01,-0.11846E+01,-0.11860E+01,
- &-0.11873E+01,-0.11886E+01,-0.11899E+01,-0.11913E+01,-0.11926E+01,
- &-0.11939E+01,-0.11952E+01,-0.11965E+01,-0.11978E+01,-0.11992E+01,
- &-0.12005E+01,-0.12018E+01,-0.12031E+01,-0.12044E+01,-0.12057E+01,
- &-0.12070E+01,-0.12083E+01,-0.12096E+01,-0.12108E+01,-0.12121E+01/
-
- DATA (BNC05M(I),I=401,500)/
- &-0.12134E+01,-0.12147E+01,-0.12160E+01,-0.12173E+01,-0.12185E+01,
- &-0.12198E+01,-0.12211E+01,-0.12224E+01,-0.12236E+01,-0.12249E+01,
- &-0.12262E+01,-0.12274E+01,-0.12287E+01,-0.12299E+01,-0.12312E+01,
- &-0.12325E+01,-0.12337E+01,-0.12350E+01,-0.12362E+01,-0.12375E+01,
- &-0.12387E+01,-0.12400E+01,-0.12412E+01,-0.12424E+01,-0.12437E+01,
- &-0.12449E+01,-0.12461E+01,-0.12474E+01,-0.12486E+01,-0.12498E+01,
- &-0.12511E+01,-0.12523E+01,-0.12535E+01,-0.12547E+01,-0.12560E+01,
- &-0.12572E+01,-0.12584E+01,-0.12596E+01,-0.12608E+01,-0.12620E+01,
- &-0.12632E+01,-0.12644E+01,-0.12656E+01,-0.12669E+01,-0.12681E+01,
- &-0.12693E+01,-0.12705E+01,-0.12717E+01,-0.12728E+01,-0.12740E+01,
- &-0.12752E+01,-0.12764E+01,-0.12776E+01,-0.12788E+01,-0.12800E+01,
- &-0.12812E+01,-0.12823E+01,-0.12835E+01,-0.12847E+01,-0.12859E+01,
- &-0.12871E+01,-0.12882E+01,-0.12894E+01,-0.12906E+01,-0.12917E+01,
- &-0.12929E+01,-0.12941E+01,-0.12952E+01,-0.12964E+01,-0.12976E+01,
- &-0.12987E+01,-0.12999E+01,-0.13010E+01,-0.13022E+01,-0.13033E+01,
- &-0.13045E+01,-0.13056E+01,-0.13068E+01,-0.13079E+01,-0.13091E+01,
- &-0.13102E+01,-0.13114E+01,-0.13125E+01,-0.13136E+01,-0.13148E+01,
- &-0.13159E+01,-0.13170E+01,-0.13182E+01,-0.13193E+01,-0.13204E+01,
- &-0.13216E+01,-0.13227E+01,-0.13238E+01,-0.13249E+01,-0.13261E+01,
- &-0.13272E+01,-0.13283E+01,-0.13294E+01,-0.13305E+01,-0.13317E+01/
-
- DATA (BNC05M(I),I=501,600)/
- &-0.13328E+01,-0.13339E+01,-0.13350E+01,-0.13361E+01,-0.13372E+01,
- &-0.13383E+01,-0.13394E+01,-0.13405E+01,-0.13416E+01,-0.13427E+01,
- &-0.13438E+01,-0.13449E+01,-0.13460E+01,-0.13471E+01,-0.13482E+01,
- &-0.13493E+01,-0.13504E+01,-0.13515E+01,-0.13526E+01,-0.13537E+01,
- &-0.13547E+01,-0.13558E+01,-0.13569E+01,-0.13580E+01,-0.13591E+01,
- &-0.13602E+01,-0.13612E+01,-0.13623E+01,-0.13634E+01,-0.13645E+01,
- &-0.13655E+01,-0.13666E+01,-0.13677E+01,-0.13687E+01,-0.13698E+01,
- &-0.13709E+01,-0.13719E+01,-0.13730E+01,-0.13741E+01,-0.13751E+01,
- &-0.13762E+01,-0.13773E+01,-0.13783E+01,-0.13794E+01,-0.13804E+01,
- &-0.13815E+01,-0.13825E+01,-0.13836E+01,-0.13846E+01,-0.13857E+01,
- &-0.13867E+01,-0.13878E+01,-0.13888E+01,-0.13899E+01,-0.13909E+01,
- &-0.13920E+01,-0.13930E+01,-0.13940E+01,-0.13951E+01,-0.13961E+01,
- &-0.13971E+01,-0.13982E+01,-0.13992E+01,-0.14002E+01,-0.14013E+01,
- &-0.14023E+01,-0.14033E+01,-0.14044E+01,-0.14054E+01,-0.14064E+01,
- &-0.14074E+01,-0.14085E+01,-0.14095E+01,-0.14105E+01,-0.14115E+01,
- &-0.14125E+01,-0.14136E+01,-0.14146E+01,-0.14156E+01,-0.14166E+01,
- &-0.14176E+01,-0.14186E+01,-0.14196E+01,-0.14207E+01,-0.14217E+01,
- &-0.14227E+01,-0.14237E+01,-0.14247E+01,-0.14257E+01,-0.14267E+01,
- &-0.14277E+01,-0.14287E+01,-0.14297E+01,-0.14307E+01,-0.14317E+01,
- &-0.14327E+01,-0.14337E+01,-0.14347E+01,-0.14357E+01,-0.14367E+01/
-
- DATA (BNC05M(I),I=601,700)/
- &-0.14473E+01,-0.14571E+01,-0.14668E+01,-0.14763E+01,-0.14858E+01,
- &-0.14952E+01,-0.15045E+01,-0.15137E+01,-0.15229E+01,-0.15319E+01,
- &-0.15409E+01,-0.15498E+01,-0.15586E+01,-0.15674E+01,-0.15761E+01,
- &-0.15847E+01,-0.15933E+01,-0.16017E+01,-0.16102E+01,-0.16185E+01,
- &-0.16268E+01,-0.16351E+01,-0.16433E+01,-0.16514E+01,-0.16595E+01,
- &-0.16675E+01,-0.16754E+01,-0.16834E+01,-0.16912E+01,-0.16990E+01,
- &-0.17068E+01,-0.17145E+01,-0.17222E+01,-0.17298E+01,-0.17374E+01,
- &-0.17450E+01,-0.17525E+01,-0.17599E+01,-0.17674E+01,-0.17747E+01,
- &-0.17821E+01,-0.17894E+01,-0.17967E+01,-0.18039E+01,-0.18111E+01,
- &-0.18182E+01,-0.18254E+01,-0.18325E+01,-0.18395E+01,-0.18466E+01,
- &-0.18535E+01,-0.18605E+01,-0.18674E+01,-0.18743E+01,-0.18812E+01,
- &-0.18881E+01,-0.18949E+01,-0.19017E+01,-0.19084E+01,-0.19152E+01,
- &-0.19219E+01,-0.19285E+01,-0.19352E+01,-0.19418E+01,-0.19484E+01,
- &-0.19550E+01,-0.19616E+01,-0.19681E+01,-0.19746E+01,-0.19811E+01,
- &-0.19876E+01,-0.19940E+01,-0.20004E+01,-0.20068E+01,-0.20132E+01,
- &-0.20196E+01,-0.20259E+01,-0.20322E+01,-0.20385E+01,-0.20448E+01,
- &-0.20510E+01,-0.20573E+01,-0.20635E+01,-0.20697E+01,-0.20759E+01,
- &-0.20821E+01,-0.20882E+01,-0.20943E+01,-0.21005E+01,-0.21066E+01,
- &-0.21126E+01,-0.21187E+01,-0.21247E+01,-0.21308E+01,-0.21368E+01,
- &-0.21428E+01,-0.21488E+01,-0.21548E+01,-0.21607E+01,-0.21667E+01/
-
- DATA (BNC05M(I),I=701,741)/
- &-0.21726E+01,-0.21785E+01,-0.21844E+01,-0.21903E+01,-0.21962E+01,
- &-0.22020E+01,-0.22079E+01,-0.22137E+01,-0.22195E+01,-0.22253E+01,
- &-0.22311E+01,-0.22369E+01,-0.22427E+01,-0.22484E+01,-0.22542E+01,
- &-0.22599E+01,-0.22656E+01,-0.22714E+01,-0.22771E+01,-0.22827E+01,
- &-0.22884E+01,-0.22941E+01,-0.22997E+01,-0.23054E+01,-0.23110E+01,
- &-0.23167E+01,-0.23223E+01,-0.23279E+01,-0.23335E+01,-0.23390E+01,
- &-0.23446E+01,-0.23502E+01,-0.23557E+01,-0.23613E+01,-0.23668E+01,
- &-0.23723E+01,-0.23779E+01,-0.23834E+01,-0.23889E+01,-0.23944E+01,
- &-0.23998E+01
- & /
-C
-C *** NH4Cl
-C
- DATA (BNC06M(I),I=1,100)/
- &-0.49470E-01,-0.10575E+00,-0.13284E+00,-0.15144E+00,-0.16564E+00,
- &-0.17711E+00,-0.18670E+00,-0.19489E+00,-0.20203E+00,-0.20831E+00,
- &-0.21392E+00,-0.21895E+00,-0.22351E+00,-0.22765E+00,-0.23144E+00,
- &-0.23493E+00,-0.23814E+00,-0.24112E+00,-0.24388E+00,-0.24646E+00,
- &-0.24886E+00,-0.25110E+00,-0.25321E+00,-0.25519E+00,-0.25705E+00,
- &-0.25880E+00,-0.26046E+00,-0.26203E+00,-0.26351E+00,-0.26492E+00,
- &-0.26626E+00,-0.26753E+00,-0.26874E+00,-0.26989E+00,-0.27100E+00,
- &-0.27205E+00,-0.27306E+00,-0.27402E+00,-0.27495E+00,-0.27584E+00,
- &-0.27669E+00,-0.27752E+00,-0.27831E+00,-0.27907E+00,-0.27981E+00,
- &-0.28052E+00,-0.28121E+00,-0.28187E+00,-0.28252E+00,-0.28314E+00,
- &-0.28375E+00,-0.28433E+00,-0.28490E+00,-0.28545E+00,-0.28599E+00,
- &-0.28651E+00,-0.28702E+00,-0.28751E+00,-0.28799E+00,-0.28845E+00,
- &-0.28891E+00,-0.28935E+00,-0.28977E+00,-0.29019E+00,-0.29059E+00,
- &-0.29098E+00,-0.29136E+00,-0.29172E+00,-0.29208E+00,-0.29242E+00,
- &-0.29275E+00,-0.29307E+00,-0.29338E+00,-0.29367E+00,-0.29396E+00,
- &-0.29423E+00,-0.29449E+00,-0.29474E+00,-0.29498E+00,-0.29521E+00,
- &-0.29543E+00,-0.29563E+00,-0.29582E+00,-0.29600E+00,-0.29617E+00,
- &-0.29633E+00,-0.29648E+00,-0.29661E+00,-0.29674E+00,-0.29685E+00,
- &-0.29696E+00,-0.29705E+00,-0.29713E+00,-0.29720E+00,-0.29726E+00,
- &-0.29732E+00,-0.29736E+00,-0.29739E+00,-0.29742E+00,-0.29743E+00/
-
- DATA (BNC06M(I),I=101,200)/
- &-0.29744E+00,-0.29744E+00,-0.29743E+00,-0.29741E+00,-0.29738E+00,
- &-0.29735E+00,-0.29731E+00,-0.29726E+00,-0.29721E+00,-0.29715E+00,
- &-0.29708E+00,-0.29701E+00,-0.29693E+00,-0.29685E+00,-0.29676E+00,
- &-0.29667E+00,-0.29658E+00,-0.29647E+00,-0.29637E+00,-0.29626E+00,
- &-0.29615E+00,-0.29603E+00,-0.29591E+00,-0.29579E+00,-0.29566E+00,
- &-0.29554E+00,-0.29540E+00,-0.29527E+00,-0.29513E+00,-0.29500E+00,
- &-0.29486E+00,-0.29471E+00,-0.29457E+00,-0.29442E+00,-0.29427E+00,
- &-0.29413E+00,-0.29397E+00,-0.29382E+00,-0.29367E+00,-0.29351E+00,
- &-0.29336E+00,-0.29320E+00,-0.29304E+00,-0.29288E+00,-0.29272E+00,
- &-0.29256E+00,-0.29239E+00,-0.29223E+00,-0.29207E+00,-0.29190E+00,
- &-0.29173E+00,-0.29157E+00,-0.29140E+00,-0.29123E+00,-0.29106E+00,
- &-0.29089E+00,-0.29072E+00,-0.29055E+00,-0.29038E+00,-0.29021E+00,
- &-0.29004E+00,-0.28987E+00,-0.28970E+00,-0.28953E+00,-0.28935E+00,
- &-0.28918E+00,-0.28901E+00,-0.28883E+00,-0.28866E+00,-0.28848E+00,
- &-0.28831E+00,-0.28814E+00,-0.28796E+00,-0.28779E+00,-0.28761E+00,
- &-0.28744E+00,-0.28726E+00,-0.28709E+00,-0.28691E+00,-0.28674E+00,
- &-0.28656E+00,-0.28639E+00,-0.28621E+00,-0.28604E+00,-0.28586E+00,
- &-0.28569E+00,-0.28551E+00,-0.28534E+00,-0.28516E+00,-0.28499E+00,
- &-0.28481E+00,-0.28464E+00,-0.28447E+00,-0.28429E+00,-0.28412E+00,
- &-0.28395E+00,-0.28377E+00,-0.28360E+00,-0.28343E+00,-0.28325E+00/
-
- DATA (BNC06M(I),I=201,300)/
- &-0.28308E+00,-0.28291E+00,-0.28274E+00,-0.28257E+00,-0.28240E+00,
- &-0.28223E+00,-0.28205E+00,-0.28188E+00,-0.28171E+00,-0.28155E+00,
- &-0.28138E+00,-0.28121E+00,-0.28104E+00,-0.28087E+00,-0.28070E+00,
- &-0.28053E+00,-0.28037E+00,-0.28020E+00,-0.28003E+00,-0.27987E+00,
- &-0.27970E+00,-0.27954E+00,-0.27937E+00,-0.27921E+00,-0.27905E+00,
- &-0.27888E+00,-0.27872E+00,-0.27856E+00,-0.27839E+00,-0.27823E+00,
- &-0.27807E+00,-0.27791E+00,-0.27775E+00,-0.27759E+00,-0.27743E+00,
- &-0.27727E+00,-0.27712E+00,-0.27696E+00,-0.27680E+00,-0.27664E+00,
- &-0.27649E+00,-0.27633E+00,-0.27618E+00,-0.27602E+00,-0.27587E+00,
- &-0.27571E+00,-0.27556E+00,-0.27541E+00,-0.27526E+00,-0.27510E+00,
- &-0.27495E+00,-0.27480E+00,-0.27465E+00,-0.27450E+00,-0.27435E+00,
- &-0.27421E+00,-0.27406E+00,-0.27391E+00,-0.27376E+00,-0.27362E+00,
- &-0.27347E+00,-0.27333E+00,-0.27318E+00,-0.27304E+00,-0.27290E+00,
- &-0.27275E+00,-0.27261E+00,-0.27247E+00,-0.27233E+00,-0.27219E+00,
- &-0.27205E+00,-0.27191E+00,-0.27177E+00,-0.27163E+00,-0.27149E+00,
- &-0.27136E+00,-0.27122E+00,-0.27109E+00,-0.27095E+00,-0.27082E+00,
- &-0.27068E+00,-0.27055E+00,-0.27042E+00,-0.27028E+00,-0.27015E+00,
- &-0.27002E+00,-0.26989E+00,-0.26976E+00,-0.26963E+00,-0.26950E+00,
- &-0.26938E+00,-0.26925E+00,-0.26912E+00,-0.26900E+00,-0.26887E+00,
- &-0.26875E+00,-0.26862E+00,-0.26850E+00,-0.26837E+00,-0.26825E+00/
-
- DATA (BNC06M(I),I=301,400)/
- &-0.26813E+00,-0.26801E+00,-0.26789E+00,-0.26777E+00,-0.26765E+00,
- &-0.26753E+00,-0.26741E+00,-0.26729E+00,-0.26718E+00,-0.26706E+00,
- &-0.26694E+00,-0.26683E+00,-0.26672E+00,-0.26660E+00,-0.26649E+00,
- &-0.26638E+00,-0.26626E+00,-0.26615E+00,-0.26604E+00,-0.26593E+00,
- &-0.26582E+00,-0.26571E+00,-0.26560E+00,-0.26550E+00,-0.26539E+00,
- &-0.26528E+00,-0.26518E+00,-0.26507E+00,-0.26497E+00,-0.26486E+00,
- &-0.26476E+00,-0.26466E+00,-0.26455E+00,-0.26445E+00,-0.26435E+00,
- &-0.26425E+00,-0.26415E+00,-0.26405E+00,-0.26395E+00,-0.26385E+00,
- &-0.26376E+00,-0.26366E+00,-0.26356E+00,-0.26347E+00,-0.26337E+00,
- &-0.26328E+00,-0.26319E+00,-0.26309E+00,-0.26300E+00,-0.26291E+00,
- &-0.26282E+00,-0.26273E+00,-0.26264E+00,-0.26255E+00,-0.26246E+00,
- &-0.26237E+00,-0.26228E+00,-0.26219E+00,-0.26211E+00,-0.26202E+00,
- &-0.26194E+00,-0.26185E+00,-0.26177E+00,-0.26168E+00,-0.26160E+00,
- &-0.26152E+00,-0.26144E+00,-0.26136E+00,-0.26128E+00,-0.26120E+00,
- &-0.26112E+00,-0.26104E+00,-0.26096E+00,-0.26088E+00,-0.26081E+00,
- &-0.26073E+00,-0.26065E+00,-0.26058E+00,-0.26050E+00,-0.26043E+00,
- &-0.26036E+00,-0.26028E+00,-0.26021E+00,-0.26014E+00,-0.26007E+00,
- &-0.26000E+00,-0.25993E+00,-0.25986E+00,-0.25979E+00,-0.25972E+00,
- &-0.25965E+00,-0.25959E+00,-0.25952E+00,-0.25945E+00,-0.25939E+00,
- &-0.25932E+00,-0.25926E+00,-0.25920E+00,-0.25913E+00,-0.25907E+00/
-
- DATA (BNC06M(I),I=401,500)/
- &-0.25901E+00,-0.25895E+00,-0.25889E+00,-0.25883E+00,-0.25877E+00,
- &-0.25871E+00,-0.25865E+00,-0.25859E+00,-0.25853E+00,-0.25848E+00,
- &-0.25842E+00,-0.25837E+00,-0.25831E+00,-0.25826E+00,-0.25820E+00,
- &-0.25815E+00,-0.25810E+00,-0.25804E+00,-0.25799E+00,-0.25794E+00,
- &-0.25789E+00,-0.25784E+00,-0.25779E+00,-0.25774E+00,-0.25769E+00,
- &-0.25765E+00,-0.25760E+00,-0.25755E+00,-0.25751E+00,-0.25746E+00,
- &-0.25741E+00,-0.25737E+00,-0.25733E+00,-0.25728E+00,-0.25724E+00,
- &-0.25720E+00,-0.25715E+00,-0.25711E+00,-0.25707E+00,-0.25703E+00,
- &-0.25699E+00,-0.25695E+00,-0.25692E+00,-0.25688E+00,-0.25684E+00,
- &-0.25680E+00,-0.25677E+00,-0.25673E+00,-0.25669E+00,-0.25666E+00,
- &-0.25662E+00,-0.25659E+00,-0.25656E+00,-0.25652E+00,-0.25649E+00,
- &-0.25646E+00,-0.25643E+00,-0.25640E+00,-0.25637E+00,-0.25634E+00,
- &-0.25631E+00,-0.25628E+00,-0.25625E+00,-0.25623E+00,-0.25620E+00,
- &-0.25617E+00,-0.25615E+00,-0.25612E+00,-0.25609E+00,-0.25607E+00,
- &-0.25605E+00,-0.25602E+00,-0.25600E+00,-0.25598E+00,-0.25596E+00,
- &-0.25593E+00,-0.25591E+00,-0.25589E+00,-0.25587E+00,-0.25585E+00,
- &-0.25583E+00,-0.25582E+00,-0.25580E+00,-0.25578E+00,-0.25576E+00,
- &-0.25575E+00,-0.25573E+00,-0.25571E+00,-0.25570E+00,-0.25569E+00,
- &-0.25567E+00,-0.25566E+00,-0.25564E+00,-0.25563E+00,-0.25562E+00,
- &-0.25561E+00,-0.25560E+00,-0.25559E+00,-0.25558E+00,-0.25557E+00/
-
- DATA (BNC06M(I),I=501,600)/
- &-0.25556E+00,-0.25555E+00,-0.25554E+00,-0.25553E+00,-0.25553E+00,
- &-0.25552E+00,-0.25551E+00,-0.25551E+00,-0.25550E+00,-0.25550E+00,
- &-0.25549E+00,-0.25549E+00,-0.25549E+00,-0.25548E+00,-0.25548E+00,
- &-0.25548E+00,-0.25548E+00,-0.25548E+00,-0.25547E+00,-0.25547E+00,
- &-0.25547E+00,-0.25548E+00,-0.25548E+00,-0.25548E+00,-0.25548E+00,
- &-0.25548E+00,-0.25549E+00,-0.25549E+00,-0.25549E+00,-0.25550E+00,
- &-0.25550E+00,-0.25551E+00,-0.25551E+00,-0.25552E+00,-0.25553E+00,
- &-0.25553E+00,-0.25554E+00,-0.25555E+00,-0.25556E+00,-0.25557E+00,
- &-0.25558E+00,-0.25559E+00,-0.25560E+00,-0.25561E+00,-0.25562E+00,
- &-0.25563E+00,-0.25564E+00,-0.25566E+00,-0.25567E+00,-0.25568E+00,
- &-0.25570E+00,-0.25571E+00,-0.25573E+00,-0.25574E+00,-0.25576E+00,
- &-0.25577E+00,-0.25579E+00,-0.25581E+00,-0.25582E+00,-0.25584E+00,
- &-0.25586E+00,-0.25588E+00,-0.25590E+00,-0.25592E+00,-0.25594E+00,
- &-0.25596E+00,-0.25598E+00,-0.25600E+00,-0.25602E+00,-0.25604E+00,
- &-0.25607E+00,-0.25609E+00,-0.25611E+00,-0.25614E+00,-0.25616E+00,
- &-0.25619E+00,-0.25621E+00,-0.25624E+00,-0.25626E+00,-0.25629E+00,
- &-0.25632E+00,-0.25634E+00,-0.25637E+00,-0.25640E+00,-0.25643E+00,
- &-0.25646E+00,-0.25649E+00,-0.25651E+00,-0.25654E+00,-0.25658E+00,
- &-0.25661E+00,-0.25664E+00,-0.25667E+00,-0.25670E+00,-0.25673E+00,
- &-0.25677E+00,-0.25680E+00,-0.25683E+00,-0.25687E+00,-0.25690E+00/
-
- DATA (BNC06M(I),I=601,700)/
- &-0.25730E+00,-0.25771E+00,-0.25816E+00,-0.25865E+00,-0.25917E+00,
- &-0.25973E+00,-0.26033E+00,-0.26096E+00,-0.26163E+00,-0.26233E+00,
- &-0.26307E+00,-0.26383E+00,-0.26463E+00,-0.26547E+00,-0.26633E+00,
- &-0.26722E+00,-0.26815E+00,-0.26910E+00,-0.27009E+00,-0.27110E+00,
- &-0.27214E+00,-0.27320E+00,-0.27430E+00,-0.27542E+00,-0.27657E+00,
- &-0.27774E+00,-0.27894E+00,-0.28017E+00,-0.28142E+00,-0.28269E+00,
- &-0.28399E+00,-0.28531E+00,-0.28666E+00,-0.28803E+00,-0.28942E+00,
- &-0.29083E+00,-0.29226E+00,-0.29372E+00,-0.29520E+00,-0.29669E+00,
- &-0.29821E+00,-0.29975E+00,-0.30131E+00,-0.30289E+00,-0.30449E+00,
- &-0.30610E+00,-0.30774E+00,-0.30939E+00,-0.31107E+00,-0.31276E+00,
- &-0.31447E+00,-0.31619E+00,-0.31794E+00,-0.31970E+00,-0.32147E+00,
- &-0.32327E+00,-0.32508E+00,-0.32690E+00,-0.32875E+00,-0.33060E+00,
- &-0.33248E+00,-0.33437E+00,-0.33627E+00,-0.33819E+00,-0.34012E+00,
- &-0.34207E+00,-0.34403E+00,-0.34601E+00,-0.34800E+00,-0.35001E+00,
- &-0.35203E+00,-0.35406E+00,-0.35610E+00,-0.35816E+00,-0.36023E+00,
- &-0.36232E+00,-0.36441E+00,-0.36652E+00,-0.36864E+00,-0.37078E+00,
- &-0.37292E+00,-0.37508E+00,-0.37725E+00,-0.37943E+00,-0.38162E+00,
- &-0.38383E+00,-0.38604E+00,-0.38827E+00,-0.39051E+00,-0.39275E+00,
- &-0.39501E+00,-0.39728E+00,-0.39956E+00,-0.40185E+00,-0.40415E+00,
- &-0.40646E+00,-0.40879E+00,-0.41112E+00,-0.41346E+00,-0.41581E+00/
-
- DATA (BNC06M(I),I=701,741)/
- &-0.41817E+00,-0.42054E+00,-0.42292E+00,-0.42530E+00,-0.42770E+00,
- &-0.43011E+00,-0.43252E+00,-0.43495E+00,-0.43738E+00,-0.43982E+00,
- &-0.44227E+00,-0.44473E+00,-0.44720E+00,-0.44967E+00,-0.45216E+00,
- &-0.45465E+00,-0.45715E+00,-0.45966E+00,-0.46218E+00,-0.46470E+00,
- &-0.46723E+00,-0.46977E+00,-0.47232E+00,-0.47487E+00,-0.47744E+00,
- &-0.48001E+00,-0.48258E+00,-0.48517E+00,-0.48776E+00,-0.49036E+00,
- &-0.49296E+00,-0.49558E+00,-0.49820E+00,-0.50082E+00,-0.50346E+00,
- &-0.50610E+00,-0.50874E+00,-0.51140E+00,-0.51406E+00,-0.51672E+00,
- &-0.51940E+00
- & /
-C
-C *** (2H,SO4)
-C
- DATA (BNC07M(I),I=1,100)/
- &-0.10030E+00,-0.21886E+00,-0.27851E+00,-0.32089E+00,-0.35431E+00,
- &-0.38211E+00,-0.40602E+00,-0.42706E+00,-0.44588E+00,-0.46295E+00,
- &-0.47857E+00,-0.49300E+00,-0.50642E+00,-0.51897E+00,-0.53076E+00,
- &-0.54189E+00,-0.55244E+00,-0.56247E+00,-0.57203E+00,-0.58117E+00,
- &-0.58993E+00,-0.59834E+00,-0.60644E+00,-0.61425E+00,-0.62178E+00,
- &-0.62907E+00,-0.63613E+00,-0.64298E+00,-0.64962E+00,-0.65608E+00,
- &-0.66236E+00,-0.66848E+00,-0.67445E+00,-0.68027E+00,-0.68595E+00,
- &-0.69151E+00,-0.69694E+00,-0.70225E+00,-0.70745E+00,-0.71255E+00,
- &-0.71755E+00,-0.72245E+00,-0.72726E+00,-0.73198E+00,-0.73662E+00,
- &-0.74117E+00,-0.74566E+00,-0.75006E+00,-0.75440E+00,-0.75867E+00,
- &-0.76287E+00,-0.76702E+00,-0.77110E+00,-0.77512E+00,-0.77909E+00,
- &-0.78300E+00,-0.78686E+00,-0.79067E+00,-0.79443E+00,-0.79815E+00,
- &-0.80182E+00,-0.80545E+00,-0.80903E+00,-0.81257E+00,-0.81608E+00,
- &-0.81954E+00,-0.82297E+00,-0.82637E+00,-0.82972E+00,-0.83305E+00,
- &-0.83634E+00,-0.83960E+00,-0.84283E+00,-0.84603E+00,-0.84920E+00,
- &-0.85234E+00,-0.85546E+00,-0.85855E+00,-0.86161E+00,-0.86465E+00,
- &-0.86767E+00,-0.87066E+00,-0.87362E+00,-0.87657E+00,-0.87949E+00,
- &-0.88240E+00,-0.88528E+00,-0.88814E+00,-0.89099E+00,-0.89381E+00,
- &-0.89661E+00,-0.89940E+00,-0.90217E+00,-0.90492E+00,-0.90766E+00,
- &-0.91037E+00,-0.91308E+00,-0.91576E+00,-0.91843E+00,-0.92109E+00/
-
- DATA (BNC07M(I),I=101,200)/
- &-0.92372E+00,-0.92635E+00,-0.92896E+00,-0.93155E+00,-0.93414E+00,
- &-0.93670E+00,-0.93926E+00,-0.94180E+00,-0.94433E+00,-0.94684E+00,
- &-0.94935E+00,-0.95184E+00,-0.95431E+00,-0.95678E+00,-0.95923E+00,
- &-0.96168E+00,-0.96411E+00,-0.96653E+00,-0.96893E+00,-0.97133E+00,
- &-0.97372E+00,-0.97609E+00,-0.97845E+00,-0.98081E+00,-0.98315E+00,
- &-0.98549E+00,-0.98781E+00,-0.99012E+00,-0.99243E+00,-0.99472E+00,
- &-0.99700E+00,-0.99928E+00,-0.10015E+01,-0.10038E+01,-0.10060E+01,
- &-0.10083E+01,-0.10105E+01,-0.10127E+01,-0.10150E+01,-0.10172E+01,
- &-0.10194E+01,-0.10215E+01,-0.10237E+01,-0.10259E+01,-0.10281E+01,
- &-0.10302E+01,-0.10324E+01,-0.10345E+01,-0.10366E+01,-0.10388E+01,
- &-0.10409E+01,-0.10430E+01,-0.10451E+01,-0.10472E+01,-0.10493E+01,
- &-0.10514E+01,-0.10534E+01,-0.10555E+01,-0.10576E+01,-0.10596E+01,
- &-0.10617E+01,-0.10637E+01,-0.10658E+01,-0.10678E+01,-0.10698E+01,
- &-0.10718E+01,-0.10738E+01,-0.10759E+01,-0.10779E+01,-0.10798E+01,
- &-0.10818E+01,-0.10838E+01,-0.10858E+01,-0.10878E+01,-0.10897E+01,
- &-0.10917E+01,-0.10937E+01,-0.10956E+01,-0.10976E+01,-0.10995E+01,
- &-0.11014E+01,-0.11034E+01,-0.11053E+01,-0.11072E+01,-0.11091E+01,
- &-0.11110E+01,-0.11129E+01,-0.11148E+01,-0.11167E+01,-0.11186E+01,
- &-0.11205E+01,-0.11224E+01,-0.11243E+01,-0.11261E+01,-0.11280E+01,
- &-0.11299E+01,-0.11317E+01,-0.11336E+01,-0.11354E+01,-0.11373E+01/
-
- DATA (BNC07M(I),I=201,300)/
- &-0.11391E+01,-0.11410E+01,-0.11428E+01,-0.11446E+01,-0.11465E+01,
- &-0.11483E+01,-0.11501E+01,-0.11519E+01,-0.11537E+01,-0.11555E+01,
- &-0.11573E+01,-0.11591E+01,-0.11609E+01,-0.11627E+01,-0.11645E+01,
- &-0.11663E+01,-0.11681E+01,-0.11699E+01,-0.11716E+01,-0.11734E+01,
- &-0.11752E+01,-0.11769E+01,-0.11787E+01,-0.11804E+01,-0.11822E+01,
- &-0.11840E+01,-0.11857E+01,-0.11874E+01,-0.11892E+01,-0.11909E+01,
- &-0.11926E+01,-0.11944E+01,-0.11961E+01,-0.11978E+01,-0.11996E+01,
- &-0.12013E+01,-0.12030E+01,-0.12047E+01,-0.12064E+01,-0.12081E+01,
- &-0.12098E+01,-0.12115E+01,-0.12132E+01,-0.12149E+01,-0.12166E+01,
- &-0.12183E+01,-0.12200E+01,-0.12216E+01,-0.12233E+01,-0.12250E+01,
- &-0.12267E+01,-0.12283E+01,-0.12300E+01,-0.12317E+01,-0.12333E+01,
- &-0.12350E+01,-0.12367E+01,-0.12383E+01,-0.12400E+01,-0.12416E+01,
- &-0.12433E+01,-0.12449E+01,-0.12466E+01,-0.12482E+01,-0.12498E+01,
- &-0.12515E+01,-0.12531E+01,-0.12547E+01,-0.12564E+01,-0.12580E+01,
- &-0.12596E+01,-0.12612E+01,-0.12628E+01,-0.12645E+01,-0.12661E+01,
- &-0.12677E+01,-0.12693E+01,-0.12709E+01,-0.12725E+01,-0.12741E+01,
- &-0.12757E+01,-0.12773E+01,-0.12789E+01,-0.12805E+01,-0.12821E+01,
- &-0.12837E+01,-0.12853E+01,-0.12869E+01,-0.12884E+01,-0.12900E+01,
- &-0.12916E+01,-0.12932E+01,-0.12947E+01,-0.12963E+01,-0.12979E+01,
- &-0.12995E+01,-0.13010E+01,-0.13026E+01,-0.13042E+01,-0.13057E+01/
-
- DATA (BNC07M(I),I=301,400)/
- &-0.13073E+01,-0.13088E+01,-0.13104E+01,-0.13119E+01,-0.13135E+01,
- &-0.13150E+01,-0.13166E+01,-0.13181E+01,-0.13197E+01,-0.13212E+01,
- &-0.13228E+01,-0.13243E+01,-0.13258E+01,-0.13274E+01,-0.13289E+01,
- &-0.13304E+01,-0.13320E+01,-0.13335E+01,-0.13350E+01,-0.13365E+01,
- &-0.13381E+01,-0.13396E+01,-0.13411E+01,-0.13426E+01,-0.13441E+01,
- &-0.13456E+01,-0.13472E+01,-0.13487E+01,-0.13502E+01,-0.13517E+01,
- &-0.13532E+01,-0.13547E+01,-0.13562E+01,-0.13577E+01,-0.13592E+01,
- &-0.13607E+01,-0.13622E+01,-0.13637E+01,-0.13652E+01,-0.13667E+01,
- &-0.13682E+01,-0.13696E+01,-0.13711E+01,-0.13726E+01,-0.13741E+01,
- &-0.13756E+01,-0.13771E+01,-0.13785E+01,-0.13800E+01,-0.13815E+01,
- &-0.13830E+01,-0.13844E+01,-0.13859E+01,-0.13874E+01,-0.13888E+01,
- &-0.13903E+01,-0.13918E+01,-0.13932E+01,-0.13947E+01,-0.13962E+01,
- &-0.13976E+01,-0.13991E+01,-0.14005E+01,-0.14020E+01,-0.14035E+01,
- &-0.14049E+01,-0.14064E+01,-0.14078E+01,-0.14093E+01,-0.14107E+01,
- &-0.14122E+01,-0.14136E+01,-0.14151E+01,-0.14165E+01,-0.14179E+01,
- &-0.14194E+01,-0.14208E+01,-0.14223E+01,-0.14237E+01,-0.14251E+01,
- &-0.14266E+01,-0.14280E+01,-0.14294E+01,-0.14309E+01,-0.14323E+01,
- &-0.14337E+01,-0.14351E+01,-0.14366E+01,-0.14380E+01,-0.14394E+01,
- &-0.14408E+01,-0.14423E+01,-0.14437E+01,-0.14451E+01,-0.14465E+01,
- &-0.14479E+01,-0.14493E+01,-0.14508E+01,-0.14522E+01,-0.14536E+01/
-
- DATA (BNC07M(I),I=401,500)/
- &-0.14550E+01,-0.14564E+01,-0.14578E+01,-0.14592E+01,-0.14606E+01,
- &-0.14620E+01,-0.14634E+01,-0.14648E+01,-0.14662E+01,-0.14676E+01,
- &-0.14690E+01,-0.14704E+01,-0.14718E+01,-0.14732E+01,-0.14746E+01,
- &-0.14760E+01,-0.14774E+01,-0.14788E+01,-0.14802E+01,-0.14816E+01,
- &-0.14830E+01,-0.14844E+01,-0.14857E+01,-0.14871E+01,-0.14885E+01,
- &-0.14899E+01,-0.14913E+01,-0.14927E+01,-0.14940E+01,-0.14954E+01,
- &-0.14968E+01,-0.14982E+01,-0.14995E+01,-0.15009E+01,-0.15023E+01,
- &-0.15037E+01,-0.15050E+01,-0.15064E+01,-0.15078E+01,-0.15092E+01,
- &-0.15105E+01,-0.15119E+01,-0.15133E+01,-0.15146E+01,-0.15160E+01,
- &-0.15174E+01,-0.15187E+01,-0.15201E+01,-0.15214E+01,-0.15228E+01,
- &-0.15242E+01,-0.15255E+01,-0.15269E+01,-0.15282E+01,-0.15296E+01,
- &-0.15309E+01,-0.15323E+01,-0.15336E+01,-0.15350E+01,-0.15364E+01,
- &-0.15377E+01,-0.15391E+01,-0.15404E+01,-0.15417E+01,-0.15431E+01,
- &-0.15444E+01,-0.15458E+01,-0.15471E+01,-0.15485E+01,-0.15498E+01,
- &-0.15512E+01,-0.15525E+01,-0.15538E+01,-0.15552E+01,-0.15565E+01,
- &-0.15579E+01,-0.15592E+01,-0.15605E+01,-0.15619E+01,-0.15632E+01,
- &-0.15645E+01,-0.15659E+01,-0.15672E+01,-0.15685E+01,-0.15699E+01,
- &-0.15712E+01,-0.15725E+01,-0.15738E+01,-0.15752E+01,-0.15765E+01,
- &-0.15778E+01,-0.15791E+01,-0.15805E+01,-0.15818E+01,-0.15831E+01,
- &-0.15844E+01,-0.15858E+01,-0.15871E+01,-0.15884E+01,-0.15897E+01/
-
- DATA (BNC07M(I),I=501,600)/
- &-0.15910E+01,-0.15923E+01,-0.15937E+01,-0.15950E+01,-0.15963E+01,
- &-0.15976E+01,-0.15989E+01,-0.16002E+01,-0.16015E+01,-0.16029E+01,
- &-0.16042E+01,-0.16055E+01,-0.16068E+01,-0.16081E+01,-0.16094E+01,
- &-0.16107E+01,-0.16120E+01,-0.16133E+01,-0.16146E+01,-0.16159E+01,
- &-0.16172E+01,-0.16185E+01,-0.16198E+01,-0.16211E+01,-0.16224E+01,
- &-0.16237E+01,-0.16250E+01,-0.16263E+01,-0.16276E+01,-0.16289E+01,
- &-0.16302E+01,-0.16315E+01,-0.16328E+01,-0.16341E+01,-0.16354E+01,
- &-0.16367E+01,-0.16380E+01,-0.16393E+01,-0.16406E+01,-0.16418E+01,
- &-0.16431E+01,-0.16444E+01,-0.16457E+01,-0.16470E+01,-0.16483E+01,
- &-0.16496E+01,-0.16509E+01,-0.16521E+01,-0.16534E+01,-0.16547E+01,
- &-0.16560E+01,-0.16573E+01,-0.16586E+01,-0.16598E+01,-0.16611E+01,
- &-0.16624E+01,-0.16637E+01,-0.16650E+01,-0.16662E+01,-0.16675E+01,
- &-0.16688E+01,-0.16701E+01,-0.16713E+01,-0.16726E+01,-0.16739E+01,
- &-0.16752E+01,-0.16764E+01,-0.16777E+01,-0.16790E+01,-0.16803E+01,
- &-0.16815E+01,-0.16828E+01,-0.16841E+01,-0.16853E+01,-0.16866E+01,
- &-0.16879E+01,-0.16891E+01,-0.16904E+01,-0.16917E+01,-0.16929E+01,
- &-0.16942E+01,-0.16955E+01,-0.16967E+01,-0.16980E+01,-0.16992E+01,
- &-0.17005E+01,-0.17018E+01,-0.17030E+01,-0.17043E+01,-0.17056E+01,
- &-0.17068E+01,-0.17081E+01,-0.17093E+01,-0.17106E+01,-0.17118E+01,
- &-0.17131E+01,-0.17144E+01,-0.17156E+01,-0.17169E+01,-0.17181E+01/
-
- DATA (BNC07M(I),I=601,700)/
- &-0.17316E+01,-0.17441E+01,-0.17565E+01,-0.17688E+01,-0.17811E+01,
- &-0.17934E+01,-0.18056E+01,-0.18178E+01,-0.18299E+01,-0.18420E+01,
- &-0.18540E+01,-0.18660E+01,-0.18780E+01,-0.18899E+01,-0.19018E+01,
- &-0.19136E+01,-0.19254E+01,-0.19372E+01,-0.19489E+01,-0.19607E+01,
- &-0.19723E+01,-0.19840E+01,-0.19956E+01,-0.20072E+01,-0.20187E+01,
- &-0.20302E+01,-0.20417E+01,-0.20532E+01,-0.20646E+01,-0.20760E+01,
- &-0.20874E+01,-0.20988E+01,-0.21101E+01,-0.21214E+01,-0.21327E+01,
- &-0.21440E+01,-0.21552E+01,-0.21664E+01,-0.21776E+01,-0.21888E+01,
- &-0.21999E+01,-0.22110E+01,-0.22221E+01,-0.22332E+01,-0.22443E+01,
- &-0.22553E+01,-0.22663E+01,-0.22773E+01,-0.22883E+01,-0.22992E+01,
- &-0.23102E+01,-0.23211E+01,-0.23320E+01,-0.23429E+01,-0.23537E+01,
- &-0.23646E+01,-0.23754E+01,-0.23862E+01,-0.23970E+01,-0.24078E+01,
- &-0.24186E+01,-0.24293E+01,-0.24401E+01,-0.24508E+01,-0.24615E+01,
- &-0.24722E+01,-0.24828E+01,-0.24935E+01,-0.25041E+01,-0.25148E+01,
- &-0.25254E+01,-0.25360E+01,-0.25466E+01,-0.25571E+01,-0.25677E+01,
- &-0.25782E+01,-0.25888E+01,-0.25993E+01,-0.26098E+01,-0.26203E+01,
- &-0.26308E+01,-0.26412E+01,-0.26517E+01,-0.26621E+01,-0.26726E+01,
- &-0.26830E+01,-0.26934E+01,-0.27038E+01,-0.27142E+01,-0.27245E+01,
- &-0.27349E+01,-0.27453E+01,-0.27556E+01,-0.27659E+01,-0.27762E+01,
- &-0.27866E+01,-0.27968E+01,-0.28071E+01,-0.28174E+01,-0.28277E+01/
-
- DATA (BNC07M(I),I=701,741)/
- &-0.28379E+01,-0.28482E+01,-0.28584E+01,-0.28686E+01,-0.28788E+01,
- &-0.28891E+01,-0.28992E+01,-0.29094E+01,-0.29196E+01,-0.29298E+01,
- &-0.29399E+01,-0.29501E+01,-0.29602E+01,-0.29704E+01,-0.29805E+01,
- &-0.29906E+01,-0.30007E+01,-0.30108E+01,-0.30209E+01,-0.30310E+01,
- &-0.30410E+01,-0.30511E+01,-0.30612E+01,-0.30712E+01,-0.30812E+01,
- &-0.30913E+01,-0.31013E+01,-0.31113E+01,-0.31213E+01,-0.31313E+01,
- &-0.31413E+01,-0.31513E+01,-0.31613E+01,-0.31712E+01,-0.31812E+01,
- &-0.31911E+01,-0.32011E+01,-0.32110E+01,-0.32210E+01,-0.32309E+01,
- &-0.32408E+01
- & /
-C
-C *** (H,HSO4)
-C
- DATA (BNC08M(I),I=1,100)/
- &-0.46515E-01,-0.91308E-01,-0.10881E+00,-0.11870E+00,-0.12469E+00,
- &-0.12827E+00,-0.13017E+00,-0.13082E+00,-0.13049E+00,-0.12935E+00,
- &-0.12755E+00,-0.12518E+00,-0.12230E+00,-0.11897E+00,-0.11525E+00,
- &-0.11116E+00,-0.10674E+00,-0.10201E+00,-0.96987E-01,-0.91699E-01,
- &-0.86157E-01,-0.80377E-01,-0.74371E-01,-0.68150E-01,-0.61725E-01,
- &-0.55105E-01,-0.48299E-01,-0.41316E-01,-0.34162E-01,-0.26845E-01,
- &-0.19373E-01,-0.11750E-01,-0.39845E-02, 0.39191E-02, 0.11955E-01,
- & 0.20117E-01, 0.28401E-01, 0.36802E-01, 0.45314E-01, 0.53933E-01,
- & 0.62655E-01, 0.71475E-01, 0.80389E-01, 0.89394E-01, 0.98485E-01,
- & 0.10766E+00, 0.11691E+00, 0.12624E+00, 0.13564E+00, 0.14512E+00,
- & 0.15465E+00, 0.16426E+00, 0.17392E+00, 0.18365E+00, 0.19344E+00,
- & 0.20328E+00, 0.21317E+00, 0.22312E+00, 0.23312E+00, 0.24317E+00,
- & 0.25327E+00, 0.26342E+00, 0.27361E+00, 0.28386E+00, 0.29415E+00,
- & 0.30449E+00, 0.31488E+00, 0.32532E+00, 0.33580E+00, 0.34633E+00,
- & 0.35692E+00, 0.36755E+00, 0.37823E+00, 0.38897E+00, 0.39976E+00,
- & 0.41060E+00, 0.42149E+00, 0.43244E+00, 0.44344E+00, 0.45450E+00,
- & 0.46562E+00, 0.47680E+00, 0.48803E+00, 0.49932E+00, 0.51068E+00,
- & 0.52209E+00, 0.53356E+00, 0.54509E+00, 0.55667E+00, 0.56832E+00,
- & 0.58003E+00, 0.59179E+00, 0.60361E+00, 0.61548E+00, 0.62741E+00,
- & 0.63940E+00, 0.65143E+00, 0.66352E+00, 0.67565E+00, 0.68783E+00/
-
- DATA (BNC08M(I),I=101,200)/
- & 0.70006E+00, 0.71232E+00, 0.72463E+00, 0.73698E+00, 0.74937E+00,
- & 0.76178E+00, 0.77424E+00, 0.78672E+00, 0.79922E+00, 0.81176E+00,
- & 0.82431E+00, 0.83689E+00, 0.84948E+00, 0.86209E+00, 0.87472E+00,
- & 0.88735E+00, 0.90000E+00, 0.91265E+00, 0.92531E+00, 0.93797E+00,
- & 0.95064E+00, 0.96330E+00, 0.97596E+00, 0.98862E+00, 0.10013E+01,
- & 0.10139E+01, 0.10266E+01, 0.10392E+01, 0.10518E+01, 0.10644E+01,
- & 0.10770E+01, 0.10896E+01, 0.11022E+01, 0.11148E+01, 0.11273E+01,
- & 0.11398E+01, 0.11524E+01, 0.11648E+01, 0.11773E+01, 0.11898E+01,
- & 0.12022E+01, 0.12146E+01, 0.12270E+01, 0.12394E+01, 0.12518E+01,
- & 0.12641E+01, 0.12764E+01, 0.12887E+01, 0.13010E+01, 0.13132E+01,
- & 0.13254E+01, 0.13376E+01, 0.13498E+01, 0.13620E+01, 0.13741E+01,
- & 0.13862E+01, 0.13983E+01, 0.14103E+01, 0.14224E+01, 0.14344E+01,
- & 0.14464E+01, 0.14583E+01, 0.14703E+01, 0.14822E+01, 0.14941E+01,
- & 0.15059E+01, 0.15178E+01, 0.15296E+01, 0.15414E+01, 0.15531E+01,
- & 0.15649E+01, 0.15766E+01, 0.15883E+01, 0.15999E+01, 0.16116E+01,
- & 0.16232E+01, 0.16348E+01, 0.16463E+01, 0.16579E+01, 0.16694E+01,
- & 0.16809E+01, 0.16923E+01, 0.17038E+01, 0.17152E+01, 0.17266E+01,
- & 0.17379E+01, 0.17493E+01, 0.17606E+01, 0.17719E+01, 0.17831E+01,
- & 0.17943E+01, 0.18056E+01, 0.18167E+01, 0.18279E+01, 0.18390E+01,
- & 0.18501E+01, 0.18612E+01, 0.18723E+01, 0.18833E+01, 0.18943E+01/
-
- DATA (BNC08M(I),I=201,300)/
- & 0.19053E+01, 0.19163E+01, 0.19272E+01, 0.19381E+01, 0.19490E+01,
- & 0.19599E+01, 0.19707E+01, 0.19815E+01, 0.19923E+01, 0.20031E+01,
- & 0.20138E+01, 0.20246E+01, 0.20353E+01, 0.20459E+01, 0.20566E+01,
- & 0.20672E+01, 0.20778E+01, 0.20884E+01, 0.20989E+01, 0.21095E+01,
- & 0.21200E+01, 0.21304E+01, 0.21409E+01, 0.21513E+01, 0.21617E+01,
- & 0.21721E+01, 0.21825E+01, 0.21928E+01, 0.22032E+01, 0.22134E+01,
- & 0.22237E+01, 0.22340E+01, 0.22442E+01, 0.22544E+01, 0.22646E+01,
- & 0.22747E+01, 0.22849E+01, 0.22950E+01, 0.23051E+01, 0.23152E+01,
- & 0.23252E+01, 0.23352E+01, 0.23452E+01, 0.23552E+01, 0.23652E+01,
- & 0.23751E+01, 0.23850E+01, 0.23949E+01, 0.24048E+01, 0.24147E+01,
- & 0.24245E+01, 0.24343E+01, 0.24441E+01, 0.24539E+01, 0.24636E+01,
- & 0.24733E+01, 0.24830E+01, 0.24927E+01, 0.25024E+01, 0.25120E+01,
- & 0.25216E+01, 0.25312E+01, 0.25408E+01, 0.25504E+01, 0.25599E+01,
- & 0.25694E+01, 0.25789E+01, 0.25884E+01, 0.25979E+01, 0.26073E+01,
- & 0.26167E+01, 0.26261E+01, 0.26355E+01, 0.26448E+01, 0.26542E+01,
- & 0.26635E+01, 0.26728E+01, 0.26821E+01, 0.26913E+01, 0.27006E+01,
- & 0.27098E+01, 0.27190E+01, 0.27282E+01, 0.27373E+01, 0.27465E+01,
- & 0.27556E+01, 0.27647E+01, 0.27738E+01, 0.27829E+01, 0.27919E+01,
- & 0.28009E+01, 0.28100E+01, 0.28190E+01, 0.28279E+01, 0.28369E+01,
- & 0.28458E+01, 0.28547E+01, 0.28636E+01, 0.28725E+01, 0.28814E+01/
-
- DATA (BNC08M(I),I=301,400)/
- & 0.28902E+01, 0.28991E+01, 0.29079E+01, 0.29167E+01, 0.29255E+01,
- & 0.29342E+01, 0.29430E+01, 0.29517E+01, 0.29604E+01, 0.29691E+01,
- & 0.29778E+01, 0.29864E+01, 0.29950E+01, 0.30037E+01, 0.30123E+01,
- & 0.30209E+01, 0.30294E+01, 0.30380E+01, 0.30465E+01, 0.30550E+01,
- & 0.30635E+01, 0.30720E+01, 0.30805E+01, 0.30889E+01, 0.30974E+01,
- & 0.31058E+01, 0.31142E+01, 0.31226E+01, 0.31309E+01, 0.31393E+01,
- & 0.31476E+01, 0.31559E+01, 0.31643E+01, 0.31725E+01, 0.31808E+01,
- & 0.31891E+01, 0.31973E+01, 0.32055E+01, 0.32137E+01, 0.32219E+01,
- & 0.32301E+01, 0.32383E+01, 0.32464E+01, 0.32546E+01, 0.32627E+01,
- & 0.32708E+01, 0.32789E+01, 0.32869E+01, 0.32950E+01, 0.33030E+01,
- & 0.33110E+01, 0.33191E+01, 0.33270E+01, 0.33350E+01, 0.33430E+01,
- & 0.33509E+01, 0.33589E+01, 0.33668E+01, 0.33747E+01, 0.33826E+01,
- & 0.33905E+01, 0.33983E+01, 0.34062E+01, 0.34140E+01, 0.34218E+01,
- & 0.34296E+01, 0.34374E+01, 0.34452E+01, 0.34530E+01, 0.34607E+01,
- & 0.34684E+01, 0.34762E+01, 0.34839E+01, 0.34915E+01, 0.34992E+01,
- & 0.35069E+01, 0.35145E+01, 0.35222E+01, 0.35298E+01, 0.35374E+01,
- & 0.35450E+01, 0.35526E+01, 0.35601E+01, 0.35677E+01, 0.35752E+01,
- & 0.35828E+01, 0.35903E+01, 0.35978E+01, 0.36053E+01, 0.36127E+01,
- & 0.36202E+01, 0.36276E+01, 0.36351E+01, 0.36425E+01, 0.36499E+01,
- & 0.36573E+01, 0.36647E+01, 0.36720E+01, 0.36794E+01, 0.36867E+01/
-
- DATA (BNC08M(I),I=401,500)/
- & 0.36941E+01, 0.37014E+01, 0.37087E+01, 0.37160E+01, 0.37233E+01,
- & 0.37305E+01, 0.37378E+01, 0.37450E+01, 0.37523E+01, 0.37595E+01,
- & 0.37667E+01, 0.37739E+01, 0.37811E+01, 0.37882E+01, 0.37954E+01,
- & 0.38025E+01, 0.38096E+01, 0.38168E+01, 0.38239E+01, 0.38310E+01,
- & 0.38380E+01, 0.38451E+01, 0.38522E+01, 0.38592E+01, 0.38663E+01,
- & 0.38733E+01, 0.38803E+01, 0.38873E+01, 0.38943E+01, 0.39013E+01,
- & 0.39082E+01, 0.39152E+01, 0.39221E+01, 0.39290E+01, 0.39360E+01,
- & 0.39429E+01, 0.39498E+01, 0.39566E+01, 0.39635E+01, 0.39704E+01,
- & 0.39772E+01, 0.39841E+01, 0.39909E+01, 0.39977E+01, 0.40045E+01,
- & 0.40113E+01, 0.40181E+01, 0.40249E+01, 0.40316E+01, 0.40384E+01,
- & 0.40451E+01, 0.40518E+01, 0.40586E+01, 0.40653E+01, 0.40720E+01,
- & 0.40786E+01, 0.40853E+01, 0.40920E+01, 0.40986E+01, 0.41053E+01,
- & 0.41119E+01, 0.41185E+01, 0.41251E+01, 0.41317E+01, 0.41383E+01,
- & 0.41449E+01, 0.41515E+01, 0.41580E+01, 0.41646E+01, 0.41711E+01,
- & 0.41776E+01, 0.41842E+01, 0.41907E+01, 0.41972E+01, 0.42036E+01,
- & 0.42101E+01, 0.42166E+01, 0.42230E+01, 0.42295E+01, 0.42359E+01,
- & 0.42423E+01, 0.42488E+01, 0.42552E+01, 0.42616E+01, 0.42679E+01,
- & 0.42743E+01, 0.42807E+01, 0.42870E+01, 0.42934E+01, 0.42997E+01,
- & 0.43060E+01, 0.43124E+01, 0.43187E+01, 0.43250E+01, 0.43313E+01,
- & 0.43375E+01, 0.43438E+01, 0.43501E+01, 0.43563E+01, 0.43625E+01/
-
- DATA (BNC08M(I),I=501,600)/
- & 0.43688E+01, 0.43750E+01, 0.43812E+01, 0.43874E+01, 0.43936E+01,
- & 0.43998E+01, 0.44060E+01, 0.44121E+01, 0.44183E+01, 0.44244E+01,
- & 0.44306E+01, 0.44367E+01, 0.44428E+01, 0.44489E+01, 0.44550E+01,
- & 0.44611E+01, 0.44672E+01, 0.44733E+01, 0.44793E+01, 0.44854E+01,
- & 0.44914E+01, 0.44975E+01, 0.45035E+01, 0.45095E+01, 0.45155E+01,
- & 0.45215E+01, 0.45275E+01, 0.45335E+01, 0.45395E+01, 0.45454E+01,
- & 0.45514E+01, 0.45574E+01, 0.45633E+01, 0.45692E+01, 0.45752E+01,
- & 0.45811E+01, 0.45870E+01, 0.45929E+01, 0.45988E+01, 0.46046E+01,
- & 0.46105E+01, 0.46164E+01, 0.46222E+01, 0.46281E+01, 0.46339E+01,
- & 0.46397E+01, 0.46456E+01, 0.46514E+01, 0.46572E+01, 0.46630E+01,
- & 0.46688E+01, 0.46745E+01, 0.46803E+01, 0.46861E+01, 0.46918E+01,
- & 0.46976E+01, 0.47033E+01, 0.47091E+01, 0.47148E+01, 0.47205E+01,
- & 0.47262E+01, 0.47319E+01, 0.47376E+01, 0.47433E+01, 0.47490E+01,
- & 0.47546E+01, 0.47603E+01, 0.47659E+01, 0.47716E+01, 0.47772E+01,
- & 0.47828E+01, 0.47885E+01, 0.47941E+01, 0.47997E+01, 0.48053E+01,
- & 0.48109E+01, 0.48164E+01, 0.48220E+01, 0.48276E+01, 0.48331E+01,
- & 0.48387E+01, 0.48442E+01, 0.48498E+01, 0.48553E+01, 0.48608E+01,
- & 0.48663E+01, 0.48718E+01, 0.48773E+01, 0.48828E+01, 0.48883E+01,
- & 0.48938E+01, 0.48992E+01, 0.49047E+01, 0.49101E+01, 0.49156E+01,
- & 0.49210E+01, 0.49265E+01, 0.49319E+01, 0.49373E+01, 0.49427E+01/
-
- DATA (BNC08M(I),I=601,700)/
- & 0.50007E+01, 0.50536E+01, 0.51058E+01, 0.51574E+01, 0.52083E+01,
- & 0.52585E+01, 0.53082E+01, 0.53572E+01, 0.54056E+01, 0.54534E+01,
- & 0.55007E+01, 0.55473E+01, 0.55935E+01, 0.56391E+01, 0.56841E+01,
- & 0.57287E+01, 0.57727E+01, 0.58163E+01, 0.58594E+01, 0.59020E+01,
- & 0.59441E+01, 0.59858E+01, 0.60270E+01, 0.60678E+01, 0.61081E+01,
- & 0.61481E+01, 0.61876E+01, 0.62267E+01, 0.62654E+01, 0.63037E+01,
- & 0.63416E+01, 0.63792E+01, 0.64164E+01, 0.64532E+01, 0.64897E+01,
- & 0.65258E+01, 0.65615E+01, 0.65969E+01, 0.66320E+01, 0.66668E+01,
- & 0.67012E+01, 0.67353E+01, 0.67691E+01, 0.68026E+01, 0.68358E+01,
- & 0.68687E+01, 0.69013E+01, 0.69336E+01, 0.69656E+01, 0.69974E+01,
- & 0.70288E+01, 0.70600E+01, 0.70910E+01, 0.71216E+01, 0.71520E+01,
- & 0.71822E+01, 0.72121E+01, 0.72417E+01, 0.72711E+01, 0.73003E+01,
- & 0.73292E+01, 0.73579E+01, 0.73864E+01, 0.74146E+01, 0.74426E+01,
- & 0.74704E+01, 0.74980E+01, 0.75253E+01, 0.75524E+01, 0.75794E+01,
- & 0.76061E+01, 0.76326E+01, 0.76589E+01, 0.76850E+01, 0.77110E+01,
- & 0.77367E+01, 0.77622E+01, 0.77876E+01, 0.78127E+01, 0.78377E+01,
- & 0.78625E+01, 0.78871E+01, 0.79115E+01, 0.79358E+01, 0.79599E+01,
- & 0.79838E+01, 0.80075E+01, 0.80311E+01, 0.80545E+01, 0.80778E+01,
- & 0.81009E+01, 0.81238E+01, 0.81466E+01, 0.81692E+01, 0.81916E+01,
- & 0.82140E+01, 0.82361E+01, 0.82581E+01, 0.82800E+01, 0.83017E+01/
-
- DATA (BNC08M(I),I=701,741)/
- & 0.83233E+01, 0.83447E+01, 0.83660E+01, 0.83872E+01, 0.84082E+01,
- & 0.84291E+01, 0.84498E+01, 0.84704E+01, 0.84909E+01, 0.85113E+01,
- & 0.85315E+01, 0.85516E+01, 0.85715E+01, 0.85914E+01, 0.86111E+01,
- & 0.86307E+01, 0.86502E+01, 0.86695E+01, 0.86888E+01, 0.87079E+01,
- & 0.87269E+01, 0.87458E+01, 0.87645E+01, 0.87832E+01, 0.88018E+01,
- & 0.88202E+01, 0.88385E+01, 0.88567E+01, 0.88749E+01, 0.88929E+01,
- & 0.89108E+01, 0.89286E+01, 0.89463E+01, 0.89638E+01, 0.89813E+01,
- & 0.89987E+01, 0.90160E+01, 0.90332E+01, 0.90503E+01, 0.90673E+01,
- & 0.90842E+01
- & /
-C
-C *** NH4HSO4
-C
- DATA (BNC09M(I),I=1,100)/
- &-0.49064E-01,-0.10428E+00,-0.13083E+00,-0.14911E+00,-0.16312E+00,
- &-0.17446E+00,-0.18395E+00,-0.19207E+00,-0.19912E+00,-0.20532E+00,
- &-0.21080E+00,-0.21569E+00,-0.22007E+00,-0.22399E+00,-0.22752E+00,
- &-0.23070E+00,-0.23356E+00,-0.23612E+00,-0.23842E+00,-0.24047E+00,
- &-0.24229E+00,-0.24389E+00,-0.24530E+00,-0.24652E+00,-0.24756E+00,
- &-0.24843E+00,-0.24914E+00,-0.24969E+00,-0.25010E+00,-0.25037E+00,
- &-0.25051E+00,-0.25052E+00,-0.25040E+00,-0.25017E+00,-0.24982E+00,
- &-0.24936E+00,-0.24880E+00,-0.24813E+00,-0.24737E+00,-0.24651E+00,
- &-0.24556E+00,-0.24452E+00,-0.24339E+00,-0.24219E+00,-0.24090E+00,
- &-0.23954E+00,-0.23810E+00,-0.23659E+00,-0.23501E+00,-0.23337E+00,
- &-0.23166E+00,-0.22988E+00,-0.22805E+00,-0.22616E+00,-0.22421E+00,
- &-0.22220E+00,-0.22015E+00,-0.21804E+00,-0.21588E+00,-0.21368E+00,
- &-0.21142E+00,-0.20912E+00,-0.20678E+00,-0.20439E+00,-0.20196E+00,
- &-0.19949E+00,-0.19698E+00,-0.19443E+00,-0.19184E+00,-0.18921E+00,
- &-0.18654E+00,-0.18384E+00,-0.18110E+00,-0.17833E+00,-0.17552E+00,
- &-0.17267E+00,-0.16979E+00,-0.16688E+00,-0.16393E+00,-0.16094E+00,
- &-0.15793E+00,-0.15488E+00,-0.15180E+00,-0.14868E+00,-0.14554E+00,
- &-0.14236E+00,-0.13915E+00,-0.13591E+00,-0.13264E+00,-0.12934E+00,
- &-0.12602E+00,-0.12266E+00,-0.11927E+00,-0.11586E+00,-0.11242E+00,
- &-0.10896E+00,-0.10547E+00,-0.10196E+00,-0.98419E-01,-0.94860E-01/
-
- DATA (BNC09M(I),I=101,200)/
- &-0.91280E-01,-0.87679E-01,-0.84058E-01,-0.80419E-01,-0.76762E-01,
- &-0.73089E-01,-0.69400E-01,-0.65696E-01,-0.61979E-01,-0.58250E-01,
- &-0.54509E-01,-0.50757E-01,-0.46996E-01,-0.43227E-01,-0.39449E-01,
- &-0.35665E-01,-0.31875E-01,-0.28080E-01,-0.24280E-01,-0.20477E-01,
- &-0.16671E-01,-0.12863E-01,-0.90543E-02,-0.52447E-02,-0.14349E-02,
- & 0.23745E-02, 0.61825E-02, 0.99888E-02, 0.13793E-01, 0.17595E-01,
- & 0.21393E-01, 0.25188E-01, 0.28979E-01, 0.32766E-01, 0.36548E-01,
- & 0.40325E-01, 0.44097E-01, 0.47864E-01, 0.51625E-01, 0.55379E-01,
- & 0.59128E-01, 0.62870E-01, 0.66605E-01, 0.70333E-01, 0.74055E-01,
- & 0.77769E-01, 0.81476E-01, 0.85176E-01, 0.88868E-01, 0.92552E-01,
- & 0.96229E-01, 0.99897E-01, 0.10356E+00, 0.10721E+00, 0.11086E+00,
- & 0.11449E+00, 0.11812E+00, 0.12174E+00, 0.12535E+00, 0.12895E+00,
- & 0.13255E+00, 0.13614E+00, 0.13971E+00, 0.14328E+00, 0.14684E+00,
- & 0.15039E+00, 0.15394E+00, 0.15747E+00, 0.16100E+00, 0.16452E+00,
- & 0.16802E+00, 0.17152E+00, 0.17501E+00, 0.17850E+00, 0.18197E+00,
- & 0.18544E+00, 0.18889E+00, 0.19234E+00, 0.19578E+00, 0.19921E+00,
- & 0.20263E+00, 0.20604E+00, 0.20944E+00, 0.21284E+00, 0.21622E+00,
- & 0.21960E+00, 0.22297E+00, 0.22633E+00, 0.22968E+00, 0.23302E+00,
- & 0.23636E+00, 0.23968E+00, 0.24300E+00, 0.24631E+00, 0.24961E+00,
- & 0.25290E+00, 0.25618E+00, 0.25945E+00, 0.26272E+00, 0.26597E+00/
-
- DATA (BNC09M(I),I=201,300)/
- & 0.26922E+00, 0.27246E+00, 0.27569E+00, 0.27892E+00, 0.28213E+00,
- & 0.28534E+00, 0.28854E+00, 0.29173E+00, 0.29491E+00, 0.29808E+00,
- & 0.30125E+00, 0.30440E+00, 0.30755E+00, 0.31069E+00, 0.31383E+00,
- & 0.31695E+00, 0.32007E+00, 0.32318E+00, 0.32628E+00, 0.32937E+00,
- & 0.33245E+00, 0.33553E+00, 0.33860E+00, 0.34166E+00, 0.34472E+00,
- & 0.34776E+00, 0.35080E+00, 0.35383E+00, 0.35685E+00, 0.35987E+00,
- & 0.36287E+00, 0.36587E+00, 0.36887E+00, 0.37185E+00, 0.37483E+00,
- & 0.37780E+00, 0.38076E+00, 0.38371E+00, 0.38666E+00, 0.38960E+00,
- & 0.39253E+00, 0.39546E+00, 0.39838E+00, 0.40129E+00, 0.40419E+00,
- & 0.40709E+00, 0.40998E+00, 0.41286E+00, 0.41573E+00, 0.41860E+00,
- & 0.42146E+00, 0.42432E+00, 0.42716E+00, 0.43000E+00, 0.43283E+00,
- & 0.43566E+00, 0.43848E+00, 0.44129E+00, 0.44410E+00, 0.44690E+00,
- & 0.44969E+00, 0.45247E+00, 0.45525E+00, 0.45802E+00, 0.46079E+00,
- & 0.46355E+00, 0.46630E+00, 0.46904E+00, 0.47178E+00, 0.47452E+00,
- & 0.47724E+00, 0.47996E+00, 0.48267E+00, 0.48538E+00, 0.48808E+00,
- & 0.49077E+00, 0.49346E+00, 0.49614E+00, 0.49882E+00, 0.50149E+00,
- & 0.50415E+00, 0.50681E+00, 0.50946E+00, 0.51210E+00, 0.51474E+00,
- & 0.51737E+00, 0.51999E+00, 0.52261E+00, 0.52523E+00, 0.52783E+00,
- & 0.53044E+00, 0.53303E+00, 0.53562E+00, 0.53820E+00, 0.54078E+00,
- & 0.54335E+00, 0.54592E+00, 0.54848E+00, 0.55104E+00, 0.55358E+00/
-
- DATA (BNC09M(I),I=301,400)/
- & 0.55613E+00, 0.55866E+00, 0.56120E+00, 0.56372E+00, 0.56624E+00,
- & 0.56876E+00, 0.57126E+00, 0.57377E+00, 0.57627E+00, 0.57876E+00,
- & 0.58124E+00, 0.58373E+00, 0.58620E+00, 0.58867E+00, 0.59114E+00,
- & 0.59360E+00, 0.59605E+00, 0.59850E+00, 0.60094E+00, 0.60338E+00,
- & 0.60581E+00, 0.60824E+00, 0.61066E+00, 0.61308E+00, 0.61549E+00,
- & 0.61789E+00, 0.62030E+00, 0.62269E+00, 0.62508E+00, 0.62747E+00,
- & 0.62985E+00, 0.63222E+00, 0.63459E+00, 0.63696E+00, 0.63932E+00,
- & 0.64167E+00, 0.64402E+00, 0.64637E+00, 0.64871E+00, 0.65104E+00,
- & 0.65337E+00, 0.65570E+00, 0.65802E+00, 0.66033E+00, 0.66265E+00,
- & 0.66495E+00, 0.66725E+00, 0.66955E+00, 0.67184E+00, 0.67413E+00,
- & 0.67641E+00, 0.67868E+00, 0.68096E+00, 0.68322E+00, 0.68549E+00,
- & 0.68775E+00, 0.69000E+00, 0.69225E+00, 0.69449E+00, 0.69673E+00,
- & 0.69897E+00, 0.70120E+00, 0.70342E+00, 0.70565E+00, 0.70786E+00,
- & 0.71008E+00, 0.71228E+00, 0.71449E+00, 0.71669E+00, 0.71888E+00,
- & 0.72107E+00, 0.72326E+00, 0.72544E+00, 0.72761E+00, 0.72979E+00,
- & 0.73195E+00, 0.73412E+00, 0.73628E+00, 0.73843E+00, 0.74058E+00,
- & 0.74273E+00, 0.74487E+00, 0.74701E+00, 0.74914E+00, 0.75127E+00,
- & 0.75340E+00, 0.75552E+00, 0.75764E+00, 0.75975E+00, 0.76186E+00,
- & 0.76396E+00, 0.76606E+00, 0.76816E+00, 0.77025E+00, 0.77234E+00,
- & 0.77442E+00, 0.77650E+00, 0.77858E+00, 0.78065E+00, 0.78272E+00/
-
- DATA (BNC09M(I),I=401,500)/
- & 0.78478E+00, 0.78684E+00, 0.78890E+00, 0.79095E+00, 0.79300E+00,
- & 0.79504E+00, 0.79708E+00, 0.79912E+00, 0.80115E+00, 0.80318E+00,
- & 0.80520E+00, 0.80723E+00, 0.80924E+00, 0.81126E+00, 0.81326E+00,
- & 0.81527E+00, 0.81727E+00, 0.81927E+00, 0.82126E+00, 0.82325E+00,
- & 0.82524E+00, 0.82722E+00, 0.82920E+00, 0.83118E+00, 0.83315E+00,
- & 0.83512E+00, 0.83708E+00, 0.83904E+00, 0.84100E+00, 0.84295E+00,
- & 0.84490E+00, 0.84684E+00, 0.84879E+00, 0.85073E+00, 0.85266E+00,
- & 0.85459E+00, 0.85652E+00, 0.85844E+00, 0.86037E+00, 0.86228E+00,
- & 0.86420E+00, 0.86611E+00, 0.86801E+00, 0.86992E+00, 0.87182E+00,
- & 0.87371E+00, 0.87560E+00, 0.87749E+00, 0.87938E+00, 0.88126E+00,
- & 0.88314E+00, 0.88502E+00, 0.88689E+00, 0.88876E+00, 0.89062E+00,
- & 0.89249E+00, 0.89434E+00, 0.89620E+00, 0.89805E+00, 0.89990E+00,
- & 0.90174E+00, 0.90359E+00, 0.90543E+00, 0.90726E+00, 0.90909E+00,
- & 0.91092E+00, 0.91275E+00, 0.91457E+00, 0.91639E+00, 0.91820E+00,
- & 0.92002E+00, 0.92183E+00, 0.92363E+00, 0.92544E+00, 0.92724E+00,
- & 0.92903E+00, 0.93083E+00, 0.93262E+00, 0.93440E+00, 0.93619E+00,
- & 0.93797E+00, 0.93975E+00, 0.94152E+00, 0.94329E+00, 0.94506E+00,
- & 0.94682E+00, 0.94859E+00, 0.95035E+00, 0.95210E+00, 0.95386E+00,
- & 0.95561E+00, 0.95735E+00, 0.95910E+00, 0.96084E+00, 0.96258E+00,
- & 0.96431E+00, 0.96604E+00, 0.96777E+00, 0.96950E+00, 0.97122E+00/
-
- DATA (BNC09M(I),I=501,600)/
- & 0.97294E+00, 0.97466E+00, 0.97637E+00, 0.97808E+00, 0.97979E+00,
- & 0.98150E+00, 0.98320E+00, 0.98490E+00, 0.98659E+00, 0.98829E+00,
- & 0.98998E+00, 0.99167E+00, 0.99335E+00, 0.99503E+00, 0.99671E+00,
- & 0.99839E+00, 0.10001E+01, 0.10017E+01, 0.10034E+01, 0.10051E+01,
- & 0.10067E+01, 0.10084E+01, 0.10100E+01, 0.10117E+01, 0.10134E+01,
- & 0.10150E+01, 0.10166E+01, 0.10183E+01, 0.10199E+01, 0.10216E+01,
- & 0.10232E+01, 0.10248E+01, 0.10265E+01, 0.10281E+01, 0.10297E+01,
- & 0.10313E+01, 0.10330E+01, 0.10346E+01, 0.10362E+01, 0.10378E+01,
- & 0.10394E+01, 0.10410E+01, 0.10426E+01, 0.10442E+01, 0.10458E+01,
- & 0.10474E+01, 0.10490E+01, 0.10506E+01, 0.10522E+01, 0.10538E+01,
- & 0.10553E+01, 0.10569E+01, 0.10585E+01, 0.10601E+01, 0.10616E+01,
- & 0.10632E+01, 0.10648E+01, 0.10663E+01, 0.10679E+01, 0.10695E+01,
- & 0.10710E+01, 0.10726E+01, 0.10741E+01, 0.10757E+01, 0.10772E+01,
- & 0.10788E+01, 0.10803E+01, 0.10818E+01, 0.10834E+01, 0.10849E+01,
- & 0.10864E+01, 0.10880E+01, 0.10895E+01, 0.10910E+01, 0.10925E+01,
- & 0.10941E+01, 0.10956E+01, 0.10971E+01, 0.10986E+01, 0.11001E+01,
- & 0.11016E+01, 0.11031E+01, 0.11046E+01, 0.11061E+01, 0.11076E+01,
- & 0.11091E+01, 0.11106E+01, 0.11121E+01, 0.11136E+01, 0.11151E+01,
- & 0.11165E+01, 0.11180E+01, 0.11195E+01, 0.11210E+01, 0.11225E+01,
- & 0.11239E+01, 0.11254E+01, 0.11269E+01, 0.11283E+01, 0.11298E+01/
-
- DATA (BNC09M(I),I=601,700)/
- & 0.11454E+01, 0.11597E+01, 0.11737E+01, 0.11876E+01, 0.12012E+01,
- & 0.12146E+01, 0.12278E+01, 0.12409E+01, 0.12537E+01, 0.12663E+01,
- & 0.12788E+01, 0.12911E+01, 0.13032E+01, 0.13152E+01, 0.13270E+01,
- & 0.13386E+01, 0.13500E+01, 0.13613E+01, 0.13725E+01, 0.13835E+01,
- & 0.13943E+01, 0.14050E+01, 0.14156E+01, 0.14260E+01, 0.14363E+01,
- & 0.14464E+01, 0.14564E+01, 0.14663E+01, 0.14761E+01, 0.14857E+01,
- & 0.14952E+01, 0.15046E+01, 0.15139E+01, 0.15231E+01, 0.15321E+01,
- & 0.15410E+01, 0.15499E+01, 0.15586E+01, 0.15672E+01, 0.15757E+01,
- & 0.15841E+01, 0.15923E+01, 0.16005E+01, 0.16086E+01, 0.16166E+01,
- & 0.16245E+01, 0.16323E+01, 0.16400E+01, 0.16477E+01, 0.16552E+01,
- & 0.16626E+01, 0.16700E+01, 0.16773E+01, 0.16845E+01, 0.16916E+01,
- & 0.16986E+01, 0.17055E+01, 0.17124E+01, 0.17192E+01, 0.17259E+01,
- & 0.17325E+01, 0.17390E+01, 0.17455E+01, 0.17519E+01, 0.17583E+01,
- & 0.17645E+01, 0.17707E+01, 0.17768E+01, 0.17829E+01, 0.17889E+01,
- & 0.17948E+01, 0.18006E+01, 0.18064E+01, 0.18121E+01, 0.18178E+01,
- & 0.18234E+01, 0.18289E+01, 0.18344E+01, 0.18398E+01, 0.18452E+01,
- & 0.18505E+01, 0.18557E+01, 0.18609E+01, 0.18660E+01, 0.18711E+01,
- & 0.18761E+01, 0.18811E+01, 0.18860E+01, 0.18908E+01, 0.18956E+01,
- & 0.19004E+01, 0.19050E+01, 0.19097E+01, 0.19143E+01, 0.19188E+01,
- & 0.19233E+01, 0.19278E+01, 0.19322E+01, 0.19365E+01, 0.19408E+01/
-
- DATA (BNC09M(I),I=701,741)/
- & 0.19451E+01, 0.19493E+01, 0.19535E+01, 0.19576E+01, 0.19616E+01,
- & 0.19657E+01, 0.19697E+01, 0.19736E+01, 0.19775E+01, 0.19814E+01,
- & 0.19852E+01, 0.19890E+01, 0.19927E+01, 0.19964E+01, 0.20001E+01,
- & 0.20037E+01, 0.20073E+01, 0.20108E+01, 0.20143E+01, 0.20178E+01,
- & 0.20212E+01, 0.20246E+01, 0.20279E+01, 0.20312E+01, 0.20345E+01,
- & 0.20378E+01, 0.20410E+01, 0.20441E+01, 0.20473E+01, 0.20504E+01,
- & 0.20534E+01, 0.20565E+01, 0.20595E+01, 0.20624E+01, 0.20654E+01,
- & 0.20683E+01, 0.20711E+01, 0.20740E+01, 0.20768E+01, 0.20796E+01,
- & 0.20823E+01
- & /
-C
-C *** (H,NO3)
-C
- DATA (BNC10M(I),I=1,100)/
- &-0.48350E-01,-0.99817E-01,-0.12258E+00,-0.13710E+00,-0.14739E+00,
- &-0.15506E+00,-0.16093E+00,-0.16548E+00,-0.16903E+00,-0.17178E+00,
- &-0.17389E+00,-0.17547E+00,-0.17659E+00,-0.17734E+00,-0.17776E+00,
- &-0.17790E+00,-0.17778E+00,-0.17745E+00,-0.17692E+00,-0.17623E+00,
- &-0.17537E+00,-0.17438E+00,-0.17327E+00,-0.17205E+00,-0.17072E+00,
- &-0.16930E+00,-0.16780E+00,-0.16623E+00,-0.16459E+00,-0.16289E+00,
- &-0.16113E+00,-0.15932E+00,-0.15747E+00,-0.15558E+00,-0.15365E+00,
- &-0.15169E+00,-0.14969E+00,-0.14768E+00,-0.14563E+00,-0.14357E+00,
- &-0.14149E+00,-0.13939E+00,-0.13727E+00,-0.13515E+00,-0.13301E+00,
- &-0.13086E+00,-0.12871E+00,-0.12655E+00,-0.12438E+00,-0.12220E+00,
- &-0.12002E+00,-0.11784E+00,-0.11565E+00,-0.11346E+00,-0.11127E+00,
- &-0.10908E+00,-0.10688E+00,-0.10468E+00,-0.10248E+00,-0.10027E+00,
- &-0.98060E-01,-0.95847E-01,-0.93631E-01,-0.91410E-01,-0.89183E-01,
- &-0.86952E-01,-0.84714E-01,-0.82470E-01,-0.80218E-01,-0.77958E-01,
- &-0.75689E-01,-0.73411E-01,-0.71123E-01,-0.68823E-01,-0.66512E-01,
- &-0.64189E-01,-0.61853E-01,-0.59502E-01,-0.57138E-01,-0.54759E-01,
- &-0.52364E-01,-0.49954E-01,-0.47527E-01,-0.45084E-01,-0.42623E-01,
- &-0.40146E-01,-0.37650E-01,-0.35137E-01,-0.32607E-01,-0.30058E-01,
- &-0.27492E-01,-0.24907E-01,-0.22306E-01,-0.19686E-01,-0.17050E-01,
- &-0.14396E-01,-0.11726E-01,-0.90402E-02,-0.63382E-02,-0.36209E-02/
-
- DATA (BNC10M(I),I=101,200)/
- &-0.88885E-03, 0.18576E-02, 0.46179E-02, 0.73912E-02, 0.10177E-01,
- & 0.12975E-01, 0.15785E-01, 0.18605E-01, 0.21435E-01, 0.24275E-01,
- & 0.27123E-01, 0.29980E-01, 0.32844E-01, 0.35716E-01, 0.38593E-01,
- & 0.41477E-01, 0.44366E-01, 0.47259E-01, 0.50157E-01, 0.53058E-01,
- & 0.55963E-01, 0.58870E-01, 0.61780E-01, 0.64691E-01, 0.67604E-01,
- & 0.70518E-01, 0.73432E-01, 0.76347E-01, 0.79262E-01, 0.82177E-01,
- & 0.85091E-01, 0.88004E-01, 0.90916E-01, 0.93827E-01, 0.96736E-01,
- & 0.99644E-01, 0.10255E+00, 0.10545E+00, 0.10836E+00, 0.11125E+00,
- & 0.11415E+00, 0.11705E+00, 0.11994E+00, 0.12283E+00, 0.12571E+00,
- & 0.12859E+00, 0.13147E+00, 0.13435E+00, 0.13722E+00, 0.14009E+00,
- & 0.14296E+00, 0.14582E+00, 0.14868E+00, 0.15154E+00, 0.15439E+00,
- & 0.15724E+00, 0.16008E+00, 0.16293E+00, 0.16576E+00, 0.16860E+00,
- & 0.17143E+00, 0.17425E+00, 0.17708E+00, 0.17989E+00, 0.18271E+00,
- & 0.18552E+00, 0.18833E+00, 0.19113E+00, 0.19393E+00, 0.19672E+00,
- & 0.19951E+00, 0.20230E+00, 0.20508E+00, 0.20786E+00, 0.21063E+00,
- & 0.21340E+00, 0.21617E+00, 0.21893E+00, 0.22168E+00, 0.22444E+00,
- & 0.22718E+00, 0.22993E+00, 0.23267E+00, 0.23540E+00, 0.23813E+00,
- & 0.24086E+00, 0.24358E+00, 0.24630E+00, 0.24901E+00, 0.25172E+00,
- & 0.25443E+00, 0.25713E+00, 0.25983E+00, 0.26252E+00, 0.26520E+00,
- & 0.26789E+00, 0.27056E+00, 0.27324E+00, 0.27591E+00, 0.27857E+00/
-
- DATA (BNC10M(I),I=201,300)/
- & 0.28123E+00, 0.28389E+00, 0.28654E+00, 0.28919E+00, 0.29183E+00,
- & 0.29447E+00, 0.29710E+00, 0.29973E+00, 0.30235E+00, 0.30497E+00,
- & 0.30759E+00, 0.31020E+00, 0.31281E+00, 0.31541E+00, 0.31801E+00,
- & 0.32060E+00, 0.32319E+00, 0.32577E+00, 0.32835E+00, 0.33093E+00,
- & 0.33350E+00, 0.33606E+00, 0.33862E+00, 0.34118E+00, 0.34373E+00,
- & 0.34628E+00, 0.34882E+00, 0.35136E+00, 0.35390E+00, 0.35642E+00,
- & 0.35895E+00, 0.36147E+00, 0.36399E+00, 0.36650E+00, 0.36901E+00,
- & 0.37151E+00, 0.37401E+00, 0.37650E+00, 0.37899E+00, 0.38147E+00,
- & 0.38395E+00, 0.38643E+00, 0.38890E+00, 0.39137E+00, 0.39383E+00,
- & 0.39629E+00, 0.39874E+00, 0.40119E+00, 0.40363E+00, 0.40607E+00,
- & 0.40851E+00, 0.41094E+00, 0.41337E+00, 0.41579E+00, 0.41821E+00,
- & 0.42062E+00, 0.42303E+00, 0.42543E+00, 0.42783E+00, 0.43023E+00,
- & 0.43262E+00, 0.43501E+00, 0.43739E+00, 0.43977E+00, 0.44214E+00,
- & 0.44451E+00, 0.44688E+00, 0.44924E+00, 0.45160E+00, 0.45395E+00,
- & 0.45630E+00, 0.45864E+00, 0.46098E+00, 0.46332E+00, 0.46565E+00,
- & 0.46797E+00, 0.47029E+00, 0.47261E+00, 0.47493E+00, 0.47724E+00,
- & 0.47954E+00, 0.48184E+00, 0.48414E+00, 0.48643E+00, 0.48872E+00,
- & 0.49100E+00, 0.49328E+00, 0.49556E+00, 0.49783E+00, 0.50010E+00,
- & 0.50236E+00, 0.50462E+00, 0.50687E+00, 0.50912E+00, 0.51137E+00,
- & 0.51361E+00, 0.51585E+00, 0.51809E+00, 0.52032E+00, 0.52254E+00/
-
- DATA (BNC10M(I),I=301,400)/
- & 0.52476E+00, 0.52698E+00, 0.52919E+00, 0.53140E+00, 0.53361E+00,
- & 0.53581E+00, 0.53801E+00, 0.54020E+00, 0.54239E+00, 0.54458E+00,
- & 0.54676E+00, 0.54894E+00, 0.55111E+00, 0.55328E+00, 0.55544E+00,
- & 0.55760E+00, 0.55976E+00, 0.56191E+00, 0.56406E+00, 0.56621E+00,
- & 0.56835E+00, 0.57049E+00, 0.57262E+00, 0.57475E+00, 0.57688E+00,
- & 0.57900E+00, 0.58112E+00, 0.58323E+00, 0.58534E+00, 0.58745E+00,
- & 0.58955E+00, 0.59165E+00, 0.59375E+00, 0.59584E+00, 0.59792E+00,
- & 0.60001E+00, 0.60209E+00, 0.60416E+00, 0.60624E+00, 0.60830E+00,
- & 0.61037E+00, 0.61243E+00, 0.61449E+00, 0.61654E+00, 0.61859E+00,
- & 0.62064E+00, 0.62268E+00, 0.62472E+00, 0.62675E+00, 0.62878E+00,
- & 0.63081E+00, 0.63283E+00, 0.63485E+00, 0.63687E+00, 0.63888E+00,
- & 0.64089E+00, 0.64290E+00, 0.64490E+00, 0.64690E+00, 0.64889E+00,
- & 0.65088E+00, 0.65287E+00, 0.65486E+00, 0.65684E+00, 0.65881E+00,
- & 0.66079E+00, 0.66276E+00, 0.66472E+00, 0.66668E+00, 0.66864E+00,
- & 0.67060E+00, 0.67255E+00, 0.67450E+00, 0.67644E+00, 0.67839E+00,
- & 0.68032E+00, 0.68226E+00, 0.68419E+00, 0.68612E+00, 0.68804E+00,
- & 0.68996E+00, 0.69188E+00, 0.69379E+00, 0.69571E+00, 0.69761E+00,
- & 0.69952E+00, 0.70142E+00, 0.70331E+00, 0.70521E+00, 0.70710E+00,
- & 0.70898E+00, 0.71087E+00, 0.71275E+00, 0.71463E+00, 0.71650E+00,
- & 0.71837E+00, 0.72024E+00, 0.72210E+00, 0.72396E+00, 0.72582E+00/
-
- DATA (BNC10M(I),I=401,500)/
- & 0.72767E+00, 0.72952E+00, 0.73137E+00, 0.73321E+00, 0.73505E+00,
- & 0.73689E+00, 0.73873E+00, 0.74056E+00, 0.74239E+00, 0.74421E+00,
- & 0.74603E+00, 0.74785E+00, 0.74967E+00, 0.75148E+00, 0.75329E+00,
- & 0.75509E+00, 0.75689E+00, 0.75869E+00, 0.76049E+00, 0.76228E+00,
- & 0.76407E+00, 0.76586E+00, 0.76764E+00, 0.76942E+00, 0.77120E+00,
- & 0.77298E+00, 0.77475E+00, 0.77652E+00, 0.77828E+00, 0.78004E+00,
- & 0.78180E+00, 0.78356E+00, 0.78531E+00, 0.78706E+00, 0.78881E+00,
- & 0.79055E+00, 0.79229E+00, 0.79403E+00, 0.79577E+00, 0.79750E+00,
- & 0.79923E+00, 0.80095E+00, 0.80268E+00, 0.80440E+00, 0.80611E+00,
- & 0.80783E+00, 0.80954E+00, 0.81125E+00, 0.81295E+00, 0.81466E+00,
- & 0.81636E+00, 0.81805E+00, 0.81975E+00, 0.82144E+00, 0.82313E+00,
- & 0.82481E+00, 0.82649E+00, 0.82817E+00, 0.82985E+00, 0.83152E+00,
- & 0.83319E+00, 0.83486E+00, 0.83653E+00, 0.83819E+00, 0.83985E+00,
- & 0.84151E+00, 0.84316E+00, 0.84481E+00, 0.84646E+00, 0.84810E+00,
- & 0.84975E+00, 0.85139E+00, 0.85303E+00, 0.85466E+00, 0.85629E+00,
- & 0.85792E+00, 0.85955E+00, 0.86117E+00, 0.86279E+00, 0.86441E+00,
- & 0.86603E+00, 0.86764E+00, 0.86925E+00, 0.87086E+00, 0.87246E+00,
- & 0.87406E+00, 0.87566E+00, 0.87726E+00, 0.87885E+00, 0.88044E+00,
- & 0.88203E+00, 0.88362E+00, 0.88520E+00, 0.88678E+00, 0.88836E+00,
- & 0.88994E+00, 0.89151E+00, 0.89308E+00, 0.89465E+00, 0.89621E+00/
-
- DATA (BNC10M(I),I=501,600)/
- & 0.89778E+00, 0.89934E+00, 0.90089E+00, 0.90245E+00, 0.90400E+00,
- & 0.90555E+00, 0.90710E+00, 0.90864E+00, 0.91019E+00, 0.91173E+00,
- & 0.91326E+00, 0.91480E+00, 0.91633E+00, 0.91786E+00, 0.91939E+00,
- & 0.92091E+00, 0.92243E+00, 0.92395E+00, 0.92547E+00, 0.92698E+00,
- & 0.92850E+00, 0.93001E+00, 0.93151E+00, 0.93302E+00, 0.93452E+00,
- & 0.93602E+00, 0.93752E+00, 0.93901E+00, 0.94051E+00, 0.94200E+00,
- & 0.94348E+00, 0.94497E+00, 0.94645E+00, 0.94793E+00, 0.94941E+00,
- & 0.95089E+00, 0.95236E+00, 0.95383E+00, 0.95530E+00, 0.95677E+00,
- & 0.95823E+00, 0.95969E+00, 0.96115E+00, 0.96261E+00, 0.96406E+00,
- & 0.96552E+00, 0.96697E+00, 0.96841E+00, 0.96986E+00, 0.97130E+00,
- & 0.97274E+00, 0.97418E+00, 0.97562E+00, 0.97705E+00, 0.97848E+00,
- & 0.97991E+00, 0.98134E+00, 0.98276E+00, 0.98419E+00, 0.98561E+00,
- & 0.98702E+00, 0.98844E+00, 0.98985E+00, 0.99126E+00, 0.99267E+00,
- & 0.99408E+00, 0.99548E+00, 0.99689E+00, 0.99829E+00, 0.99969E+00,
- & 0.10011E+01, 0.10025E+01, 0.10039E+01, 0.10053E+01, 0.10066E+01,
- & 0.10080E+01, 0.10094E+01, 0.10108E+01, 0.10122E+01, 0.10135E+01,
- & 0.10149E+01, 0.10163E+01, 0.10177E+01, 0.10190E+01, 0.10204E+01,
- & 0.10218E+01, 0.10231E+01, 0.10245E+01, 0.10258E+01, 0.10272E+01,
- & 0.10285E+01, 0.10299E+01, 0.10312E+01, 0.10326E+01, 0.10339E+01,
- & 0.10353E+01, 0.10366E+01, 0.10380E+01, 0.10393E+01, 0.10406E+01/
-
- DATA (BNC10M(I),I=601,700)/
- & 0.10549E+01, 0.10679E+01, 0.10807E+01, 0.10933E+01, 0.11058E+01,
- & 0.11180E+01, 0.11301E+01, 0.11420E+01, 0.11537E+01, 0.11652E+01,
- & 0.11766E+01, 0.11878E+01, 0.11989E+01, 0.12098E+01, 0.12205E+01,
- & 0.12311E+01, 0.12415E+01, 0.12518E+01, 0.12620E+01, 0.12720E+01,
- & 0.12819E+01, 0.12916E+01, 0.13012E+01, 0.13107E+01, 0.13201E+01,
- & 0.13293E+01, 0.13384E+01, 0.13474E+01, 0.13562E+01, 0.13650E+01,
- & 0.13736E+01, 0.13821E+01, 0.13905E+01, 0.13988E+01, 0.14070E+01,
- & 0.14151E+01, 0.14231E+01, 0.14310E+01, 0.14388E+01, 0.14464E+01,
- & 0.14540E+01, 0.14615E+01, 0.14689E+01, 0.14762E+01, 0.14834E+01,
- & 0.14906E+01, 0.14976E+01, 0.15045E+01, 0.15114E+01, 0.15182E+01,
- & 0.15249E+01, 0.15315E+01, 0.15380E+01, 0.15444E+01, 0.15508E+01,
- & 0.15571E+01, 0.15633E+01, 0.15695E+01, 0.15755E+01, 0.15815E+01,
- & 0.15875E+01, 0.15933E+01, 0.15991E+01, 0.16048E+01, 0.16105E+01,
- & 0.16160E+01, 0.16215E+01, 0.16270E+01, 0.16324E+01, 0.16377E+01,
- & 0.16429E+01, 0.16481E+01, 0.16533E+01, 0.16583E+01, 0.16634E+01,
- & 0.16683E+01, 0.16732E+01, 0.16780E+01, 0.16828E+01, 0.16875E+01,
- & 0.16922E+01, 0.16968E+01, 0.17014E+01, 0.17059E+01, 0.17104E+01,
- & 0.17148E+01, 0.17191E+01, 0.17234E+01, 0.17277E+01, 0.17319E+01,
- & 0.17360E+01, 0.17401E+01, 0.17442E+01, 0.17482E+01, 0.17521E+01,
- & 0.17560E+01, 0.17599E+01, 0.17637E+01, 0.17675E+01, 0.17712E+01/
-
- DATA (BNC10M(I),I=701,741)/
- & 0.17749E+01, 0.17786E+01, 0.17822E+01, 0.17858E+01, 0.17893E+01,
- & 0.17927E+01, 0.17962E+01, 0.17996E+01, 0.18029E+01, 0.18063E+01,
- & 0.18095E+01, 0.18128E+01, 0.18160E+01, 0.18191E+01, 0.18223E+01,
- & 0.18253E+01, 0.18284E+01, 0.18314E+01, 0.18344E+01, 0.18373E+01,
- & 0.18402E+01, 0.18431E+01, 0.18459E+01, 0.18487E+01, 0.18515E+01,
- & 0.18542E+01, 0.18569E+01, 0.18596E+01, 0.18623E+01, 0.18649E+01,
- & 0.18674E+01, 0.18700E+01, 0.18725E+01, 0.18749E+01, 0.18774E+01,
- & 0.18798E+01, 0.18822E+01, 0.18845E+01, 0.18869E+01, 0.18892E+01,
- & 0.18914E+01
- & /
-C
-C *** (H,Cl)
-C
- DATA (BNC11M(I),I=1,100)/
- &-0.46921E-01,-0.92783E-01,-0.11083E+00,-0.12102E+00,-0.12722E+00,
- &-0.13092E+00,-0.13292E+00,-0.13364E+00,-0.13339E+00,-0.13235E+00,
- &-0.13067E+00,-0.12843E+00,-0.12574E+00,-0.12263E+00,-0.11917E+00,
- &-0.11539E+00,-0.11133E+00,-0.10701E+00,-0.10245E+00,-0.97688E-01,
- &-0.92727E-01,-0.87586E-01,-0.82279E-01,-0.76818E-01,-0.71216E-01,
- &-0.65481E-01,-0.59623E-01,-0.53651E-01,-0.47571E-01,-0.41393E-01,
- &-0.35121E-01,-0.28762E-01,-0.22322E-01,-0.15807E-01,-0.92221E-02,
- &-0.25712E-02, 0.41408E-02, 0.10910E-01, 0.17731E-01, 0.24602E-01,
- & 0.31518E-01, 0.38477E-01, 0.45474E-01, 0.52508E-01, 0.59576E-01,
- & 0.66675E-01, 0.73803E-01, 0.80957E-01, 0.88137E-01, 0.95339E-01,
- & 0.10256E+00, 0.10981E+00, 0.11707E+00, 0.12435E+00, 0.13165E+00,
- & 0.13897E+00, 0.14630E+00, 0.15365E+00, 0.16101E+00, 0.16839E+00,
- & 0.17578E+00, 0.18319E+00, 0.19062E+00, 0.19806E+00, 0.20553E+00,
- & 0.21300E+00, 0.22050E+00, 0.22802E+00, 0.23556E+00, 0.24313E+00,
- & 0.25071E+00, 0.25832E+00, 0.26596E+00, 0.27362E+00, 0.28131E+00,
- & 0.28903E+00, 0.29679E+00, 0.30457E+00, 0.31239E+00, 0.32024E+00,
- & 0.32813E+00, 0.33605E+00, 0.34401E+00, 0.35201E+00, 0.36004E+00,
- & 0.36812E+00, 0.37623E+00, 0.38439E+00, 0.39258E+00, 0.40081E+00,
- & 0.40909E+00, 0.41740E+00, 0.42575E+00, 0.43414E+00, 0.44257E+00,
- & 0.45104E+00, 0.45954E+00, 0.46808E+00, 0.47665E+00, 0.48526E+00/
-
- DATA (BNC11M(I),I=101,200)/
- & 0.49390E+00, 0.50257E+00, 0.51127E+00, 0.51999E+00, 0.52875E+00,
- & 0.53752E+00, 0.54633E+00, 0.55515E+00, 0.56400E+00, 0.57286E+00,
- & 0.58174E+00, 0.59064E+00, 0.59955E+00, 0.60847E+00, 0.61740E+00,
- & 0.62635E+00, 0.63530E+00, 0.64426E+00, 0.65322E+00, 0.66219E+00,
- & 0.67116E+00, 0.68013E+00, 0.68911E+00, 0.69808E+00, 0.70705E+00,
- & 0.71602E+00, 0.72499E+00, 0.73395E+00, 0.74290E+00, 0.75185E+00,
- & 0.76080E+00, 0.76973E+00, 0.77866E+00, 0.78758E+00, 0.79649E+00,
- & 0.80539E+00, 0.81428E+00, 0.82316E+00, 0.83203E+00, 0.84089E+00,
- & 0.84973E+00, 0.85857E+00, 0.86739E+00, 0.87619E+00, 0.88499E+00,
- & 0.89377E+00, 0.90254E+00, 0.91129E+00, 0.92003E+00, 0.92876E+00,
- & 0.93747E+00, 0.94617E+00, 0.95486E+00, 0.96352E+00, 0.97218E+00,
- & 0.98082E+00, 0.98944E+00, 0.99805E+00, 0.10066E+01, 0.10152E+01,
- & 0.10238E+01, 0.10323E+01, 0.10409E+01, 0.10494E+01, 0.10579E+01,
- & 0.10664E+01, 0.10748E+01, 0.10833E+01, 0.10917E+01, 0.11001E+01,
- & 0.11085E+01, 0.11169E+01, 0.11253E+01, 0.11337E+01, 0.11420E+01,
- & 0.11503E+01, 0.11586E+01, 0.11669E+01, 0.11752E+01, 0.11834E+01,
- & 0.11917E+01, 0.11999E+01, 0.12081E+01, 0.12163E+01, 0.12245E+01,
- & 0.12326E+01, 0.12408E+01, 0.12489E+01, 0.12570E+01, 0.12651E+01,
- & 0.12732E+01, 0.12812E+01, 0.12893E+01, 0.12973E+01, 0.13053E+01,
- & 0.13133E+01, 0.13213E+01, 0.13292E+01, 0.13372E+01, 0.13451E+01/
-
- DATA (BNC11M(I),I=201,300)/
- & 0.13530E+01, 0.13609E+01, 0.13688E+01, 0.13767E+01, 0.13845E+01,
- & 0.13923E+01, 0.14001E+01, 0.14079E+01, 0.14157E+01, 0.14235E+01,
- & 0.14312E+01, 0.14390E+01, 0.14467E+01, 0.14544E+01, 0.14620E+01,
- & 0.14697E+01, 0.14774E+01, 0.14850E+01, 0.14926E+01, 0.15002E+01,
- & 0.15078E+01, 0.15154E+01, 0.15229E+01, 0.15305E+01, 0.15380E+01,
- & 0.15455E+01, 0.15530E+01, 0.15604E+01, 0.15679E+01, 0.15753E+01,
- & 0.15828E+01, 0.15902E+01, 0.15976E+01, 0.16050E+01, 0.16123E+01,
- & 0.16197E+01, 0.16270E+01, 0.16343E+01, 0.16416E+01, 0.16489E+01,
- & 0.16562E+01, 0.16634E+01, 0.16707E+01, 0.16779E+01, 0.16851E+01,
- & 0.16923E+01, 0.16995E+01, 0.17067E+01, 0.17138E+01, 0.17210E+01,
- & 0.17281E+01, 0.17352E+01, 0.17423E+01, 0.17493E+01, 0.17564E+01,
- & 0.17635E+01, 0.17705E+01, 0.17775E+01, 0.17845E+01, 0.17915E+01,
- & 0.17985E+01, 0.18054E+01, 0.18124E+01, 0.18193E+01, 0.18262E+01,
- & 0.18331E+01, 0.18400E+01, 0.18469E+01, 0.18537E+01, 0.18606E+01,
- & 0.18674E+01, 0.18742E+01, 0.18810E+01, 0.18878E+01, 0.18946E+01,
- & 0.19014E+01, 0.19081E+01, 0.19148E+01, 0.19216E+01, 0.19283E+01,
- & 0.19350E+01, 0.19416E+01, 0.19483E+01, 0.19550E+01, 0.19616E+01,
- & 0.19682E+01, 0.19748E+01, 0.19814E+01, 0.19880E+01, 0.19946E+01,
- & 0.20011E+01, 0.20077E+01, 0.20142E+01, 0.20207E+01, 0.20272E+01,
- & 0.20337E+01, 0.20402E+01, 0.20467E+01, 0.20531E+01, 0.20596E+01/
-
- DATA (BNC11M(I),I=301,400)/
- & 0.20660E+01, 0.20724E+01, 0.20788E+01, 0.20852E+01, 0.20916E+01,
- & 0.20979E+01, 0.21043E+01, 0.21106E+01, 0.21169E+01, 0.21233E+01,
- & 0.21296E+01, 0.21358E+01, 0.21421E+01, 0.21484E+01, 0.21546E+01,
- & 0.21609E+01, 0.21671E+01, 0.21733E+01, 0.21795E+01, 0.21857E+01,
- & 0.21919E+01, 0.21981E+01, 0.22042E+01, 0.22104E+01, 0.22165E+01,
- & 0.22226E+01, 0.22287E+01, 0.22348E+01, 0.22409E+01, 0.22470E+01,
- & 0.22530E+01, 0.22591E+01, 0.22651E+01, 0.22711E+01, 0.22771E+01,
- & 0.22831E+01, 0.22891E+01, 0.22951E+01, 0.23011E+01, 0.23070E+01,
- & 0.23130E+01, 0.23189E+01, 0.23248E+01, 0.23308E+01, 0.23367E+01,
- & 0.23425E+01, 0.23484E+01, 0.23543E+01, 0.23601E+01, 0.23660E+01,
- & 0.23718E+01, 0.23776E+01, 0.23835E+01, 0.23893E+01, 0.23950E+01,
- & 0.24008E+01, 0.24066E+01, 0.24124E+01, 0.24181E+01, 0.24238E+01,
- & 0.24296E+01, 0.24353E+01, 0.24410E+01, 0.24467E+01, 0.24524E+01,
- & 0.24580E+01, 0.24637E+01, 0.24694E+01, 0.24750E+01, 0.24806E+01,
- & 0.24862E+01, 0.24919E+01, 0.24975E+01, 0.25031E+01, 0.25086E+01,
- & 0.25142E+01, 0.25198E+01, 0.25253E+01, 0.25309E+01, 0.25364E+01,
- & 0.25419E+01, 0.25474E+01, 0.25529E+01, 0.25584E+01, 0.25639E+01,
- & 0.25694E+01, 0.25748E+01, 0.25803E+01, 0.25857E+01, 0.25912E+01,
- & 0.25966E+01, 0.26020E+01, 0.26074E+01, 0.26128E+01, 0.26182E+01,
- & 0.26235E+01, 0.26289E+01, 0.26343E+01, 0.26396E+01, 0.26450E+01/
-
- DATA (BNC11M(I),I=401,500)/
- & 0.26503E+01, 0.26556E+01, 0.26609E+01, 0.26662E+01, 0.26715E+01,
- & 0.26768E+01, 0.26821E+01, 0.26873E+01, 0.26926E+01, 0.26978E+01,
- & 0.27031E+01, 0.27083E+01, 0.27135E+01, 0.27187E+01, 0.27239E+01,
- & 0.27291E+01, 0.27343E+01, 0.27395E+01, 0.27446E+01, 0.27498E+01,
- & 0.27549E+01, 0.27601E+01, 0.27652E+01, 0.27703E+01, 0.27754E+01,
- & 0.27805E+01, 0.27856E+01, 0.27907E+01, 0.27958E+01, 0.28008E+01,
- & 0.28059E+01, 0.28110E+01, 0.28160E+01, 0.28210E+01, 0.28261E+01,
- & 0.28311E+01, 0.28361E+01, 0.28411E+01, 0.28461E+01, 0.28511E+01,
- & 0.28560E+01, 0.28610E+01, 0.28660E+01, 0.28709E+01, 0.28759E+01,
- & 0.28808E+01, 0.28857E+01, 0.28906E+01, 0.28956E+01, 0.29005E+01,
- & 0.29053E+01, 0.29102E+01, 0.29151E+01, 0.29200E+01, 0.29248E+01,
- & 0.29297E+01, 0.29345E+01, 0.29394E+01, 0.29442E+01, 0.29490E+01,
- & 0.29539E+01, 0.29587E+01, 0.29635E+01, 0.29683E+01, 0.29730E+01,
- & 0.29778E+01, 0.29826E+01, 0.29873E+01, 0.29921E+01, 0.29968E+01,
- & 0.30016E+01, 0.30063E+01, 0.30110E+01, 0.30157E+01, 0.30205E+01,
- & 0.30252E+01, 0.30298E+01, 0.30345E+01, 0.30392E+01, 0.30439E+01,
- & 0.30485E+01, 0.30532E+01, 0.30578E+01, 0.30625E+01, 0.30671E+01,
- & 0.30717E+01, 0.30764E+01, 0.30810E+01, 0.30856E+01, 0.30902E+01,
- & 0.30948E+01, 0.30994E+01, 0.31039E+01, 0.31085E+01, 0.31131E+01,
- & 0.31176E+01, 0.31222E+01, 0.31267E+01, 0.31312E+01, 0.31358E+01/
-
- DATA (BNC11M(I),I=501,600)/
- & 0.31403E+01, 0.31448E+01, 0.31493E+01, 0.31538E+01, 0.31583E+01,
- & 0.31628E+01, 0.31672E+01, 0.31717E+01, 0.31762E+01, 0.31806E+01,
- & 0.31851E+01, 0.31895E+01, 0.31940E+01, 0.31984E+01, 0.32028E+01,
- & 0.32072E+01, 0.32117E+01, 0.32161E+01, 0.32205E+01, 0.32248E+01,
- & 0.32292E+01, 0.32336E+01, 0.32380E+01, 0.32423E+01, 0.32467E+01,
- & 0.32510E+01, 0.32554E+01, 0.32597E+01, 0.32641E+01, 0.32684E+01,
- & 0.32727E+01, 0.32770E+01, 0.32813E+01, 0.32856E+01, 0.32899E+01,
- & 0.32942E+01, 0.32985E+01, 0.33028E+01, 0.33070E+01, 0.33113E+01,
- & 0.33155E+01, 0.33198E+01, 0.33240E+01, 0.33283E+01, 0.33325E+01,
- & 0.33367E+01, 0.33409E+01, 0.33451E+01, 0.33493E+01, 0.33535E+01,
- & 0.33577E+01, 0.33619E+01, 0.33661E+01, 0.33703E+01, 0.33744E+01,
- & 0.33786E+01, 0.33828E+01, 0.33869E+01, 0.33911E+01, 0.33952E+01,
- & 0.33993E+01, 0.34035E+01, 0.34076E+01, 0.34117E+01, 0.34158E+01,
- & 0.34199E+01, 0.34240E+01, 0.34281E+01, 0.34322E+01, 0.34363E+01,
- & 0.34403E+01, 0.34444E+01, 0.34485E+01, 0.34525E+01, 0.34566E+01,
- & 0.34606E+01, 0.34647E+01, 0.34687E+01, 0.34727E+01, 0.34767E+01,
- & 0.34808E+01, 0.34848E+01, 0.34888E+01, 0.34928E+01, 0.34968E+01,
- & 0.35008E+01, 0.35047E+01, 0.35087E+01, 0.35127E+01, 0.35167E+01,
- & 0.35206E+01, 0.35246E+01, 0.35285E+01, 0.35325E+01, 0.35364E+01,
- & 0.35403E+01, 0.35443E+01, 0.35482E+01, 0.35521E+01, 0.35560E+01/
-
- DATA (BNC11M(I),I=601,700)/
- & 0.35979E+01, 0.36362E+01, 0.36739E+01, 0.37112E+01, 0.37479E+01,
- & 0.37842E+01, 0.38200E+01, 0.38554E+01, 0.38903E+01, 0.39247E+01,
- & 0.39588E+01, 0.39924E+01, 0.40256E+01, 0.40584E+01, 0.40909E+01,
- & 0.41229E+01, 0.41546E+01, 0.41859E+01, 0.42168E+01, 0.42474E+01,
- & 0.42776E+01, 0.43075E+01, 0.43371E+01, 0.43664E+01, 0.43953E+01,
- & 0.44239E+01, 0.44522E+01, 0.44802E+01, 0.45079E+01, 0.45353E+01,
- & 0.45624E+01, 0.45893E+01, 0.46158E+01, 0.46421E+01, 0.46681E+01,
- & 0.46939E+01, 0.47194E+01, 0.47447E+01, 0.47697E+01, 0.47944E+01,
- & 0.48190E+01, 0.48432E+01, 0.48673E+01, 0.48911E+01, 0.49147E+01,
- & 0.49381E+01, 0.49612E+01, 0.49842E+01, 0.50069E+01, 0.50294E+01,
- & 0.50517E+01, 0.50738E+01, 0.50958E+01, 0.51175E+01, 0.51390E+01,
- & 0.51603E+01, 0.51815E+01, 0.52024E+01, 0.52232E+01, 0.52438E+01,
- & 0.52643E+01, 0.52845E+01, 0.53046E+01, 0.53245E+01, 0.53442E+01,
- & 0.53638E+01, 0.53832E+01, 0.54025E+01, 0.54216E+01, 0.54405E+01,
- & 0.54593E+01, 0.54779E+01, 0.54964E+01, 0.55147E+01, 0.55329E+01,
- & 0.55510E+01, 0.55689E+01, 0.55866E+01, 0.56043E+01, 0.56217E+01,
- & 0.56391E+01, 0.56563E+01, 0.56734E+01, 0.56903E+01, 0.57072E+01,
- & 0.57239E+01, 0.57404E+01, 0.57569E+01, 0.57732E+01, 0.57894E+01,
- & 0.58055E+01, 0.58215E+01, 0.58373E+01, 0.58530E+01, 0.58687E+01,
- & 0.58842E+01, 0.58996E+01, 0.59148E+01, 0.59300E+01, 0.59451E+01/
-
- DATA (BNC11M(I),I=701,741)/
- & 0.59600E+01, 0.59749E+01, 0.59896E+01, 0.60043E+01, 0.60188E+01,
- & 0.60333E+01, 0.60476E+01, 0.60619E+01, 0.60760E+01, 0.60901E+01,
- & 0.61040E+01, 0.61179E+01, 0.61316E+01, 0.61453E+01, 0.61589E+01,
- & 0.61724E+01, 0.61858E+01, 0.61991E+01, 0.62123E+01, 0.62254E+01,
- & 0.62385E+01, 0.62514E+01, 0.62643E+01, 0.62771E+01, 0.62898E+01,
- & 0.63024E+01, 0.63150E+01, 0.63274E+01, 0.63398E+01, 0.63521E+01,
- & 0.63644E+01, 0.63765E+01, 0.63886E+01, 0.64006E+01, 0.64125E+01,
- & 0.64243E+01, 0.64361E+01, 0.64478E+01, 0.64594E+01, 0.64710E+01,
- & 0.64825E+01
- & /
-C
-C *** NaHSO4
-C
- DATA (BNC12M(I),I=1,100)/
- &-0.48156E-01,-0.99449E-01,-0.12247E+00,-0.13741E+00,-0.14823E+00,
- &-0.15646E+00,-0.16292E+00,-0.16806E+00,-0.17218E+00,-0.17549E+00,
- &-0.17813E+00,-0.18020E+00,-0.18178E+00,-0.18294E+00,-0.18372E+00,
- &-0.18417E+00,-0.18432E+00,-0.18420E+00,-0.18383E+00,-0.18323E+00,
- &-0.18241E+00,-0.18140E+00,-0.18020E+00,-0.17883E+00,-0.17729E+00,
- &-0.17560E+00,-0.17376E+00,-0.17179E+00,-0.16968E+00,-0.16745E+00,
- &-0.16509E+00,-0.16262E+00,-0.16005E+00,-0.15737E+00,-0.15459E+00,
- &-0.15171E+00,-0.14874E+00,-0.14568E+00,-0.14254E+00,-0.13932E+00,
- &-0.13602E+00,-0.13265E+00,-0.12921E+00,-0.12569E+00,-0.12212E+00,
- &-0.11847E+00,-0.11477E+00,-0.11101E+00,-0.10719E+00,-0.10332E+00,
- &-0.99401E-01,-0.95428E-01,-0.91408E-01,-0.87340E-01,-0.83227E-01,
- &-0.79071E-01,-0.74872E-01,-0.70632E-01,-0.66351E-01,-0.62032E-01,
- &-0.57674E-01,-0.53279E-01,-0.48846E-01,-0.44378E-01,-0.39874E-01,
- &-0.35334E-01,-0.30759E-01,-0.26149E-01,-0.21504E-01,-0.16825E-01,
- &-0.12111E-01,-0.73619E-02,-0.25784E-02, 0.22401E-02, 0.70935E-02,
- & 0.11982E-01, 0.16906E-01, 0.21866E-01, 0.26861E-01, 0.31892E-01,
- & 0.36958E-01, 0.42061E-01, 0.47200E-01, 0.52375E-01, 0.57586E-01,
- & 0.62833E-01, 0.68116E-01, 0.73434E-01, 0.78787E-01, 0.84176E-01,
- & 0.89598E-01, 0.95055E-01, 0.10054E+00, 0.10607E+00, 0.11162E+00,
- & 0.11721E+00, 0.12282E+00, 0.12847E+00, 0.13414E+00, 0.13984E+00/
-
- DATA (BNC12M(I),I=101,200)/
- & 0.14556E+00, 0.15132E+00, 0.15709E+00, 0.16289E+00, 0.16871E+00,
- & 0.17454E+00, 0.18040E+00, 0.18627E+00, 0.19216E+00, 0.19807E+00,
- & 0.20399E+00, 0.20992E+00, 0.21586E+00, 0.22181E+00, 0.22777E+00,
- & 0.23374E+00, 0.23971E+00, 0.24569E+00, 0.25168E+00, 0.25766E+00,
- & 0.26365E+00, 0.26964E+00, 0.27563E+00, 0.28162E+00, 0.28761E+00,
- & 0.29360E+00, 0.29958E+00, 0.30556E+00, 0.31153E+00, 0.31750E+00,
- & 0.32347E+00, 0.32943E+00, 0.33538E+00, 0.34133E+00, 0.34727E+00,
- & 0.35320E+00, 0.35912E+00, 0.36504E+00, 0.37094E+00, 0.37684E+00,
- & 0.38273E+00, 0.38861E+00, 0.39448E+00, 0.40034E+00, 0.40618E+00,
- & 0.41202E+00, 0.41785E+00, 0.42367E+00, 0.42947E+00, 0.43527E+00,
- & 0.44105E+00, 0.44683E+00, 0.45259E+00, 0.45834E+00, 0.46408E+00,
- & 0.46981E+00, 0.47552E+00, 0.48123E+00, 0.48692E+00, 0.49260E+00,
- & 0.49827E+00, 0.50393E+00, 0.50957E+00, 0.51520E+00, 0.52083E+00,
- & 0.52644E+00, 0.53203E+00, 0.53762E+00, 0.54319E+00, 0.54875E+00,
- & 0.55430E+00, 0.55984E+00, 0.56537E+00, 0.57088E+00, 0.57638E+00,
- & 0.58187E+00, 0.58734E+00, 0.59281E+00, 0.59826E+00, 0.60370E+00,
- & 0.60913E+00, 0.61455E+00, 0.61995E+00, 0.62534E+00, 0.63072E+00,
- & 0.63609E+00, 0.64145E+00, 0.64679E+00, 0.65212E+00, 0.65744E+00,
- & 0.66275E+00, 0.66805E+00, 0.67333E+00, 0.67860E+00, 0.68387E+00,
- & 0.68911E+00, 0.69435E+00, 0.69958E+00, 0.70479E+00, 0.70999E+00/
-
- DATA (BNC12M(I),I=201,300)/
- & 0.71518E+00, 0.72036E+00, 0.72553E+00, 0.73068E+00, 0.73582E+00,
- & 0.74096E+00, 0.74608E+00, 0.75118E+00, 0.75628E+00, 0.76137E+00,
- & 0.76644E+00, 0.77150E+00, 0.77656E+00, 0.78160E+00, 0.78663E+00,
- & 0.79164E+00, 0.79665E+00, 0.80164E+00, 0.80663E+00, 0.81160E+00,
- & 0.81656E+00, 0.82152E+00, 0.82646E+00, 0.83138E+00, 0.83630E+00,
- & 0.84121E+00, 0.84611E+00, 0.85099E+00, 0.85587E+00, 0.86073E+00,
- & 0.86558E+00, 0.87042E+00, 0.87526E+00, 0.88008E+00, 0.88489E+00,
- & 0.88969E+00, 0.89448E+00, 0.89926E+00, 0.90403E+00, 0.90878E+00,
- & 0.91353E+00, 0.91827E+00, 0.92300E+00, 0.92771E+00, 0.93242E+00,
- & 0.93711E+00, 0.94180E+00, 0.94648E+00, 0.95114E+00, 0.95580E+00,
- & 0.96044E+00, 0.96508E+00, 0.96971E+00, 0.97432E+00, 0.97893E+00,
- & 0.98352E+00, 0.98811E+00, 0.99269E+00, 0.99725E+00, 0.10018E+01,
- & 0.10064E+01, 0.10109E+01, 0.10154E+01, 0.10199E+01, 0.10245E+01,
- & 0.10290E+01, 0.10334E+01, 0.10379E+01, 0.10424E+01, 0.10469E+01,
- & 0.10513E+01, 0.10558E+01, 0.10602E+01, 0.10646E+01, 0.10690E+01,
- & 0.10734E+01, 0.10778E+01, 0.10822E+01, 0.10866E+01, 0.10910E+01,
- & 0.10953E+01, 0.10997E+01, 0.11040E+01, 0.11084E+01, 0.11127E+01,
- & 0.11170E+01, 0.11213E+01, 0.11256E+01, 0.11299E+01, 0.11342E+01,
- & 0.11384E+01, 0.11427E+01, 0.11470E+01, 0.11512E+01, 0.11554E+01,
- & 0.11597E+01, 0.11639E+01, 0.11681E+01, 0.11723E+01, 0.11765E+01/
-
- DATA (BNC12M(I),I=301,400)/
- & 0.11807E+01, 0.11849E+01, 0.11890E+01, 0.11932E+01, 0.11974E+01,
- & 0.12015E+01, 0.12056E+01, 0.12098E+01, 0.12139E+01, 0.12180E+01,
- & 0.12221E+01, 0.12262E+01, 0.12303E+01, 0.12344E+01, 0.12384E+01,
- & 0.12425E+01, 0.12466E+01, 0.12506E+01, 0.12547E+01, 0.12587E+01,
- & 0.12627E+01, 0.12667E+01, 0.12707E+01, 0.12747E+01, 0.12787E+01,
- & 0.12827E+01, 0.12867E+01, 0.12907E+01, 0.12946E+01, 0.12986E+01,
- & 0.13025E+01, 0.13065E+01, 0.13104E+01, 0.13143E+01, 0.13182E+01,
- & 0.13221E+01, 0.13261E+01, 0.13299E+01, 0.13338E+01, 0.13377E+01,
- & 0.13416E+01, 0.13455E+01, 0.13493E+01, 0.13532E+01, 0.13570E+01,
- & 0.13608E+01, 0.13647E+01, 0.13685E+01, 0.13723E+01, 0.13761E+01,
- & 0.13799E+01, 0.13837E+01, 0.13875E+01, 0.13913E+01, 0.13950E+01,
- & 0.13988E+01, 0.14026E+01, 0.14063E+01, 0.14101E+01, 0.14138E+01,
- & 0.14175E+01, 0.14213E+01, 0.14250E+01, 0.14287E+01, 0.14324E+01,
- & 0.14361E+01, 0.14398E+01, 0.14435E+01, 0.14471E+01, 0.14508E+01,
- & 0.14545E+01, 0.14581E+01, 0.14618E+01, 0.14654E+01, 0.14690E+01,
- & 0.14727E+01, 0.14763E+01, 0.14799E+01, 0.14835E+01, 0.14871E+01,
- & 0.14907E+01, 0.14943E+01, 0.14979E+01, 0.15015E+01, 0.15051E+01,
- & 0.15086E+01, 0.15122E+01, 0.15157E+01, 0.15193E+01, 0.15228E+01,
- & 0.15264E+01, 0.15299E+01, 0.15334E+01, 0.15369E+01, 0.15404E+01,
- & 0.15439E+01, 0.15474E+01, 0.15509E+01, 0.15544E+01, 0.15579E+01/
-
- DATA (BNC12M(I),I=401,500)/
- & 0.15613E+01, 0.15648E+01, 0.15683E+01, 0.15717E+01, 0.15752E+01,
- & 0.15786E+01, 0.15821E+01, 0.15855E+01, 0.15889E+01, 0.15923E+01,
- & 0.15957E+01, 0.15991E+01, 0.16025E+01, 0.16059E+01, 0.16093E+01,
- & 0.16127E+01, 0.16161E+01, 0.16195E+01, 0.16228E+01, 0.16262E+01,
- & 0.16295E+01, 0.16329E+01, 0.16362E+01, 0.16396E+01, 0.16429E+01,
- & 0.16462E+01, 0.16495E+01, 0.16529E+01, 0.16562E+01, 0.16595E+01,
- & 0.16628E+01, 0.16661E+01, 0.16693E+01, 0.16726E+01, 0.16759E+01,
- & 0.16792E+01, 0.16824E+01, 0.16857E+01, 0.16890E+01, 0.16922E+01,
- & 0.16954E+01, 0.16987E+01, 0.17019E+01, 0.17051E+01, 0.17084E+01,
- & 0.17116E+01, 0.17148E+01, 0.17180E+01, 0.17212E+01, 0.17244E+01,
- & 0.17276E+01, 0.17308E+01, 0.17339E+01, 0.17371E+01, 0.17403E+01,
- & 0.17434E+01, 0.17466E+01, 0.17498E+01, 0.17529E+01, 0.17561E+01,
- & 0.17592E+01, 0.17623E+01, 0.17655E+01, 0.17686E+01, 0.17717E+01,
- & 0.17748E+01, 0.17779E+01, 0.17810E+01, 0.17841E+01, 0.17872E+01,
- & 0.17903E+01, 0.17934E+01, 0.17965E+01, 0.17995E+01, 0.18026E+01,
- & 0.18057E+01, 0.18087E+01, 0.18118E+01, 0.18148E+01, 0.18179E+01,
- & 0.18209E+01, 0.18239E+01, 0.18270E+01, 0.18300E+01, 0.18330E+01,
- & 0.18360E+01, 0.18390E+01, 0.18420E+01, 0.18450E+01, 0.18480E+01,
- & 0.18510E+01, 0.18540E+01, 0.18570E+01, 0.18600E+01, 0.18629E+01,
- & 0.18659E+01, 0.18689E+01, 0.18718E+01, 0.18748E+01, 0.18777E+01/
-
- DATA (BNC12M(I),I=501,600)/
- & 0.18807E+01, 0.18836E+01, 0.18865E+01, 0.18895E+01, 0.18924E+01,
- & 0.18953E+01, 0.18982E+01, 0.19012E+01, 0.19041E+01, 0.19070E+01,
- & 0.19099E+01, 0.19128E+01, 0.19157E+01, 0.19185E+01, 0.19214E+01,
- & 0.19243E+01, 0.19272E+01, 0.19300E+01, 0.19329E+01, 0.19358E+01,
- & 0.19386E+01, 0.19415E+01, 0.19443E+01, 0.19472E+01, 0.19500E+01,
- & 0.19528E+01, 0.19557E+01, 0.19585E+01, 0.19613E+01, 0.19641E+01,
- & 0.19669E+01, 0.19697E+01, 0.19725E+01, 0.19753E+01, 0.19781E+01,
- & 0.19809E+01, 0.19837E+01, 0.19865E+01, 0.19893E+01, 0.19921E+01,
- & 0.19948E+01, 0.19976E+01, 0.20004E+01, 0.20031E+01, 0.20059E+01,
- & 0.20086E+01, 0.20114E+01, 0.20141E+01, 0.20168E+01, 0.20196E+01,
- & 0.20223E+01, 0.20250E+01, 0.20278E+01, 0.20305E+01, 0.20332E+01,
- & 0.20359E+01, 0.20386E+01, 0.20413E+01, 0.20440E+01, 0.20467E+01,
- & 0.20494E+01, 0.20521E+01, 0.20548E+01, 0.20574E+01, 0.20601E+01,
- & 0.20628E+01, 0.20654E+01, 0.20681E+01, 0.20708E+01, 0.20734E+01,
- & 0.20761E+01, 0.20787E+01, 0.20814E+01, 0.20840E+01, 0.20866E+01,
- & 0.20893E+01, 0.20919E+01, 0.20945E+01, 0.20971E+01, 0.20998E+01,
- & 0.21024E+01, 0.21050E+01, 0.21076E+01, 0.21102E+01, 0.21128E+01,
- & 0.21154E+01, 0.21180E+01, 0.21206E+01, 0.21231E+01, 0.21257E+01,
- & 0.21283E+01, 0.21309E+01, 0.21334E+01, 0.21360E+01, 0.21386E+01,
- & 0.21411E+01, 0.21437E+01, 0.21462E+01, 0.21488E+01, 0.21513E+01/
-
- DATA (BNC12M(I),I=601,700)/
- & 0.21786E+01, 0.22034E+01, 0.22280E+01, 0.22522E+01, 0.22760E+01,
- & 0.22996E+01, 0.23228E+01, 0.23457E+01, 0.23684E+01, 0.23907E+01,
- & 0.24128E+01, 0.24345E+01, 0.24560E+01, 0.24773E+01, 0.24982E+01,
- & 0.25190E+01, 0.25394E+01, 0.25596E+01, 0.25796E+01, 0.25993E+01,
- & 0.26188E+01, 0.26381E+01, 0.26571E+01, 0.26760E+01, 0.26946E+01,
- & 0.27130E+01, 0.27312E+01, 0.27491E+01, 0.27669E+01, 0.27845E+01,
- & 0.28019E+01, 0.28191E+01, 0.28361E+01, 0.28529E+01, 0.28696E+01,
- & 0.28860E+01, 0.29023E+01, 0.29185E+01, 0.29344E+01, 0.29502E+01,
- & 0.29658E+01, 0.29813E+01, 0.29966E+01, 0.30117E+01, 0.30267E+01,
- & 0.30415E+01, 0.30562E+01, 0.30708E+01, 0.30852E+01, 0.30994E+01,
- & 0.31136E+01, 0.31275E+01, 0.31414E+01, 0.31551E+01, 0.31687E+01,
- & 0.31821E+01, 0.31954E+01, 0.32086E+01, 0.32217E+01, 0.32346E+01,
- & 0.32474E+01, 0.32601E+01, 0.32727E+01, 0.32852E+01, 0.32976E+01,
- & 0.33098E+01, 0.33219E+01, 0.33339E+01, 0.33459E+01, 0.33577E+01,
- & 0.33694E+01, 0.33810E+01, 0.33924E+01, 0.34038E+01, 0.34151E+01,
- & 0.34263E+01, 0.34374E+01, 0.34484E+01, 0.34593E+01, 0.34701E+01,
- & 0.34808E+01, 0.34914E+01, 0.35020E+01, 0.35124E+01, 0.35228E+01,
- & 0.35330E+01, 0.35432E+01, 0.35533E+01, 0.35633E+01, 0.35732E+01,
- & 0.35831E+01, 0.35928E+01, 0.36025E+01, 0.36121E+01, 0.36216E+01,
- & 0.36311E+01, 0.36405E+01, 0.36497E+01, 0.36590E+01, 0.36681E+01/
-
- DATA (BNC12M(I),I=701,741)/
- & 0.36772E+01, 0.36862E+01, 0.36951E+01, 0.37039E+01, 0.37127E+01,
- & 0.37214E+01, 0.37301E+01, 0.37386E+01, 0.37472E+01, 0.37556E+01,
- & 0.37640E+01, 0.37723E+01, 0.37805E+01, 0.37887E+01, 0.37968E+01,
- & 0.38049E+01, 0.38129E+01, 0.38208E+01, 0.38287E+01, 0.38365E+01,
- & 0.38442E+01, 0.38519E+01, 0.38595E+01, 0.38671E+01, 0.38746E+01,
- & 0.38821E+01, 0.38895E+01, 0.38968E+01, 0.39041E+01, 0.39114E+01,
- & 0.39186E+01, 0.39257E+01, 0.39328E+01, 0.39398E+01, 0.39468E+01,
- & 0.39537E+01, 0.39606E+01, 0.39674E+01, 0.39742E+01, 0.39809E+01,
- & 0.39875E+01
- & /
-C
-C *** (NH4)3H(SO4)2
-C
- DATA (BNC13M(I),I=1,100)/
- &-0.79945E-01,-0.17380E+00,-0.22078E+00,-0.25407E+00,-0.28025E+00,
- &-0.30198E+00,-0.32062E+00,-0.33698E+00,-0.35158E+00,-0.36476E+00,
- &-0.37680E+00,-0.38787E+00,-0.39813E+00,-0.40767E+00,-0.41660E+00,
- &-0.42499E+00,-0.43289E+00,-0.44036E+00,-0.44744E+00,-0.45416E+00,
- &-0.46056E+00,-0.46665E+00,-0.47248E+00,-0.47805E+00,-0.48338E+00,
- &-0.48850E+00,-0.49341E+00,-0.49812E+00,-0.50265E+00,-0.50701E+00,
- &-0.51121E+00,-0.51525E+00,-0.51915E+00,-0.52291E+00,-0.52654E+00,
- &-0.53004E+00,-0.53342E+00,-0.53669E+00,-0.53985E+00,-0.54290E+00,
- &-0.54585E+00,-0.54871E+00,-0.55147E+00,-0.55415E+00,-0.55674E+00,
- &-0.55924E+00,-0.56167E+00,-0.56402E+00,-0.56630E+00,-0.56851E+00,
- &-0.57065E+00,-0.57272E+00,-0.57473E+00,-0.57668E+00,-0.57857E+00,
- &-0.58041E+00,-0.58219E+00,-0.58391E+00,-0.58559E+00,-0.58721E+00,
- &-0.58879E+00,-0.59031E+00,-0.59180E+00,-0.59324E+00,-0.59464E+00,
- &-0.59599E+00,-0.59731E+00,-0.59859E+00,-0.59983E+00,-0.60103E+00,
- &-0.60220E+00,-0.60333E+00,-0.60443E+00,-0.60550E+00,-0.60653E+00,
- &-0.60753E+00,-0.60850E+00,-0.60945E+00,-0.61036E+00,-0.61124E+00,
- &-0.61209E+00,-0.61292E+00,-0.61372E+00,-0.61449E+00,-0.61524E+00,
- &-0.61596E+00,-0.61666E+00,-0.61733E+00,-0.61798E+00,-0.61861E+00,
- &-0.61921E+00,-0.61979E+00,-0.62035E+00,-0.62089E+00,-0.62141E+00,
- &-0.62190E+00,-0.62238E+00,-0.62284E+00,-0.62328E+00,-0.62370E+00/
-
- DATA (BNC13M(I),I=101,200)/
- &-0.62410E+00,-0.62449E+00,-0.62486E+00,-0.62521E+00,-0.62555E+00,
- &-0.62587E+00,-0.62618E+00,-0.62648E+00,-0.62676E+00,-0.62702E+00,
- &-0.62728E+00,-0.62752E+00,-0.62776E+00,-0.62798E+00,-0.62819E+00,
- &-0.62839E+00,-0.62858E+00,-0.62876E+00,-0.62893E+00,-0.62910E+00,
- &-0.62925E+00,-0.62940E+00,-0.62954E+00,-0.62967E+00,-0.62980E+00,
- &-0.62992E+00,-0.63003E+00,-0.63014E+00,-0.63024E+00,-0.63034E+00,
- &-0.63043E+00,-0.63052E+00,-0.63060E+00,-0.63068E+00,-0.63075E+00,
- &-0.63082E+00,-0.63089E+00,-0.63095E+00,-0.63101E+00,-0.63106E+00,
- &-0.63111E+00,-0.63116E+00,-0.63121E+00,-0.63125E+00,-0.63129E+00,
- &-0.63133E+00,-0.63136E+00,-0.63140E+00,-0.63143E+00,-0.63146E+00,
- &-0.63148E+00,-0.63151E+00,-0.63153E+00,-0.63155E+00,-0.63157E+00,
- &-0.63159E+00,-0.63161E+00,-0.63162E+00,-0.63164E+00,-0.63165E+00,
- &-0.63166E+00,-0.63167E+00,-0.63168E+00,-0.63169E+00,-0.63170E+00,
- &-0.63170E+00,-0.63171E+00,-0.63171E+00,-0.63172E+00,-0.63172E+00,
- &-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00,
- &-0.63174E+00,-0.63174E+00,-0.63174E+00,-0.63174E+00,-0.63174E+00,
- &-0.63174E+00,-0.63174E+00,-0.63174E+00,-0.63174E+00,-0.63174E+00,
- &-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00,
- &-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00,-0.63173E+00,
- &-0.63173E+00,-0.63173E+00,-0.63174E+00,-0.63174E+00,-0.63174E+00/
-
- DATA (BNC13M(I),I=201,300)/
- &-0.63174E+00,-0.63174E+00,-0.63175E+00,-0.63175E+00,-0.63175E+00,
- &-0.63176E+00,-0.63176E+00,-0.63176E+00,-0.63177E+00,-0.63178E+00,
- &-0.63178E+00,-0.63179E+00,-0.63180E+00,-0.63180E+00,-0.63181E+00,
- &-0.63182E+00,-0.63183E+00,-0.63184E+00,-0.63185E+00,-0.63186E+00,
- &-0.63187E+00,-0.63188E+00,-0.63190E+00,-0.63191E+00,-0.63192E+00,
- &-0.63194E+00,-0.63195E+00,-0.63197E+00,-0.63199E+00,-0.63200E+00,
- &-0.63202E+00,-0.63204E+00,-0.63206E+00,-0.63208E+00,-0.63210E+00,
- &-0.63212E+00,-0.63214E+00,-0.63216E+00,-0.63219E+00,-0.63221E+00,
- &-0.63223E+00,-0.63226E+00,-0.63229E+00,-0.63231E+00,-0.63234E+00,
- &-0.63237E+00,-0.63240E+00,-0.63243E+00,-0.63246E+00,-0.63249E+00,
- &-0.63252E+00,-0.63255E+00,-0.63259E+00,-0.63262E+00,-0.63266E+00,
- &-0.63269E+00,-0.63273E+00,-0.63277E+00,-0.63280E+00,-0.63284E+00,
- &-0.63288E+00,-0.63292E+00,-0.63296E+00,-0.63301E+00,-0.63305E+00,
- &-0.63309E+00,-0.63314E+00,-0.63318E+00,-0.63323E+00,-0.63327E+00,
- &-0.63332E+00,-0.63337E+00,-0.63342E+00,-0.63347E+00,-0.63352E+00,
- &-0.63357E+00,-0.63362E+00,-0.63367E+00,-0.63373E+00,-0.63378E+00,
- &-0.63384E+00,-0.63389E+00,-0.63395E+00,-0.63401E+00,-0.63407E+00,
- &-0.63413E+00,-0.63419E+00,-0.63425E+00,-0.63431E+00,-0.63437E+00,
- &-0.63443E+00,-0.63450E+00,-0.63456E+00,-0.63463E+00,-0.63470E+00,
- &-0.63476E+00,-0.63483E+00,-0.63490E+00,-0.63497E+00,-0.63504E+00/
-
- DATA (BNC13M(I),I=301,400)/
- &-0.63511E+00,-0.63518E+00,-0.63526E+00,-0.63533E+00,-0.63540E+00,
- &-0.63548E+00,-0.63556E+00,-0.63563E+00,-0.63571E+00,-0.63579E+00,
- &-0.63587E+00,-0.63595E+00,-0.63603E+00,-0.63611E+00,-0.63619E+00,
- &-0.63627E+00,-0.63636E+00,-0.63644E+00,-0.63653E+00,-0.63661E+00,
- &-0.63670E+00,-0.63679E+00,-0.63688E+00,-0.63697E+00,-0.63706E+00,
- &-0.63715E+00,-0.63724E+00,-0.63733E+00,-0.63743E+00,-0.63752E+00,
- &-0.63761E+00,-0.63771E+00,-0.63781E+00,-0.63790E+00,-0.63800E+00,
- &-0.63810E+00,-0.63820E+00,-0.63830E+00,-0.63840E+00,-0.63850E+00,
- &-0.63860E+00,-0.63871E+00,-0.63881E+00,-0.63892E+00,-0.63902E+00,
- &-0.63913E+00,-0.63923E+00,-0.63934E+00,-0.63945E+00,-0.63956E+00,
- &-0.63967E+00,-0.63978E+00,-0.63989E+00,-0.64000E+00,-0.64012E+00,
- &-0.64023E+00,-0.64034E+00,-0.64046E+00,-0.64058E+00,-0.64069E+00,
- &-0.64081E+00,-0.64093E+00,-0.64105E+00,-0.64117E+00,-0.64129E+00,
- &-0.64141E+00,-0.64153E+00,-0.64165E+00,-0.64177E+00,-0.64190E+00,
- &-0.64202E+00,-0.64215E+00,-0.64228E+00,-0.64240E+00,-0.64253E+00,
- &-0.64266E+00,-0.64279E+00,-0.64292E+00,-0.64305E+00,-0.64318E+00,
- &-0.64331E+00,-0.64344E+00,-0.64358E+00,-0.64371E+00,-0.64385E+00,
- &-0.64398E+00,-0.64412E+00,-0.64425E+00,-0.64439E+00,-0.64453E+00,
- &-0.64467E+00,-0.64481E+00,-0.64495E+00,-0.64509E+00,-0.64523E+00,
- &-0.64537E+00,-0.64552E+00,-0.64566E+00,-0.64581E+00,-0.64595E+00/
-
- DATA (BNC13M(I),I=401,500)/
- &-0.64610E+00,-0.64624E+00,-0.64639E+00,-0.64654E+00,-0.64669E+00,
- &-0.64684E+00,-0.64699E+00,-0.64714E+00,-0.64729E+00,-0.64744E+00,
- &-0.64759E+00,-0.64775E+00,-0.64790E+00,-0.64805E+00,-0.64821E+00,
- &-0.64837E+00,-0.64852E+00,-0.64868E+00,-0.64884E+00,-0.64900E+00,
- &-0.64916E+00,-0.64932E+00,-0.64948E+00,-0.64964E+00,-0.64980E+00,
- &-0.64996E+00,-0.65013E+00,-0.65029E+00,-0.65045E+00,-0.65062E+00,
- &-0.65079E+00,-0.65095E+00,-0.65112E+00,-0.65129E+00,-0.65146E+00,
- &-0.65163E+00,-0.65180E+00,-0.65197E+00,-0.65214E+00,-0.65231E+00,
- &-0.65248E+00,-0.65265E+00,-0.65283E+00,-0.65300E+00,-0.65318E+00,
- &-0.65335E+00,-0.65353E+00,-0.65370E+00,-0.65388E+00,-0.65406E+00,
- &-0.65424E+00,-0.65442E+00,-0.65460E+00,-0.65478E+00,-0.65496E+00,
- &-0.65514E+00,-0.65532E+00,-0.65551E+00,-0.65569E+00,-0.65587E+00,
- &-0.65606E+00,-0.65624E+00,-0.65643E+00,-0.65662E+00,-0.65680E+00,
- &-0.65699E+00,-0.65718E+00,-0.65737E+00,-0.65756E+00,-0.65775E+00,
- &-0.65794E+00,-0.65813E+00,-0.65832E+00,-0.65852E+00,-0.65871E+00,
- &-0.65890E+00,-0.65910E+00,-0.65929E+00,-0.65949E+00,-0.65968E+00,
- &-0.65988E+00,-0.66008E+00,-0.66028E+00,-0.66047E+00,-0.66067E+00,
- &-0.66087E+00,-0.66107E+00,-0.66127E+00,-0.66147E+00,-0.66168E+00,
- &-0.66188E+00,-0.66208E+00,-0.66229E+00,-0.66249E+00,-0.66269E+00,
- &-0.66290E+00,-0.66311E+00,-0.66331E+00,-0.66352E+00,-0.66373E+00/
-
- DATA (BNC13M(I),I=501,600)/
- &-0.66394E+00,-0.66414E+00,-0.66435E+00,-0.66456E+00,-0.66477E+00,
- &-0.66499E+00,-0.66520E+00,-0.66541E+00,-0.66562E+00,-0.66583E+00,
- &-0.66605E+00,-0.66626E+00,-0.66648E+00,-0.66669E+00,-0.66691E+00,
- &-0.66713E+00,-0.66734E+00,-0.66756E+00,-0.66778E+00,-0.66800E+00,
- &-0.66822E+00,-0.66844E+00,-0.66866E+00,-0.66888E+00,-0.66910E+00,
- &-0.66932E+00,-0.66954E+00,-0.66977E+00,-0.66999E+00,-0.67021E+00,
- &-0.67044E+00,-0.67066E+00,-0.67089E+00,-0.67111E+00,-0.67134E+00,
- &-0.67157E+00,-0.67180E+00,-0.67202E+00,-0.67225E+00,-0.67248E+00,
- &-0.67271E+00,-0.67294E+00,-0.67317E+00,-0.67340E+00,-0.67364E+00,
- &-0.67387E+00,-0.67410E+00,-0.67434E+00,-0.67457E+00,-0.67480E+00,
- &-0.67504E+00,-0.67527E+00,-0.67551E+00,-0.67575E+00,-0.67598E+00,
- &-0.67622E+00,-0.67646E+00,-0.67670E+00,-0.67694E+00,-0.67718E+00,
- &-0.67742E+00,-0.67766E+00,-0.67790E+00,-0.67814E+00,-0.67838E+00,
- &-0.67862E+00,-0.67887E+00,-0.67911E+00,-0.67935E+00,-0.67960E+00,
- &-0.67984E+00,-0.68009E+00,-0.68033E+00,-0.68058E+00,-0.68083E+00,
- &-0.68107E+00,-0.68132E+00,-0.68157E+00,-0.68182E+00,-0.68207E+00,
- &-0.68232E+00,-0.68257E+00,-0.68282E+00,-0.68307E+00,-0.68332E+00,
- &-0.68357E+00,-0.68383E+00,-0.68408E+00,-0.68433E+00,-0.68459E+00,
- &-0.68484E+00,-0.68510E+00,-0.68535E+00,-0.68561E+00,-0.68586E+00,
- &-0.68612E+00,-0.68638E+00,-0.68664E+00,-0.68689E+00,-0.68715E+00/
-
- DATA (BNC13M(I),I=601,700)/
- &-0.68998E+00,-0.69264E+00,-0.69534E+00,-0.69809E+00,-0.70088E+00,
- &-0.70371E+00,-0.70659E+00,-0.70950E+00,-0.71245E+00,-0.71544E+00,
- &-0.71847E+00,-0.72154E+00,-0.72464E+00,-0.72778E+00,-0.73095E+00,
- &-0.73416E+00,-0.73741E+00,-0.74068E+00,-0.74399E+00,-0.74733E+00,
- &-0.75070E+00,-0.75411E+00,-0.75754E+00,-0.76101E+00,-0.76450E+00,
- &-0.76802E+00,-0.77157E+00,-0.77515E+00,-0.77876E+00,-0.78239E+00,
- &-0.78605E+00,-0.78974E+00,-0.79345E+00,-0.79719E+00,-0.80095E+00,
- &-0.80474E+00,-0.80855E+00,-0.81239E+00,-0.81625E+00,-0.82013E+00,
- &-0.82403E+00,-0.82796E+00,-0.83191E+00,-0.83588E+00,-0.83987E+00,
- &-0.84388E+00,-0.84792E+00,-0.85197E+00,-0.85604E+00,-0.86014E+00,
- &-0.86425E+00,-0.86838E+00,-0.87253E+00,-0.87670E+00,-0.88089E+00,
- &-0.88510E+00,-0.88932E+00,-0.89357E+00,-0.89782E+00,-0.90210E+00,
- &-0.90639E+00,-0.91070E+00,-0.91503E+00,-0.91937E+00,-0.92373E+00,
- &-0.92811E+00,-0.93250E+00,-0.93690E+00,-0.94132E+00,-0.94576E+00,
- &-0.95021E+00,-0.95467E+00,-0.95915E+00,-0.96364E+00,-0.96815E+00,
- &-0.97267E+00,-0.97721E+00,-0.98176E+00,-0.98632E+00,-0.99089E+00,
- &-0.99548E+00,-0.10001E+01,-0.10047E+01,-0.10093E+01,-0.10140E+01,
- &-0.10186E+01,-0.10233E+01,-0.10279E+01,-0.10326E+01,-0.10373E+01,
- &-0.10420E+01,-0.10468E+01,-0.10515E+01,-0.10562E+01,-0.10610E+01,
- &-0.10657E+01,-0.10705E+01,-0.10753E+01,-0.10801E+01,-0.10849E+01/
-
- DATA (BNC13M(I),I=701,741)/
- &-0.10897E+01,-0.10945E+01,-0.10994E+01,-0.11042E+01,-0.11091E+01,
- &-0.11139E+01,-0.11188E+01,-0.11237E+01,-0.11286E+01,-0.11335E+01,
- &-0.11384E+01,-0.11433E+01,-0.11483E+01,-0.11532E+01,-0.11582E+01,
- &-0.11631E+01,-0.11681E+01,-0.11730E+01,-0.11780E+01,-0.11830E+01,
- &-0.11880E+01,-0.11930E+01,-0.11980E+01,-0.12031E+01,-0.12081E+01,
- &-0.12131E+01,-0.12182E+01,-0.12232E+01,-0.12283E+01,-0.12333E+01,
- &-0.12384E+01,-0.12435E+01,-0.12486E+01,-0.12537E+01,-0.12588E+01,
- &-0.12639E+01,-0.12690E+01,-0.12741E+01,-0.12793E+01,-0.12844E+01,
- &-0.12896E+01
- & /
- END
-
diff --git a/src/MNH/data_kmcf248a.f b/src/MNH/data_kmcf248a.f
deleted file mode 100644
index b9d44fd9f2971d794a6ddcab11fd7e05168b71a6..0000000000000000000000000000000000000000
--- a/src/MNH/data_kmcf248a.f
+++ /dev/null
@@ -1,2218 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 data_kmcf248a.f 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-C=======================================================================
-C
-C *** ISORROPIA CODE
-C *** BLOCK DATA KMCF248A
-C *** CONTAINS THE DATA FOR KUSSIK-MEISNER BINARY COEFFICIENT ARRAYS
-C NEEDED IN SUBROUTINE KM
-C
-C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
-C *** WRITTEN BY ATHANASIOS NENES
-C
-C=======================================================================
-C
- BLOCK DATA KMCF248
-C
-C *** Common block definition
-C
- COMMON /KMC248/
- &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741),
- &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741),
- &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741),
- &BNC13M( 741)
-C
-C *** NaCl
-C
- DATA (BNC01M(I),I=1,100)/
- &-0.47484E-01,-0.98816E-01,-0.12198E+00,-0.13703E+00,-0.14791E+00,
- &-0.15621E+00,-0.16272E+00,-0.16794E+00,-0.17216E+00,-0.17559E+00,
- &-0.17838E+00,-0.18065E+00,-0.18247E+00,-0.18392E+00,-0.18504E+00,
- &-0.18588E+00,-0.18647E+00,-0.18685E+00,-0.18703E+00,-0.18705E+00,
- &-0.18691E+00,-0.18663E+00,-0.18623E+00,-0.18571E+00,-0.18510E+00,
- &-0.18440E+00,-0.18361E+00,-0.18275E+00,-0.18181E+00,-0.18082E+00,
- &-0.17977E+00,-0.17867E+00,-0.17752E+00,-0.17633E+00,-0.17510E+00,
- &-0.17383E+00,-0.17253E+00,-0.17121E+00,-0.16985E+00,-0.16848E+00,
- &-0.16708E+00,-0.16566E+00,-0.16423E+00,-0.16278E+00,-0.16131E+00,
- &-0.15984E+00,-0.15835E+00,-0.15685E+00,-0.15534E+00,-0.15383E+00,
- &-0.15230E+00,-0.15077E+00,-0.14924E+00,-0.14769E+00,-0.14614E+00,
- &-0.14459E+00,-0.14303E+00,-0.14147E+00,-0.13990E+00,-0.13832E+00,
- &-0.13674E+00,-0.13516E+00,-0.13357E+00,-0.13197E+00,-0.13037E+00,
- &-0.12876E+00,-0.12715E+00,-0.12553E+00,-0.12389E+00,-0.12226E+00,
- &-0.12061E+00,-0.11895E+00,-0.11728E+00,-0.11561E+00,-0.11392E+00,
- &-0.11222E+00,-0.11051E+00,-0.10878E+00,-0.10705E+00,-0.10530E+00,
- &-0.10354E+00,-0.10176E+00,-0.99968E-01,-0.98163E-01,-0.96343E-01,
- &-0.94509E-01,-0.92660E-01,-0.90795E-01,-0.88916E-01,-0.87022E-01,
- &-0.85112E-01,-0.83188E-01,-0.81249E-01,-0.79295E-01,-0.77327E-01,
- &-0.75345E-01,-0.73349E-01,-0.71339E-01,-0.69317E-01,-0.67281E-01/
-
- DATA (BNC01M(I),I=101,200)/
- &-0.65233E-01,-0.63173E-01,-0.61101E-01,-0.59019E-01,-0.56926E-01,
- &-0.54823E-01,-0.52710E-01,-0.50588E-01,-0.48457E-01,-0.46319E-01,
- &-0.44173E-01,-0.42019E-01,-0.39859E-01,-0.37694E-01,-0.35522E-01,
- &-0.33345E-01,-0.31164E-01,-0.28978E-01,-0.26789E-01,-0.24596E-01,
- &-0.22400E-01,-0.20201E-01,-0.18000E-01,-0.15797E-01,-0.13592E-01,
- &-0.11386E-01,-0.91787E-02,-0.69707E-02,-0.47622E-02,-0.25533E-02,
- &-0.34438E-03, 0.18645E-02, 0.40730E-02, 0.62810E-02, 0.84884E-02,
- & 0.10695E-01, 0.12900E-01, 0.15105E-01, 0.17308E-01, 0.19510E-01,
- & 0.21710E-01, 0.23909E-01, 0.26107E-01, 0.28302E-01, 0.30496E-01,
- & 0.32687E-01, 0.34877E-01, 0.37065E-01, 0.39251E-01, 0.41434E-01,
- & 0.43616E-01, 0.45795E-01, 0.47972E-01, 0.50147E-01, 0.52319E-01,
- & 0.54489E-01, 0.56656E-01, 0.58821E-01, 0.60983E-01, 0.63143E-01,
- & 0.65300E-01, 0.67455E-01, 0.69607E-01, 0.71757E-01, 0.73903E-01,
- & 0.76047E-01, 0.78189E-01, 0.80327E-01, 0.82463E-01, 0.84596E-01,
- & 0.86727E-01, 0.88854E-01, 0.90979E-01, 0.93101E-01, 0.95220E-01,
- & 0.97336E-01, 0.99449E-01, 0.10156E+00, 0.10367E+00, 0.10577E+00,
- & 0.10787E+00, 0.10997E+00, 0.11207E+00, 0.11416E+00, 0.11625E+00,
- & 0.11833E+00, 0.12042E+00, 0.12250E+00, 0.12458E+00, 0.12665E+00,
- & 0.12872E+00, 0.13079E+00, 0.13286E+00, 0.13492E+00, 0.13698E+00,
- & 0.13903E+00, 0.14108E+00, 0.14313E+00, 0.14518E+00, 0.14722E+00/
-
- DATA (BNC01M(I),I=201,300)/
- & 0.14926E+00, 0.15130E+00, 0.15334E+00, 0.15537E+00, 0.15739E+00,
- & 0.15942E+00, 0.16144E+00, 0.16346E+00, 0.16547E+00, 0.16748E+00,
- & 0.16949E+00, 0.17150E+00, 0.17350E+00, 0.17550E+00, 0.17749E+00,
- & 0.17949E+00, 0.18148E+00, 0.18346E+00, 0.18545E+00, 0.18743E+00,
- & 0.18940E+00, 0.19138E+00, 0.19335E+00, 0.19531E+00, 0.19728E+00,
- & 0.19924E+00, 0.20119E+00, 0.20315E+00, 0.20510E+00, 0.20705E+00,
- & 0.20899E+00, 0.21093E+00, 0.21287E+00, 0.21480E+00, 0.21674E+00,
- & 0.21866E+00, 0.22059E+00, 0.22251E+00, 0.22443E+00, 0.22635E+00,
- & 0.22826E+00, 0.23017E+00, 0.23207E+00, 0.23398E+00, 0.23588E+00,
- & 0.23777E+00, 0.23967E+00, 0.24156E+00, 0.24344E+00, 0.24533E+00,
- & 0.24721E+00, 0.24908E+00, 0.25096E+00, 0.25283E+00, 0.25470E+00,
- & 0.25656E+00, 0.25842E+00, 0.26028E+00, 0.26214E+00, 0.26399E+00,
- & 0.26584E+00, 0.26768E+00, 0.26953E+00, 0.27137E+00, 0.27320E+00,
- & 0.27504E+00, 0.27687E+00, 0.27869E+00, 0.28052E+00, 0.28234E+00,
- & 0.28415E+00, 0.28597E+00, 0.28778E+00, 0.28959E+00, 0.29139E+00,
- & 0.29320E+00, 0.29499E+00, 0.29679E+00, 0.29858E+00, 0.30037E+00,
- & 0.30216E+00, 0.30394E+00, 0.30572E+00, 0.30750E+00, 0.30928E+00,
- & 0.31105E+00, 0.31282E+00, 0.31458E+00, 0.31634E+00, 0.31810E+00,
- & 0.31986E+00, 0.32161E+00, 0.32336E+00, 0.32511E+00, 0.32686E+00,
- & 0.32860E+00, 0.33033E+00, 0.33207E+00, 0.33380E+00, 0.33553E+00/
-
- DATA (BNC01M(I),I=301,400)/
- & 0.33726E+00, 0.33898E+00, 0.34070E+00, 0.34242E+00, 0.34413E+00,
- & 0.34585E+00, 0.34755E+00, 0.34926E+00, 0.35096E+00, 0.35266E+00,
- & 0.35436E+00, 0.35605E+00, 0.35775E+00, 0.35943E+00, 0.36112E+00,
- & 0.36280E+00, 0.36448E+00, 0.36616E+00, 0.36783E+00, 0.36950E+00,
- & 0.37117E+00, 0.37284E+00, 0.37450E+00, 0.37616E+00, 0.37782E+00,
- & 0.37947E+00, 0.38112E+00, 0.38277E+00, 0.38442E+00, 0.38606E+00,
- & 0.38770E+00, 0.38934E+00, 0.39097E+00, 0.39260E+00, 0.39423E+00,
- & 0.39586E+00, 0.39748E+00, 0.39910E+00, 0.40072E+00, 0.40233E+00,
- & 0.40394E+00, 0.40555E+00, 0.40716E+00, 0.40876E+00, 0.41037E+00,
- & 0.41196E+00, 0.41356E+00, 0.41515E+00, 0.41674E+00, 0.41833E+00,
- & 0.41992E+00, 0.42150E+00, 0.42308E+00, 0.42466E+00, 0.42623E+00,
- & 0.42780E+00, 0.42937E+00, 0.43094E+00, 0.43250E+00, 0.43406E+00,
- & 0.43562E+00, 0.43718E+00, 0.43873E+00, 0.44028E+00, 0.44183E+00,
- & 0.44337E+00, 0.44492E+00, 0.44646E+00, 0.44799E+00, 0.44953E+00,
- & 0.45106E+00, 0.45259E+00, 0.45412E+00, 0.45564E+00, 0.45717E+00,
- & 0.45868E+00, 0.46020E+00, 0.46172E+00, 0.46323E+00, 0.46474E+00,
- & 0.46625E+00, 0.46775E+00, 0.46925E+00, 0.47075E+00, 0.47225E+00,
- & 0.47374E+00, 0.47523E+00, 0.47672E+00, 0.47821E+00, 0.47970E+00,
- & 0.48118E+00, 0.48266E+00, 0.48414E+00, 0.48561E+00, 0.48708E+00,
- & 0.48855E+00, 0.49002E+00, 0.49148E+00, 0.49295E+00, 0.49441E+00/
-
- DATA (BNC01M(I),I=401,500)/
- & 0.49587E+00, 0.49732E+00, 0.49877E+00, 0.50022E+00, 0.50167E+00,
- & 0.50312E+00, 0.50456E+00, 0.50600E+00, 0.50744E+00, 0.50888E+00,
- & 0.51031E+00, 0.51174E+00, 0.51317E+00, 0.51460E+00, 0.51602E+00,
- & 0.51745E+00, 0.51887E+00, 0.52028E+00, 0.52170E+00, 0.52311E+00,
- & 0.52452E+00, 0.52593E+00, 0.52734E+00, 0.52874E+00, 0.53014E+00,
- & 0.53154E+00, 0.53294E+00, 0.53433E+00, 0.53573E+00, 0.53712E+00,
- & 0.53851E+00, 0.53989E+00, 0.54127E+00, 0.54266E+00, 0.54403E+00,
- & 0.54541E+00, 0.54679E+00, 0.54816E+00, 0.54953E+00, 0.55090E+00,
- & 0.55226E+00, 0.55363E+00, 0.55499E+00, 0.55635E+00, 0.55770E+00,
- & 0.55906E+00, 0.56041E+00, 0.56176E+00, 0.56311E+00, 0.56446E+00,
- & 0.56580E+00, 0.56714E+00, 0.56848E+00, 0.56982E+00, 0.57115E+00,
- & 0.57249E+00, 0.57382E+00, 0.57515E+00, 0.57648E+00, 0.57780E+00,
- & 0.57912E+00, 0.58044E+00, 0.58176E+00, 0.58308E+00, 0.58439E+00,
- & 0.58571E+00, 0.58702E+00, 0.58832E+00, 0.58963E+00, 0.59093E+00,
- & 0.59224E+00, 0.59354E+00, 0.59483E+00, 0.59613E+00, 0.59742E+00,
- & 0.59872E+00, 0.60001E+00, 0.60129E+00, 0.60258E+00, 0.60386E+00,
- & 0.60514E+00, 0.60642E+00, 0.60770E+00, 0.60898E+00, 0.61025E+00,
- & 0.61152E+00, 0.61279E+00, 0.61406E+00, 0.61533E+00, 0.61659E+00,
- & 0.61785E+00, 0.61911E+00, 0.62037E+00, 0.62163E+00, 0.62288E+00,
- & 0.62413E+00, 0.62538E+00, 0.62663E+00, 0.62788E+00, 0.62912E+00/
-
- DATA (BNC01M(I),I=501,600)/
- & 0.63036E+00, 0.63160E+00, 0.63284E+00, 0.63408E+00, 0.63531E+00,
- & 0.63655E+00, 0.63778E+00, 0.63901E+00, 0.64023E+00, 0.64146E+00,
- & 0.64268E+00, 0.64390E+00, 0.64512E+00, 0.64634E+00, 0.64756E+00,
- & 0.64877E+00, 0.64998E+00, 0.65120E+00, 0.65240E+00, 0.65361E+00,
- & 0.65482E+00, 0.65602E+00, 0.65722E+00, 0.65842E+00, 0.65962E+00,
- & 0.66081E+00, 0.66201E+00, 0.66320E+00, 0.66439E+00, 0.66558E+00,
- & 0.66676E+00, 0.66795E+00, 0.66913E+00, 0.67031E+00, 0.67149E+00,
- & 0.67267E+00, 0.67385E+00, 0.67502E+00, 0.67619E+00, 0.67736E+00,
- & 0.67853E+00, 0.67970E+00, 0.68087E+00, 0.68203E+00, 0.68319E+00,
- & 0.68435E+00, 0.68551E+00, 0.68667E+00, 0.68782E+00, 0.68898E+00,
- & 0.69013E+00, 0.69128E+00, 0.69243E+00, 0.69357E+00, 0.69472E+00,
- & 0.69586E+00, 0.69700E+00, 0.69814E+00, 0.69928E+00, 0.70042E+00,
- & 0.70155E+00, 0.70268E+00, 0.70381E+00, 0.70494E+00, 0.70607E+00,
- & 0.70720E+00, 0.70832E+00, 0.70945E+00, 0.71057E+00, 0.71169E+00,
- & 0.71280E+00, 0.71392E+00, 0.71504E+00, 0.71615E+00, 0.71726E+00,
- & 0.71837E+00, 0.71948E+00, 0.72058E+00, 0.72169E+00, 0.72279E+00,
- & 0.72389E+00, 0.72499E+00, 0.72609E+00, 0.72719E+00, 0.72828E+00,
- & 0.72938E+00, 0.73047E+00, 0.73156E+00, 0.73265E+00, 0.73374E+00,
- & 0.73482E+00, 0.73591E+00, 0.73699E+00, 0.73807E+00, 0.73915E+00,
- & 0.74023E+00, 0.74130E+00, 0.74238E+00, 0.74345E+00, 0.74452E+00/
-
- DATA (BNC01M(I),I=601,700)/
- & 0.75600E+00, 0.76647E+00, 0.77680E+00, 0.78697E+00, 0.79701E+00,
- & 0.80690E+00, 0.81666E+00, 0.82629E+00, 0.83578E+00, 0.84515E+00,
- & 0.85439E+00, 0.86351E+00, 0.87250E+00, 0.88138E+00, 0.89014E+00,
- & 0.89879E+00, 0.90732E+00, 0.91574E+00, 0.92406E+00, 0.93227E+00,
- & 0.94038E+00, 0.94838E+00, 0.95628E+00, 0.96409E+00, 0.97180E+00,
- & 0.97941E+00, 0.98693E+00, 0.99435E+00, 0.10017E+01, 0.10089E+01,
- & 0.10161E+01, 0.10232E+01, 0.10302E+01, 0.10371E+01, 0.10439E+01,
- & 0.10506E+01, 0.10573E+01, 0.10639E+01, 0.10704E+01, 0.10768E+01,
- & 0.10832E+01, 0.10895E+01, 0.10957E+01, 0.11018E+01, 0.11079E+01,
- & 0.11139E+01, 0.11199E+01, 0.11257E+01, 0.11315E+01, 0.11373E+01,
- & 0.11430E+01, 0.11486E+01, 0.11541E+01, 0.11596E+01, 0.11651E+01,
- & 0.11704E+01, 0.11757E+01, 0.11810E+01, 0.11862E+01, 0.11913E+01,
- & 0.11964E+01, 0.12015E+01, 0.12064E+01, 0.12114E+01, 0.12162E+01,
- & 0.12211E+01, 0.12258E+01, 0.12306E+01, 0.12352E+01, 0.12399E+01,
- & 0.12444E+01, 0.12490E+01, 0.12534E+01, 0.12579E+01, 0.12623E+01,
- & 0.12666E+01, 0.12709E+01, 0.12751E+01, 0.12794E+01, 0.12835E+01,
- & 0.12876E+01, 0.12917E+01, 0.12958E+01, 0.12998E+01, 0.13037E+01,
- & 0.13076E+01, 0.13115E+01, 0.13153E+01, 0.13191E+01, 0.13229E+01,
- & 0.13266E+01, 0.13303E+01, 0.13340E+01, 0.13376E+01, 0.13411E+01,
- & 0.13447E+01, 0.13482E+01, 0.13517E+01, 0.13551E+01, 0.13585E+01/
-
- DATA (BNC01M(I),I=701,741)/
- & 0.13619E+01, 0.13652E+01, 0.13685E+01, 0.13718E+01, 0.13750E+01,
- & 0.13782E+01, 0.13814E+01, 0.13845E+01, 0.13876E+01, 0.13907E+01,
- & 0.13937E+01, 0.13967E+01, 0.13997E+01, 0.14027E+01, 0.14056E+01,
- & 0.14085E+01, 0.14114E+01, 0.14142E+01, 0.14170E+01, 0.14198E+01,
- & 0.14226E+01, 0.14253E+01, 0.14280E+01, 0.14307E+01, 0.14333E+01,
- & 0.14360E+01, 0.14386E+01, 0.14411E+01, 0.14437E+01, 0.14462E+01,
- & 0.14487E+01, 0.14512E+01, 0.14536E+01, 0.14561E+01, 0.14585E+01,
- & 0.14608E+01, 0.14632E+01, 0.14655E+01, 0.14678E+01, 0.14701E+01,
- & 0.14724E+01
- & /
-C
-C *** Na2SO4
-C
- DATA (BNC02M(I),I=1,100)/
- &-0.97981E-01,-0.21379E+00,-0.27204E+00,-0.31341E+00,-0.34603E+00,
- &-0.37314E+00,-0.39646E+00,-0.41696E+00,-0.43531E+00,-0.45193E+00,
- &-0.46714E+00,-0.48118E+00,-0.49423E+00,-0.50643E+00,-0.51788E+00,
- &-0.52870E+00,-0.53893E+00,-0.54866E+00,-0.55793E+00,-0.56679E+00,
- &-0.57528E+00,-0.58342E+00,-0.59125E+00,-0.59880E+00,-0.60608E+00,
- &-0.61312E+00,-0.61993E+00,-0.62653E+00,-0.63293E+00,-0.63915E+00,
- &-0.64519E+00,-0.65108E+00,-0.65681E+00,-0.66239E+00,-0.66784E+00,
- &-0.67316E+00,-0.67836E+00,-0.68344E+00,-0.68841E+00,-0.69328E+00,
- &-0.69804E+00,-0.70271E+00,-0.70729E+00,-0.71178E+00,-0.71618E+00,
- &-0.72051E+00,-0.72476E+00,-0.72893E+00,-0.73304E+00,-0.73707E+00,
- &-0.74104E+00,-0.74495E+00,-0.74880E+00,-0.75259E+00,-0.75632E+00,
- &-0.75999E+00,-0.76362E+00,-0.76719E+00,-0.77072E+00,-0.77420E+00,
- &-0.77763E+00,-0.78102E+00,-0.78436E+00,-0.78767E+00,-0.79094E+00,
- &-0.79416E+00,-0.79735E+00,-0.80051E+00,-0.80363E+00,-0.80671E+00,
- &-0.80977E+00,-0.81279E+00,-0.81578E+00,-0.81875E+00,-0.82168E+00,
- &-0.82459E+00,-0.82747E+00,-0.83032E+00,-0.83315E+00,-0.83596E+00,
- &-0.83874E+00,-0.84150E+00,-0.84423E+00,-0.84695E+00,-0.84964E+00,
- &-0.85232E+00,-0.85497E+00,-0.85760E+00,-0.86022E+00,-0.86282E+00,
- &-0.86540E+00,-0.86796E+00,-0.87051E+00,-0.87303E+00,-0.87555E+00,
- &-0.87804E+00,-0.88052E+00,-0.88299E+00,-0.88544E+00,-0.88788E+00/
-
- DATA (BNC02M(I),I=101,200)/
- &-0.89030E+00,-0.89271E+00,-0.89510E+00,-0.89748E+00,-0.89985E+00,
- &-0.90220E+00,-0.90454E+00,-0.90687E+00,-0.90918E+00,-0.91148E+00,
- &-0.91377E+00,-0.91605E+00,-0.91832E+00,-0.92057E+00,-0.92281E+00,
- &-0.92504E+00,-0.92726E+00,-0.92947E+00,-0.93167E+00,-0.93385E+00,
- &-0.93603E+00,-0.93819E+00,-0.94034E+00,-0.94249E+00,-0.94462E+00,
- &-0.94674E+00,-0.94886E+00,-0.95096E+00,-0.95305E+00,-0.95513E+00,
- &-0.95721E+00,-0.95927E+00,-0.96132E+00,-0.96337E+00,-0.96540E+00,
- &-0.96743E+00,-0.96945E+00,-0.97146E+00,-0.97346E+00,-0.97545E+00,
- &-0.97743E+00,-0.97941E+00,-0.98137E+00,-0.98333E+00,-0.98528E+00,
- &-0.98722E+00,-0.98915E+00,-0.99108E+00,-0.99300E+00,-0.99491E+00,
- &-0.99681E+00,-0.99871E+00,-0.10006E+01,-0.10025E+01,-0.10044E+01,
- &-0.10062E+01,-0.10081E+01,-0.10099E+01,-0.10118E+01,-0.10136E+01,
- &-0.10155E+01,-0.10173E+01,-0.10191E+01,-0.10209E+01,-0.10227E+01,
- &-0.10245E+01,-0.10263E+01,-0.10281E+01,-0.10299E+01,-0.10317E+01,
- &-0.10334E+01,-0.10352E+01,-0.10369E+01,-0.10387E+01,-0.10404E+01,
- &-0.10422E+01,-0.10439E+01,-0.10457E+01,-0.10474E+01,-0.10491E+01,
- &-0.10508E+01,-0.10525E+01,-0.10542E+01,-0.10559E+01,-0.10576E+01,
- &-0.10593E+01,-0.10610E+01,-0.10627E+01,-0.10643E+01,-0.10660E+01,
- &-0.10677E+01,-0.10693E+01,-0.10710E+01,-0.10726E+01,-0.10743E+01,
- &-0.10759E+01,-0.10775E+01,-0.10792E+01,-0.10808E+01,-0.10824E+01/
-
- DATA (BNC02M(I),I=201,300)/
- &-0.10840E+01,-0.10857E+01,-0.10873E+01,-0.10889E+01,-0.10905E+01,
- &-0.10921E+01,-0.10937E+01,-0.10952E+01,-0.10968E+01,-0.10984E+01,
- &-0.11000E+01,-0.11015E+01,-0.11031E+01,-0.11047E+01,-0.11062E+01,
- &-0.11078E+01,-0.11093E+01,-0.11109E+01,-0.11124E+01,-0.11140E+01,
- &-0.11155E+01,-0.11170E+01,-0.11186E+01,-0.11201E+01,-0.11216E+01,
- &-0.11231E+01,-0.11247E+01,-0.11262E+01,-0.11277E+01,-0.11292E+01,
- &-0.11307E+01,-0.11322E+01,-0.11337E+01,-0.11352E+01,-0.11366E+01,
- &-0.11381E+01,-0.11396E+01,-0.11411E+01,-0.11426E+01,-0.11440E+01,
- &-0.11455E+01,-0.11470E+01,-0.11484E+01,-0.11499E+01,-0.11514E+01,
- &-0.11528E+01,-0.11543E+01,-0.11557E+01,-0.11571E+01,-0.11586E+01,
- &-0.11600E+01,-0.11615E+01,-0.11629E+01,-0.11643E+01,-0.11658E+01,
- &-0.11672E+01,-0.11686E+01,-0.11700E+01,-0.11714E+01,-0.11728E+01,
- &-0.11743E+01,-0.11757E+01,-0.11771E+01,-0.11785E+01,-0.11799E+01,
- &-0.11813E+01,-0.11827E+01,-0.11841E+01,-0.11854E+01,-0.11868E+01,
- &-0.11882E+01,-0.11896E+01,-0.11910E+01,-0.11923E+01,-0.11937E+01,
- &-0.11951E+01,-0.11965E+01,-0.11978E+01,-0.11992E+01,-0.12006E+01,
- &-0.12019E+01,-0.12033E+01,-0.12046E+01,-0.12060E+01,-0.12073E+01,
- &-0.12087E+01,-0.12100E+01,-0.12114E+01,-0.12127E+01,-0.12140E+01,
- &-0.12154E+01,-0.12167E+01,-0.12181E+01,-0.12194E+01,-0.12207E+01,
- &-0.12220E+01,-0.12234E+01,-0.12247E+01,-0.12260E+01,-0.12273E+01/
-
- DATA (BNC02M(I),I=301,400)/
- &-0.12286E+01,-0.12299E+01,-0.12313E+01,-0.12326E+01,-0.12339E+01,
- &-0.12352E+01,-0.12365E+01,-0.12378E+01,-0.12391E+01,-0.12404E+01,
- &-0.12417E+01,-0.12430E+01,-0.12443E+01,-0.12455E+01,-0.12468E+01,
- &-0.12481E+01,-0.12494E+01,-0.12507E+01,-0.12520E+01,-0.12532E+01,
- &-0.12545E+01,-0.12558E+01,-0.12571E+01,-0.12583E+01,-0.12596E+01,
- &-0.12609E+01,-0.12621E+01,-0.12634E+01,-0.12647E+01,-0.12659E+01,
- &-0.12672E+01,-0.12684E+01,-0.12697E+01,-0.12709E+01,-0.12722E+01,
- &-0.12734E+01,-0.12747E+01,-0.12759E+01,-0.12772E+01,-0.12784E+01,
- &-0.12797E+01,-0.12809E+01,-0.12821E+01,-0.12834E+01,-0.12846E+01,
- &-0.12858E+01,-0.12871E+01,-0.12883E+01,-0.12895E+01,-0.12907E+01,
- &-0.12920E+01,-0.12932E+01,-0.12944E+01,-0.12956E+01,-0.12969E+01,
- &-0.12981E+01,-0.12993E+01,-0.13005E+01,-0.13017E+01,-0.13029E+01,
- &-0.13041E+01,-0.13053E+01,-0.13065E+01,-0.13078E+01,-0.13090E+01,
- &-0.13102E+01,-0.13114E+01,-0.13126E+01,-0.13138E+01,-0.13149E+01,
- &-0.13161E+01,-0.13173E+01,-0.13185E+01,-0.13197E+01,-0.13209E+01,
- &-0.13221E+01,-0.13233E+01,-0.13245E+01,-0.13256E+01,-0.13268E+01,
- &-0.13280E+01,-0.13292E+01,-0.13304E+01,-0.13315E+01,-0.13327E+01,
- &-0.13339E+01,-0.13351E+01,-0.13362E+01,-0.13374E+01,-0.13386E+01,
- &-0.13397E+01,-0.13409E+01,-0.13421E+01,-0.13432E+01,-0.13444E+01,
- &-0.13456E+01,-0.13467E+01,-0.13479E+01,-0.13490E+01,-0.13502E+01/
-
- DATA (BNC02M(I),I=401,500)/
- &-0.13513E+01,-0.13525E+01,-0.13537E+01,-0.13548E+01,-0.13560E+01,
- &-0.13571E+01,-0.13582E+01,-0.13594E+01,-0.13605E+01,-0.13617E+01,
- &-0.13628E+01,-0.13640E+01,-0.13651E+01,-0.13662E+01,-0.13674E+01,
- &-0.13685E+01,-0.13697E+01,-0.13708E+01,-0.13719E+01,-0.13731E+01,
- &-0.13742E+01,-0.13753E+01,-0.13764E+01,-0.13776E+01,-0.13787E+01,
- &-0.13798E+01,-0.13810E+01,-0.13821E+01,-0.13832E+01,-0.13843E+01,
- &-0.13854E+01,-0.13866E+01,-0.13877E+01,-0.13888E+01,-0.13899E+01,
- &-0.13910E+01,-0.13921E+01,-0.13932E+01,-0.13944E+01,-0.13955E+01,
- &-0.13966E+01,-0.13977E+01,-0.13988E+01,-0.13999E+01,-0.14010E+01,
- &-0.14021E+01,-0.14032E+01,-0.14043E+01,-0.14054E+01,-0.14065E+01,
- &-0.14076E+01,-0.14087E+01,-0.14098E+01,-0.14109E+01,-0.14120E+01,
- &-0.14131E+01,-0.14142E+01,-0.14153E+01,-0.14164E+01,-0.14175E+01,
- &-0.14186E+01,-0.14196E+01,-0.14207E+01,-0.14218E+01,-0.14229E+01,
- &-0.14240E+01,-0.14251E+01,-0.14261E+01,-0.14272E+01,-0.14283E+01,
- &-0.14294E+01,-0.14305E+01,-0.14315E+01,-0.14326E+01,-0.14337E+01,
- &-0.14348E+01,-0.14359E+01,-0.14369E+01,-0.14380E+01,-0.14391E+01,
- &-0.14401E+01,-0.14412E+01,-0.14423E+01,-0.14433E+01,-0.14444E+01,
- &-0.14455E+01,-0.14465E+01,-0.14476E+01,-0.14487E+01,-0.14497E+01,
- &-0.14508E+01,-0.14519E+01,-0.14529E+01,-0.14540E+01,-0.14550E+01,
- &-0.14561E+01,-0.14572E+01,-0.14582E+01,-0.14593E+01,-0.14603E+01/
-
- DATA (BNC02M(I),I=501,600)/
- &-0.14614E+01,-0.14624E+01,-0.14635E+01,-0.14645E+01,-0.14656E+01,
- &-0.14666E+01,-0.14677E+01,-0.14687E+01,-0.14698E+01,-0.14708E+01,
- &-0.14719E+01,-0.14729E+01,-0.14740E+01,-0.14750E+01,-0.14760E+01,
- &-0.14771E+01,-0.14781E+01,-0.14792E+01,-0.14802E+01,-0.14812E+01,
- &-0.14823E+01,-0.14833E+01,-0.14843E+01,-0.14854E+01,-0.14864E+01,
- &-0.14875E+01,-0.14885E+01,-0.14895E+01,-0.14905E+01,-0.14916E+01,
- &-0.14926E+01,-0.14936E+01,-0.14947E+01,-0.14957E+01,-0.14967E+01,
- &-0.14978E+01,-0.14988E+01,-0.14998E+01,-0.15008E+01,-0.15018E+01,
- &-0.15029E+01,-0.15039E+01,-0.15049E+01,-0.15059E+01,-0.15070E+01,
- &-0.15080E+01,-0.15090E+01,-0.15100E+01,-0.15110E+01,-0.15120E+01,
- &-0.15131E+01,-0.15141E+01,-0.15151E+01,-0.15161E+01,-0.15171E+01,
- &-0.15181E+01,-0.15191E+01,-0.15202E+01,-0.15212E+01,-0.15222E+01,
- &-0.15232E+01,-0.15242E+01,-0.15252E+01,-0.15262E+01,-0.15272E+01,
- &-0.15282E+01,-0.15292E+01,-0.15302E+01,-0.15312E+01,-0.15322E+01,
- &-0.15332E+01,-0.15342E+01,-0.15352E+01,-0.15362E+01,-0.15372E+01,
- &-0.15382E+01,-0.15392E+01,-0.15402E+01,-0.15412E+01,-0.15422E+01,
- &-0.15432E+01,-0.15442E+01,-0.15452E+01,-0.15462E+01,-0.15472E+01,
- &-0.15482E+01,-0.15492E+01,-0.15502E+01,-0.15512E+01,-0.15522E+01,
- &-0.15531E+01,-0.15541E+01,-0.15551E+01,-0.15561E+01,-0.15571E+01,
- &-0.15581E+01,-0.15591E+01,-0.15601E+01,-0.15610E+01,-0.15620E+01/
-
- DATA (BNC02M(I),I=601,700)/
- &-0.15726E+01,-0.15824E+01,-0.15921E+01,-0.16017E+01,-0.16113E+01,
- &-0.16208E+01,-0.16303E+01,-0.16397E+01,-0.16491E+01,-0.16584E+01,
- &-0.16677E+01,-0.16770E+01,-0.16862E+01,-0.16954E+01,-0.17045E+01,
- &-0.17136E+01,-0.17226E+01,-0.17316E+01,-0.17406E+01,-0.17495E+01,
- &-0.17584E+01,-0.17673E+01,-0.17761E+01,-0.17849E+01,-0.17937E+01,
- &-0.18024E+01,-0.18111E+01,-0.18198E+01,-0.18284E+01,-0.18370E+01,
- &-0.18456E+01,-0.18542E+01,-0.18627E+01,-0.18712E+01,-0.18797E+01,
- &-0.18881E+01,-0.18966E+01,-0.19050E+01,-0.19133E+01,-0.19217E+01,
- &-0.19300E+01,-0.19383E+01,-0.19466E+01,-0.19548E+01,-0.19631E+01,
- &-0.19713E+01,-0.19795E+01,-0.19876E+01,-0.19958E+01,-0.20039E+01,
- &-0.20120E+01,-0.20201E+01,-0.20282E+01,-0.20362E+01,-0.20443E+01,
- &-0.20523E+01,-0.20603E+01,-0.20682E+01,-0.20762E+01,-0.20841E+01,
- &-0.20921E+01,-0.21000E+01,-0.21079E+01,-0.21157E+01,-0.21236E+01,
- &-0.21314E+01,-0.21393E+01,-0.21471E+01,-0.21549E+01,-0.21626E+01,
- &-0.21704E+01,-0.21782E+01,-0.21859E+01,-0.21936E+01,-0.22013E+01,
- &-0.22090E+01,-0.22167E+01,-0.22244E+01,-0.22320E+01,-0.22396E+01,
- &-0.22473E+01,-0.22549E+01,-0.22625E+01,-0.22701E+01,-0.22776E+01,
- &-0.22852E+01,-0.22928E+01,-0.23003E+01,-0.23078E+01,-0.23153E+01,
- &-0.23228E+01,-0.23303E+01,-0.23378E+01,-0.23453E+01,-0.23527E+01,
- &-0.23602E+01,-0.23676E+01,-0.23750E+01,-0.23825E+01,-0.23899E+01/
-
- DATA (BNC02M(I),I=701,741)/
- &-0.23973E+01,-0.24046E+01,-0.24120E+01,-0.24194E+01,-0.24267E+01,
- &-0.24341E+01,-0.24414E+01,-0.24487E+01,-0.24560E+01,-0.24633E+01,
- &-0.24706E+01,-0.24779E+01,-0.24852E+01,-0.24925E+01,-0.24997E+01,
- &-0.25070E+01,-0.25142E+01,-0.25214E+01,-0.25287E+01,-0.25359E+01,
- &-0.25431E+01,-0.25503E+01,-0.25575E+01,-0.25647E+01,-0.25718E+01,
- &-0.25790E+01,-0.25862E+01,-0.25933E+01,-0.26004E+01,-0.26076E+01,
- &-0.26147E+01,-0.26218E+01,-0.26289E+01,-0.26360E+01,-0.26431E+01,
- &-0.26502E+01,-0.26573E+01,-0.26644E+01,-0.26714E+01,-0.26785E+01,
- &-0.26856E+01
- & /
-C
-C *** NaNO3
-C
- DATA (BNC03M(I),I=1,100)/
- &-0.49134E-01,-0.10768E+00,-0.13739E+00,-0.15864E+00,-0.17549E+00,
- &-0.18957E+00,-0.20174E+00,-0.21250E+00,-0.22216E+00,-0.23096E+00,
- &-0.23904E+00,-0.24653E+00,-0.25352E+00,-0.26008E+00,-0.26626E+00,
- &-0.27211E+00,-0.27767E+00,-0.28298E+00,-0.28804E+00,-0.29290E+00,
- &-0.29757E+00,-0.30206E+00,-0.30639E+00,-0.31057E+00,-0.31462E+00,
- &-0.31854E+00,-0.32234E+00,-0.32603E+00,-0.32962E+00,-0.33312E+00,
- &-0.33652E+00,-0.33984E+00,-0.34308E+00,-0.34624E+00,-0.34933E+00,
- &-0.35235E+00,-0.35530E+00,-0.35820E+00,-0.36103E+00,-0.36381E+00,
- &-0.36653E+00,-0.36921E+00,-0.37183E+00,-0.37441E+00,-0.37694E+00,
- &-0.37942E+00,-0.38187E+00,-0.38427E+00,-0.38664E+00,-0.38897E+00,
- &-0.39126E+00,-0.39352E+00,-0.39574E+00,-0.39793E+00,-0.40009E+00,
- &-0.40222E+00,-0.40432E+00,-0.40640E+00,-0.40844E+00,-0.41047E+00,
- &-0.41246E+00,-0.41443E+00,-0.41638E+00,-0.41831E+00,-0.42021E+00,
- &-0.42209E+00,-0.42396E+00,-0.42580E+00,-0.42763E+00,-0.42943E+00,
- &-0.43122E+00,-0.43300E+00,-0.43475E+00,-0.43649E+00,-0.43822E+00,
- &-0.43993E+00,-0.44163E+00,-0.44331E+00,-0.44498E+00,-0.44664E+00,
- &-0.44829E+00,-0.44992E+00,-0.45154E+00,-0.45315E+00,-0.45476E+00,
- &-0.45635E+00,-0.45793E+00,-0.45950E+00,-0.46106E+00,-0.46261E+00,
- &-0.46416E+00,-0.46569E+00,-0.46722E+00,-0.46874E+00,-0.47025E+00,
- &-0.47175E+00,-0.47324E+00,-0.47473E+00,-0.47621E+00,-0.47768E+00/
-
- DATA (BNC03M(I),I=101,200)/
- &-0.47915E+00,-0.48060E+00,-0.48205E+00,-0.48350E+00,-0.48493E+00,
- &-0.48636E+00,-0.48779E+00,-0.48920E+00,-0.49061E+00,-0.49202E+00,
- &-0.49342E+00,-0.49481E+00,-0.49619E+00,-0.49757E+00,-0.49894E+00,
- &-0.50031E+00,-0.50166E+00,-0.50302E+00,-0.50436E+00,-0.50571E+00,
- &-0.50704E+00,-0.50837E+00,-0.50969E+00,-0.51101E+00,-0.51232E+00,
- &-0.51363E+00,-0.51493E+00,-0.51622E+00,-0.51751E+00,-0.51879E+00,
- &-0.52007E+00,-0.52134E+00,-0.52261E+00,-0.52387E+00,-0.52513E+00,
- &-0.52638E+00,-0.52762E+00,-0.52886E+00,-0.53010E+00,-0.53133E+00,
- &-0.53255E+00,-0.53377E+00,-0.53499E+00,-0.53620E+00,-0.53740E+00,
- &-0.53860E+00,-0.53980E+00,-0.54099E+00,-0.54218E+00,-0.54336E+00,
- &-0.54454E+00,-0.54571E+00,-0.54688E+00,-0.54804E+00,-0.54920E+00,
- &-0.55036E+00,-0.55151E+00,-0.55266E+00,-0.55380E+00,-0.55494E+00,
- &-0.55608E+00,-0.55721E+00,-0.55833E+00,-0.55946E+00,-0.56058E+00,
- &-0.56169E+00,-0.56280E+00,-0.56391E+00,-0.56502E+00,-0.56612E+00,
- &-0.56721E+00,-0.56831E+00,-0.56940E+00,-0.57048E+00,-0.57157E+00,
- &-0.57265E+00,-0.57372E+00,-0.57479E+00,-0.57586E+00,-0.57693E+00,
- &-0.57799E+00,-0.57905E+00,-0.58011E+00,-0.58116E+00,-0.58221E+00,
- &-0.58325E+00,-0.58430E+00,-0.58534E+00,-0.58637E+00,-0.58741E+00,
- &-0.58844E+00,-0.58947E+00,-0.59049E+00,-0.59151E+00,-0.59253E+00,
- &-0.59355E+00,-0.59456E+00,-0.59557E+00,-0.59658E+00,-0.59758E+00/
-
- DATA (BNC03M(I),I=201,300)/
- &-0.59859E+00,-0.59959E+00,-0.60058E+00,-0.60158E+00,-0.60257E+00,
- &-0.60356E+00,-0.60454E+00,-0.60553E+00,-0.60651E+00,-0.60748E+00,
- &-0.60846E+00,-0.60943E+00,-0.61040E+00,-0.61137E+00,-0.61234E+00,
- &-0.61330E+00,-0.61426E+00,-0.61522E+00,-0.61617E+00,-0.61713E+00,
- &-0.61808E+00,-0.61903E+00,-0.61997E+00,-0.62092E+00,-0.62186E+00,
- &-0.62280E+00,-0.62374E+00,-0.62467E+00,-0.62561E+00,-0.62654E+00,
- &-0.62746E+00,-0.62839E+00,-0.62932E+00,-0.63024E+00,-0.63116E+00,
- &-0.63208E+00,-0.63299E+00,-0.63390E+00,-0.63482E+00,-0.63573E+00,
- &-0.63663E+00,-0.63754E+00,-0.63844E+00,-0.63934E+00,-0.64024E+00,
- &-0.64114E+00,-0.64204E+00,-0.64293E+00,-0.64382E+00,-0.64471E+00,
- &-0.64560E+00,-0.64649E+00,-0.64737E+00,-0.64825E+00,-0.64913E+00,
- &-0.65001E+00,-0.65089E+00,-0.65176E+00,-0.65264E+00,-0.65351E+00,
- &-0.65438E+00,-0.65524E+00,-0.65611E+00,-0.65697E+00,-0.65784E+00,
- &-0.65870E+00,-0.65956E+00,-0.66041E+00,-0.66127E+00,-0.66212E+00,
- &-0.66298E+00,-0.66383E+00,-0.66468E+00,-0.66552E+00,-0.66637E+00,
- &-0.66721E+00,-0.66806E+00,-0.66890E+00,-0.66974E+00,-0.67057E+00,
- &-0.67141E+00,-0.67224E+00,-0.67308E+00,-0.67391E+00,-0.67474E+00,
- &-0.67557E+00,-0.67639E+00,-0.67722E+00,-0.67804E+00,-0.67887E+00,
- &-0.67969E+00,-0.68051E+00,-0.68133E+00,-0.68214E+00,-0.68296E+00,
- &-0.68377E+00,-0.68458E+00,-0.68539E+00,-0.68620E+00,-0.68701E+00/
-
- DATA (BNC03M(I),I=301,400)/
- &-0.68782E+00,-0.68862E+00,-0.68943E+00,-0.69023E+00,-0.69103E+00,
- &-0.69183E+00,-0.69263E+00,-0.69343E+00,-0.69422E+00,-0.69502E+00,
- &-0.69581E+00,-0.69660E+00,-0.69739E+00,-0.69818E+00,-0.69897E+00,
- &-0.69976E+00,-0.70054E+00,-0.70132E+00,-0.70211E+00,-0.70289E+00,
- &-0.70367E+00,-0.70445E+00,-0.70523E+00,-0.70600E+00,-0.70678E+00,
- &-0.70755E+00,-0.70832E+00,-0.70910E+00,-0.70987E+00,-0.71064E+00,
- &-0.71140E+00,-0.71217E+00,-0.71294E+00,-0.71370E+00,-0.71446E+00,
- &-0.71523E+00,-0.71599E+00,-0.71675E+00,-0.71751E+00,-0.71826E+00,
- &-0.71902E+00,-0.71977E+00,-0.72053E+00,-0.72128E+00,-0.72203E+00,
- &-0.72279E+00,-0.72353E+00,-0.72428E+00,-0.72503E+00,-0.72578E+00,
- &-0.72652E+00,-0.72727E+00,-0.72801E+00,-0.72875E+00,-0.72949E+00,
- &-0.73023E+00,-0.73097E+00,-0.73171E+00,-0.73245E+00,-0.73318E+00,
- &-0.73392E+00,-0.73465E+00,-0.73539E+00,-0.73612E+00,-0.73685E+00,
- &-0.73758E+00,-0.73831E+00,-0.73904E+00,-0.73976E+00,-0.74049E+00,
- &-0.74121E+00,-0.74194E+00,-0.74266E+00,-0.74338E+00,-0.74410E+00,
- &-0.74482E+00,-0.74554E+00,-0.74626E+00,-0.74698E+00,-0.74769E+00,
- &-0.74841E+00,-0.74912E+00,-0.74984E+00,-0.75055E+00,-0.75126E+00,
- &-0.75197E+00,-0.75268E+00,-0.75339E+00,-0.75410E+00,-0.75481E+00,
- &-0.75551E+00,-0.75622E+00,-0.75692E+00,-0.75763E+00,-0.75833E+00,
- &-0.75903E+00,-0.75973E+00,-0.76043E+00,-0.76113E+00,-0.76183E+00/
-
- DATA (BNC03M(I),I=401,500)/
- &-0.76253E+00,-0.76322E+00,-0.76392E+00,-0.76461E+00,-0.76531E+00,
- &-0.76600E+00,-0.76669E+00,-0.76738E+00,-0.76808E+00,-0.76877E+00,
- &-0.76945E+00,-0.77014E+00,-0.77083E+00,-0.77152E+00,-0.77220E+00,
- &-0.77289E+00,-0.77357E+00,-0.77425E+00,-0.77494E+00,-0.77562E+00,
- &-0.77630E+00,-0.77698E+00,-0.77766E+00,-0.77834E+00,-0.77902E+00,
- &-0.77969E+00,-0.78037E+00,-0.78105E+00,-0.78172E+00,-0.78239E+00,
- &-0.78307E+00,-0.78374E+00,-0.78441E+00,-0.78508E+00,-0.78575E+00,
- &-0.78642E+00,-0.78709E+00,-0.78776E+00,-0.78843E+00,-0.78909E+00,
- &-0.78976E+00,-0.79042E+00,-0.79109E+00,-0.79175E+00,-0.79242E+00,
- &-0.79308E+00,-0.79374E+00,-0.79440E+00,-0.79506E+00,-0.79572E+00,
- &-0.79638E+00,-0.79704E+00,-0.79769E+00,-0.79835E+00,-0.79901E+00,
- &-0.79966E+00,-0.80032E+00,-0.80097E+00,-0.80162E+00,-0.80228E+00,
- &-0.80293E+00,-0.80358E+00,-0.80423E+00,-0.80488E+00,-0.80553E+00,
- &-0.80618E+00,-0.80682E+00,-0.80747E+00,-0.80812E+00,-0.80876E+00,
- &-0.80941E+00,-0.81005E+00,-0.81070E+00,-0.81134E+00,-0.81198E+00,
- &-0.81263E+00,-0.81327E+00,-0.81391E+00,-0.81455E+00,-0.81519E+00,
- &-0.81583E+00,-0.81646E+00,-0.81710E+00,-0.81774E+00,-0.81837E+00,
- &-0.81901E+00,-0.81965E+00,-0.82028E+00,-0.82091E+00,-0.82155E+00,
- &-0.82218E+00,-0.82281E+00,-0.82344E+00,-0.82407E+00,-0.82470E+00,
- &-0.82533E+00,-0.82596E+00,-0.82659E+00,-0.82722E+00,-0.82785E+00/
-
- DATA (BNC03M(I),I=501,600)/
- &-0.82847E+00,-0.82910E+00,-0.82973E+00,-0.83035E+00,-0.83097E+00,
- &-0.83160E+00,-0.83222E+00,-0.83284E+00,-0.83347E+00,-0.83409E+00,
- &-0.83471E+00,-0.83533E+00,-0.83595E+00,-0.83657E+00,-0.83719E+00,
- &-0.83781E+00,-0.83842E+00,-0.83904E+00,-0.83966E+00,-0.84027E+00,
- &-0.84089E+00,-0.84150E+00,-0.84212E+00,-0.84273E+00,-0.84334E+00,
- &-0.84396E+00,-0.84457E+00,-0.84518E+00,-0.84579E+00,-0.84640E+00,
- &-0.84701E+00,-0.84762E+00,-0.84823E+00,-0.84884E+00,-0.84945E+00,
- &-0.85005E+00,-0.85066E+00,-0.85127E+00,-0.85187E+00,-0.85248E+00,
- &-0.85308E+00,-0.85369E+00,-0.85429E+00,-0.85489E+00,-0.85550E+00,
- &-0.85610E+00,-0.85670E+00,-0.85730E+00,-0.85790E+00,-0.85850E+00,
- &-0.85910E+00,-0.85970E+00,-0.86030E+00,-0.86090E+00,-0.86150E+00,
- &-0.86210E+00,-0.86269E+00,-0.86329E+00,-0.86388E+00,-0.86448E+00,
- &-0.86507E+00,-0.86567E+00,-0.86626E+00,-0.86686E+00,-0.86745E+00,
- &-0.86804E+00,-0.86863E+00,-0.86923E+00,-0.86982E+00,-0.87041E+00,
- &-0.87100E+00,-0.87159E+00,-0.87218E+00,-0.87277E+00,-0.87335E+00,
- &-0.87394E+00,-0.87453E+00,-0.87512E+00,-0.87570E+00,-0.87629E+00,
- &-0.87687E+00,-0.87746E+00,-0.87804E+00,-0.87863E+00,-0.87921E+00,
- &-0.87980E+00,-0.88038E+00,-0.88096E+00,-0.88154E+00,-0.88212E+00,
- &-0.88271E+00,-0.88329E+00,-0.88387E+00,-0.88445E+00,-0.88503E+00,
- &-0.88560E+00,-0.88618E+00,-0.88676E+00,-0.88734E+00,-0.88792E+00/
-
- DATA (BNC03M(I),I=601,700)/
- &-0.89413E+00,-0.89983E+00,-0.90549E+00,-0.91112E+00,-0.91671E+00,
- &-0.92226E+00,-0.92777E+00,-0.93325E+00,-0.93869E+00,-0.94410E+00,
- &-0.94948E+00,-0.95483E+00,-0.96015E+00,-0.96543E+00,-0.97069E+00,
- &-0.97592E+00,-0.98112E+00,-0.98629E+00,-0.99143E+00,-0.99655E+00,
- &-0.10016E+01,-0.10067E+01,-0.10118E+01,-0.10168E+01,-0.10218E+01,
- &-0.10267E+01,-0.10317E+01,-0.10366E+01,-0.10415E+01,-0.10464E+01,
- &-0.10513E+01,-0.10561E+01,-0.10609E+01,-0.10658E+01,-0.10705E+01,
- &-0.10753E+01,-0.10801E+01,-0.10848E+01,-0.10895E+01,-0.10942E+01,
- &-0.10989E+01,-0.11035E+01,-0.11082E+01,-0.11128E+01,-0.11174E+01,
- &-0.11220E+01,-0.11266E+01,-0.11311E+01,-0.11357E+01,-0.11402E+01,
- &-0.11447E+01,-0.11493E+01,-0.11537E+01,-0.11582E+01,-0.11627E+01,
- &-0.11671E+01,-0.11716E+01,-0.11760E+01,-0.11804E+01,-0.11848E+01,
- &-0.11892E+01,-0.11936E+01,-0.11979E+01,-0.12023E+01,-0.12066E+01,
- &-0.12109E+01,-0.12153E+01,-0.12196E+01,-0.12239E+01,-0.12281E+01,
- &-0.12324E+01,-0.12367E+01,-0.12409E+01,-0.12452E+01,-0.12494E+01,
- &-0.12536E+01,-0.12578E+01,-0.12620E+01,-0.12662E+01,-0.12704E+01,
- &-0.12746E+01,-0.12787E+01,-0.12829E+01,-0.12870E+01,-0.12912E+01,
- &-0.12953E+01,-0.12994E+01,-0.13035E+01,-0.13076E+01,-0.13117E+01,
- &-0.13158E+01,-0.13199E+01,-0.13239E+01,-0.13280E+01,-0.13320E+01,
- &-0.13361E+01,-0.13401E+01,-0.13441E+01,-0.13482E+01,-0.13522E+01/
-
- DATA (BNC03M(I),I=701,741)/
- &-0.13562E+01,-0.13602E+01,-0.13642E+01,-0.13682E+01,-0.13721E+01,
- &-0.13761E+01,-0.13801E+01,-0.13840E+01,-0.13880E+01,-0.13919E+01,
- &-0.13959E+01,-0.13998E+01,-0.14037E+01,-0.14076E+01,-0.14115E+01,
- &-0.14154E+01,-0.14193E+01,-0.14232E+01,-0.14271E+01,-0.14310E+01,
- &-0.14349E+01,-0.14387E+01,-0.14426E+01,-0.14464E+01,-0.14503E+01,
- &-0.14541E+01,-0.14580E+01,-0.14618E+01,-0.14656E+01,-0.14695E+01,
- &-0.14733E+01,-0.14771E+01,-0.14809E+01,-0.14847E+01,-0.14885E+01,
- &-0.14923E+01,-0.14961E+01,-0.14998E+01,-0.15036E+01,-0.15074E+01,
- &-0.15112E+01
- & /
-C
-C *** (NH4)2SO4
-C
- DATA (BNC04M(I),I=1,100)/
- &-0.98067E-01,-0.21426E+00,-0.27286E+00,-0.31457E+00,-0.34750E+00,
- &-0.37493E+00,-0.39855E+00,-0.41935E+00,-0.43799E+00,-0.45490E+00,
- &-0.47039E+00,-0.48471E+00,-0.49804E+00,-0.51051E+00,-0.52223E+00,
- &-0.53331E+00,-0.54381E+00,-0.55380E+00,-0.56333E+00,-0.57244E+00,
- &-0.58118E+00,-0.58957E+00,-0.59765E+00,-0.60544E+00,-0.61296E+00,
- &-0.62024E+00,-0.62729E+00,-0.63412E+00,-0.64075E+00,-0.64720E+00,
- &-0.65347E+00,-0.65958E+00,-0.66553E+00,-0.67134E+00,-0.67700E+00,
- &-0.68254E+00,-0.68795E+00,-0.69324E+00,-0.69842E+00,-0.70349E+00,
- &-0.70846E+00,-0.71333E+00,-0.71811E+00,-0.72280E+00,-0.72740E+00,
- &-0.73192E+00,-0.73636E+00,-0.74072E+00,-0.74501E+00,-0.74923E+00,
- &-0.75339E+00,-0.75748E+00,-0.76150E+00,-0.76547E+00,-0.76938E+00,
- &-0.77323E+00,-0.77702E+00,-0.78077E+00,-0.78446E+00,-0.78811E+00,
- &-0.79171E+00,-0.79527E+00,-0.79878E+00,-0.80225E+00,-0.80567E+00,
- &-0.80906E+00,-0.81241E+00,-0.81573E+00,-0.81900E+00,-0.82225E+00,
- &-0.82546E+00,-0.82864E+00,-0.83179E+00,-0.83491E+00,-0.83799E+00,
- &-0.84106E+00,-0.84409E+00,-0.84710E+00,-0.85008E+00,-0.85304E+00,
- &-0.85597E+00,-0.85889E+00,-0.86178E+00,-0.86464E+00,-0.86749E+00,
- &-0.87032E+00,-0.87312E+00,-0.87591E+00,-0.87868E+00,-0.88143E+00,
- &-0.88416E+00,-0.88687E+00,-0.88957E+00,-0.89225E+00,-0.89492E+00,
- &-0.89757E+00,-0.90020E+00,-0.90282E+00,-0.90542E+00,-0.90801E+00/
-
- DATA (BNC04M(I),I=101,200)/
- &-0.91058E+00,-0.91314E+00,-0.91569E+00,-0.91822E+00,-0.92074E+00,
- &-0.92325E+00,-0.92574E+00,-0.92822E+00,-0.93068E+00,-0.93314E+00,
- &-0.93558E+00,-0.93801E+00,-0.94043E+00,-0.94283E+00,-0.94522E+00,
- &-0.94760E+00,-0.94997E+00,-0.95233E+00,-0.95468E+00,-0.95701E+00,
- &-0.95934E+00,-0.96165E+00,-0.96395E+00,-0.96624E+00,-0.96852E+00,
- &-0.97079E+00,-0.97305E+00,-0.97530E+00,-0.97754E+00,-0.97977E+00,
- &-0.98199E+00,-0.98419E+00,-0.98639E+00,-0.98858E+00,-0.99076E+00,
- &-0.99293E+00,-0.99509E+00,-0.99724E+00,-0.99938E+00,-0.10015E+01,
- &-0.10036E+01,-0.10058E+01,-0.10079E+01,-0.10100E+01,-0.10120E+01,
- &-0.10141E+01,-0.10162E+01,-0.10183E+01,-0.10203E+01,-0.10224E+01,
- &-0.10244E+01,-0.10264E+01,-0.10285E+01,-0.10305E+01,-0.10325E+01,
- &-0.10345E+01,-0.10365E+01,-0.10385E+01,-0.10405E+01,-0.10424E+01,
- &-0.10444E+01,-0.10463E+01,-0.10483E+01,-0.10502E+01,-0.10522E+01,
- &-0.10541E+01,-0.10560E+01,-0.10580E+01,-0.10599E+01,-0.10618E+01,
- &-0.10637E+01,-0.10656E+01,-0.10674E+01,-0.10693E+01,-0.10712E+01,
- &-0.10731E+01,-0.10749E+01,-0.10768E+01,-0.10786E+01,-0.10805E+01,
- &-0.10823E+01,-0.10841E+01,-0.10860E+01,-0.10878E+01,-0.10896E+01,
- &-0.10914E+01,-0.10932E+01,-0.10950E+01,-0.10968E+01,-0.10986E+01,
- &-0.11004E+01,-0.11022E+01,-0.11039E+01,-0.11057E+01,-0.11075E+01,
- &-0.11092E+01,-0.11110E+01,-0.11127E+01,-0.11145E+01,-0.11162E+01/
-
- DATA (BNC04M(I),I=201,300)/
- &-0.11180E+01,-0.11197E+01,-0.11214E+01,-0.11231E+01,-0.11248E+01,
- &-0.11266E+01,-0.11283E+01,-0.11300E+01,-0.11317E+01,-0.11334E+01,
- &-0.11350E+01,-0.11367E+01,-0.11384E+01,-0.11401E+01,-0.11418E+01,
- &-0.11434E+01,-0.11451E+01,-0.11468E+01,-0.11484E+01,-0.11501E+01,
- &-0.11517E+01,-0.11534E+01,-0.11550E+01,-0.11566E+01,-0.11583E+01,
- &-0.11599E+01,-0.11615E+01,-0.11631E+01,-0.11648E+01,-0.11664E+01,
- &-0.11680E+01,-0.11696E+01,-0.11712E+01,-0.11728E+01,-0.11744E+01,
- &-0.11760E+01,-0.11776E+01,-0.11791E+01,-0.11807E+01,-0.11823E+01,
- &-0.11839E+01,-0.11854E+01,-0.11870E+01,-0.11886E+01,-0.11901E+01,
- &-0.11917E+01,-0.11933E+01,-0.11948E+01,-0.11964E+01,-0.11979E+01,
- &-0.11994E+01,-0.12010E+01,-0.12025E+01,-0.12040E+01,-0.12056E+01,
- &-0.12071E+01,-0.12086E+01,-0.12101E+01,-0.12117E+01,-0.12132E+01,
- &-0.12147E+01,-0.12162E+01,-0.12177E+01,-0.12192E+01,-0.12207E+01,
- &-0.12222E+01,-0.12237E+01,-0.12252E+01,-0.12267E+01,-0.12281E+01,
- &-0.12296E+01,-0.12311E+01,-0.12326E+01,-0.12341E+01,-0.12355E+01,
- &-0.12370E+01,-0.12385E+01,-0.12399E+01,-0.12414E+01,-0.12428E+01,
- &-0.12443E+01,-0.12458E+01,-0.12472E+01,-0.12487E+01,-0.12501E+01,
- &-0.12515E+01,-0.12530E+01,-0.12544E+01,-0.12559E+01,-0.12573E+01,
- &-0.12587E+01,-0.12601E+01,-0.12616E+01,-0.12630E+01,-0.12644E+01,
- &-0.12658E+01,-0.12672E+01,-0.12687E+01,-0.12701E+01,-0.12715E+01/
-
- DATA (BNC04M(I),I=301,400)/
- &-0.12729E+01,-0.12743E+01,-0.12757E+01,-0.12771E+01,-0.12785E+01,
- &-0.12799E+01,-0.12813E+01,-0.12827E+01,-0.12841E+01,-0.12854E+01,
- &-0.12868E+01,-0.12882E+01,-0.12896E+01,-0.12910E+01,-0.12923E+01,
- &-0.12937E+01,-0.12951E+01,-0.12965E+01,-0.12978E+01,-0.12992E+01,
- &-0.13006E+01,-0.13019E+01,-0.13033E+01,-0.13046E+01,-0.13060E+01,
- &-0.13073E+01,-0.13087E+01,-0.13100E+01,-0.13114E+01,-0.13127E+01,
- &-0.13141E+01,-0.13154E+01,-0.13168E+01,-0.13181E+01,-0.13194E+01,
- &-0.13208E+01,-0.13221E+01,-0.13234E+01,-0.13248E+01,-0.13261E+01,
- &-0.13274E+01,-0.13287E+01,-0.13301E+01,-0.13314E+01,-0.13327E+01,
- &-0.13340E+01,-0.13353E+01,-0.13366E+01,-0.13379E+01,-0.13393E+01,
- &-0.13406E+01,-0.13419E+01,-0.13432E+01,-0.13445E+01,-0.13458E+01,
- &-0.13471E+01,-0.13484E+01,-0.13497E+01,-0.13510E+01,-0.13522E+01,
- &-0.13535E+01,-0.13548E+01,-0.13561E+01,-0.13574E+01,-0.13587E+01,
- &-0.13600E+01,-0.13612E+01,-0.13625E+01,-0.13638E+01,-0.13651E+01,
- &-0.13663E+01,-0.13676E+01,-0.13689E+01,-0.13701E+01,-0.13714E+01,
- &-0.13727E+01,-0.13739E+01,-0.13752E+01,-0.13765E+01,-0.13777E+01,
- &-0.13790E+01,-0.13802E+01,-0.13815E+01,-0.13828E+01,-0.13840E+01,
- &-0.13853E+01,-0.13865E+01,-0.13878E+01,-0.13890E+01,-0.13902E+01,
- &-0.13915E+01,-0.13927E+01,-0.13940E+01,-0.13952E+01,-0.13964E+01,
- &-0.13977E+01,-0.13989E+01,-0.14001E+01,-0.14014E+01,-0.14026E+01/
-
- DATA (BNC04M(I),I=401,500)/
- &-0.14038E+01,-0.14051E+01,-0.14063E+01,-0.14075E+01,-0.14087E+01,
- &-0.14100E+01,-0.14112E+01,-0.14124E+01,-0.14136E+01,-0.14148E+01,
- &-0.14161E+01,-0.14173E+01,-0.14185E+01,-0.14197E+01,-0.14209E+01,
- &-0.14221E+01,-0.14233E+01,-0.14245E+01,-0.14257E+01,-0.14269E+01,
- &-0.14281E+01,-0.14293E+01,-0.14305E+01,-0.14317E+01,-0.14329E+01,
- &-0.14341E+01,-0.14353E+01,-0.14365E+01,-0.14377E+01,-0.14389E+01,
- &-0.14401E+01,-0.14413E+01,-0.14425E+01,-0.14437E+01,-0.14448E+01,
- &-0.14460E+01,-0.14472E+01,-0.14484E+01,-0.14496E+01,-0.14508E+01,
- &-0.14519E+01,-0.14531E+01,-0.14543E+01,-0.14555E+01,-0.14566E+01,
- &-0.14578E+01,-0.14590E+01,-0.14602E+01,-0.14613E+01,-0.14625E+01,
- &-0.14637E+01,-0.14648E+01,-0.14660E+01,-0.14672E+01,-0.14683E+01,
- &-0.14695E+01,-0.14706E+01,-0.14718E+01,-0.14730E+01,-0.14741E+01,
- &-0.14753E+01,-0.14764E+01,-0.14776E+01,-0.14787E+01,-0.14799E+01,
- &-0.14810E+01,-0.14822E+01,-0.14833E+01,-0.14845E+01,-0.14856E+01,
- &-0.14868E+01,-0.14879E+01,-0.14891E+01,-0.14902E+01,-0.14913E+01,
- &-0.14925E+01,-0.14936E+01,-0.14948E+01,-0.14959E+01,-0.14970E+01,
- &-0.14982E+01,-0.14993E+01,-0.15004E+01,-0.15016E+01,-0.15027E+01,
- &-0.15038E+01,-0.15050E+01,-0.15061E+01,-0.15072E+01,-0.15083E+01,
- &-0.15095E+01,-0.15106E+01,-0.15117E+01,-0.15128E+01,-0.15140E+01,
- &-0.15151E+01,-0.15162E+01,-0.15173E+01,-0.15184E+01,-0.15196E+01/
-
- DATA (BNC04M(I),I=501,600)/
- &-0.15207E+01,-0.15218E+01,-0.15229E+01,-0.15240E+01,-0.15251E+01,
- &-0.15262E+01,-0.15273E+01,-0.15285E+01,-0.15296E+01,-0.15307E+01,
- &-0.15318E+01,-0.15329E+01,-0.15340E+01,-0.15351E+01,-0.15362E+01,
- &-0.15373E+01,-0.15384E+01,-0.15395E+01,-0.15406E+01,-0.15417E+01,
- &-0.15428E+01,-0.15439E+01,-0.15450E+01,-0.15461E+01,-0.15472E+01,
- &-0.15483E+01,-0.15494E+01,-0.15505E+01,-0.15516E+01,-0.15526E+01,
- &-0.15537E+01,-0.15548E+01,-0.15559E+01,-0.15570E+01,-0.15581E+01,
- &-0.15592E+01,-0.15603E+01,-0.15613E+01,-0.15624E+01,-0.15635E+01,
- &-0.15646E+01,-0.15657E+01,-0.15667E+01,-0.15678E+01,-0.15689E+01,
- &-0.15700E+01,-0.15711E+01,-0.15721E+01,-0.15732E+01,-0.15743E+01,
- &-0.15754E+01,-0.15764E+01,-0.15775E+01,-0.15786E+01,-0.15796E+01,
- &-0.15807E+01,-0.15818E+01,-0.15828E+01,-0.15839E+01,-0.15850E+01,
- &-0.15860E+01,-0.15871E+01,-0.15882E+01,-0.15892E+01,-0.15903E+01,
- &-0.15914E+01,-0.15924E+01,-0.15935E+01,-0.15945E+01,-0.15956E+01,
- &-0.15967E+01,-0.15977E+01,-0.15988E+01,-0.15998E+01,-0.16009E+01,
- &-0.16019E+01,-0.16030E+01,-0.16041E+01,-0.16051E+01,-0.16062E+01,
- &-0.16072E+01,-0.16083E+01,-0.16093E+01,-0.16104E+01,-0.16114E+01,
- &-0.16124E+01,-0.16135E+01,-0.16145E+01,-0.16156E+01,-0.16166E+01,
- &-0.16177E+01,-0.16187E+01,-0.16198E+01,-0.16208E+01,-0.16218E+01,
- &-0.16229E+01,-0.16239E+01,-0.16250E+01,-0.16260E+01,-0.16270E+01/
-
- DATA (BNC04M(I),I=601,700)/
- &-0.16382E+01,-0.16485E+01,-0.16587E+01,-0.16688E+01,-0.16789E+01,
- &-0.16890E+01,-0.16989E+01,-0.17088E+01,-0.17187E+01,-0.17285E+01,
- &-0.17383E+01,-0.17480E+01,-0.17576E+01,-0.17673E+01,-0.17768E+01,
- &-0.17863E+01,-0.17958E+01,-0.18053E+01,-0.18146E+01,-0.18240E+01,
- &-0.18333E+01,-0.18426E+01,-0.18518E+01,-0.18610E+01,-0.18702E+01,
- &-0.18793E+01,-0.18884E+01,-0.18974E+01,-0.19065E+01,-0.19154E+01,
- &-0.19244E+01,-0.19333E+01,-0.19422E+01,-0.19511E+01,-0.19599E+01,
- &-0.19687E+01,-0.19775E+01,-0.19862E+01,-0.19949E+01,-0.20036E+01,
- &-0.20123E+01,-0.20209E+01,-0.20295E+01,-0.20381E+01,-0.20466E+01,
- &-0.20552E+01,-0.20637E+01,-0.20722E+01,-0.20806E+01,-0.20890E+01,
- &-0.20975E+01,-0.21058E+01,-0.21142E+01,-0.21226E+01,-0.21309E+01,
- &-0.21392E+01,-0.21475E+01,-0.21557E+01,-0.21640E+01,-0.21722E+01,
- &-0.21804E+01,-0.21886E+01,-0.21968E+01,-0.22049E+01,-0.22130E+01,
- &-0.22211E+01,-0.22292E+01,-0.22373E+01,-0.22454E+01,-0.22534E+01,
- &-0.22614E+01,-0.22694E+01,-0.22774E+01,-0.22854E+01,-0.22933E+01,
- &-0.23013E+01,-0.23092E+01,-0.23171E+01,-0.23250E+01,-0.23329E+01,
- &-0.23408E+01,-0.23486E+01,-0.23564E+01,-0.23643E+01,-0.23721E+01,
- &-0.23799E+01,-0.23876E+01,-0.23954E+01,-0.24032E+01,-0.24109E+01,
- &-0.24186E+01,-0.24263E+01,-0.24340E+01,-0.24417E+01,-0.24494E+01,
- &-0.24570E+01,-0.24647E+01,-0.24723E+01,-0.24800E+01,-0.24876E+01/
-
- DATA (BNC04M(I),I=701,741)/
- &-0.24952E+01,-0.25028E+01,-0.25103E+01,-0.25179E+01,-0.25255E+01,
- &-0.25330E+01,-0.25405E+01,-0.25481E+01,-0.25556E+01,-0.25631E+01,
- &-0.25706E+01,-0.25780E+01,-0.25855E+01,-0.25930E+01,-0.26004E+01,
- &-0.26079E+01,-0.26153E+01,-0.26227E+01,-0.26301E+01,-0.26375E+01,
- &-0.26449E+01,-0.26523E+01,-0.26597E+01,-0.26670E+01,-0.26744E+01,
- &-0.26817E+01,-0.26891E+01,-0.26964E+01,-0.27037E+01,-0.27110E+01,
- &-0.27183E+01,-0.27256E+01,-0.27329E+01,-0.27401E+01,-0.27474E+01,
- &-0.27547E+01,-0.27619E+01,-0.27692E+01,-0.27764E+01,-0.27836E+01,
- &-0.27908E+01
- & /
-C
-C *** NH4NO3
-C
- DATA (BNC05M(I),I=1,100)/
- &-0.49707E-01,-0.11083E+00,-0.14292E+00,-0.16643E+00,-0.18546E+00,
- &-0.20168E+00,-0.21592E+00,-0.22872E+00,-0.24038E+00,-0.25114E+00,
- &-0.26116E+00,-0.27056E+00,-0.27943E+00,-0.28784E+00,-0.29586E+00,
- &-0.30352E+00,-0.31087E+00,-0.31794E+00,-0.32476E+00,-0.33134E+00,
- &-0.33772E+00,-0.34390E+00,-0.34990E+00,-0.35574E+00,-0.36142E+00,
- &-0.36695E+00,-0.37235E+00,-0.37763E+00,-0.38278E+00,-0.38782E+00,
- &-0.39275E+00,-0.39758E+00,-0.40232E+00,-0.40696E+00,-0.41151E+00,
- &-0.41597E+00,-0.42035E+00,-0.42466E+00,-0.42889E+00,-0.43305E+00,
- &-0.43713E+00,-0.44115E+00,-0.44511E+00,-0.44900E+00,-0.45283E+00,
- &-0.45660E+00,-0.46032E+00,-0.46398E+00,-0.46759E+00,-0.47114E+00,
- &-0.47465E+00,-0.47811E+00,-0.48152E+00,-0.48489E+00,-0.48821E+00,
- &-0.49150E+00,-0.49474E+00,-0.49794E+00,-0.50111E+00,-0.50424E+00,
- &-0.50733E+00,-0.51039E+00,-0.51342E+00,-0.51642E+00,-0.51939E+00,
- &-0.52233E+00,-0.52524E+00,-0.52812E+00,-0.53098E+00,-0.53382E+00,
- &-0.53663E+00,-0.53943E+00,-0.54220E+00,-0.54495E+00,-0.54768E+00,
- &-0.55039E+00,-0.55309E+00,-0.55577E+00,-0.55843E+00,-0.56108E+00,
- &-0.56371E+00,-0.56633E+00,-0.56894E+00,-0.57153E+00,-0.57412E+00,
- &-0.57669E+00,-0.57925E+00,-0.58180E+00,-0.58433E+00,-0.58686E+00,
- &-0.58938E+00,-0.59189E+00,-0.59439E+00,-0.59688E+00,-0.59936E+00,
- &-0.60184E+00,-0.60430E+00,-0.60676E+00,-0.60921E+00,-0.61165E+00/
-
- DATA (BNC05M(I),I=101,200)/
- &-0.61408E+00,-0.61651E+00,-0.61892E+00,-0.62133E+00,-0.62373E+00,
- &-0.62612E+00,-0.62851E+00,-0.63088E+00,-0.63325E+00,-0.63561E+00,
- &-0.63796E+00,-0.64030E+00,-0.64263E+00,-0.64496E+00,-0.64727E+00,
- &-0.64958E+00,-0.65188E+00,-0.65417E+00,-0.65645E+00,-0.65872E+00,
- &-0.66098E+00,-0.66324E+00,-0.66548E+00,-0.66772E+00,-0.66995E+00,
- &-0.67217E+00,-0.67438E+00,-0.67658E+00,-0.67877E+00,-0.68095E+00,
- &-0.68312E+00,-0.68529E+00,-0.68744E+00,-0.68959E+00,-0.69173E+00,
- &-0.69386E+00,-0.69598E+00,-0.69809E+00,-0.70019E+00,-0.70229E+00,
- &-0.70437E+00,-0.70645E+00,-0.70852E+00,-0.71058E+00,-0.71263E+00,
- &-0.71468E+00,-0.71671E+00,-0.71874E+00,-0.72076E+00,-0.72277E+00,
- &-0.72477E+00,-0.72677E+00,-0.72876E+00,-0.73074E+00,-0.73271E+00,
- &-0.73468E+00,-0.73664E+00,-0.73859E+00,-0.74053E+00,-0.74246E+00,
- &-0.74439E+00,-0.74631E+00,-0.74823E+00,-0.75013E+00,-0.75203E+00,
- &-0.75393E+00,-0.75581E+00,-0.75769E+00,-0.75956E+00,-0.76143E+00,
- &-0.76329E+00,-0.76514E+00,-0.76698E+00,-0.76882E+00,-0.77066E+00,
- &-0.77248E+00,-0.77430E+00,-0.77611E+00,-0.77792E+00,-0.77972E+00,
- &-0.78152E+00,-0.78331E+00,-0.78509E+00,-0.78686E+00,-0.78863E+00,
- &-0.79040E+00,-0.79216E+00,-0.79391E+00,-0.79566E+00,-0.79740E+00,
- &-0.79913E+00,-0.80086E+00,-0.80258E+00,-0.80430E+00,-0.80601E+00,
- &-0.80772E+00,-0.80942E+00,-0.81112E+00,-0.81281E+00,-0.81449E+00/
-
- DATA (BNC05M(I),I=201,300)/
- &-0.81617E+00,-0.81785E+00,-0.81952E+00,-0.82118E+00,-0.82284E+00,
- &-0.82449E+00,-0.82614E+00,-0.82779E+00,-0.82942E+00,-0.83106E+00,
- &-0.83269E+00,-0.83431E+00,-0.83593E+00,-0.83754E+00,-0.83915E+00,
- &-0.84075E+00,-0.84235E+00,-0.84395E+00,-0.84554E+00,-0.84712E+00,
- &-0.84870E+00,-0.85028E+00,-0.85185E+00,-0.85341E+00,-0.85498E+00,
- &-0.85653E+00,-0.85809E+00,-0.85963E+00,-0.86118E+00,-0.86272E+00,
- &-0.86425E+00,-0.86578E+00,-0.86731E+00,-0.86883E+00,-0.87035E+00,
- &-0.87186E+00,-0.87337E+00,-0.87488E+00,-0.87638E+00,-0.87788E+00,
- &-0.87937E+00,-0.88086E+00,-0.88234E+00,-0.88382E+00,-0.88530E+00,
- &-0.88677E+00,-0.88824E+00,-0.88970E+00,-0.89116E+00,-0.89262E+00,
- &-0.89407E+00,-0.89552E+00,-0.89697E+00,-0.89841E+00,-0.89985E+00,
- &-0.90128E+00,-0.90271E+00,-0.90414E+00,-0.90556E+00,-0.90698E+00,
- &-0.90839E+00,-0.90980E+00,-0.91121E+00,-0.91261E+00,-0.91402E+00,
- &-0.91541E+00,-0.91681E+00,-0.91820E+00,-0.91958E+00,-0.92096E+00,
- &-0.92234E+00,-0.92372E+00,-0.92509E+00,-0.92646E+00,-0.92783E+00,
- &-0.92919E+00,-0.93055E+00,-0.93190E+00,-0.93326E+00,-0.93461E+00,
- &-0.93595E+00,-0.93729E+00,-0.93863E+00,-0.93997E+00,-0.94130E+00,
- &-0.94263E+00,-0.94396E+00,-0.94528E+00,-0.94660E+00,-0.94792E+00,
- &-0.94923E+00,-0.95054E+00,-0.95185E+00,-0.95316E+00,-0.95446E+00,
- &-0.95576E+00,-0.95705E+00,-0.95834E+00,-0.95963E+00,-0.96092E+00/
-
- DATA (BNC05M(I),I=301,400)/
- &-0.96220E+00,-0.96348E+00,-0.96476E+00,-0.96604E+00,-0.96731E+00,
- &-0.96858E+00,-0.96984E+00,-0.97110E+00,-0.97237E+00,-0.97362E+00,
- &-0.97488E+00,-0.97613E+00,-0.97738E+00,-0.97862E+00,-0.97987E+00,
- &-0.98111E+00,-0.98235E+00,-0.98358E+00,-0.98481E+00,-0.98604E+00,
- &-0.98727E+00,-0.98850E+00,-0.98972E+00,-0.99094E+00,-0.99215E+00,
- &-0.99337E+00,-0.99458E+00,-0.99579E+00,-0.99699E+00,-0.99820E+00,
- &-0.99940E+00,-0.10006E+01,-0.10018E+01,-0.10030E+01,-0.10042E+01,
- &-0.10054E+01,-0.10066E+01,-0.10077E+01,-0.10089E+01,-0.10101E+01,
- &-0.10113E+01,-0.10124E+01,-0.10136E+01,-0.10148E+01,-0.10159E+01,
- &-0.10171E+01,-0.10183E+01,-0.10194E+01,-0.10206E+01,-0.10217E+01,
- &-0.10229E+01,-0.10240E+01,-0.10252E+01,-0.10263E+01,-0.10275E+01,
- &-0.10286E+01,-0.10298E+01,-0.10309E+01,-0.10320E+01,-0.10332E+01,
- &-0.10343E+01,-0.10354E+01,-0.10365E+01,-0.10377E+01,-0.10388E+01,
- &-0.10399E+01,-0.10410E+01,-0.10421E+01,-0.10433E+01,-0.10444E+01,
- &-0.10455E+01,-0.10466E+01,-0.10477E+01,-0.10488E+01,-0.10499E+01,
- &-0.10510E+01,-0.10521E+01,-0.10532E+01,-0.10543E+01,-0.10553E+01,
- &-0.10564E+01,-0.10575E+01,-0.10586E+01,-0.10597E+01,-0.10608E+01,
- &-0.10618E+01,-0.10629E+01,-0.10640E+01,-0.10650E+01,-0.10661E+01,
- &-0.10672E+01,-0.10682E+01,-0.10693E+01,-0.10704E+01,-0.10714E+01,
- &-0.10725E+01,-0.10735E+01,-0.10746E+01,-0.10756E+01,-0.10767E+01/
-
- DATA (BNC05M(I),I=401,500)/
- &-0.10777E+01,-0.10788E+01,-0.10798E+01,-0.10809E+01,-0.10819E+01,
- &-0.10830E+01,-0.10840E+01,-0.10850E+01,-0.10861E+01,-0.10871E+01,
- &-0.10881E+01,-0.10891E+01,-0.10902E+01,-0.10912E+01,-0.10922E+01,
- &-0.10932E+01,-0.10943E+01,-0.10953E+01,-0.10963E+01,-0.10973E+01,
- &-0.10983E+01,-0.10993E+01,-0.11003E+01,-0.11013E+01,-0.11023E+01,
- &-0.11033E+01,-0.11043E+01,-0.11053E+01,-0.11063E+01,-0.11073E+01,
- &-0.11083E+01,-0.11093E+01,-0.11103E+01,-0.11113E+01,-0.11123E+01,
- &-0.11133E+01,-0.11143E+01,-0.11152E+01,-0.11162E+01,-0.11172E+01,
- &-0.11182E+01,-0.11192E+01,-0.11201E+01,-0.11211E+01,-0.11221E+01,
- &-0.11230E+01,-0.11240E+01,-0.11250E+01,-0.11260E+01,-0.11269E+01,
- &-0.11279E+01,-0.11288E+01,-0.11298E+01,-0.11308E+01,-0.11317E+01,
- &-0.11327E+01,-0.11336E+01,-0.11346E+01,-0.11355E+01,-0.11365E+01,
- &-0.11374E+01,-0.11384E+01,-0.11393E+01,-0.11402E+01,-0.11412E+01,
- &-0.11421E+01,-0.11431E+01,-0.11440E+01,-0.11449E+01,-0.11459E+01,
- &-0.11468E+01,-0.11477E+01,-0.11487E+01,-0.11496E+01,-0.11505E+01,
- &-0.11514E+01,-0.11524E+01,-0.11533E+01,-0.11542E+01,-0.11551E+01,
- &-0.11560E+01,-0.11570E+01,-0.11579E+01,-0.11588E+01,-0.11597E+01,
- &-0.11606E+01,-0.11615E+01,-0.11624E+01,-0.11633E+01,-0.11643E+01,
- &-0.11652E+01,-0.11661E+01,-0.11670E+01,-0.11679E+01,-0.11688E+01,
- &-0.11697E+01,-0.11706E+01,-0.11715E+01,-0.11723E+01,-0.11732E+01/
-
- DATA (BNC05M(I),I=501,600)/
- &-0.11741E+01,-0.11750E+01,-0.11759E+01,-0.11768E+01,-0.11777E+01,
- &-0.11786E+01,-0.11795E+01,-0.11803E+01,-0.11812E+01,-0.11821E+01,
- &-0.11830E+01,-0.11839E+01,-0.11847E+01,-0.11856E+01,-0.11865E+01,
- &-0.11874E+01,-0.11882E+01,-0.11891E+01,-0.11900E+01,-0.11908E+01,
- &-0.11917E+01,-0.11926E+01,-0.11934E+01,-0.11943E+01,-0.11952E+01,
- &-0.11960E+01,-0.11969E+01,-0.11977E+01,-0.11986E+01,-0.11994E+01,
- &-0.12003E+01,-0.12011E+01,-0.12020E+01,-0.12029E+01,-0.12037E+01,
- &-0.12046E+01,-0.12054E+01,-0.12062E+01,-0.12071E+01,-0.12079E+01,
- &-0.12088E+01,-0.12096E+01,-0.12105E+01,-0.12113E+01,-0.12121E+01,
- &-0.12130E+01,-0.12138E+01,-0.12147E+01,-0.12155E+01,-0.12163E+01,
- &-0.12171E+01,-0.12180E+01,-0.12188E+01,-0.12196E+01,-0.12205E+01,
- &-0.12213E+01,-0.12221E+01,-0.12229E+01,-0.12238E+01,-0.12246E+01,
- &-0.12254E+01,-0.12262E+01,-0.12271E+01,-0.12279E+01,-0.12287E+01,
- &-0.12295E+01,-0.12303E+01,-0.12311E+01,-0.12319E+01,-0.12328E+01,
- &-0.12336E+01,-0.12344E+01,-0.12352E+01,-0.12360E+01,-0.12368E+01,
- &-0.12376E+01,-0.12384E+01,-0.12392E+01,-0.12400E+01,-0.12408E+01,
- &-0.12416E+01,-0.12424E+01,-0.12432E+01,-0.12440E+01,-0.12448E+01,
- &-0.12456E+01,-0.12464E+01,-0.12472E+01,-0.12480E+01,-0.12488E+01,
- &-0.12496E+01,-0.12504E+01,-0.12512E+01,-0.12519E+01,-0.12527E+01,
- &-0.12535E+01,-0.12543E+01,-0.12551E+01,-0.12559E+01,-0.12567E+01/
-
- DATA (BNC05M(I),I=601,700)/
- &-0.12650E+01,-0.12727E+01,-0.12803E+01,-0.12878E+01,-0.12952E+01,
- &-0.13026E+01,-0.13098E+01,-0.13170E+01,-0.13241E+01,-0.13312E+01,
- &-0.13381E+01,-0.13450E+01,-0.13519E+01,-0.13586E+01,-0.13654E+01,
- &-0.13720E+01,-0.13786E+01,-0.13851E+01,-0.13916E+01,-0.13980E+01,
- &-0.14044E+01,-0.14107E+01,-0.14169E+01,-0.14231E+01,-0.14293E+01,
- &-0.14354E+01,-0.14415E+01,-0.14475E+01,-0.14534E+01,-0.14594E+01,
- &-0.14652E+01,-0.14711E+01,-0.14769E+01,-0.14827E+01,-0.14884E+01,
- &-0.14941E+01,-0.14997E+01,-0.15053E+01,-0.15109E+01,-0.15164E+01,
- &-0.15219E+01,-0.15274E+01,-0.15328E+01,-0.15382E+01,-0.15436E+01,
- &-0.15490E+01,-0.15543E+01,-0.15595E+01,-0.15648E+01,-0.15700E+01,
- &-0.15752E+01,-0.15804E+01,-0.15855E+01,-0.15906E+01,-0.15957E+01,
- &-0.16008E+01,-0.16058E+01,-0.16108E+01,-0.16158E+01,-0.16208E+01,
- &-0.16257E+01,-0.16306E+01,-0.16355E+01,-0.16404E+01,-0.16452E+01,
- &-0.16500E+01,-0.16548E+01,-0.16596E+01,-0.16644E+01,-0.16691E+01,
- &-0.16739E+01,-0.16786E+01,-0.16832E+01,-0.16879E+01,-0.16926E+01,
- &-0.16972E+01,-0.17018E+01,-0.17064E+01,-0.17110E+01,-0.17155E+01,
- &-0.17201E+01,-0.17246E+01,-0.17291E+01,-0.17336E+01,-0.17381E+01,
- &-0.17425E+01,-0.17470E+01,-0.17514E+01,-0.17558E+01,-0.17602E+01,
- &-0.17646E+01,-0.17690E+01,-0.17733E+01,-0.17777E+01,-0.17820E+01,
- &-0.17863E+01,-0.17906E+01,-0.17949E+01,-0.17992E+01,-0.18035E+01/
-
- DATA (BNC05M(I),I=701,741)/
- &-0.18077E+01,-0.18119E+01,-0.18162E+01,-0.18204E+01,-0.18246E+01,
- &-0.18288E+01,-0.18330E+01,-0.18371E+01,-0.18413E+01,-0.18454E+01,
- &-0.18496E+01,-0.18537E+01,-0.18578E+01,-0.18619E+01,-0.18660E+01,
- &-0.18701E+01,-0.18742E+01,-0.18782E+01,-0.18823E+01,-0.18863E+01,
- &-0.18903E+01,-0.18944E+01,-0.18984E+01,-0.19024E+01,-0.19064E+01,
- &-0.19104E+01,-0.19144E+01,-0.19183E+01,-0.19223E+01,-0.19262E+01,
- &-0.19302E+01,-0.19341E+01,-0.19380E+01,-0.19419E+01,-0.19459E+01,
- &-0.19498E+01,-0.19537E+01,-0.19575E+01,-0.19614E+01,-0.19653E+01,
- &-0.19691E+01
- & /
-C
-C *** NH4Cl
-C
- DATA (BNC06M(I),I=1,100)/
- &-0.48310E-01,-0.10321E+00,-0.12958E+00,-0.14766E+00,-0.16145E+00,
- &-0.17257E+00,-0.18185E+00,-0.18977E+00,-0.19665E+00,-0.20270E+00,
- &-0.20809E+00,-0.21292E+00,-0.21728E+00,-0.22124E+00,-0.22486E+00,
- &-0.22818E+00,-0.23123E+00,-0.23405E+00,-0.23666E+00,-0.23908E+00,
- &-0.24134E+00,-0.24344E+00,-0.24541E+00,-0.24725E+00,-0.24898E+00,
- &-0.25060E+00,-0.25213E+00,-0.25357E+00,-0.25493E+00,-0.25621E+00,
- &-0.25742E+00,-0.25857E+00,-0.25966E+00,-0.26069E+00,-0.26167E+00,
- &-0.26261E+00,-0.26350E+00,-0.26434E+00,-0.26515E+00,-0.26592E+00,
- &-0.26666E+00,-0.26736E+00,-0.26804E+00,-0.26868E+00,-0.26930E+00,
- &-0.26990E+00,-0.27047E+00,-0.27101E+00,-0.27154E+00,-0.27205E+00,
- &-0.27253E+00,-0.27300E+00,-0.27345E+00,-0.27389E+00,-0.27431E+00,
- &-0.27471E+00,-0.27510E+00,-0.27547E+00,-0.27583E+00,-0.27618E+00,
- &-0.27651E+00,-0.27684E+00,-0.27714E+00,-0.27744E+00,-0.27772E+00,
- &-0.27800E+00,-0.27826E+00,-0.27851E+00,-0.27874E+00,-0.27897E+00,
- &-0.27918E+00,-0.27939E+00,-0.27958E+00,-0.27976E+00,-0.27993E+00,
- &-0.28008E+00,-0.28023E+00,-0.28037E+00,-0.28049E+00,-0.28060E+00,
- &-0.28070E+00,-0.28080E+00,-0.28088E+00,-0.28094E+00,-0.28100E+00,
- &-0.28105E+00,-0.28108E+00,-0.28111E+00,-0.28113E+00,-0.28113E+00,
- &-0.28112E+00,-0.28111E+00,-0.28108E+00,-0.28105E+00,-0.28100E+00,
- &-0.28095E+00,-0.28089E+00,-0.28081E+00,-0.28073E+00,-0.28064E+00/
-
- DATA (BNC06M(I),I=101,200)/
- &-0.28055E+00,-0.28044E+00,-0.28033E+00,-0.28021E+00,-0.28008E+00,
- &-0.27994E+00,-0.27980E+00,-0.27965E+00,-0.27950E+00,-0.27934E+00,
- &-0.27917E+00,-0.27900E+00,-0.27882E+00,-0.27864E+00,-0.27845E+00,
- &-0.27826E+00,-0.27806E+00,-0.27786E+00,-0.27766E+00,-0.27745E+00,
- &-0.27724E+00,-0.27702E+00,-0.27681E+00,-0.27658E+00,-0.27636E+00,
- &-0.27613E+00,-0.27590E+00,-0.27567E+00,-0.27544E+00,-0.27520E+00,
- &-0.27496E+00,-0.27472E+00,-0.27448E+00,-0.27423E+00,-0.27398E+00,
- &-0.27374E+00,-0.27349E+00,-0.27323E+00,-0.27298E+00,-0.27273E+00,
- &-0.27247E+00,-0.27222E+00,-0.27196E+00,-0.27170E+00,-0.27144E+00,
- &-0.27118E+00,-0.27092E+00,-0.27065E+00,-0.27039E+00,-0.27013E+00,
- &-0.26986E+00,-0.26959E+00,-0.26933E+00,-0.26906E+00,-0.26879E+00,
- &-0.26852E+00,-0.26825E+00,-0.26798E+00,-0.26771E+00,-0.26744E+00,
- &-0.26717E+00,-0.26690E+00,-0.26663E+00,-0.26635E+00,-0.26608E+00,
- &-0.26581E+00,-0.26553E+00,-0.26526E+00,-0.26499E+00,-0.26471E+00,
- &-0.26444E+00,-0.26416E+00,-0.26389E+00,-0.26361E+00,-0.26333E+00,
- &-0.26306E+00,-0.26278E+00,-0.26251E+00,-0.26223E+00,-0.26195E+00,
- &-0.26168E+00,-0.26140E+00,-0.26112E+00,-0.26085E+00,-0.26057E+00,
- &-0.26029E+00,-0.26002E+00,-0.25974E+00,-0.25946E+00,-0.25919E+00,
- &-0.25891E+00,-0.25863E+00,-0.25836E+00,-0.25808E+00,-0.25781E+00,
- &-0.25753E+00,-0.25725E+00,-0.25698E+00,-0.25670E+00,-0.25643E+00/
-
- DATA (BNC06M(I),I=201,300)/
- &-0.25615E+00,-0.25588E+00,-0.25560E+00,-0.25533E+00,-0.25505E+00,
- &-0.25478E+00,-0.25450E+00,-0.25423E+00,-0.25396E+00,-0.25368E+00,
- &-0.25341E+00,-0.25314E+00,-0.25287E+00,-0.25259E+00,-0.25232E+00,
- &-0.25205E+00,-0.25178E+00,-0.25151E+00,-0.25124E+00,-0.25097E+00,
- &-0.25070E+00,-0.25043E+00,-0.25016E+00,-0.24989E+00,-0.24962E+00,
- &-0.24935E+00,-0.24908E+00,-0.24882E+00,-0.24855E+00,-0.24828E+00,
- &-0.24802E+00,-0.24775E+00,-0.24749E+00,-0.24722E+00,-0.24696E+00,
- &-0.24669E+00,-0.24643E+00,-0.24616E+00,-0.24590E+00,-0.24564E+00,
- &-0.24538E+00,-0.24511E+00,-0.24485E+00,-0.24459E+00,-0.24433E+00,
- &-0.24407E+00,-0.24381E+00,-0.24355E+00,-0.24329E+00,-0.24304E+00,
- &-0.24278E+00,-0.24252E+00,-0.24226E+00,-0.24201E+00,-0.24175E+00,
- &-0.24150E+00,-0.24124E+00,-0.24099E+00,-0.24073E+00,-0.24048E+00,
- &-0.24023E+00,-0.23997E+00,-0.23972E+00,-0.23947E+00,-0.23922E+00,
- &-0.23897E+00,-0.23872E+00,-0.23847E+00,-0.23822E+00,-0.23797E+00,
- &-0.23772E+00,-0.23748E+00,-0.23723E+00,-0.23698E+00,-0.23674E+00,
- &-0.23649E+00,-0.23625E+00,-0.23600E+00,-0.23576E+00,-0.23552E+00,
- &-0.23527E+00,-0.23503E+00,-0.23479E+00,-0.23455E+00,-0.23431E+00,
- &-0.23407E+00,-0.23383E+00,-0.23359E+00,-0.23335E+00,-0.23311E+00,
- &-0.23288E+00,-0.23264E+00,-0.23240E+00,-0.23217E+00,-0.23193E+00,
- &-0.23170E+00,-0.23146E+00,-0.23123E+00,-0.23100E+00,-0.23076E+00/
-
- DATA (BNC06M(I),I=301,400)/
- &-0.23053E+00,-0.23030E+00,-0.23007E+00,-0.22984E+00,-0.22961E+00,
- &-0.22938E+00,-0.22915E+00,-0.22892E+00,-0.22869E+00,-0.22847E+00,
- &-0.22824E+00,-0.22802E+00,-0.22779E+00,-0.22757E+00,-0.22734E+00,
- &-0.22712E+00,-0.22689E+00,-0.22667E+00,-0.22645E+00,-0.22623E+00,
- &-0.22601E+00,-0.22579E+00,-0.22557E+00,-0.22535E+00,-0.22513E+00,
- &-0.22491E+00,-0.22469E+00,-0.22448E+00,-0.22426E+00,-0.22404E+00,
- &-0.22383E+00,-0.22361E+00,-0.22340E+00,-0.22318E+00,-0.22297E+00,
- &-0.22276E+00,-0.22255E+00,-0.22233E+00,-0.22212E+00,-0.22191E+00,
- &-0.22170E+00,-0.22149E+00,-0.22129E+00,-0.22108E+00,-0.22087E+00,
- &-0.22066E+00,-0.22046E+00,-0.22025E+00,-0.22004E+00,-0.21984E+00,
- &-0.21963E+00,-0.21943E+00,-0.21923E+00,-0.21902E+00,-0.21882E+00,
- &-0.21862E+00,-0.21842E+00,-0.21822E+00,-0.21802E+00,-0.21782E+00,
- &-0.21762E+00,-0.21742E+00,-0.21722E+00,-0.21703E+00,-0.21683E+00,
- &-0.21663E+00,-0.21644E+00,-0.21624E+00,-0.21605E+00,-0.21585E+00,
- &-0.21566E+00,-0.21547E+00,-0.21527E+00,-0.21508E+00,-0.21489E+00,
- &-0.21470E+00,-0.21451E+00,-0.21432E+00,-0.21413E+00,-0.21394E+00,
- &-0.21375E+00,-0.21357E+00,-0.21338E+00,-0.21319E+00,-0.21301E+00,
- &-0.21282E+00,-0.21264E+00,-0.21245E+00,-0.21227E+00,-0.21208E+00,
- &-0.21190E+00,-0.21172E+00,-0.21154E+00,-0.21136E+00,-0.21118E+00,
- &-0.21100E+00,-0.21082E+00,-0.21064E+00,-0.21046E+00,-0.21028E+00/
-
- DATA (BNC06M(I),I=401,500)/
- &-0.21010E+00,-0.20992E+00,-0.20975E+00,-0.20957E+00,-0.20940E+00,
- &-0.20922E+00,-0.20905E+00,-0.20887E+00,-0.20870E+00,-0.20853E+00,
- &-0.20835E+00,-0.20818E+00,-0.20801E+00,-0.20784E+00,-0.20767E+00,
- &-0.20750E+00,-0.20733E+00,-0.20716E+00,-0.20699E+00,-0.20683E+00,
- &-0.20666E+00,-0.20649E+00,-0.20632E+00,-0.20616E+00,-0.20599E+00,
- &-0.20583E+00,-0.20566E+00,-0.20550E+00,-0.20534E+00,-0.20517E+00,
- &-0.20501E+00,-0.20485E+00,-0.20469E+00,-0.20453E+00,-0.20437E+00,
- &-0.20421E+00,-0.20405E+00,-0.20389E+00,-0.20373E+00,-0.20357E+00,
- &-0.20342E+00,-0.20326E+00,-0.20310E+00,-0.20295E+00,-0.20279E+00,
- &-0.20264E+00,-0.20248E+00,-0.20233E+00,-0.20218E+00,-0.20202E+00,
- &-0.20187E+00,-0.20172E+00,-0.20157E+00,-0.20142E+00,-0.20127E+00,
- &-0.20112E+00,-0.20097E+00,-0.20082E+00,-0.20067E+00,-0.20052E+00,
- &-0.20037E+00,-0.20022E+00,-0.20008E+00,-0.19993E+00,-0.19979E+00,
- &-0.19964E+00,-0.19950E+00,-0.19935E+00,-0.19921E+00,-0.19906E+00,
- &-0.19892E+00,-0.19878E+00,-0.19864E+00,-0.19850E+00,-0.19835E+00,
- &-0.19821E+00,-0.19807E+00,-0.19793E+00,-0.19780E+00,-0.19766E+00,
- &-0.19752E+00,-0.19738E+00,-0.19724E+00,-0.19711E+00,-0.19697E+00,
- &-0.19683E+00,-0.19670E+00,-0.19656E+00,-0.19643E+00,-0.19629E+00,
- &-0.19616E+00,-0.19603E+00,-0.19589E+00,-0.19576E+00,-0.19563E+00,
- &-0.19550E+00,-0.19537E+00,-0.19524E+00,-0.19511E+00,-0.19498E+00/
-
- DATA (BNC06M(I),I=501,600)/
- &-0.19485E+00,-0.19472E+00,-0.19459E+00,-0.19446E+00,-0.19434E+00,
- &-0.19421E+00,-0.19408E+00,-0.19396E+00,-0.19383E+00,-0.19371E+00,
- &-0.19358E+00,-0.19346E+00,-0.19333E+00,-0.19321E+00,-0.19309E+00,
- &-0.19296E+00,-0.19284E+00,-0.19272E+00,-0.19260E+00,-0.19248E+00,
- &-0.19236E+00,-0.19224E+00,-0.19212E+00,-0.19200E+00,-0.19188E+00,
- &-0.19176E+00,-0.19164E+00,-0.19153E+00,-0.19141E+00,-0.19129E+00,
- &-0.19118E+00,-0.19106E+00,-0.19094E+00,-0.19083E+00,-0.19071E+00,
- &-0.19060E+00,-0.19049E+00,-0.19037E+00,-0.19026E+00,-0.19015E+00,
- &-0.19004E+00,-0.18992E+00,-0.18981E+00,-0.18970E+00,-0.18959E+00,
- &-0.18948E+00,-0.18937E+00,-0.18926E+00,-0.18916E+00,-0.18905E+00,
- &-0.18894E+00,-0.18883E+00,-0.18872E+00,-0.18862E+00,-0.18851E+00,
- &-0.18841E+00,-0.18830E+00,-0.18819E+00,-0.18809E+00,-0.18799E+00,
- &-0.18788E+00,-0.18778E+00,-0.18768E+00,-0.18757E+00,-0.18747E+00,
- &-0.18737E+00,-0.18727E+00,-0.18717E+00,-0.18707E+00,-0.18697E+00,
- &-0.18687E+00,-0.18677E+00,-0.18667E+00,-0.18657E+00,-0.18647E+00,
- &-0.18637E+00,-0.18627E+00,-0.18618E+00,-0.18608E+00,-0.18598E+00,
- &-0.18589E+00,-0.18579E+00,-0.18570E+00,-0.18560E+00,-0.18551E+00,
- &-0.18541E+00,-0.18532E+00,-0.18523E+00,-0.18513E+00,-0.18504E+00,
- &-0.18495E+00,-0.18486E+00,-0.18477E+00,-0.18468E+00,-0.18458E+00,
- &-0.18449E+00,-0.18440E+00,-0.18431E+00,-0.18423E+00,-0.18414E+00/
-
- DATA (BNC06M(I),I=601,700)/
- &-0.18320E+00,-0.18237E+00,-0.18158E+00,-0.18083E+00,-0.18010E+00,
- &-0.17942E+00,-0.17876E+00,-0.17814E+00,-0.17755E+00,-0.17700E+00,
- &-0.17647E+00,-0.17597E+00,-0.17551E+00,-0.17507E+00,-0.17467E+00,
- &-0.17429E+00,-0.17394E+00,-0.17362E+00,-0.17333E+00,-0.17306E+00,
- &-0.17282E+00,-0.17260E+00,-0.17241E+00,-0.17225E+00,-0.17211E+00,
- &-0.17200E+00,-0.17190E+00,-0.17184E+00,-0.17179E+00,-0.17177E+00,
- &-0.17177E+00,-0.17180E+00,-0.17184E+00,-0.17191E+00,-0.17200E+00,
- &-0.17210E+00,-0.17223E+00,-0.17238E+00,-0.17255E+00,-0.17274E+00,
- &-0.17295E+00,-0.17318E+00,-0.17342E+00,-0.17369E+00,-0.17397E+00,
- &-0.17427E+00,-0.17459E+00,-0.17493E+00,-0.17528E+00,-0.17565E+00,
- &-0.17604E+00,-0.17644E+00,-0.17687E+00,-0.17730E+00,-0.17775E+00,
- &-0.17822E+00,-0.17871E+00,-0.17921E+00,-0.17972E+00,-0.18025E+00,
- &-0.18079E+00,-0.18135E+00,-0.18193E+00,-0.18251E+00,-0.18311E+00,
- &-0.18373E+00,-0.18436E+00,-0.18500E+00,-0.18565E+00,-0.18632E+00,
- &-0.18700E+00,-0.18770E+00,-0.18840E+00,-0.18912E+00,-0.18985E+00,
- &-0.19060E+00,-0.19135E+00,-0.19212E+00,-0.19290E+00,-0.19369E+00,
- &-0.19450E+00,-0.19531E+00,-0.19614E+00,-0.19697E+00,-0.19782E+00,
- &-0.19868E+00,-0.19955E+00,-0.20043E+00,-0.20132E+00,-0.20222E+00,
- &-0.20313E+00,-0.20405E+00,-0.20498E+00,-0.20592E+00,-0.20687E+00,
- &-0.20783E+00,-0.20880E+00,-0.20978E+00,-0.21077E+00,-0.21177E+00/
-
- DATA (BNC06M(I),I=701,741)/
- &-0.21278E+00,-0.21379E+00,-0.21482E+00,-0.21585E+00,-0.21690E+00,
- &-0.21795E+00,-0.21901E+00,-0.22008E+00,-0.22116E+00,-0.22224E+00,
- &-0.22334E+00,-0.22444E+00,-0.22555E+00,-0.22667E+00,-0.22780E+00,
- &-0.22893E+00,-0.23007E+00,-0.23122E+00,-0.23238E+00,-0.23355E+00,
- &-0.23472E+00,-0.23590E+00,-0.23709E+00,-0.23828E+00,-0.23949E+00,
- &-0.24070E+00,-0.24191E+00,-0.24314E+00,-0.24437E+00,-0.24561E+00,
- &-0.24685E+00,-0.24810E+00,-0.24936E+00,-0.25062E+00,-0.25189E+00,
- &-0.25317E+00,-0.25446E+00,-0.25575E+00,-0.25704E+00,-0.25835E+00,
- &-0.25966E+00
- & /
-C
-C *** (2H,SO4)
-C
- DATA (BNC07M(I),I=1,100)/
- &-0.97854E-01,-0.21310E+00,-0.27082E+00,-0.31170E+00,-0.34384E+00,
- &-0.37049E+00,-0.39335E+00,-0.41342E+00,-0.43132E+00,-0.44752E+00,
- &-0.46231E+00,-0.47593E+00,-0.48857E+00,-0.50036E+00,-0.51142E+00,
- &-0.52184E+00,-0.53169E+00,-0.54103E+00,-0.54992E+00,-0.55840E+00,
- &-0.56651E+00,-0.57428E+00,-0.58175E+00,-0.58893E+00,-0.59585E+00,
- &-0.60254E+00,-0.60899E+00,-0.61525E+00,-0.62130E+00,-0.62718E+00,
- &-0.63289E+00,-0.63844E+00,-0.64384E+00,-0.64910E+00,-0.65422E+00,
- &-0.65922E+00,-0.66410E+00,-0.66887E+00,-0.67353E+00,-0.67809E+00,
- &-0.68255E+00,-0.68692E+00,-0.69120E+00,-0.69539E+00,-0.69951E+00,
- &-0.70355E+00,-0.70751E+00,-0.71141E+00,-0.71523E+00,-0.71899E+00,
- &-0.72269E+00,-0.72632E+00,-0.72990E+00,-0.73342E+00,-0.73689E+00,
- &-0.74031E+00,-0.74367E+00,-0.74699E+00,-0.75026E+00,-0.75349E+00,
- &-0.75667E+00,-0.75981E+00,-0.76291E+00,-0.76597E+00,-0.76900E+00,
- &-0.77198E+00,-0.77493E+00,-0.77785E+00,-0.78073E+00,-0.78358E+00,
- &-0.78640E+00,-0.78919E+00,-0.79195E+00,-0.79468E+00,-0.79738E+00,
- &-0.80006E+00,-0.80271E+00,-0.80533E+00,-0.80793E+00,-0.81051E+00,
- &-0.81306E+00,-0.81559E+00,-0.81810E+00,-0.82058E+00,-0.82305E+00,
- &-0.82550E+00,-0.82792E+00,-0.83033E+00,-0.83271E+00,-0.83508E+00,
- &-0.83744E+00,-0.83977E+00,-0.84209E+00,-0.84439E+00,-0.84667E+00,
- &-0.84894E+00,-0.85119E+00,-0.85343E+00,-0.85565E+00,-0.85785E+00/
-
- DATA (BNC07M(I),I=101,200)/
- &-0.86005E+00,-0.86222E+00,-0.86439E+00,-0.86654E+00,-0.86868E+00,
- &-0.87080E+00,-0.87291E+00,-0.87501E+00,-0.87710E+00,-0.87917E+00,
- &-0.88123E+00,-0.88328E+00,-0.88532E+00,-0.88735E+00,-0.88936E+00,
- &-0.89137E+00,-0.89336E+00,-0.89534E+00,-0.89731E+00,-0.89927E+00,
- &-0.90122E+00,-0.90316E+00,-0.90509E+00,-0.90701E+00,-0.90892E+00,
- &-0.91082E+00,-0.91271E+00,-0.91460E+00,-0.91647E+00,-0.91833E+00,
- &-0.92019E+00,-0.92203E+00,-0.92387E+00,-0.92569E+00,-0.92751E+00,
- &-0.92932E+00,-0.93113E+00,-0.93292E+00,-0.93471E+00,-0.93648E+00,
- &-0.93825E+00,-0.94002E+00,-0.94177E+00,-0.94352E+00,-0.94526E+00,
- &-0.94699E+00,-0.94872E+00,-0.95043E+00,-0.95214E+00,-0.95385E+00,
- &-0.95554E+00,-0.95723E+00,-0.95892E+00,-0.96060E+00,-0.96227E+00,
- &-0.96393E+00,-0.96559E+00,-0.96724E+00,-0.96888E+00,-0.97052E+00,
- &-0.97215E+00,-0.97378E+00,-0.97540E+00,-0.97701E+00,-0.97862E+00,
- &-0.98023E+00,-0.98182E+00,-0.98342E+00,-0.98500E+00,-0.98658E+00,
- &-0.98816E+00,-0.98973E+00,-0.99129E+00,-0.99285E+00,-0.99441E+00,
- &-0.99596E+00,-0.99750E+00,-0.99904E+00,-0.10006E+01,-0.10021E+01,
- &-0.10036E+01,-0.10052E+01,-0.10067E+01,-0.10082E+01,-0.10097E+01,
- &-0.10112E+01,-0.10127E+01,-0.10142E+01,-0.10157E+01,-0.10171E+01,
- &-0.10186E+01,-0.10201E+01,-0.10216E+01,-0.10230E+01,-0.10245E+01,
- &-0.10260E+01,-0.10274E+01,-0.10289E+01,-0.10303E+01,-0.10317E+01/
-
- DATA (BNC07M(I),I=201,300)/
- &-0.10332E+01,-0.10346E+01,-0.10361E+01,-0.10375E+01,-0.10389E+01,
- &-0.10403E+01,-0.10417E+01,-0.10431E+01,-0.10446E+01,-0.10460E+01,
- &-0.10474E+01,-0.10488E+01,-0.10502E+01,-0.10515E+01,-0.10529E+01,
- &-0.10543E+01,-0.10557E+01,-0.10571E+01,-0.10584E+01,-0.10598E+01,
- &-0.10612E+01,-0.10625E+01,-0.10639E+01,-0.10653E+01,-0.10666E+01,
- &-0.10680E+01,-0.10693E+01,-0.10707E+01,-0.10720E+01,-0.10733E+01,
- &-0.10747E+01,-0.10760E+01,-0.10773E+01,-0.10787E+01,-0.10800E+01,
- &-0.10813E+01,-0.10826E+01,-0.10839E+01,-0.10853E+01,-0.10866E+01,
- &-0.10879E+01,-0.10892E+01,-0.10905E+01,-0.10918E+01,-0.10931E+01,
- &-0.10944E+01,-0.10957E+01,-0.10970E+01,-0.10982E+01,-0.10995E+01,
- &-0.11008E+01,-0.11021E+01,-0.11034E+01,-0.11046E+01,-0.11059E+01,
- &-0.11072E+01,-0.11084E+01,-0.11097E+01,-0.11110E+01,-0.11122E+01,
- &-0.11135E+01,-0.11147E+01,-0.11160E+01,-0.11172E+01,-0.11185E+01,
- &-0.11197E+01,-0.11210E+01,-0.11222E+01,-0.11234E+01,-0.11247E+01,
- &-0.11259E+01,-0.11271E+01,-0.11284E+01,-0.11296E+01,-0.11308E+01,
- &-0.11321E+01,-0.11333E+01,-0.11345E+01,-0.11357E+01,-0.11369E+01,
- &-0.11381E+01,-0.11393E+01,-0.11406E+01,-0.11418E+01,-0.11430E+01,
- &-0.11442E+01,-0.11454E+01,-0.11466E+01,-0.11478E+01,-0.11490E+01,
- &-0.11502E+01,-0.11513E+01,-0.11525E+01,-0.11537E+01,-0.11549E+01,
- &-0.11561E+01,-0.11573E+01,-0.11585E+01,-0.11596E+01,-0.11608E+01/
-
- DATA (BNC07M(I),I=301,400)/
- &-0.11620E+01,-0.11632E+01,-0.11643E+01,-0.11655E+01,-0.11667E+01,
- &-0.11678E+01,-0.11690E+01,-0.11702E+01,-0.11713E+01,-0.11725E+01,
- &-0.11736E+01,-0.11748E+01,-0.11759E+01,-0.11771E+01,-0.11782E+01,
- &-0.11794E+01,-0.11805E+01,-0.11817E+01,-0.11828E+01,-0.11840E+01,
- &-0.11851E+01,-0.11863E+01,-0.11874E+01,-0.11885E+01,-0.11897E+01,
- &-0.11908E+01,-0.11919E+01,-0.11931E+01,-0.11942E+01,-0.11953E+01,
- &-0.11964E+01,-0.11976E+01,-0.11987E+01,-0.11998E+01,-0.12009E+01,
- &-0.12021E+01,-0.12032E+01,-0.12043E+01,-0.12054E+01,-0.12065E+01,
- &-0.12076E+01,-0.12087E+01,-0.12098E+01,-0.12109E+01,-0.12121E+01,
- &-0.12132E+01,-0.12143E+01,-0.12154E+01,-0.12165E+01,-0.12176E+01,
- &-0.12187E+01,-0.12198E+01,-0.12209E+01,-0.12219E+01,-0.12230E+01,
- &-0.12241E+01,-0.12252E+01,-0.12263E+01,-0.12274E+01,-0.12285E+01,
- &-0.12296E+01,-0.12306E+01,-0.12317E+01,-0.12328E+01,-0.12339E+01,
- &-0.12350E+01,-0.12360E+01,-0.12371E+01,-0.12382E+01,-0.12393E+01,
- &-0.12403E+01,-0.12414E+01,-0.12425E+01,-0.12436E+01,-0.12446E+01,
- &-0.12457E+01,-0.12468E+01,-0.12478E+01,-0.12489E+01,-0.12499E+01,
- &-0.12510E+01,-0.12521E+01,-0.12531E+01,-0.12542E+01,-0.12552E+01,
- &-0.12563E+01,-0.12574E+01,-0.12584E+01,-0.12595E+01,-0.12605E+01,
- &-0.12616E+01,-0.12626E+01,-0.12637E+01,-0.12647E+01,-0.12657E+01,
- &-0.12668E+01,-0.12678E+01,-0.12689E+01,-0.12699E+01,-0.12710E+01/
-
- DATA (BNC07M(I),I=401,500)/
- &-0.12720E+01,-0.12730E+01,-0.12741E+01,-0.12751E+01,-0.12761E+01,
- &-0.12772E+01,-0.12782E+01,-0.12792E+01,-0.12803E+01,-0.12813E+01,
- &-0.12823E+01,-0.12834E+01,-0.12844E+01,-0.12854E+01,-0.12864E+01,
- &-0.12875E+01,-0.12885E+01,-0.12895E+01,-0.12905E+01,-0.12916E+01,
- &-0.12926E+01,-0.12936E+01,-0.12946E+01,-0.12956E+01,-0.12966E+01,
- &-0.12977E+01,-0.12987E+01,-0.12997E+01,-0.13007E+01,-0.13017E+01,
- &-0.13027E+01,-0.13037E+01,-0.13047E+01,-0.13057E+01,-0.13068E+01,
- &-0.13078E+01,-0.13088E+01,-0.13098E+01,-0.13108E+01,-0.13118E+01,
- &-0.13128E+01,-0.13138E+01,-0.13148E+01,-0.13158E+01,-0.13168E+01,
- &-0.13178E+01,-0.13188E+01,-0.13198E+01,-0.13208E+01,-0.13218E+01,
- &-0.13227E+01,-0.13237E+01,-0.13247E+01,-0.13257E+01,-0.13267E+01,
- &-0.13277E+01,-0.13287E+01,-0.13297E+01,-0.13307E+01,-0.13317E+01,
- &-0.13326E+01,-0.13336E+01,-0.13346E+01,-0.13356E+01,-0.13366E+01,
- &-0.13376E+01,-0.13385E+01,-0.13395E+01,-0.13405E+01,-0.13415E+01,
- &-0.13424E+01,-0.13434E+01,-0.13444E+01,-0.13454E+01,-0.13463E+01,
- &-0.13473E+01,-0.13483E+01,-0.13493E+01,-0.13502E+01,-0.13512E+01,
- &-0.13522E+01,-0.13532E+01,-0.13541E+01,-0.13551E+01,-0.13561E+01,
- &-0.13570E+01,-0.13580E+01,-0.13590E+01,-0.13599E+01,-0.13609E+01,
- &-0.13618E+01,-0.13628E+01,-0.13638E+01,-0.13647E+01,-0.13657E+01,
- &-0.13666E+01,-0.13676E+01,-0.13686E+01,-0.13695E+01,-0.13705E+01/
-
- DATA (BNC07M(I),I=501,600)/
- &-0.13714E+01,-0.13724E+01,-0.13733E+01,-0.13743E+01,-0.13753E+01,
- &-0.13762E+01,-0.13772E+01,-0.13781E+01,-0.13791E+01,-0.13800E+01,
- &-0.13810E+01,-0.13819E+01,-0.13829E+01,-0.13838E+01,-0.13847E+01,
- &-0.13857E+01,-0.13866E+01,-0.13876E+01,-0.13885E+01,-0.13895E+01,
- &-0.13904E+01,-0.13914E+01,-0.13923E+01,-0.13932E+01,-0.13942E+01,
- &-0.13951E+01,-0.13961E+01,-0.13970E+01,-0.13979E+01,-0.13989E+01,
- &-0.13998E+01,-0.14007E+01,-0.14017E+01,-0.14026E+01,-0.14036E+01,
- &-0.14045E+01,-0.14054E+01,-0.14064E+01,-0.14073E+01,-0.14082E+01,
- &-0.14091E+01,-0.14101E+01,-0.14110E+01,-0.14119E+01,-0.14129E+01,
- &-0.14138E+01,-0.14147E+01,-0.14156E+01,-0.14166E+01,-0.14175E+01,
- &-0.14184E+01,-0.14193E+01,-0.14203E+01,-0.14212E+01,-0.14221E+01,
- &-0.14230E+01,-0.14240E+01,-0.14249E+01,-0.14258E+01,-0.14267E+01,
- &-0.14276E+01,-0.14286E+01,-0.14295E+01,-0.14304E+01,-0.14313E+01,
- &-0.14322E+01,-0.14332E+01,-0.14341E+01,-0.14350E+01,-0.14359E+01,
- &-0.14368E+01,-0.14377E+01,-0.14386E+01,-0.14396E+01,-0.14405E+01,
- &-0.14414E+01,-0.14423E+01,-0.14432E+01,-0.14441E+01,-0.14450E+01,
- &-0.14459E+01,-0.14468E+01,-0.14477E+01,-0.14487E+01,-0.14496E+01,
- &-0.14505E+01,-0.14514E+01,-0.14523E+01,-0.14532E+01,-0.14541E+01,
- &-0.14550E+01,-0.14559E+01,-0.14568E+01,-0.14577E+01,-0.14586E+01,
- &-0.14595E+01,-0.14604E+01,-0.14613E+01,-0.14622E+01,-0.14631E+01/
-
- DATA (BNC07M(I),I=601,700)/
- &-0.14728E+01,-0.14817E+01,-0.14906E+01,-0.14994E+01,-0.15082E+01,
- &-0.15170E+01,-0.15257E+01,-0.15343E+01,-0.15430E+01,-0.15515E+01,
- &-0.15601E+01,-0.15686E+01,-0.15771E+01,-0.15856E+01,-0.15940E+01,
- &-0.16024E+01,-0.16107E+01,-0.16191E+01,-0.16274E+01,-0.16356E+01,
- &-0.16439E+01,-0.16521E+01,-0.16603E+01,-0.16684E+01,-0.16766E+01,
- &-0.16847E+01,-0.16928E+01,-0.17008E+01,-0.17089E+01,-0.17169E+01,
- &-0.17249E+01,-0.17328E+01,-0.17408E+01,-0.17487E+01,-0.17566E+01,
- &-0.17645E+01,-0.17723E+01,-0.17802E+01,-0.17880E+01,-0.17958E+01,
- &-0.18036E+01,-0.18114E+01,-0.18191E+01,-0.18268E+01,-0.18346E+01,
- &-0.18423E+01,-0.18499E+01,-0.18576E+01,-0.18652E+01,-0.18729E+01,
- &-0.18805E+01,-0.18881E+01,-0.18957E+01,-0.19032E+01,-0.19108E+01,
- &-0.19183E+01,-0.19258E+01,-0.19334E+01,-0.19409E+01,-0.19483E+01,
- &-0.19558E+01,-0.19633E+01,-0.19707E+01,-0.19781E+01,-0.19855E+01,
- &-0.19929E+01,-0.20003E+01,-0.20077E+01,-0.20151E+01,-0.20224E+01,
- &-0.20298E+01,-0.20371E+01,-0.20444E+01,-0.20517E+01,-0.20590E+01,
- &-0.20663E+01,-0.20736E+01,-0.20808E+01,-0.20881E+01,-0.20953E+01,
- &-0.21026E+01,-0.21098E+01,-0.21170E+01,-0.21242E+01,-0.21314E+01,
- &-0.21386E+01,-0.21457E+01,-0.21529E+01,-0.21601E+01,-0.21672E+01,
- &-0.21743E+01,-0.21815E+01,-0.21886E+01,-0.21957E+01,-0.22028E+01,
- &-0.22099E+01,-0.22169E+01,-0.22240E+01,-0.22311E+01,-0.22381E+01/
-
- DATA (BNC07M(I),I=701,741)/
- &-0.22452E+01,-0.22522E+01,-0.22593E+01,-0.22663E+01,-0.22733E+01,
- &-0.22803E+01,-0.22873E+01,-0.22943E+01,-0.23013E+01,-0.23082E+01,
- &-0.23152E+01,-0.23222E+01,-0.23291E+01,-0.23361E+01,-0.23430E+01,
- &-0.23499E+01,-0.23569E+01,-0.23638E+01,-0.23707E+01,-0.23776E+01,
- &-0.23845E+01,-0.23914E+01,-0.23983E+01,-0.24052E+01,-0.24120E+01,
- &-0.24189E+01,-0.24258E+01,-0.24326E+01,-0.24395E+01,-0.24463E+01,
- &-0.24531E+01,-0.24600E+01,-0.24668E+01,-0.24736E+01,-0.24804E+01,
- &-0.24872E+01,-0.24940E+01,-0.25008E+01,-0.25076E+01,-0.25144E+01,
- &-0.25211E+01
- & /
-C
-C *** (H,HSO4)
-C
- DATA (BNC08M(I),I=1,100)/
- &-0.45623E-01,-0.90075E-01,-0.10774E+00,-0.11790E+00,-0.12423E+00,
- &-0.12817E+00,-0.13046E+00,-0.13152E+00,-0.13161E+00,-0.13092E+00,
- &-0.12958E+00,-0.12767E+00,-0.12527E+00,-0.12245E+00,-0.11923E+00,
- &-0.11566E+00,-0.11177E+00,-0.10758E+00,-0.10312E+00,-0.98394E-01,
- &-0.93430E-01,-0.88237E-01,-0.82830E-01,-0.77218E-01,-0.71412E-01,
- &-0.65422E-01,-0.59256E-01,-0.52921E-01,-0.46426E-01,-0.39777E-01,
- &-0.32981E-01,-0.26044E-01,-0.18972E-01,-0.11771E-01,-0.44450E-02,
- & 0.29997E-02, 0.10558E-01, 0.18226E-01, 0.25999E-01, 0.33872E-01,
- & 0.41842E-01, 0.49903E-01, 0.58053E-01, 0.66287E-01, 0.74602E-01,
- & 0.82995E-01, 0.91462E-01, 0.10000E+00, 0.10861E+00, 0.11728E+00,
- & 0.12601E+00, 0.13481E+00, 0.14366E+00, 0.15257E+00, 0.16153E+00,
- & 0.17055E+00, 0.17962E+00, 0.18873E+00, 0.19790E+00, 0.20711E+00,
- & 0.21637E+00, 0.22567E+00, 0.23502E+00, 0.24442E+00, 0.25386E+00,
- & 0.26334E+00, 0.27287E+00, 0.28244E+00, 0.29205E+00, 0.30172E+00,
- & 0.31142E+00, 0.32118E+00, 0.33098E+00, 0.34083E+00, 0.35072E+00,
- & 0.36067E+00, 0.37066E+00, 0.38071E+00, 0.39081E+00, 0.40096E+00,
- & 0.41116E+00, 0.42141E+00, 0.43172E+00, 0.44208E+00, 0.45250E+00,
- & 0.46297E+00, 0.47349E+00, 0.48407E+00, 0.49470E+00, 0.50539E+00,
- & 0.51613E+00, 0.52692E+00, 0.53777E+00, 0.54867E+00, 0.55961E+00,
- & 0.57061E+00, 0.58165E+00, 0.59274E+00, 0.60387E+00, 0.61505E+00/
-
- DATA (BNC08M(I),I=101,200)/
- & 0.62627E+00, 0.63752E+00, 0.64882E+00, 0.66015E+00, 0.67151E+00,
- & 0.68291E+00, 0.69433E+00, 0.70578E+00, 0.71726E+00, 0.72876E+00,
- & 0.74028E+00, 0.75182E+00, 0.76338E+00, 0.77495E+00, 0.78653E+00,
- & 0.79813E+00, 0.80973E+00, 0.82134E+00, 0.83296E+00, 0.84458E+00,
- & 0.85620E+00, 0.86782E+00, 0.87945E+00, 0.89107E+00, 0.90268E+00,
- & 0.91429E+00, 0.92589E+00, 0.93749E+00, 0.94908E+00, 0.96066E+00,
- & 0.97222E+00, 0.98378E+00, 0.99532E+00, 0.10069E+01, 0.10184E+01,
- & 0.10299E+01, 0.10414E+01, 0.10528E+01, 0.10643E+01, 0.10757E+01,
- & 0.10871E+01, 0.10985E+01, 0.11099E+01, 0.11213E+01, 0.11326E+01,
- & 0.11440E+01, 0.11553E+01, 0.11666E+01, 0.11778E+01, 0.11891E+01,
- & 0.12003E+01, 0.12115E+01, 0.12227E+01, 0.12338E+01, 0.12450E+01,
- & 0.12561E+01, 0.12672E+01, 0.12783E+01, 0.12893E+01, 0.13004E+01,
- & 0.13114E+01, 0.13224E+01, 0.13333E+01, 0.13443E+01, 0.13552E+01,
- & 0.13661E+01, 0.13770E+01, 0.13878E+01, 0.13987E+01, 0.14095E+01,
- & 0.14203E+01, 0.14310E+01, 0.14418E+01, 0.14525E+01, 0.14632E+01,
- & 0.14739E+01, 0.14845E+01, 0.14951E+01, 0.15058E+01, 0.15163E+01,
- & 0.15269E+01, 0.15374E+01, 0.15479E+01, 0.15584E+01, 0.15689E+01,
- & 0.15794E+01, 0.15898E+01, 0.16002E+01, 0.16105E+01, 0.16209E+01,
- & 0.16312E+01, 0.16415E+01, 0.16518E+01, 0.16621E+01, 0.16723E+01,
- & 0.16826E+01, 0.16928E+01, 0.17029E+01, 0.17131E+01, 0.17232E+01/
-
- DATA (BNC08M(I),I=201,300)/
- & 0.17333E+01, 0.17434E+01, 0.17535E+01, 0.17635E+01, 0.17735E+01,
- & 0.17835E+01, 0.17935E+01, 0.18034E+01, 0.18134E+01, 0.18233E+01,
- & 0.18332E+01, 0.18430E+01, 0.18529E+01, 0.18627E+01, 0.18725E+01,
- & 0.18823E+01, 0.18920E+01, 0.19017E+01, 0.19115E+01, 0.19211E+01,
- & 0.19308E+01, 0.19405E+01, 0.19501E+01, 0.19597E+01, 0.19693E+01,
- & 0.19788E+01, 0.19884E+01, 0.19979E+01, 0.20074E+01, 0.20169E+01,
- & 0.20263E+01, 0.20358E+01, 0.20452E+01, 0.20546E+01, 0.20640E+01,
- & 0.20733E+01, 0.20827E+01, 0.20920E+01, 0.21013E+01, 0.21105E+01,
- & 0.21198E+01, 0.21290E+01, 0.21383E+01, 0.21474E+01, 0.21566E+01,
- & 0.21658E+01, 0.21749E+01, 0.21840E+01, 0.21931E+01, 0.22022E+01,
- & 0.22113E+01, 0.22203E+01, 0.22293E+01, 0.22383E+01, 0.22473E+01,
- & 0.22563E+01, 0.22652E+01, 0.22741E+01, 0.22830E+01, 0.22919E+01,
- & 0.23008E+01, 0.23096E+01, 0.23185E+01, 0.23273E+01, 0.23361E+01,
- & 0.23448E+01, 0.23536E+01, 0.23623E+01, 0.23710E+01, 0.23797E+01,
- & 0.23884E+01, 0.23971E+01, 0.24057E+01, 0.24144E+01, 0.24230E+01,
- & 0.24316E+01, 0.24401E+01, 0.24487E+01, 0.24572E+01, 0.24657E+01,
- & 0.24742E+01, 0.24827E+01, 0.24912E+01, 0.24997E+01, 0.25081E+01,
- & 0.25165E+01, 0.25249E+01, 0.25333E+01, 0.25416E+01, 0.25500E+01,
- & 0.25583E+01, 0.25666E+01, 0.25749E+01, 0.25832E+01, 0.25915E+01,
- & 0.25997E+01, 0.26080E+01, 0.26162E+01, 0.26244E+01, 0.26326E+01/
-
- DATA (BNC08M(I),I=301,400)/
- & 0.26407E+01, 0.26489E+01, 0.26570E+01, 0.26651E+01, 0.26732E+01,
- & 0.26813E+01, 0.26894E+01, 0.26974E+01, 0.27055E+01, 0.27135E+01,
- & 0.27215E+01, 0.27295E+01, 0.27374E+01, 0.27454E+01, 0.27533E+01,
- & 0.27613E+01, 0.27692E+01, 0.27771E+01, 0.27850E+01, 0.27928E+01,
- & 0.28007E+01, 0.28085E+01, 0.28163E+01, 0.28241E+01, 0.28319E+01,
- & 0.28397E+01, 0.28475E+01, 0.28552E+01, 0.28629E+01, 0.28706E+01,
- & 0.28783E+01, 0.28860E+01, 0.28937E+01, 0.29014E+01, 0.29090E+01,
- & 0.29166E+01, 0.29242E+01, 0.29318E+01, 0.29394E+01, 0.29470E+01,
- & 0.29545E+01, 0.29621E+01, 0.29696E+01, 0.29771E+01, 0.29846E+01,
- & 0.29921E+01, 0.29996E+01, 0.30070E+01, 0.30145E+01, 0.30219E+01,
- & 0.30293E+01, 0.30367E+01, 0.30441E+01, 0.30515E+01, 0.30589E+01,
- & 0.30662E+01, 0.30735E+01, 0.30809E+01, 0.30882E+01, 0.30955E+01,
- & 0.31027E+01, 0.31100E+01, 0.31173E+01, 0.31245E+01, 0.31317E+01,
- & 0.31390E+01, 0.31462E+01, 0.31534E+01, 0.31605E+01, 0.31677E+01,
- & 0.31748E+01, 0.31820E+01, 0.31891E+01, 0.31962E+01, 0.32033E+01,
- & 0.32104E+01, 0.32175E+01, 0.32245E+01, 0.32316E+01, 0.32386E+01,
- & 0.32457E+01, 0.32527E+01, 0.32597E+01, 0.32667E+01, 0.32736E+01,
- & 0.32806E+01, 0.32875E+01, 0.32945E+01, 0.33014E+01, 0.33083E+01,
- & 0.33152E+01, 0.33221E+01, 0.33290E+01, 0.33359E+01, 0.33427E+01,
- & 0.33496E+01, 0.33564E+01, 0.33632E+01, 0.33700E+01, 0.33768E+01/
-
- DATA (BNC08M(I),I=401,500)/
- & 0.33836E+01, 0.33904E+01, 0.33971E+01, 0.34039E+01, 0.34106E+01,
- & 0.34174E+01, 0.34241E+01, 0.34308E+01, 0.34375E+01, 0.34442E+01,
- & 0.34508E+01, 0.34575E+01, 0.34641E+01, 0.34708E+01, 0.34774E+01,
- & 0.34840E+01, 0.34906E+01, 0.34972E+01, 0.35038E+01, 0.35104E+01,
- & 0.35169E+01, 0.35235E+01, 0.35300E+01, 0.35365E+01, 0.35431E+01,
- & 0.35496E+01, 0.35561E+01, 0.35625E+01, 0.35690E+01, 0.35755E+01,
- & 0.35819E+01, 0.35884E+01, 0.35948E+01, 0.36012E+01, 0.36076E+01,
- & 0.36140E+01, 0.36204E+01, 0.36268E+01, 0.36332E+01, 0.36395E+01,
- & 0.36459E+01, 0.36522E+01, 0.36585E+01, 0.36649E+01, 0.36712E+01,
- & 0.36775E+01, 0.36838E+01, 0.36900E+01, 0.36963E+01, 0.37026E+01,
- & 0.37088E+01, 0.37150E+01, 0.37213E+01, 0.37275E+01, 0.37337E+01,
- & 0.37399E+01, 0.37461E+01, 0.37523E+01, 0.37584E+01, 0.37646E+01,
- & 0.37707E+01, 0.37769E+01, 0.37830E+01, 0.37891E+01, 0.37952E+01,
- & 0.38013E+01, 0.38074E+01, 0.38135E+01, 0.38196E+01, 0.38256E+01,
- & 0.38317E+01, 0.38377E+01, 0.38438E+01, 0.38498E+01, 0.38558E+01,
- & 0.38618E+01, 0.38678E+01, 0.38738E+01, 0.38798E+01, 0.38858E+01,
- & 0.38917E+01, 0.38977E+01, 0.39036E+01, 0.39096E+01, 0.39155E+01,
- & 0.39214E+01, 0.39273E+01, 0.39332E+01, 0.39391E+01, 0.39450E+01,
- & 0.39509E+01, 0.39567E+01, 0.39626E+01, 0.39684E+01, 0.39743E+01,
- & 0.39801E+01, 0.39859E+01, 0.39917E+01, 0.39975E+01, 0.40033E+01/
-
- DATA (BNC08M(I),I=501,600)/
- & 0.40091E+01, 0.40149E+01, 0.40206E+01, 0.40264E+01, 0.40321E+01,
- & 0.40379E+01, 0.40436E+01, 0.40493E+01, 0.40551E+01, 0.40608E+01,
- & 0.40665E+01, 0.40722E+01, 0.40778E+01, 0.40835E+01, 0.40892E+01,
- & 0.40948E+01, 0.41005E+01, 0.41061E+01, 0.41118E+01, 0.41174E+01,
- & 0.41230E+01, 0.41286E+01, 0.41342E+01, 0.41398E+01, 0.41454E+01,
- & 0.41510E+01, 0.41565E+01, 0.41621E+01, 0.41677E+01, 0.41732E+01,
- & 0.41787E+01, 0.41843E+01, 0.41898E+01, 0.41953E+01, 0.42008E+01,
- & 0.42063E+01, 0.42118E+01, 0.42173E+01, 0.42228E+01, 0.42282E+01,
- & 0.42337E+01, 0.42391E+01, 0.42446E+01, 0.42500E+01, 0.42554E+01,
- & 0.42609E+01, 0.42663E+01, 0.42717E+01, 0.42771E+01, 0.42825E+01,
- & 0.42878E+01, 0.42932E+01, 0.42986E+01, 0.43040E+01, 0.43093E+01,
- & 0.43146E+01, 0.43200E+01, 0.43253E+01, 0.43306E+01, 0.43360E+01,
- & 0.43413E+01, 0.43466E+01, 0.43519E+01, 0.43571E+01, 0.43624E+01,
- & 0.43677E+01, 0.43730E+01, 0.43782E+01, 0.43835E+01, 0.43887E+01,
- & 0.43940E+01, 0.43992E+01, 0.44044E+01, 0.44096E+01, 0.44148E+01,
- & 0.44200E+01, 0.44252E+01, 0.44304E+01, 0.44356E+01, 0.44408E+01,
- & 0.44459E+01, 0.44511E+01, 0.44562E+01, 0.44614E+01, 0.44665E+01,
- & 0.44717E+01, 0.44768E+01, 0.44819E+01, 0.44870E+01, 0.44921E+01,
- & 0.44972E+01, 0.45023E+01, 0.45074E+01, 0.45125E+01, 0.45175E+01,
- & 0.45226E+01, 0.45277E+01, 0.45327E+01, 0.45377E+01, 0.45428E+01/
-
- DATA (BNC08M(I),I=601,700)/
- & 0.45968E+01, 0.46461E+01, 0.46948E+01, 0.47428E+01, 0.47903E+01,
- & 0.48372E+01, 0.48835E+01, 0.49293E+01, 0.49745E+01, 0.50191E+01,
- & 0.50633E+01, 0.51069E+01, 0.51500E+01, 0.51927E+01, 0.52349E+01,
- & 0.52765E+01, 0.53178E+01, 0.53586E+01, 0.53989E+01, 0.54388E+01,
- & 0.54783E+01, 0.55174E+01, 0.55560E+01, 0.55943E+01, 0.56322E+01,
- & 0.56696E+01, 0.57068E+01, 0.57435E+01, 0.57799E+01, 0.58159E+01,
- & 0.58515E+01, 0.58869E+01, 0.59218E+01, 0.59565E+01, 0.59908E+01,
- & 0.60248E+01, 0.60585E+01, 0.60919E+01, 0.61249E+01, 0.61577E+01,
- & 0.61902E+01, 0.62224E+01, 0.62543E+01, 0.62859E+01, 0.63172E+01,
- & 0.63483E+01, 0.63791E+01, 0.64096E+01, 0.64399E+01, 0.64699E+01,
- & 0.64997E+01, 0.65292E+01, 0.65585E+01, 0.65875E+01, 0.66163E+01,
- & 0.66449E+01, 0.66733E+01, 0.67014E+01, 0.67293E+01, 0.67569E+01,
- & 0.67844E+01, 0.68116E+01, 0.68387E+01, 0.68655E+01, 0.68921E+01,
- & 0.69185E+01, 0.69447E+01, 0.69708E+01, 0.69966E+01, 0.70222E+01,
- & 0.70477E+01, 0.70729E+01, 0.70980E+01, 0.71229E+01, 0.71476E+01,
- & 0.71721E+01, 0.71965E+01, 0.72207E+01, 0.72447E+01, 0.72686E+01,
- & 0.72922E+01, 0.73158E+01, 0.73391E+01, 0.73623E+01, 0.73854E+01,
- & 0.74082E+01, 0.74310E+01, 0.74536E+01, 0.74760E+01, 0.74983E+01,
- & 0.75204E+01, 0.75424E+01, 0.75642E+01, 0.75859E+01, 0.76075E+01,
- & 0.76289E+01, 0.76502E+01, 0.76714E+01, 0.76924E+01, 0.77133E+01/
-
- DATA (BNC08M(I),I=701,741)/
- & 0.77340E+01, 0.77546E+01, 0.77751E+01, 0.77955E+01, 0.78157E+01,
- & 0.78358E+01, 0.78558E+01, 0.78757E+01, 0.78955E+01, 0.79151E+01,
- & 0.79346E+01, 0.79540E+01, 0.79733E+01, 0.79925E+01, 0.80115E+01,
- & 0.80305E+01, 0.80493E+01, 0.80680E+01, 0.80867E+01, 0.81052E+01,
- & 0.81236E+01, 0.81419E+01, 0.81601E+01, 0.81782E+01, 0.81961E+01,
- & 0.82140E+01, 0.82318E+01, 0.82495E+01, 0.82671E+01, 0.82846E+01,
- & 0.83020E+01, 0.83193E+01, 0.83365E+01, 0.83536E+01, 0.83706E+01,
- & 0.83876E+01, 0.84044E+01, 0.84212E+01, 0.84378E+01, 0.84544E+01,
- & 0.84709E+01
- & /
-C
-C *** NH4HSO4
-C
- DATA (BNC09M(I),I=1,100)/
- &-0.47941E-01,-0.10187E+00,-0.12775E+00,-0.14554E+00,-0.15916E+00,
- &-0.17016E+00,-0.17935E+00,-0.18720E+00,-0.19401E+00,-0.19998E+00,
- &-0.20526E+00,-0.20996E+00,-0.21416E+00,-0.21792E+00,-0.22130E+00,
- &-0.22433E+00,-0.22706E+00,-0.22950E+00,-0.23169E+00,-0.23364E+00,
- &-0.23537E+00,-0.23689E+00,-0.23822E+00,-0.23937E+00,-0.24035E+00,
- &-0.24117E+00,-0.24183E+00,-0.24235E+00,-0.24273E+00,-0.24298E+00,
- &-0.24310E+00,-0.24310E+00,-0.24299E+00,-0.24276E+00,-0.24242E+00,
- &-0.24198E+00,-0.24144E+00,-0.24080E+00,-0.24008E+00,-0.23926E+00,
- &-0.23835E+00,-0.23736E+00,-0.23630E+00,-0.23515E+00,-0.23393E+00,
- &-0.23264E+00,-0.23128E+00,-0.22985E+00,-0.22835E+00,-0.22680E+00,
- &-0.22518E+00,-0.22350E+00,-0.22177E+00,-0.21998E+00,-0.21814E+00,
- &-0.21625E+00,-0.21431E+00,-0.21232E+00,-0.21028E+00,-0.20820E+00,
- &-0.20607E+00,-0.20391E+00,-0.20170E+00,-0.19945E+00,-0.19716E+00,
- &-0.19483E+00,-0.19246E+00,-0.19006E+00,-0.18762E+00,-0.18514E+00,
- &-0.18263E+00,-0.18009E+00,-0.17751E+00,-0.17490E+00,-0.17225E+00,
- &-0.16957E+00,-0.16686E+00,-0.16412E+00,-0.16135E+00,-0.15854E+00,
- &-0.15571E+00,-0.15284E+00,-0.14994E+00,-0.14702E+00,-0.14406E+00,
- &-0.14108E+00,-0.13806E+00,-0.13502E+00,-0.13195E+00,-0.12885E+00,
- &-0.12573E+00,-0.12257E+00,-0.11940E+00,-0.11619E+00,-0.11297E+00,
- &-0.10972E+00,-0.10644E+00,-0.10315E+00,-0.99827E-01,-0.96489E-01/
-
- DATA (BNC09M(I),I=101,200)/
- &-0.93130E-01,-0.89752E-01,-0.86357E-01,-0.82944E-01,-0.79515E-01,
- &-0.76070E-01,-0.72611E-01,-0.69138E-01,-0.65653E-01,-0.62156E-01,
- &-0.58649E-01,-0.55131E-01,-0.51605E-01,-0.48070E-01,-0.44529E-01,
- &-0.40980E-01,-0.37426E-01,-0.33868E-01,-0.30305E-01,-0.26738E-01,
- &-0.23169E-01,-0.19598E-01,-0.16026E-01,-0.12452E-01,-0.88787E-02,
- &-0.53053E-02,-0.17329E-02, 0.18381E-02, 0.54075E-02, 0.89747E-02,
- & 0.12539E-01, 0.16101E-01, 0.19659E-01, 0.23213E-01, 0.26764E-01,
- & 0.30310E-01, 0.33851E-01, 0.37388E-01, 0.40919E-01, 0.44446E-01,
- & 0.47966E-01, 0.51481E-01, 0.54990E-01, 0.58493E-01, 0.61990E-01,
- & 0.65481E-01, 0.68964E-01, 0.72442E-01, 0.75912E-01, 0.79376E-01,
- & 0.82833E-01, 0.86282E-01, 0.89725E-01, 0.93161E-01, 0.96589E-01,
- & 0.10001E+00, 0.10342E+00, 0.10683E+00, 0.11023E+00, 0.11362E+00,
- & 0.11700E+00, 0.12038E+00, 0.12375E+00, 0.12711E+00, 0.13046E+00,
- & 0.13381E+00, 0.13714E+00, 0.14047E+00, 0.14379E+00, 0.14711E+00,
- & 0.15041E+00, 0.15371E+00, 0.15700E+00, 0.16028E+00, 0.16356E+00,
- & 0.16683E+00, 0.17008E+00, 0.17334E+00, 0.17658E+00, 0.17981E+00,
- & 0.18304E+00, 0.18626E+00, 0.18947E+00, 0.19268E+00, 0.19587E+00,
- & 0.19906E+00, 0.20224E+00, 0.20541E+00, 0.20858E+00, 0.21173E+00,
- & 0.21488E+00, 0.21802E+00, 0.22116E+00, 0.22428E+00, 0.22740E+00,
- & 0.23051E+00, 0.23361E+00, 0.23671E+00, 0.23979E+00, 0.24287E+00/
-
- DATA (BNC09M(I),I=201,300)/
- & 0.24594E+00, 0.24901E+00, 0.25206E+00, 0.25511E+00, 0.25815E+00,
- & 0.26119E+00, 0.26422E+00, 0.26723E+00, 0.27025E+00, 0.27325E+00,
- & 0.27625E+00, 0.27924E+00, 0.28222E+00, 0.28519E+00, 0.28816E+00,
- & 0.29112E+00, 0.29407E+00, 0.29702E+00, 0.29996E+00, 0.30289E+00,
- & 0.30581E+00, 0.30873E+00, 0.31164E+00, 0.31454E+00, 0.31743E+00,
- & 0.32032E+00, 0.32320E+00, 0.32608E+00, 0.32895E+00, 0.33181E+00,
- & 0.33466E+00, 0.33751E+00, 0.34035E+00, 0.34318E+00, 0.34601E+00,
- & 0.34883E+00, 0.35164E+00, 0.35445E+00, 0.35725E+00, 0.36004E+00,
- & 0.36282E+00, 0.36560E+00, 0.36838E+00, 0.37114E+00, 0.37390E+00,
- & 0.37666E+00, 0.37940E+00, 0.38214E+00, 0.38488E+00, 0.38760E+00,
- & 0.39033E+00, 0.39304E+00, 0.39575E+00, 0.39845E+00, 0.40115E+00,
- & 0.40384E+00, 0.40652E+00, 0.40920E+00, 0.41187E+00, 0.41453E+00,
- & 0.41719E+00, 0.41985E+00, 0.42249E+00, 0.42513E+00, 0.42777E+00,
- & 0.43040E+00, 0.43302E+00, 0.43563E+00, 0.43825E+00, 0.44085E+00,
- & 0.44345E+00, 0.44604E+00, 0.44863E+00, 0.45121E+00, 0.45379E+00,
- & 0.45636E+00, 0.45892E+00, 0.46148E+00, 0.46403E+00, 0.46658E+00,
- & 0.46912E+00, 0.47165E+00, 0.47419E+00, 0.47671E+00, 0.47923E+00,
- & 0.48174E+00, 0.48425E+00, 0.48675E+00, 0.48925E+00, 0.49174E+00,
- & 0.49423E+00, 0.49671E+00, 0.49918E+00, 0.50165E+00, 0.50412E+00,
- & 0.50658E+00, 0.50903E+00, 0.51148E+00, 0.51392E+00, 0.51636E+00/
-
- DATA (BNC09M(I),I=301,400)/
- & 0.51879E+00, 0.52122E+00, 0.52364E+00, 0.52606E+00, 0.52847E+00,
- & 0.53088E+00, 0.53328E+00, 0.53568E+00, 0.53807E+00, 0.54046E+00,
- & 0.54284E+00, 0.54522E+00, 0.54759E+00, 0.54996E+00, 0.55232E+00,
- & 0.55467E+00, 0.55703E+00, 0.55937E+00, 0.56172E+00, 0.56405E+00,
- & 0.56639E+00, 0.56871E+00, 0.57104E+00, 0.57336E+00, 0.57567E+00,
- & 0.57798E+00, 0.58028E+00, 0.58258E+00, 0.58488E+00, 0.58717E+00,
- & 0.58945E+00, 0.59173E+00, 0.59401E+00, 0.59628E+00, 0.59855E+00,
- & 0.60081E+00, 0.60307E+00, 0.60532E+00, 0.60757E+00, 0.60981E+00,
- & 0.61205E+00, 0.61429E+00, 0.61652E+00, 0.61874E+00, 0.62097E+00,
- & 0.62318E+00, 0.62540E+00, 0.62761E+00, 0.62981E+00, 0.63201E+00,
- & 0.63421E+00, 0.63640E+00, 0.63859E+00, 0.64077E+00, 0.64295E+00,
- & 0.64512E+00, 0.64729E+00, 0.64946E+00, 0.65162E+00, 0.65378E+00,
- & 0.65593E+00, 0.65808E+00, 0.66022E+00, 0.66236E+00, 0.66450E+00,
- & 0.66663E+00, 0.66876E+00, 0.67089E+00, 0.67301E+00, 0.67512E+00,
- & 0.67724E+00, 0.67935E+00, 0.68145E+00, 0.68355E+00, 0.68565E+00,
- & 0.68774E+00, 0.68983E+00, 0.69191E+00, 0.69399E+00, 0.69607E+00,
- & 0.69814E+00, 0.70021E+00, 0.70228E+00, 0.70434E+00, 0.70639E+00,
- & 0.70845E+00, 0.71050E+00, 0.71254E+00, 0.71459E+00, 0.71662E+00,
- & 0.71866E+00, 0.72069E+00, 0.72272E+00, 0.72474E+00, 0.72676E+00,
- & 0.72878E+00, 0.73079E+00, 0.73280E+00, 0.73480E+00, 0.73680E+00/
-
- DATA (BNC09M(I),I=401,500)/
- & 0.73880E+00, 0.74079E+00, 0.74279E+00, 0.74477E+00, 0.74675E+00,
- & 0.74873E+00, 0.75071E+00, 0.75268E+00, 0.75465E+00, 0.75662E+00,
- & 0.75858E+00, 0.76054E+00, 0.76249E+00, 0.76444E+00, 0.76639E+00,
- & 0.76833E+00, 0.77028E+00, 0.77221E+00, 0.77415E+00, 0.77608E+00,
- & 0.77801E+00, 0.77993E+00, 0.78185E+00, 0.78377E+00, 0.78568E+00,
- & 0.78759E+00, 0.78950E+00, 0.79140E+00, 0.79330E+00, 0.79520E+00,
- & 0.79709E+00, 0.79898E+00, 0.80087E+00, 0.80275E+00, 0.80463E+00,
- & 0.80651E+00, 0.80838E+00, 0.81025E+00, 0.81212E+00, 0.81399E+00,
- & 0.81585E+00, 0.81770E+00, 0.81956E+00, 0.82141E+00, 0.82326E+00,
- & 0.82510E+00, 0.82694E+00, 0.82878E+00, 0.83062E+00, 0.83245E+00,
- & 0.83428E+00, 0.83611E+00, 0.83793E+00, 0.83975E+00, 0.84157E+00,
- & 0.84338E+00, 0.84519E+00, 0.84700E+00, 0.84880E+00, 0.85061E+00,
- & 0.85240E+00, 0.85420E+00, 0.85599E+00, 0.85778E+00, 0.85957E+00,
- & 0.86135E+00, 0.86313E+00, 0.86491E+00, 0.86669E+00, 0.86846E+00,
- & 0.87023E+00, 0.87199E+00, 0.87376E+00, 0.87552E+00, 0.87727E+00,
- & 0.87903E+00, 0.88078E+00, 0.88253E+00, 0.88427E+00, 0.88602E+00,
- & 0.88776E+00, 0.88949E+00, 0.89123E+00, 0.89296E+00, 0.89469E+00,
- & 0.89641E+00, 0.89814E+00, 0.89986E+00, 0.90157E+00, 0.90329E+00,
- & 0.90500E+00, 0.90671E+00, 0.90842E+00, 0.91012E+00, 0.91182E+00,
- & 0.91352E+00, 0.91521E+00, 0.91691E+00, 0.91860E+00, 0.92028E+00/
-
- DATA (BNC09M(I),I=501,600)/
- & 0.92197E+00, 0.92365E+00, 0.92533E+00, 0.92700E+00, 0.92868E+00,
- & 0.93035E+00, 0.93202E+00, 0.93368E+00, 0.93535E+00, 0.93701E+00,
- & 0.93867E+00, 0.94032E+00, 0.94197E+00, 0.94362E+00, 0.94527E+00,
- & 0.94692E+00, 0.94856E+00, 0.95020E+00, 0.95184E+00, 0.95347E+00,
- & 0.95510E+00, 0.95673E+00, 0.95836E+00, 0.95998E+00, 0.96160E+00,
- & 0.96322E+00, 0.96484E+00, 0.96646E+00, 0.96807E+00, 0.96968E+00,
- & 0.97128E+00, 0.97289E+00, 0.97449E+00, 0.97609E+00, 0.97769E+00,
- & 0.97928E+00, 0.98087E+00, 0.98246E+00, 0.98405E+00, 0.98563E+00,
- & 0.98722E+00, 0.98880E+00, 0.99037E+00, 0.99195E+00, 0.99352E+00,
- & 0.99509E+00, 0.99666E+00, 0.99822E+00, 0.99979E+00, 0.10013E+01,
- & 0.10029E+01, 0.10045E+01, 0.10060E+01, 0.10076E+01, 0.10091E+01,
- & 0.10107E+01, 0.10122E+01, 0.10137E+01, 0.10153E+01, 0.10168E+01,
- & 0.10184E+01, 0.10199E+01, 0.10214E+01, 0.10230E+01, 0.10245E+01,
- & 0.10260E+01, 0.10275E+01, 0.10290E+01, 0.10306E+01, 0.10321E+01,
- & 0.10336E+01, 0.10351E+01, 0.10366E+01, 0.10381E+01, 0.10396E+01,
- & 0.10411E+01, 0.10426E+01, 0.10441E+01, 0.10456E+01, 0.10471E+01,
- & 0.10486E+01, 0.10501E+01, 0.10516E+01, 0.10530E+01, 0.10545E+01,
- & 0.10560E+01, 0.10575E+01, 0.10590E+01, 0.10604E+01, 0.10619E+01,
- & 0.10634E+01, 0.10648E+01, 0.10663E+01, 0.10678E+01, 0.10692E+01,
- & 0.10707E+01, 0.10721E+01, 0.10736E+01, 0.10750E+01, 0.10765E+01/
-
- DATA (BNC09M(I),I=601,700)/
- & 0.10920E+01, 0.11062E+01, 0.11202E+01, 0.11339E+01, 0.11475E+01,
- & 0.11609E+01, 0.11741E+01, 0.11872E+01, 0.12000E+01, 0.12127E+01,
- & 0.12252E+01, 0.12376E+01, 0.12498E+01, 0.12619E+01, 0.12738E+01,
- & 0.12855E+01, 0.12971E+01, 0.13086E+01, 0.13199E+01, 0.13311E+01,
- & 0.13421E+01, 0.13531E+01, 0.13638E+01, 0.13745E+01, 0.13850E+01,
- & 0.13954E+01, 0.14057E+01, 0.14159E+01, 0.14259E+01, 0.14359E+01,
- & 0.14457E+01, 0.14554E+01, 0.14650E+01, 0.14745E+01, 0.14839E+01,
- & 0.14932E+01, 0.15024E+01, 0.15115E+01, 0.15205E+01, 0.15294E+01,
- & 0.15382E+01, 0.15469E+01, 0.15555E+01, 0.15641E+01, 0.15725E+01,
- & 0.15808E+01, 0.15891E+01, 0.15973E+01, 0.16054E+01, 0.16134E+01,
- & 0.16213E+01, 0.16292E+01, 0.16370E+01, 0.16447E+01, 0.16523E+01,
- & 0.16598E+01, 0.16673E+01, 0.16747E+01, 0.16820E+01, 0.16893E+01,
- & 0.16965E+01, 0.17036E+01, 0.17106E+01, 0.17176E+01, 0.17245E+01,
- & 0.17314E+01, 0.17381E+01, 0.17449E+01, 0.17515E+01, 0.17581E+01,
- & 0.17646E+01, 0.17711E+01, 0.17775E+01, 0.17839E+01, 0.17902E+01,
- & 0.17964E+01, 0.18026E+01, 0.18087E+01, 0.18148E+01, 0.18208E+01,
- & 0.18268E+01, 0.18327E+01, 0.18385E+01, 0.18443E+01, 0.18501E+01,
- & 0.18558E+01, 0.18614E+01, 0.18671E+01, 0.18726E+01, 0.18781E+01,
- & 0.18836E+01, 0.18890E+01, 0.18943E+01, 0.18997E+01, 0.19049E+01,
- & 0.19102E+01, 0.19153E+01, 0.19205E+01, 0.19256E+01, 0.19306E+01/
-
- DATA (BNC09M(I),I=701,741)/
- & 0.19356E+01, 0.19406E+01, 0.19455E+01, 0.19504E+01, 0.19552E+01,
- & 0.19600E+01, 0.19648E+01, 0.19695E+01, 0.19742E+01, 0.19788E+01,
- & 0.19835E+01, 0.19880E+01, 0.19925E+01, 0.19970E+01, 0.20015E+01,
- & 0.20059E+01, 0.20103E+01, 0.20146E+01, 0.20190E+01, 0.20232E+01,
- & 0.20275E+01, 0.20317E+01, 0.20359E+01, 0.20400E+01, 0.20441E+01,
- & 0.20482E+01, 0.20522E+01, 0.20562E+01, 0.20602E+01, 0.20641E+01,
- & 0.20681E+01, 0.20719E+01, 0.20758E+01, 0.20796E+01, 0.20834E+01,
- & 0.20872E+01, 0.20909E+01, 0.20946E+01, 0.20983E+01, 0.21019E+01,
- & 0.21055E+01
- & /
-C
-C *** (H,NO3)
-C
- DATA (BNC10M(I),I=1,100)/
- &-0.47292E-01,-0.97810E-01,-0.12025E+00,-0.13463E+00,-0.14486E+00,
- &-0.15252E+00,-0.15842E+00,-0.16303E+00,-0.16665E+00,-0.16950E+00,
- &-0.17170E+00,-0.17339E+00,-0.17464E+00,-0.17551E+00,-0.17606E+00,
- &-0.17633E+00,-0.17636E+00,-0.17617E+00,-0.17579E+00,-0.17524E+00,
- &-0.17454E+00,-0.17370E+00,-0.17274E+00,-0.17167E+00,-0.17050E+00,
- &-0.16924E+00,-0.16790E+00,-0.16648E+00,-0.16500E+00,-0.16345E+00,
- &-0.16185E+00,-0.16020E+00,-0.15851E+00,-0.15677E+00,-0.15499E+00,
- &-0.15319E+00,-0.15135E+00,-0.14948E+00,-0.14759E+00,-0.14568E+00,
- &-0.14374E+00,-0.14179E+00,-0.13982E+00,-0.13784E+00,-0.13585E+00,
- &-0.13384E+00,-0.13183E+00,-0.12981E+00,-0.12778E+00,-0.12574E+00,
- &-0.12369E+00,-0.12165E+00,-0.11959E+00,-0.11753E+00,-0.11547E+00,
- &-0.11341E+00,-0.11134E+00,-0.10926E+00,-0.10719E+00,-0.10510E+00,
- &-0.10302E+00,-0.10093E+00,-0.98835E-01,-0.96735E-01,-0.94630E-01,
- &-0.92519E-01,-0.90401E-01,-0.88277E-01,-0.86145E-01,-0.84004E-01,
- &-0.81855E-01,-0.79696E-01,-0.77527E-01,-0.75348E-01,-0.73157E-01,
- &-0.70954E-01,-0.68738E-01,-0.66510E-01,-0.64268E-01,-0.62011E-01,
- &-0.59741E-01,-0.57455E-01,-0.55153E-01,-0.52836E-01,-0.50503E-01,
- &-0.48154E-01,-0.45788E-01,-0.43406E-01,-0.41006E-01,-0.38591E-01,
- &-0.36158E-01,-0.33709E-01,-0.31243E-01,-0.28761E-01,-0.26264E-01,
- &-0.23750E-01,-0.21221E-01,-0.18676E-01,-0.16117E-01,-0.13544E-01/
-
- DATA (BNC10M(I),I=101,200)/
- &-0.10957E-01,-0.83559E-02,-0.57424E-02,-0.31166E-02,-0.47900E-03,
- & 0.21698E-02, 0.48293E-02, 0.74989E-02, 0.10178E-01, 0.12866E-01,
- & 0.15562E-01, 0.18266E-01, 0.20977E-01, 0.23695E-01, 0.26419E-01,
- & 0.29149E-01, 0.31883E-01, 0.34622E-01, 0.37365E-01, 0.40112E-01,
- & 0.42862E-01, 0.45614E-01, 0.48369E-01, 0.51126E-01, 0.53884E-01,
- & 0.56643E-01, 0.59403E-01, 0.62164E-01, 0.64925E-01, 0.67685E-01,
- & 0.70446E-01, 0.73206E-01, 0.75965E-01, 0.78723E-01, 0.81480E-01,
- & 0.84236E-01, 0.86990E-01, 0.89742E-01, 0.92493E-01, 0.95241E-01,
- & 0.97988E-01, 0.10073E+00, 0.10347E+00, 0.10621E+00, 0.10895E+00,
- & 0.11169E+00, 0.11442E+00, 0.11715E+00, 0.11987E+00, 0.12260E+00,
- & 0.12532E+00, 0.12803E+00, 0.13075E+00, 0.13346E+00, 0.13617E+00,
- & 0.13887E+00, 0.14157E+00, 0.14427E+00, 0.14697E+00, 0.14966E+00,
- & 0.15235E+00, 0.15503E+00, 0.15771E+00, 0.16039E+00, 0.16307E+00,
- & 0.16574E+00, 0.16840E+00, 0.17107E+00, 0.17373E+00, 0.17639E+00,
- & 0.17904E+00, 0.18169E+00, 0.18433E+00, 0.18698E+00, 0.18961E+00,
- & 0.19225E+00, 0.19488E+00, 0.19751E+00, 0.20013E+00, 0.20275E+00,
- & 0.20537E+00, 0.20798E+00, 0.21059E+00, 0.21319E+00, 0.21579E+00,
- & 0.21839E+00, 0.22098E+00, 0.22357E+00, 0.22615E+00, 0.22873E+00,
- & 0.23131E+00, 0.23388E+00, 0.23645E+00, 0.23902E+00, 0.24158E+00,
- & 0.24414E+00, 0.24669E+00, 0.24924E+00, 0.25178E+00, 0.25433E+00/
-
- DATA (BNC10M(I),I=201,300)/
- & 0.25686E+00, 0.25940E+00, 0.26192E+00, 0.26445E+00, 0.26697E+00,
- & 0.26949E+00, 0.27200E+00, 0.27451E+00, 0.27701E+00, 0.27952E+00,
- & 0.28201E+00, 0.28450E+00, 0.28699E+00, 0.28948E+00, 0.29196E+00,
- & 0.29444E+00, 0.29691E+00, 0.29938E+00, 0.30184E+00, 0.30430E+00,
- & 0.30676E+00, 0.30921E+00, 0.31166E+00, 0.31410E+00, 0.31654E+00,
- & 0.31898E+00, 0.32141E+00, 0.32384E+00, 0.32626E+00, 0.32868E+00,
- & 0.33109E+00, 0.33351E+00, 0.33591E+00, 0.33832E+00, 0.34071E+00,
- & 0.34311E+00, 0.34550E+00, 0.34789E+00, 0.35027E+00, 0.35265E+00,
- & 0.35502E+00, 0.35740E+00, 0.35976E+00, 0.36213E+00, 0.36448E+00,
- & 0.36684E+00, 0.36919E+00, 0.37154E+00, 0.37388E+00, 0.37622E+00,
- & 0.37855E+00, 0.38088E+00, 0.38321E+00, 0.38553E+00, 0.38785E+00,
- & 0.39016E+00, 0.39247E+00, 0.39478E+00, 0.39708E+00, 0.39938E+00,
- & 0.40168E+00, 0.40397E+00, 0.40626E+00, 0.40854E+00, 0.41082E+00,
- & 0.41309E+00, 0.41536E+00, 0.41763E+00, 0.41989E+00, 0.42215E+00,
- & 0.42441E+00, 0.42666E+00, 0.42891E+00, 0.43115E+00, 0.43339E+00,
- & 0.43563E+00, 0.43786E+00, 0.44009E+00, 0.44231E+00, 0.44453E+00,
- & 0.44675E+00, 0.44896E+00, 0.45117E+00, 0.45337E+00, 0.45558E+00,
- & 0.45777E+00, 0.45997E+00, 0.46216E+00, 0.46434E+00, 0.46652E+00,
- & 0.46870E+00, 0.47088E+00, 0.47305E+00, 0.47522E+00, 0.47738E+00,
- & 0.47954E+00, 0.48169E+00, 0.48385E+00, 0.48600E+00, 0.48814E+00/
-
- DATA (BNC10M(I),I=301,400)/
- & 0.49028E+00, 0.49242E+00, 0.49455E+00, 0.49668E+00, 0.49881E+00,
- & 0.50093E+00, 0.50305E+00, 0.50516E+00, 0.50728E+00, 0.50938E+00,
- & 0.51149E+00, 0.51359E+00, 0.51569E+00, 0.51778E+00, 0.51987E+00,
- & 0.52196E+00, 0.52404E+00, 0.52612E+00, 0.52819E+00, 0.53026E+00,
- & 0.53233E+00, 0.53440E+00, 0.53646E+00, 0.53851E+00, 0.54057E+00,
- & 0.54262E+00, 0.54467E+00, 0.54671E+00, 0.54875E+00, 0.55079E+00,
- & 0.55282E+00, 0.55485E+00, 0.55687E+00, 0.55890E+00, 0.56092E+00,
- & 0.56293E+00, 0.56494E+00, 0.56695E+00, 0.56896E+00, 0.57096E+00,
- & 0.57296E+00, 0.57495E+00, 0.57694E+00, 0.57893E+00, 0.58092E+00,
- & 0.58290E+00, 0.58488E+00, 0.58685E+00, 0.58882E+00, 0.59079E+00,
- & 0.59275E+00, 0.59472E+00, 0.59667E+00, 0.59863E+00, 0.60058E+00,
- & 0.60253E+00, 0.60447E+00, 0.60641E+00, 0.60835E+00, 0.61029E+00,
- & 0.61222E+00, 0.61415E+00, 0.61607E+00, 0.61799E+00, 0.61991E+00,
- & 0.62183E+00, 0.62374E+00, 0.62565E+00, 0.62755E+00, 0.62945E+00,
- & 0.63135E+00, 0.63325E+00, 0.63514E+00, 0.63703E+00, 0.63892E+00,
- & 0.64080E+00, 0.64268E+00, 0.64456E+00, 0.64643E+00, 0.64830E+00,
- & 0.65017E+00, 0.65204E+00, 0.65390E+00, 0.65576E+00, 0.65761E+00,
- & 0.65946E+00, 0.66131E+00, 0.66316E+00, 0.66500E+00, 0.66684E+00,
- & 0.66868E+00, 0.67051E+00, 0.67234E+00, 0.67417E+00, 0.67600E+00,
- & 0.67782E+00, 0.67964E+00, 0.68145E+00, 0.68326E+00, 0.68507E+00/
-
- DATA (BNC10M(I),I=401,500)/
- & 0.68688E+00, 0.68868E+00, 0.69049E+00, 0.69228E+00, 0.69408E+00,
- & 0.69587E+00, 0.69766E+00, 0.69944E+00, 0.70123E+00, 0.70301E+00,
- & 0.70479E+00, 0.70656E+00, 0.70833E+00, 0.71010E+00, 0.71187E+00,
- & 0.71363E+00, 0.71539E+00, 0.71715E+00, 0.71890E+00, 0.72065E+00,
- & 0.72240E+00, 0.72415E+00, 0.72589E+00, 0.72763E+00, 0.72937E+00,
- & 0.73110E+00, 0.73283E+00, 0.73456E+00, 0.73629E+00, 0.73801E+00,
- & 0.73973E+00, 0.74145E+00, 0.74316E+00, 0.74487E+00, 0.74658E+00,
- & 0.74829E+00, 0.75000E+00, 0.75170E+00, 0.75339E+00, 0.75509E+00,
- & 0.75678E+00, 0.75847E+00, 0.76016E+00, 0.76185E+00, 0.76353E+00,
- & 0.76521E+00, 0.76689E+00, 0.76856E+00, 0.77023E+00, 0.77190E+00,
- & 0.77357E+00, 0.77523E+00, 0.77689E+00, 0.77855E+00, 0.78021E+00,
- & 0.78186E+00, 0.78351E+00, 0.78516E+00, 0.78680E+00, 0.78844E+00,
- & 0.79009E+00, 0.79172E+00, 0.79336E+00, 0.79499E+00, 0.79662E+00,
- & 0.79825E+00, 0.79987E+00, 0.80149E+00, 0.80311E+00, 0.80473E+00,
- & 0.80635E+00, 0.80796E+00, 0.80957E+00, 0.81117E+00, 0.81278E+00,
- & 0.81438E+00, 0.81598E+00, 0.81758E+00, 0.81917E+00, 0.82076E+00,
- & 0.82235E+00, 0.82394E+00, 0.82553E+00, 0.82711E+00, 0.82869E+00,
- & 0.83027E+00, 0.83184E+00, 0.83341E+00, 0.83498E+00, 0.83655E+00,
- & 0.83812E+00, 0.83968E+00, 0.84124E+00, 0.84280E+00, 0.84435E+00,
- & 0.84591E+00, 0.84746E+00, 0.84901E+00, 0.85055E+00, 0.85210E+00/
-
- DATA (BNC10M(I),I=501,600)/
- & 0.85364E+00, 0.85518E+00, 0.85671E+00, 0.85825E+00, 0.85978E+00,
- & 0.86131E+00, 0.86284E+00, 0.86436E+00, 0.86589E+00, 0.86741E+00,
- & 0.86892E+00, 0.87044E+00, 0.87195E+00, 0.87346E+00, 0.87497E+00,
- & 0.87648E+00, 0.87799E+00, 0.87949E+00, 0.88099E+00, 0.88249E+00,
- & 0.88398E+00, 0.88547E+00, 0.88696E+00, 0.88845E+00, 0.88994E+00,
- & 0.89142E+00, 0.89291E+00, 0.89439E+00, 0.89586E+00, 0.89734E+00,
- & 0.89881E+00, 0.90028E+00, 0.90175E+00, 0.90322E+00, 0.90468E+00,
- & 0.90615E+00, 0.90761E+00, 0.90906E+00, 0.91052E+00, 0.91197E+00,
- & 0.91343E+00, 0.91488E+00, 0.91632E+00, 0.91777E+00, 0.91921E+00,
- & 0.92065E+00, 0.92209E+00, 0.92353E+00, 0.92496E+00, 0.92639E+00,
- & 0.92782E+00, 0.92925E+00, 0.93068E+00, 0.93210E+00, 0.93352E+00,
- & 0.93494E+00, 0.93636E+00, 0.93778E+00, 0.93919E+00, 0.94060E+00,
- & 0.94201E+00, 0.94342E+00, 0.94483E+00, 0.94623E+00, 0.94763E+00,
- & 0.94903E+00, 0.95043E+00, 0.95182E+00, 0.95322E+00, 0.95461E+00,
- & 0.95600E+00, 0.95738E+00, 0.95877E+00, 0.96015E+00, 0.96153E+00,
- & 0.96291E+00, 0.96429E+00, 0.96566E+00, 0.96704E+00, 0.96841E+00,
- & 0.96978E+00, 0.97115E+00, 0.97251E+00, 0.97388E+00, 0.97524E+00,
- & 0.97660E+00, 0.97795E+00, 0.97931E+00, 0.98066E+00, 0.98202E+00,
- & 0.98337E+00, 0.98471E+00, 0.98606E+00, 0.98740E+00, 0.98875E+00,
- & 0.99009E+00, 0.99143E+00, 0.99276E+00, 0.99410E+00, 0.99543E+00/
-
- DATA (BNC10M(I),I=601,700)/
- & 0.10097E+01, 0.10227E+01, 0.10356E+01, 0.10483E+01, 0.10608E+01,
- & 0.10731E+01, 0.10852E+01, 0.10972E+01, 0.11091E+01, 0.11208E+01,
- & 0.11323E+01, 0.11437E+01, 0.11549E+01, 0.11660E+01, 0.11770E+01,
- & 0.11878E+01, 0.11985E+01, 0.12090E+01, 0.12195E+01, 0.12298E+01,
- & 0.12399E+01, 0.12500E+01, 0.12599E+01, 0.12697E+01, 0.12794E+01,
- & 0.12889E+01, 0.12984E+01, 0.13077E+01, 0.13170E+01, 0.13261E+01,
- & 0.13351E+01, 0.13441E+01, 0.13529E+01, 0.13616E+01, 0.13702E+01,
- & 0.13788E+01, 0.13872E+01, 0.13955E+01, 0.14038E+01, 0.14119E+01,
- & 0.14200E+01, 0.14280E+01, 0.14359E+01, 0.14437E+01, 0.14514E+01,
- & 0.14590E+01, 0.14666E+01, 0.14741E+01, 0.14815E+01, 0.14888E+01,
- & 0.14961E+01, 0.15032E+01, 0.15103E+01, 0.15174E+01, 0.15243E+01,
- & 0.15312E+01, 0.15380E+01, 0.15448E+01, 0.15515E+01, 0.15581E+01,
- & 0.15646E+01, 0.15711E+01, 0.15775E+01, 0.15839E+01, 0.15901E+01,
- & 0.15964E+01, 0.16025E+01, 0.16086E+01, 0.16147E+01, 0.16207E+01,
- & 0.16266E+01, 0.16325E+01, 0.16383E+01, 0.16441E+01, 0.16498E+01,
- & 0.16554E+01, 0.16610E+01, 0.16666E+01, 0.16721E+01, 0.16775E+01,
- & 0.16829E+01, 0.16882E+01, 0.16935E+01, 0.16988E+01, 0.17040E+01,
- & 0.17091E+01, 0.17142E+01, 0.17193E+01, 0.17243E+01, 0.17292E+01,
- & 0.17342E+01, 0.17390E+01, 0.17439E+01, 0.17486E+01, 0.17534E+01,
- & 0.17581E+01, 0.17627E+01, 0.17674E+01, 0.17719E+01, 0.17765E+01/
-
- DATA (BNC10M(I),I=701,741)/
- & 0.17810E+01, 0.17854E+01, 0.17898E+01, 0.17942E+01, 0.17985E+01,
- & 0.18028E+01, 0.18071E+01, 0.18113E+01, 0.18155E+01, 0.18196E+01,
- & 0.18238E+01, 0.18278E+01, 0.18319E+01, 0.18359E+01, 0.18399E+01,
- & 0.18438E+01, 0.18477E+01, 0.18516E+01, 0.18554E+01, 0.18592E+01,
- & 0.18630E+01, 0.18667E+01, 0.18704E+01, 0.18741E+01, 0.18777E+01,
- & 0.18814E+01, 0.18849E+01, 0.18885E+01, 0.18920E+01, 0.18955E+01,
- & 0.18990E+01, 0.19024E+01, 0.19058E+01, 0.19092E+01, 0.19125E+01,
- & 0.19158E+01, 0.19191E+01, 0.19224E+01, 0.19256E+01, 0.19288E+01,
- & 0.19320E+01
- & /
-C
-C *** (H,Cl)
-C
- DATA (BNC11M(I),I=1,100)/
- &-0.45992E-01,-0.91415E-01,-0.10957E+00,-0.12001E+00,-0.12652E+00,
- &-0.13058E+00,-0.13296E+00,-0.13409E+00,-0.13425E+00,-0.13365E+00,
- &-0.13241E+00,-0.13063E+00,-0.12840E+00,-0.12577E+00,-0.12279E+00,
- &-0.11951E+00,-0.11594E+00,-0.11213E+00,-0.10809E+00,-0.10384E+00,
- &-0.99402E-01,-0.94790E-01,-0.90019E-01,-0.85098E-01,-0.80040E-01,
- &-0.74855E-01,-0.69550E-01,-0.64135E-01,-0.58616E-01,-0.53002E-01,
- &-0.47297E-01,-0.41509E-01,-0.35643E-01,-0.29704E-01,-0.23697E-01,
- &-0.17626E-01,-0.11497E-01,-0.53118E-02, 0.92416E-03, 0.72078E-02,
- & 0.13536E-01, 0.19905E-01, 0.26312E-01, 0.32755E-01, 0.39231E-01,
- & 0.45737E-01, 0.52272E-01, 0.58833E-01, 0.65418E-01, 0.72027E-01,
- & 0.78657E-01, 0.85307E-01, 0.91976E-01, 0.98664E-01, 0.10537E+00,
- & 0.11209E+00, 0.11883E+00, 0.12558E+00, 0.13235E+00, 0.13913E+00,
- & 0.14593E+00, 0.15274E+00, 0.15958E+00, 0.16642E+00, 0.17329E+00,
- & 0.18017E+00, 0.18707E+00, 0.19399E+00, 0.20093E+00, 0.20789E+00,
- & 0.21487E+00, 0.22188E+00, 0.22891E+00, 0.23597E+00, 0.24305E+00,
- & 0.25016E+00, 0.25730E+00, 0.26447E+00, 0.27166E+00, 0.27890E+00,
- & 0.28616E+00, 0.29346E+00, 0.30079E+00, 0.30815E+00, 0.31556E+00,
- & 0.32299E+00, 0.33047E+00, 0.33798E+00, 0.34553E+00, 0.35311E+00,
- & 0.36073E+00, 0.36839E+00, 0.37608E+00, 0.38381E+00, 0.39158E+00,
- & 0.39937E+00, 0.40721E+00, 0.41507E+00, 0.42297E+00, 0.43089E+00/
-
- DATA (BNC11M(I),I=101,200)/
- & 0.43885E+00, 0.44683E+00, 0.45485E+00, 0.46288E+00, 0.47095E+00,
- & 0.47903E+00, 0.48714E+00, 0.49527E+00, 0.50341E+00, 0.51158E+00,
- & 0.51976E+00, 0.52795E+00, 0.53616E+00, 0.54438E+00, 0.55261E+00,
- & 0.56085E+00, 0.56909E+00, 0.57735E+00, 0.58561E+00, 0.59387E+00,
- & 0.60213E+00, 0.61040E+00, 0.61867E+00, 0.62693E+00, 0.63520E+00,
- & 0.64346E+00, 0.65172E+00, 0.65998E+00, 0.66823E+00, 0.67648E+00,
- & 0.68472E+00, 0.69296E+00, 0.70119E+00, 0.70941E+00, 0.71762E+00,
- & 0.72582E+00, 0.73402E+00, 0.74220E+00, 0.75038E+00, 0.75854E+00,
- & 0.76670E+00, 0.77484E+00, 0.78297E+00, 0.79109E+00, 0.79920E+00,
- & 0.80730E+00, 0.81539E+00, 0.82346E+00, 0.83152E+00, 0.83957E+00,
- & 0.84760E+00, 0.85562E+00, 0.86363E+00, 0.87163E+00, 0.87961E+00,
- & 0.88758E+00, 0.89553E+00, 0.90347E+00, 0.91140E+00, 0.91931E+00,
- & 0.92721E+00, 0.93510E+00, 0.94297E+00, 0.95083E+00, 0.95867E+00,
- & 0.96650E+00, 0.97431E+00, 0.98211E+00, 0.98990E+00, 0.99767E+00,
- & 0.10054E+01, 0.10132E+01, 0.10209E+01, 0.10286E+01, 0.10363E+01,
- & 0.10440E+01, 0.10517E+01, 0.10593E+01, 0.10669E+01, 0.10746E+01,
- & 0.10822E+01, 0.10898E+01, 0.10974E+01, 0.11049E+01, 0.11125E+01,
- & 0.11200E+01, 0.11275E+01, 0.11350E+01, 0.11425E+01, 0.11500E+01,
- & 0.11574E+01, 0.11649E+01, 0.11723E+01, 0.11797E+01, 0.11871E+01,
- & 0.11945E+01, 0.12019E+01, 0.12092E+01, 0.12166E+01, 0.12239E+01/
-
- DATA (BNC11M(I),I=201,300)/
- & 0.12312E+01, 0.12385E+01, 0.12458E+01, 0.12531E+01, 0.12603E+01,
- & 0.12675E+01, 0.12748E+01, 0.12820E+01, 0.12892E+01, 0.12963E+01,
- & 0.13035E+01, 0.13106E+01, 0.13178E+01, 0.13249E+01, 0.13320E+01,
- & 0.13391E+01, 0.13462E+01, 0.13532E+01, 0.13603E+01, 0.13673E+01,
- & 0.13743E+01, 0.13813E+01, 0.13883E+01, 0.13953E+01, 0.14022E+01,
- & 0.14092E+01, 0.14161E+01, 0.14230E+01, 0.14299E+01, 0.14368E+01,
- & 0.14437E+01, 0.14505E+01, 0.14574E+01, 0.14642E+01, 0.14710E+01,
- & 0.14778E+01, 0.14846E+01, 0.14914E+01, 0.14981E+01, 0.15049E+01,
- & 0.15116E+01, 0.15183E+01, 0.15250E+01, 0.15317E+01, 0.15384E+01,
- & 0.15450E+01, 0.15517E+01, 0.15583E+01, 0.15650E+01, 0.15716E+01,
- & 0.15782E+01, 0.15847E+01, 0.15913E+01, 0.15979E+01, 0.16044E+01,
- & 0.16109E+01, 0.16174E+01, 0.16239E+01, 0.16304E+01, 0.16369E+01,
- & 0.16434E+01, 0.16498E+01, 0.16562E+01, 0.16627E+01, 0.16691E+01,
- & 0.16755E+01, 0.16818E+01, 0.16882E+01, 0.16946E+01, 0.17009E+01,
- & 0.17072E+01, 0.17136E+01, 0.17199E+01, 0.17262E+01, 0.17324E+01,
- & 0.17387E+01, 0.17450E+01, 0.17512E+01, 0.17574E+01, 0.17636E+01,
- & 0.17699E+01, 0.17760E+01, 0.17822E+01, 0.17884E+01, 0.17945E+01,
- & 0.18007E+01, 0.18068E+01, 0.18129E+01, 0.18190E+01, 0.18251E+01,
- & 0.18312E+01, 0.18373E+01, 0.18434E+01, 0.18494E+01, 0.18554E+01,
- & 0.18615E+01, 0.18675E+01, 0.18735E+01, 0.18795E+01, 0.18854E+01/
-
- DATA (BNC11M(I),I=301,400)/
- & 0.18914E+01, 0.18973E+01, 0.19033E+01, 0.19092E+01, 0.19151E+01,
- & 0.19210E+01, 0.19269E+01, 0.19328E+01, 0.19387E+01, 0.19446E+01,
- & 0.19504E+01, 0.19562E+01, 0.19621E+01, 0.19679E+01, 0.19737E+01,
- & 0.19795E+01, 0.19853E+01, 0.19910E+01, 0.19968E+01, 0.20025E+01,
- & 0.20083E+01, 0.20140E+01, 0.20197E+01, 0.20254E+01, 0.20311E+01,
- & 0.20368E+01, 0.20425E+01, 0.20481E+01, 0.20538E+01, 0.20594E+01,
- & 0.20651E+01, 0.20707E+01, 0.20763E+01, 0.20819E+01, 0.20875E+01,
- & 0.20931E+01, 0.20986E+01, 0.21042E+01, 0.21097E+01, 0.21153E+01,
- & 0.21208E+01, 0.21263E+01, 0.21318E+01, 0.21373E+01, 0.21428E+01,
- & 0.21483E+01, 0.21537E+01, 0.21592E+01, 0.21646E+01, 0.21701E+01,
- & 0.21755E+01, 0.21809E+01, 0.21863E+01, 0.21917E+01, 0.21971E+01,
- & 0.22025E+01, 0.22078E+01, 0.22132E+01, 0.22185E+01, 0.22239E+01,
- & 0.22292E+01, 0.22345E+01, 0.22398E+01, 0.22451E+01, 0.22504E+01,
- & 0.22557E+01, 0.22610E+01, 0.22662E+01, 0.22715E+01, 0.22767E+01,
- & 0.22819E+01, 0.22872E+01, 0.22924E+01, 0.22976E+01, 0.23028E+01,
- & 0.23080E+01, 0.23131E+01, 0.23183E+01, 0.23235E+01, 0.23286E+01,
- & 0.23338E+01, 0.23389E+01, 0.23440E+01, 0.23491E+01, 0.23542E+01,
- & 0.23593E+01, 0.23644E+01, 0.23695E+01, 0.23746E+01, 0.23796E+01,
- & 0.23847E+01, 0.23897E+01, 0.23947E+01, 0.23998E+01, 0.24048E+01,
- & 0.24098E+01, 0.24148E+01, 0.24198E+01, 0.24248E+01, 0.24297E+01/
-
- DATA (BNC11M(I),I=401,500)/
- & 0.24347E+01, 0.24397E+01, 0.24446E+01, 0.24496E+01, 0.24545E+01,
- & 0.24594E+01, 0.24643E+01, 0.24692E+01, 0.24741E+01, 0.24790E+01,
- & 0.24839E+01, 0.24888E+01, 0.24936E+01, 0.24985E+01, 0.25033E+01,
- & 0.25082E+01, 0.25130E+01, 0.25178E+01, 0.25227E+01, 0.25275E+01,
- & 0.25323E+01, 0.25371E+01, 0.25418E+01, 0.25466E+01, 0.25514E+01,
- & 0.25561E+01, 0.25609E+01, 0.25656E+01, 0.25704E+01, 0.25751E+01,
- & 0.25798E+01, 0.25845E+01, 0.25892E+01, 0.25939E+01, 0.25986E+01,
- & 0.26033E+01, 0.26080E+01, 0.26127E+01, 0.26173E+01, 0.26220E+01,
- & 0.26266E+01, 0.26313E+01, 0.26359E+01, 0.26405E+01, 0.26451E+01,
- & 0.26497E+01, 0.26543E+01, 0.26589E+01, 0.26635E+01, 0.26681E+01,
- & 0.26727E+01, 0.26772E+01, 0.26818E+01, 0.26863E+01, 0.26909E+01,
- & 0.26954E+01, 0.26999E+01, 0.27044E+01, 0.27090E+01, 0.27135E+01,
- & 0.27180E+01, 0.27224E+01, 0.27269E+01, 0.27314E+01, 0.27359E+01,
- & 0.27403E+01, 0.27448E+01, 0.27492E+01, 0.27537E+01, 0.27581E+01,
- & 0.27626E+01, 0.27670E+01, 0.27714E+01, 0.27758E+01, 0.27802E+01,
- & 0.27846E+01, 0.27890E+01, 0.27934E+01, 0.27977E+01, 0.28021E+01,
- & 0.28065E+01, 0.28108E+01, 0.28152E+01, 0.28195E+01, 0.28238E+01,
- & 0.28282E+01, 0.28325E+01, 0.28368E+01, 0.28411E+01, 0.28454E+01,
- & 0.28497E+01, 0.28540E+01, 0.28583E+01, 0.28625E+01, 0.28668E+01,
- & 0.28711E+01, 0.28753E+01, 0.28796E+01, 0.28838E+01, 0.28880E+01/
-
- DATA (BNC11M(I),I=501,600)/
- & 0.28923E+01, 0.28965E+01, 0.29007E+01, 0.29049E+01, 0.29091E+01,
- & 0.29133E+01, 0.29175E+01, 0.29217E+01, 0.29259E+01, 0.29301E+01,
- & 0.29342E+01, 0.29384E+01, 0.29425E+01, 0.29467E+01, 0.29508E+01,
- & 0.29550E+01, 0.29591E+01, 0.29632E+01, 0.29673E+01, 0.29714E+01,
- & 0.29756E+01, 0.29797E+01, 0.29837E+01, 0.29878E+01, 0.29919E+01,
- & 0.29960E+01, 0.30001E+01, 0.30041E+01, 0.30082E+01, 0.30122E+01,
- & 0.30163E+01, 0.30203E+01, 0.30244E+01, 0.30284E+01, 0.30324E+01,
- & 0.30364E+01, 0.30404E+01, 0.30444E+01, 0.30484E+01, 0.30524E+01,
- & 0.30564E+01, 0.30604E+01, 0.30644E+01, 0.30684E+01, 0.30723E+01,
- & 0.30763E+01, 0.30802E+01, 0.30842E+01, 0.30881E+01, 0.30921E+01,
- & 0.30960E+01, 0.30999E+01, 0.31039E+01, 0.31078E+01, 0.31117E+01,
- & 0.31156E+01, 0.31195E+01, 0.31234E+01, 0.31273E+01, 0.31311E+01,
- & 0.31350E+01, 0.31389E+01, 0.31428E+01, 0.31466E+01, 0.31505E+01,
- & 0.31543E+01, 0.31582E+01, 0.31620E+01, 0.31658E+01, 0.31697E+01,
- & 0.31735E+01, 0.31773E+01, 0.31811E+01, 0.31849E+01, 0.31887E+01,
- & 0.31925E+01, 0.31963E+01, 0.32001E+01, 0.32039E+01, 0.32077E+01,
- & 0.32115E+01, 0.32152E+01, 0.32190E+01, 0.32227E+01, 0.32265E+01,
- & 0.32302E+01, 0.32340E+01, 0.32377E+01, 0.32414E+01, 0.32452E+01,
- & 0.32489E+01, 0.32526E+01, 0.32563E+01, 0.32600E+01, 0.32637E+01,
- & 0.32674E+01, 0.32711E+01, 0.32748E+01, 0.32785E+01, 0.32822E+01/
-
- DATA (BNC11M(I),I=601,700)/
- & 0.33216E+01, 0.33575E+01, 0.33930E+01, 0.34281E+01, 0.34627E+01,
- & 0.34969E+01, 0.35306E+01, 0.35640E+01, 0.35969E+01, 0.36294E+01,
- & 0.36616E+01, 0.36933E+01, 0.37247E+01, 0.37557E+01, 0.37864E+01,
- & 0.38167E+01, 0.38467E+01, 0.38764E+01, 0.39057E+01, 0.39347E+01,
- & 0.39633E+01, 0.39917E+01, 0.40198E+01, 0.40475E+01, 0.40750E+01,
- & 0.41022E+01, 0.41291E+01, 0.41558E+01, 0.41821E+01, 0.42082E+01,
- & 0.42341E+01, 0.42596E+01, 0.42850E+01, 0.43100E+01, 0.43349E+01,
- & 0.43595E+01, 0.43838E+01, 0.44080E+01, 0.44319E+01, 0.44556E+01,
- & 0.44790E+01, 0.45023E+01, 0.45253E+01, 0.45481E+01, 0.45707E+01,
- & 0.45932E+01, 0.46154E+01, 0.46374E+01, 0.46592E+01, 0.46809E+01,
- & 0.47023E+01, 0.47236E+01, 0.47447E+01, 0.47656E+01, 0.47863E+01,
- & 0.48069E+01, 0.48273E+01, 0.48475E+01, 0.48675E+01, 0.48874E+01,
- & 0.49071E+01, 0.49267E+01, 0.49461E+01, 0.49654E+01, 0.49845E+01,
- & 0.50034E+01, 0.50222E+01, 0.50409E+01, 0.50594E+01, 0.50778E+01,
- & 0.50960E+01, 0.51141E+01, 0.51321E+01, 0.51499E+01, 0.51676E+01,
- & 0.51851E+01, 0.52025E+01, 0.52198E+01, 0.52370E+01, 0.52541E+01,
- & 0.52710E+01, 0.52878E+01, 0.53044E+01, 0.53210E+01, 0.53374E+01,
- & 0.53538E+01, 0.53700E+01, 0.53861E+01, 0.54021E+01, 0.54179E+01,
- & 0.54337E+01, 0.54494E+01, 0.54649E+01, 0.54804E+01, 0.54957E+01,
- & 0.55109E+01, 0.55261E+01, 0.55411E+01, 0.55560E+01, 0.55709E+01/
-
- DATA (BNC11M(I),I=701,741)/
- & 0.55856E+01, 0.56002E+01, 0.56148E+01, 0.56292E+01, 0.56436E+01,
- & 0.56579E+01, 0.56720E+01, 0.56861E+01, 0.57001E+01, 0.57140E+01,
- & 0.57278E+01, 0.57416E+01, 0.57552E+01, 0.57688E+01, 0.57822E+01,
- & 0.57956E+01, 0.58089E+01, 0.58222E+01, 0.58353E+01, 0.58484E+01,
- & 0.58614E+01, 0.58743E+01, 0.58871E+01, 0.58999E+01, 0.59126E+01,
- & 0.59252E+01, 0.59377E+01, 0.59501E+01, 0.59625E+01, 0.59748E+01,
- & 0.59871E+01, 0.59993E+01, 0.60114E+01, 0.60234E+01, 0.60353E+01,
- & 0.60472E+01, 0.60591E+01, 0.60708E+01, 0.60825E+01, 0.60941E+01,
- & 0.61057E+01
- & /
-C
-C *** NaHSO4
-C
- DATA (BNC12M(I),I=1,100)/
- &-0.47116E-01,-0.97475E-01,-0.12015E+00,-0.13491E+00,-0.14562E+00,
- &-0.15380E+00,-0.16023E+00,-0.16537E+00,-0.16952E+00,-0.17287E+00,
- &-0.17555E+00,-0.17769E+00,-0.17935E+00,-0.18059E+00,-0.18148E+00,
- &-0.18204E+00,-0.18230E+00,-0.18230E+00,-0.18206E+00,-0.18160E+00,
- &-0.18093E+00,-0.18008E+00,-0.17904E+00,-0.17783E+00,-0.17647E+00,
- &-0.17496E+00,-0.17331E+00,-0.17153E+00,-0.16962E+00,-0.16760E+00,
- &-0.16545E+00,-0.16320E+00,-0.16085E+00,-0.15839E+00,-0.15584E+00,
- &-0.15321E+00,-0.15048E+00,-0.14767E+00,-0.14478E+00,-0.14181E+00,
- &-0.13877E+00,-0.13567E+00,-0.13249E+00,-0.12925E+00,-0.12594E+00,
- &-0.12258E+00,-0.11916E+00,-0.11568E+00,-0.11216E+00,-0.10858E+00,
- &-0.10495E+00,-0.10127E+00,-0.97550E-01,-0.93785E-01,-0.89977E-01,
- &-0.86128E-01,-0.82239E-01,-0.78311E-01,-0.74345E-01,-0.70342E-01,
- &-0.66304E-01,-0.62230E-01,-0.58122E-01,-0.53979E-01,-0.49803E-01,
- &-0.45593E-01,-0.41351E-01,-0.37076E-01,-0.32768E-01,-0.28428E-01,
- &-0.24056E-01,-0.19651E-01,-0.15214E-01,-0.10744E-01,-0.62423E-02,
- &-0.17073E-02, 0.28604E-02, 0.74611E-02, 0.12095E-01, 0.16762E-01,
- & 0.21462E-01, 0.26196E-01, 0.30963E-01, 0.35763E-01, 0.40597E-01,
- & 0.45463E-01, 0.50363E-01, 0.55296E-01, 0.60261E-01, 0.65258E-01,
- & 0.70287E-01, 0.75348E-01, 0.80439E-01, 0.85560E-01, 0.90710E-01,
- & 0.95889E-01, 0.10110E+00, 0.10633E+00, 0.11159E+00, 0.11687E+00/
-
- DATA (BNC12M(I),I=101,200)/
- & 0.12218E+00, 0.12752E+00, 0.13287E+00, 0.13824E+00, 0.14364E+00,
- & 0.14905E+00, 0.15448E+00, 0.15993E+00, 0.16539E+00, 0.17086E+00,
- & 0.17635E+00, 0.18185E+00, 0.18736E+00, 0.19287E+00, 0.19840E+00,
- & 0.20393E+00, 0.20947E+00, 0.21502E+00, 0.22057E+00, 0.22612E+00,
- & 0.23167E+00, 0.23722E+00, 0.24278E+00, 0.24834E+00, 0.25389E+00,
- & 0.25944E+00, 0.26499E+00, 0.27054E+00, 0.27608E+00, 0.28162E+00,
- & 0.28715E+00, 0.29268E+00, 0.29821E+00, 0.30373E+00, 0.30924E+00,
- & 0.31474E+00, 0.32024E+00, 0.32573E+00, 0.33121E+00, 0.33668E+00,
- & 0.34215E+00, 0.34761E+00, 0.35306E+00, 0.35850E+00, 0.36393E+00,
- & 0.36935E+00, 0.37476E+00, 0.38016E+00, 0.38555E+00, 0.39094E+00,
- & 0.39631E+00, 0.40167E+00, 0.40703E+00, 0.41237E+00, 0.41770E+00,
- & 0.42302E+00, 0.42833E+00, 0.43363E+00, 0.43893E+00, 0.44420E+00,
- & 0.44947E+00, 0.45473E+00, 0.45998E+00, 0.46522E+00, 0.47044E+00,
- & 0.47566E+00, 0.48087E+00, 0.48606E+00, 0.49124E+00, 0.49641E+00,
- & 0.50158E+00, 0.50673E+00, 0.51187E+00, 0.51699E+00, 0.52211E+00,
- & 0.52722E+00, 0.53232E+00, 0.53740E+00, 0.54247E+00, 0.54754E+00,
- & 0.55259E+00, 0.55763E+00, 0.56266E+00, 0.56768E+00, 0.57269E+00,
- & 0.57769E+00, 0.58267E+00, 0.58765E+00, 0.59262E+00, 0.59757E+00,
- & 0.60251E+00, 0.60745E+00, 0.61237E+00, 0.61728E+00, 0.62218E+00,
- & 0.62707E+00, 0.63195E+00, 0.63682E+00, 0.64168E+00, 0.64652E+00/
-
- DATA (BNC12M(I),I=201,300)/
- & 0.65136E+00, 0.65619E+00, 0.66100E+00, 0.66581E+00, 0.67060E+00,
- & 0.67539E+00, 0.68016E+00, 0.68492E+00, 0.68968E+00, 0.69442E+00,
- & 0.69915E+00, 0.70387E+00, 0.70858E+00, 0.71328E+00, 0.71798E+00,
- & 0.72266E+00, 0.72733E+00, 0.73199E+00, 0.73664E+00, 0.74128E+00,
- & 0.74591E+00, 0.75053E+00, 0.75514E+00, 0.75974E+00, 0.76433E+00,
- & 0.76891E+00, 0.77348E+00, 0.77804E+00, 0.78260E+00, 0.78714E+00,
- & 0.79167E+00, 0.79619E+00, 0.80070E+00, 0.80521E+00, 0.80970E+00,
- & 0.81418E+00, 0.81866E+00, 0.82312E+00, 0.82758E+00, 0.83202E+00,
- & 0.83646E+00, 0.84089E+00, 0.84530E+00, 0.84971E+00, 0.85411E+00,
- & 0.85850E+00, 0.86288E+00, 0.86725E+00, 0.87161E+00, 0.87597E+00,
- & 0.88031E+00, 0.88465E+00, 0.88897E+00, 0.89329E+00, 0.89760E+00,
- & 0.90189E+00, 0.90619E+00, 0.91047E+00, 0.91474E+00, 0.91900E+00,
- & 0.92326E+00, 0.92750E+00, 0.93174E+00, 0.93597E+00, 0.94019E+00,
- & 0.94440E+00, 0.94860E+00, 0.95280E+00, 0.95698E+00, 0.96116E+00,
- & 0.96533E+00, 0.96949E+00, 0.97364E+00, 0.97778E+00, 0.98192E+00,
- & 0.98604E+00, 0.99016E+00, 0.99427E+00, 0.99837E+00, 0.10025E+01,
- & 0.10066E+01, 0.10106E+01, 0.10147E+01, 0.10188E+01, 0.10228E+01,
- & 0.10269E+01, 0.10309E+01, 0.10349E+01, 0.10389E+01, 0.10430E+01,
- & 0.10470E+01, 0.10510E+01, 0.10549E+01, 0.10589E+01, 0.10629E+01,
- & 0.10669E+01, 0.10708E+01, 0.10748E+01, 0.10787E+01, 0.10827E+01/
-
- DATA (BNC12M(I),I=301,400)/
- & 0.10866E+01, 0.10905E+01, 0.10944E+01, 0.10983E+01, 0.11022E+01,
- & 0.11061E+01, 0.11100E+01, 0.11139E+01, 0.11177E+01, 0.11216E+01,
- & 0.11254E+01, 0.11293E+01, 0.11331E+01, 0.11370E+01, 0.11408E+01,
- & 0.11446E+01, 0.11484E+01, 0.11522E+01, 0.11560E+01, 0.11598E+01,
- & 0.11636E+01, 0.11673E+01, 0.11711E+01, 0.11749E+01, 0.11786E+01,
- & 0.11824E+01, 0.11861E+01, 0.11898E+01, 0.11936E+01, 0.11973E+01,
- & 0.12010E+01, 0.12047E+01, 0.12084E+01, 0.12121E+01, 0.12157E+01,
- & 0.12194E+01, 0.12231E+01, 0.12268E+01, 0.12304E+01, 0.12341E+01,
- & 0.12377E+01, 0.12413E+01, 0.12450E+01, 0.12486E+01, 0.12522E+01,
- & 0.12558E+01, 0.12594E+01, 0.12630E+01, 0.12666E+01, 0.12702E+01,
- & 0.12738E+01, 0.12773E+01, 0.12809E+01, 0.12844E+01, 0.12880E+01,
- & 0.12915E+01, 0.12951E+01, 0.12986E+01, 0.13021E+01, 0.13057E+01,
- & 0.13092E+01, 0.13127E+01, 0.13162E+01, 0.13197E+01, 0.13232E+01,
- & 0.13266E+01, 0.13301E+01, 0.13336E+01, 0.13370E+01, 0.13405E+01,
- & 0.13440E+01, 0.13474E+01, 0.13508E+01, 0.13543E+01, 0.13577E+01,
- & 0.13611E+01, 0.13645E+01, 0.13679E+01, 0.13714E+01, 0.13747E+01,
- & 0.13781E+01, 0.13815E+01, 0.13849E+01, 0.13883E+01, 0.13916E+01,
- & 0.13950E+01, 0.13984E+01, 0.14017E+01, 0.14051E+01, 0.14084E+01,
- & 0.14117E+01, 0.14151E+01, 0.14184E+01, 0.14217E+01, 0.14250E+01,
- & 0.14283E+01, 0.14316E+01, 0.14349E+01, 0.14382E+01, 0.14415E+01/
-
- DATA (BNC12M(I),I=401,500)/
- & 0.14448E+01, 0.14480E+01, 0.14513E+01, 0.14546E+01, 0.14578E+01,
- & 0.14611E+01, 0.14643E+01, 0.14676E+01, 0.14708E+01, 0.14740E+01,
- & 0.14772E+01, 0.14805E+01, 0.14837E+01, 0.14869E+01, 0.14901E+01,
- & 0.14933E+01, 0.14965E+01, 0.14997E+01, 0.15028E+01, 0.15060E+01,
- & 0.15092E+01, 0.15124E+01, 0.15155E+01, 0.15187E+01, 0.15218E+01,
- & 0.15250E+01, 0.15281E+01, 0.15312E+01, 0.15344E+01, 0.15375E+01,
- & 0.15406E+01, 0.15437E+01, 0.15468E+01, 0.15499E+01, 0.15530E+01,
- & 0.15561E+01, 0.15592E+01, 0.15623E+01, 0.15654E+01, 0.15685E+01,
- & 0.15715E+01, 0.15746E+01, 0.15776E+01, 0.15807E+01, 0.15838E+01,
- & 0.15868E+01, 0.15898E+01, 0.15929E+01, 0.15959E+01, 0.15989E+01,
- & 0.16020E+01, 0.16050E+01, 0.16080E+01, 0.16110E+01, 0.16140E+01,
- & 0.16170E+01, 0.16200E+01, 0.16230E+01, 0.16259E+01, 0.16289E+01,
- & 0.16319E+01, 0.16349E+01, 0.16378E+01, 0.16408E+01, 0.16437E+01,
- & 0.16467E+01, 0.16496E+01, 0.16526E+01, 0.16555E+01, 0.16585E+01,
- & 0.16614E+01, 0.16643E+01, 0.16672E+01, 0.16701E+01, 0.16731E+01,
- & 0.16760E+01, 0.16789E+01, 0.16818E+01, 0.16846E+01, 0.16875E+01,
- & 0.16904E+01, 0.16933E+01, 0.16962E+01, 0.16990E+01, 0.17019E+01,
- & 0.17048E+01, 0.17076E+01, 0.17105E+01, 0.17133E+01, 0.17162E+01,
- & 0.17190E+01, 0.17218E+01, 0.17247E+01, 0.17275E+01, 0.17303E+01,
- & 0.17331E+01, 0.17360E+01, 0.17388E+01, 0.17416E+01, 0.17444E+01/
-
- DATA (BNC12M(I),I=501,600)/
- & 0.17472E+01, 0.17500E+01, 0.17528E+01, 0.17555E+01, 0.17583E+01,
- & 0.17611E+01, 0.17639E+01, 0.17666E+01, 0.17694E+01, 0.17722E+01,
- & 0.17749E+01, 0.17777E+01, 0.17804E+01, 0.17832E+01, 0.17859E+01,
- & 0.17887E+01, 0.17914E+01, 0.17941E+01, 0.17968E+01, 0.17996E+01,
- & 0.18023E+01, 0.18050E+01, 0.18077E+01, 0.18104E+01, 0.18131E+01,
- & 0.18158E+01, 0.18185E+01, 0.18212E+01, 0.18239E+01, 0.18265E+01,
- & 0.18292E+01, 0.18319E+01, 0.18346E+01, 0.18372E+01, 0.18399E+01,
- & 0.18426E+01, 0.18452E+01, 0.18479E+01, 0.18505E+01, 0.18531E+01,
- & 0.18558E+01, 0.18584E+01, 0.18611E+01, 0.18637E+01, 0.18663E+01,
- & 0.18689E+01, 0.18715E+01, 0.18742E+01, 0.18768E+01, 0.18794E+01,
- & 0.18820E+01, 0.18846E+01, 0.18872E+01, 0.18898E+01, 0.18923E+01,
- & 0.18949E+01, 0.18975E+01, 0.19001E+01, 0.19027E+01, 0.19052E+01,
- & 0.19078E+01, 0.19104E+01, 0.19129E+01, 0.19155E+01, 0.19180E+01,
- & 0.19206E+01, 0.19231E+01, 0.19257E+01, 0.19282E+01, 0.19307E+01,
- & 0.19333E+01, 0.19358E+01, 0.19383E+01, 0.19408E+01, 0.19433E+01,
- & 0.19459E+01, 0.19484E+01, 0.19509E+01, 0.19534E+01, 0.19559E+01,
- & 0.19584E+01, 0.19609E+01, 0.19634E+01, 0.19658E+01, 0.19683E+01,
- & 0.19708E+01, 0.19733E+01, 0.19757E+01, 0.19782E+01, 0.19807E+01,
- & 0.19831E+01, 0.19856E+01, 0.19881E+01, 0.19905E+01, 0.19930E+01,
- & 0.19954E+01, 0.19978E+01, 0.20003E+01, 0.20027E+01, 0.20052E+01/
-
- DATA (BNC12M(I),I=601,700)/
- & 0.20312E+01, 0.20550E+01, 0.20785E+01, 0.21017E+01, 0.21246E+01,
- & 0.21472E+01, 0.21695E+01, 0.21916E+01, 0.22134E+01, 0.22349E+01,
- & 0.22561E+01, 0.22771E+01, 0.22978E+01, 0.23183E+01, 0.23386E+01,
- & 0.23586E+01, 0.23784E+01, 0.23980E+01, 0.24173E+01, 0.24364E+01,
- & 0.24553E+01, 0.24740E+01, 0.24925E+01, 0.25108E+01, 0.25289E+01,
- & 0.25468E+01, 0.25646E+01, 0.25821E+01, 0.25994E+01, 0.26166E+01,
- & 0.26336E+01, 0.26504E+01, 0.26670E+01, 0.26835E+01, 0.26998E+01,
- & 0.27160E+01, 0.27320E+01, 0.27478E+01, 0.27635E+01, 0.27790E+01,
- & 0.27944E+01, 0.28096E+01, 0.28247E+01, 0.28396E+01, 0.28544E+01,
- & 0.28690E+01, 0.28836E+01, 0.28980E+01, 0.29122E+01, 0.29263E+01,
- & 0.29403E+01, 0.29542E+01, 0.29680E+01, 0.29816E+01, 0.29951E+01,
- & 0.30085E+01, 0.30217E+01, 0.30349E+01, 0.30479E+01, 0.30609E+01,
- & 0.30737E+01, 0.30864E+01, 0.30990E+01, 0.31115E+01, 0.31239E+01,
- & 0.31362E+01, 0.31483E+01, 0.31604E+01, 0.31724E+01, 0.31843E+01,
- & 0.31961E+01, 0.32078E+01, 0.32194E+01, 0.32309E+01, 0.32423E+01,
- & 0.32536E+01, 0.32648E+01, 0.32760E+01, 0.32870E+01, 0.32980E+01,
- & 0.33089E+01, 0.33197E+01, 0.33304E+01, 0.33411E+01, 0.33516E+01,
- & 0.33621E+01, 0.33725E+01, 0.33828E+01, 0.33931E+01, 0.34032E+01,
- & 0.34133E+01, 0.34233E+01, 0.34333E+01, 0.34431E+01, 0.34529E+01,
- & 0.34627E+01, 0.34723E+01, 0.34819E+01, 0.34914E+01, 0.35009E+01/
-
- DATA (BNC12M(I),I=701,741)/
- & 0.35103E+01, 0.35196E+01, 0.35288E+01, 0.35380E+01, 0.35471E+01,
- & 0.35562E+01, 0.35652E+01, 0.35741E+01, 0.35830E+01, 0.35918E+01,
- & 0.36005E+01, 0.36092E+01, 0.36178E+01, 0.36264E+01, 0.36349E+01,
- & 0.36434E+01, 0.36518E+01, 0.36601E+01, 0.36684E+01, 0.36766E+01,
- & 0.36848E+01, 0.36929E+01, 0.37010E+01, 0.37090E+01, 0.37169E+01,
- & 0.37248E+01, 0.37327E+01, 0.37405E+01, 0.37483E+01, 0.37560E+01,
- & 0.37636E+01, 0.37712E+01, 0.37788E+01, 0.37863E+01, 0.37938E+01,
- & 0.38012E+01, 0.38085E+01, 0.38159E+01, 0.38231E+01, 0.38304E+01,
- & 0.38376E+01
- & /
-C
-C *** (NH4)3H(SO4)2
-C
- DATA (BNC13M(I),I=1,100)/
- &-0.78016E-01,-0.16930E+00,-0.21481E+00,-0.24696E+00,-0.27216E+00,
- &-0.29302E+00,-0.31087E+00,-0.32649E+00,-0.34040E+00,-0.35293E+00,
- &-0.36434E+00,-0.37481E+00,-0.38448E+00,-0.39347E+00,-0.40186E+00,
- &-0.40972E+00,-0.41711E+00,-0.42408E+00,-0.43067E+00,-0.43692E+00,
- &-0.44285E+00,-0.44850E+00,-0.45388E+00,-0.45901E+00,-0.46392E+00,
- &-0.46861E+00,-0.47311E+00,-0.47741E+00,-0.48155E+00,-0.48551E+00,
- &-0.48933E+00,-0.49299E+00,-0.49651E+00,-0.49991E+00,-0.50317E+00,
- &-0.50632E+00,-0.50935E+00,-0.51227E+00,-0.51508E+00,-0.51780E+00,
- &-0.52042E+00,-0.52294E+00,-0.52538E+00,-0.52774E+00,-0.53001E+00,
- &-0.53221E+00,-0.53432E+00,-0.53637E+00,-0.53835E+00,-0.54026E+00,
- &-0.54210E+00,-0.54389E+00,-0.54561E+00,-0.54727E+00,-0.54888E+00,
- &-0.55044E+00,-0.55194E+00,-0.55339E+00,-0.55479E+00,-0.55615E+00,
- &-0.55746E+00,-0.55872E+00,-0.55994E+00,-0.56113E+00,-0.56227E+00,
- &-0.56337E+00,-0.56443E+00,-0.56546E+00,-0.56645E+00,-0.56741E+00,
- &-0.56833E+00,-0.56922E+00,-0.57008E+00,-0.57090E+00,-0.57170E+00,
- &-0.57246E+00,-0.57320E+00,-0.57391E+00,-0.57459E+00,-0.57524E+00,
- &-0.57587E+00,-0.57647E+00,-0.57704E+00,-0.57759E+00,-0.57812E+00,
- &-0.57862E+00,-0.57910E+00,-0.57955E+00,-0.57999E+00,-0.58040E+00,
- &-0.58078E+00,-0.58115E+00,-0.58150E+00,-0.58183E+00,-0.58214E+00,
- &-0.58243E+00,-0.58270E+00,-0.58295E+00,-0.58318E+00,-0.58340E+00/
-
- DATA (BNC13M(I),I=101,200)/
- &-0.58360E+00,-0.58379E+00,-0.58396E+00,-0.58411E+00,-0.58425E+00,
- &-0.58438E+00,-0.58449E+00,-0.58459E+00,-0.58467E+00,-0.58475E+00,
- &-0.58481E+00,-0.58486E+00,-0.58490E+00,-0.58493E+00,-0.58495E+00,
- &-0.58495E+00,-0.58495E+00,-0.58495E+00,-0.58493E+00,-0.58490E+00,
- &-0.58487E+00,-0.58483E+00,-0.58478E+00,-0.58473E+00,-0.58467E+00,
- &-0.58460E+00,-0.58452E+00,-0.58445E+00,-0.58436E+00,-0.58427E+00,
- &-0.58418E+00,-0.58408E+00,-0.58397E+00,-0.58386E+00,-0.58375E+00,
- &-0.58363E+00,-0.58351E+00,-0.58339E+00,-0.58326E+00,-0.58313E+00,
- &-0.58300E+00,-0.58286E+00,-0.58272E+00,-0.58258E+00,-0.58243E+00,
- &-0.58228E+00,-0.58213E+00,-0.58198E+00,-0.58183E+00,-0.58167E+00,
- &-0.58151E+00,-0.58135E+00,-0.58119E+00,-0.58102E+00,-0.58086E+00,
- &-0.58069E+00,-0.58052E+00,-0.58035E+00,-0.58018E+00,-0.58001E+00,
- &-0.57983E+00,-0.57966E+00,-0.57948E+00,-0.57930E+00,-0.57912E+00,
- &-0.57894E+00,-0.57876E+00,-0.57858E+00,-0.57840E+00,-0.57822E+00,
- &-0.57803E+00,-0.57785E+00,-0.57766E+00,-0.57748E+00,-0.57729E+00,
- &-0.57711E+00,-0.57692E+00,-0.57673E+00,-0.57655E+00,-0.57636E+00,
- &-0.57617E+00,-0.57598E+00,-0.57579E+00,-0.57561E+00,-0.57542E+00,
- &-0.57523E+00,-0.57504E+00,-0.57485E+00,-0.57466E+00,-0.57447E+00,
- &-0.57428E+00,-0.57409E+00,-0.57390E+00,-0.57372E+00,-0.57353E+00,
- &-0.57334E+00,-0.57315E+00,-0.57296E+00,-0.57277E+00,-0.57258E+00/
-
- DATA (BNC13M(I),I=201,300)/
- &-0.57240E+00,-0.57221E+00,-0.57202E+00,-0.57183E+00,-0.57165E+00,
- &-0.57146E+00,-0.57127E+00,-0.57109E+00,-0.57090E+00,-0.57072E+00,
- &-0.57053E+00,-0.57035E+00,-0.57016E+00,-0.56998E+00,-0.56980E+00,
- &-0.56961E+00,-0.56943E+00,-0.56925E+00,-0.56907E+00,-0.56888E+00,
- &-0.56870E+00,-0.56852E+00,-0.56834E+00,-0.56816E+00,-0.56798E+00,
- &-0.56781E+00,-0.56763E+00,-0.56745E+00,-0.56727E+00,-0.56710E+00,
- &-0.56692E+00,-0.56675E+00,-0.56657E+00,-0.56640E+00,-0.56623E+00,
- &-0.56605E+00,-0.56588E+00,-0.56571E+00,-0.56554E+00,-0.56537E+00,
- &-0.56520E+00,-0.56503E+00,-0.56486E+00,-0.56469E+00,-0.56452E+00,
- &-0.56436E+00,-0.56419E+00,-0.56402E+00,-0.56386E+00,-0.56370E+00,
- &-0.56353E+00,-0.56337E+00,-0.56321E+00,-0.56304E+00,-0.56288E+00,
- &-0.56272E+00,-0.56256E+00,-0.56240E+00,-0.56225E+00,-0.56209E+00,
- &-0.56193E+00,-0.56178E+00,-0.56162E+00,-0.56146E+00,-0.56131E+00,
- &-0.56116E+00,-0.56100E+00,-0.56085E+00,-0.56070E+00,-0.56055E+00,
- &-0.56040E+00,-0.56025E+00,-0.56010E+00,-0.55995E+00,-0.55980E+00,
- &-0.55966E+00,-0.55951E+00,-0.55937E+00,-0.55922E+00,-0.55908E+00,
- &-0.55893E+00,-0.55879E+00,-0.55865E+00,-0.55851E+00,-0.55837E+00,
- &-0.55823E+00,-0.55809E+00,-0.55795E+00,-0.55781E+00,-0.55768E+00,
- &-0.55754E+00,-0.55740E+00,-0.55727E+00,-0.55714E+00,-0.55700E+00,
- &-0.55687E+00,-0.55674E+00,-0.55661E+00,-0.55648E+00,-0.55635E+00/
-
- DATA (BNC13M(I),I=301,400)/
- &-0.55622E+00,-0.55609E+00,-0.55596E+00,-0.55583E+00,-0.55571E+00,
- &-0.55558E+00,-0.55546E+00,-0.55533E+00,-0.55521E+00,-0.55509E+00,
- &-0.55496E+00,-0.55484E+00,-0.55472E+00,-0.55460E+00,-0.55448E+00,
- &-0.55436E+00,-0.55425E+00,-0.55413E+00,-0.55401E+00,-0.55390E+00,
- &-0.55378E+00,-0.55367E+00,-0.55355E+00,-0.55344E+00,-0.55333E+00,
- &-0.55322E+00,-0.55311E+00,-0.55300E+00,-0.55289E+00,-0.55278E+00,
- &-0.55267E+00,-0.55256E+00,-0.55246E+00,-0.55235E+00,-0.55224E+00,
- &-0.55214E+00,-0.55204E+00,-0.55193E+00,-0.55183E+00,-0.55173E+00,
- &-0.55163E+00,-0.55153E+00,-0.55143E+00,-0.55133E+00,-0.55123E+00,
- &-0.55113E+00,-0.55103E+00,-0.55094E+00,-0.55084E+00,-0.55075E+00,
- &-0.55065E+00,-0.55056E+00,-0.55047E+00,-0.55037E+00,-0.55028E+00,
- &-0.55019E+00,-0.55010E+00,-0.55001E+00,-0.54992E+00,-0.54983E+00,
- &-0.54975E+00,-0.54966E+00,-0.54957E+00,-0.54949E+00,-0.54940E+00,
- &-0.54932E+00,-0.54924E+00,-0.54915E+00,-0.54907E+00,-0.54899E+00,
- &-0.54891E+00,-0.54883E+00,-0.54875E+00,-0.54867E+00,-0.54859E+00,
- &-0.54851E+00,-0.54844E+00,-0.54836E+00,-0.54828E+00,-0.54821E+00,
- &-0.54813E+00,-0.54806E+00,-0.54799E+00,-0.54792E+00,-0.54784E+00,
- &-0.54777E+00,-0.54770E+00,-0.54763E+00,-0.54756E+00,-0.54749E+00,
- &-0.54743E+00,-0.54736E+00,-0.54729E+00,-0.54723E+00,-0.54716E+00,
- &-0.54710E+00,-0.54703E+00,-0.54697E+00,-0.54691E+00,-0.54684E+00/
-
- DATA (BNC13M(I),I=401,500)/
- &-0.54678E+00,-0.54672E+00,-0.54666E+00,-0.54660E+00,-0.54654E+00,
- &-0.54648E+00,-0.54643E+00,-0.54637E+00,-0.54631E+00,-0.54626E+00,
- &-0.54620E+00,-0.54615E+00,-0.54609E+00,-0.54604E+00,-0.54599E+00,
- &-0.54593E+00,-0.54588E+00,-0.54583E+00,-0.54578E+00,-0.54573E+00,
- &-0.54568E+00,-0.54563E+00,-0.54558E+00,-0.54554E+00,-0.54549E+00,
- &-0.54544E+00,-0.54540E+00,-0.54535E+00,-0.54531E+00,-0.54527E+00,
- &-0.54522E+00,-0.54518E+00,-0.54514E+00,-0.54510E+00,-0.54506E+00,
- &-0.54502E+00,-0.54498E+00,-0.54494E+00,-0.54490E+00,-0.54486E+00,
- &-0.54482E+00,-0.54479E+00,-0.54475E+00,-0.54471E+00,-0.54468E+00,
- &-0.54465E+00,-0.54461E+00,-0.54458E+00,-0.54455E+00,-0.54451E+00,
- &-0.54448E+00,-0.54445E+00,-0.54442E+00,-0.54439E+00,-0.54436E+00,
- &-0.54433E+00,-0.54430E+00,-0.54428E+00,-0.54425E+00,-0.54422E+00,
- &-0.54420E+00,-0.54417E+00,-0.54415E+00,-0.54412E+00,-0.54410E+00,
- &-0.54408E+00,-0.54405E+00,-0.54403E+00,-0.54401E+00,-0.54399E+00,
- &-0.54397E+00,-0.54395E+00,-0.54393E+00,-0.54391E+00,-0.54389E+00,
- &-0.54388E+00,-0.54386E+00,-0.54384E+00,-0.54383E+00,-0.54381E+00,
- &-0.54380E+00,-0.54378E+00,-0.54377E+00,-0.54376E+00,-0.54374E+00,
- &-0.54373E+00,-0.54372E+00,-0.54371E+00,-0.54370E+00,-0.54369E+00,
- &-0.54368E+00,-0.54367E+00,-0.54366E+00,-0.54365E+00,-0.54365E+00,
- &-0.54364E+00,-0.54363E+00,-0.54363E+00,-0.54362E+00,-0.54362E+00/
-
- DATA (BNC13M(I),I=501,600)/
- &-0.54361E+00,-0.54361E+00,-0.54361E+00,-0.54361E+00,-0.54360E+00,
- &-0.54360E+00,-0.54360E+00,-0.54360E+00,-0.54360E+00,-0.54360E+00,
- &-0.54360E+00,-0.54360E+00,-0.54361E+00,-0.54361E+00,-0.54361E+00,
- &-0.54361E+00,-0.54362E+00,-0.54362E+00,-0.54363E+00,-0.54363E+00,
- &-0.54364E+00,-0.54365E+00,-0.54365E+00,-0.54366E+00,-0.54367E+00,
- &-0.54368E+00,-0.54369E+00,-0.54370E+00,-0.54371E+00,-0.54372E+00,
- &-0.54373E+00,-0.54374E+00,-0.54375E+00,-0.54376E+00,-0.54378E+00,
- &-0.54379E+00,-0.54380E+00,-0.54382E+00,-0.54383E+00,-0.54385E+00,
- &-0.54387E+00,-0.54388E+00,-0.54390E+00,-0.54392E+00,-0.54393E+00,
- &-0.54395E+00,-0.54397E+00,-0.54399E+00,-0.54401E+00,-0.54403E+00,
- &-0.54405E+00,-0.54407E+00,-0.54409E+00,-0.54412E+00,-0.54414E+00,
- &-0.54416E+00,-0.54418E+00,-0.54421E+00,-0.54423E+00,-0.54426E+00,
- &-0.54428E+00,-0.54431E+00,-0.54434E+00,-0.54436E+00,-0.54439E+00,
- &-0.54442E+00,-0.54445E+00,-0.54447E+00,-0.54450E+00,-0.54453E+00,
- &-0.54456E+00,-0.54459E+00,-0.54462E+00,-0.54466E+00,-0.54469E+00,
- &-0.54472E+00,-0.54475E+00,-0.54479E+00,-0.54482E+00,-0.54485E+00,
- &-0.54489E+00,-0.54492E+00,-0.54496E+00,-0.54499E+00,-0.54503E+00,
- &-0.54507E+00,-0.54510E+00,-0.54514E+00,-0.54518E+00,-0.54522E+00,
- &-0.54526E+00,-0.54530E+00,-0.54534E+00,-0.54538E+00,-0.54542E+00,
- &-0.54546E+00,-0.54550E+00,-0.54554E+00,-0.54558E+00,-0.54563E+00/
-
- DATA (BNC13M(I),I=601,700)/
- &-0.54612E+00,-0.54661E+00,-0.54715E+00,-0.54773E+00,-0.54835E+00,
- &-0.54901E+00,-0.54971E+00,-0.55044E+00,-0.55121E+00,-0.55202E+00,
- &-0.55287E+00,-0.55374E+00,-0.55466E+00,-0.55560E+00,-0.55658E+00,
- &-0.55760E+00,-0.55864E+00,-0.55972E+00,-0.56083E+00,-0.56196E+00,
- &-0.56313E+00,-0.56433E+00,-0.56556E+00,-0.56681E+00,-0.56809E+00,
- &-0.56940E+00,-0.57074E+00,-0.57210E+00,-0.57349E+00,-0.57491E+00,
- &-0.57635E+00,-0.57782E+00,-0.57931E+00,-0.58082E+00,-0.58236E+00,
- &-0.58392E+00,-0.58551E+00,-0.58712E+00,-0.58875E+00,-0.59040E+00,
- &-0.59207E+00,-0.59377E+00,-0.59549E+00,-0.59722E+00,-0.59898E+00,
- &-0.60076E+00,-0.60256E+00,-0.60438E+00,-0.60621E+00,-0.60807E+00,
- &-0.60994E+00,-0.61183E+00,-0.61375E+00,-0.61567E+00,-0.61762E+00,
- &-0.61959E+00,-0.62157E+00,-0.62357E+00,-0.62558E+00,-0.62761E+00,
- &-0.62966E+00,-0.63173E+00,-0.63381E+00,-0.63590E+00,-0.63801E+00,
- &-0.64014E+00,-0.64228E+00,-0.64444E+00,-0.64661E+00,-0.64879E+00,
- &-0.65099E+00,-0.65321E+00,-0.65544E+00,-0.65768E+00,-0.65993E+00,
- &-0.66220E+00,-0.66448E+00,-0.66678E+00,-0.66909E+00,-0.67141E+00,
- &-0.67374E+00,-0.67609E+00,-0.67845E+00,-0.68082E+00,-0.68320E+00,
- &-0.68559E+00,-0.68800E+00,-0.69042E+00,-0.69285E+00,-0.69529E+00,
- &-0.69774E+00,-0.70021E+00,-0.70268E+00,-0.70516E+00,-0.70766E+00,
- &-0.71017E+00,-0.71268E+00,-0.71521E+00,-0.71775E+00,-0.72030E+00/
-
- DATA (BNC13M(I),I=701,741)/
- &-0.72285E+00,-0.72542E+00,-0.72800E+00,-0.73059E+00,-0.73318E+00,
- &-0.73579E+00,-0.73840E+00,-0.74103E+00,-0.74366E+00,-0.74631E+00,
- &-0.74896E+00,-0.75162E+00,-0.75429E+00,-0.75697E+00,-0.75965E+00,
- &-0.76235E+00,-0.76505E+00,-0.76777E+00,-0.77049E+00,-0.77322E+00,
- &-0.77595E+00,-0.77870E+00,-0.78145E+00,-0.78421E+00,-0.78698E+00,
- &-0.78976E+00,-0.79254E+00,-0.79534E+00,-0.79814E+00,-0.80094E+00,
- &-0.80376E+00,-0.80658E+00,-0.80941E+00,-0.81224E+00,-0.81509E+00,
- &-0.81794E+00,-0.82079E+00,-0.82366E+00,-0.82653E+00,-0.82940E+00,
- &-0.83229E+00
- & /
- END
-
-
diff --git a/src/MNH/data_kmcf273a.f b/src/MNH/data_kmcf273a.f
deleted file mode 100644
index 5e815a3e823d1fa027e85d4a6026557ed6ed9bad..0000000000000000000000000000000000000000
--- a/src/MNH/data_kmcf273a.f
+++ /dev/null
@@ -1,2217 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 data_kmcf273a.f 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-C=======================================================================
-C
-C *** ISORROPIA CODE
-C *** BLOCK DATA KMCF273A
-C *** CONTAINS THE DATA FOR KUSSIK-MEISNER BINARY COEFFICIENT ARRAYS
-C NEEDED IN SUBROUTINE KM
-C
-C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
-C *** WRITTEN BY ATHANASIOS NENES
-C
-C=======================================================================
-C
- BLOCK DATA KMCF273
-C
-C *** Common block definition
-C
- COMMON /KMC273/
- &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741),
- &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741),
- &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741),
- &BNC13M( 741)
-C
-C *** NaCl
-C
- DATA (BNC01M(I),I=1,100)/
- &-0.46407E-01,-0.96708E-01,-0.11948E+00,-0.13432E+00,-0.14508E+00,
- &-0.15330E+00,-0.15979E+00,-0.16500E+00,-0.16923E+00,-0.17269E+00,
- &-0.17553E+00,-0.17785E+00,-0.17973E+00,-0.18124E+00,-0.18244E+00,
- &-0.18336E+00,-0.18404E+00,-0.18450E+00,-0.18477E+00,-0.18488E+00,
- &-0.18483E+00,-0.18465E+00,-0.18435E+00,-0.18393E+00,-0.18342E+00,
- &-0.18282E+00,-0.18213E+00,-0.18137E+00,-0.18054E+00,-0.17965E+00,
- &-0.17870E+00,-0.17770E+00,-0.17665E+00,-0.17556E+00,-0.17443E+00,
- &-0.17327E+00,-0.17207E+00,-0.17084E+00,-0.16958E+00,-0.16830E+00,
- &-0.16700E+00,-0.16568E+00,-0.16434E+00,-0.16298E+00,-0.16161E+00,
- &-0.16022E+00,-0.15882E+00,-0.15741E+00,-0.15599E+00,-0.15455E+00,
- &-0.15311E+00,-0.15166E+00,-0.15021E+00,-0.14875E+00,-0.14728E+00,
- &-0.14580E+00,-0.14432E+00,-0.14283E+00,-0.14134E+00,-0.13984E+00,
- &-0.13833E+00,-0.13682E+00,-0.13530E+00,-0.13378E+00,-0.13224E+00,
- &-0.13071E+00,-0.12916E+00,-0.12761E+00,-0.12605E+00,-0.12448E+00,
- &-0.12290E+00,-0.12131E+00,-0.11971E+00,-0.11810E+00,-0.11649E+00,
- &-0.11486E+00,-0.11322E+00,-0.11156E+00,-0.10990E+00,-0.10822E+00,
- &-0.10653E+00,-0.10483E+00,-0.10311E+00,-0.10138E+00,-0.99639E-01,
- &-0.97882E-01,-0.96110E-01,-0.94324E-01,-0.92525E-01,-0.90711E-01,
- &-0.88883E-01,-0.87042E-01,-0.85186E-01,-0.83317E-01,-0.81435E-01,
- &-0.79539E-01,-0.77630E-01,-0.75709E-01,-0.73776E-01,-0.71830E-01/
-
- DATA (BNC01M(I),I=101,200)/
- &-0.69873E-01,-0.67905E-01,-0.65926E-01,-0.63937E-01,-0.61937E-01,
- &-0.59929E-01,-0.57911E-01,-0.55885E-01,-0.53851E-01,-0.51809E-01,
- &-0.49760E-01,-0.47705E-01,-0.45643E-01,-0.43575E-01,-0.41502E-01,
- &-0.39424E-01,-0.37342E-01,-0.35255E-01,-0.33165E-01,-0.31071E-01,
- &-0.28975E-01,-0.26875E-01,-0.24774E-01,-0.22670E-01,-0.20565E-01,
- &-0.18458E-01,-0.16350E-01,-0.14240E-01,-0.12131E-01,-0.10020E-01,
- &-0.79100E-02,-0.57993E-02,-0.36888E-02,-0.15785E-02, 0.53139E-03,
- & 0.26407E-02, 0.47494E-02, 0.68572E-02, 0.89641E-02, 0.11070E-01,
- & 0.13175E-01, 0.15278E-01, 0.17380E-01, 0.19481E-01, 0.21580E-01,
- & 0.23678E-01, 0.25774E-01, 0.27869E-01, 0.29962E-01, 0.32052E-01,
- & 0.34142E-01, 0.36229E-01, 0.38314E-01, 0.40398E-01, 0.42479E-01,
- & 0.44558E-01, 0.46636E-01, 0.48711E-01, 0.50784E-01, 0.52855E-01,
- & 0.54924E-01, 0.56990E-01, 0.59054E-01, 0.61116E-01, 0.63176E-01,
- & 0.65233E-01, 0.67288E-01, 0.69341E-01, 0.71391E-01, 0.73439E-01,
- & 0.75485E-01, 0.77528E-01, 0.79569E-01, 0.81607E-01, 0.83642E-01,
- & 0.85675E-01, 0.87706E-01, 0.89734E-01, 0.91760E-01, 0.93783E-01,
- & 0.95803E-01, 0.97821E-01, 0.99836E-01, 0.10185E+00, 0.10386E+00,
- & 0.10587E+00, 0.10787E+00, 0.10987E+00, 0.11187E+00, 0.11387E+00,
- & 0.11586E+00, 0.11785E+00, 0.11984E+00, 0.12183E+00, 0.12381E+00,
- & 0.12579E+00, 0.12777E+00, 0.12974E+00, 0.13172E+00, 0.13369E+00/
-
- DATA (BNC01M(I),I=201,300)/
- & 0.13565E+00, 0.13762E+00, 0.13958E+00, 0.14154E+00, 0.14349E+00,
- & 0.14544E+00, 0.14739E+00, 0.14934E+00, 0.15129E+00, 0.15323E+00,
- & 0.15517E+00, 0.15710E+00, 0.15904E+00, 0.16097E+00, 0.16289E+00,
- & 0.16482E+00, 0.16674E+00, 0.16866E+00, 0.17057E+00, 0.17249E+00,
- & 0.17440E+00, 0.17631E+00, 0.17821E+00, 0.18011E+00, 0.18201E+00,
- & 0.18391E+00, 0.18580E+00, 0.18769E+00, 0.18958E+00, 0.19146E+00,
- & 0.19334E+00, 0.19522E+00, 0.19710E+00, 0.19897E+00, 0.20084E+00,
- & 0.20271E+00, 0.20458E+00, 0.20644E+00, 0.20830E+00, 0.21015E+00,
- & 0.21201E+00, 0.21386E+00, 0.21570E+00, 0.21755E+00, 0.21939E+00,
- & 0.22123E+00, 0.22307E+00, 0.22490E+00, 0.22673E+00, 0.22856E+00,
- & 0.23038E+00, 0.23221E+00, 0.23403E+00, 0.23584E+00, 0.23766E+00,
- & 0.23947E+00, 0.24127E+00, 0.24308E+00, 0.24488E+00, 0.24668E+00,
- & 0.24848E+00, 0.25027E+00, 0.25206E+00, 0.25385E+00, 0.25564E+00,
- & 0.25742E+00, 0.25920E+00, 0.26098E+00, 0.26275E+00, 0.26452E+00,
- & 0.26629E+00, 0.26806E+00, 0.26982E+00, 0.27158E+00, 0.27334E+00,
- & 0.27509E+00, 0.27684E+00, 0.27859E+00, 0.28034E+00, 0.28208E+00,
- & 0.28383E+00, 0.28556E+00, 0.28730E+00, 0.28903E+00, 0.29076E+00,
- & 0.29249E+00, 0.29422E+00, 0.29594E+00, 0.29766E+00, 0.29937E+00,
- & 0.30109E+00, 0.30280E+00, 0.30451E+00, 0.30621E+00, 0.30792E+00,
- & 0.30962E+00, 0.31131E+00, 0.31301E+00, 0.31470E+00, 0.31639E+00/
-
- DATA (BNC01M(I),I=301,400)/
- & 0.31808E+00, 0.31976E+00, 0.32144E+00, 0.32312E+00, 0.32480E+00,
- & 0.32647E+00, 0.32815E+00, 0.32981E+00, 0.33148E+00, 0.33314E+00,
- & 0.33480E+00, 0.33646E+00, 0.33812E+00, 0.33977E+00, 0.34142E+00,
- & 0.34307E+00, 0.34471E+00, 0.34636E+00, 0.34800E+00, 0.34963E+00,
- & 0.35127E+00, 0.35290E+00, 0.35453E+00, 0.35616E+00, 0.35778E+00,
- & 0.35940E+00, 0.36102E+00, 0.36264E+00, 0.36426E+00, 0.36587E+00,
- & 0.36748E+00, 0.36908E+00, 0.37069E+00, 0.37229E+00, 0.37389E+00,
- & 0.37549E+00, 0.37708E+00, 0.37867E+00, 0.38026E+00, 0.38185E+00,
- & 0.38343E+00, 0.38502E+00, 0.38659E+00, 0.38817E+00, 0.38975E+00,
- & 0.39132E+00, 0.39289E+00, 0.39446E+00, 0.39602E+00, 0.39758E+00,
- & 0.39914E+00, 0.40070E+00, 0.40226E+00, 0.40381E+00, 0.40536E+00,
- & 0.40691E+00, 0.40845E+00, 0.41000E+00, 0.41154E+00, 0.41308E+00,
- & 0.41461E+00, 0.41615E+00, 0.41768E+00, 0.41921E+00, 0.42073E+00,
- & 0.42226E+00, 0.42378E+00, 0.42530E+00, 0.42682E+00, 0.42833E+00,
- & 0.42985E+00, 0.43136E+00, 0.43286E+00, 0.43437E+00, 0.43587E+00,
- & 0.43737E+00, 0.43887E+00, 0.44037E+00, 0.44187E+00, 0.44336E+00,
- & 0.44485E+00, 0.44633E+00, 0.44782E+00, 0.44930E+00, 0.45078E+00,
- & 0.45226E+00, 0.45374E+00, 0.45521E+00, 0.45669E+00, 0.45815E+00,
- & 0.45962E+00, 0.46109E+00, 0.46255E+00, 0.46401E+00, 0.46547E+00,
- & 0.46693E+00, 0.46838E+00, 0.46983E+00, 0.47128E+00, 0.47273E+00/
-
- DATA (BNC01M(I),I=401,500)/
- & 0.47418E+00, 0.47562E+00, 0.47706E+00, 0.47850E+00, 0.47994E+00,
- & 0.48137E+00, 0.48280E+00, 0.48423E+00, 0.48566E+00, 0.48709E+00,
- & 0.48851E+00, 0.48993E+00, 0.49135E+00, 0.49277E+00, 0.49419E+00,
- & 0.49560E+00, 0.49701E+00, 0.49842E+00, 0.49983E+00, 0.50123E+00,
- & 0.50264E+00, 0.50404E+00, 0.50544E+00, 0.50683E+00, 0.50823E+00,
- & 0.50962E+00, 0.51101E+00, 0.51240E+00, 0.51379E+00, 0.51517E+00,
- & 0.51656E+00, 0.51794E+00, 0.51931E+00, 0.52069E+00, 0.52207E+00,
- & 0.52344E+00, 0.52481E+00, 0.52618E+00, 0.52754E+00, 0.52891E+00,
- & 0.53027E+00, 0.53163E+00, 0.53299E+00, 0.53435E+00, 0.53570E+00,
- & 0.53705E+00, 0.53840E+00, 0.53975E+00, 0.54110E+00, 0.54245E+00,
- & 0.54379E+00, 0.54513E+00, 0.54647E+00, 0.54781E+00, 0.54914E+00,
- & 0.55047E+00, 0.55180E+00, 0.55313E+00, 0.55446E+00, 0.55579E+00,
- & 0.55711E+00, 0.55843E+00, 0.55975E+00, 0.56107E+00, 0.56239E+00,
- & 0.56370E+00, 0.56501E+00, 0.56632E+00, 0.56763E+00, 0.56894E+00,
- & 0.57025E+00, 0.57155E+00, 0.57285E+00, 0.57415E+00, 0.57545E+00,
- & 0.57674E+00, 0.57804E+00, 0.57933E+00, 0.58062E+00, 0.58191E+00,
- & 0.58319E+00, 0.58448E+00, 0.58576E+00, 0.58704E+00, 0.58832E+00,
- & 0.58960E+00, 0.59088E+00, 0.59215E+00, 0.59342E+00, 0.59469E+00,
- & 0.59596E+00, 0.59723E+00, 0.59849E+00, 0.59976E+00, 0.60102E+00,
- & 0.60228E+00, 0.60354E+00, 0.60479E+00, 0.60605E+00, 0.60730E+00/
-
- DATA (BNC01M(I),I=501,600)/
- & 0.60855E+00, 0.60980E+00, 0.61105E+00, 0.61230E+00, 0.61354E+00,
- & 0.61478E+00, 0.61602E+00, 0.61726E+00, 0.61850E+00, 0.61974E+00,
- & 0.62097E+00, 0.62220E+00, 0.62343E+00, 0.62466E+00, 0.62589E+00,
- & 0.62711E+00, 0.62834E+00, 0.62956E+00, 0.63078E+00, 0.63200E+00,
- & 0.63322E+00, 0.63443E+00, 0.63565E+00, 0.63686E+00, 0.63807E+00,
- & 0.63928E+00, 0.64049E+00, 0.64169E+00, 0.64290E+00, 0.64410E+00,
- & 0.64530E+00, 0.64650E+00, 0.64770E+00, 0.64889E+00, 0.65009E+00,
- & 0.65128E+00, 0.65247E+00, 0.65366E+00, 0.65485E+00, 0.65603E+00,
- & 0.65722E+00, 0.65840E+00, 0.65958E+00, 0.66076E+00, 0.66194E+00,
- & 0.66312E+00, 0.66429E+00, 0.66547E+00, 0.66664E+00, 0.66781E+00,
- & 0.66898E+00, 0.67015E+00, 0.67131E+00, 0.67248E+00, 0.67364E+00,
- & 0.67480E+00, 0.67596E+00, 0.67712E+00, 0.67828E+00, 0.67943E+00,
- & 0.68058E+00, 0.68174E+00, 0.68289E+00, 0.68404E+00, 0.68518E+00,
- & 0.68633E+00, 0.68748E+00, 0.68862E+00, 0.68976E+00, 0.69090E+00,
- & 0.69204E+00, 0.69318E+00, 0.69431E+00, 0.69545E+00, 0.69658E+00,
- & 0.69771E+00, 0.69884E+00, 0.69997E+00, 0.70109E+00, 0.70222E+00,
- & 0.70334E+00, 0.70447E+00, 0.70559E+00, 0.70671E+00, 0.70782E+00,
- & 0.70894E+00, 0.71006E+00, 0.71117E+00, 0.71228E+00, 0.71339E+00,
- & 0.71450E+00, 0.71561E+00, 0.71672E+00, 0.71782E+00, 0.71893E+00,
- & 0.72003E+00, 0.72113E+00, 0.72223E+00, 0.72333E+00, 0.72442E+00/
-
- DATA (BNC01M(I),I=601,700)/
- & 0.73618E+00, 0.74693E+00, 0.75754E+00, 0.76801E+00, 0.77836E+00,
- & 0.78859E+00, 0.79869E+00, 0.80867E+00, 0.81853E+00, 0.82827E+00,
- & 0.83790E+00, 0.84742E+00, 0.85683E+00, 0.86613E+00, 0.87532E+00,
- & 0.88441E+00, 0.89340E+00, 0.90229E+00, 0.91108E+00, 0.91978E+00,
- & 0.92838E+00, 0.93688E+00, 0.94530E+00, 0.95363E+00, 0.96187E+00,
- & 0.97002E+00, 0.97808E+00, 0.98607E+00, 0.99397E+00, 0.10018E+01,
- & 0.10095E+01, 0.10172E+01, 0.10248E+01, 0.10323E+01, 0.10397E+01,
- & 0.10471E+01, 0.10544E+01, 0.10616E+01, 0.10688E+01, 0.10758E+01,
- & 0.10828E+01, 0.10898E+01, 0.10967E+01, 0.11035E+01, 0.11102E+01,
- & 0.11169E+01, 0.11236E+01, 0.11301E+01, 0.11366E+01, 0.11431E+01,
- & 0.11495E+01, 0.11558E+01, 0.11621E+01, 0.11683E+01, 0.11745E+01,
- & 0.11806E+01, 0.11867E+01, 0.11927E+01, 0.11986E+01, 0.12045E+01,
- & 0.12104E+01, 0.12162E+01, 0.12220E+01, 0.12277E+01, 0.12333E+01,
- & 0.12389E+01, 0.12445E+01, 0.12500E+01, 0.12555E+01, 0.12609E+01,
- & 0.12663E+01, 0.12717E+01, 0.12770E+01, 0.12822E+01, 0.12874E+01,
- & 0.12926E+01, 0.12977E+01, 0.13028E+01, 0.13079E+01, 0.13129E+01,
- & 0.13179E+01, 0.13228E+01, 0.13277E+01, 0.13325E+01, 0.13374E+01,
- & 0.13421E+01, 0.13469E+01, 0.13516E+01, 0.13563E+01, 0.13609E+01,
- & 0.13655E+01, 0.13701E+01, 0.13746E+01, 0.13792E+01, 0.13836E+01,
- & 0.13881E+01, 0.13925E+01, 0.13968E+01, 0.14012E+01, 0.14055E+01/
-
- DATA (BNC01M(I),I=701,741)/
- & 0.14098E+01, 0.14140E+01, 0.14183E+01, 0.14224E+01, 0.14266E+01,
- & 0.14307E+01, 0.14348E+01, 0.14389E+01, 0.14430E+01, 0.14470E+01,
- & 0.14510E+01, 0.14549E+01, 0.14589E+01, 0.14628E+01, 0.14666E+01,
- & 0.14705E+01, 0.14743E+01, 0.14781E+01, 0.14819E+01, 0.14856E+01,
- & 0.14894E+01, 0.14931E+01, 0.14967E+01, 0.15004E+01, 0.15040E+01,
- & 0.15076E+01, 0.15112E+01, 0.15147E+01, 0.15183E+01, 0.15218E+01,
- & 0.15253E+01, 0.15287E+01, 0.15322E+01, 0.15356E+01, 0.15390E+01,
- & 0.15424E+01, 0.15457E+01, 0.15490E+01, 0.15524E+01, 0.15556E+01,
- & 0.15589E+01
- & /
-C
-C *** Na2SO4
-C
- DATA (BNC02M(I),I=1,100)/
- &-0.95525E-01,-0.20796E+00,-0.26423E+00,-0.30406E+00,-0.33534E+00,
- &-0.36126E+00,-0.38348E+00,-0.40297E+00,-0.42035E+00,-0.43605E+00,
- &-0.45039E+00,-0.46358E+00,-0.47581E+00,-0.48722E+00,-0.49790E+00,
- &-0.50796E+00,-0.51746E+00,-0.52646E+00,-0.53502E+00,-0.54318E+00,
- &-0.55098E+00,-0.55845E+00,-0.56561E+00,-0.57250E+00,-0.57913E+00,
- &-0.58552E+00,-0.59170E+00,-0.59767E+00,-0.60345E+00,-0.60905E+00,
- &-0.61449E+00,-0.61976E+00,-0.62489E+00,-0.62989E+00,-0.63474E+00,
- &-0.63948E+00,-0.64410E+00,-0.64860E+00,-0.65300E+00,-0.65729E+00,
- &-0.66149E+00,-0.66560E+00,-0.66962E+00,-0.67356E+00,-0.67741E+00,
- &-0.68119E+00,-0.68489E+00,-0.68852E+00,-0.69209E+00,-0.69559E+00,
- &-0.69902E+00,-0.70240E+00,-0.70571E+00,-0.70897E+00,-0.71218E+00,
- &-0.71534E+00,-0.71844E+00,-0.72149E+00,-0.72450E+00,-0.72747E+00,
- &-0.73039E+00,-0.73327E+00,-0.73610E+00,-0.73890E+00,-0.74166E+00,
- &-0.74438E+00,-0.74707E+00,-0.74973E+00,-0.75235E+00,-0.75493E+00,
- &-0.75749E+00,-0.76002E+00,-0.76252E+00,-0.76499E+00,-0.76743E+00,
- &-0.76985E+00,-0.77224E+00,-0.77461E+00,-0.77695E+00,-0.77927E+00,
- &-0.78156E+00,-0.78384E+00,-0.78609E+00,-0.78833E+00,-0.79054E+00,
- &-0.79273E+00,-0.79491E+00,-0.79706E+00,-0.79920E+00,-0.80132E+00,
- &-0.80342E+00,-0.80551E+00,-0.80758E+00,-0.80963E+00,-0.81167E+00,
- &-0.81370E+00,-0.81570E+00,-0.81770E+00,-0.81968E+00,-0.82164E+00/
-
- DATA (BNC02M(I),I=101,200)/
- &-0.82360E+00,-0.82553E+00,-0.82746E+00,-0.82937E+00,-0.83127E+00,
- &-0.83316E+00,-0.83503E+00,-0.83689E+00,-0.83874E+00,-0.84058E+00,
- &-0.84241E+00,-0.84422E+00,-0.84602E+00,-0.84782E+00,-0.84960E+00,
- &-0.85137E+00,-0.85312E+00,-0.85487E+00,-0.85661E+00,-0.85834E+00,
- &-0.86005E+00,-0.86176E+00,-0.86346E+00,-0.86514E+00,-0.86682E+00,
- &-0.86849E+00,-0.87015E+00,-0.87180E+00,-0.87343E+00,-0.87506E+00,
- &-0.87668E+00,-0.87830E+00,-0.87990E+00,-0.88149E+00,-0.88308E+00,
- &-0.88466E+00,-0.88622E+00,-0.88779E+00,-0.88934E+00,-0.89088E+00,
- &-0.89242E+00,-0.89395E+00,-0.89547E+00,-0.89698E+00,-0.89848E+00,
- &-0.89998E+00,-0.90147E+00,-0.90295E+00,-0.90443E+00,-0.90590E+00,
- &-0.90736E+00,-0.90881E+00,-0.91026E+00,-0.91170E+00,-0.91313E+00,
- &-0.91456E+00,-0.91598E+00,-0.91740E+00,-0.91880E+00,-0.92020E+00,
- &-0.92160E+00,-0.92299E+00,-0.92437E+00,-0.92575E+00,-0.92712E+00,
- &-0.92848E+00,-0.92984E+00,-0.93120E+00,-0.93254E+00,-0.93389E+00,
- &-0.93522E+00,-0.93655E+00,-0.93788E+00,-0.93920E+00,-0.94052E+00,
- &-0.94182E+00,-0.94313E+00,-0.94443E+00,-0.94572E+00,-0.94701E+00,
- &-0.94830E+00,-0.94958E+00,-0.95085E+00,-0.95212E+00,-0.95338E+00,
- &-0.95464E+00,-0.95590E+00,-0.95715E+00,-0.95840E+00,-0.95964E+00,
- &-0.96087E+00,-0.96211E+00,-0.96333E+00,-0.96456E+00,-0.96578E+00,
- &-0.96699E+00,-0.96820E+00,-0.96941E+00,-0.97061E+00,-0.97181E+00/
-
- DATA (BNC02M(I),I=201,300)/
- &-0.97300E+00,-0.97419E+00,-0.97538E+00,-0.97656E+00,-0.97774E+00,
- &-0.97892E+00,-0.98009E+00,-0.98125E+00,-0.98242E+00,-0.98358E+00,
- &-0.98473E+00,-0.98588E+00,-0.98703E+00,-0.98817E+00,-0.98932E+00,
- &-0.99045E+00,-0.99159E+00,-0.99272E+00,-0.99384E+00,-0.99497E+00,
- &-0.99609E+00,-0.99720E+00,-0.99832E+00,-0.99943E+00,-0.10005E+01,
- &-0.10016E+01,-0.10027E+01,-0.10038E+01,-0.10049E+01,-0.10060E+01,
- &-0.10071E+01,-0.10082E+01,-0.10093E+01,-0.10103E+01,-0.10114E+01,
- &-0.10125E+01,-0.10136E+01,-0.10146E+01,-0.10157E+01,-0.10168E+01,
- &-0.10178E+01,-0.10189E+01,-0.10199E+01,-0.10210E+01,-0.10220E+01,
- &-0.10231E+01,-0.10241E+01,-0.10251E+01,-0.10262E+01,-0.10272E+01,
- &-0.10282E+01,-0.10293E+01,-0.10303E+01,-0.10313E+01,-0.10323E+01,
- &-0.10333E+01,-0.10344E+01,-0.10354E+01,-0.10364E+01,-0.10374E+01,
- &-0.10384E+01,-0.10394E+01,-0.10404E+01,-0.10414E+01,-0.10424E+01,
- &-0.10434E+01,-0.10444E+01,-0.10453E+01,-0.10463E+01,-0.10473E+01,
- &-0.10483E+01,-0.10493E+01,-0.10502E+01,-0.10512E+01,-0.10522E+01,
- &-0.10532E+01,-0.10541E+01,-0.10551E+01,-0.10560E+01,-0.10570E+01,
- &-0.10580E+01,-0.10589E+01,-0.10599E+01,-0.10608E+01,-0.10618E+01,
- &-0.10627E+01,-0.10637E+01,-0.10646E+01,-0.10655E+01,-0.10665E+01,
- &-0.10674E+01,-0.10684E+01,-0.10693E+01,-0.10702E+01,-0.10711E+01,
- &-0.10721E+01,-0.10730E+01,-0.10739E+01,-0.10748E+01,-0.10758E+01/
-
- DATA (BNC02M(I),I=301,400)/
- &-0.10767E+01,-0.10776E+01,-0.10785E+01,-0.10794E+01,-0.10803E+01,
- &-0.10812E+01,-0.10821E+01,-0.10830E+01,-0.10839E+01,-0.10848E+01,
- &-0.10857E+01,-0.10866E+01,-0.10875E+01,-0.10884E+01,-0.10893E+01,
- &-0.10902E+01,-0.10911E+01,-0.10920E+01,-0.10929E+01,-0.10938E+01,
- &-0.10946E+01,-0.10955E+01,-0.10964E+01,-0.10973E+01,-0.10981E+01,
- &-0.10990E+01,-0.10999E+01,-0.11008E+01,-0.11016E+01,-0.11025E+01,
- &-0.11034E+01,-0.11042E+01,-0.11051E+01,-0.11059E+01,-0.11068E+01,
- &-0.11077E+01,-0.11085E+01,-0.11094E+01,-0.11102E+01,-0.11111E+01,
- &-0.11119E+01,-0.11128E+01,-0.11136E+01,-0.11145E+01,-0.11153E+01,
- &-0.11161E+01,-0.11170E+01,-0.11178E+01,-0.11187E+01,-0.11195E+01,
- &-0.11203E+01,-0.11212E+01,-0.11220E+01,-0.11228E+01,-0.11237E+01,
- &-0.11245E+01,-0.11253E+01,-0.11261E+01,-0.11270E+01,-0.11278E+01,
- &-0.11286E+01,-0.11294E+01,-0.11302E+01,-0.11311E+01,-0.11319E+01,
- &-0.11327E+01,-0.11335E+01,-0.11343E+01,-0.11351E+01,-0.11359E+01,
- &-0.11367E+01,-0.11376E+01,-0.11384E+01,-0.11392E+01,-0.11400E+01,
- &-0.11408E+01,-0.11416E+01,-0.11424E+01,-0.11432E+01,-0.11440E+01,
- &-0.11448E+01,-0.11456E+01,-0.11463E+01,-0.11471E+01,-0.11479E+01,
- &-0.11487E+01,-0.11495E+01,-0.11503E+01,-0.11511E+01,-0.11519E+01,
- &-0.11526E+01,-0.11534E+01,-0.11542E+01,-0.11550E+01,-0.11558E+01,
- &-0.11565E+01,-0.11573E+01,-0.11581E+01,-0.11589E+01,-0.11596E+01/
-
- DATA (BNC02M(I),I=401,500)/
- &-0.11604E+01,-0.11612E+01,-0.11620E+01,-0.11627E+01,-0.11635E+01,
- &-0.11643E+01,-0.11650E+01,-0.11658E+01,-0.11666E+01,-0.11673E+01,
- &-0.11681E+01,-0.11688E+01,-0.11696E+01,-0.11704E+01,-0.11711E+01,
- &-0.11719E+01,-0.11726E+01,-0.11734E+01,-0.11741E+01,-0.11749E+01,
- &-0.11756E+01,-0.11764E+01,-0.11771E+01,-0.11779E+01,-0.11786E+01,
- &-0.11794E+01,-0.11801E+01,-0.11809E+01,-0.11816E+01,-0.11824E+01,
- &-0.11831E+01,-0.11838E+01,-0.11846E+01,-0.11853E+01,-0.11860E+01,
- &-0.11868E+01,-0.11875E+01,-0.11883E+01,-0.11890E+01,-0.11897E+01,
- &-0.11905E+01,-0.11912E+01,-0.11919E+01,-0.11926E+01,-0.11934E+01,
- &-0.11941E+01,-0.11948E+01,-0.11955E+01,-0.11963E+01,-0.11970E+01,
- &-0.11977E+01,-0.11984E+01,-0.11992E+01,-0.11999E+01,-0.12006E+01,
- &-0.12013E+01,-0.12020E+01,-0.12028E+01,-0.12035E+01,-0.12042E+01,
- &-0.12049E+01,-0.12056E+01,-0.12063E+01,-0.12070E+01,-0.12077E+01,
- &-0.12085E+01,-0.12092E+01,-0.12099E+01,-0.12106E+01,-0.12113E+01,
- &-0.12120E+01,-0.12127E+01,-0.12134E+01,-0.12141E+01,-0.12148E+01,
- &-0.12155E+01,-0.12162E+01,-0.12169E+01,-0.12176E+01,-0.12183E+01,
- &-0.12190E+01,-0.12197E+01,-0.12204E+01,-0.12211E+01,-0.12218E+01,
- &-0.12225E+01,-0.12232E+01,-0.12239E+01,-0.12246E+01,-0.12252E+01,
- &-0.12259E+01,-0.12266E+01,-0.12273E+01,-0.12280E+01,-0.12287E+01,
- &-0.12294E+01,-0.12301E+01,-0.12307E+01,-0.12314E+01,-0.12321E+01/
-
- DATA (BNC02M(I),I=501,600)/
- &-0.12328E+01,-0.12335E+01,-0.12341E+01,-0.12348E+01,-0.12355E+01,
- &-0.12362E+01,-0.12369E+01,-0.12375E+01,-0.12382E+01,-0.12389E+01,
- &-0.12396E+01,-0.12402E+01,-0.12409E+01,-0.12416E+01,-0.12423E+01,
- &-0.12429E+01,-0.12436E+01,-0.12443E+01,-0.12449E+01,-0.12456E+01,
- &-0.12463E+01,-0.12470E+01,-0.12476E+01,-0.12483E+01,-0.12489E+01,
- &-0.12496E+01,-0.12503E+01,-0.12509E+01,-0.12516E+01,-0.12523E+01,
- &-0.12529E+01,-0.12536E+01,-0.12542E+01,-0.12549E+01,-0.12556E+01,
- &-0.12562E+01,-0.12569E+01,-0.12575E+01,-0.12582E+01,-0.12589E+01,
- &-0.12595E+01,-0.12602E+01,-0.12608E+01,-0.12615E+01,-0.12621E+01,
- &-0.12628E+01,-0.12634E+01,-0.12641E+01,-0.12647E+01,-0.12654E+01,
- &-0.12660E+01,-0.12667E+01,-0.12673E+01,-0.12680E+01,-0.12686E+01,
- &-0.12693E+01,-0.12699E+01,-0.12706E+01,-0.12712E+01,-0.12718E+01,
- &-0.12725E+01,-0.12731E+01,-0.12738E+01,-0.12744E+01,-0.12750E+01,
- &-0.12757E+01,-0.12763E+01,-0.12770E+01,-0.12776E+01,-0.12782E+01,
- &-0.12789E+01,-0.12795E+01,-0.12802E+01,-0.12808E+01,-0.12814E+01,
- &-0.12821E+01,-0.12827E+01,-0.12833E+01,-0.12840E+01,-0.12846E+01,
- &-0.12852E+01,-0.12858E+01,-0.12865E+01,-0.12871E+01,-0.12877E+01,
- &-0.12884E+01,-0.12890E+01,-0.12896E+01,-0.12903E+01,-0.12909E+01,
- &-0.12915E+01,-0.12921E+01,-0.12928E+01,-0.12934E+01,-0.12940E+01,
- &-0.12946E+01,-0.12952E+01,-0.12959E+01,-0.12965E+01,-0.12971E+01/
-
- DATA (BNC02M(I),I=601,700)/
- &-0.13038E+01,-0.13099E+01,-0.13160E+01,-0.13220E+01,-0.13280E+01,
- &-0.13340E+01,-0.13399E+01,-0.13457E+01,-0.13515E+01,-0.13573E+01,
- &-0.13631E+01,-0.13688E+01,-0.13744E+01,-0.13801E+01,-0.13856E+01,
- &-0.13912E+01,-0.13967E+01,-0.14022E+01,-0.14077E+01,-0.14131E+01,
- &-0.14185E+01,-0.14239E+01,-0.14292E+01,-0.14345E+01,-0.14398E+01,
- &-0.14451E+01,-0.14503E+01,-0.14555E+01,-0.14607E+01,-0.14659E+01,
- &-0.14710E+01,-0.14761E+01,-0.14812E+01,-0.14862E+01,-0.14913E+01,
- &-0.14963E+01,-0.15013E+01,-0.15063E+01,-0.15112E+01,-0.15161E+01,
- &-0.15211E+01,-0.15260E+01,-0.15308E+01,-0.15357E+01,-0.15405E+01,
- &-0.15453E+01,-0.15501E+01,-0.15549E+01,-0.15597E+01,-0.15644E+01,
- &-0.15692E+01,-0.15739E+01,-0.15786E+01,-0.15833E+01,-0.15880E+01,
- &-0.15926E+01,-0.15972E+01,-0.16019E+01,-0.16065E+01,-0.16111E+01,
- &-0.16157E+01,-0.16202E+01,-0.16248E+01,-0.16293E+01,-0.16338E+01,
- &-0.16384E+01,-0.16429E+01,-0.16473E+01,-0.16518E+01,-0.16563E+01,
- &-0.16607E+01,-0.16652E+01,-0.16696E+01,-0.16740E+01,-0.16784E+01,
- &-0.16828E+01,-0.16872E+01,-0.16915E+01,-0.16959E+01,-0.17003E+01,
- &-0.17046E+01,-0.17089E+01,-0.17132E+01,-0.17175E+01,-0.17218E+01,
- &-0.17261E+01,-0.17304E+01,-0.17347E+01,-0.17389E+01,-0.17432E+01,
- &-0.17474E+01,-0.17516E+01,-0.17559E+01,-0.17601E+01,-0.17643E+01,
- &-0.17685E+01,-0.17726E+01,-0.17768E+01,-0.17810E+01,-0.17851E+01/
-
- DATA (BNC02M(I),I=701,741)/
- &-0.17893E+01,-0.17934E+01,-0.17976E+01,-0.18017E+01,-0.18058E+01,
- &-0.18099E+01,-0.18140E+01,-0.18181E+01,-0.18222E+01,-0.18263E+01,
- &-0.18304E+01,-0.18344E+01,-0.18385E+01,-0.18425E+01,-0.18466E+01,
- &-0.18506E+01,-0.18547E+01,-0.18587E+01,-0.18627E+01,-0.18667E+01,
- &-0.18707E+01,-0.18747E+01,-0.18787E+01,-0.18827E+01,-0.18866E+01,
- &-0.18906E+01,-0.18946E+01,-0.18985E+01,-0.19025E+01,-0.19064E+01,
- &-0.19104E+01,-0.19143E+01,-0.19182E+01,-0.19222E+01,-0.19261E+01,
- &-0.19300E+01,-0.19339E+01,-0.19378E+01,-0.19417E+01,-0.19456E+01,
- &-0.19495E+01
- & /
-C
-C *** NaNO3
-C
- DATA (BNC03M(I),I=1,100)/
- &-0.47892E-01,-0.10469E+00,-0.13335E+00,-0.15377E+00,-0.16990E+00,
- &-0.18333E+00,-0.19490E+00,-0.20510E+00,-0.21423E+00,-0.22252E+00,
- &-0.23012E+00,-0.23714E+00,-0.24367E+00,-0.24979E+00,-0.25554E+00,
- &-0.26097E+00,-0.26612E+00,-0.27101E+00,-0.27568E+00,-0.28015E+00,
- &-0.28443E+00,-0.28854E+00,-0.29249E+00,-0.29630E+00,-0.29998E+00,
- &-0.30354E+00,-0.30699E+00,-0.31033E+00,-0.31357E+00,-0.31671E+00,
- &-0.31977E+00,-0.32275E+00,-0.32565E+00,-0.32848E+00,-0.33124E+00,
- &-0.33393E+00,-0.33656E+00,-0.33913E+00,-0.34164E+00,-0.34410E+00,
- &-0.34651E+00,-0.34887E+00,-0.35118E+00,-0.35344E+00,-0.35567E+00,
- &-0.35785E+00,-0.35999E+00,-0.36209E+00,-0.36415E+00,-0.36618E+00,
- &-0.36817E+00,-0.37013E+00,-0.37206E+00,-0.37396E+00,-0.37583E+00,
- &-0.37767E+00,-0.37948E+00,-0.38127E+00,-0.38303E+00,-0.38476E+00,
- &-0.38648E+00,-0.38816E+00,-0.38983E+00,-0.39148E+00,-0.39310E+00,
- &-0.39470E+00,-0.39629E+00,-0.39786E+00,-0.39941E+00,-0.40094E+00,
- &-0.40245E+00,-0.40395E+00,-0.40543E+00,-0.40690E+00,-0.40836E+00,
- &-0.40980E+00,-0.41122E+00,-0.41264E+00,-0.41404E+00,-0.41543E+00,
- &-0.41681E+00,-0.41817E+00,-0.41953E+00,-0.42087E+00,-0.42221E+00,
- &-0.42354E+00,-0.42485E+00,-0.42616E+00,-0.42745E+00,-0.42874E+00,
- &-0.43002E+00,-0.43129E+00,-0.43256E+00,-0.43381E+00,-0.43506E+00,
- &-0.43630E+00,-0.43753E+00,-0.43876E+00,-0.43998E+00,-0.44119E+00/
-
- DATA (BNC03M(I),I=101,200)/
- &-0.44239E+00,-0.44359E+00,-0.44478E+00,-0.44597E+00,-0.44715E+00,
- &-0.44832E+00,-0.44948E+00,-0.45064E+00,-0.45179E+00,-0.45294E+00,
- &-0.45408E+00,-0.45521E+00,-0.45634E+00,-0.45746E+00,-0.45858E+00,
- &-0.45969E+00,-0.46079E+00,-0.46189E+00,-0.46298E+00,-0.46407E+00,
- &-0.46515E+00,-0.46623E+00,-0.46730E+00,-0.46836E+00,-0.46942E+00,
- &-0.47047E+00,-0.47152E+00,-0.47257E+00,-0.47360E+00,-0.47464E+00,
- &-0.47566E+00,-0.47669E+00,-0.47770E+00,-0.47871E+00,-0.47972E+00,
- &-0.48072E+00,-0.48172E+00,-0.48271E+00,-0.48370E+00,-0.48468E+00,
- &-0.48566E+00,-0.48663E+00,-0.48760E+00,-0.48857E+00,-0.48953E+00,
- &-0.49048E+00,-0.49143E+00,-0.49238E+00,-0.49332E+00,-0.49426E+00,
- &-0.49520E+00,-0.49613E+00,-0.49705E+00,-0.49797E+00,-0.49889E+00,
- &-0.49980E+00,-0.50071E+00,-0.50162E+00,-0.50252E+00,-0.50342E+00,
- &-0.50432E+00,-0.50521E+00,-0.50609E+00,-0.50698E+00,-0.50786E+00,
- &-0.50873E+00,-0.50961E+00,-0.51047E+00,-0.51134E+00,-0.51220E+00,
- &-0.51306E+00,-0.51392E+00,-0.51477E+00,-0.51562E+00,-0.51647E+00,
- &-0.51731E+00,-0.51815E+00,-0.51898E+00,-0.51982E+00,-0.52065E+00,
- &-0.52147E+00,-0.52230E+00,-0.52312E+00,-0.52394E+00,-0.52475E+00,
- &-0.52556E+00,-0.52637E+00,-0.52718E+00,-0.52798E+00,-0.52878E+00,
- &-0.52958E+00,-0.53038E+00,-0.53117E+00,-0.53196E+00,-0.53275E+00,
- &-0.53353E+00,-0.53431E+00,-0.53509E+00,-0.53587E+00,-0.53664E+00/
-
- DATA (BNC03M(I),I=201,300)/
- &-0.53741E+00,-0.53818E+00,-0.53895E+00,-0.53971E+00,-0.54047E+00,
- &-0.54123E+00,-0.54199E+00,-0.54274E+00,-0.54349E+00,-0.54424E+00,
- &-0.54499E+00,-0.54573E+00,-0.54648E+00,-0.54722E+00,-0.54796E+00,
- &-0.54869E+00,-0.54942E+00,-0.55016E+00,-0.55088E+00,-0.55161E+00,
- &-0.55234E+00,-0.55306E+00,-0.55378E+00,-0.55450E+00,-0.55521E+00,
- &-0.55593E+00,-0.55664E+00,-0.55735E+00,-0.55806E+00,-0.55876E+00,
- &-0.55947E+00,-0.56017E+00,-0.56087E+00,-0.56156E+00,-0.56226E+00,
- &-0.56295E+00,-0.56365E+00,-0.56434E+00,-0.56503E+00,-0.56571E+00,
- &-0.56640E+00,-0.56708E+00,-0.56776E+00,-0.56844E+00,-0.56912E+00,
- &-0.56979E+00,-0.57046E+00,-0.57114E+00,-0.57181E+00,-0.57248E+00,
- &-0.57314E+00,-0.57381E+00,-0.57447E+00,-0.57513E+00,-0.57579E+00,
- &-0.57645E+00,-0.57711E+00,-0.57776E+00,-0.57841E+00,-0.57907E+00,
- &-0.57971E+00,-0.58036E+00,-0.58101E+00,-0.58165E+00,-0.58230E+00,
- &-0.58294E+00,-0.58358E+00,-0.58422E+00,-0.58486E+00,-0.58549E+00,
- &-0.58613E+00,-0.58676E+00,-0.58739E+00,-0.58802E+00,-0.58865E+00,
- &-0.58928E+00,-0.58990E+00,-0.59052E+00,-0.59115E+00,-0.59177E+00,
- &-0.59239E+00,-0.59301E+00,-0.59362E+00,-0.59424E+00,-0.59485E+00,
- &-0.59546E+00,-0.59607E+00,-0.59668E+00,-0.59729E+00,-0.59790E+00,
- &-0.59851E+00,-0.59911E+00,-0.59971E+00,-0.60031E+00,-0.60092E+00,
- &-0.60151E+00,-0.60211E+00,-0.60271E+00,-0.60330E+00,-0.60390E+00/
-
- DATA (BNC03M(I),I=301,400)/
- &-0.60449E+00,-0.60508E+00,-0.60567E+00,-0.60626E+00,-0.60685E+00,
- &-0.60744E+00,-0.60802E+00,-0.60860E+00,-0.60919E+00,-0.60977E+00,
- &-0.61035E+00,-0.61093E+00,-0.61151E+00,-0.61208E+00,-0.61266E+00,
- &-0.61323E+00,-0.61381E+00,-0.61438E+00,-0.61495E+00,-0.61552E+00,
- &-0.61609E+00,-0.61666E+00,-0.61722E+00,-0.61779E+00,-0.61835E+00,
- &-0.61892E+00,-0.61948E+00,-0.62004E+00,-0.62060E+00,-0.62116E+00,
- &-0.62171E+00,-0.62227E+00,-0.62283E+00,-0.62338E+00,-0.62393E+00,
- &-0.62449E+00,-0.62504E+00,-0.62559E+00,-0.62614E+00,-0.62669E+00,
- &-0.62723E+00,-0.62778E+00,-0.62833E+00,-0.62887E+00,-0.62941E+00,
- &-0.62996E+00,-0.63050E+00,-0.63104E+00,-0.63158E+00,-0.63211E+00,
- &-0.63265E+00,-0.63319E+00,-0.63372E+00,-0.63426E+00,-0.63479E+00,
- &-0.63532E+00,-0.63586E+00,-0.63639E+00,-0.63692E+00,-0.63744E+00,
- &-0.63797E+00,-0.63850E+00,-0.63903E+00,-0.63955E+00,-0.64007E+00,
- &-0.64060E+00,-0.64112E+00,-0.64164E+00,-0.64216E+00,-0.64268E+00,
- &-0.64320E+00,-0.64372E+00,-0.64424E+00,-0.64475E+00,-0.64527E+00,
- &-0.64578E+00,-0.64630E+00,-0.64681E+00,-0.64732E+00,-0.64783E+00,
- &-0.64834E+00,-0.64885E+00,-0.64936E+00,-0.64987E+00,-0.65037E+00,
- &-0.65088E+00,-0.65139E+00,-0.65189E+00,-0.65239E+00,-0.65290E+00,
- &-0.65340E+00,-0.65390E+00,-0.65440E+00,-0.65490E+00,-0.65540E+00,
- &-0.65590E+00,-0.65639E+00,-0.65689E+00,-0.65739E+00,-0.65788E+00/
-
- DATA (BNC03M(I),I=401,500)/
- &-0.65838E+00,-0.65887E+00,-0.65936E+00,-0.65985E+00,-0.66035E+00,
- &-0.66084E+00,-0.66133E+00,-0.66181E+00,-0.66230E+00,-0.66279E+00,
- &-0.66328E+00,-0.66376E+00,-0.66425E+00,-0.66473E+00,-0.66522E+00,
- &-0.66570E+00,-0.66618E+00,-0.66666E+00,-0.66714E+00,-0.66762E+00,
- &-0.66810E+00,-0.66858E+00,-0.66906E+00,-0.66954E+00,-0.67001E+00,
- &-0.67049E+00,-0.67097E+00,-0.67144E+00,-0.67191E+00,-0.67239E+00,
- &-0.67286E+00,-0.67333E+00,-0.67380E+00,-0.67427E+00,-0.67474E+00,
- &-0.67521E+00,-0.67568E+00,-0.67615E+00,-0.67662E+00,-0.67708E+00,
- &-0.67755E+00,-0.67801E+00,-0.67848E+00,-0.67894E+00,-0.67941E+00,
- &-0.67987E+00,-0.68033E+00,-0.68079E+00,-0.68125E+00,-0.68171E+00,
- &-0.68217E+00,-0.68263E+00,-0.68309E+00,-0.68355E+00,-0.68400E+00,
- &-0.68446E+00,-0.68492E+00,-0.68537E+00,-0.68583E+00,-0.68628E+00,
- &-0.68673E+00,-0.68719E+00,-0.68764E+00,-0.68809E+00,-0.68854E+00,
- &-0.68899E+00,-0.68944E+00,-0.68989E+00,-0.69034E+00,-0.69079E+00,
- &-0.69124E+00,-0.69168E+00,-0.69213E+00,-0.69257E+00,-0.69302E+00,
- &-0.69346E+00,-0.69391E+00,-0.69435E+00,-0.69480E+00,-0.69524E+00,
- &-0.69568E+00,-0.69612E+00,-0.69656E+00,-0.69700E+00,-0.69744E+00,
- &-0.69788E+00,-0.69832E+00,-0.69876E+00,-0.69919E+00,-0.69963E+00,
- &-0.70007E+00,-0.70050E+00,-0.70094E+00,-0.70137E+00,-0.70181E+00,
- &-0.70224E+00,-0.70267E+00,-0.70311E+00,-0.70354E+00,-0.70397E+00/
-
- DATA (BNC03M(I),I=501,600)/
- &-0.70440E+00,-0.70483E+00,-0.70526E+00,-0.70569E+00,-0.70612E+00,
- &-0.70655E+00,-0.70698E+00,-0.70740E+00,-0.70783E+00,-0.70826E+00,
- &-0.70868E+00,-0.70911E+00,-0.70953E+00,-0.70996E+00,-0.71038E+00,
- &-0.71081E+00,-0.71123E+00,-0.71165E+00,-0.71207E+00,-0.71250E+00,
- &-0.71292E+00,-0.71334E+00,-0.71376E+00,-0.71418E+00,-0.71460E+00,
- &-0.71501E+00,-0.71543E+00,-0.71585E+00,-0.71627E+00,-0.71668E+00,
- &-0.71710E+00,-0.71752E+00,-0.71793E+00,-0.71835E+00,-0.71876E+00,
- &-0.71917E+00,-0.71959E+00,-0.72000E+00,-0.72041E+00,-0.72083E+00,
- &-0.72124E+00,-0.72165E+00,-0.72206E+00,-0.72247E+00,-0.72288E+00,
- &-0.72329E+00,-0.72370E+00,-0.72411E+00,-0.72451E+00,-0.72492E+00,
- &-0.72533E+00,-0.72574E+00,-0.72614E+00,-0.72655E+00,-0.72695E+00,
- &-0.72736E+00,-0.72776E+00,-0.72817E+00,-0.72857E+00,-0.72897E+00,
- &-0.72938E+00,-0.72978E+00,-0.73018E+00,-0.73058E+00,-0.73098E+00,
- &-0.73139E+00,-0.73179E+00,-0.73219E+00,-0.73259E+00,-0.73298E+00,
- &-0.73338E+00,-0.73378E+00,-0.73418E+00,-0.73458E+00,-0.73497E+00,
- &-0.73537E+00,-0.73577E+00,-0.73616E+00,-0.73656E+00,-0.73695E+00,
- &-0.73735E+00,-0.73774E+00,-0.73814E+00,-0.73853E+00,-0.73892E+00,
- &-0.73932E+00,-0.73971E+00,-0.74010E+00,-0.74049E+00,-0.74088E+00,
- &-0.74127E+00,-0.74166E+00,-0.74205E+00,-0.74244E+00,-0.74283E+00,
- &-0.74322E+00,-0.74361E+00,-0.74400E+00,-0.74439E+00,-0.74477E+00/
-
- DATA (BNC03M(I),I=601,700)/
- &-0.74893E+00,-0.75275E+00,-0.75652E+00,-0.76027E+00,-0.76398E+00,
- &-0.76765E+00,-0.77130E+00,-0.77492E+00,-0.77850E+00,-0.78206E+00,
- &-0.78558E+00,-0.78908E+00,-0.79256E+00,-0.79600E+00,-0.79942E+00,
- &-0.80282E+00,-0.80619E+00,-0.80954E+00,-0.81286E+00,-0.81617E+00,
- &-0.81944E+00,-0.82270E+00,-0.82594E+00,-0.82915E+00,-0.83235E+00,
- &-0.83552E+00,-0.83868E+00,-0.84181E+00,-0.84493E+00,-0.84803E+00,
- &-0.85111E+00,-0.85417E+00,-0.85722E+00,-0.86025E+00,-0.86326E+00,
- &-0.86626E+00,-0.86924E+00,-0.87221E+00,-0.87515E+00,-0.87809E+00,
- &-0.88101E+00,-0.88391E+00,-0.88681E+00,-0.88968E+00,-0.89255E+00,
- &-0.89540E+00,-0.89823E+00,-0.90106E+00,-0.90387E+00,-0.90666E+00,
- &-0.90945E+00,-0.91222E+00,-0.91499E+00,-0.91773E+00,-0.92047E+00,
- &-0.92320E+00,-0.92592E+00,-0.92862E+00,-0.93131E+00,-0.93400E+00,
- &-0.93667E+00,-0.93933E+00,-0.94198E+00,-0.94462E+00,-0.94726E+00,
- &-0.94988E+00,-0.95249E+00,-0.95509E+00,-0.95769E+00,-0.96027E+00,
- &-0.96285E+00,-0.96541E+00,-0.96797E+00,-0.97052E+00,-0.97306E+00,
- &-0.97559E+00,-0.97812E+00,-0.98063E+00,-0.98314E+00,-0.98564E+00,
- &-0.98813E+00,-0.99062E+00,-0.99309E+00,-0.99556E+00,-0.99802E+00,
- &-0.10005E+01,-0.10029E+01,-0.10054E+01,-0.10078E+01,-0.10102E+01,
- &-0.10126E+01,-0.10150E+01,-0.10175E+01,-0.10198E+01,-0.10222E+01,
- &-0.10246E+01,-0.10270E+01,-0.10294E+01,-0.10317E+01,-0.10341E+01/
-
- DATA (BNC03M(I),I=701,741)/
- &-0.10365E+01,-0.10388E+01,-0.10411E+01,-0.10435E+01,-0.10458E+01,
- &-0.10481E+01,-0.10505E+01,-0.10528E+01,-0.10551E+01,-0.10574E+01,
- &-0.10597E+01,-0.10620E+01,-0.10642E+01,-0.10665E+01,-0.10688E+01,
- &-0.10711E+01,-0.10733E+01,-0.10756E+01,-0.10778E+01,-0.10801E+01,
- &-0.10823E+01,-0.10846E+01,-0.10868E+01,-0.10890E+01,-0.10913E+01,
- &-0.10935E+01,-0.10957E+01,-0.10979E+01,-0.11001E+01,-0.11023E+01,
- &-0.11045E+01,-0.11067E+01,-0.11089E+01,-0.11111E+01,-0.11133E+01,
- &-0.11154E+01,-0.11176E+01,-0.11198E+01,-0.11219E+01,-0.11241E+01,
- &-0.11263E+01
- & /
-C
-C *** (NH4)2SO4
-C
- DATA (BNC04M(I),I=1,100)/
- &-0.95602E-01,-0.20838E+00,-0.26497E+00,-0.30509E+00,-0.33666E+00,
- &-0.36287E+00,-0.38536E+00,-0.40512E+00,-0.42276E+00,-0.43873E+00,
- &-0.45332E+00,-0.46676E+00,-0.47924E+00,-0.49089E+00,-0.50182E+00,
- &-0.51211E+00,-0.52185E+00,-0.53109E+00,-0.53988E+00,-0.54827E+00,
- &-0.55629E+00,-0.56398E+00,-0.57137E+00,-0.57848E+00,-0.58532E+00,
- &-0.59193E+00,-0.59832E+00,-0.60450E+00,-0.61049E+00,-0.61630E+00,
- &-0.62194E+00,-0.62742E+00,-0.63275E+00,-0.63794E+00,-0.64299E+00,
- &-0.64792E+00,-0.65273E+00,-0.65742E+00,-0.66201E+00,-0.66649E+00,
- &-0.67087E+00,-0.67516E+00,-0.67936E+00,-0.68347E+00,-0.68750E+00,
- &-0.69145E+00,-0.69533E+00,-0.69913E+00,-0.70286E+00,-0.70653E+00,
- &-0.71013E+00,-0.71367E+00,-0.71715E+00,-0.72057E+00,-0.72393E+00,
- &-0.72724E+00,-0.73050E+00,-0.73371E+00,-0.73687E+00,-0.73999E+00,
- &-0.74306E+00,-0.74609E+00,-0.74907E+00,-0.75202E+00,-0.75492E+00,
- &-0.75779E+00,-0.76063E+00,-0.76342E+00,-0.76619E+00,-0.76892E+00,
- &-0.77162E+00,-0.77428E+00,-0.77692E+00,-0.77953E+00,-0.78212E+00,
- &-0.78467E+00,-0.78720E+00,-0.78971E+00,-0.79219E+00,-0.79464E+00,
- &-0.79708E+00,-0.79949E+00,-0.80188E+00,-0.80425E+00,-0.80660E+00,
- &-0.80893E+00,-0.81124E+00,-0.81353E+00,-0.81581E+00,-0.81807E+00,
- &-0.82031E+00,-0.82253E+00,-0.82474E+00,-0.82693E+00,-0.82910E+00,
- &-0.83127E+00,-0.83341E+00,-0.83554E+00,-0.83766E+00,-0.83976E+00/
-
- DATA (BNC04M(I),I=101,200)/
- &-0.84185E+00,-0.84393E+00,-0.84599E+00,-0.84804E+00,-0.85007E+00,
- &-0.85210E+00,-0.85411E+00,-0.85611E+00,-0.85809E+00,-0.86007E+00,
- &-0.86203E+00,-0.86398E+00,-0.86592E+00,-0.86785E+00,-0.86977E+00,
- &-0.87167E+00,-0.87357E+00,-0.87545E+00,-0.87732E+00,-0.87918E+00,
- &-0.88103E+00,-0.88287E+00,-0.88470E+00,-0.88652E+00,-0.88833E+00,
- &-0.89013E+00,-0.89192E+00,-0.89370E+00,-0.89547E+00,-0.89724E+00,
- &-0.89899E+00,-0.90073E+00,-0.90246E+00,-0.90419E+00,-0.90590E+00,
- &-0.90761E+00,-0.90930E+00,-0.91099E+00,-0.91267E+00,-0.91434E+00,
- &-0.91601E+00,-0.91766E+00,-0.91931E+00,-0.92094E+00,-0.92257E+00,
- &-0.92420E+00,-0.92581E+00,-0.92742E+00,-0.92902E+00,-0.93061E+00,
- &-0.93219E+00,-0.93377E+00,-0.93534E+00,-0.93690E+00,-0.93846E+00,
- &-0.94000E+00,-0.94155E+00,-0.94308E+00,-0.94461E+00,-0.94613E+00,
- &-0.94764E+00,-0.94915E+00,-0.95065E+00,-0.95215E+00,-0.95363E+00,
- &-0.95512E+00,-0.95659E+00,-0.95806E+00,-0.95953E+00,-0.96099E+00,
- &-0.96244E+00,-0.96388E+00,-0.96532E+00,-0.96676E+00,-0.96819E+00,
- &-0.96961E+00,-0.97103E+00,-0.97244E+00,-0.97385E+00,-0.97525E+00,
- &-0.97665E+00,-0.97804E+00,-0.97942E+00,-0.98080E+00,-0.98218E+00,
- &-0.98355E+00,-0.98491E+00,-0.98627E+00,-0.98763E+00,-0.98898E+00,
- &-0.99033E+00,-0.99167E+00,-0.99300E+00,-0.99434E+00,-0.99566E+00,
- &-0.99699E+00,-0.99830E+00,-0.99962E+00,-0.10009E+01,-0.10022E+01/
-
- DATA (BNC04M(I),I=201,300)/
- &-0.10035E+01,-0.10048E+01,-0.10061E+01,-0.10074E+01,-0.10087E+01,
- &-0.10100E+01,-0.10112E+01,-0.10125E+01,-0.10138E+01,-0.10150E+01,
- &-0.10163E+01,-0.10176E+01,-0.10188E+01,-0.10200E+01,-0.10213E+01,
- &-0.10225E+01,-0.10238E+01,-0.10250E+01,-0.10262E+01,-0.10274E+01,
- &-0.10287E+01,-0.10299E+01,-0.10311E+01,-0.10323E+01,-0.10335E+01,
- &-0.10347E+01,-0.10359E+01,-0.10371E+01,-0.10383E+01,-0.10395E+01,
- &-0.10407E+01,-0.10419E+01,-0.10430E+01,-0.10442E+01,-0.10454E+01,
- &-0.10465E+01,-0.10477E+01,-0.10489E+01,-0.10500E+01,-0.10512E+01,
- &-0.10523E+01,-0.10535E+01,-0.10546E+01,-0.10558E+01,-0.10569E+01,
- &-0.10581E+01,-0.10592E+01,-0.10603E+01,-0.10615E+01,-0.10626E+01,
- &-0.10637E+01,-0.10648E+01,-0.10659E+01,-0.10670E+01,-0.10682E+01,
- &-0.10693E+01,-0.10704E+01,-0.10715E+01,-0.10726E+01,-0.10737E+01,
- &-0.10748E+01,-0.10759E+01,-0.10769E+01,-0.10780E+01,-0.10791E+01,
- &-0.10802E+01,-0.10813E+01,-0.10824E+01,-0.10834E+01,-0.10845E+01,
- &-0.10856E+01,-0.10866E+01,-0.10877E+01,-0.10888E+01,-0.10898E+01,
- &-0.10909E+01,-0.10919E+01,-0.10930E+01,-0.10940E+01,-0.10951E+01,
- &-0.10961E+01,-0.10972E+01,-0.10982E+01,-0.10992E+01,-0.11003E+01,
- &-0.11013E+01,-0.11023E+01,-0.11034E+01,-0.11044E+01,-0.11054E+01,
- &-0.11064E+01,-0.11074E+01,-0.11085E+01,-0.11095E+01,-0.11105E+01,
- &-0.11115E+01,-0.11125E+01,-0.11135E+01,-0.11145E+01,-0.11155E+01/
-
- DATA (BNC04M(I),I=301,400)/
- &-0.11165E+01,-0.11175E+01,-0.11185E+01,-0.11195E+01,-0.11205E+01,
- &-0.11215E+01,-0.11225E+01,-0.11234E+01,-0.11244E+01,-0.11254E+01,
- &-0.11264E+01,-0.11274E+01,-0.11283E+01,-0.11293E+01,-0.11303E+01,
- &-0.11313E+01,-0.11322E+01,-0.11332E+01,-0.11342E+01,-0.11351E+01,
- &-0.11361E+01,-0.11370E+01,-0.11380E+01,-0.11389E+01,-0.11399E+01,
- &-0.11408E+01,-0.11418E+01,-0.11427E+01,-0.11437E+01,-0.11446E+01,
- &-0.11456E+01,-0.11465E+01,-0.11475E+01,-0.11484E+01,-0.11493E+01,
- &-0.11503E+01,-0.11512E+01,-0.11521E+01,-0.11531E+01,-0.11540E+01,
- &-0.11549E+01,-0.11558E+01,-0.11567E+01,-0.11577E+01,-0.11586E+01,
- &-0.11595E+01,-0.11604E+01,-0.11613E+01,-0.11622E+01,-0.11632E+01,
- &-0.11641E+01,-0.11650E+01,-0.11659E+01,-0.11668E+01,-0.11677E+01,
- &-0.11686E+01,-0.11695E+01,-0.11704E+01,-0.11713E+01,-0.11722E+01,
- &-0.11731E+01,-0.11740E+01,-0.11749E+01,-0.11757E+01,-0.11766E+01,
- &-0.11775E+01,-0.11784E+01,-0.11793E+01,-0.11802E+01,-0.11810E+01,
- &-0.11819E+01,-0.11828E+01,-0.11837E+01,-0.11846E+01,-0.11854E+01,
- &-0.11863E+01,-0.11872E+01,-0.11880E+01,-0.11889E+01,-0.11898E+01,
- &-0.11906E+01,-0.11915E+01,-0.11924E+01,-0.11932E+01,-0.11941E+01,
- &-0.11949E+01,-0.11958E+01,-0.11967E+01,-0.11975E+01,-0.11984E+01,
- &-0.11992E+01,-0.12001E+01,-0.12009E+01,-0.12018E+01,-0.12026E+01,
- &-0.12035E+01,-0.12043E+01,-0.12051E+01,-0.12060E+01,-0.12068E+01/
-
- DATA (BNC04M(I),I=401,500)/
- &-0.12077E+01,-0.12085E+01,-0.12093E+01,-0.12102E+01,-0.12110E+01,
- &-0.12118E+01,-0.12127E+01,-0.12135E+01,-0.12143E+01,-0.12152E+01,
- &-0.12160E+01,-0.12168E+01,-0.12176E+01,-0.12185E+01,-0.12193E+01,
- &-0.12201E+01,-0.12209E+01,-0.12217E+01,-0.12226E+01,-0.12234E+01,
- &-0.12242E+01,-0.12250E+01,-0.12258E+01,-0.12266E+01,-0.12274E+01,
- &-0.12283E+01,-0.12291E+01,-0.12299E+01,-0.12307E+01,-0.12315E+01,
- &-0.12323E+01,-0.12331E+01,-0.12339E+01,-0.12347E+01,-0.12355E+01,
- &-0.12363E+01,-0.12371E+01,-0.12379E+01,-0.12387E+01,-0.12395E+01,
- &-0.12403E+01,-0.12411E+01,-0.12419E+01,-0.12426E+01,-0.12434E+01,
- &-0.12442E+01,-0.12450E+01,-0.12458E+01,-0.12466E+01,-0.12474E+01,
- &-0.12482E+01,-0.12489E+01,-0.12497E+01,-0.12505E+01,-0.12513E+01,
- &-0.12521E+01,-0.12528E+01,-0.12536E+01,-0.12544E+01,-0.12552E+01,
- &-0.12559E+01,-0.12567E+01,-0.12575E+01,-0.12583E+01,-0.12590E+01,
- &-0.12598E+01,-0.12606E+01,-0.12613E+01,-0.12621E+01,-0.12629E+01,
- &-0.12636E+01,-0.12644E+01,-0.12652E+01,-0.12659E+01,-0.12667E+01,
- &-0.12674E+01,-0.12682E+01,-0.12690E+01,-0.12697E+01,-0.12705E+01,
- &-0.12712E+01,-0.12720E+01,-0.12727E+01,-0.12735E+01,-0.12742E+01,
- &-0.12750E+01,-0.12757E+01,-0.12765E+01,-0.12772E+01,-0.12780E+01,
- &-0.12787E+01,-0.12795E+01,-0.12802E+01,-0.12810E+01,-0.12817E+01,
- &-0.12825E+01,-0.12832E+01,-0.12839E+01,-0.12847E+01,-0.12854E+01/
-
- DATA (BNC04M(I),I=501,600)/
- &-0.12862E+01,-0.12869E+01,-0.12876E+01,-0.12884E+01,-0.12891E+01,
- &-0.12898E+01,-0.12906E+01,-0.12913E+01,-0.12920E+01,-0.12928E+01,
- &-0.12935E+01,-0.12942E+01,-0.12950E+01,-0.12957E+01,-0.12964E+01,
- &-0.12971E+01,-0.12979E+01,-0.12986E+01,-0.12993E+01,-0.13000E+01,
- &-0.13008E+01,-0.13015E+01,-0.13022E+01,-0.13029E+01,-0.13036E+01,
- &-0.13044E+01,-0.13051E+01,-0.13058E+01,-0.13065E+01,-0.13072E+01,
- &-0.13079E+01,-0.13087E+01,-0.13094E+01,-0.13101E+01,-0.13108E+01,
- &-0.13115E+01,-0.13122E+01,-0.13129E+01,-0.13136E+01,-0.13143E+01,
- &-0.13151E+01,-0.13158E+01,-0.13165E+01,-0.13172E+01,-0.13179E+01,
- &-0.13186E+01,-0.13193E+01,-0.13200E+01,-0.13207E+01,-0.13214E+01,
- &-0.13221E+01,-0.13228E+01,-0.13235E+01,-0.13242E+01,-0.13249E+01,
- &-0.13256E+01,-0.13263E+01,-0.13270E+01,-0.13277E+01,-0.13284E+01,
- &-0.13291E+01,-0.13298E+01,-0.13304E+01,-0.13311E+01,-0.13318E+01,
- &-0.13325E+01,-0.13332E+01,-0.13339E+01,-0.13346E+01,-0.13353E+01,
- &-0.13360E+01,-0.13367E+01,-0.13373E+01,-0.13380E+01,-0.13387E+01,
- &-0.13394E+01,-0.13401E+01,-0.13408E+01,-0.13414E+01,-0.13421E+01,
- &-0.13428E+01,-0.13435E+01,-0.13442E+01,-0.13448E+01,-0.13455E+01,
- &-0.13462E+01,-0.13469E+01,-0.13476E+01,-0.13482E+01,-0.13489E+01,
- &-0.13496E+01,-0.13503E+01,-0.13509E+01,-0.13516E+01,-0.13523E+01,
- &-0.13530E+01,-0.13536E+01,-0.13543E+01,-0.13550E+01,-0.13556E+01/
-
- DATA (BNC04M(I),I=601,700)/
- &-0.13628E+01,-0.13694E+01,-0.13760E+01,-0.13825E+01,-0.13889E+01,
- &-0.13953E+01,-0.14016E+01,-0.14079E+01,-0.14142E+01,-0.14204E+01,
- &-0.14265E+01,-0.14327E+01,-0.14387E+01,-0.14448E+01,-0.14507E+01,
- &-0.14567E+01,-0.14626E+01,-0.14685E+01,-0.14743E+01,-0.14801E+01,
- &-0.14859E+01,-0.14916E+01,-0.14973E+01,-0.15030E+01,-0.15087E+01,
- &-0.15143E+01,-0.15198E+01,-0.15254E+01,-0.15309E+01,-0.15364E+01,
- &-0.15419E+01,-0.15473E+01,-0.15527E+01,-0.15581E+01,-0.15635E+01,
- &-0.15688E+01,-0.15741E+01,-0.15794E+01,-0.15846E+01,-0.15899E+01,
- &-0.15951E+01,-0.16003E+01,-0.16055E+01,-0.16106E+01,-0.16157E+01,
- &-0.16208E+01,-0.16259E+01,-0.16310E+01,-0.16360E+01,-0.16411E+01,
- &-0.16461E+01,-0.16511E+01,-0.16560E+01,-0.16610E+01,-0.16659E+01,
- &-0.16708E+01,-0.16757E+01,-0.16806E+01,-0.16855E+01,-0.16903E+01,
- &-0.16952E+01,-0.17000E+01,-0.17048E+01,-0.17096E+01,-0.17143E+01,
- &-0.17191E+01,-0.17238E+01,-0.17285E+01,-0.17333E+01,-0.17379E+01,
- &-0.17426E+01,-0.17473E+01,-0.17520E+01,-0.17566E+01,-0.17612E+01,
- &-0.17658E+01,-0.17704E+01,-0.17750E+01,-0.17796E+01,-0.17842E+01,
- &-0.17887E+01,-0.17933E+01,-0.17978E+01,-0.18023E+01,-0.18068E+01,
- &-0.18113E+01,-0.18158E+01,-0.18203E+01,-0.18247E+01,-0.18292E+01,
- &-0.18336E+01,-0.18380E+01,-0.18425E+01,-0.18469E+01,-0.18513E+01,
- &-0.18556E+01,-0.18600E+01,-0.18644E+01,-0.18687E+01,-0.18731E+01/
-
- DATA (BNC04M(I),I=701,741)/
- &-0.18774E+01,-0.18818E+01,-0.18861E+01,-0.18904E+01,-0.18947E+01,
- &-0.18990E+01,-0.19033E+01,-0.19075E+01,-0.19118E+01,-0.19161E+01,
- &-0.19203E+01,-0.19245E+01,-0.19288E+01,-0.19330E+01,-0.19372E+01,
- &-0.19414E+01,-0.19456E+01,-0.19498E+01,-0.19540E+01,-0.19582E+01,
- &-0.19623E+01,-0.19665E+01,-0.19707E+01,-0.19748E+01,-0.19789E+01,
- &-0.19831E+01,-0.19872E+01,-0.19913E+01,-0.19954E+01,-0.19995E+01,
- &-0.20036E+01,-0.20077E+01,-0.20118E+01,-0.20159E+01,-0.20199E+01,
- &-0.20240E+01,-0.20280E+01,-0.20321E+01,-0.20361E+01,-0.20402E+01,
- &-0.20442E+01
- & /
-C
-C *** NH4NO3
-C
- DATA (BNC05M(I),I=1,100)/
- &-0.48407E-01,-0.10752E+00,-0.13832E+00,-0.16078E+00,-0.17887E+00,
- &-0.19423E+00,-0.20767E+00,-0.21970E+00,-0.23063E+00,-0.24069E+00,
- &-0.25003E+00,-0.25876E+00,-0.26699E+00,-0.27478E+00,-0.28218E+00,
- &-0.28924E+00,-0.29599E+00,-0.30248E+00,-0.30872E+00,-0.31474E+00,
- &-0.32056E+00,-0.32619E+00,-0.33165E+00,-0.33695E+00,-0.34210E+00,
- &-0.34712E+00,-0.35200E+00,-0.35676E+00,-0.36141E+00,-0.36595E+00,
- &-0.37039E+00,-0.37472E+00,-0.37897E+00,-0.38313E+00,-0.38720E+00,
- &-0.39119E+00,-0.39511E+00,-0.39895E+00,-0.40271E+00,-0.40642E+00,
- &-0.41005E+00,-0.41362E+00,-0.41713E+00,-0.42058E+00,-0.42397E+00,
- &-0.42731E+00,-0.43059E+00,-0.43382E+00,-0.43700E+00,-0.44014E+00,
- &-0.44323E+00,-0.44627E+00,-0.44927E+00,-0.45222E+00,-0.45514E+00,
- &-0.45802E+00,-0.46085E+00,-0.46366E+00,-0.46642E+00,-0.46916E+00,
- &-0.47186E+00,-0.47453E+00,-0.47717E+00,-0.47978E+00,-0.48236E+00,
- &-0.48491E+00,-0.48744E+00,-0.48995E+00,-0.49243E+00,-0.49489E+00,
- &-0.49732E+00,-0.49974E+00,-0.50213E+00,-0.50451E+00,-0.50687E+00,
- &-0.50921E+00,-0.51154E+00,-0.51385E+00,-0.51614E+00,-0.51842E+00,
- &-0.52069E+00,-0.52295E+00,-0.52519E+00,-0.52742E+00,-0.52963E+00,
- &-0.53184E+00,-0.53404E+00,-0.53622E+00,-0.53840E+00,-0.54057E+00,
- &-0.54273E+00,-0.54487E+00,-0.54701E+00,-0.54915E+00,-0.55127E+00,
- &-0.55338E+00,-0.55549E+00,-0.55759E+00,-0.55968E+00,-0.56176E+00/
-
- DATA (BNC05M(I),I=101,200)/
- &-0.56384E+00,-0.56591E+00,-0.56797E+00,-0.57002E+00,-0.57206E+00,
- &-0.57410E+00,-0.57613E+00,-0.57815E+00,-0.58016E+00,-0.58217E+00,
- &-0.58417E+00,-0.58616E+00,-0.58814E+00,-0.59011E+00,-0.59208E+00,
- &-0.59404E+00,-0.59599E+00,-0.59793E+00,-0.59986E+00,-0.60178E+00,
- &-0.60370E+00,-0.60561E+00,-0.60751E+00,-0.60940E+00,-0.61128E+00,
- &-0.61316E+00,-0.61503E+00,-0.61688E+00,-0.61873E+00,-0.62058E+00,
- &-0.62241E+00,-0.62424E+00,-0.62605E+00,-0.62786E+00,-0.62966E+00,
- &-0.63146E+00,-0.63324E+00,-0.63502E+00,-0.63679E+00,-0.63855E+00,
- &-0.64030E+00,-0.64204E+00,-0.64378E+00,-0.64551E+00,-0.64723E+00,
- &-0.64895E+00,-0.65066E+00,-0.65235E+00,-0.65405E+00,-0.65573E+00,
- &-0.65741E+00,-0.65908E+00,-0.66074E+00,-0.66240E+00,-0.66405E+00,
- &-0.66569E+00,-0.66733E+00,-0.66895E+00,-0.67058E+00,-0.67219E+00,
- &-0.67380E+00,-0.67540E+00,-0.67700E+00,-0.67859E+00,-0.68017E+00,
- &-0.68174E+00,-0.68331E+00,-0.68488E+00,-0.68643E+00,-0.68798E+00,
- &-0.68953E+00,-0.69107E+00,-0.69260E+00,-0.69413E+00,-0.69565E+00,
- &-0.69716E+00,-0.69867E+00,-0.70017E+00,-0.70167E+00,-0.70316E+00,
- &-0.70465E+00,-0.70613E+00,-0.70760E+00,-0.70907E+00,-0.71054E+00,
- &-0.71199E+00,-0.71345E+00,-0.71489E+00,-0.71634E+00,-0.71777E+00,
- &-0.71920E+00,-0.72063E+00,-0.72205E+00,-0.72347E+00,-0.72488E+00,
- &-0.72629E+00,-0.72769E+00,-0.72908E+00,-0.73047E+00,-0.73186E+00/
-
- DATA (BNC05M(I),I=201,300)/
- &-0.73324E+00,-0.73462E+00,-0.73599E+00,-0.73736E+00,-0.73872E+00,
- &-0.74008E+00,-0.74143E+00,-0.74278E+00,-0.74412E+00,-0.74546E+00,
- &-0.74679E+00,-0.74812E+00,-0.74945E+00,-0.75077E+00,-0.75209E+00,
- &-0.75340E+00,-0.75471E+00,-0.75601E+00,-0.75731E+00,-0.75861E+00,
- &-0.75990E+00,-0.76118E+00,-0.76246E+00,-0.76374E+00,-0.76502E+00,
- &-0.76629E+00,-0.76755E+00,-0.76881E+00,-0.77007E+00,-0.77133E+00,
- &-0.77257E+00,-0.77382E+00,-0.77506E+00,-0.77630E+00,-0.77753E+00,
- &-0.77876E+00,-0.77999E+00,-0.78121E+00,-0.78243E+00,-0.78365E+00,
- &-0.78486E+00,-0.78607E+00,-0.78727E+00,-0.78847E+00,-0.78967E+00,
- &-0.79086E+00,-0.79205E+00,-0.79323E+00,-0.79441E+00,-0.79559E+00,
- &-0.79677E+00,-0.79794E+00,-0.79911E+00,-0.80027E+00,-0.80143E+00,
- &-0.80259E+00,-0.80375E+00,-0.80490E+00,-0.80604E+00,-0.80719E+00,
- &-0.80833E+00,-0.80947E+00,-0.81060E+00,-0.81173E+00,-0.81286E+00,
- &-0.81398E+00,-0.81510E+00,-0.81622E+00,-0.81734E+00,-0.81845E+00,
- &-0.81956E+00,-0.82066E+00,-0.82177E+00,-0.82287E+00,-0.82396E+00,
- &-0.82505E+00,-0.82614E+00,-0.82723E+00,-0.82832E+00,-0.82940E+00,
- &-0.83048E+00,-0.83155E+00,-0.83262E+00,-0.83369E+00,-0.83476E+00,
- &-0.83582E+00,-0.83688E+00,-0.83794E+00,-0.83899E+00,-0.84005E+00,
- &-0.84110E+00,-0.84214E+00,-0.84319E+00,-0.84423E+00,-0.84527E+00,
- &-0.84630E+00,-0.84733E+00,-0.84836E+00,-0.84939E+00,-0.85041E+00/
-
- DATA (BNC05M(I),I=301,400)/
- &-0.85144E+00,-0.85246E+00,-0.85347E+00,-0.85449E+00,-0.85550E+00,
- &-0.85651E+00,-0.85751E+00,-0.85852E+00,-0.85952E+00,-0.86051E+00,
- &-0.86151E+00,-0.86250E+00,-0.86349E+00,-0.86448E+00,-0.86547E+00,
- &-0.86645E+00,-0.86743E+00,-0.86841E+00,-0.86939E+00,-0.87036E+00,
- &-0.87133E+00,-0.87230E+00,-0.87327E+00,-0.87423E+00,-0.87519E+00,
- &-0.87615E+00,-0.87711E+00,-0.87806E+00,-0.87901E+00,-0.87996E+00,
- &-0.88091E+00,-0.88185E+00,-0.88280E+00,-0.88374E+00,-0.88468E+00,
- &-0.88561E+00,-0.88655E+00,-0.88748E+00,-0.88841E+00,-0.88933E+00,
- &-0.89026E+00,-0.89118E+00,-0.89210E+00,-0.89302E+00,-0.89394E+00,
- &-0.89485E+00,-0.89576E+00,-0.89667E+00,-0.89758E+00,-0.89849E+00,
- &-0.89939E+00,-0.90029E+00,-0.90119E+00,-0.90209E+00,-0.90298E+00,
- &-0.90387E+00,-0.90477E+00,-0.90565E+00,-0.90654E+00,-0.90743E+00,
- &-0.90831E+00,-0.90919E+00,-0.91007E+00,-0.91095E+00,-0.91182E+00,
- &-0.91269E+00,-0.91357E+00,-0.91443E+00,-0.91530E+00,-0.91617E+00,
- &-0.91703E+00,-0.91789E+00,-0.91875E+00,-0.91961E+00,-0.92046E+00,
- &-0.92132E+00,-0.92217E+00,-0.92302E+00,-0.92387E+00,-0.92471E+00,
- &-0.92556E+00,-0.92640E+00,-0.92724E+00,-0.92808E+00,-0.92892E+00,
- &-0.92975E+00,-0.93059E+00,-0.93142E+00,-0.93225E+00,-0.93308E+00,
- &-0.93390E+00,-0.93473E+00,-0.93555E+00,-0.93637E+00,-0.93719E+00,
- &-0.93801E+00,-0.93883E+00,-0.93964E+00,-0.94045E+00,-0.94126E+00/
-
- DATA (BNC05M(I),I=401,500)/
- &-0.94207E+00,-0.94288E+00,-0.94369E+00,-0.94449E+00,-0.94529E+00,
- &-0.94609E+00,-0.94689E+00,-0.94769E+00,-0.94849E+00,-0.94928E+00,
- &-0.95007E+00,-0.95087E+00,-0.95166E+00,-0.95244E+00,-0.95323E+00,
- &-0.95401E+00,-0.95480E+00,-0.95558E+00,-0.95636E+00,-0.95714E+00,
- &-0.95791E+00,-0.95869E+00,-0.95946E+00,-0.96023E+00,-0.96101E+00,
- &-0.96177E+00,-0.96254E+00,-0.96331E+00,-0.96407E+00,-0.96484E+00,
- &-0.96560E+00,-0.96636E+00,-0.96712E+00,-0.96787E+00,-0.96863E+00,
- &-0.96938E+00,-0.97014E+00,-0.97089E+00,-0.97164E+00,-0.97238E+00,
- &-0.97313E+00,-0.97388E+00,-0.97462E+00,-0.97536E+00,-0.97610E+00,
- &-0.97684E+00,-0.97758E+00,-0.97832E+00,-0.97905E+00,-0.97979E+00,
- &-0.98052E+00,-0.98125E+00,-0.98198E+00,-0.98271E+00,-0.98344E+00,
- &-0.98416E+00,-0.98489E+00,-0.98561E+00,-0.98633E+00,-0.98705E+00,
- &-0.98777E+00,-0.98849E+00,-0.98921E+00,-0.98992E+00,-0.99064E+00,
- &-0.99135E+00,-0.99206E+00,-0.99277E+00,-0.99348E+00,-0.99419E+00,
- &-0.99489E+00,-0.99560E+00,-0.99630E+00,-0.99700E+00,-0.99770E+00,
- &-0.99840E+00,-0.99910E+00,-0.99980E+00,-0.10005E+01,-0.10012E+01,
- &-0.10019E+01,-0.10026E+01,-0.10033E+01,-0.10040E+01,-0.10046E+01,
- &-0.10053E+01,-0.10060E+01,-0.10067E+01,-0.10074E+01,-0.10081E+01,
- &-0.10087E+01,-0.10094E+01,-0.10101E+01,-0.10108E+01,-0.10115E+01,
- &-0.10121E+01,-0.10128E+01,-0.10135E+01,-0.10142E+01,-0.10148E+01/
-
- DATA (BNC05M(I),I=501,600)/
- &-0.10155E+01,-0.10162E+01,-0.10168E+01,-0.10175E+01,-0.10182E+01,
- &-0.10188E+01,-0.10195E+01,-0.10201E+01,-0.10208E+01,-0.10215E+01,
- &-0.10221E+01,-0.10228E+01,-0.10234E+01,-0.10241E+01,-0.10247E+01,
- &-0.10254E+01,-0.10260E+01,-0.10267E+01,-0.10273E+01,-0.10280E+01,
- &-0.10286E+01,-0.10293E+01,-0.10299E+01,-0.10306E+01,-0.10312E+01,
- &-0.10319E+01,-0.10325E+01,-0.10331E+01,-0.10338E+01,-0.10344E+01,
- &-0.10351E+01,-0.10357E+01,-0.10363E+01,-0.10370E+01,-0.10376E+01,
- &-0.10382E+01,-0.10389E+01,-0.10395E+01,-0.10401E+01,-0.10407E+01,
- &-0.10414E+01,-0.10420E+01,-0.10426E+01,-0.10432E+01,-0.10439E+01,
- &-0.10445E+01,-0.10451E+01,-0.10457E+01,-0.10463E+01,-0.10470E+01,
- &-0.10476E+01,-0.10482E+01,-0.10488E+01,-0.10494E+01,-0.10500E+01,
- &-0.10506E+01,-0.10512E+01,-0.10519E+01,-0.10525E+01,-0.10531E+01,
- &-0.10537E+01,-0.10543E+01,-0.10549E+01,-0.10555E+01,-0.10561E+01,
- &-0.10567E+01,-0.10573E+01,-0.10579E+01,-0.10585E+01,-0.10591E+01,
- &-0.10597E+01,-0.10603E+01,-0.10609E+01,-0.10615E+01,-0.10621E+01,
- &-0.10627E+01,-0.10633E+01,-0.10639E+01,-0.10644E+01,-0.10650E+01,
- &-0.10656E+01,-0.10662E+01,-0.10668E+01,-0.10674E+01,-0.10680E+01,
- &-0.10685E+01,-0.10691E+01,-0.10697E+01,-0.10703E+01,-0.10709E+01,
- &-0.10715E+01,-0.10720E+01,-0.10726E+01,-0.10732E+01,-0.10738E+01,
- &-0.10743E+01,-0.10749E+01,-0.10755E+01,-0.10761E+01,-0.10766E+01/
-
- DATA (BNC05M(I),I=601,700)/
- &-0.10828E+01,-0.10883E+01,-0.10939E+01,-0.10993E+01,-0.11047E+01,
- &-0.11099E+01,-0.11152E+01,-0.11203E+01,-0.11254E+01,-0.11304E+01,
- &-0.11354E+01,-0.11403E+01,-0.11451E+01,-0.11499E+01,-0.11546E+01,
- &-0.11593E+01,-0.11639E+01,-0.11685E+01,-0.11730E+01,-0.11775E+01,
- &-0.11819E+01,-0.11863E+01,-0.11906E+01,-0.11949E+01,-0.11991E+01,
- &-0.12033E+01,-0.12075E+01,-0.12116E+01,-0.12156E+01,-0.12197E+01,
- &-0.12237E+01,-0.12276E+01,-0.12316E+01,-0.12355E+01,-0.12393E+01,
- &-0.12431E+01,-0.12469E+01,-0.12507E+01,-0.12544E+01,-0.12581E+01,
- &-0.12618E+01,-0.12654E+01,-0.12690E+01,-0.12726E+01,-0.12761E+01,
- &-0.12797E+01,-0.12831E+01,-0.12866E+01,-0.12901E+01,-0.12935E+01,
- &-0.12969E+01,-0.13002E+01,-0.13036E+01,-0.13069E+01,-0.13102E+01,
- &-0.13135E+01,-0.13167E+01,-0.13200E+01,-0.13232E+01,-0.13264E+01,
- &-0.13295E+01,-0.13327E+01,-0.13358E+01,-0.13389E+01,-0.13420E+01,
- &-0.13451E+01,-0.13481E+01,-0.13512E+01,-0.13542E+01,-0.13572E+01,
- &-0.13601E+01,-0.13631E+01,-0.13661E+01,-0.13690E+01,-0.13719E+01,
- &-0.13748E+01,-0.13777E+01,-0.13806E+01,-0.13834E+01,-0.13863E+01,
- &-0.13891E+01,-0.13919E+01,-0.13947E+01,-0.13975E+01,-0.14002E+01,
- &-0.14030E+01,-0.14057E+01,-0.14085E+01,-0.14112E+01,-0.14139E+01,
- &-0.14166E+01,-0.14192E+01,-0.14219E+01,-0.14246E+01,-0.14272E+01,
- &-0.14298E+01,-0.14325E+01,-0.14351E+01,-0.14377E+01,-0.14402E+01/
-
- DATA (BNC05M(I),I=701,741)/
- &-0.14428E+01,-0.14454E+01,-0.14479E+01,-0.14505E+01,-0.14530E+01,
- &-0.14555E+01,-0.14581E+01,-0.14606E+01,-0.14631E+01,-0.14655E+01,
- &-0.14680E+01,-0.14705E+01,-0.14729E+01,-0.14754E+01,-0.14778E+01,
- &-0.14803E+01,-0.14827E+01,-0.14851E+01,-0.14875E+01,-0.14899E+01,
- &-0.14923E+01,-0.14947E+01,-0.14970E+01,-0.14994E+01,-0.15017E+01,
- &-0.15041E+01,-0.15064E+01,-0.15088E+01,-0.15111E+01,-0.15134E+01,
- &-0.15157E+01,-0.15180E+01,-0.15203E+01,-0.15226E+01,-0.15249E+01,
- &-0.15272E+01,-0.15294E+01,-0.15317E+01,-0.15340E+01,-0.15362E+01,
- &-0.15385E+01
- & /
-C
-C *** NH4Cl
-C
- DATA (BNC06M(I),I=1,100)/
- &-0.47150E-01,-0.10066E+00,-0.12632E+00,-0.14389E+00,-0.15726E+00,
- &-0.16803E+00,-0.17700E+00,-0.18464E+00,-0.19127E+00,-0.19709E+00,
- &-0.20226E+00,-0.20689E+00,-0.21106E+00,-0.21484E+00,-0.21828E+00,
- &-0.22143E+00,-0.22432E+00,-0.22698E+00,-0.22943E+00,-0.23171E+00,
- &-0.23382E+00,-0.23578E+00,-0.23761E+00,-0.23932E+00,-0.24091E+00,
- &-0.24240E+00,-0.24380E+00,-0.24511E+00,-0.24634E+00,-0.24750E+00,
- &-0.24859E+00,-0.24961E+00,-0.25058E+00,-0.25149E+00,-0.25235E+00,
- &-0.25316E+00,-0.25393E+00,-0.25466E+00,-0.25535E+00,-0.25600E+00,
- &-0.25662E+00,-0.25721E+00,-0.25776E+00,-0.25829E+00,-0.25879E+00,
- &-0.25927E+00,-0.25972E+00,-0.26015E+00,-0.26056E+00,-0.26095E+00,
- &-0.26132E+00,-0.26167E+00,-0.26201E+00,-0.26232E+00,-0.26262E+00,
- &-0.26291E+00,-0.26318E+00,-0.26344E+00,-0.26368E+00,-0.26391E+00,
- &-0.26412E+00,-0.26433E+00,-0.26452E+00,-0.26470E+00,-0.26486E+00,
- &-0.26502E+00,-0.26516E+00,-0.26529E+00,-0.26541E+00,-0.26552E+00,
- &-0.26562E+00,-0.26570E+00,-0.26578E+00,-0.26584E+00,-0.26589E+00,
- &-0.26594E+00,-0.26597E+00,-0.26599E+00,-0.26600E+00,-0.26600E+00,
- &-0.26598E+00,-0.26596E+00,-0.26593E+00,-0.26589E+00,-0.26583E+00,
- &-0.26577E+00,-0.26569E+00,-0.26561E+00,-0.26551E+00,-0.26541E+00,
- &-0.26529E+00,-0.26517E+00,-0.26504E+00,-0.26490E+00,-0.26474E+00,
- &-0.26458E+00,-0.26441E+00,-0.26424E+00,-0.26405E+00,-0.26386E+00/
-
- DATA (BNC06M(I),I=101,200)/
- &-0.26365E+00,-0.26345E+00,-0.26323E+00,-0.26300E+00,-0.26277E+00,
- &-0.26254E+00,-0.26229E+00,-0.26204E+00,-0.26179E+00,-0.26153E+00,
- &-0.26126E+00,-0.26099E+00,-0.26071E+00,-0.26043E+00,-0.26014E+00,
- &-0.25985E+00,-0.25955E+00,-0.25925E+00,-0.25895E+00,-0.25864E+00,
- &-0.25833E+00,-0.25802E+00,-0.25770E+00,-0.25738E+00,-0.25706E+00,
- &-0.25673E+00,-0.25640E+00,-0.25607E+00,-0.25574E+00,-0.25540E+00,
- &-0.25506E+00,-0.25472E+00,-0.25438E+00,-0.25404E+00,-0.25369E+00,
- &-0.25335E+00,-0.25300E+00,-0.25265E+00,-0.25230E+00,-0.25194E+00,
- &-0.25159E+00,-0.25123E+00,-0.25088E+00,-0.25052E+00,-0.25016E+00,
- &-0.24980E+00,-0.24944E+00,-0.24908E+00,-0.24872E+00,-0.24835E+00,
- &-0.24799E+00,-0.24762E+00,-0.24726E+00,-0.24689E+00,-0.24652E+00,
- &-0.24615E+00,-0.24578E+00,-0.24541E+00,-0.24504E+00,-0.24467E+00,
- &-0.24430E+00,-0.24393E+00,-0.24356E+00,-0.24318E+00,-0.24281E+00,
- &-0.24244E+00,-0.24206E+00,-0.24169E+00,-0.24131E+00,-0.24094E+00,
- &-0.24056E+00,-0.24019E+00,-0.23981E+00,-0.23943E+00,-0.23906E+00,
- &-0.23868E+00,-0.23830E+00,-0.23792E+00,-0.23755E+00,-0.23717E+00,
- &-0.23679E+00,-0.23641E+00,-0.23603E+00,-0.23566E+00,-0.23528E+00,
- &-0.23490E+00,-0.23452E+00,-0.23414E+00,-0.23376E+00,-0.23339E+00,
- &-0.23301E+00,-0.23263E+00,-0.23225E+00,-0.23187E+00,-0.23149E+00,
- &-0.23111E+00,-0.23073E+00,-0.23036E+00,-0.22998E+00,-0.22960E+00/
-
- DATA (BNC06M(I),I=201,300)/
- &-0.22922E+00,-0.22884E+00,-0.22847E+00,-0.22809E+00,-0.22771E+00,
- &-0.22733E+00,-0.22695E+00,-0.22658E+00,-0.22620E+00,-0.22582E+00,
- &-0.22545E+00,-0.22507E+00,-0.22469E+00,-0.22432E+00,-0.22394E+00,
- &-0.22357E+00,-0.22319E+00,-0.22282E+00,-0.22244E+00,-0.22207E+00,
- &-0.22169E+00,-0.22132E+00,-0.22094E+00,-0.22057E+00,-0.22020E+00,
- &-0.21982E+00,-0.21945E+00,-0.21908E+00,-0.21871E+00,-0.21833E+00,
- &-0.21796E+00,-0.21759E+00,-0.21722E+00,-0.21685E+00,-0.21648E+00,
- &-0.21611E+00,-0.21574E+00,-0.21537E+00,-0.21500E+00,-0.21463E+00,
- &-0.21426E+00,-0.21390E+00,-0.21353E+00,-0.21316E+00,-0.21280E+00,
- &-0.21243E+00,-0.21206E+00,-0.21170E+00,-0.21133E+00,-0.21097E+00,
- &-0.21060E+00,-0.21024E+00,-0.20987E+00,-0.20951E+00,-0.20915E+00,
- &-0.20879E+00,-0.20842E+00,-0.20806E+00,-0.20770E+00,-0.20734E+00,
- &-0.20698E+00,-0.20662E+00,-0.20626E+00,-0.20590E+00,-0.20554E+00,
- &-0.20518E+00,-0.20483E+00,-0.20447E+00,-0.20411E+00,-0.20376E+00,
- &-0.20340E+00,-0.20304E+00,-0.20269E+00,-0.20233E+00,-0.20198E+00,
- &-0.20163E+00,-0.20127E+00,-0.20092E+00,-0.20057E+00,-0.20022E+00,
- &-0.19986E+00,-0.19951E+00,-0.19916E+00,-0.19881E+00,-0.19846E+00,
- &-0.19811E+00,-0.19776E+00,-0.19742E+00,-0.19707E+00,-0.19672E+00,
- &-0.19637E+00,-0.19603E+00,-0.19568E+00,-0.19534E+00,-0.19499E+00,
- &-0.19465E+00,-0.19430E+00,-0.19396E+00,-0.19362E+00,-0.19327E+00/
-
- DATA (BNC06M(I),I=301,400)/
- &-0.19293E+00,-0.19259E+00,-0.19225E+00,-0.19191E+00,-0.19157E+00,
- &-0.19123E+00,-0.19089E+00,-0.19055E+00,-0.19021E+00,-0.18988E+00,
- &-0.18954E+00,-0.18920E+00,-0.18887E+00,-0.18853E+00,-0.18819E+00,
- &-0.18786E+00,-0.18752E+00,-0.18719E+00,-0.18686E+00,-0.18652E+00,
- &-0.18619E+00,-0.18586E+00,-0.18553E+00,-0.18520E+00,-0.18487E+00,
- &-0.18454E+00,-0.18421E+00,-0.18388E+00,-0.18355E+00,-0.18322E+00,
- &-0.18290E+00,-0.18257E+00,-0.18224E+00,-0.18192E+00,-0.18159E+00,
- &-0.18127E+00,-0.18094E+00,-0.18062E+00,-0.18029E+00,-0.17997E+00,
- &-0.17965E+00,-0.17933E+00,-0.17901E+00,-0.17868E+00,-0.17836E+00,
- &-0.17804E+00,-0.17772E+00,-0.17741E+00,-0.17709E+00,-0.17677E+00,
- &-0.17645E+00,-0.17613E+00,-0.17582E+00,-0.17550E+00,-0.17519E+00,
- &-0.17487E+00,-0.17456E+00,-0.17424E+00,-0.17393E+00,-0.17362E+00,
- &-0.17330E+00,-0.17299E+00,-0.17268E+00,-0.17237E+00,-0.17206E+00,
- &-0.17175E+00,-0.17144E+00,-0.17113E+00,-0.17082E+00,-0.17051E+00,
- &-0.17020E+00,-0.16990E+00,-0.16959E+00,-0.16928E+00,-0.16898E+00,
- &-0.16867E+00,-0.16837E+00,-0.16806E+00,-0.16776E+00,-0.16746E+00,
- &-0.16715E+00,-0.16685E+00,-0.16655E+00,-0.16625E+00,-0.16595E+00,
- &-0.16565E+00,-0.16535E+00,-0.16505E+00,-0.16475E+00,-0.16445E+00,
- &-0.16415E+00,-0.16385E+00,-0.16355E+00,-0.16326E+00,-0.16296E+00,
- &-0.16267E+00,-0.16237E+00,-0.16208E+00,-0.16178E+00,-0.16149E+00/
-
- DATA (BNC06M(I),I=401,500)/
- &-0.16119E+00,-0.16090E+00,-0.16061E+00,-0.16032E+00,-0.16003E+00,
- &-0.15973E+00,-0.15944E+00,-0.15915E+00,-0.15886E+00,-0.15858E+00,
- &-0.15829E+00,-0.15800E+00,-0.15771E+00,-0.15742E+00,-0.15714E+00,
- &-0.15685E+00,-0.15656E+00,-0.15628E+00,-0.15599E+00,-0.15571E+00,
- &-0.15543E+00,-0.15514E+00,-0.15486E+00,-0.15458E+00,-0.15429E+00,
- &-0.15401E+00,-0.15373E+00,-0.15345E+00,-0.15317E+00,-0.15289E+00,
- &-0.15261E+00,-0.15233E+00,-0.15205E+00,-0.15177E+00,-0.15150E+00,
- &-0.15122E+00,-0.15094E+00,-0.15067E+00,-0.15039E+00,-0.15012E+00,
- &-0.14984E+00,-0.14957E+00,-0.14929E+00,-0.14902E+00,-0.14875E+00,
- &-0.14847E+00,-0.14820E+00,-0.14793E+00,-0.14766E+00,-0.14739E+00,
- &-0.14712E+00,-0.14685E+00,-0.14658E+00,-0.14631E+00,-0.14604E+00,
- &-0.14577E+00,-0.14550E+00,-0.14523E+00,-0.14497E+00,-0.14470E+00,
- &-0.14443E+00,-0.14417E+00,-0.14390E+00,-0.14364E+00,-0.14337E+00,
- &-0.14311E+00,-0.14285E+00,-0.14258E+00,-0.14232E+00,-0.14206E+00,
- &-0.14180E+00,-0.14154E+00,-0.14127E+00,-0.14101E+00,-0.14075E+00,
- &-0.14049E+00,-0.14024E+00,-0.13998E+00,-0.13972E+00,-0.13946E+00,
- &-0.13920E+00,-0.13895E+00,-0.13869E+00,-0.13843E+00,-0.13818E+00,
- &-0.13792E+00,-0.13767E+00,-0.13741E+00,-0.13716E+00,-0.13690E+00,
- &-0.13665E+00,-0.13640E+00,-0.13614E+00,-0.13589E+00,-0.13564E+00,
- &-0.13539E+00,-0.13514E+00,-0.13489E+00,-0.13464E+00,-0.13439E+00/
-
- DATA (BNC06M(I),I=501,600)/
- &-0.13414E+00,-0.13389E+00,-0.13364E+00,-0.13339E+00,-0.13315E+00,
- &-0.13290E+00,-0.13265E+00,-0.13241E+00,-0.13216E+00,-0.13191E+00,
- &-0.13167E+00,-0.13142E+00,-0.13118E+00,-0.13094E+00,-0.13069E+00,
- &-0.13045E+00,-0.13021E+00,-0.12996E+00,-0.12972E+00,-0.12948E+00,
- &-0.12924E+00,-0.12900E+00,-0.12876E+00,-0.12852E+00,-0.12828E+00,
- &-0.12804E+00,-0.12780E+00,-0.12756E+00,-0.12732E+00,-0.12708E+00,
- &-0.12685E+00,-0.12661E+00,-0.12637E+00,-0.12614E+00,-0.12590E+00,
- &-0.12567E+00,-0.12543E+00,-0.12520E+00,-0.12496E+00,-0.12473E+00,
- &-0.12449E+00,-0.12426E+00,-0.12403E+00,-0.12380E+00,-0.12356E+00,
- &-0.12333E+00,-0.12310E+00,-0.12287E+00,-0.12264E+00,-0.12241E+00,
- &-0.12218E+00,-0.12195E+00,-0.12172E+00,-0.12149E+00,-0.12127E+00,
- &-0.12104E+00,-0.12081E+00,-0.12058E+00,-0.12036E+00,-0.12013E+00,
- &-0.11990E+00,-0.11968E+00,-0.11945E+00,-0.11923E+00,-0.11900E+00,
- &-0.11878E+00,-0.11856E+00,-0.11833E+00,-0.11811E+00,-0.11789E+00,
- &-0.11766E+00,-0.11744E+00,-0.11722E+00,-0.11700E+00,-0.11678E+00,
- &-0.11656E+00,-0.11634E+00,-0.11612E+00,-0.11590E+00,-0.11568E+00,
- &-0.11546E+00,-0.11524E+00,-0.11502E+00,-0.11481E+00,-0.11459E+00,
- &-0.11437E+00,-0.11416E+00,-0.11394E+00,-0.11372E+00,-0.11351E+00,
- &-0.11329E+00,-0.11308E+00,-0.11286E+00,-0.11265E+00,-0.11244E+00,
- &-0.11222E+00,-0.11201E+00,-0.11180E+00,-0.11158E+00,-0.11137E+00/
-
- DATA (BNC06M(I),I=601,700)/
- &-0.10910E+00,-0.10704E+00,-0.10500E+00,-0.10300E+00,-0.10104E+00,
- &-0.99099E-01,-0.97194E-01,-0.95319E-01,-0.93474E-01,-0.91659E-01,
- &-0.89872E-01,-0.88114E-01,-0.86385E-01,-0.84682E-01,-0.83007E-01,
- &-0.81358E-01,-0.79736E-01,-0.78139E-01,-0.76568E-01,-0.75022E-01,
- &-0.73500E-01,-0.72002E-01,-0.70529E-01,-0.69079E-01,-0.67651E-01,
- &-0.66247E-01,-0.64865E-01,-0.63505E-01,-0.62167E-01,-0.60850E-01,
- &-0.59554E-01,-0.58278E-01,-0.57024E-01,-0.55789E-01,-0.54574E-01,
- &-0.53379E-01,-0.52203E-01,-0.51046E-01,-0.49908E-01,-0.48788E-01,
- &-0.47686E-01,-0.46602E-01,-0.45536E-01,-0.44487E-01,-0.43456E-01,
- &-0.42441E-01,-0.41444E-01,-0.40462E-01,-0.39497E-01,-0.38548E-01,
- &-0.37615E-01,-0.36697E-01,-0.35795E-01,-0.34908E-01,-0.34037E-01,
- &-0.33180E-01,-0.32337E-01,-0.31509E-01,-0.30696E-01,-0.29896E-01,
- &-0.29110E-01,-0.28338E-01,-0.27580E-01,-0.26835E-01,-0.26103E-01,
- &-0.25384E-01,-0.24679E-01,-0.23985E-01,-0.23305E-01,-0.22637E-01,
- &-0.21981E-01,-0.21338E-01,-0.20706E-01,-0.20086E-01,-0.19478E-01,
- &-0.18882E-01,-0.18297E-01,-0.17724E-01,-0.17161E-01,-0.16610E-01,
- &-0.16070E-01,-0.15540E-01,-0.15021E-01,-0.14513E-01,-0.14015E-01,
- &-0.13528E-01,-0.13050E-01,-0.12583E-01,-0.12126E-01,-0.11679E-01,
- &-0.11242E-01,-0.10814E-01,-0.10396E-01,-0.99873E-02,-0.95881E-02,
- &-0.91981E-02,-0.88174E-02,-0.84457E-02,-0.80831E-02,-0.77293E-02/
-
- DATA (BNC06M(I),I=701,741)/
- &-0.73844E-02,-0.70483E-02,-0.67208E-02,-0.64018E-02,-0.60913E-02,
- &-0.57891E-02,-0.54953E-02,-0.52097E-02,-0.49322E-02,-0.46628E-02,
- &-0.44013E-02,-0.41478E-02,-0.39020E-02,-0.36640E-02,-0.34338E-02,
- &-0.32110E-02,-0.29958E-02,-0.27881E-02,-0.25878E-02,-0.23947E-02,
- &-0.22090E-02,-0.20303E-02,-0.18588E-02,-0.16944E-02,-0.15370E-02,
- &-0.13864E-02,-0.12427E-02,-0.11059E-02,-0.97561E-03,-0.85213E-03,
- &-0.73525E-03,-0.62493E-03,-0.52107E-03,-0.42366E-03,-0.33261E-03,
- &-0.24793E-03,-0.16947E-03,-0.97264E-04,-0.31222E-04, 0.28782E-04,
- & 0.82683E-04
- & /
-C
-C *** (2H,SO4)
-C
- DATA (BNC07M(I),I=1,100)/
- &-0.95410E-01,-0.20734E+00,-0.26314E+00,-0.30252E+00,-0.33337E+00,
- &-0.35888E+00,-0.38069E+00,-0.39978E+00,-0.41677E+00,-0.43209E+00,
- &-0.44604E+00,-0.45886E+00,-0.47072E+00,-0.48176E+00,-0.49209E+00,
- &-0.50179E+00,-0.51093E+00,-0.51959E+00,-0.52781E+00,-0.53563E+00,
- &-0.54309E+00,-0.55022E+00,-0.55706E+00,-0.56362E+00,-0.56993E+00,
- &-0.57600E+00,-0.58186E+00,-0.58752E+00,-0.59299E+00,-0.59828E+00,
- &-0.60341E+00,-0.60839E+00,-0.61322E+00,-0.61792E+00,-0.62249E+00,
- &-0.62693E+00,-0.63126E+00,-0.63549E+00,-0.63961E+00,-0.64363E+00,
- &-0.64755E+00,-0.65139E+00,-0.65514E+00,-0.65881E+00,-0.66240E+00,
- &-0.66592E+00,-0.66937E+00,-0.67275E+00,-0.67606E+00,-0.67931E+00,
- &-0.68250E+00,-0.68563E+00,-0.68871E+00,-0.69173E+00,-0.69470E+00,
- &-0.69762E+00,-0.70049E+00,-0.70331E+00,-0.70609E+00,-0.70883E+00,
- &-0.71153E+00,-0.71418E+00,-0.71680E+00,-0.71938E+00,-0.72192E+00,
- &-0.72442E+00,-0.72690E+00,-0.72933E+00,-0.73174E+00,-0.73412E+00,
- &-0.73646E+00,-0.73878E+00,-0.74107E+00,-0.74333E+00,-0.74556E+00,
- &-0.74777E+00,-0.74996E+00,-0.75212E+00,-0.75425E+00,-0.75636E+00,
- &-0.75845E+00,-0.76052E+00,-0.76257E+00,-0.76460E+00,-0.76661E+00,
- &-0.76859E+00,-0.77056E+00,-0.77251E+00,-0.77444E+00,-0.77636E+00,
- &-0.77826E+00,-0.78014E+00,-0.78200E+00,-0.78385E+00,-0.78568E+00,
- &-0.78750E+00,-0.78930E+00,-0.79109E+00,-0.79286E+00,-0.79462E+00/
-
- DATA (BNC07M(I),I=101,200)/
- &-0.79637E+00,-0.79810E+00,-0.79982E+00,-0.80152E+00,-0.80322E+00,
- &-0.80490E+00,-0.80657E+00,-0.80822E+00,-0.80987E+00,-0.81150E+00,
- &-0.81312E+00,-0.81473E+00,-0.81633E+00,-0.81791E+00,-0.81949E+00,
- &-0.82106E+00,-0.82261E+00,-0.82416E+00,-0.82569E+00,-0.82722E+00,
- &-0.82873E+00,-0.83024E+00,-0.83173E+00,-0.83322E+00,-0.83469E+00,
- &-0.83616E+00,-0.83762E+00,-0.83907E+00,-0.84051E+00,-0.84194E+00,
- &-0.84337E+00,-0.84478E+00,-0.84619E+00,-0.84759E+00,-0.84898E+00,
- &-0.85036E+00,-0.85174E+00,-0.85310E+00,-0.85446E+00,-0.85581E+00,
- &-0.85716E+00,-0.85850E+00,-0.85983E+00,-0.86115E+00,-0.86246E+00,
- &-0.86377E+00,-0.86507E+00,-0.86637E+00,-0.86766E+00,-0.86894E+00,
- &-0.87022E+00,-0.87148E+00,-0.87275E+00,-0.87400E+00,-0.87525E+00,
- &-0.87650E+00,-0.87774E+00,-0.87897E+00,-0.88020E+00,-0.88142E+00,
- &-0.88263E+00,-0.88384E+00,-0.88504E+00,-0.88624E+00,-0.88744E+00,
- &-0.88862E+00,-0.88980E+00,-0.89098E+00,-0.89215E+00,-0.89332E+00,
- &-0.89448E+00,-0.89564E+00,-0.89679E+00,-0.89794E+00,-0.89908E+00,
- &-0.90022E+00,-0.90135E+00,-0.90248E+00,-0.90360E+00,-0.90472E+00,
- &-0.90583E+00,-0.90694E+00,-0.90805E+00,-0.90915E+00,-0.91024E+00,
- &-0.91134E+00,-0.91242E+00,-0.91351E+00,-0.91459E+00,-0.91566E+00,
- &-0.91673E+00,-0.91780E+00,-0.91887E+00,-0.91993E+00,-0.92098E+00,
- &-0.92203E+00,-0.92308E+00,-0.92413E+00,-0.92517E+00,-0.92620E+00/
-
- DATA (BNC07M(I),I=201,300)/
- &-0.92724E+00,-0.92827E+00,-0.92929E+00,-0.93032E+00,-0.93134E+00,
- &-0.93235E+00,-0.93336E+00,-0.93437E+00,-0.93538E+00,-0.93638E+00,
- &-0.93738E+00,-0.93837E+00,-0.93937E+00,-0.94035E+00,-0.94134E+00,
- &-0.94232E+00,-0.94330E+00,-0.94428E+00,-0.94525E+00,-0.94622E+00,
- &-0.94719E+00,-0.94815E+00,-0.94912E+00,-0.95007E+00,-0.95103E+00,
- &-0.95198E+00,-0.95293E+00,-0.95388E+00,-0.95482E+00,-0.95576E+00,
- &-0.95670E+00,-0.95764E+00,-0.95857E+00,-0.95950E+00,-0.96043E+00,
- &-0.96135E+00,-0.96228E+00,-0.96320E+00,-0.96411E+00,-0.96503E+00,
- &-0.96594E+00,-0.96685E+00,-0.96776E+00,-0.96866E+00,-0.96956E+00,
- &-0.97046E+00,-0.97136E+00,-0.97226E+00,-0.97315E+00,-0.97404E+00,
- &-0.97493E+00,-0.97581E+00,-0.97670E+00,-0.97758E+00,-0.97845E+00,
- &-0.97933E+00,-0.98021E+00,-0.98108E+00,-0.98195E+00,-0.98281E+00,
- &-0.98368E+00,-0.98454E+00,-0.98540E+00,-0.98626E+00,-0.98712E+00,
- &-0.98798E+00,-0.98883E+00,-0.98968E+00,-0.99053E+00,-0.99137E+00,
- &-0.99222E+00,-0.99306E+00,-0.99390E+00,-0.99474E+00,-0.99558E+00,
- &-0.99641E+00,-0.99725E+00,-0.99808E+00,-0.99891E+00,-0.99973E+00,
- &-0.10006E+01,-0.10014E+01,-0.10022E+01,-0.10030E+01,-0.10038E+01,
- &-0.10047E+01,-0.10055E+01,-0.10063E+01,-0.10071E+01,-0.10079E+01,
- &-0.10087E+01,-0.10095E+01,-0.10103E+01,-0.10111E+01,-0.10119E+01,
- &-0.10127E+01,-0.10135E+01,-0.10143E+01,-0.10151E+01,-0.10159E+01/
-
- DATA (BNC07M(I),I=301,400)/
- &-0.10167E+01,-0.10175E+01,-0.10183E+01,-0.10191E+01,-0.10198E+01,
- &-0.10206E+01,-0.10214E+01,-0.10222E+01,-0.10230E+01,-0.10237E+01,
- &-0.10245E+01,-0.10253E+01,-0.10261E+01,-0.10268E+01,-0.10276E+01,
- &-0.10284E+01,-0.10291E+01,-0.10299E+01,-0.10307E+01,-0.10314E+01,
- &-0.10322E+01,-0.10329E+01,-0.10337E+01,-0.10344E+01,-0.10352E+01,
- &-0.10360E+01,-0.10367E+01,-0.10375E+01,-0.10382E+01,-0.10390E+01,
- &-0.10397E+01,-0.10404E+01,-0.10412E+01,-0.10419E+01,-0.10427E+01,
- &-0.10434E+01,-0.10442E+01,-0.10449E+01,-0.10456E+01,-0.10464E+01,
- &-0.10471E+01,-0.10478E+01,-0.10486E+01,-0.10493E+01,-0.10500E+01,
- &-0.10507E+01,-0.10515E+01,-0.10522E+01,-0.10529E+01,-0.10536E+01,
- &-0.10544E+01,-0.10551E+01,-0.10558E+01,-0.10565E+01,-0.10572E+01,
- &-0.10579E+01,-0.10587E+01,-0.10594E+01,-0.10601E+01,-0.10608E+01,
- &-0.10615E+01,-0.10622E+01,-0.10629E+01,-0.10636E+01,-0.10643E+01,
- &-0.10650E+01,-0.10657E+01,-0.10664E+01,-0.10671E+01,-0.10678E+01,
- &-0.10685E+01,-0.10692E+01,-0.10699E+01,-0.10706E+01,-0.10713E+01,
- &-0.10720E+01,-0.10727E+01,-0.10734E+01,-0.10741E+01,-0.10748E+01,
- &-0.10755E+01,-0.10761E+01,-0.10768E+01,-0.10775E+01,-0.10782E+01,
- &-0.10789E+01,-0.10796E+01,-0.10802E+01,-0.10809E+01,-0.10816E+01,
- &-0.10823E+01,-0.10830E+01,-0.10836E+01,-0.10843E+01,-0.10850E+01,
- &-0.10857E+01,-0.10863E+01,-0.10870E+01,-0.10877E+01,-0.10883E+01/
-
- DATA (BNC07M(I),I=401,500)/
- &-0.10890E+01,-0.10897E+01,-0.10903E+01,-0.10910E+01,-0.10917E+01,
- &-0.10923E+01,-0.10930E+01,-0.10937E+01,-0.10943E+01,-0.10950E+01,
- &-0.10956E+01,-0.10963E+01,-0.10970E+01,-0.10976E+01,-0.10983E+01,
- &-0.10989E+01,-0.10996E+01,-0.11002E+01,-0.11009E+01,-0.11015E+01,
- &-0.11022E+01,-0.11028E+01,-0.11035E+01,-0.11041E+01,-0.11048E+01,
- &-0.11054E+01,-0.11061E+01,-0.11067E+01,-0.11074E+01,-0.11080E+01,
- &-0.11086E+01,-0.11093E+01,-0.11099E+01,-0.11106E+01,-0.11112E+01,
- &-0.11118E+01,-0.11125E+01,-0.11131E+01,-0.11138E+01,-0.11144E+01,
- &-0.11150E+01,-0.11157E+01,-0.11163E+01,-0.11169E+01,-0.11176E+01,
- &-0.11182E+01,-0.11188E+01,-0.11195E+01,-0.11201E+01,-0.11207E+01,
- &-0.11213E+01,-0.11220E+01,-0.11226E+01,-0.11232E+01,-0.11238E+01,
- &-0.11245E+01,-0.11251E+01,-0.11257E+01,-0.11263E+01,-0.11270E+01,
- &-0.11276E+01,-0.11282E+01,-0.11288E+01,-0.11294E+01,-0.11300E+01,
- &-0.11307E+01,-0.11313E+01,-0.11319E+01,-0.11325E+01,-0.11331E+01,
- &-0.11337E+01,-0.11344E+01,-0.11350E+01,-0.11356E+01,-0.11362E+01,
- &-0.11368E+01,-0.11374E+01,-0.11380E+01,-0.11386E+01,-0.11392E+01,
- &-0.11398E+01,-0.11404E+01,-0.11410E+01,-0.11417E+01,-0.11423E+01,
- &-0.11429E+01,-0.11435E+01,-0.11441E+01,-0.11447E+01,-0.11453E+01,
- &-0.11459E+01,-0.11465E+01,-0.11471E+01,-0.11477E+01,-0.11483E+01,
- &-0.11489E+01,-0.11495E+01,-0.11501E+01,-0.11507E+01,-0.11512E+01/
-
- DATA (BNC07M(I),I=501,600)/
- &-0.11518E+01,-0.11524E+01,-0.11530E+01,-0.11536E+01,-0.11542E+01,
- &-0.11548E+01,-0.11554E+01,-0.11560E+01,-0.11566E+01,-0.11572E+01,
- &-0.11578E+01,-0.11583E+01,-0.11589E+01,-0.11595E+01,-0.11601E+01,
- &-0.11607E+01,-0.11613E+01,-0.11619E+01,-0.11624E+01,-0.11630E+01,
- &-0.11636E+01,-0.11642E+01,-0.11648E+01,-0.11654E+01,-0.11659E+01,
- &-0.11665E+01,-0.11671E+01,-0.11677E+01,-0.11683E+01,-0.11688E+01,
- &-0.11694E+01,-0.11700E+01,-0.11706E+01,-0.11711E+01,-0.11717E+01,
- &-0.11723E+01,-0.11729E+01,-0.11734E+01,-0.11740E+01,-0.11746E+01,
- &-0.11752E+01,-0.11757E+01,-0.11763E+01,-0.11769E+01,-0.11774E+01,
- &-0.11780E+01,-0.11786E+01,-0.11792E+01,-0.11797E+01,-0.11803E+01,
- &-0.11809E+01,-0.11814E+01,-0.11820E+01,-0.11826E+01,-0.11831E+01,
- &-0.11837E+01,-0.11842E+01,-0.11848E+01,-0.11854E+01,-0.11859E+01,
- &-0.11865E+01,-0.11871E+01,-0.11876E+01,-0.11882E+01,-0.11887E+01,
- &-0.11893E+01,-0.11899E+01,-0.11904E+01,-0.11910E+01,-0.11915E+01,
- &-0.11921E+01,-0.11927E+01,-0.11932E+01,-0.11938E+01,-0.11943E+01,
- &-0.11949E+01,-0.11954E+01,-0.11960E+01,-0.11965E+01,-0.11971E+01,
- &-0.11977E+01,-0.11982E+01,-0.11988E+01,-0.11993E+01,-0.11999E+01,
- &-0.12004E+01,-0.12010E+01,-0.12015E+01,-0.12021E+01,-0.12026E+01,
- &-0.12032E+01,-0.12037E+01,-0.12043E+01,-0.12048E+01,-0.12054E+01,
- &-0.12059E+01,-0.12065E+01,-0.12070E+01,-0.12075E+01,-0.12081E+01/
-
- DATA (BNC07M(I),I=601,700)/
- &-0.12140E+01,-0.12193E+01,-0.12247E+01,-0.12300E+01,-0.12353E+01,
- &-0.12405E+01,-0.12457E+01,-0.12509E+01,-0.12560E+01,-0.12611E+01,
- &-0.12662E+01,-0.12712E+01,-0.12763E+01,-0.12812E+01,-0.12862E+01,
- &-0.12911E+01,-0.12960E+01,-0.13009E+01,-0.13058E+01,-0.13106E+01,
- &-0.13154E+01,-0.13202E+01,-0.13250E+01,-0.13297E+01,-0.13344E+01,
- &-0.13391E+01,-0.13438E+01,-0.13484E+01,-0.13531E+01,-0.13577E+01,
- &-0.13623E+01,-0.13669E+01,-0.13714E+01,-0.13760E+01,-0.13805E+01,
- &-0.13850E+01,-0.13895E+01,-0.13940E+01,-0.13984E+01,-0.14029E+01,
- &-0.14073E+01,-0.14117E+01,-0.14161E+01,-0.14205E+01,-0.14249E+01,
- &-0.14292E+01,-0.14336E+01,-0.14379E+01,-0.14422E+01,-0.14465E+01,
- &-0.14508E+01,-0.14551E+01,-0.14593E+01,-0.14636E+01,-0.14678E+01,
- &-0.14720E+01,-0.14763E+01,-0.14805E+01,-0.14847E+01,-0.14888E+01,
- &-0.14930E+01,-0.14972E+01,-0.15013E+01,-0.15055E+01,-0.15096E+01,
- &-0.15137E+01,-0.15178E+01,-0.15219E+01,-0.15260E+01,-0.15301E+01,
- &-0.15341E+01,-0.15382E+01,-0.15423E+01,-0.15463E+01,-0.15503E+01,
- &-0.15544E+01,-0.15584E+01,-0.15624E+01,-0.15664E+01,-0.15704E+01,
- &-0.15744E+01,-0.15783E+01,-0.15823E+01,-0.15863E+01,-0.15902E+01,
- &-0.15941E+01,-0.15981E+01,-0.16020E+01,-0.16059E+01,-0.16098E+01,
- &-0.16138E+01,-0.16176E+01,-0.16215E+01,-0.16254E+01,-0.16293E+01,
- &-0.16332E+01,-0.16370E+01,-0.16409E+01,-0.16448E+01,-0.16486E+01/
-
- DATA (BNC07M(I),I=701,741)/
- &-0.16524E+01,-0.16563E+01,-0.16601E+01,-0.16639E+01,-0.16677E+01,
- &-0.16715E+01,-0.16753E+01,-0.16791E+01,-0.16829E+01,-0.16867E+01,
- &-0.16905E+01,-0.16943E+01,-0.16980E+01,-0.17018E+01,-0.17055E+01,
- &-0.17093E+01,-0.17130E+01,-0.17168E+01,-0.17205E+01,-0.17243E+01,
- &-0.17280E+01,-0.17317E+01,-0.17354E+01,-0.17391E+01,-0.17428E+01,
- &-0.17465E+01,-0.17502E+01,-0.17539E+01,-0.17576E+01,-0.17613E+01,
- &-0.17650E+01,-0.17686E+01,-0.17723E+01,-0.17760E+01,-0.17796E+01,
- &-0.17833E+01,-0.17869E+01,-0.17906E+01,-0.17942E+01,-0.17978E+01,
- &-0.18015E+01
- & /
-C
-C *** (H,HSO4)
-C
- DATA (BNC08M(I),I=1,100)/
- &-0.44732E-01,-0.88841E-01,-0.10667E+00,-0.11710E+00,-0.12376E+00,
- &-0.12807E+00,-0.13075E+00,-0.13222E+00,-0.13274E+00,-0.13249E+00,
- &-0.13160E+00,-0.13016E+00,-0.12825E+00,-0.12592E+00,-0.12321E+00,
- &-0.12016E+00,-0.11680E+00,-0.11316E+00,-0.10925E+00,-0.10509E+00,
- &-0.10070E+00,-0.96097E-01,-0.91288E-01,-0.86286E-01,-0.81100E-01,
- &-0.75739E-01,-0.70212E-01,-0.64527E-01,-0.58690E-01,-0.52709E-01,
- &-0.46590E-01,-0.40338E-01,-0.33960E-01,-0.27460E-01,-0.20845E-01,
- &-0.14118E-01,-0.72843E-02,-0.34872E-03, 0.66847E-02, 0.13812E-01,
- & 0.21029E-01, 0.28331E-01, 0.35716E-01, 0.43180E-01, 0.50719E-01,
- & 0.58331E-01, 0.66012E-01, 0.73759E-01, 0.81569E-01, 0.89441E-01,
- & 0.97371E-01, 0.10536E+00, 0.11340E+00, 0.12149E+00, 0.12963E+00,
- & 0.13783E+00, 0.14607E+00, 0.15435E+00, 0.16268E+00, 0.17106E+00,
- & 0.17947E+00, 0.18793E+00, 0.19643E+00, 0.20498E+00, 0.21356E+00,
- & 0.22219E+00, 0.23085E+00, 0.23956E+00, 0.24831E+00, 0.25710E+00,
- & 0.26593E+00, 0.27481E+00, 0.28372E+00, 0.29269E+00, 0.30169E+00,
- & 0.31074E+00, 0.31984E+00, 0.32898E+00, 0.33817E+00, 0.34741E+00,
- & 0.35669E+00, 0.36602E+00, 0.37541E+00, 0.38484E+00, 0.39432E+00,
- & 0.40385E+00, 0.41343E+00, 0.42306E+00, 0.43273E+00, 0.44246E+00,
- & 0.45224E+00, 0.46206E+00, 0.47193E+00, 0.48185E+00, 0.49181E+00,
- & 0.50182E+00, 0.51187E+00, 0.52196E+00, 0.53209E+00, 0.54227E+00/
-
- DATA (BNC08M(I),I=101,200)/
- & 0.55248E+00, 0.56272E+00, 0.57300E+00, 0.58331E+00, 0.59366E+00,
- & 0.60403E+00, 0.61442E+00, 0.62485E+00, 0.63529E+00, 0.64576E+00,
- & 0.65625E+00, 0.66675E+00, 0.67727E+00, 0.68780E+00, 0.69835E+00,
- & 0.70890E+00, 0.71946E+00, 0.73003E+00, 0.74061E+00, 0.75119E+00,
- & 0.76177E+00, 0.77235E+00, 0.78293E+00, 0.79351E+00, 0.80408E+00,
- & 0.81465E+00, 0.82522E+00, 0.83577E+00, 0.84633E+00, 0.85687E+00,
- & 0.86740E+00, 0.87792E+00, 0.88844E+00, 0.89894E+00, 0.90942E+00,
- & 0.91990E+00, 0.93036E+00, 0.94081E+00, 0.95124E+00, 0.96166E+00,
- & 0.97206E+00, 0.98244E+00, 0.99281E+00, 0.10032E+01, 0.10135E+01,
- & 0.10238E+01, 0.10341E+01, 0.10444E+01, 0.10547E+01, 0.10649E+01,
- & 0.10752E+01, 0.10854E+01, 0.10956E+01, 0.11057E+01, 0.11159E+01,
- & 0.11260E+01, 0.11361E+01, 0.11462E+01, 0.11563E+01, 0.11664E+01,
- & 0.11764E+01, 0.11864E+01, 0.11964E+01, 0.12064E+01, 0.12164E+01,
- & 0.12263E+01, 0.12362E+01, 0.12461E+01, 0.12560E+01, 0.12658E+01,
- & 0.12757E+01, 0.12855E+01, 0.12953E+01, 0.13051E+01, 0.13148E+01,
- & 0.13246E+01, 0.13343E+01, 0.13440E+01, 0.13536E+01, 0.13633E+01,
- & 0.13729E+01, 0.13825E+01, 0.13921E+01, 0.14017E+01, 0.14112E+01,
- & 0.14208E+01, 0.14303E+01, 0.14398E+01, 0.14492E+01, 0.14587E+01,
- & 0.14681E+01, 0.14775E+01, 0.14869E+01, 0.14963E+01, 0.15056E+01,
- & 0.15150E+01, 0.15243E+01, 0.15336E+01, 0.15428E+01, 0.15521E+01/
-
- DATA (BNC08M(I),I=201,300)/
- & 0.15613E+01, 0.15705E+01, 0.15797E+01, 0.15889E+01, 0.15980E+01,
- & 0.16071E+01, 0.16162E+01, 0.16253E+01, 0.16344E+01, 0.16434E+01,
- & 0.16525E+01, 0.16615E+01, 0.16705E+01, 0.16794E+01, 0.16884E+01,
- & 0.16973E+01, 0.17062E+01, 0.17151E+01, 0.17240E+01, 0.17328E+01,
- & 0.17417E+01, 0.17505E+01, 0.17593E+01, 0.17681E+01, 0.17768E+01,
- & 0.17855E+01, 0.17943E+01, 0.18030E+01, 0.18117E+01, 0.18203E+01,
- & 0.18290E+01, 0.18376E+01, 0.18462E+01, 0.18548E+01, 0.18634E+01,
- & 0.18719E+01, 0.18804E+01, 0.18890E+01, 0.18975E+01, 0.19059E+01,
- & 0.19144E+01, 0.19228E+01, 0.19313E+01, 0.19397E+01, 0.19481E+01,
- & 0.19564E+01, 0.19648E+01, 0.19731E+01, 0.19814E+01, 0.19897E+01,
- & 0.19980E+01, 0.20063E+01, 0.20145E+01, 0.20228E+01, 0.20310E+01,
- & 0.20392E+01, 0.20474E+01, 0.20555E+01, 0.20637E+01, 0.20718E+01,
- & 0.20799E+01, 0.20880E+01, 0.20961E+01, 0.21042E+01, 0.21122E+01,
- & 0.21202E+01, 0.21282E+01, 0.21362E+01, 0.21442E+01, 0.21522E+01,
- & 0.21601E+01, 0.21681E+01, 0.21760E+01, 0.21839E+01, 0.21917E+01,
- & 0.21996E+01, 0.22075E+01, 0.22153E+01, 0.22231E+01, 0.22309E+01,
- & 0.22387E+01, 0.22465E+01, 0.22542E+01, 0.22620E+01, 0.22697E+01,
- & 0.22774E+01, 0.22851E+01, 0.22928E+01, 0.23004E+01, 0.23081E+01,
- & 0.23157E+01, 0.23233E+01, 0.23309E+01, 0.23385E+01, 0.23461E+01,
- & 0.23536E+01, 0.23612E+01, 0.23687E+01, 0.23762E+01, 0.23837E+01/
-
- DATA (BNC08M(I),I=301,400)/
- & 0.23912E+01, 0.23987E+01, 0.24061E+01, 0.24135E+01, 0.24210E+01,
- & 0.24284E+01, 0.24358E+01, 0.24432E+01, 0.24505E+01, 0.24579E+01,
- & 0.24652E+01, 0.24725E+01, 0.24798E+01, 0.24871E+01, 0.24944E+01,
- & 0.25017E+01, 0.25089E+01, 0.25162E+01, 0.25234E+01, 0.25306E+01,
- & 0.25378E+01, 0.25450E+01, 0.25522E+01, 0.25593E+01, 0.25665E+01,
- & 0.25736E+01, 0.25807E+01, 0.25878E+01, 0.25949E+01, 0.26020E+01,
- & 0.26091E+01, 0.26161E+01, 0.26231E+01, 0.26302E+01, 0.26372E+01,
- & 0.26442E+01, 0.26512E+01, 0.26581E+01, 0.26651E+01, 0.26720E+01,
- & 0.26790E+01, 0.26859E+01, 0.26928E+01, 0.26997E+01, 0.27066E+01,
- & 0.27135E+01, 0.27203E+01, 0.27272E+01, 0.27340E+01, 0.27408E+01,
- & 0.27476E+01, 0.27544E+01, 0.27612E+01, 0.27680E+01, 0.27747E+01,
- & 0.27815E+01, 0.27882E+01, 0.27949E+01, 0.28016E+01, 0.28083E+01,
- & 0.28150E+01, 0.28217E+01, 0.28284E+01, 0.28350E+01, 0.28417E+01,
- & 0.28483E+01, 0.28549E+01, 0.28615E+01, 0.28681E+01, 0.28747E+01,
- & 0.28812E+01, 0.28878E+01, 0.28944E+01, 0.29009E+01, 0.29074E+01,
- & 0.29139E+01, 0.29204E+01, 0.29269E+01, 0.29334E+01, 0.29399E+01,
- & 0.29463E+01, 0.29528E+01, 0.29592E+01, 0.29656E+01, 0.29720E+01,
- & 0.29784E+01, 0.29848E+01, 0.29912E+01, 0.29976E+01, 0.30039E+01,
- & 0.30103E+01, 0.30166E+01, 0.30229E+01, 0.30292E+01, 0.30355E+01,
- & 0.30418E+01, 0.30481E+01, 0.30544E+01, 0.30607E+01, 0.30669E+01/
-
- DATA (BNC08M(I),I=401,500)/
- & 0.30731E+01, 0.30794E+01, 0.30856E+01, 0.30918E+01, 0.30980E+01,
- & 0.31042E+01, 0.31104E+01, 0.31165E+01, 0.31227E+01, 0.31288E+01,
- & 0.31350E+01, 0.31411E+01, 0.31472E+01, 0.31533E+01, 0.31594E+01,
- & 0.31655E+01, 0.31716E+01, 0.31777E+01, 0.31837E+01, 0.31898E+01,
- & 0.31958E+01, 0.32018E+01, 0.32078E+01, 0.32139E+01, 0.32198E+01,
- & 0.32258E+01, 0.32318E+01, 0.32378E+01, 0.32437E+01, 0.32497E+01,
- & 0.32556E+01, 0.32616E+01, 0.32675E+01, 0.32734E+01, 0.32793E+01,
- & 0.32852E+01, 0.32911E+01, 0.32970E+01, 0.33028E+01, 0.33087E+01,
- & 0.33145E+01, 0.33204E+01, 0.33262E+01, 0.33320E+01, 0.33378E+01,
- & 0.33436E+01, 0.33494E+01, 0.33552E+01, 0.33610E+01, 0.33667E+01,
- & 0.33725E+01, 0.33782E+01, 0.33840E+01, 0.33897E+01, 0.33954E+01,
- & 0.34011E+01, 0.34068E+01, 0.34125E+01, 0.34182E+01, 0.34239E+01,
- & 0.34296E+01, 0.34352E+01, 0.34409E+01, 0.34465E+01, 0.34521E+01,
- & 0.34578E+01, 0.34634E+01, 0.34690E+01, 0.34746E+01, 0.34802E+01,
- & 0.34858E+01, 0.34913E+01, 0.34969E+01, 0.35025E+01, 0.35080E+01,
- & 0.35135E+01, 0.35191E+01, 0.35246E+01, 0.35301E+01, 0.35356E+01,
- & 0.35411E+01, 0.35466E+01, 0.35521E+01, 0.35576E+01, 0.35630E+01,
- & 0.35685E+01, 0.35739E+01, 0.35794E+01, 0.35848E+01, 0.35902E+01,
- & 0.35957E+01, 0.36011E+01, 0.36065E+01, 0.36119E+01, 0.36173E+01,
- & 0.36226E+01, 0.36280E+01, 0.36334E+01, 0.36387E+01, 0.36441E+01/
-
- DATA (BNC08M(I),I=501,600)/
- & 0.36494E+01, 0.36547E+01, 0.36601E+01, 0.36654E+01, 0.36707E+01,
- & 0.36760E+01, 0.36813E+01, 0.36866E+01, 0.36918E+01, 0.36971E+01,
- & 0.37024E+01, 0.37076E+01, 0.37129E+01, 0.37181E+01, 0.37234E+01,
- & 0.37286E+01, 0.37338E+01, 0.37390E+01, 0.37442E+01, 0.37494E+01,
- & 0.37546E+01, 0.37598E+01, 0.37649E+01, 0.37701E+01, 0.37753E+01,
- & 0.37804E+01, 0.37856E+01, 0.37907E+01, 0.37958E+01, 0.38010E+01,
- & 0.38061E+01, 0.38112E+01, 0.38163E+01, 0.38214E+01, 0.38265E+01,
- & 0.38316E+01, 0.38366E+01, 0.38417E+01, 0.38468E+01, 0.38518E+01,
- & 0.38568E+01, 0.38619E+01, 0.38669E+01, 0.38719E+01, 0.38770E+01,
- & 0.38820E+01, 0.38870E+01, 0.38920E+01, 0.38970E+01, 0.39020E+01,
- & 0.39069E+01, 0.39119E+01, 0.39169E+01, 0.39218E+01, 0.39268E+01,
- & 0.39317E+01, 0.39366E+01, 0.39416E+01, 0.39465E+01, 0.39514E+01,
- & 0.39563E+01, 0.39612E+01, 0.39661E+01, 0.39710E+01, 0.39759E+01,
- & 0.39808E+01, 0.39857E+01, 0.39905E+01, 0.39954E+01, 0.40002E+01,
- & 0.40051E+01, 0.40099E+01, 0.40147E+01, 0.40196E+01, 0.40244E+01,
- & 0.40292E+01, 0.40340E+01, 0.40388E+01, 0.40436E+01, 0.40484E+01,
- & 0.40532E+01, 0.40579E+01, 0.40627E+01, 0.40675E+01, 0.40722E+01,
- & 0.40770E+01, 0.40817E+01, 0.40865E+01, 0.40912E+01, 0.40959E+01,
- & 0.41006E+01, 0.41054E+01, 0.41101E+01, 0.41148E+01, 0.41195E+01,
- & 0.41242E+01, 0.41288E+01, 0.41335E+01, 0.41382E+01, 0.41429E+01/
-
- DATA (BNC08M(I),I=601,700)/
- & 0.41929E+01, 0.42386E+01, 0.42837E+01, 0.43283E+01, 0.43723E+01,
- & 0.44159E+01, 0.44588E+01, 0.45013E+01, 0.45433E+01, 0.45849E+01,
- & 0.46259E+01, 0.46665E+01, 0.47066E+01, 0.47463E+01, 0.47856E+01,
- & 0.48244E+01, 0.48628E+01, 0.49008E+01, 0.49384E+01, 0.49757E+01,
- & 0.50125E+01, 0.50490E+01, 0.50851E+01, 0.51208E+01, 0.51562E+01,
- & 0.51912E+01, 0.52259E+01, 0.52603E+01, 0.52943E+01, 0.53280E+01,
- & 0.53614E+01, 0.53945E+01, 0.54273E+01, 0.54598E+01, 0.54919E+01,
- & 0.55238E+01, 0.55554E+01, 0.55868E+01, 0.56178E+01, 0.56486E+01,
- & 0.56791E+01, 0.57094E+01, 0.57394E+01, 0.57691E+01, 0.57986E+01,
- & 0.58279E+01, 0.58569E+01, 0.58856E+01, 0.59142E+01, 0.59425E+01,
- & 0.59705E+01, 0.59984E+01, 0.60260E+01, 0.60534E+01, 0.60807E+01,
- & 0.61076E+01, 0.61344E+01, 0.61610E+01, 0.61874E+01, 0.62136E+01,
- & 0.62396E+01, 0.62653E+01, 0.62909E+01, 0.63164E+01, 0.63416E+01,
- & 0.63666E+01, 0.63915E+01, 0.64162E+01, 0.64407E+01, 0.64650E+01,
- & 0.64892E+01, 0.65132E+01, 0.65370E+01, 0.65607E+01, 0.65842E+01,
- & 0.66076E+01, 0.66308E+01, 0.66538E+01, 0.66767E+01, 0.66994E+01,
- & 0.67220E+01, 0.67444E+01, 0.67667E+01, 0.67889E+01, 0.68108E+01,
- & 0.68327E+01, 0.68544E+01, 0.68760E+01, 0.68974E+01, 0.69188E+01,
- & 0.69399E+01, 0.69610E+01, 0.69819E+01, 0.70027E+01, 0.70233E+01,
- & 0.70439E+01, 0.70643E+01, 0.70846E+01, 0.71047E+01, 0.71248E+01/
-
- DATA (BNC08M(I),I=701,741)/
- & 0.71447E+01, 0.71645E+01, 0.71842E+01, 0.72038E+01, 0.72233E+01,
- & 0.72426E+01, 0.72619E+01, 0.72810E+01, 0.73000E+01, 0.73189E+01,
- & 0.73378E+01, 0.73565E+01, 0.73751E+01, 0.73936E+01, 0.74120E+01,
- & 0.74303E+01, 0.74484E+01, 0.74665E+01, 0.74845E+01, 0.75024E+01,
- & 0.75203E+01, 0.75380E+01, 0.75556E+01, 0.75731E+01, 0.75905E+01,
- & 0.76079E+01, 0.76251E+01, 0.76423E+01, 0.76593E+01, 0.76763E+01,
- & 0.76932E+01, 0.77100E+01, 0.77268E+01, 0.77434E+01, 0.77600E+01,
- & 0.77764E+01, 0.77928E+01, 0.78091E+01, 0.78253E+01, 0.78415E+01,
- & 0.78576E+01
- & /
-C
-C *** NH4HSO4
-C
- DATA (BNC09M(I),I=1,100)/
- &-0.46818E-01,-0.99454E-01,-0.12468E+00,-0.14198E+00,-0.15520E+00,
- &-0.16586E+00,-0.17475E+00,-0.18233E+00,-0.18889E+00,-0.19464E+00,
- &-0.19972E+00,-0.20422E+00,-0.20825E+00,-0.21184E+00,-0.21507E+00,
- &-0.21797E+00,-0.22056E+00,-0.22288E+00,-0.22496E+00,-0.22681E+00,
- &-0.22844E+00,-0.22988E+00,-0.23114E+00,-0.23222E+00,-0.23314E+00,
- &-0.23391E+00,-0.23453E+00,-0.23502E+00,-0.23537E+00,-0.23559E+00,
- &-0.23570E+00,-0.23569E+00,-0.23557E+00,-0.23535E+00,-0.23502E+00,
- &-0.23460E+00,-0.23408E+00,-0.23348E+00,-0.23278E+00,-0.23200E+00,
- &-0.23115E+00,-0.23021E+00,-0.22920E+00,-0.22811E+00,-0.22696E+00,
- &-0.22574E+00,-0.22445E+00,-0.22310E+00,-0.22169E+00,-0.22023E+00,
- &-0.21870E+00,-0.21712E+00,-0.21549E+00,-0.21381E+00,-0.21207E+00,
- &-0.21029E+00,-0.20847E+00,-0.20660E+00,-0.20468E+00,-0.20272E+00,
- &-0.20073E+00,-0.19869E+00,-0.19661E+00,-0.19450E+00,-0.19235E+00,
- &-0.19016E+00,-0.18794E+00,-0.18569E+00,-0.18340E+00,-0.18107E+00,
- &-0.17872E+00,-0.17633E+00,-0.17392E+00,-0.17147E+00,-0.16899E+00,
- &-0.16648E+00,-0.16394E+00,-0.16137E+00,-0.15877E+00,-0.15614E+00,
- &-0.15349E+00,-0.15080E+00,-0.14809E+00,-0.14535E+00,-0.14259E+00,
- &-0.13979E+00,-0.13697E+00,-0.13413E+00,-0.13125E+00,-0.12836E+00,
- &-0.12544E+00,-0.12249E+00,-0.11952E+00,-0.11653E+00,-0.11351E+00,
- &-0.11047E+00,-0.10741E+00,-0.10433E+00,-0.10124E+00,-0.98117E-01/
-
- DATA (BNC09M(I),I=101,200)/
- &-0.94980E-01,-0.91826E-01,-0.88655E-01,-0.85469E-01,-0.82267E-01,
- &-0.79051E-01,-0.75822E-01,-0.72581E-01,-0.69327E-01,-0.66063E-01,
- &-0.62789E-01,-0.59505E-01,-0.56214E-01,-0.52914E-01,-0.49608E-01,
- &-0.46296E-01,-0.42978E-01,-0.39656E-01,-0.36329E-01,-0.33000E-01,
- &-0.29667E-01,-0.26333E-01,-0.22997E-01,-0.19660E-01,-0.16323E-01,
- &-0.12985E-01,-0.96483E-02,-0.63125E-02,-0.29780E-02, 0.35480E-03,
- & 0.36852E-02, 0.70134E-02, 0.10339E-01, 0.13661E-01, 0.16979E-01,
- & 0.20294E-01, 0.23605E-01, 0.26912E-01, 0.30214E-01, 0.33512E-01,
- & 0.36805E-01, 0.40093E-01, 0.43376E-01, 0.46653E-01, 0.49925E-01,
- & 0.53192E-01, 0.56453E-01, 0.59708E-01, 0.62957E-01, 0.66200E-01,
- & 0.69437E-01, 0.72668E-01, 0.75892E-01, 0.79111E-01, 0.82322E-01,
- & 0.85528E-01, 0.88727E-01, 0.91919E-01, 0.95104E-01, 0.98283E-01,
- & 0.10146E+00, 0.10462E+00, 0.10778E+00, 0.11093E+00, 0.11408E+00,
- & 0.11722E+00, 0.12035E+00, 0.12347E+00, 0.12659E+00, 0.12970E+00,
- & 0.13280E+00, 0.13590E+00, 0.13899E+00, 0.14207E+00, 0.14515E+00,
- & 0.14822E+00, 0.15128E+00, 0.15433E+00, 0.15738E+00, 0.16042E+00,
- & 0.16345E+00, 0.16648E+00, 0.16950E+00, 0.17251E+00, 0.17552E+00,
- & 0.17852E+00, 0.18151E+00, 0.18449E+00, 0.18747E+00, 0.19044E+00,
- & 0.19341E+00, 0.19636E+00, 0.19931E+00, 0.20226E+00, 0.20519E+00,
- & 0.20812E+00, 0.21104E+00, 0.21396E+00, 0.21687E+00, 0.21977E+00/
-
- DATA (BNC09M(I),I=201,300)/
- & 0.22266E+00, 0.22555E+00, 0.22843E+00, 0.23131E+00, 0.23418E+00,
- & 0.23704E+00, 0.23989E+00, 0.24274E+00, 0.24558E+00, 0.24842E+00,
- & 0.25124E+00, 0.25407E+00, 0.25688E+00, 0.25969E+00, 0.26249E+00,
- & 0.26529E+00, 0.26807E+00, 0.27086E+00, 0.27363E+00, 0.27640E+00,
- & 0.27917E+00, 0.28192E+00, 0.28467E+00, 0.28742E+00, 0.29015E+00,
- & 0.29288E+00, 0.29561E+00, 0.29833E+00, 0.30104E+00, 0.30375E+00,
- & 0.30645E+00, 0.30914E+00, 0.31183E+00, 0.31451E+00, 0.31719E+00,
- & 0.31986E+00, 0.32252E+00, 0.32518E+00, 0.32783E+00, 0.33048E+00,
- & 0.33312E+00, 0.33575E+00, 0.33838E+00, 0.34100E+00, 0.34362E+00,
- & 0.34623E+00, 0.34883E+00, 0.35143E+00, 0.35402E+00, 0.35661E+00,
- & 0.35919E+00, 0.36177E+00, 0.36434E+00, 0.36690E+00, 0.36946E+00,
- & 0.37201E+00, 0.37456E+00, 0.37710E+00, 0.37964E+00, 0.38217E+00,
- & 0.38470E+00, 0.38722E+00, 0.38973E+00, 0.39224E+00, 0.39474E+00,
- & 0.39724E+00, 0.39974E+00, 0.40222E+00, 0.40471E+00, 0.40718E+00,
- & 0.40966E+00, 0.41212E+00, 0.41458E+00, 0.41704E+00, 0.41949E+00,
- & 0.42194E+00, 0.42438E+00, 0.42681E+00, 0.42924E+00, 0.43167E+00,
- & 0.43409E+00, 0.43650E+00, 0.43891E+00, 0.44132E+00, 0.44372E+00,
- & 0.44611E+00, 0.44851E+00, 0.45089E+00, 0.45327E+00, 0.45565E+00,
- & 0.45802E+00, 0.46038E+00, 0.46274E+00, 0.46510E+00, 0.46745E+00,
- & 0.46980E+00, 0.47214E+00, 0.47448E+00, 0.47681E+00, 0.47914E+00/
-
- DATA (BNC09M(I),I=301,400)/
- & 0.48146E+00, 0.48378E+00, 0.48609E+00, 0.48840E+00, 0.49070E+00,
- & 0.49300E+00, 0.49530E+00, 0.49759E+00, 0.49988E+00, 0.50216E+00,
- & 0.50444E+00, 0.50671E+00, 0.50898E+00, 0.51124E+00, 0.51350E+00,
- & 0.51575E+00, 0.51800E+00, 0.52025E+00, 0.52249E+00, 0.52473E+00,
- & 0.52696E+00, 0.52919E+00, 0.53141E+00, 0.53363E+00, 0.53585E+00,
- & 0.53806E+00, 0.54027E+00, 0.54247E+00, 0.54467E+00, 0.54686E+00,
- & 0.54905E+00, 0.55124E+00, 0.55342E+00, 0.55560E+00, 0.55777E+00,
- & 0.55994E+00, 0.56211E+00, 0.56427E+00, 0.56643E+00, 0.56858E+00,
- & 0.57073E+00, 0.57288E+00, 0.57502E+00, 0.57715E+00, 0.57929E+00,
- & 0.58142E+00, 0.58354E+00, 0.58566E+00, 0.58778E+00, 0.58990E+00,
- & 0.59201E+00, 0.59411E+00, 0.59621E+00, 0.59831E+00, 0.60041E+00,
- & 0.60250E+00, 0.60458E+00, 0.60667E+00, 0.60874E+00, 0.61082E+00,
- & 0.61289E+00, 0.61496E+00, 0.61702E+00, 0.61908E+00, 0.62114E+00,
- & 0.62319E+00, 0.62524E+00, 0.62729E+00, 0.62933E+00, 0.63137E+00,
- & 0.63340E+00, 0.63544E+00, 0.63746E+00, 0.63949E+00, 0.64151E+00,
- & 0.64352E+00, 0.64554E+00, 0.64755E+00, 0.64955E+00, 0.65156E+00,
- & 0.65355E+00, 0.65555E+00, 0.65754E+00, 0.65953E+00, 0.66152E+00,
- & 0.66350E+00, 0.66548E+00, 0.66745E+00, 0.66942E+00, 0.67139E+00,
- & 0.67335E+00, 0.67532E+00, 0.67727E+00, 0.67923E+00, 0.68118E+00,
- & 0.68313E+00, 0.68507E+00, 0.68701E+00, 0.68895E+00, 0.69089E+00/
-
- DATA (BNC09M(I),I=401,500)/
- & 0.69282E+00, 0.69475E+00, 0.69667E+00, 0.69859E+00, 0.70051E+00,
- & 0.70243E+00, 0.70434E+00, 0.70625E+00, 0.70815E+00, 0.71005E+00,
- & 0.71195E+00, 0.71385E+00, 0.71574E+00, 0.71763E+00, 0.71952E+00,
- & 0.72140E+00, 0.72328E+00, 0.72516E+00, 0.72703E+00, 0.72890E+00,
- & 0.73077E+00, 0.73264E+00, 0.73450E+00, 0.73636E+00, 0.73821E+00,
- & 0.74006E+00, 0.74191E+00, 0.74376E+00, 0.74560E+00, 0.74745E+00,
- & 0.74928E+00, 0.75112E+00, 0.75295E+00, 0.75478E+00, 0.75660E+00,
- & 0.75843E+00, 0.76025E+00, 0.76206E+00, 0.76388E+00, 0.76569E+00,
- & 0.76750E+00, 0.76930E+00, 0.77110E+00, 0.77290E+00, 0.77470E+00,
- & 0.77649E+00, 0.77828E+00, 0.78007E+00, 0.78186E+00, 0.78364E+00,
- & 0.78542E+00, 0.78720E+00, 0.78897E+00, 0.79074E+00, 0.79251E+00,
- & 0.79428E+00, 0.79604E+00, 0.79780E+00, 0.79956E+00, 0.80131E+00,
- & 0.80306E+00, 0.80481E+00, 0.80656E+00, 0.80830E+00, 0.81005E+00,
- & 0.81178E+00, 0.81352E+00, 0.81525E+00, 0.81698E+00, 0.81871E+00,
- & 0.82044E+00, 0.82216E+00, 0.82388E+00, 0.82560E+00, 0.82731E+00,
- & 0.82902E+00, 0.83073E+00, 0.83244E+00, 0.83414E+00, 0.83585E+00,
- & 0.83754E+00, 0.83924E+00, 0.84093E+00, 0.84263E+00, 0.84431E+00,
- & 0.84600E+00, 0.84768E+00, 0.84937E+00, 0.85104E+00, 0.85272E+00,
- & 0.85439E+00, 0.85607E+00, 0.85773E+00, 0.85940E+00, 0.86106E+00,
- & 0.86273E+00, 0.86438E+00, 0.86604E+00, 0.86769E+00, 0.86935E+00/
-
- DATA (BNC09M(I),I=501,600)/
- & 0.87100E+00, 0.87264E+00, 0.87429E+00, 0.87593E+00, 0.87757E+00,
- & 0.87920E+00, 0.88084E+00, 0.88247E+00, 0.88410E+00, 0.88573E+00,
- & 0.88735E+00, 0.88898E+00, 0.89060E+00, 0.89221E+00, 0.89383E+00,
- & 0.89544E+00, 0.89705E+00, 0.89866E+00, 0.90027E+00, 0.90187E+00,
- & 0.90347E+00, 0.90507E+00, 0.90667E+00, 0.90827E+00, 0.90986E+00,
- & 0.91145E+00, 0.91304E+00, 0.91462E+00, 0.91621E+00, 0.91779E+00,
- & 0.91937E+00, 0.92094E+00, 0.92252E+00, 0.92409E+00, 0.92566E+00,
- & 0.92723E+00, 0.92879E+00, 0.93036E+00, 0.93192E+00, 0.93347E+00,
- & 0.93503E+00, 0.93659E+00, 0.93814E+00, 0.93969E+00, 0.94124E+00,
- & 0.94278E+00, 0.94433E+00, 0.94587E+00, 0.94741E+00, 0.94894E+00,
- & 0.95048E+00, 0.95201E+00, 0.95354E+00, 0.95507E+00, 0.95660E+00,
- & 0.95812E+00, 0.95965E+00, 0.96117E+00, 0.96269E+00, 0.96420E+00,
- & 0.96572E+00, 0.96723E+00, 0.96874E+00, 0.97025E+00, 0.97175E+00,
- & 0.97325E+00, 0.97476E+00, 0.97626E+00, 0.97775E+00, 0.97925E+00,
- & 0.98074E+00, 0.98223E+00, 0.98372E+00, 0.98521E+00, 0.98670E+00,
- & 0.98818E+00, 0.98966E+00, 0.99114E+00, 0.99262E+00, 0.99410E+00,
- & 0.99557E+00, 0.99704E+00, 0.99851E+00, 0.99998E+00, 0.10014E+01,
- & 0.10029E+01, 0.10044E+01, 0.10058E+01, 0.10073E+01, 0.10087E+01,
- & 0.10102E+01, 0.10116E+01, 0.10131E+01, 0.10145E+01, 0.10160E+01,
- & 0.10174E+01, 0.10189E+01, 0.10203E+01, 0.10218E+01, 0.10232E+01/
-
- DATA (BNC09M(I),I=601,700)/
- & 0.10386E+01, 0.10527E+01, 0.10666E+01, 0.10803E+01, 0.10938E+01,
- & 0.11072E+01, 0.11204E+01, 0.11334E+01, 0.11463E+01, 0.11591E+01,
- & 0.11717E+01, 0.11841E+01, 0.11964E+01, 0.12086E+01, 0.12206E+01,
- & 0.12325E+01, 0.12442E+01, 0.12558E+01, 0.12673E+01, 0.12787E+01,
- & 0.12900E+01, 0.13011E+01, 0.13121E+01, 0.13230E+01, 0.13338E+01,
- & 0.13444E+01, 0.13550E+01, 0.13655E+01, 0.13758E+01, 0.13860E+01,
- & 0.13962E+01, 0.14062E+01, 0.14162E+01, 0.14260E+01, 0.14358E+01,
- & 0.14454E+01, 0.14550E+01, 0.14645E+01, 0.14738E+01, 0.14831E+01,
- & 0.14924E+01, 0.15015E+01, 0.15105E+01, 0.15195E+01, 0.15284E+01,
- & 0.15372E+01, 0.15459E+01, 0.15545E+01, 0.15631E+01, 0.15716E+01,
- & 0.15800E+01, 0.15884E+01, 0.15966E+01, 0.16049E+01, 0.16130E+01,
- & 0.16211E+01, 0.16291E+01, 0.16370E+01, 0.16449E+01, 0.16527E+01,
- & 0.16604E+01, 0.16681E+01, 0.16757E+01, 0.16833E+01, 0.16908E+01,
- & 0.16982E+01, 0.17056E+01, 0.17129E+01, 0.17201E+01, 0.17273E+01,
- & 0.17345E+01, 0.17416E+01, 0.17486E+01, 0.17556E+01, 0.17626E+01,
- & 0.17694E+01, 0.17763E+01, 0.17830E+01, 0.17898E+01, 0.17964E+01,
- & 0.18031E+01, 0.18097E+01, 0.18162E+01, 0.18227E+01, 0.18291E+01,
- & 0.18355E+01, 0.18418E+01, 0.18481E+01, 0.18544E+01, 0.18606E+01,
- & 0.18668E+01, 0.18729E+01, 0.18790E+01, 0.18850E+01, 0.18910E+01,
- & 0.18970E+01, 0.19029E+01, 0.19088E+01, 0.19146E+01, 0.19204E+01/
-
- DATA (BNC09M(I),I=701,741)/
- & 0.19262E+01, 0.19319E+01, 0.19376E+01, 0.19432E+01, 0.19488E+01,
- & 0.19544E+01, 0.19599E+01, 0.19654E+01, 0.19709E+01, 0.19763E+01,
- & 0.19817E+01, 0.19871E+01, 0.19924E+01, 0.19977E+01, 0.20029E+01,
- & 0.20082E+01, 0.20133E+01, 0.20185E+01, 0.20236E+01, 0.20287E+01,
- & 0.20338E+01, 0.20388E+01, 0.20438E+01, 0.20488E+01, 0.20537E+01,
- & 0.20586E+01, 0.20635E+01, 0.20683E+01, 0.20731E+01, 0.20779E+01,
- & 0.20827E+01, 0.20874E+01, 0.20921E+01, 0.20968E+01, 0.21014E+01,
- & 0.21061E+01, 0.21107E+01, 0.21152E+01, 0.21198E+01, 0.21243E+01,
- & 0.21288E+01
- & /
-C
-C *** (H,NO3)
-C
- DATA (BNC10M(I),I=1,100)/
- &-0.46234E-01,-0.95802E-01,-0.11793E+00,-0.13215E+00,-0.14233E+00,
- &-0.14999E+00,-0.15592E+00,-0.16058E+00,-0.16428E+00,-0.16721E+00,
- &-0.16952E+00,-0.17131E+00,-0.17268E+00,-0.17367E+00,-0.17435E+00,
- &-0.17476E+00,-0.17493E+00,-0.17488E+00,-0.17465E+00,-0.17425E+00,
- &-0.17370E+00,-0.17301E+00,-0.17221E+00,-0.17129E+00,-0.17028E+00,
- &-0.16917E+00,-0.16799E+00,-0.16673E+00,-0.16540E+00,-0.16402E+00,
- &-0.16257E+00,-0.16108E+00,-0.15954E+00,-0.15796E+00,-0.15634E+00,
- &-0.15468E+00,-0.15300E+00,-0.15128E+00,-0.14954E+00,-0.14778E+00,
- &-0.14600E+00,-0.14419E+00,-0.14237E+00,-0.14054E+00,-0.13869E+00,
- &-0.13682E+00,-0.13495E+00,-0.13307E+00,-0.13117E+00,-0.12927E+00,
- &-0.12737E+00,-0.12545E+00,-0.12353E+00,-0.12160E+00,-0.11967E+00,
- &-0.11774E+00,-0.11579E+00,-0.11385E+00,-0.11190E+00,-0.10994E+00,
- &-0.10798E+00,-0.10601E+00,-0.10404E+00,-0.10206E+00,-0.10008E+00,
- &-0.98086E-01,-0.96089E-01,-0.94084E-01,-0.92071E-01,-0.90050E-01,
- &-0.88020E-01,-0.85981E-01,-0.83932E-01,-0.81872E-01,-0.79801E-01,
- &-0.77719E-01,-0.75624E-01,-0.73517E-01,-0.71397E-01,-0.69264E-01,
- &-0.67117E-01,-0.64955E-01,-0.62779E-01,-0.60589E-01,-0.58383E-01,
- &-0.56162E-01,-0.53926E-01,-0.51674E-01,-0.49406E-01,-0.47123E-01,
- &-0.44825E-01,-0.42510E-01,-0.40181E-01,-0.37837E-01,-0.35477E-01,
- &-0.33103E-01,-0.30715E-01,-0.28312E-01,-0.25896E-01,-0.23466E-01/
-
- DATA (BNC10M(I),I=101,200)/
- &-0.21024E-01,-0.18569E-01,-0.16103E-01,-0.13624E-01,-0.11135E-01,
- &-0.86356E-02,-0.61260E-02,-0.36070E-02,-0.10791E-02, 0.14571E-02,
- & 0.40011E-02, 0.65524E-02, 0.91106E-02, 0.11675E-01, 0.14245E-01,
- & 0.16820E-01, 0.19401E-01, 0.21985E-01, 0.24574E-01, 0.27166E-01,
- & 0.29761E-01, 0.32358E-01, 0.34958E-01, 0.37560E-01, 0.40164E-01,
- & 0.42768E-01, 0.45374E-01, 0.47981E-01, 0.50587E-01, 0.53194E-01,
- & 0.55801E-01, 0.58408E-01, 0.61014E-01, 0.63620E-01, 0.66224E-01,
- & 0.68828E-01, 0.71430E-01, 0.74031E-01, 0.76630E-01, 0.79228E-01,
- & 0.81824E-01, 0.84419E-01, 0.87011E-01, 0.89602E-01, 0.92190E-01,
- & 0.94776E-01, 0.97360E-01, 0.99941E-01, 0.10252E+00, 0.10510E+00,
- & 0.10767E+00, 0.11024E+00, 0.11281E+00, 0.11538E+00, 0.11794E+00,
- & 0.12050E+00, 0.12306E+00, 0.12562E+00, 0.12817E+00, 0.13072E+00,
- & 0.13327E+00, 0.13581E+00, 0.13835E+00, 0.14089E+00, 0.14342E+00,
- & 0.14595E+00, 0.14848E+00, 0.15101E+00, 0.15353E+00, 0.15605E+00,
- & 0.15857E+00, 0.16108E+00, 0.16359E+00, 0.16609E+00, 0.16860E+00,
- & 0.17110E+00, 0.17359E+00, 0.17609E+00, 0.17858E+00, 0.18106E+00,
- & 0.18355E+00, 0.18603E+00, 0.18850E+00, 0.19098E+00, 0.19345E+00,
- & 0.19591E+00, 0.19838E+00, 0.20084E+00, 0.20329E+00, 0.20574E+00,
- & 0.20819E+00, 0.21064E+00, 0.21308E+00, 0.21552E+00, 0.21795E+00,
- & 0.22039E+00, 0.22281E+00, 0.22524E+00, 0.22766E+00, 0.23008E+00/
-
- DATA (BNC10M(I),I=201,300)/
- & 0.23249E+00, 0.23490E+00, 0.23731E+00, 0.23971E+00, 0.24211E+00,
- & 0.24451E+00, 0.24690E+00, 0.24929E+00, 0.25167E+00, 0.25406E+00,
- & 0.25643E+00, 0.25881E+00, 0.26118E+00, 0.26355E+00, 0.26591E+00,
- & 0.26827E+00, 0.27063E+00, 0.27298E+00, 0.27533E+00, 0.27768E+00,
- & 0.28002E+00, 0.28236E+00, 0.28469E+00, 0.28702E+00, 0.28935E+00,
- & 0.29167E+00, 0.29399E+00, 0.29631E+00, 0.29862E+00, 0.30093E+00,
- & 0.30324E+00, 0.30554E+00, 0.30784E+00, 0.31013E+00, 0.31242E+00,
- & 0.31471E+00, 0.31700E+00, 0.31928E+00, 0.32155E+00, 0.32383E+00,
- & 0.32610E+00, 0.32836E+00, 0.33062E+00, 0.33288E+00, 0.33514E+00,
- & 0.33739E+00, 0.33964E+00, 0.34188E+00, 0.34412E+00, 0.34636E+00,
- & 0.34859E+00, 0.35082E+00, 0.35305E+00, 0.35527E+00, 0.35749E+00,
- & 0.35971E+00, 0.36192E+00, 0.36413E+00, 0.36633E+00, 0.36854E+00,
- & 0.37073E+00, 0.37293E+00, 0.37512E+00, 0.37731E+00, 0.37949E+00,
- & 0.38167E+00, 0.38385E+00, 0.38602E+00, 0.38819E+00, 0.39036E+00,
- & 0.39252E+00, 0.39468E+00, 0.39683E+00, 0.39899E+00, 0.40113E+00,
- & 0.40328E+00, 0.40542E+00, 0.40756E+00, 0.40970E+00, 0.41183E+00,
- & 0.41395E+00, 0.41608E+00, 0.41820E+00, 0.42032E+00, 0.42243E+00,
- & 0.42454E+00, 0.42665E+00, 0.42875E+00, 0.43085E+00, 0.43295E+00,
- & 0.43505E+00, 0.43714E+00, 0.43922E+00, 0.44131E+00, 0.44339E+00,
- & 0.44546E+00, 0.44754E+00, 0.44961E+00, 0.45167E+00, 0.45374E+00/
-
- DATA (BNC10M(I),I=301,400)/
- & 0.45580E+00, 0.45786E+00, 0.45991E+00, 0.46196E+00, 0.46401E+00,
- & 0.46605E+00, 0.46809E+00, 0.47013E+00, 0.47216E+00, 0.47419E+00,
- & 0.47622E+00, 0.47824E+00, 0.48026E+00, 0.48228E+00, 0.48429E+00,
- & 0.48631E+00, 0.48831E+00, 0.49032E+00, 0.49232E+00, 0.49432E+00,
- & 0.49631E+00, 0.49830E+00, 0.50029E+00, 0.50228E+00, 0.50426E+00,
- & 0.50624E+00, 0.50821E+00, 0.51019E+00, 0.51216E+00, 0.51412E+00,
- & 0.51609E+00, 0.51805E+00, 0.52000E+00, 0.52196E+00, 0.52391E+00,
- & 0.52585E+00, 0.52780E+00, 0.52974E+00, 0.53168E+00, 0.53361E+00,
- & 0.53554E+00, 0.53747E+00, 0.53940E+00, 0.54132E+00, 0.54324E+00,
- & 0.54516E+00, 0.54707E+00, 0.54898E+00, 0.55089E+00, 0.55280E+00,
- & 0.55470E+00, 0.55660E+00, 0.55849E+00, 0.56038E+00, 0.56227E+00,
- & 0.56416E+00, 0.56605E+00, 0.56793E+00, 0.56980E+00, 0.57168E+00,
- & 0.57355E+00, 0.57542E+00, 0.57729E+00, 0.57915E+00, 0.58101E+00,
- & 0.58287E+00, 0.58472E+00, 0.58657E+00, 0.58842E+00, 0.59027E+00,
- & 0.59211E+00, 0.59395E+00, 0.59579E+00, 0.59762E+00, 0.59945E+00,
- & 0.60128E+00, 0.60311E+00, 0.60493E+00, 0.60675E+00, 0.60857E+00,
- & 0.61038E+00, 0.61219E+00, 0.61400E+00, 0.61581E+00, 0.61761E+00,
- & 0.61941E+00, 0.62121E+00, 0.62300E+00, 0.62480E+00, 0.62659E+00,
- & 0.62837E+00, 0.63016E+00, 0.63194E+00, 0.63372E+00, 0.63549E+00,
- & 0.63727E+00, 0.63904E+00, 0.64080E+00, 0.64257E+00, 0.64433E+00/
-
- DATA (BNC10M(I),I=401,500)/
- & 0.64609E+00, 0.64785E+00, 0.64960E+00, 0.65135E+00, 0.65310E+00,
- & 0.65485E+00, 0.65659E+00, 0.65833E+00, 0.66007E+00, 0.66181E+00,
- & 0.66354E+00, 0.66527E+00, 0.66700E+00, 0.66872E+00, 0.67044E+00,
- & 0.67216E+00, 0.67388E+00, 0.67560E+00, 0.67731E+00, 0.67902E+00,
- & 0.68073E+00, 0.68243E+00, 0.68413E+00, 0.68583E+00, 0.68753E+00,
- & 0.68922E+00, 0.69092E+00, 0.69260E+00, 0.69429E+00, 0.69598E+00,
- & 0.69766E+00, 0.69934E+00, 0.70101E+00, 0.70269E+00, 0.70436E+00,
- & 0.70603E+00, 0.70770E+00, 0.70936E+00, 0.71102E+00, 0.71268E+00,
- & 0.71434E+00, 0.71599E+00, 0.71765E+00, 0.71930E+00, 0.72094E+00,
- & 0.72259E+00, 0.72423E+00, 0.72587E+00, 0.72751E+00, 0.72914E+00,
- & 0.73078E+00, 0.73241E+00, 0.73404E+00, 0.73566E+00, 0.73729E+00,
- & 0.73891E+00, 0.74053E+00, 0.74214E+00, 0.74376E+00, 0.74537E+00,
- & 0.74698E+00, 0.74858E+00, 0.75019E+00, 0.75179E+00, 0.75339E+00,
- & 0.75499E+00, 0.75658E+00, 0.75818E+00, 0.75977E+00, 0.76136E+00,
- & 0.76294E+00, 0.76453E+00, 0.76611E+00, 0.76769E+00, 0.76927E+00,
- & 0.77084E+00, 0.77241E+00, 0.77398E+00, 0.77555E+00, 0.77712E+00,
- & 0.77868E+00, 0.78024E+00, 0.78180E+00, 0.78336E+00, 0.78492E+00,
- & 0.78647E+00, 0.78802E+00, 0.78957E+00, 0.79111E+00, 0.79266E+00,
- & 0.79420E+00, 0.79574E+00, 0.79728E+00, 0.79881E+00, 0.80034E+00,
- & 0.80188E+00, 0.80340E+00, 0.80493E+00, 0.80646E+00, 0.80798E+00/
-
- DATA (BNC10M(I),I=501,600)/
- & 0.80950E+00, 0.81102E+00, 0.81253E+00, 0.81405E+00, 0.81556E+00,
- & 0.81707E+00, 0.81858E+00, 0.82008E+00, 0.82158E+00, 0.82309E+00,
- & 0.82459E+00, 0.82608E+00, 0.82758E+00, 0.82907E+00, 0.83056E+00,
- & 0.83205E+00, 0.83354E+00, 0.83502E+00, 0.83651E+00, 0.83799E+00,
- & 0.83947E+00, 0.84094E+00, 0.84242E+00, 0.84389E+00, 0.84536E+00,
- & 0.84683E+00, 0.84830E+00, 0.84976E+00, 0.85122E+00, 0.85268E+00,
- & 0.85414E+00, 0.85560E+00, 0.85705E+00, 0.85851E+00, 0.85996E+00,
- & 0.86141E+00, 0.86285E+00, 0.86430E+00, 0.86574E+00, 0.86718E+00,
- & 0.86862E+00, 0.87006E+00, 0.87149E+00, 0.87293E+00, 0.87436E+00,
- & 0.87579E+00, 0.87721E+00, 0.87864E+00, 0.88006E+00, 0.88149E+00,
- & 0.88291E+00, 0.88432E+00, 0.88574E+00, 0.88715E+00, 0.88857E+00,
- & 0.88998E+00, 0.89139E+00, 0.89279E+00, 0.89420E+00, 0.89560E+00,
- & 0.89700E+00, 0.89840E+00, 0.89980E+00, 0.90119E+00, 0.90259E+00,
- & 0.90398E+00, 0.90537E+00, 0.90676E+00, 0.90814E+00, 0.90953E+00,
- & 0.91091E+00, 0.91229E+00, 0.91367E+00, 0.91505E+00, 0.91642E+00,
- & 0.91780E+00, 0.91917E+00, 0.92054E+00, 0.92191E+00, 0.92327E+00,
- & 0.92464E+00, 0.92600E+00, 0.92736E+00, 0.92872E+00, 0.93008E+00,
- & 0.93144E+00, 0.93279E+00, 0.93414E+00, 0.93549E+00, 0.93684E+00,
- & 0.93819E+00, 0.93954E+00, 0.94088E+00, 0.94222E+00, 0.94356E+00,
- & 0.94490E+00, 0.94624E+00, 0.94757E+00, 0.94891E+00, 0.95024E+00/
-
- DATA (BNC10M(I),I=601,700)/
- & 0.96452E+00, 0.97756E+00, 0.99045E+00, 0.10032E+01, 0.10157E+01,
- & 0.10282E+01, 0.10404E+01, 0.10525E+01, 0.10645E+01, 0.10763E+01,
- & 0.10880E+01, 0.10996E+01, 0.11110E+01, 0.11223E+01, 0.11335E+01,
- & 0.11445E+01, 0.11555E+01, 0.11663E+01, 0.11769E+01, 0.11875E+01,
- & 0.11980E+01, 0.12083E+01, 0.12185E+01, 0.12287E+01, 0.12387E+01,
- & 0.12486E+01, 0.12584E+01, 0.12681E+01, 0.12777E+01, 0.12872E+01,
- & 0.12967E+01, 0.13060E+01, 0.13152E+01, 0.13244E+01, 0.13334E+01,
- & 0.13424E+01, 0.13513E+01, 0.13601E+01, 0.13688E+01, 0.13774E+01,
- & 0.13860E+01, 0.13944E+01, 0.14028E+01, 0.14111E+01, 0.14194E+01,
- & 0.14275E+01, 0.14356E+01, 0.14437E+01, 0.14516E+01, 0.14595E+01,
- & 0.14673E+01, 0.14750E+01, 0.14827E+01, 0.14903E+01, 0.14978E+01,
- & 0.15053E+01, 0.15127E+01, 0.15201E+01, 0.15274E+01, 0.15346E+01,
- & 0.15418E+01, 0.15489E+01, 0.15559E+01, 0.15629E+01, 0.15698E+01,
- & 0.15767E+01, 0.15835E+01, 0.15903E+01, 0.15970E+01, 0.16037E+01,
- & 0.16103E+01, 0.16168E+01, 0.16233E+01, 0.16298E+01, 0.16362E+01,
- & 0.16425E+01, 0.16488E+01, 0.16551E+01, 0.16613E+01, 0.16675E+01,
- & 0.16736E+01, 0.16797E+01, 0.16857E+01, 0.16917E+01, 0.16976E+01,
- & 0.17035E+01, 0.17093E+01, 0.17152E+01, 0.17209E+01, 0.17266E+01,
- & 0.17323E+01, 0.17380E+01, 0.17436E+01, 0.17491E+01, 0.17546E+01,
- & 0.17601E+01, 0.17656E+01, 0.17710E+01, 0.17763E+01, 0.17817E+01/
-
- DATA (BNC10M(I),I=701,741)/
- & 0.17870E+01, 0.17922E+01, 0.17975E+01, 0.18026E+01, 0.18078E+01,
- & 0.18129E+01, 0.18180E+01, 0.18230E+01, 0.18281E+01, 0.18330E+01,
- & 0.18380E+01, 0.18429E+01, 0.18478E+01, 0.18526E+01, 0.18575E+01,
- & 0.18622E+01, 0.18670E+01, 0.18717E+01, 0.18764E+01, 0.18811E+01,
- & 0.18857E+01, 0.18903E+01, 0.18949E+01, 0.18994E+01, 0.19040E+01,
- & 0.19085E+01, 0.19129E+01, 0.19174E+01, 0.19218E+01, 0.19261E+01,
- & 0.19305E+01, 0.19348E+01, 0.19391E+01, 0.19434E+01, 0.19476E+01,
- & 0.19519E+01, 0.19560E+01, 0.19602E+01, 0.19644E+01, 0.19685E+01,
- & 0.19726E+01
- & /
-C
-C *** (H,Cl)
-C
- DATA (BNC11M(I),I=1,100)/
- &-0.45064E-01,-0.90047E-01,-0.10831E+00,-0.11900E+00,-0.12582E+00,
- &-0.13024E+00,-0.13300E+00,-0.13453E+00,-0.13511E+00,-0.13494E+00,
- &-0.13415E+00,-0.13283E+00,-0.13107E+00,-0.12891E+00,-0.12642E+00,
- &-0.12362E+00,-0.12056E+00,-0.11725E+00,-0.11372E+00,-0.10999E+00,
- &-0.10608E+00,-0.10200E+00,-0.97758E-01,-0.93378E-01,-0.88865E-01,
- &-0.84228E-01,-0.79477E-01,-0.74619E-01,-0.69661E-01,-0.64611E-01,
- &-0.59474E-01,-0.54257E-01,-0.48964E-01,-0.43600E-01,-0.38171E-01,
- &-0.32681E-01,-0.27134E-01,-0.21533E-01,-0.15883E-01,-0.10186E-01,
- &-0.44467E-02, 0.13329E-02, 0.71497E-02, 0.13001E-01, 0.18885E-01,
- & 0.24799E-01, 0.30740E-01, 0.36708E-01, 0.42700E-01, 0.48715E-01,
- & 0.54751E-01, 0.60806E-01, 0.66881E-01, 0.72974E-01, 0.79084E-01,
- & 0.85210E-01, 0.91353E-01, 0.97511E-01, 0.10368E+00, 0.10987E+00,
- & 0.11608E+00, 0.12230E+00, 0.12853E+00, 0.13478E+00, 0.14105E+00,
- & 0.14733E+00, 0.15364E+00, 0.15996E+00, 0.16629E+00, 0.17265E+00,
- & 0.17903E+00, 0.18544E+00, 0.19186E+00, 0.19831E+00, 0.20478E+00,
- & 0.21128E+00, 0.21781E+00, 0.22436E+00, 0.23094E+00, 0.23755E+00,
- & 0.24419E+00, 0.25087E+00, 0.25757E+00, 0.26430E+00, 0.27107E+00,
- & 0.27787E+00, 0.28471E+00, 0.29157E+00, 0.29847E+00, 0.30541E+00,
- & 0.31238E+00, 0.31938E+00, 0.32641E+00, 0.33348E+00, 0.34058E+00,
- & 0.34771E+00, 0.35487E+00, 0.36206E+00, 0.36928E+00, 0.37653E+00/
-
- DATA (BNC11M(I),I=101,200)/
- & 0.38380E+00, 0.39110E+00, 0.39843E+00, 0.40578E+00, 0.41315E+00,
- & 0.42054E+00, 0.42795E+00, 0.43539E+00, 0.44283E+00, 0.45030E+00,
- & 0.45778E+00, 0.46527E+00, 0.47278E+00, 0.48029E+00, 0.48782E+00,
- & 0.49535E+00, 0.50289E+00, 0.51044E+00, 0.51799E+00, 0.52555E+00,
- & 0.53310E+00, 0.54066E+00, 0.54823E+00, 0.55579E+00, 0.56335E+00,
- & 0.57091E+00, 0.57846E+00, 0.58602E+00, 0.59357E+00, 0.60111E+00,
- & 0.60865E+00, 0.61619E+00, 0.62371E+00, 0.63124E+00, 0.63875E+00,
- & 0.64626E+00, 0.65376E+00, 0.66125E+00, 0.66873E+00, 0.67620E+00,
- & 0.68366E+00, 0.69112E+00, 0.69856E+00, 0.70599E+00, 0.71342E+00,
- & 0.72083E+00, 0.72823E+00, 0.73562E+00, 0.74300E+00, 0.75037E+00,
- & 0.75773E+00, 0.76507E+00, 0.77241E+00, 0.77973E+00, 0.78704E+00,
- & 0.79434E+00, 0.80162E+00, 0.80890E+00, 0.81616E+00, 0.82341E+00,
- & 0.83065E+00, 0.83787E+00, 0.84508E+00, 0.85228E+00, 0.85947E+00,
- & 0.86664E+00, 0.87380E+00, 0.88095E+00, 0.88808E+00, 0.89520E+00,
- & 0.90231E+00, 0.90941E+00, 0.91649E+00, 0.92356E+00, 0.93062E+00,
- & 0.93766E+00, 0.94469E+00, 0.95171E+00, 0.95871E+00, 0.96570E+00,
- & 0.97268E+00, 0.97964E+00, 0.98659E+00, 0.99353E+00, 0.10005E+01,
- & 0.10074E+01, 0.10143E+01, 0.10211E+01, 0.10280E+01, 0.10349E+01,
- & 0.10417E+01, 0.10485E+01, 0.10554E+01, 0.10622E+01, 0.10690E+01,
- & 0.10757E+01, 0.10825E+01, 0.10892E+01, 0.10960E+01, 0.11027E+01/
-
- DATA (BNC11M(I),I=201,300)/
- & 0.11094E+01, 0.11161E+01, 0.11228E+01, 0.11295E+01, 0.11361E+01,
- & 0.11428E+01, 0.11494E+01, 0.11560E+01, 0.11626E+01, 0.11692E+01,
- & 0.11758E+01, 0.11823E+01, 0.11889E+01, 0.11954E+01, 0.12019E+01,
- & 0.12085E+01, 0.12150E+01, 0.12214E+01, 0.12279E+01, 0.12344E+01,
- & 0.12408E+01, 0.12472E+01, 0.12537E+01, 0.12601E+01, 0.12665E+01,
- & 0.12728E+01, 0.12792E+01, 0.12856E+01, 0.12919E+01, 0.12982E+01,
- & 0.13045E+01, 0.13109E+01, 0.13171E+01, 0.13234E+01, 0.13297E+01,
- & 0.13359E+01, 0.13422E+01, 0.13484E+01, 0.13546E+01, 0.13608E+01,
- & 0.13670E+01, 0.13732E+01, 0.13794E+01, 0.13855E+01, 0.13917E+01,
- & 0.13978E+01, 0.14039E+01, 0.14100E+01, 0.14161E+01, 0.14222E+01,
- & 0.14282E+01, 0.14343E+01, 0.14403E+01, 0.14464E+01, 0.14524E+01,
- & 0.14584E+01, 0.14644E+01, 0.14704E+01, 0.14763E+01, 0.14823E+01,
- & 0.14882E+01, 0.14942E+01, 0.15001E+01, 0.15060E+01, 0.15119E+01,
- & 0.15178E+01, 0.15237E+01, 0.15295E+01, 0.15354E+01, 0.15412E+01,
- & 0.15471E+01, 0.15529E+01, 0.15587E+01, 0.15645E+01, 0.15703E+01,
- & 0.15761E+01, 0.15818E+01, 0.15876E+01, 0.15933E+01, 0.15990E+01,
- & 0.16047E+01, 0.16105E+01, 0.16162E+01, 0.16218E+01, 0.16275E+01,
- & 0.16332E+01, 0.16388E+01, 0.16445E+01, 0.16501E+01, 0.16557E+01,
- & 0.16613E+01, 0.16669E+01, 0.16725E+01, 0.16781E+01, 0.16836E+01,
- & 0.16892E+01, 0.16947E+01, 0.17003E+01, 0.17058E+01, 0.17113E+01/
-
- DATA (BNC11M(I),I=301,400)/
- & 0.17168E+01, 0.17223E+01, 0.17278E+01, 0.17332E+01, 0.17387E+01,
- & 0.17441E+01, 0.17496E+01, 0.17550E+01, 0.17604E+01, 0.17658E+01,
- & 0.17712E+01, 0.17766E+01, 0.17820E+01, 0.17874E+01, 0.17927E+01,
- & 0.17981E+01, 0.18034E+01, 0.18087E+01, 0.18141E+01, 0.18194E+01,
- & 0.18247E+01, 0.18300E+01, 0.18352E+01, 0.18405E+01, 0.18458E+01,
- & 0.18510E+01, 0.18562E+01, 0.18615E+01, 0.18667E+01, 0.18719E+01,
- & 0.18771E+01, 0.18823E+01, 0.18875E+01, 0.18927E+01, 0.18978E+01,
- & 0.19030E+01, 0.19081E+01, 0.19132E+01, 0.19184E+01, 0.19235E+01,
- & 0.19286E+01, 0.19337E+01, 0.19388E+01, 0.19439E+01, 0.19489E+01,
- & 0.19540E+01, 0.19590E+01, 0.19641E+01, 0.19691E+01, 0.19741E+01,
- & 0.19792E+01, 0.19842E+01, 0.19892E+01, 0.19942E+01, 0.19991E+01,
- & 0.20041E+01, 0.20091E+01, 0.20140E+01, 0.20190E+01, 0.20239E+01,
- & 0.20288E+01, 0.20338E+01, 0.20387E+01, 0.20436E+01, 0.20485E+01,
- & 0.20533E+01, 0.20582E+01, 0.20631E+01, 0.20679E+01, 0.20728E+01,
- & 0.20776E+01, 0.20825E+01, 0.20873E+01, 0.20921E+01, 0.20969E+01,
- & 0.21017E+01, 0.21065E+01, 0.21113E+01, 0.21161E+01, 0.21209E+01,
- & 0.21256E+01, 0.21304E+01, 0.21351E+01, 0.21398E+01, 0.21446E+01,
- & 0.21493E+01, 0.21540E+01, 0.21587E+01, 0.21634E+01, 0.21681E+01,
- & 0.21728E+01, 0.21774E+01, 0.21821E+01, 0.21868E+01, 0.21914E+01,
- & 0.21960E+01, 0.22007E+01, 0.22053E+01, 0.22099E+01, 0.22145E+01/
-
- DATA (BNC11M(I),I=401,500)/
- & 0.22191E+01, 0.22237E+01, 0.22283E+01, 0.22329E+01, 0.22375E+01,
- & 0.22420E+01, 0.22466E+01, 0.22511E+01, 0.22557E+01, 0.22602E+01,
- & 0.22647E+01, 0.22693E+01, 0.22738E+01, 0.22783E+01, 0.22828E+01,
- & 0.22873E+01, 0.22917E+01, 0.22962E+01, 0.23007E+01, 0.23051E+01,
- & 0.23096E+01, 0.23140E+01, 0.23185E+01, 0.23229E+01, 0.23273E+01,
- & 0.23318E+01, 0.23362E+01, 0.23406E+01, 0.23450E+01, 0.23494E+01,
- & 0.23537E+01, 0.23581E+01, 0.23625E+01, 0.23668E+01, 0.23712E+01,
- & 0.23756E+01, 0.23799E+01, 0.23842E+01, 0.23886E+01, 0.23929E+01,
- & 0.23972E+01, 0.24015E+01, 0.24058E+01, 0.24101E+01, 0.24144E+01,
- & 0.24187E+01, 0.24229E+01, 0.24272E+01, 0.24315E+01, 0.24357E+01,
- & 0.24400E+01, 0.24442E+01, 0.24484E+01, 0.24527E+01, 0.24569E+01,
- & 0.24611E+01, 0.24653E+01, 0.24695E+01, 0.24737E+01, 0.24779E+01,
- & 0.24821E+01, 0.24862E+01, 0.24904E+01, 0.24946E+01, 0.24987E+01,
- & 0.25029E+01, 0.25070E+01, 0.25112E+01, 0.25153E+01, 0.25194E+01,
- & 0.25235E+01, 0.25276E+01, 0.25317E+01, 0.25358E+01, 0.25399E+01,
- & 0.25440E+01, 0.25481E+01, 0.25522E+01, 0.25563E+01, 0.25603E+01,
- & 0.25644E+01, 0.25684E+01, 0.25725E+01, 0.25765E+01, 0.25805E+01,
- & 0.25846E+01, 0.25886E+01, 0.25926E+01, 0.25966E+01, 0.26006E+01,
- & 0.26046E+01, 0.26086E+01, 0.26126E+01, 0.26166E+01, 0.26205E+01,
- & 0.26245E+01, 0.26285E+01, 0.26324E+01, 0.26364E+01, 0.26403E+01/
-
- DATA (BNC11M(I),I=501,600)/
- & 0.26443E+01, 0.26482E+01, 0.26521E+01, 0.26561E+01, 0.26600E+01,
- & 0.26639E+01, 0.26678E+01, 0.26717E+01, 0.26756E+01, 0.26795E+01,
- & 0.26834E+01, 0.26872E+01, 0.26911E+01, 0.26950E+01, 0.26988E+01,
- & 0.27027E+01, 0.27065E+01, 0.27104E+01, 0.27142E+01, 0.27181E+01,
- & 0.27219E+01, 0.27257E+01, 0.27295E+01, 0.27333E+01, 0.27371E+01,
- & 0.27409E+01, 0.27447E+01, 0.27485E+01, 0.27523E+01, 0.27561E+01,
- & 0.27599E+01, 0.27636E+01, 0.27674E+01, 0.27712E+01, 0.27749E+01,
- & 0.27787E+01, 0.27824E+01, 0.27861E+01, 0.27899E+01, 0.27936E+01,
- & 0.27973E+01, 0.28010E+01, 0.28048E+01, 0.28085E+01, 0.28122E+01,
- & 0.28159E+01, 0.28195E+01, 0.28232E+01, 0.28269E+01, 0.28306E+01,
- & 0.28343E+01, 0.28379E+01, 0.28416E+01, 0.28453E+01, 0.28489E+01,
- & 0.28525E+01, 0.28562E+01, 0.28598E+01, 0.28635E+01, 0.28671E+01,
- & 0.28707E+01, 0.28743E+01, 0.28779E+01, 0.28815E+01, 0.28851E+01,
- & 0.28887E+01, 0.28923E+01, 0.28959E+01, 0.28995E+01, 0.29031E+01,
- & 0.29067E+01, 0.29102E+01, 0.29138E+01, 0.29174E+01, 0.29209E+01,
- & 0.29245E+01, 0.29280E+01, 0.29315E+01, 0.29351E+01, 0.29386E+01,
- & 0.29421E+01, 0.29457E+01, 0.29492E+01, 0.29527E+01, 0.29562E+01,
- & 0.29597E+01, 0.29632E+01, 0.29667E+01, 0.29702E+01, 0.29737E+01,
- & 0.29772E+01, 0.29806E+01, 0.29841E+01, 0.29876E+01, 0.29910E+01,
- & 0.29945E+01, 0.29980E+01, 0.30014E+01, 0.30048E+01, 0.30083E+01/
-
- DATA (BNC11M(I),I=601,700)/
- & 0.30452E+01, 0.30789E+01, 0.31122E+01, 0.31450E+01, 0.31775E+01,
- & 0.32096E+01, 0.32413E+01, 0.32726E+01, 0.33035E+01, 0.33341E+01,
- & 0.33644E+01, 0.33943E+01, 0.34238E+01, 0.34531E+01, 0.34820E+01,
- & 0.35106E+01, 0.35389E+01, 0.35668E+01, 0.35945E+01, 0.36219E+01,
- & 0.36490E+01, 0.36759E+01, 0.37024E+01, 0.37287E+01, 0.37548E+01,
- & 0.37805E+01, 0.38061E+01, 0.38313E+01, 0.38564E+01, 0.38811E+01,
- & 0.39057E+01, 0.39300E+01, 0.39541E+01, 0.39780E+01, 0.40016E+01,
- & 0.40250E+01, 0.40483E+01, 0.40713E+01, 0.40941E+01, 0.41167E+01,
- & 0.41391E+01, 0.41613E+01, 0.41833E+01, 0.42051E+01, 0.42268E+01,
- & 0.42482E+01, 0.42695E+01, 0.42906E+01, 0.43116E+01, 0.43323E+01,
- & 0.43529E+01, 0.43733E+01, 0.43936E+01, 0.44137E+01, 0.44336E+01,
- & 0.44534E+01, 0.44730E+01, 0.44925E+01, 0.45118E+01, 0.45310E+01,
- & 0.45500E+01, 0.45689E+01, 0.45877E+01, 0.46063E+01, 0.46247E+01,
- & 0.46431E+01, 0.46613E+01, 0.46793E+01, 0.46973E+01, 0.47151E+01,
- & 0.47327E+01, 0.47503E+01, 0.47677E+01, 0.47850E+01, 0.48022E+01,
- & 0.48193E+01, 0.48362E+01, 0.48530E+01, 0.48698E+01, 0.48864E+01,
- & 0.49029E+01, 0.49192E+01, 0.49355E+01, 0.49517E+01, 0.49677E+01,
- & 0.49837E+01, 0.49995E+01, 0.50153E+01, 0.50309E+01, 0.50465E+01,
- & 0.50619E+01, 0.50773E+01, 0.50925E+01, 0.51077E+01, 0.51227E+01,
- & 0.51377E+01, 0.51526E+01, 0.51673E+01, 0.51820E+01, 0.51966E+01/
-
- DATA (BNC11M(I),I=701,741)/
- & 0.52112E+01, 0.52256E+01, 0.52399E+01, 0.52542E+01, 0.52683E+01,
- & 0.52824E+01, 0.52964E+01, 0.53104E+01, 0.53242E+01, 0.53380E+01,
- & 0.53516E+01, 0.53652E+01, 0.53788E+01, 0.53922E+01, 0.54056E+01,
- & 0.54189E+01, 0.54321E+01, 0.54453E+01, 0.54583E+01, 0.54713E+01,
- & 0.54843E+01, 0.54971E+01, 0.55099E+01, 0.55226E+01, 0.55353E+01,
- & 0.55479E+01, 0.55604E+01, 0.55729E+01, 0.55852E+01, 0.55976E+01,
- & 0.56098E+01, 0.56220E+01, 0.56341E+01, 0.56462E+01, 0.56582E+01,
- & 0.56701E+01, 0.56820E+01, 0.56938E+01, 0.57056E+01, 0.57173E+01,
- & 0.57289E+01
- & /
-C
-C *** NaHSO4
-C
- DATA (BNC12M(I),I=1,100)/
- &-0.46075E-01,-0.95502E-01,-0.11783E+00,-0.13242E+00,-0.14301E+00,
- &-0.15113E+00,-0.15754E+00,-0.16269E+00,-0.16685E+00,-0.17024E+00,
- &-0.17298E+00,-0.17518E+00,-0.17692E+00,-0.17825E+00,-0.17923E+00,
- &-0.17990E+00,-0.18028E+00,-0.18041E+00,-0.18030E+00,-0.17998E+00,
- &-0.17946E+00,-0.17875E+00,-0.17788E+00,-0.17684E+00,-0.17565E+00,
- &-0.17433E+00,-0.17286E+00,-0.17128E+00,-0.16957E+00,-0.16775E+00,
- &-0.16581E+00,-0.16378E+00,-0.16165E+00,-0.15942E+00,-0.15710E+00,
- &-0.15470E+00,-0.15222E+00,-0.14965E+00,-0.14702E+00,-0.14431E+00,
- &-0.14153E+00,-0.13868E+00,-0.13577E+00,-0.13280E+00,-0.12977E+00,
- &-0.12669E+00,-0.12355E+00,-0.12036E+00,-0.11712E+00,-0.11383E+00,
- &-0.11049E+00,-0.10711E+00,-0.10369E+00,-0.10023E+00,-0.96726E-01,
- &-0.93185E-01,-0.89606E-01,-0.85990E-01,-0.82339E-01,-0.78653E-01,
- &-0.74934E-01,-0.71181E-01,-0.67397E-01,-0.63580E-01,-0.59732E-01,
- &-0.55853E-01,-0.51943E-01,-0.48003E-01,-0.44033E-01,-0.40032E-01,
- &-0.36001E-01,-0.31941E-01,-0.27850E-01,-0.23729E-01,-0.19578E-01,
- &-0.15397E-01,-0.11185E-01,-0.69434E-02,-0.26710E-02, 0.16320E-02,
- & 0.59656E-02, 0.10330E-01, 0.14725E-01, 0.19151E-01, 0.23607E-01,
- & 0.28093E-01, 0.32610E-01, 0.37158E-01, 0.41734E-01, 0.46341E-01,
- & 0.50976E-01, 0.55640E-01, 0.60333E-01, 0.65052E-01, 0.69799E-01,
- & 0.74572E-01, 0.79370E-01, 0.84193E-01, 0.89040E-01, 0.93910E-01/
-
- DATA (BNC12M(I),I=101,200)/
- & 0.98802E-01, 0.10371E+00, 0.10865E+00, 0.11360E+00, 0.11857E+00,
- & 0.12356E+00, 0.12856E+00, 0.13358E+00, 0.13861E+00, 0.14365E+00,
- & 0.14871E+00, 0.15378E+00, 0.15885E+00, 0.16394E+00, 0.16903E+00,
- & 0.17413E+00, 0.17923E+00, 0.18434E+00, 0.18945E+00, 0.19457E+00,
- & 0.19969E+00, 0.20481E+00, 0.20993E+00, 0.21505E+00, 0.22017E+00,
- & 0.22529E+00, 0.23040E+00, 0.23552E+00, 0.24063E+00, 0.24574E+00,
- & 0.25084E+00, 0.25594E+00, 0.26103E+00, 0.26612E+00, 0.27120E+00,
- & 0.27628E+00, 0.28135E+00, 0.28642E+00, 0.29148E+00, 0.29653E+00,
- & 0.30157E+00, 0.30661E+00, 0.31163E+00, 0.31665E+00, 0.32167E+00,
- & 0.32667E+00, 0.33167E+00, 0.33666E+00, 0.34163E+00, 0.34660E+00,
- & 0.35157E+00, 0.35652E+00, 0.36146E+00, 0.36640E+00, 0.37132E+00,
- & 0.37624E+00, 0.38115E+00, 0.38604E+00, 0.39093E+00, 0.39581E+00,
- & 0.40068E+00, 0.40554E+00, 0.41039E+00, 0.41523E+00, 0.42006E+00,
- & 0.42488E+00, 0.42970E+00, 0.43450E+00, 0.43929E+00, 0.44408E+00,
- & 0.44885E+00, 0.45361E+00, 0.45837E+00, 0.46311E+00, 0.46785E+00,
- & 0.47257E+00, 0.47729E+00, 0.48199E+00, 0.48669E+00, 0.49137E+00,
- & 0.49605E+00, 0.50072E+00, 0.50537E+00, 0.51002E+00, 0.51466E+00,
- & 0.51928E+00, 0.52390E+00, 0.52851E+00, 0.53311E+00, 0.53770E+00,
- & 0.54228E+00, 0.54684E+00, 0.55140E+00, 0.55595E+00, 0.56050E+00,
- & 0.56503E+00, 0.56955E+00, 0.57406E+00, 0.57856E+00, 0.58306E+00/
-
- DATA (BNC12M(I),I=201,300)/
- & 0.58754E+00, 0.59201E+00, 0.59648E+00, 0.60093E+00, 0.60538E+00,
- & 0.60982E+00, 0.61424E+00, 0.61866E+00, 0.62307E+00, 0.62747E+00,
- & 0.63186E+00, 0.63624E+00, 0.64061E+00, 0.64497E+00, 0.64933E+00,
- & 0.65367E+00, 0.65801E+00, 0.66233E+00, 0.66665E+00, 0.67096E+00,
- & 0.67525E+00, 0.67954E+00, 0.68383E+00, 0.68810E+00, 0.69236E+00,
- & 0.69662E+00, 0.70086E+00, 0.70510E+00, 0.70933E+00, 0.71354E+00,
- & 0.71776E+00, 0.72196E+00, 0.72615E+00, 0.73033E+00, 0.73451E+00,
- & 0.73868E+00, 0.74284E+00, 0.74699E+00, 0.75113E+00, 0.75526E+00,
- & 0.75939E+00, 0.76350E+00, 0.76761E+00, 0.77171E+00, 0.77580E+00,
- & 0.77989E+00, 0.78396E+00, 0.78803E+00, 0.79208E+00, 0.79614E+00,
- & 0.80018E+00, 0.80421E+00, 0.80824E+00, 0.81225E+00, 0.81626E+00,
- & 0.82027E+00, 0.82426E+00, 0.82825E+00, 0.83222E+00, 0.83619E+00,
- & 0.84015E+00, 0.84411E+00, 0.84805E+00, 0.85199E+00, 0.85592E+00,
- & 0.85985E+00, 0.86376E+00, 0.86767E+00, 0.87157E+00, 0.87546E+00,
- & 0.87935E+00, 0.88322E+00, 0.88709E+00, 0.89095E+00, 0.89481E+00,
- & 0.89866E+00, 0.90250E+00, 0.90633E+00, 0.91015E+00, 0.91397E+00,
- & 0.91778E+00, 0.92158E+00, 0.92538E+00, 0.92916E+00, 0.93295E+00,
- & 0.93672E+00, 0.94049E+00, 0.94424E+00, 0.94800E+00, 0.95174E+00,
- & 0.95548E+00, 0.95921E+00, 0.96293E+00, 0.96665E+00, 0.97036E+00,
- & 0.97406E+00, 0.97776E+00, 0.98145E+00, 0.98513E+00, 0.98880E+00/
-
- DATA (BNC12M(I),I=301,400)/
- & 0.99247E+00, 0.99613E+00, 0.99979E+00, 0.10034E+01, 0.10071E+01,
- & 0.10107E+01, 0.10143E+01, 0.10180E+01, 0.10216E+01, 0.10252E+01,
- & 0.10288E+01, 0.10324E+01, 0.10360E+01, 0.10395E+01, 0.10431E+01,
- & 0.10467E+01, 0.10502E+01, 0.10538E+01, 0.10573E+01, 0.10609E+01,
- & 0.10644E+01, 0.10680E+01, 0.10715E+01, 0.10750E+01, 0.10785E+01,
- & 0.10820E+01, 0.10855E+01, 0.10890E+01, 0.10925E+01, 0.10960E+01,
- & 0.10994E+01, 0.11029E+01, 0.11064E+01, 0.11098E+01, 0.11133E+01,
- & 0.11167E+01, 0.11201E+01, 0.11236E+01, 0.11270E+01, 0.11304E+01,
- & 0.11338E+01, 0.11372E+01, 0.11406E+01, 0.11440E+01, 0.11474E+01,
- & 0.11508E+01, 0.11542E+01, 0.11575E+01, 0.11609E+01, 0.11642E+01,
- & 0.11676E+01, 0.11709E+01, 0.11743E+01, 0.11776E+01, 0.11810E+01,
- & 0.11843E+01, 0.11876E+01, 0.11909E+01, 0.11942E+01, 0.11975E+01,
- & 0.12008E+01, 0.12041E+01, 0.12074E+01, 0.12107E+01, 0.12139E+01,
- & 0.12172E+01, 0.12205E+01, 0.12237E+01, 0.12270E+01, 0.12302E+01,
- & 0.12335E+01, 0.12367E+01, 0.12399E+01, 0.12431E+01, 0.12464E+01,
- & 0.12496E+01, 0.12528E+01, 0.12560E+01, 0.12592E+01, 0.12624E+01,
- & 0.12656E+01, 0.12687E+01, 0.12719E+01, 0.12751E+01, 0.12782E+01,
- & 0.12814E+01, 0.12846E+01, 0.12877E+01, 0.12909E+01, 0.12940E+01,
- & 0.12971E+01, 0.13003E+01, 0.13034E+01, 0.13065E+01, 0.13096E+01,
- & 0.13127E+01, 0.13158E+01, 0.13189E+01, 0.13220E+01, 0.13251E+01/
-
- DATA (BNC12M(I),I=401,500)/
- & 0.13282E+01, 0.13313E+01, 0.13343E+01, 0.13374E+01, 0.13405E+01,
- & 0.13435E+01, 0.13466E+01, 0.13496E+01, 0.13527E+01, 0.13557E+01,
- & 0.13588E+01, 0.13618E+01, 0.13648E+01, 0.13678E+01, 0.13708E+01,
- & 0.13739E+01, 0.13769E+01, 0.13799E+01, 0.13829E+01, 0.13858E+01,
- & 0.13888E+01, 0.13918E+01, 0.13948E+01, 0.13978E+01, 0.14007E+01,
- & 0.14037E+01, 0.14067E+01, 0.14096E+01, 0.14126E+01, 0.14155E+01,
- & 0.14184E+01, 0.14214E+01, 0.14243E+01, 0.14272E+01, 0.14302E+01,
- & 0.14331E+01, 0.14360E+01, 0.14389E+01, 0.14418E+01, 0.14447E+01,
- & 0.14476E+01, 0.14505E+01, 0.14534E+01, 0.14563E+01, 0.14591E+01,
- & 0.14620E+01, 0.14649E+01, 0.14678E+01, 0.14706E+01, 0.14735E+01,
- & 0.14763E+01, 0.14792E+01, 0.14820E+01, 0.14849E+01, 0.14877E+01,
- & 0.14905E+01, 0.14933E+01, 0.14962E+01, 0.14990E+01, 0.15018E+01,
- & 0.15046E+01, 0.15074E+01, 0.15102E+01, 0.15130E+01, 0.15158E+01,
- & 0.15186E+01, 0.15214E+01, 0.15242E+01, 0.15269E+01, 0.15297E+01,
- & 0.15325E+01, 0.15352E+01, 0.15380E+01, 0.15408E+01, 0.15435E+01,
- & 0.15463E+01, 0.15490E+01, 0.15517E+01, 0.15545E+01, 0.15572E+01,
- & 0.15599E+01, 0.15627E+01, 0.15654E+01, 0.15681E+01, 0.15708E+01,
- & 0.15735E+01, 0.15762E+01, 0.15789E+01, 0.15816E+01, 0.15843E+01,
- & 0.15870E+01, 0.15897E+01, 0.15924E+01, 0.15951E+01, 0.15977E+01,
- & 0.16004E+01, 0.16031E+01, 0.16057E+01, 0.16084E+01, 0.16110E+01/
-
- DATA (BNC12M(I),I=501,600)/
- & 0.16137E+01, 0.16163E+01, 0.16190E+01, 0.16216E+01, 0.16243E+01,
- & 0.16269E+01, 0.16295E+01, 0.16321E+01, 0.16348E+01, 0.16374E+01,
- & 0.16400E+01, 0.16426E+01, 0.16452E+01, 0.16478E+01, 0.16504E+01,
- & 0.16530E+01, 0.16556E+01, 0.16582E+01, 0.16608E+01, 0.16634E+01,
- & 0.16659E+01, 0.16685E+01, 0.16711E+01, 0.16736E+01, 0.16762E+01,
- & 0.16788E+01, 0.16813E+01, 0.16839E+01, 0.16864E+01, 0.16890E+01,
- & 0.16915E+01, 0.16940E+01, 0.16966E+01, 0.16991E+01, 0.17016E+01,
- & 0.17042E+01, 0.17067E+01, 0.17092E+01, 0.17117E+01, 0.17142E+01,
- & 0.17167E+01, 0.17192E+01, 0.17218E+01, 0.17242E+01, 0.17267E+01,
- & 0.17292E+01, 0.17317E+01, 0.17342E+01, 0.17367E+01, 0.17392E+01,
- & 0.17416E+01, 0.17441E+01, 0.17466E+01, 0.17490E+01, 0.17515E+01,
- & 0.17540E+01, 0.17564E+01, 0.17589E+01, 0.17613E+01, 0.17638E+01,
- & 0.17662E+01, 0.17686E+01, 0.17711E+01, 0.17735E+01, 0.17759E+01,
- & 0.17784E+01, 0.17808E+01, 0.17832E+01, 0.17856E+01, 0.17880E+01,
- & 0.17904E+01, 0.17929E+01, 0.17953E+01, 0.17977E+01, 0.18001E+01,
- & 0.18024E+01, 0.18048E+01, 0.18072E+01, 0.18096E+01, 0.18120E+01,
- & 0.18144E+01, 0.18167E+01, 0.18191E+01, 0.18215E+01, 0.18239E+01,
- & 0.18262E+01, 0.18286E+01, 0.18309E+01, 0.18333E+01, 0.18356E+01,
- & 0.18380E+01, 0.18403E+01, 0.18427E+01, 0.18450E+01, 0.18474E+01,
- & 0.18497E+01, 0.18520E+01, 0.18543E+01, 0.18567E+01, 0.18590E+01/
-
- DATA (BNC12M(I),I=601,700)/
- & 0.18839E+01, 0.19066E+01, 0.19291E+01, 0.19513E+01, 0.19732E+01,
- & 0.19949E+01, 0.20163E+01, 0.20374E+01, 0.20583E+01, 0.20790E+01,
- & 0.20994E+01, 0.21196E+01, 0.21396E+01, 0.21594E+01, 0.21789E+01,
- & 0.21982E+01, 0.22174E+01, 0.22363E+01, 0.22550E+01, 0.22735E+01,
- & 0.22918E+01, 0.23100E+01, 0.23279E+01, 0.23457E+01, 0.23633E+01,
- & 0.23807E+01, 0.23979E+01, 0.24150E+01, 0.24319E+01, 0.24487E+01,
- & 0.24653E+01, 0.24817E+01, 0.24980E+01, 0.25141E+01, 0.25301E+01,
- & 0.25459E+01, 0.25616E+01, 0.25771E+01, 0.25925E+01, 0.26078E+01,
- & 0.26229E+01, 0.26379E+01, 0.26527E+01, 0.26675E+01, 0.26821E+01,
- & 0.26965E+01, 0.27109E+01, 0.27251E+01, 0.27393E+01, 0.27532E+01,
- & 0.27671E+01, 0.27809E+01, 0.27945E+01, 0.28081E+01, 0.28215E+01,
- & 0.28349E+01, 0.28481E+01, 0.28612E+01, 0.28742E+01, 0.28871E+01,
- & 0.28999E+01, 0.29126E+01, 0.29252E+01, 0.29378E+01, 0.29502E+01,
- & 0.29625E+01, 0.29747E+01, 0.29869E+01, 0.29989E+01, 0.30109E+01,
- & 0.30228E+01, 0.30346E+01, 0.30463E+01, 0.30579E+01, 0.30694E+01,
- & 0.30809E+01, 0.30923E+01, 0.31036E+01, 0.31148E+01, 0.31259E+01,
- & 0.31370E+01, 0.31480E+01, 0.31589E+01, 0.31697E+01, 0.31805E+01,
- & 0.31912E+01, 0.32018E+01, 0.32123E+01, 0.32228E+01, 0.32332E+01,
- & 0.32436E+01, 0.32538E+01, 0.32640E+01, 0.32742E+01, 0.32842E+01,
- & 0.32943E+01, 0.33042E+01, 0.33141E+01, 0.33239E+01, 0.33336E+01/
-
- DATA (BNC12M(I),I=701,741)/
- & 0.33433E+01, 0.33530E+01, 0.33626E+01, 0.33721E+01, 0.33815E+01,
- & 0.33909E+01, 0.34003E+01, 0.34095E+01, 0.34188E+01, 0.34279E+01,
- & 0.34371E+01, 0.34461E+01, 0.34551E+01, 0.34641E+01, 0.34730E+01,
- & 0.34819E+01, 0.34906E+01, 0.34994E+01, 0.35081E+01, 0.35167E+01,
- & 0.35253E+01, 0.35339E+01, 0.35424E+01, 0.35508E+01, 0.35592E+01,
- & 0.35676E+01, 0.35759E+01, 0.35842E+01, 0.35924E+01, 0.36006E+01,
- & 0.36087E+01, 0.36168E+01, 0.36248E+01, 0.36328E+01, 0.36408E+01,
- & 0.36487E+01, 0.36565E+01, 0.36644E+01, 0.36721E+01, 0.36799E+01,
- & 0.36876E+01
- & /
-C
-C *** (NH4)3H(SO4)2
-C
- DATA (BNC13M(I),I=1,100)/
- &-0.76088E-01,-0.16481E+00,-0.20885E+00,-0.23985E+00,-0.26408E+00,
- &-0.28407E+00,-0.30112E+00,-0.31600E+00,-0.32922E+00,-0.34109E+00,
- &-0.35188E+00,-0.36175E+00,-0.37084E+00,-0.37927E+00,-0.38712E+00,
- &-0.39445E+00,-0.40133E+00,-0.40781E+00,-0.41391E+00,-0.41968E+00,
- &-0.42515E+00,-0.43034E+00,-0.43528E+00,-0.43998E+00,-0.44445E+00,
- &-0.44873E+00,-0.45281E+00,-0.45671E+00,-0.46044E+00,-0.46402E+00,
- &-0.46744E+00,-0.47073E+00,-0.47388E+00,-0.47690E+00,-0.47980E+00,
- &-0.48259E+00,-0.48527E+00,-0.48784E+00,-0.49032E+00,-0.49270E+00,
- &-0.49498E+00,-0.49718E+00,-0.49930E+00,-0.50133E+00,-0.50329E+00,
- &-0.50517E+00,-0.50698E+00,-0.50872E+00,-0.51040E+00,-0.51201E+00,
- &-0.51356E+00,-0.51505E+00,-0.51648E+00,-0.51786E+00,-0.51919E+00,
- &-0.52046E+00,-0.52169E+00,-0.52287E+00,-0.52400E+00,-0.52508E+00,
- &-0.52613E+00,-0.52713E+00,-0.52809E+00,-0.52901E+00,-0.52989E+00,
- &-0.53074E+00,-0.53155E+00,-0.53233E+00,-0.53307E+00,-0.53378E+00,
- &-0.53446E+00,-0.53510E+00,-0.53572E+00,-0.53631E+00,-0.53686E+00,
- &-0.53739E+00,-0.53790E+00,-0.53837E+00,-0.53882E+00,-0.53924E+00,
- &-0.53964E+00,-0.54002E+00,-0.54036E+00,-0.54069E+00,-0.54099E+00,
- &-0.54128E+00,-0.54153E+00,-0.54177E+00,-0.54199E+00,-0.54218E+00,
- &-0.54236E+00,-0.54251E+00,-0.54265E+00,-0.54277E+00,-0.54287E+00,
- &-0.54295E+00,-0.54301E+00,-0.54306E+00,-0.54309E+00,-0.54310E+00/
-
- DATA (BNC13M(I),I=101,200)/
- &-0.54310E+00,-0.54309E+00,-0.54306E+00,-0.54301E+00,-0.54295E+00,
- &-0.54288E+00,-0.54279E+00,-0.54270E+00,-0.54259E+00,-0.54247E+00,
- &-0.54233E+00,-0.54219E+00,-0.54204E+00,-0.54188E+00,-0.54170E+00,
- &-0.54152E+00,-0.54133E+00,-0.54113E+00,-0.54092E+00,-0.54071E+00,
- &-0.54049E+00,-0.54026E+00,-0.54002E+00,-0.53978E+00,-0.53953E+00,
- &-0.53927E+00,-0.53901E+00,-0.53875E+00,-0.53848E+00,-0.53820E+00,
- &-0.53792E+00,-0.53763E+00,-0.53734E+00,-0.53705E+00,-0.53675E+00,
- &-0.53645E+00,-0.53614E+00,-0.53583E+00,-0.53552E+00,-0.53520E+00,
- &-0.53488E+00,-0.53456E+00,-0.53423E+00,-0.53391E+00,-0.53357E+00,
- &-0.53324E+00,-0.53291E+00,-0.53257E+00,-0.53223E+00,-0.53188E+00,
- &-0.53154E+00,-0.53119E+00,-0.53085E+00,-0.53050E+00,-0.53014E+00,
- &-0.52979E+00,-0.52944E+00,-0.52908E+00,-0.52872E+00,-0.52836E+00,
- &-0.52800E+00,-0.52764E+00,-0.52728E+00,-0.52691E+00,-0.52655E+00,
- &-0.52618E+00,-0.52582E+00,-0.52545E+00,-0.52508E+00,-0.52471E+00,
- &-0.52434E+00,-0.52397E+00,-0.52360E+00,-0.52323E+00,-0.52285E+00,
- &-0.52248E+00,-0.52211E+00,-0.52173E+00,-0.52136E+00,-0.52098E+00,
- &-0.52061E+00,-0.52023E+00,-0.51985E+00,-0.51948E+00,-0.51910E+00,
- &-0.51872E+00,-0.51834E+00,-0.51797E+00,-0.51759E+00,-0.51721E+00,
- &-0.51683E+00,-0.51646E+00,-0.51608E+00,-0.51570E+00,-0.51532E+00,
- &-0.51494E+00,-0.51456E+00,-0.51419E+00,-0.51381E+00,-0.51343E+00/
-
- DATA (BNC13M(I),I=201,300)/
- &-0.51305E+00,-0.51267E+00,-0.51230E+00,-0.51192E+00,-0.51154E+00,
- &-0.51116E+00,-0.51079E+00,-0.51041E+00,-0.51003E+00,-0.50966E+00,
- &-0.50928E+00,-0.50891E+00,-0.50853E+00,-0.50815E+00,-0.50778E+00,
- &-0.50740E+00,-0.50703E+00,-0.50666E+00,-0.50628E+00,-0.50591E+00,
- &-0.50554E+00,-0.50516E+00,-0.50479E+00,-0.50442E+00,-0.50405E+00,
- &-0.50368E+00,-0.50330E+00,-0.50293E+00,-0.50256E+00,-0.50219E+00,
- &-0.50183E+00,-0.50146E+00,-0.50109E+00,-0.50072E+00,-0.50035E+00,
- &-0.49999E+00,-0.49962E+00,-0.49925E+00,-0.49889E+00,-0.49852E+00,
- &-0.49816E+00,-0.49780E+00,-0.49743E+00,-0.49707E+00,-0.49671E+00,
- &-0.49634E+00,-0.49598E+00,-0.49562E+00,-0.49526E+00,-0.49490E+00,
- &-0.49454E+00,-0.49418E+00,-0.49383E+00,-0.49347E+00,-0.49311E+00,
- &-0.49275E+00,-0.49240E+00,-0.49204E+00,-0.49169E+00,-0.49133E+00,
- &-0.49098E+00,-0.49063E+00,-0.49028E+00,-0.48992E+00,-0.48957E+00,
- &-0.48922E+00,-0.48887E+00,-0.48852E+00,-0.48817E+00,-0.48782E+00,
- &-0.48748E+00,-0.48713E+00,-0.48678E+00,-0.48644E+00,-0.48609E+00,
- &-0.48575E+00,-0.48540E+00,-0.48506E+00,-0.48471E+00,-0.48437E+00,
- &-0.48403E+00,-0.48369E+00,-0.48335E+00,-0.48301E+00,-0.48267E+00,
- &-0.48233E+00,-0.48199E+00,-0.48165E+00,-0.48132E+00,-0.48098E+00,
- &-0.48065E+00,-0.48031E+00,-0.47998E+00,-0.47964E+00,-0.47931E+00,
- &-0.47898E+00,-0.47864E+00,-0.47831E+00,-0.47798E+00,-0.47765E+00/
-
- DATA (BNC13M(I),I=301,400)/
- &-0.47732E+00,-0.47699E+00,-0.47666E+00,-0.47634E+00,-0.47601E+00,
- &-0.47568E+00,-0.47536E+00,-0.47503E+00,-0.47471E+00,-0.47438E+00,
- &-0.47406E+00,-0.47374E+00,-0.47342E+00,-0.47309E+00,-0.47277E+00,
- &-0.47245E+00,-0.47213E+00,-0.47181E+00,-0.47150E+00,-0.47118E+00,
- &-0.47086E+00,-0.47055E+00,-0.47023E+00,-0.46991E+00,-0.46960E+00,
- &-0.46929E+00,-0.46897E+00,-0.46866E+00,-0.46835E+00,-0.46804E+00,
- &-0.46772E+00,-0.46741E+00,-0.46710E+00,-0.46680E+00,-0.46649E+00,
- &-0.46618E+00,-0.46587E+00,-0.46557E+00,-0.46526E+00,-0.46495E+00,
- &-0.46465E+00,-0.46435E+00,-0.46404E+00,-0.46374E+00,-0.46344E+00,
- &-0.46314E+00,-0.46283E+00,-0.46253E+00,-0.46223E+00,-0.46194E+00,
- &-0.46164E+00,-0.46134E+00,-0.46104E+00,-0.46074E+00,-0.46045E+00,
- &-0.46015E+00,-0.45986E+00,-0.45956E+00,-0.45927E+00,-0.45898E+00,
- &-0.45868E+00,-0.45839E+00,-0.45810E+00,-0.45781E+00,-0.45752E+00,
- &-0.45723E+00,-0.45694E+00,-0.45665E+00,-0.45637E+00,-0.45608E+00,
- &-0.45579E+00,-0.45551E+00,-0.45522E+00,-0.45494E+00,-0.45465E+00,
- &-0.45437E+00,-0.45409E+00,-0.45380E+00,-0.45352E+00,-0.45324E+00,
- &-0.45296E+00,-0.45268E+00,-0.45240E+00,-0.45212E+00,-0.45184E+00,
- &-0.45156E+00,-0.45129E+00,-0.45101E+00,-0.45074E+00,-0.45046E+00,
- &-0.45019E+00,-0.44991E+00,-0.44964E+00,-0.44936E+00,-0.44909E+00,
- &-0.44882E+00,-0.44855E+00,-0.44828E+00,-0.44801E+00,-0.44774E+00/
-
- DATA (BNC13M(I),I=401,500)/
- &-0.44747E+00,-0.44720E+00,-0.44693E+00,-0.44667E+00,-0.44640E+00,
- &-0.44613E+00,-0.44587E+00,-0.44560E+00,-0.44534E+00,-0.44507E+00,
- &-0.44481E+00,-0.44455E+00,-0.44428E+00,-0.44402E+00,-0.44376E+00,
- &-0.44350E+00,-0.44324E+00,-0.44298E+00,-0.44272E+00,-0.44246E+00,
- &-0.44221E+00,-0.44195E+00,-0.44169E+00,-0.44144E+00,-0.44118E+00,
- &-0.44093E+00,-0.44067E+00,-0.44042E+00,-0.44016E+00,-0.43991E+00,
- &-0.43966E+00,-0.43941E+00,-0.43916E+00,-0.43891E+00,-0.43866E+00,
- &-0.43841E+00,-0.43816E+00,-0.43791E+00,-0.43766E+00,-0.43741E+00,
- &-0.43717E+00,-0.43692E+00,-0.43667E+00,-0.43643E+00,-0.43618E+00,
- &-0.43594E+00,-0.43570E+00,-0.43545E+00,-0.43521E+00,-0.43497E+00,
- &-0.43473E+00,-0.43448E+00,-0.43424E+00,-0.43400E+00,-0.43376E+00,
- &-0.43353E+00,-0.43329E+00,-0.43305E+00,-0.43281E+00,-0.43257E+00,
- &-0.43234E+00,-0.43210E+00,-0.43187E+00,-0.43163E+00,-0.43140E+00,
- &-0.43116E+00,-0.43093E+00,-0.43070E+00,-0.43046E+00,-0.43023E+00,
- &-0.43000E+00,-0.42977E+00,-0.42954E+00,-0.42931E+00,-0.42908E+00,
- &-0.42885E+00,-0.42862E+00,-0.42840E+00,-0.42817E+00,-0.42794E+00,
- &-0.42772E+00,-0.42749E+00,-0.42727E+00,-0.42704E+00,-0.42682E+00,
- &-0.42659E+00,-0.42637E+00,-0.42615E+00,-0.42592E+00,-0.42570E+00,
- &-0.42548E+00,-0.42526E+00,-0.42504E+00,-0.42482E+00,-0.42460E+00,
- &-0.42438E+00,-0.42416E+00,-0.42394E+00,-0.42373E+00,-0.42351E+00/
-
- DATA (BNC13M(I),I=501,600)/
- &-0.42329E+00,-0.42308E+00,-0.42286E+00,-0.42265E+00,-0.42243E+00,
- &-0.42222E+00,-0.42200E+00,-0.42179E+00,-0.42158E+00,-0.42137E+00,
- &-0.42116E+00,-0.42094E+00,-0.42073E+00,-0.42052E+00,-0.42031E+00,
- &-0.42010E+00,-0.41989E+00,-0.41969E+00,-0.41948E+00,-0.41927E+00,
- &-0.41906E+00,-0.41886E+00,-0.41865E+00,-0.41844E+00,-0.41824E+00,
- &-0.41804E+00,-0.41783E+00,-0.41763E+00,-0.41742E+00,-0.41722E+00,
- &-0.41702E+00,-0.41682E+00,-0.41661E+00,-0.41641E+00,-0.41621E+00,
- &-0.41601E+00,-0.41581E+00,-0.41561E+00,-0.41541E+00,-0.41522E+00,
- &-0.41502E+00,-0.41482E+00,-0.41462E+00,-0.41443E+00,-0.41423E+00,
- &-0.41404E+00,-0.41384E+00,-0.41364E+00,-0.41345E+00,-0.41326E+00,
- &-0.41306E+00,-0.41287E+00,-0.41268E+00,-0.41249E+00,-0.41229E+00,
- &-0.41210E+00,-0.41191E+00,-0.41172E+00,-0.41153E+00,-0.41134E+00,
- &-0.41115E+00,-0.41096E+00,-0.41077E+00,-0.41059E+00,-0.41040E+00,
- &-0.41021E+00,-0.41003E+00,-0.40984E+00,-0.40965E+00,-0.40947E+00,
- &-0.40928E+00,-0.40910E+00,-0.40891E+00,-0.40873E+00,-0.40855E+00,
- &-0.40836E+00,-0.40818E+00,-0.40800E+00,-0.40782E+00,-0.40764E+00,
- &-0.40746E+00,-0.40728E+00,-0.40710E+00,-0.40692E+00,-0.40674E+00,
- &-0.40656E+00,-0.40638E+00,-0.40620E+00,-0.40603E+00,-0.40585E+00,
- &-0.40567E+00,-0.40550E+00,-0.40532E+00,-0.40514E+00,-0.40497E+00,
- &-0.40480E+00,-0.40462E+00,-0.40445E+00,-0.40427E+00,-0.40410E+00/
-
- DATA (BNC13M(I),I=601,700)/
- &-0.40226E+00,-0.40059E+00,-0.39896E+00,-0.39738E+00,-0.39582E+00,
- &-0.39431E+00,-0.39283E+00,-0.39138E+00,-0.38998E+00,-0.38860E+00,
- &-0.38726E+00,-0.38595E+00,-0.38467E+00,-0.38343E+00,-0.38221E+00,
- &-0.38103E+00,-0.37988E+00,-0.37876E+00,-0.37766E+00,-0.37660E+00,
- &-0.37556E+00,-0.37455E+00,-0.37357E+00,-0.37261E+00,-0.37169E+00,
- &-0.37078E+00,-0.36991E+00,-0.36906E+00,-0.36823E+00,-0.36743E+00,
- &-0.36665E+00,-0.36590E+00,-0.36516E+00,-0.36446E+00,-0.36377E+00,
- &-0.36311E+00,-0.36247E+00,-0.36185E+00,-0.36125E+00,-0.36067E+00,
- &-0.36012E+00,-0.35958E+00,-0.35907E+00,-0.35857E+00,-0.35809E+00,
- &-0.35764E+00,-0.35720E+00,-0.35678E+00,-0.35638E+00,-0.35600E+00,
- &-0.35563E+00,-0.35529E+00,-0.35496E+00,-0.35465E+00,-0.35435E+00,
- &-0.35407E+00,-0.35381E+00,-0.35357E+00,-0.35334E+00,-0.35313E+00,
- &-0.35293E+00,-0.35275E+00,-0.35258E+00,-0.35243E+00,-0.35229E+00,
- &-0.35217E+00,-0.35206E+00,-0.35197E+00,-0.35189E+00,-0.35183E+00,
- &-0.35178E+00,-0.35174E+00,-0.35172E+00,-0.35171E+00,-0.35171E+00,
- &-0.35173E+00,-0.35176E+00,-0.35180E+00,-0.35186E+00,-0.35193E+00,
- &-0.35201E+00,-0.35210E+00,-0.35220E+00,-0.35232E+00,-0.35245E+00,
- &-0.35258E+00,-0.35274E+00,-0.35290E+00,-0.35307E+00,-0.35326E+00,
- &-0.35345E+00,-0.35366E+00,-0.35387E+00,-0.35410E+00,-0.35434E+00,
- &-0.35459E+00,-0.35485E+00,-0.35512E+00,-0.35540E+00,-0.35569E+00/
-
- DATA (BNC13M(I),I=701,741)/
- &-0.35599E+00,-0.35629E+00,-0.35661E+00,-0.35694E+00,-0.35728E+00,
- &-0.35763E+00,-0.35798E+00,-0.35835E+00,-0.35872E+00,-0.35911E+00,
- &-0.35950E+00,-0.35990E+00,-0.36031E+00,-0.36073E+00,-0.36116E+00,
- &-0.36159E+00,-0.36204E+00,-0.36249E+00,-0.36295E+00,-0.36342E+00,
- &-0.36390E+00,-0.36438E+00,-0.36487E+00,-0.36537E+00,-0.36588E+00,
- &-0.36640E+00,-0.36692E+00,-0.36746E+00,-0.36799E+00,-0.36854E+00,
- &-0.36909E+00,-0.36966E+00,-0.37022E+00,-0.37080E+00,-0.37138E+00,
- &-0.37197E+00,-0.37257E+00,-0.37317E+00,-0.37378E+00,-0.37440E+00,
- &-0.37502E+00
- & /
- END
-
diff --git a/src/MNH/data_kmcf298a.f b/src/MNH/data_kmcf298a.f
deleted file mode 100644
index 158a1047fbf9e9508b6819b7adec0d811cc2dd82..0000000000000000000000000000000000000000
--- a/src/MNH/data_kmcf298a.f
+++ /dev/null
@@ -1,2218 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 data_kmcf298a.f 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-C=======================================================================
-C
-C *** ISORROPIA CODE
-C *** BLOCK DATA KMCF298A
-C *** CONTAINS THE DATA FOR KUSSIK-MEISNER BINARY COEFFICIENT ARRAYS
-C NEEDED IN SUBROUTINE KM
-C
-C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
-C *** WRITTEN BY ATHANASIOS NENES
-C
-C=======================================================================
-C
- BLOCK DATA KMCF298
-C
-C *** Common block definition
-C
- COMMON /KMC298/
- &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741),
- &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741),
- &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741),
- &BNC13M( 741)
-C
-C *** NaCl
-C
- DATA (BNC01M(I),I=1,100)/
- &-0.45329E-01,-0.94600E-01,-0.11698E+00,-0.13161E+00,-0.14224E+00,
- &-0.15040E+00,-0.15685E+00,-0.16205E+00,-0.16630E+00,-0.16979E+00,
- &-0.17267E+00,-0.17504E+00,-0.17699E+00,-0.17857E+00,-0.17984E+00,
- &-0.18084E+00,-0.18160E+00,-0.18215E+00,-0.18251E+00,-0.18271E+00,
- &-0.18276E+00,-0.18267E+00,-0.18247E+00,-0.18215E+00,-0.18174E+00,
- &-0.18124E+00,-0.18065E+00,-0.17999E+00,-0.17926E+00,-0.17847E+00,
- &-0.17763E+00,-0.17673E+00,-0.17578E+00,-0.17480E+00,-0.17377E+00,
- &-0.17270E+00,-0.17160E+00,-0.17047E+00,-0.16931E+00,-0.16813E+00,
- &-0.16692E+00,-0.16569E+00,-0.16445E+00,-0.16318E+00,-0.16190E+00,
- &-0.16060E+00,-0.15929E+00,-0.15796E+00,-0.15663E+00,-0.15528E+00,
- &-0.15392E+00,-0.15256E+00,-0.15118E+00,-0.14980E+00,-0.14841E+00,
- &-0.14701E+00,-0.14561E+00,-0.14419E+00,-0.14277E+00,-0.14135E+00,
- &-0.13992E+00,-0.13848E+00,-0.13703E+00,-0.13558E+00,-0.13412E+00,
- &-0.13265E+00,-0.13117E+00,-0.12969E+00,-0.12820E+00,-0.12670E+00,
- &-0.12519E+00,-0.12367E+00,-0.12214E+00,-0.12060E+00,-0.11905E+00,
- &-0.11750E+00,-0.11593E+00,-0.11434E+00,-0.11275E+00,-0.11115E+00,
- &-0.10953E+00,-0.10790E+00,-0.10626E+00,-0.10460E+00,-0.10293E+00,
- &-0.10125E+00,-0.99560E-01,-0.97854E-01,-0.96134E-01,-0.94401E-01,
- &-0.92654E-01,-0.90895E-01,-0.89123E-01,-0.87339E-01,-0.85542E-01,
- &-0.83733E-01,-0.81912E-01,-0.80079E-01,-0.78234E-01,-0.76379E-01/
-
- DATA (BNC01M(I),I=101,200)/
- &-0.74513E-01,-0.72637E-01,-0.70750E-01,-0.68854E-01,-0.66949E-01,
- &-0.65035E-01,-0.63113E-01,-0.61182E-01,-0.59244E-01,-0.57299E-01,
- &-0.55348E-01,-0.53390E-01,-0.51426E-01,-0.49456E-01,-0.47482E-01,
- &-0.45503E-01,-0.43520E-01,-0.41532E-01,-0.39541E-01,-0.37547E-01,
- &-0.35550E-01,-0.33550E-01,-0.31547E-01,-0.29543E-01,-0.27537E-01,
- &-0.25529E-01,-0.23520E-01,-0.21510E-01,-0.19499E-01,-0.17488E-01,
- &-0.15476E-01,-0.13463E-01,-0.11451E-01,-0.94381E-02,-0.74256E-02,
- &-0.54134E-02,-0.34017E-02,-0.13906E-02, 0.62006E-03, 0.26299E-02,
- & 0.46389E-02, 0.66470E-02, 0.86541E-02, 0.10660E-01, 0.12665E-01,
- & 0.14669E-01, 0.16671E-01, 0.18672E-01, 0.20672E-01, 0.22671E-01,
- & 0.24667E-01, 0.26663E-01, 0.28657E-01, 0.30649E-01, 0.32639E-01,
- & 0.34628E-01, 0.36616E-01, 0.38601E-01, 0.40585E-01, 0.42567E-01,
- & 0.44547E-01, 0.46525E-01, 0.48502E-01, 0.50476E-01, 0.52449E-01,
- & 0.54419E-01, 0.56388E-01, 0.58355E-01, 0.60320E-01, 0.62282E-01,
- & 0.64243E-01, 0.66202E-01, 0.68158E-01, 0.70113E-01, 0.72065E-01,
- & 0.74015E-01, 0.75963E-01, 0.77909E-01, 0.79853E-01, 0.81794E-01,
- & 0.83734E-01, 0.85671E-01, 0.87606E-01, 0.89539E-01, 0.91469E-01,
- & 0.93397E-01, 0.95323E-01, 0.97247E-01, 0.99168E-01, 0.10109E+00,
- & 0.10300E+00, 0.10492E+00, 0.10683E+00, 0.10874E+00, 0.11065E+00,
- & 0.11255E+00, 0.11446E+00, 0.11636E+00, 0.11825E+00, 0.12015E+00/
-
- DATA (BNC01M(I),I=201,300)/
- & 0.12204E+00, 0.12393E+00, 0.12582E+00, 0.12771E+00, 0.12959E+00,
- & 0.13147E+00, 0.13335E+00, 0.13523E+00, 0.13710E+00, 0.13897E+00,
- & 0.14084E+00, 0.14271E+00, 0.14457E+00, 0.14643E+00, 0.14829E+00,
- & 0.15015E+00, 0.15200E+00, 0.15385E+00, 0.15570E+00, 0.15755E+00,
- & 0.15939E+00, 0.16124E+00, 0.16307E+00, 0.16491E+00, 0.16675E+00,
- & 0.16858E+00, 0.17041E+00, 0.17223E+00, 0.17406E+00, 0.17588E+00,
- & 0.17770E+00, 0.17952E+00, 0.18133E+00, 0.18314E+00, 0.18495E+00,
- & 0.18676E+00, 0.18856E+00, 0.19036E+00, 0.19216E+00, 0.19396E+00,
- & 0.19575E+00, 0.19755E+00, 0.19934E+00, 0.20112E+00, 0.20291E+00,
- & 0.20469E+00, 0.20647E+00, 0.20824E+00, 0.21002E+00, 0.21179E+00,
- & 0.21356E+00, 0.21533E+00, 0.21709E+00, 0.21885E+00, 0.22061E+00,
- & 0.22237E+00, 0.22412E+00, 0.22588E+00, 0.22763E+00, 0.22937E+00,
- & 0.23112E+00, 0.23286E+00, 0.23460E+00, 0.23634E+00, 0.23807E+00,
- & 0.23980E+00, 0.24153E+00, 0.24326E+00, 0.24498E+00, 0.24671E+00,
- & 0.24843E+00, 0.25014E+00, 0.25186E+00, 0.25357E+00, 0.25528E+00,
- & 0.25699E+00, 0.25869E+00, 0.26040E+00, 0.26210E+00, 0.26380E+00,
- & 0.26549E+00, 0.26718E+00, 0.26888E+00, 0.27056E+00, 0.27225E+00,
- & 0.27393E+00, 0.27561E+00, 0.27729E+00, 0.27897E+00, 0.28064E+00,
- & 0.28231E+00, 0.28398E+00, 0.28565E+00, 0.28731E+00, 0.28898E+00,
- & 0.29064E+00, 0.29229E+00, 0.29395E+00, 0.29560E+00, 0.29725E+00/
-
- DATA (BNC01M(I),I=301,400)/
- & 0.29890E+00, 0.30054E+00, 0.30219E+00, 0.30383E+00, 0.30547E+00,
- & 0.30710E+00, 0.30874E+00, 0.31037E+00, 0.31200E+00, 0.31362E+00,
- & 0.31525E+00, 0.31687E+00, 0.31849E+00, 0.32011E+00, 0.32172E+00,
- & 0.32333E+00, 0.32495E+00, 0.32655E+00, 0.32816E+00, 0.32976E+00,
- & 0.33136E+00, 0.33296E+00, 0.33456E+00, 0.33616E+00, 0.33775E+00,
- & 0.33934E+00, 0.34093E+00, 0.34251E+00, 0.34410E+00, 0.34568E+00,
- & 0.34726E+00, 0.34883E+00, 0.35041E+00, 0.35198E+00, 0.35355E+00,
- & 0.35512E+00, 0.35668E+00, 0.35825E+00, 0.35981E+00, 0.36137E+00,
- & 0.36292E+00, 0.36448E+00, 0.36603E+00, 0.36758E+00, 0.36913E+00,
- & 0.37067E+00, 0.37222E+00, 0.37376E+00, 0.37530E+00, 0.37684E+00,
- & 0.37837E+00, 0.37990E+00, 0.38144E+00, 0.38296E+00, 0.38449E+00,
- & 0.38602E+00, 0.38754E+00, 0.38906E+00, 0.39058E+00, 0.39209E+00,
- & 0.39361E+00, 0.39512E+00, 0.39663E+00, 0.39814E+00, 0.39964E+00,
- & 0.40114E+00, 0.40265E+00, 0.40414E+00, 0.40564E+00, 0.40714E+00,
- & 0.40863E+00, 0.41012E+00, 0.41161E+00, 0.41310E+00, 0.41458E+00,
- & 0.41606E+00, 0.41755E+00, 0.41902E+00, 0.42050E+00, 0.42198E+00,
- & 0.42345E+00, 0.42492E+00, 0.42639E+00, 0.42785E+00, 0.42932E+00,
- & 0.43078E+00, 0.43224E+00, 0.43370E+00, 0.43516E+00, 0.43661E+00,
- & 0.43807E+00, 0.43952E+00, 0.44097E+00, 0.44241E+00, 0.44386E+00,
- & 0.44530E+00, 0.44674E+00, 0.44818E+00, 0.44962E+00, 0.45105E+00/
-
- DATA (BNC01M(I),I=401,500)/
- & 0.45249E+00, 0.45392E+00, 0.45535E+00, 0.45677E+00, 0.45820E+00,
- & 0.45962E+00, 0.46105E+00, 0.46247E+00, 0.46388E+00, 0.46530E+00,
- & 0.46671E+00, 0.46813E+00, 0.46954E+00, 0.47094E+00, 0.47235E+00,
- & 0.47376E+00, 0.47516E+00, 0.47656E+00, 0.47796E+00, 0.47936E+00,
- & 0.48075E+00, 0.48215E+00, 0.48354E+00, 0.48493E+00, 0.48632E+00,
- & 0.48770E+00, 0.48909E+00, 0.49047E+00, 0.49185E+00, 0.49323E+00,
- & 0.49461E+00, 0.49598E+00, 0.49735E+00, 0.49873E+00, 0.50010E+00,
- & 0.50146E+00, 0.50283E+00, 0.50420E+00, 0.50556E+00, 0.50692E+00,
- & 0.50828E+00, 0.50964E+00, 0.51099E+00, 0.51235E+00, 0.51370E+00,
- & 0.51505E+00, 0.51640E+00, 0.51774E+00, 0.51909E+00, 0.52043E+00,
- & 0.52178E+00, 0.52312E+00, 0.52445E+00, 0.52579E+00, 0.52713E+00,
- & 0.52846E+00, 0.52979E+00, 0.53112E+00, 0.53245E+00, 0.53377E+00,
- & 0.53510E+00, 0.53642E+00, 0.53774E+00, 0.53906E+00, 0.54038E+00,
- & 0.54170E+00, 0.54301E+00, 0.54433E+00, 0.54564E+00, 0.54695E+00,
- & 0.54825E+00, 0.54956E+00, 0.55086E+00, 0.55217E+00, 0.55347E+00,
- & 0.55477E+00, 0.55607E+00, 0.55736E+00, 0.55866E+00, 0.55995E+00,
- & 0.56124E+00, 0.56253E+00, 0.56382E+00, 0.56511E+00, 0.56639E+00,
- & 0.56768E+00, 0.56896E+00, 0.57024E+00, 0.57152E+00, 0.57280E+00,
- & 0.57407E+00, 0.57534E+00, 0.57662E+00, 0.57789E+00, 0.57916E+00,
- & 0.58043E+00, 0.58169E+00, 0.58296E+00, 0.58422E+00, 0.58548E+00/
-
- DATA (BNC01M(I),I=501,600)/
- & 0.58674E+00, 0.58800E+00, 0.58926E+00, 0.59051E+00, 0.59176E+00,
- & 0.59302E+00, 0.59427E+00, 0.59552E+00, 0.59676E+00, 0.59801E+00,
- & 0.59925E+00, 0.60050E+00, 0.60174E+00, 0.60298E+00, 0.60422E+00,
- & 0.60545E+00, 0.60669E+00, 0.60792E+00, 0.60916E+00, 0.61039E+00,
- & 0.61162E+00, 0.61285E+00, 0.61407E+00, 0.61530E+00, 0.61652E+00,
- & 0.61774E+00, 0.61896E+00, 0.62018E+00, 0.62140E+00, 0.62262E+00,
- & 0.62383E+00, 0.62505E+00, 0.62626E+00, 0.62747E+00, 0.62868E+00,
- & 0.62989E+00, 0.63109E+00, 0.63230E+00, 0.63350E+00, 0.63470E+00,
- & 0.63590E+00, 0.63710E+00, 0.63830E+00, 0.63950E+00, 0.64069E+00,
- & 0.64188E+00, 0.64308E+00, 0.64427E+00, 0.64546E+00, 0.64664E+00,
- & 0.64783E+00, 0.64902E+00, 0.65020E+00, 0.65138E+00, 0.65256E+00,
- & 0.65374E+00, 0.65492E+00, 0.65610E+00, 0.65727E+00, 0.65845E+00,
- & 0.65962E+00, 0.66079E+00, 0.66196E+00, 0.66313E+00, 0.66430E+00,
- & 0.66546E+00, 0.66663E+00, 0.66779E+00, 0.66895E+00, 0.67011E+00,
- & 0.67127E+00, 0.67243E+00, 0.67359E+00, 0.67474E+00, 0.67590E+00,
- & 0.67705E+00, 0.67820E+00, 0.67935E+00, 0.68050E+00, 0.68165E+00,
- & 0.68279E+00, 0.68394E+00, 0.68508E+00, 0.68622E+00, 0.68736E+00,
- & 0.68850E+00, 0.68964E+00, 0.69078E+00, 0.69191E+00, 0.69305E+00,
- & 0.69418E+00, 0.69531E+00, 0.69644E+00, 0.69757E+00, 0.69870E+00,
- & 0.69983E+00, 0.70095E+00, 0.70208E+00, 0.70320E+00, 0.70432E+00/
-
- DATA (BNC01M(I),I=601,700)/
- & 0.71636E+00, 0.72738E+00, 0.73828E+00, 0.74906E+00, 0.75972E+00,
- & 0.77027E+00, 0.78071E+00, 0.79105E+00, 0.80127E+00, 0.81139E+00,
- & 0.82141E+00, 0.83133E+00, 0.84115E+00, 0.85087E+00, 0.86050E+00,
- & 0.87004E+00, 0.87948E+00, 0.88883E+00, 0.89810E+00, 0.90728E+00,
- & 0.91638E+00, 0.92539E+00, 0.93432E+00, 0.94316E+00, 0.95193E+00,
- & 0.96063E+00, 0.96924E+00, 0.97778E+00, 0.98625E+00, 0.99464E+00,
- & 0.10030E+01, 0.10112E+01, 0.10194E+01, 0.10275E+01, 0.10356E+01,
- & 0.10435E+01, 0.10515E+01, 0.10593E+01, 0.10671E+01, 0.10748E+01,
- & 0.10825E+01, 0.10901E+01, 0.10977E+01, 0.11051E+01, 0.11126E+01,
- & 0.11200E+01, 0.11273E+01, 0.11345E+01, 0.11418E+01, 0.11489E+01,
- & 0.11560E+01, 0.11631E+01, 0.11701E+01, 0.11770E+01, 0.11839E+01,
- & 0.11908E+01, 0.11976E+01, 0.12044E+01, 0.12111E+01, 0.12177E+01,
- & 0.12244E+01, 0.12309E+01, 0.12375E+01, 0.12440E+01, 0.12504E+01,
- & 0.12568E+01, 0.12632E+01, 0.12695E+01, 0.12758E+01, 0.12820E+01,
- & 0.12882E+01, 0.12943E+01, 0.13005E+01, 0.13065E+01, 0.13126E+01,
- & 0.13186E+01, 0.13246E+01, 0.13305E+01, 0.13364E+01, 0.13422E+01,
- & 0.13481E+01, 0.13539E+01, 0.13596E+01, 0.13653E+01, 0.13710E+01,
- & 0.13767E+01, 0.13823E+01, 0.13879E+01, 0.13934E+01, 0.13990E+01,
- & 0.14044E+01, 0.14099E+01, 0.14153E+01, 0.14207E+01, 0.14261E+01,
- & 0.14314E+01, 0.14368E+01, 0.14420E+01, 0.14473E+01, 0.14525E+01/
-
- DATA (BNC01M(I),I=701,741)/
- & 0.14577E+01, 0.14629E+01, 0.14680E+01, 0.14731E+01, 0.14782E+01,
- & 0.14833E+01, 0.14883E+01, 0.14933E+01, 0.14983E+01, 0.15033E+01,
- & 0.15082E+01, 0.15131E+01, 0.15180E+01, 0.15228E+01, 0.15277E+01,
- & 0.15325E+01, 0.15372E+01, 0.15420E+01, 0.15467E+01, 0.15515E+01,
- & 0.15561E+01, 0.15608E+01, 0.15655E+01, 0.15701E+01, 0.15747E+01,
- & 0.15793E+01, 0.15838E+01, 0.15884E+01, 0.15929E+01, 0.15974E+01,
- & 0.16018E+01, 0.16063E+01, 0.16107E+01, 0.16151E+01, 0.16195E+01,
- & 0.16239E+01, 0.16282E+01, 0.16326E+01, 0.16369E+01, 0.16412E+01,
- & 0.16454E+01
- & /
-C
-C *** Na2SO4
-C
- DATA (BNC02M(I),I=1,100)/
- &-0.93069E-01,-0.20213E+00,-0.25643E+00,-0.29470E+00,-0.32465E+00,
- &-0.34938E+00,-0.37051E+00,-0.38898E+00,-0.40540E+00,-0.42018E+00,
- &-0.43364E+00,-0.44599E+00,-0.45740E+00,-0.46801E+00,-0.47792E+00,
- &-0.48722E+00,-0.49598E+00,-0.50426E+00,-0.51211E+00,-0.51957E+00,
- &-0.52668E+00,-0.53347E+00,-0.53997E+00,-0.54620E+00,-0.55218E+00,
- &-0.55793E+00,-0.56347E+00,-0.56881E+00,-0.57397E+00,-0.57896E+00,
- &-0.58378E+00,-0.58845E+00,-0.59298E+00,-0.59738E+00,-0.60165E+00,
- &-0.60580E+00,-0.60983E+00,-0.61376E+00,-0.61759E+00,-0.62131E+00,
- &-0.62495E+00,-0.62849E+00,-0.63195E+00,-0.63533E+00,-0.63864E+00,
- &-0.64187E+00,-0.64502E+00,-0.64811E+00,-0.65114E+00,-0.65410E+00,
- &-0.65700E+00,-0.65984E+00,-0.66263E+00,-0.66536E+00,-0.66804E+00,
- &-0.67068E+00,-0.67326E+00,-0.67580E+00,-0.67829E+00,-0.68074E+00,
- &-0.68314E+00,-0.68551E+00,-0.68784E+00,-0.69013E+00,-0.69239E+00,
- &-0.69461E+00,-0.69679E+00,-0.69894E+00,-0.70107E+00,-0.70316E+00,
- &-0.70522E+00,-0.70725E+00,-0.70925E+00,-0.71123E+00,-0.71318E+00,
- &-0.71511E+00,-0.71701E+00,-0.71889E+00,-0.72075E+00,-0.72258E+00,
- &-0.72439E+00,-0.72618E+00,-0.72795E+00,-0.72970E+00,-0.73143E+00,
- &-0.73315E+00,-0.73484E+00,-0.73652E+00,-0.73818E+00,-0.73982E+00,
- &-0.74145E+00,-0.74306E+00,-0.74465E+00,-0.74623E+00,-0.74780E+00,
- &-0.74935E+00,-0.75088E+00,-0.75241E+00,-0.75392E+00,-0.75541E+00/
-
- DATA (BNC02M(I),I=101,200)/
- &-0.75689E+00,-0.75836E+00,-0.75982E+00,-0.76126E+00,-0.76269E+00,
- &-0.76411E+00,-0.76552E+00,-0.76692E+00,-0.76830E+00,-0.76968E+00,
- &-0.77104E+00,-0.77239E+00,-0.77373E+00,-0.77506E+00,-0.77638E+00,
- &-0.77769E+00,-0.77899E+00,-0.78028E+00,-0.78155E+00,-0.78282E+00,
- &-0.78408E+00,-0.78533E+00,-0.78657E+00,-0.78780E+00,-0.78902E+00,
- &-0.79024E+00,-0.79144E+00,-0.79263E+00,-0.79382E+00,-0.79500E+00,
- &-0.79616E+00,-0.79732E+00,-0.79848E+00,-0.79962E+00,-0.80076E+00,
- &-0.80188E+00,-0.80300E+00,-0.80411E+00,-0.80522E+00,-0.80631E+00,
- &-0.80740E+00,-0.80848E+00,-0.80956E+00,-0.81063E+00,-0.81169E+00,
- &-0.81274E+00,-0.81379E+00,-0.81482E+00,-0.81586E+00,-0.81688E+00,
- &-0.81790E+00,-0.81891E+00,-0.81992E+00,-0.82092E+00,-0.82191E+00,
- &-0.82290E+00,-0.82388E+00,-0.82486E+00,-0.82583E+00,-0.82679E+00,
- &-0.82775E+00,-0.82870E+00,-0.82965E+00,-0.83059E+00,-0.83152E+00,
- &-0.83245E+00,-0.83338E+00,-0.83429E+00,-0.83521E+00,-0.83612E+00,
- &-0.83702E+00,-0.83792E+00,-0.83881E+00,-0.83970E+00,-0.84058E+00,
- &-0.84146E+00,-0.84233E+00,-0.84320E+00,-0.84407E+00,-0.84492E+00,
- &-0.84578E+00,-0.84663E+00,-0.84747E+00,-0.84832E+00,-0.84915E+00,
- &-0.84998E+00,-0.85081E+00,-0.85164E+00,-0.85245E+00,-0.85327E+00,
- &-0.85408E+00,-0.85489E+00,-0.85569E+00,-0.85649E+00,-0.85728E+00,
- &-0.85807E+00,-0.85886E+00,-0.85964E+00,-0.86042E+00,-0.86120E+00/
-
- DATA (BNC02M(I),I=201,300)/
- &-0.86197E+00,-0.86274E+00,-0.86350E+00,-0.86426E+00,-0.86502E+00,
- &-0.86577E+00,-0.86652E+00,-0.86727E+00,-0.86801E+00,-0.86875E+00,
- &-0.86949E+00,-0.87022E+00,-0.87095E+00,-0.87167E+00,-0.87240E+00,
- &-0.87312E+00,-0.87383E+00,-0.87454E+00,-0.87525E+00,-0.87596E+00,
- &-0.87666E+00,-0.87736E+00,-0.87806E+00,-0.87875E+00,-0.87945E+00,
- &-0.88013E+00,-0.88082E+00,-0.88150E+00,-0.88218E+00,-0.88286E+00,
- &-0.88353E+00,-0.88420E+00,-0.88487E+00,-0.88553E+00,-0.88620E+00,
- &-0.88686E+00,-0.88751E+00,-0.88817E+00,-0.88882E+00,-0.88947E+00,
- &-0.89011E+00,-0.89076E+00,-0.89140E+00,-0.89203E+00,-0.89267E+00,
- &-0.89330E+00,-0.89393E+00,-0.89456E+00,-0.89519E+00,-0.89581E+00,
- &-0.89643E+00,-0.89705E+00,-0.89767E+00,-0.89828E+00,-0.89889E+00,
- &-0.89950E+00,-0.90011E+00,-0.90071E+00,-0.90131E+00,-0.90191E+00,
- &-0.90251E+00,-0.90310E+00,-0.90370E+00,-0.90429E+00,-0.90488E+00,
- &-0.90546E+00,-0.90605E+00,-0.90663E+00,-0.90721E+00,-0.90779E+00,
- &-0.90836E+00,-0.90894E+00,-0.90951E+00,-0.91008E+00,-0.91064E+00,
- &-0.91121E+00,-0.91177E+00,-0.91233E+00,-0.91289E+00,-0.91345E+00,
- &-0.91401E+00,-0.91456E+00,-0.91511E+00,-0.91566E+00,-0.91621E+00,
- &-0.91675E+00,-0.91730E+00,-0.91784E+00,-0.91838E+00,-0.91892E+00,
- &-0.91946E+00,-0.91999E+00,-0.92052E+00,-0.92105E+00,-0.92158E+00,
- &-0.92211E+00,-0.92264E+00,-0.92316E+00,-0.92368E+00,-0.92420E+00/
-
- DATA (BNC02M(I),I=301,400)/
- &-0.92472E+00,-0.92524E+00,-0.92576E+00,-0.92627E+00,-0.92678E+00,
- &-0.92729E+00,-0.92780E+00,-0.92831E+00,-0.92881E+00,-0.92932E+00,
- &-0.92982E+00,-0.93032E+00,-0.93082E+00,-0.93132E+00,-0.93181E+00,
- &-0.93231E+00,-0.93280E+00,-0.93329E+00,-0.93378E+00,-0.93427E+00,
- &-0.93476E+00,-0.93524E+00,-0.93573E+00,-0.93621E+00,-0.93669E+00,
- &-0.93717E+00,-0.93765E+00,-0.93812E+00,-0.93860E+00,-0.93907E+00,
- &-0.93954E+00,-0.94002E+00,-0.94048E+00,-0.94095E+00,-0.94142E+00,
- &-0.94188E+00,-0.94235E+00,-0.94281E+00,-0.94327E+00,-0.94373E+00,
- &-0.94419E+00,-0.94465E+00,-0.94510E+00,-0.94556E+00,-0.94601E+00,
- &-0.94646E+00,-0.94691E+00,-0.94736E+00,-0.94781E+00,-0.94826E+00,
- &-0.94870E+00,-0.94915E+00,-0.94959E+00,-0.95003E+00,-0.95047E+00,
- &-0.95091E+00,-0.95135E+00,-0.95178E+00,-0.95222E+00,-0.95265E+00,
- &-0.95309E+00,-0.95352E+00,-0.95395E+00,-0.95438E+00,-0.95481E+00,
- &-0.95523E+00,-0.95566E+00,-0.95608E+00,-0.95651E+00,-0.95693E+00,
- &-0.95735E+00,-0.95777E+00,-0.95819E+00,-0.95861E+00,-0.95903E+00,
- &-0.95944E+00,-0.95986E+00,-0.96027E+00,-0.96068E+00,-0.96109E+00,
- &-0.96150E+00,-0.96191E+00,-0.96232E+00,-0.96273E+00,-0.96313E+00,
- &-0.96354E+00,-0.96394E+00,-0.96435E+00,-0.96475E+00,-0.96515E+00,
- &-0.96555E+00,-0.96595E+00,-0.96634E+00,-0.96674E+00,-0.96714E+00,
- &-0.96753E+00,-0.96793E+00,-0.96832E+00,-0.96871E+00,-0.96910E+00/
-
- DATA (BNC02M(I),I=401,500)/
- &-0.96949E+00,-0.96988E+00,-0.97027E+00,-0.97065E+00,-0.97104E+00,
- &-0.97142E+00,-0.97181E+00,-0.97219E+00,-0.97257E+00,-0.97295E+00,
- &-0.97333E+00,-0.97371E+00,-0.97409E+00,-0.97447E+00,-0.97484E+00,
- &-0.97522E+00,-0.97560E+00,-0.97597E+00,-0.97634E+00,-0.97671E+00,
- &-0.97708E+00,-0.97745E+00,-0.97782E+00,-0.97819E+00,-0.97856E+00,
- &-0.97893E+00,-0.97929E+00,-0.97966E+00,-0.98002E+00,-0.98038E+00,
- &-0.98075E+00,-0.98111E+00,-0.98147E+00,-0.98183E+00,-0.98219E+00,
- &-0.98255E+00,-0.98290E+00,-0.98326E+00,-0.98362E+00,-0.98397E+00,
- &-0.98432E+00,-0.98468E+00,-0.98503E+00,-0.98538E+00,-0.98573E+00,
- &-0.98608E+00,-0.98643E+00,-0.98678E+00,-0.98713E+00,-0.98747E+00,
- &-0.98782E+00,-0.98817E+00,-0.98851E+00,-0.98885E+00,-0.98920E+00,
- &-0.98954E+00,-0.98988E+00,-0.99022E+00,-0.99056E+00,-0.99090E+00,
- &-0.99124E+00,-0.99158E+00,-0.99191E+00,-0.99225E+00,-0.99259E+00,
- &-0.99292E+00,-0.99325E+00,-0.99359E+00,-0.99392E+00,-0.99425E+00,
- &-0.99458E+00,-0.99491E+00,-0.99524E+00,-0.99557E+00,-0.99590E+00,
- &-0.99623E+00,-0.99656E+00,-0.99688E+00,-0.99721E+00,-0.99753E+00,
- &-0.99786E+00,-0.99818E+00,-0.99850E+00,-0.99883E+00,-0.99915E+00,
- &-0.99947E+00,-0.99979E+00,-0.10001E+01,-0.10004E+01,-0.10007E+01,
- &-0.10011E+01,-0.10014E+01,-0.10017E+01,-0.10020E+01,-0.10023E+01,
- &-0.10026E+01,-0.10030E+01,-0.10033E+01,-0.10036E+01,-0.10039E+01/
-
- DATA (BNC02M(I),I=501,600)/
- &-0.10042E+01,-0.10045E+01,-0.10048E+01,-0.10051E+01,-0.10054E+01,
- &-0.10057E+01,-0.10061E+01,-0.10064E+01,-0.10067E+01,-0.10070E+01,
- &-0.10073E+01,-0.10076E+01,-0.10079E+01,-0.10082E+01,-0.10085E+01,
- &-0.10088E+01,-0.10091E+01,-0.10094E+01,-0.10097E+01,-0.10100E+01,
- &-0.10103E+01,-0.10106E+01,-0.10109E+01,-0.10112E+01,-0.10115E+01,
- &-0.10118E+01,-0.10121E+01,-0.10124E+01,-0.10127E+01,-0.10130E+01,
- &-0.10132E+01,-0.10135E+01,-0.10138E+01,-0.10141E+01,-0.10144E+01,
- &-0.10147E+01,-0.10150E+01,-0.10153E+01,-0.10156E+01,-0.10159E+01,
- &-0.10161E+01,-0.10164E+01,-0.10167E+01,-0.10170E+01,-0.10173E+01,
- &-0.10176E+01,-0.10179E+01,-0.10181E+01,-0.10184E+01,-0.10187E+01,
- &-0.10190E+01,-0.10193E+01,-0.10196E+01,-0.10198E+01,-0.10201E+01,
- &-0.10204E+01,-0.10207E+01,-0.10210E+01,-0.10212E+01,-0.10215E+01,
- &-0.10218E+01,-0.10221E+01,-0.10223E+01,-0.10226E+01,-0.10229E+01,
- &-0.10232E+01,-0.10234E+01,-0.10237E+01,-0.10240E+01,-0.10243E+01,
- &-0.10245E+01,-0.10248E+01,-0.10251E+01,-0.10253E+01,-0.10256E+01,
- &-0.10259E+01,-0.10261E+01,-0.10264E+01,-0.10267E+01,-0.10270E+01,
- &-0.10272E+01,-0.10275E+01,-0.10278E+01,-0.10280E+01,-0.10283E+01,
- &-0.10285E+01,-0.10288E+01,-0.10291E+01,-0.10293E+01,-0.10296E+01,
- &-0.10299E+01,-0.10301E+01,-0.10304E+01,-0.10307E+01,-0.10309E+01,
- &-0.10312E+01,-0.10314E+01,-0.10317E+01,-0.10319E+01,-0.10322E+01/
-
- DATA (BNC02M(I),I=601,700)/
- &-0.10350E+01,-0.10375E+01,-0.10400E+01,-0.10424E+01,-0.10448E+01,
- &-0.10471E+01,-0.10495E+01,-0.10517E+01,-0.10540E+01,-0.10562E+01,
- &-0.10584E+01,-0.10605E+01,-0.10627E+01,-0.10647E+01,-0.10668E+01,
- &-0.10688E+01,-0.10708E+01,-0.10728E+01,-0.10748E+01,-0.10767E+01,
- &-0.10786E+01,-0.10805E+01,-0.10823E+01,-0.10841E+01,-0.10860E+01,
- &-0.10877E+01,-0.10895E+01,-0.10912E+01,-0.10930E+01,-0.10947E+01,
- &-0.10963E+01,-0.10980E+01,-0.10996E+01,-0.11013E+01,-0.11029E+01,
- &-0.11044E+01,-0.11060E+01,-0.11076E+01,-0.11091E+01,-0.11106E+01,
- &-0.11121E+01,-0.11136E+01,-0.11151E+01,-0.11165E+01,-0.11180E+01,
- &-0.11194E+01,-0.11208E+01,-0.11222E+01,-0.11236E+01,-0.11250E+01,
- &-0.11263E+01,-0.11277E+01,-0.11290E+01,-0.11303E+01,-0.11316E+01,
- &-0.11329E+01,-0.11342E+01,-0.11355E+01,-0.11368E+01,-0.11380E+01,
- &-0.11392E+01,-0.11405E+01,-0.11417E+01,-0.11429E+01,-0.11441E+01,
- &-0.11453E+01,-0.11464E+01,-0.11476E+01,-0.11488E+01,-0.11499E+01,
- &-0.11510E+01,-0.11522E+01,-0.11533E+01,-0.11544E+01,-0.11555E+01,
- &-0.11566E+01,-0.11577E+01,-0.11587E+01,-0.11598E+01,-0.11609E+01,
- &-0.11619E+01,-0.11630E+01,-0.11640E+01,-0.11650E+01,-0.11660E+01,
- &-0.11670E+01,-0.11680E+01,-0.11690E+01,-0.11700E+01,-0.11710E+01,
- &-0.11720E+01,-0.11729E+01,-0.11739E+01,-0.11749E+01,-0.11758E+01,
- &-0.11767E+01,-0.11777E+01,-0.11786E+01,-0.11795E+01,-0.11804E+01/
-
- DATA (BNC02M(I),I=701,741)/
- &-0.11813E+01,-0.11822E+01,-0.11831E+01,-0.11840E+01,-0.11849E+01,
- &-0.11858E+01,-0.11867E+01,-0.11875E+01,-0.11884E+01,-0.11893E+01,
- &-0.11901E+01,-0.11909E+01,-0.11918E+01,-0.11926E+01,-0.11934E+01,
- &-0.11943E+01,-0.11951E+01,-0.11959E+01,-0.11967E+01,-0.11975E+01,
- &-0.11983E+01,-0.11991E+01,-0.11999E+01,-0.12007E+01,-0.12015E+01,
- &-0.12022E+01,-0.12030E+01,-0.12038E+01,-0.12045E+01,-0.12053E+01,
- &-0.12060E+01,-0.12068E+01,-0.12075E+01,-0.12083E+01,-0.12090E+01,
- &-0.12097E+01,-0.12105E+01,-0.12112E+01,-0.12119E+01,-0.12126E+01,
- &-0.12133E+01
- & /
-C
-C *** NaNO3
-C
- DATA (BNC03M(I),I=1,100)/
- &-0.46649E-01,-0.10169E+00,-0.12931E+00,-0.14890E+00,-0.16430E+00,
- &-0.17709E+00,-0.18807E+00,-0.19770E+00,-0.20631E+00,-0.21409E+00,
- &-0.22120E+00,-0.22775E+00,-0.23383E+00,-0.23950E+00,-0.24481E+00,
- &-0.24982E+00,-0.25456E+00,-0.25905E+00,-0.26332E+00,-0.26739E+00,
- &-0.27128E+00,-0.27501E+00,-0.27859E+00,-0.28204E+00,-0.28535E+00,
- &-0.28855E+00,-0.29164E+00,-0.29462E+00,-0.29751E+00,-0.30031E+00,
- &-0.30303E+00,-0.30567E+00,-0.30823E+00,-0.31072E+00,-0.31315E+00,
- &-0.31551E+00,-0.31782E+00,-0.32006E+00,-0.32225E+00,-0.32439E+00,
- &-0.32649E+00,-0.32853E+00,-0.33053E+00,-0.33248E+00,-0.33439E+00,
- &-0.33627E+00,-0.33810E+00,-0.33990E+00,-0.34166E+00,-0.34339E+00,
- &-0.34509E+00,-0.34675E+00,-0.34839E+00,-0.34999E+00,-0.35157E+00,
- &-0.35312E+00,-0.35464E+00,-0.35614E+00,-0.35761E+00,-0.35906E+00,
- &-0.36049E+00,-0.36190E+00,-0.36328E+00,-0.36464E+00,-0.36599E+00,
- &-0.36731E+00,-0.36862E+00,-0.36991E+00,-0.37118E+00,-0.37244E+00,
- &-0.37368E+00,-0.37491E+00,-0.37612E+00,-0.37731E+00,-0.37849E+00,
- &-0.37966E+00,-0.38082E+00,-0.38197E+00,-0.38310E+00,-0.38422E+00,
- &-0.38533E+00,-0.38643E+00,-0.38752E+00,-0.38860E+00,-0.38966E+00,
- &-0.39072E+00,-0.39177E+00,-0.39282E+00,-0.39385E+00,-0.39487E+00,
- &-0.39589E+00,-0.39690E+00,-0.39790E+00,-0.39889E+00,-0.39988E+00,
- &-0.40086E+00,-0.40183E+00,-0.40279E+00,-0.40375E+00,-0.40470E+00/
-
- DATA (BNC03M(I),I=101,200)/
- &-0.40564E+00,-0.40658E+00,-0.40751E+00,-0.40844E+00,-0.40936E+00,
- &-0.41027E+00,-0.41117E+00,-0.41208E+00,-0.41297E+00,-0.41386E+00,
- &-0.41474E+00,-0.41562E+00,-0.41649E+00,-0.41736E+00,-0.41822E+00,
- &-0.41907E+00,-0.41992E+00,-0.42076E+00,-0.42160E+00,-0.42243E+00,
- &-0.42326E+00,-0.42408E+00,-0.42490E+00,-0.42571E+00,-0.42652E+00,
- &-0.42732E+00,-0.42812E+00,-0.42891E+00,-0.42970E+00,-0.43048E+00,
- &-0.43126E+00,-0.43203E+00,-0.43280E+00,-0.43356E+00,-0.43432E+00,
- &-0.43507E+00,-0.43582E+00,-0.43656E+00,-0.43730E+00,-0.43804E+00,
- &-0.43877E+00,-0.43950E+00,-0.44022E+00,-0.44094E+00,-0.44165E+00,
- &-0.44236E+00,-0.44307E+00,-0.44377E+00,-0.44447E+00,-0.44516E+00,
- &-0.44585E+00,-0.44654E+00,-0.44722E+00,-0.44790E+00,-0.44858E+00,
- &-0.44925E+00,-0.44992E+00,-0.45058E+00,-0.45124E+00,-0.45190E+00,
- &-0.45255E+00,-0.45320E+00,-0.45385E+00,-0.45450E+00,-0.45514E+00,
- &-0.45577E+00,-0.45641E+00,-0.45704E+00,-0.45766E+00,-0.45829E+00,
- &-0.45891E+00,-0.45953E+00,-0.46014E+00,-0.46075E+00,-0.46136E+00,
- &-0.46197E+00,-0.46257E+00,-0.46317E+00,-0.46377E+00,-0.46436E+00,
- &-0.46496E+00,-0.46555E+00,-0.46613E+00,-0.46671E+00,-0.46730E+00,
- &-0.46787E+00,-0.46845E+00,-0.46902E+00,-0.46959E+00,-0.47016E+00,
- &-0.47072E+00,-0.47129E+00,-0.47185E+00,-0.47240E+00,-0.47296E+00,
- &-0.47351E+00,-0.47406E+00,-0.47461E+00,-0.47515E+00,-0.47570E+00/
-
- DATA (BNC03M(I),I=201,300)/
- &-0.47624E+00,-0.47678E+00,-0.47731E+00,-0.47785E+00,-0.47838E+00,
- &-0.47891E+00,-0.47943E+00,-0.47996E+00,-0.48048E+00,-0.48100E+00,
- &-0.48152E+00,-0.48204E+00,-0.48255E+00,-0.48306E+00,-0.48357E+00,
- &-0.48408E+00,-0.48459E+00,-0.48509E+00,-0.48559E+00,-0.48609E+00,
- &-0.48659E+00,-0.48709E+00,-0.48758E+00,-0.48807E+00,-0.48856E+00,
- &-0.48905E+00,-0.48954E+00,-0.49002E+00,-0.49051E+00,-0.49099E+00,
- &-0.49147E+00,-0.49194E+00,-0.49242E+00,-0.49289E+00,-0.49336E+00,
- &-0.49383E+00,-0.49430E+00,-0.49477E+00,-0.49523E+00,-0.49570E+00,
- &-0.49616E+00,-0.49662E+00,-0.49708E+00,-0.49753E+00,-0.49799E+00,
- &-0.49844E+00,-0.49889E+00,-0.49934E+00,-0.49979E+00,-0.50024E+00,
- &-0.50068E+00,-0.50113E+00,-0.50157E+00,-0.50201E+00,-0.50245E+00,
- &-0.50289E+00,-0.50332E+00,-0.50376E+00,-0.50419E+00,-0.50462E+00,
- &-0.50505E+00,-0.50548E+00,-0.50591E+00,-0.50634E+00,-0.50676E+00,
- &-0.50718E+00,-0.50760E+00,-0.50803E+00,-0.50844E+00,-0.50886E+00,
- &-0.50928E+00,-0.50969E+00,-0.51011E+00,-0.51052E+00,-0.51093E+00,
- &-0.51134E+00,-0.51175E+00,-0.51215E+00,-0.51256E+00,-0.51296E+00,
- &-0.51336E+00,-0.51377E+00,-0.51417E+00,-0.51457E+00,-0.51496E+00,
- &-0.51536E+00,-0.51576E+00,-0.51615E+00,-0.51654E+00,-0.51693E+00,
- &-0.51732E+00,-0.51771E+00,-0.51810E+00,-0.51849E+00,-0.51887E+00,
- &-0.51926E+00,-0.51964E+00,-0.52002E+00,-0.52040E+00,-0.52078E+00/
-
- DATA (BNC03M(I),I=301,400)/
- &-0.52116E+00,-0.52154E+00,-0.52192E+00,-0.52229E+00,-0.52267E+00,
- &-0.52304E+00,-0.52341E+00,-0.52378E+00,-0.52415E+00,-0.52452E+00,
- &-0.52489E+00,-0.52526E+00,-0.52562E+00,-0.52599E+00,-0.52635E+00,
- &-0.52671E+00,-0.52707E+00,-0.52743E+00,-0.52779E+00,-0.52815E+00,
- &-0.52851E+00,-0.52886E+00,-0.52922E+00,-0.52957E+00,-0.52993E+00,
- &-0.53028E+00,-0.53063E+00,-0.53098E+00,-0.53133E+00,-0.53168E+00,
- &-0.53203E+00,-0.53237E+00,-0.53272E+00,-0.53306E+00,-0.53341E+00,
- &-0.53375E+00,-0.53409E+00,-0.53443E+00,-0.53477E+00,-0.53511E+00,
- &-0.53545E+00,-0.53579E+00,-0.53612E+00,-0.53646E+00,-0.53679E+00,
- &-0.53713E+00,-0.53746E+00,-0.53779E+00,-0.53812E+00,-0.53845E+00,
- &-0.53878E+00,-0.53911E+00,-0.53944E+00,-0.53976E+00,-0.54009E+00,
- &-0.54041E+00,-0.54074E+00,-0.54106E+00,-0.54138E+00,-0.54170E+00,
- &-0.54203E+00,-0.54235E+00,-0.54266E+00,-0.54298E+00,-0.54330E+00,
- &-0.54362E+00,-0.54393E+00,-0.54425E+00,-0.54456E+00,-0.54488E+00,
- &-0.54519E+00,-0.54550E+00,-0.54581E+00,-0.54612E+00,-0.54643E+00,
- &-0.54674E+00,-0.54705E+00,-0.54736E+00,-0.54766E+00,-0.54797E+00,
- &-0.54827E+00,-0.54858E+00,-0.54888E+00,-0.54919E+00,-0.54949E+00,
- &-0.54979E+00,-0.55009E+00,-0.55039E+00,-0.55069E+00,-0.55099E+00,
- &-0.55129E+00,-0.55158E+00,-0.55188E+00,-0.55218E+00,-0.55247E+00,
- &-0.55277E+00,-0.55306E+00,-0.55335E+00,-0.55364E+00,-0.55394E+00/
-
- DATA (BNC03M(I),I=401,500)/
- &-0.55423E+00,-0.55452E+00,-0.55481E+00,-0.55510E+00,-0.55538E+00,
- &-0.55567E+00,-0.55596E+00,-0.55624E+00,-0.55653E+00,-0.55681E+00,
- &-0.55710E+00,-0.55738E+00,-0.55767E+00,-0.55795E+00,-0.55823E+00,
- &-0.55851E+00,-0.55879E+00,-0.55907E+00,-0.55935E+00,-0.55963E+00,
- &-0.55991E+00,-0.56018E+00,-0.56046E+00,-0.56074E+00,-0.56101E+00,
- &-0.56129E+00,-0.56156E+00,-0.56184E+00,-0.56211E+00,-0.56238E+00,
- &-0.56265E+00,-0.56292E+00,-0.56319E+00,-0.56346E+00,-0.56373E+00,
- &-0.56400E+00,-0.56427E+00,-0.56454E+00,-0.56481E+00,-0.56507E+00,
- &-0.56534E+00,-0.56560E+00,-0.56587E+00,-0.56613E+00,-0.56640E+00,
- &-0.56666E+00,-0.56692E+00,-0.56718E+00,-0.56745E+00,-0.56771E+00,
- &-0.56797E+00,-0.56823E+00,-0.56849E+00,-0.56875E+00,-0.56900E+00,
- &-0.56926E+00,-0.56952E+00,-0.56977E+00,-0.57003E+00,-0.57029E+00,
- &-0.57054E+00,-0.57080E+00,-0.57105E+00,-0.57130E+00,-0.57156E+00,
- &-0.57181E+00,-0.57206E+00,-0.57231E+00,-0.57256E+00,-0.57281E+00,
- &-0.57306E+00,-0.57331E+00,-0.57356E+00,-0.57381E+00,-0.57406E+00,
- &-0.57430E+00,-0.57455E+00,-0.57480E+00,-0.57504E+00,-0.57529E+00,
- &-0.57553E+00,-0.57578E+00,-0.57602E+00,-0.57626E+00,-0.57651E+00,
- &-0.57675E+00,-0.57699E+00,-0.57723E+00,-0.57747E+00,-0.57771E+00,
- &-0.57795E+00,-0.57819E+00,-0.57843E+00,-0.57867E+00,-0.57891E+00,
- &-0.57915E+00,-0.57939E+00,-0.57962E+00,-0.57986E+00,-0.58009E+00/
-
- DATA (BNC03M(I),I=501,600)/
- &-0.58033E+00,-0.58056E+00,-0.58080E+00,-0.58103E+00,-0.58127E+00,
- &-0.58150E+00,-0.58173E+00,-0.58196E+00,-0.58220E+00,-0.58243E+00,
- &-0.58266E+00,-0.58289E+00,-0.58312E+00,-0.58335E+00,-0.58358E+00,
- &-0.58381E+00,-0.58404E+00,-0.58426E+00,-0.58449E+00,-0.58472E+00,
- &-0.58494E+00,-0.58517E+00,-0.58540E+00,-0.58562E+00,-0.58585E+00,
- &-0.58607E+00,-0.58630E+00,-0.58652E+00,-0.58674E+00,-0.58697E+00,
- &-0.58719E+00,-0.58741E+00,-0.58763E+00,-0.58785E+00,-0.58807E+00,
- &-0.58829E+00,-0.58851E+00,-0.58873E+00,-0.58895E+00,-0.58917E+00,
- &-0.58939E+00,-0.58961E+00,-0.58983E+00,-0.59004E+00,-0.59026E+00,
- &-0.59048E+00,-0.59069E+00,-0.59091E+00,-0.59113E+00,-0.59134E+00,
- &-0.59155E+00,-0.59177E+00,-0.59198E+00,-0.59220E+00,-0.59241E+00,
- &-0.59262E+00,-0.59283E+00,-0.59305E+00,-0.59326E+00,-0.59347E+00,
- &-0.59368E+00,-0.59389E+00,-0.59410E+00,-0.59431E+00,-0.59452E+00,
- &-0.59473E+00,-0.59494E+00,-0.59515E+00,-0.59535E+00,-0.59556E+00,
- &-0.59577E+00,-0.59598E+00,-0.59618E+00,-0.59639E+00,-0.59659E+00,
- &-0.59680E+00,-0.59701E+00,-0.59721E+00,-0.59741E+00,-0.59762E+00,
- &-0.59782E+00,-0.59803E+00,-0.59823E+00,-0.59843E+00,-0.59863E+00,
- &-0.59884E+00,-0.59904E+00,-0.59924E+00,-0.59944E+00,-0.59964E+00,
- &-0.59984E+00,-0.60004E+00,-0.60024E+00,-0.60044E+00,-0.60064E+00,
- &-0.60084E+00,-0.60104E+00,-0.60123E+00,-0.60143E+00,-0.60163E+00/
-
- DATA (BNC03M(I),I=601,700)/
- &-0.60374E+00,-0.60566E+00,-0.60755E+00,-0.60942E+00,-0.61125E+00,
- &-0.61305E+00,-0.61483E+00,-0.61658E+00,-0.61831E+00,-0.62001E+00,
- &-0.62169E+00,-0.62334E+00,-0.62497E+00,-0.62658E+00,-0.62816E+00,
- &-0.62973E+00,-0.63127E+00,-0.63279E+00,-0.63429E+00,-0.63578E+00,
- &-0.63724E+00,-0.63869E+00,-0.64012E+00,-0.64153E+00,-0.64292E+00,
- &-0.64430E+00,-0.64566E+00,-0.64700E+00,-0.64833E+00,-0.64964E+00,
- &-0.65094E+00,-0.65222E+00,-0.65349E+00,-0.65475E+00,-0.65599E+00,
- &-0.65721E+00,-0.65843E+00,-0.65963E+00,-0.66082E+00,-0.66199E+00,
- &-0.66315E+00,-0.66431E+00,-0.66544E+00,-0.66657E+00,-0.66769E+00,
- &-0.66879E+00,-0.66989E+00,-0.67097E+00,-0.67204E+00,-0.67310E+00,
- &-0.67415E+00,-0.67520E+00,-0.67623E+00,-0.67725E+00,-0.67826E+00,
- &-0.67927E+00,-0.68026E+00,-0.68124E+00,-0.68222E+00,-0.68319E+00,
- &-0.68415E+00,-0.68510E+00,-0.68604E+00,-0.68697E+00,-0.68790E+00,
- &-0.68881E+00,-0.68972E+00,-0.69062E+00,-0.69152E+00,-0.69241E+00,
- &-0.69329E+00,-0.69416E+00,-0.69502E+00,-0.69588E+00,-0.69673E+00,
- &-0.69758E+00,-0.69841E+00,-0.69924E+00,-0.70007E+00,-0.70089E+00,
- &-0.70170E+00,-0.70250E+00,-0.70330E+00,-0.70410E+00,-0.70488E+00,
- &-0.70566E+00,-0.70644E+00,-0.70721E+00,-0.70797E+00,-0.70873E+00,
- &-0.70948E+00,-0.71023E+00,-0.71097E+00,-0.71171E+00,-0.71244E+00,
- &-0.71317E+00,-0.71389E+00,-0.71460E+00,-0.71531E+00,-0.71602E+00/
-
- DATA (BNC03M(I),I=701,741)/
- &-0.71672E+00,-0.71742E+00,-0.71811E+00,-0.71880E+00,-0.71948E+00,
- &-0.72016E+00,-0.72083E+00,-0.72150E+00,-0.72216E+00,-0.72282E+00,
- &-0.72348E+00,-0.72413E+00,-0.72478E+00,-0.72542E+00,-0.72606E+00,
- &-0.72670E+00,-0.72733E+00,-0.72795E+00,-0.72858E+00,-0.72920E+00,
- &-0.72981E+00,-0.73042E+00,-0.73103E+00,-0.73163E+00,-0.73223E+00,
- &-0.73283E+00,-0.73342E+00,-0.73401E+00,-0.73460E+00,-0.73518E+00,
- &-0.73576E+00,-0.73634E+00,-0.73691E+00,-0.73748E+00,-0.73805E+00,
- &-0.73861E+00,-0.73917E+00,-0.73972E+00,-0.74028E+00,-0.74083E+00,
- &-0.74137E+00
- & /
-C
-C *** (NH4)2SO4
-C
- DATA (BNC04M(I),I=1,100)/
- &-0.93137E-01,-0.20251E+00,-0.25708E+00,-0.29562E+00,-0.32582E+00,
- &-0.35081E+00,-0.37218E+00,-0.39089E+00,-0.40754E+00,-0.42256E+00,
- &-0.43624E+00,-0.44882E+00,-0.46045E+00,-0.47127E+00,-0.48140E+00,
- &-0.49091E+00,-0.49988E+00,-0.50837E+00,-0.51643E+00,-0.52409E+00,
- &-0.53140E+00,-0.53839E+00,-0.54509E+00,-0.55151E+00,-0.55769E+00,
- &-0.56363E+00,-0.56936E+00,-0.57489E+00,-0.58023E+00,-0.58540E+00,
- &-0.59041E+00,-0.59526E+00,-0.59997E+00,-0.60454E+00,-0.60898E+00,
- &-0.61330E+00,-0.61751E+00,-0.62160E+00,-0.62559E+00,-0.62949E+00,
- &-0.63328E+00,-0.63699E+00,-0.64061E+00,-0.64415E+00,-0.64761E+00,
- &-0.65099E+00,-0.65430E+00,-0.65754E+00,-0.66072E+00,-0.66383E+00,
- &-0.66687E+00,-0.66986E+00,-0.67279E+00,-0.67567E+00,-0.67849E+00,
- &-0.68126E+00,-0.68398E+00,-0.68666E+00,-0.68928E+00,-0.69187E+00,
- &-0.69441E+00,-0.69691E+00,-0.69937E+00,-0.70179E+00,-0.70418E+00,
- &-0.70653E+00,-0.70884E+00,-0.71112E+00,-0.71337E+00,-0.71558E+00,
- &-0.71777E+00,-0.71993E+00,-0.72206E+00,-0.72416E+00,-0.72624E+00,
- &-0.72829E+00,-0.73031E+00,-0.73231E+00,-0.73429E+00,-0.73625E+00,
- &-0.73818E+00,-0.74009E+00,-0.74199E+00,-0.74386E+00,-0.74571E+00,
- &-0.74755E+00,-0.74936E+00,-0.75116E+00,-0.75294E+00,-0.75471E+00,
- &-0.75646E+00,-0.75819E+00,-0.75990E+00,-0.76161E+00,-0.76329E+00,
- &-0.76497E+00,-0.76662E+00,-0.76827E+00,-0.76990E+00,-0.77152E+00/
-
- DATA (BNC04M(I),I=101,200)/
- &-0.77312E+00,-0.77471E+00,-0.77629E+00,-0.77786E+00,-0.77941E+00,
- &-0.78095E+00,-0.78248E+00,-0.78400E+00,-0.78550E+00,-0.78700E+00,
- &-0.78848E+00,-0.78996E+00,-0.79142E+00,-0.79287E+00,-0.79431E+00,
- &-0.79574E+00,-0.79716E+00,-0.79856E+00,-0.79996E+00,-0.80135E+00,
- &-0.80273E+00,-0.80410E+00,-0.80546E+00,-0.80681E+00,-0.80815E+00,
- &-0.80948E+00,-0.81080E+00,-0.81211E+00,-0.81341E+00,-0.81470E+00,
- &-0.81599E+00,-0.81726E+00,-0.81853E+00,-0.81979E+00,-0.82104E+00,
- &-0.82228E+00,-0.82352E+00,-0.82474E+00,-0.82596E+00,-0.82717E+00,
- &-0.82837E+00,-0.82956E+00,-0.83075E+00,-0.83193E+00,-0.83310E+00,
- &-0.83426E+00,-0.83542E+00,-0.83657E+00,-0.83771E+00,-0.83885E+00,
- &-0.83998E+00,-0.84110E+00,-0.84221E+00,-0.84332E+00,-0.84442E+00,
- &-0.84552E+00,-0.84661E+00,-0.84769E+00,-0.84876E+00,-0.84983E+00,
- &-0.85090E+00,-0.85195E+00,-0.85301E+00,-0.85405E+00,-0.85509E+00,
- &-0.85612E+00,-0.85715E+00,-0.85818E+00,-0.85919E+00,-0.86020E+00,
- &-0.86121E+00,-0.86221E+00,-0.86320E+00,-0.86419E+00,-0.86518E+00,
- &-0.86616E+00,-0.86713E+00,-0.86810E+00,-0.86907E+00,-0.87002E+00,
- &-0.87098E+00,-0.87193E+00,-0.87287E+00,-0.87381E+00,-0.87475E+00,
- &-0.87568E+00,-0.87660E+00,-0.87752E+00,-0.87844E+00,-0.87935E+00,
- &-0.88026E+00,-0.88116E+00,-0.88206E+00,-0.88296E+00,-0.88385E+00,
- &-0.88473E+00,-0.88562E+00,-0.88649E+00,-0.88737E+00,-0.88824E+00/
-
- DATA (BNC04M(I),I=201,300)/
- &-0.88910E+00,-0.88997E+00,-0.89082E+00,-0.89168E+00,-0.89253E+00,
- &-0.89337E+00,-0.89422E+00,-0.89505E+00,-0.89589E+00,-0.89672E+00,
- &-0.89755E+00,-0.89837E+00,-0.89919E+00,-0.90001E+00,-0.90082E+00,
- &-0.90163E+00,-0.90244E+00,-0.90324E+00,-0.90404E+00,-0.90483E+00,
- &-0.90563E+00,-0.90641E+00,-0.90720E+00,-0.90798E+00,-0.90876E+00,
- &-0.90954E+00,-0.91031E+00,-0.91108E+00,-0.91185E+00,-0.91261E+00,
- &-0.91337E+00,-0.91413E+00,-0.91488E+00,-0.91563E+00,-0.91638E+00,
- &-0.91713E+00,-0.91787E+00,-0.91861E+00,-0.91934E+00,-0.92008E+00,
- &-0.92081E+00,-0.92153E+00,-0.92226E+00,-0.92298E+00,-0.92370E+00,
- &-0.92442E+00,-0.92513E+00,-0.92584E+00,-0.92655E+00,-0.92726E+00,
- &-0.92796E+00,-0.92866E+00,-0.92936E+00,-0.93005E+00,-0.93075E+00,
- &-0.93144E+00,-0.93212E+00,-0.93281E+00,-0.93349E+00,-0.93417E+00,
- &-0.93485E+00,-0.93553E+00,-0.93620E+00,-0.93687E+00,-0.93754E+00,
- &-0.93820E+00,-0.93887E+00,-0.93953E+00,-0.94019E+00,-0.94084E+00,
- &-0.94150E+00,-0.94215E+00,-0.94280E+00,-0.94345E+00,-0.94409E+00,
- &-0.94473E+00,-0.94537E+00,-0.94601E+00,-0.94665E+00,-0.94728E+00,
- &-0.94792E+00,-0.94855E+00,-0.94917E+00,-0.94980E+00,-0.95042E+00,
- &-0.95104E+00,-0.95166E+00,-0.95228E+00,-0.95290E+00,-0.95351E+00,
- &-0.95412E+00,-0.95473E+00,-0.95534E+00,-0.95594E+00,-0.95655E+00,
- &-0.95715E+00,-0.95775E+00,-0.95835E+00,-0.95894E+00,-0.95954E+00/
-
- DATA (BNC04M(I),I=301,400)/
- &-0.96013E+00,-0.96072E+00,-0.96131E+00,-0.96189E+00,-0.96248E+00,
- &-0.96306E+00,-0.96364E+00,-0.96422E+00,-0.96480E+00,-0.96538E+00,
- &-0.96595E+00,-0.96652E+00,-0.96709E+00,-0.96766E+00,-0.96823E+00,
- &-0.96879E+00,-0.96936E+00,-0.96992E+00,-0.97048E+00,-0.97104E+00,
- &-0.97159E+00,-0.97215E+00,-0.97270E+00,-0.97325E+00,-0.97380E+00,
- &-0.97435E+00,-0.97490E+00,-0.97545E+00,-0.97599E+00,-0.97653E+00,
- &-0.97707E+00,-0.97761E+00,-0.97815E+00,-0.97869E+00,-0.97922E+00,
- &-0.97975E+00,-0.98028E+00,-0.98081E+00,-0.98134E+00,-0.98187E+00,
- &-0.98240E+00,-0.98292E+00,-0.98344E+00,-0.98396E+00,-0.98448E+00,
- &-0.98500E+00,-0.98552E+00,-0.98603E+00,-0.98655E+00,-0.98706E+00,
- &-0.98757E+00,-0.98808E+00,-0.98859E+00,-0.98909E+00,-0.98960E+00,
- &-0.99010E+00,-0.99061E+00,-0.99111E+00,-0.99161E+00,-0.99211E+00,
- &-0.99261E+00,-0.99310E+00,-0.99360E+00,-0.99409E+00,-0.99458E+00,
- &-0.99507E+00,-0.99556E+00,-0.99605E+00,-0.99654E+00,-0.99702E+00,
- &-0.99751E+00,-0.99799E+00,-0.99847E+00,-0.99895E+00,-0.99943E+00,
- &-0.99991E+00,-0.10004E+01,-0.10009E+01,-0.10013E+01,-0.10018E+01,
- &-0.10023E+01,-0.10028E+01,-0.10032E+01,-0.10037E+01,-0.10042E+01,
- &-0.10046E+01,-0.10051E+01,-0.10056E+01,-0.10060E+01,-0.10065E+01,
- &-0.10069E+01,-0.10074E+01,-0.10079E+01,-0.10083E+01,-0.10088E+01,
- &-0.10092E+01,-0.10097E+01,-0.10101E+01,-0.10106E+01,-0.10110E+01/
-
- DATA (BNC04M(I),I=401,500)/
- &-0.10115E+01,-0.10119E+01,-0.10124E+01,-0.10128E+01,-0.10133E+01,
- &-0.10137E+01,-0.10142E+01,-0.10146E+01,-0.10150E+01,-0.10155E+01,
- &-0.10159E+01,-0.10164E+01,-0.10168E+01,-0.10172E+01,-0.10177E+01,
- &-0.10181E+01,-0.10185E+01,-0.10190E+01,-0.10194E+01,-0.10198E+01,
- &-0.10202E+01,-0.10207E+01,-0.10211E+01,-0.10215E+01,-0.10219E+01,
- &-0.10224E+01,-0.10228E+01,-0.10232E+01,-0.10236E+01,-0.10241E+01,
- &-0.10245E+01,-0.10249E+01,-0.10253E+01,-0.10257E+01,-0.10261E+01,
- &-0.10266E+01,-0.10270E+01,-0.10274E+01,-0.10278E+01,-0.10282E+01,
- &-0.10286E+01,-0.10290E+01,-0.10294E+01,-0.10298E+01,-0.10302E+01,
- &-0.10306E+01,-0.10310E+01,-0.10315E+01,-0.10319E+01,-0.10323E+01,
- &-0.10327E+01,-0.10331E+01,-0.10335E+01,-0.10339E+01,-0.10342E+01,
- &-0.10346E+01,-0.10350E+01,-0.10354E+01,-0.10358E+01,-0.10362E+01,
- &-0.10366E+01,-0.10370E+01,-0.10374E+01,-0.10378E+01,-0.10382E+01,
- &-0.10386E+01,-0.10389E+01,-0.10393E+01,-0.10397E+01,-0.10401E+01,
- &-0.10405E+01,-0.10409E+01,-0.10413E+01,-0.10416E+01,-0.10420E+01,
- &-0.10424E+01,-0.10428E+01,-0.10431E+01,-0.10435E+01,-0.10439E+01,
- &-0.10443E+01,-0.10447E+01,-0.10450E+01,-0.10454E+01,-0.10458E+01,
- &-0.10461E+01,-0.10465E+01,-0.10469E+01,-0.10473E+01,-0.10476E+01,
- &-0.10480E+01,-0.10484E+01,-0.10487E+01,-0.10491E+01,-0.10495E+01,
- &-0.10498E+01,-0.10502E+01,-0.10506E+01,-0.10509E+01,-0.10513E+01/
-
- DATA (BNC04M(I),I=501,600)/
- &-0.10516E+01,-0.10520E+01,-0.10524E+01,-0.10527E+01,-0.10531E+01,
- &-0.10534E+01,-0.10538E+01,-0.10541E+01,-0.10545E+01,-0.10549E+01,
- &-0.10552E+01,-0.10556E+01,-0.10559E+01,-0.10563E+01,-0.10566E+01,
- &-0.10570E+01,-0.10573E+01,-0.10577E+01,-0.10580E+01,-0.10584E+01,
- &-0.10587E+01,-0.10591E+01,-0.10594E+01,-0.10597E+01,-0.10601E+01,
- &-0.10604E+01,-0.10608E+01,-0.10611E+01,-0.10615E+01,-0.10618E+01,
- &-0.10621E+01,-0.10625E+01,-0.10628E+01,-0.10632E+01,-0.10635E+01,
- &-0.10638E+01,-0.10642E+01,-0.10645E+01,-0.10648E+01,-0.10652E+01,
- &-0.10655E+01,-0.10659E+01,-0.10662E+01,-0.10665E+01,-0.10668E+01,
- &-0.10672E+01,-0.10675E+01,-0.10678E+01,-0.10682E+01,-0.10685E+01,
- &-0.10688E+01,-0.10692E+01,-0.10695E+01,-0.10698E+01,-0.10701E+01,
- &-0.10705E+01,-0.10708E+01,-0.10711E+01,-0.10714E+01,-0.10718E+01,
- &-0.10721E+01,-0.10724E+01,-0.10727E+01,-0.10730E+01,-0.10734E+01,
- &-0.10737E+01,-0.10740E+01,-0.10743E+01,-0.10746E+01,-0.10750E+01,
- &-0.10753E+01,-0.10756E+01,-0.10759E+01,-0.10762E+01,-0.10765E+01,
- &-0.10768E+01,-0.10772E+01,-0.10775E+01,-0.10778E+01,-0.10781E+01,
- &-0.10784E+01,-0.10787E+01,-0.10790E+01,-0.10793E+01,-0.10796E+01,
- &-0.10800E+01,-0.10803E+01,-0.10806E+01,-0.10809E+01,-0.10812E+01,
- &-0.10815E+01,-0.10818E+01,-0.10821E+01,-0.10824E+01,-0.10827E+01,
- &-0.10830E+01,-0.10833E+01,-0.10836E+01,-0.10839E+01,-0.10842E+01/
-
- DATA (BNC04M(I),I=601,700)/
- &-0.10874E+01,-0.10904E+01,-0.10933E+01,-0.10961E+01,-0.10989E+01,
- &-0.11017E+01,-0.11044E+01,-0.11070E+01,-0.11097E+01,-0.11123E+01,
- &-0.11148E+01,-0.11173E+01,-0.11198E+01,-0.11223E+01,-0.11247E+01,
- &-0.11271E+01,-0.11294E+01,-0.11317E+01,-0.11340E+01,-0.11363E+01,
- &-0.11385E+01,-0.11407E+01,-0.11429E+01,-0.11450E+01,-0.11471E+01,
- &-0.11492E+01,-0.11513E+01,-0.11534E+01,-0.11554E+01,-0.11574E+01,
- &-0.11593E+01,-0.11613E+01,-0.11632E+01,-0.11651E+01,-0.11670E+01,
- &-0.11689E+01,-0.11707E+01,-0.11726E+01,-0.11744E+01,-0.11762E+01,
- &-0.11779E+01,-0.11797E+01,-0.11814E+01,-0.11831E+01,-0.11848E+01,
- &-0.11865E+01,-0.11882E+01,-0.11898E+01,-0.11915E+01,-0.11931E+01,
- &-0.11947E+01,-0.11963E+01,-0.11978E+01,-0.11994E+01,-0.12009E+01,
- &-0.12025E+01,-0.12040E+01,-0.12055E+01,-0.12070E+01,-0.12084E+01,
- &-0.12099E+01,-0.12114E+01,-0.12128E+01,-0.12142E+01,-0.12156E+01,
- &-0.12170E+01,-0.12184E+01,-0.12198E+01,-0.12212E+01,-0.12225E+01,
- &-0.12238E+01,-0.12252E+01,-0.12265E+01,-0.12278E+01,-0.12291E+01,
- &-0.12304E+01,-0.12317E+01,-0.12329E+01,-0.12342E+01,-0.12355E+01,
- &-0.12367E+01,-0.12379E+01,-0.12391E+01,-0.12404E+01,-0.12416E+01,
- &-0.12428E+01,-0.12439E+01,-0.12451E+01,-0.12463E+01,-0.12474E+01,
- &-0.12486E+01,-0.12497E+01,-0.12509E+01,-0.12520E+01,-0.12531E+01,
- &-0.12542E+01,-0.12553E+01,-0.12564E+01,-0.12575E+01,-0.12586E+01/
-
- DATA (BNC04M(I),I=701,741)/
- &-0.12597E+01,-0.12607E+01,-0.12618E+01,-0.12629E+01,-0.12639E+01,
- &-0.12649E+01,-0.12660E+01,-0.12670E+01,-0.12680E+01,-0.12690E+01,
- &-0.12700E+01,-0.12710E+01,-0.12720E+01,-0.12730E+01,-0.12740E+01,
- &-0.12750E+01,-0.12760E+01,-0.12769E+01,-0.12779E+01,-0.12788E+01,
- &-0.12798E+01,-0.12807E+01,-0.12816E+01,-0.12826E+01,-0.12835E+01,
- &-0.12844E+01,-0.12853E+01,-0.12862E+01,-0.12871E+01,-0.12880E+01,
- &-0.12889E+01,-0.12898E+01,-0.12907E+01,-0.12916E+01,-0.12924E+01,
- &-0.12933E+01,-0.12942E+01,-0.12950E+01,-0.12959E+01,-0.12967E+01,
- &-0.12976E+01
- & /
-C
-C *** NH4NO3
-C
- DATA (BNC05M(I),I=1,100)/
- &-0.47107E-01,-0.10421E+00,-0.13373E+00,-0.15513E+00,-0.17228E+00,
- &-0.18677E+00,-0.19941E+00,-0.21068E+00,-0.22088E+00,-0.23023E+00,
- &-0.23889E+00,-0.24697E+00,-0.25455E+00,-0.26171E+00,-0.26849E+00,
- &-0.27495E+00,-0.28111E+00,-0.28702E+00,-0.29269E+00,-0.29814E+00,
- &-0.30340E+00,-0.30849E+00,-0.31340E+00,-0.31817E+00,-0.32279E+00,
- &-0.32728E+00,-0.33165E+00,-0.33590E+00,-0.34004E+00,-0.34408E+00,
- &-0.34802E+00,-0.35186E+00,-0.35562E+00,-0.35930E+00,-0.36289E+00,
- &-0.36641E+00,-0.36986E+00,-0.37323E+00,-0.37654E+00,-0.37978E+00,
- &-0.38296E+00,-0.38609E+00,-0.38915E+00,-0.39216E+00,-0.39511E+00,
- &-0.39801E+00,-0.40086E+00,-0.40367E+00,-0.40642E+00,-0.40913E+00,
- &-0.41180E+00,-0.41443E+00,-0.41701E+00,-0.41956E+00,-0.42207E+00,
- &-0.42454E+00,-0.42697E+00,-0.42937E+00,-0.43174E+00,-0.43408E+00,
- &-0.43639E+00,-0.43866E+00,-0.44091E+00,-0.44313E+00,-0.44533E+00,
- &-0.44750E+00,-0.44965E+00,-0.45177E+00,-0.45387E+00,-0.45595E+00,
- &-0.45801E+00,-0.46005E+00,-0.46207E+00,-0.46408E+00,-0.46606E+00,
- &-0.46803E+00,-0.46999E+00,-0.47193E+00,-0.47386E+00,-0.47577E+00,
- &-0.47767E+00,-0.47956E+00,-0.48143E+00,-0.48330E+00,-0.48515E+00,
- &-0.48700E+00,-0.48883E+00,-0.49065E+00,-0.49247E+00,-0.49427E+00,
- &-0.49607E+00,-0.49786E+00,-0.49964E+00,-0.50141E+00,-0.50317E+00,
- &-0.50493E+00,-0.50668E+00,-0.50842E+00,-0.51015E+00,-0.51188E+00/
-
- DATA (BNC05M(I),I=101,200)/
- &-0.51359E+00,-0.51530E+00,-0.51701E+00,-0.51870E+00,-0.52039E+00,
- &-0.52208E+00,-0.52375E+00,-0.52542E+00,-0.52708E+00,-0.52873E+00,
- &-0.53038E+00,-0.53201E+00,-0.53364E+00,-0.53527E+00,-0.53688E+00,
- &-0.53849E+00,-0.54009E+00,-0.54168E+00,-0.54327E+00,-0.54485E+00,
- &-0.54642E+00,-0.54798E+00,-0.54953E+00,-0.55108E+00,-0.55262E+00,
- &-0.55415E+00,-0.55568E+00,-0.55719E+00,-0.55870E+00,-0.56020E+00,
- &-0.56170E+00,-0.56318E+00,-0.56466E+00,-0.56613E+00,-0.56760E+00,
- &-0.56905E+00,-0.57050E+00,-0.57195E+00,-0.57338E+00,-0.57481E+00,
- &-0.57623E+00,-0.57764E+00,-0.57905E+00,-0.58044E+00,-0.58184E+00,
- &-0.58322E+00,-0.58460E+00,-0.58597E+00,-0.58734E+00,-0.58869E+00,
- &-0.59004E+00,-0.59139E+00,-0.59273E+00,-0.59406E+00,-0.59539E+00,
- &-0.59670E+00,-0.59802E+00,-0.59932E+00,-0.60062E+00,-0.60192E+00,
- &-0.60321E+00,-0.60449E+00,-0.60577E+00,-0.60704E+00,-0.60830E+00,
- &-0.60956E+00,-0.61081E+00,-0.61206E+00,-0.61330E+00,-0.61454E+00,
- &-0.61577E+00,-0.61699E+00,-0.61821E+00,-0.61943E+00,-0.62064E+00,
- &-0.62184E+00,-0.62304E+00,-0.62423E+00,-0.62542E+00,-0.62660E+00,
- &-0.62778E+00,-0.62895E+00,-0.63012E+00,-0.63128E+00,-0.63244E+00,
- &-0.63359E+00,-0.63474E+00,-0.63588E+00,-0.63702E+00,-0.63815E+00,
- &-0.63928E+00,-0.64040E+00,-0.64152E+00,-0.64264E+00,-0.64375E+00,
- &-0.64485E+00,-0.64595E+00,-0.64705E+00,-0.64814E+00,-0.64923E+00/
-
- DATA (BNC05M(I),I=201,300)/
- &-0.65031E+00,-0.65139E+00,-0.65246E+00,-0.65353E+00,-0.65460E+00,
- &-0.65566E+00,-0.65672E+00,-0.65777E+00,-0.65882E+00,-0.65986E+00,
- &-0.66090E+00,-0.66194E+00,-0.66297E+00,-0.66400E+00,-0.66502E+00,
- &-0.66605E+00,-0.66706E+00,-0.66807E+00,-0.66908E+00,-0.67009E+00,
- &-0.67109E+00,-0.67209E+00,-0.67308E+00,-0.67407E+00,-0.67506E+00,
- &-0.67604E+00,-0.67702E+00,-0.67799E+00,-0.67896E+00,-0.67993E+00,
- &-0.68090E+00,-0.68186E+00,-0.68281E+00,-0.68377E+00,-0.68472E+00,
- &-0.68566E+00,-0.68661E+00,-0.68755E+00,-0.68848E+00,-0.68942E+00,
- &-0.69035E+00,-0.69127E+00,-0.69220E+00,-0.69312E+00,-0.69403E+00,
- &-0.69495E+00,-0.69586E+00,-0.69676E+00,-0.69767E+00,-0.69857E+00,
- &-0.69946E+00,-0.70036E+00,-0.70125E+00,-0.70214E+00,-0.70302E+00,
- &-0.70390E+00,-0.70478E+00,-0.70566E+00,-0.70653E+00,-0.70740E+00,
- &-0.70827E+00,-0.70913E+00,-0.70999E+00,-0.71085E+00,-0.71170E+00,
- &-0.71256E+00,-0.71340E+00,-0.71425E+00,-0.71509E+00,-0.71593E+00,
- &-0.71677E+00,-0.71761E+00,-0.71844E+00,-0.71927E+00,-0.72010E+00,
- &-0.72092E+00,-0.72174E+00,-0.72256E+00,-0.72337E+00,-0.72419E+00,
- &-0.72500E+00,-0.72581E+00,-0.72661E+00,-0.72741E+00,-0.72821E+00,
- &-0.72901E+00,-0.72981E+00,-0.73060E+00,-0.73139E+00,-0.73218E+00,
- &-0.73296E+00,-0.73374E+00,-0.73452E+00,-0.73530E+00,-0.73607E+00,
- &-0.73685E+00,-0.73762E+00,-0.73838E+00,-0.73915E+00,-0.73991E+00/
-
- DATA (BNC05M(I),I=301,400)/
- &-0.74067E+00,-0.74143E+00,-0.74218E+00,-0.74294E+00,-0.74369E+00,
- &-0.74444E+00,-0.74518E+00,-0.74593E+00,-0.74667E+00,-0.74741E+00,
- &-0.74814E+00,-0.74888E+00,-0.74961E+00,-0.75034E+00,-0.75107E+00,
- &-0.75179E+00,-0.75252E+00,-0.75324E+00,-0.75396E+00,-0.75468E+00,
- &-0.75539E+00,-0.75610E+00,-0.75681E+00,-0.75752E+00,-0.75823E+00,
- &-0.75893E+00,-0.75963E+00,-0.76033E+00,-0.76103E+00,-0.76173E+00,
- &-0.76242E+00,-0.76311E+00,-0.76380E+00,-0.76449E+00,-0.76518E+00,
- &-0.76586E+00,-0.76654E+00,-0.76722E+00,-0.76790E+00,-0.76857E+00,
- &-0.76925E+00,-0.76992E+00,-0.77059E+00,-0.77126E+00,-0.77192E+00,
- &-0.77259E+00,-0.77325E+00,-0.77391E+00,-0.77457E+00,-0.77523E+00,
- &-0.77588E+00,-0.77653E+00,-0.77718E+00,-0.77783E+00,-0.77848E+00,
- &-0.77913E+00,-0.77977E+00,-0.78041E+00,-0.78105E+00,-0.78169E+00,
- &-0.78233E+00,-0.78296E+00,-0.78359E+00,-0.78422E+00,-0.78485E+00,
- &-0.78548E+00,-0.78611E+00,-0.78673E+00,-0.78735E+00,-0.78797E+00,
- &-0.78859E+00,-0.78921E+00,-0.78983E+00,-0.79044E+00,-0.79105E+00,
- &-0.79166E+00,-0.79227E+00,-0.79288E+00,-0.79348E+00,-0.79409E+00,
- &-0.79469E+00,-0.79529E+00,-0.79589E+00,-0.79649E+00,-0.79708E+00,
- &-0.79768E+00,-0.79827E+00,-0.79886E+00,-0.79945E+00,-0.80004E+00,
- &-0.80062E+00,-0.80121E+00,-0.80179E+00,-0.80237E+00,-0.80295E+00,
- &-0.80353E+00,-0.80411E+00,-0.80468E+00,-0.80526E+00,-0.80583E+00/
-
- DATA (BNC05M(I),I=401,500)/
- &-0.80640E+00,-0.80697E+00,-0.80754E+00,-0.80811E+00,-0.80867E+00,
- &-0.80923E+00,-0.80980E+00,-0.81036E+00,-0.81092E+00,-0.81147E+00,
- &-0.81203E+00,-0.81259E+00,-0.81314E+00,-0.81369E+00,-0.81424E+00,
- &-0.81479E+00,-0.81534E+00,-0.81589E+00,-0.81643E+00,-0.81697E+00,
- &-0.81752E+00,-0.81806E+00,-0.81860E+00,-0.81913E+00,-0.81967E+00,
- &-0.82021E+00,-0.82074E+00,-0.82127E+00,-0.82180E+00,-0.82233E+00,
- &-0.82286E+00,-0.82339E+00,-0.82392E+00,-0.82444E+00,-0.82496E+00,
- &-0.82549E+00,-0.82601E+00,-0.82653E+00,-0.82705E+00,-0.82756E+00,
- &-0.82808E+00,-0.82859E+00,-0.82911E+00,-0.82962E+00,-0.83013E+00,
- &-0.83064E+00,-0.83115E+00,-0.83165E+00,-0.83216E+00,-0.83266E+00,
- &-0.83317E+00,-0.83367E+00,-0.83417E+00,-0.83467E+00,-0.83517E+00,
- &-0.83566E+00,-0.83616E+00,-0.83665E+00,-0.83715E+00,-0.83764E+00,
- &-0.83813E+00,-0.83862E+00,-0.83911E+00,-0.83960E+00,-0.84008E+00,
- &-0.84057E+00,-0.84105E+00,-0.84154E+00,-0.84202E+00,-0.84250E+00,
- &-0.84298E+00,-0.84346E+00,-0.84393E+00,-0.84441E+00,-0.84489E+00,
- &-0.84536E+00,-0.84583E+00,-0.84630E+00,-0.84677E+00,-0.84724E+00,
- &-0.84771E+00,-0.84818E+00,-0.84865E+00,-0.84911E+00,-0.84957E+00,
- &-0.85004E+00,-0.85050E+00,-0.85096E+00,-0.85142E+00,-0.85188E+00,
- &-0.85234E+00,-0.85279E+00,-0.85325E+00,-0.85370E+00,-0.85416E+00,
- &-0.85461E+00,-0.85506E+00,-0.85551E+00,-0.85596E+00,-0.85641E+00/
-
- DATA (BNC05M(I),I=501,600)/
- &-0.85686E+00,-0.85730E+00,-0.85775E+00,-0.85819E+00,-0.85863E+00,
- &-0.85908E+00,-0.85952E+00,-0.85996E+00,-0.86040E+00,-0.86084E+00,
- &-0.86127E+00,-0.86171E+00,-0.86214E+00,-0.86258E+00,-0.86301E+00,
- &-0.86344E+00,-0.86388E+00,-0.86431E+00,-0.86474E+00,-0.86516E+00,
- &-0.86559E+00,-0.86602E+00,-0.86644E+00,-0.86687E+00,-0.86729E+00,
- &-0.86772E+00,-0.86814E+00,-0.86856E+00,-0.86898E+00,-0.86940E+00,
- &-0.86982E+00,-0.87023E+00,-0.87065E+00,-0.87106E+00,-0.87148E+00,
- &-0.87189E+00,-0.87231E+00,-0.87272E+00,-0.87313E+00,-0.87354E+00,
- &-0.87395E+00,-0.87436E+00,-0.87476E+00,-0.87517E+00,-0.87558E+00,
- &-0.87598E+00,-0.87638E+00,-0.87679E+00,-0.87719E+00,-0.87759E+00,
- &-0.87799E+00,-0.87839E+00,-0.87879E+00,-0.87919E+00,-0.87958E+00,
- &-0.87998E+00,-0.88038E+00,-0.88077E+00,-0.88116E+00,-0.88156E+00,
- &-0.88195E+00,-0.88234E+00,-0.88273E+00,-0.88312E+00,-0.88351E+00,
- &-0.88390E+00,-0.88428E+00,-0.88467E+00,-0.88506E+00,-0.88544E+00,
- &-0.88582E+00,-0.88621E+00,-0.88659E+00,-0.88697E+00,-0.88735E+00,
- &-0.88773E+00,-0.88811E+00,-0.88849E+00,-0.88887E+00,-0.88924E+00,
- &-0.88962E+00,-0.88999E+00,-0.89037E+00,-0.89074E+00,-0.89112E+00,
- &-0.89149E+00,-0.89186E+00,-0.89223E+00,-0.89260E+00,-0.89297E+00,
- &-0.89334E+00,-0.89370E+00,-0.89407E+00,-0.89444E+00,-0.89480E+00,
- &-0.89517E+00,-0.89553E+00,-0.89589E+00,-0.89626E+00,-0.89662E+00/
-
- DATA (BNC05M(I),I=601,700)/
- &-0.90048E+00,-0.90398E+00,-0.90741E+00,-0.91077E+00,-0.91407E+00,
- &-0.91731E+00,-0.92048E+00,-0.92360E+00,-0.92666E+00,-0.92966E+00,
- &-0.93261E+00,-0.93551E+00,-0.93835E+00,-0.94115E+00,-0.94389E+00,
- &-0.94659E+00,-0.94924E+00,-0.95185E+00,-0.95441E+00,-0.95693E+00,
- &-0.95941E+00,-0.96185E+00,-0.96425E+00,-0.96661E+00,-0.96893E+00,
- &-0.97121E+00,-0.97346E+00,-0.97568E+00,-0.97786E+00,-0.98000E+00,
- &-0.98212E+00,-0.98420E+00,-0.98625E+00,-0.98827E+00,-0.99026E+00,
- &-0.99222E+00,-0.99415E+00,-0.99605E+00,-0.99793E+00,-0.99978E+00,
- &-0.10016E+01,-0.10034E+01,-0.10052E+01,-0.10069E+01,-0.10087E+01,
- &-0.10104E+01,-0.10120E+01,-0.10137E+01,-0.10153E+01,-0.10169E+01,
- &-0.10185E+01,-0.10201E+01,-0.10216E+01,-0.10232E+01,-0.10247E+01,
- &-0.10262E+01,-0.10276E+01,-0.10291E+01,-0.10305E+01,-0.10319E+01,
- &-0.10333E+01,-0.10347E+01,-0.10361E+01,-0.10374E+01,-0.10388E+01,
- &-0.10401E+01,-0.10414E+01,-0.10427E+01,-0.10439E+01,-0.10452E+01,
- &-0.10464E+01,-0.10477E+01,-0.10489E+01,-0.10501E+01,-0.10513E+01,
- &-0.10524E+01,-0.10536E+01,-0.10547E+01,-0.10559E+01,-0.10570E+01,
- &-0.10581E+01,-0.10592E+01,-0.10603E+01,-0.10613E+01,-0.10624E+01,
- &-0.10635E+01,-0.10645E+01,-0.10655E+01,-0.10665E+01,-0.10675E+01,
- &-0.10685E+01,-0.10695E+01,-0.10705E+01,-0.10715E+01,-0.10724E+01,
- &-0.10734E+01,-0.10743E+01,-0.10752E+01,-0.10761E+01,-0.10770E+01/
-
- DATA (BNC05M(I),I=701,741)/
- &-0.10779E+01,-0.10788E+01,-0.10797E+01,-0.10806E+01,-0.10814E+01,
- &-0.10823E+01,-0.10831E+01,-0.10840E+01,-0.10848E+01,-0.10856E+01,
- &-0.10865E+01,-0.10873E+01,-0.10881E+01,-0.10889E+01,-0.10896E+01,
- &-0.10904E+01,-0.10912E+01,-0.10920E+01,-0.10927E+01,-0.10935E+01,
- &-0.10942E+01,-0.10949E+01,-0.10957E+01,-0.10964E+01,-0.10971E+01,
- &-0.10978E+01,-0.10985E+01,-0.10992E+01,-0.10999E+01,-0.11006E+01,
- &-0.11013E+01,-0.11020E+01,-0.11026E+01,-0.11033E+01,-0.11039E+01,
- &-0.11046E+01,-0.11052E+01,-0.11059E+01,-0.11065E+01,-0.11071E+01,
- &-0.11078E+01
- & /
-C
-C *** NH4Cl
-C
- DATA (BNC06M(I),I=1,100)/
- &-0.45990E-01,-0.98113E-01,-0.12306E+00,-0.14011E+00,-0.15308E+00,
- &-0.16349E+00,-0.17215E+00,-0.17952E+00,-0.18589E+00,-0.19149E+00,
- &-0.19644E+00,-0.20086E+00,-0.20484E+00,-0.20843E+00,-0.21170E+00,
- &-0.21467E+00,-0.21740E+00,-0.21990E+00,-0.22221E+00,-0.22433E+00,
- &-0.22630E+00,-0.22812E+00,-0.22981E+00,-0.23138E+00,-0.23284E+00,
- &-0.23420E+00,-0.23547E+00,-0.23665E+00,-0.23775E+00,-0.23879E+00,
- &-0.23975E+00,-0.24065E+00,-0.24150E+00,-0.24229E+00,-0.24303E+00,
- &-0.24372E+00,-0.24437E+00,-0.24498E+00,-0.24555E+00,-0.24608E+00,
- &-0.24658E+00,-0.24705E+00,-0.24749E+00,-0.24790E+00,-0.24829E+00,
- &-0.24865E+00,-0.24898E+00,-0.24929E+00,-0.24959E+00,-0.24986E+00,
- &-0.25011E+00,-0.25034E+00,-0.25056E+00,-0.25076E+00,-0.25094E+00,
- &-0.25111E+00,-0.25126E+00,-0.25140E+00,-0.25152E+00,-0.25163E+00,
- &-0.25173E+00,-0.25182E+00,-0.25189E+00,-0.25195E+00,-0.25200E+00,
- &-0.25204E+00,-0.25206E+00,-0.25207E+00,-0.25208E+00,-0.25207E+00,
- &-0.25205E+00,-0.25202E+00,-0.25198E+00,-0.25192E+00,-0.25186E+00,
- &-0.25179E+00,-0.25170E+00,-0.25161E+00,-0.25150E+00,-0.25139E+00,
- &-0.25126E+00,-0.25113E+00,-0.25098E+00,-0.25083E+00,-0.25066E+00,
- &-0.25049E+00,-0.25030E+00,-0.25011E+00,-0.24990E+00,-0.24969E+00,
- &-0.24946E+00,-0.24923E+00,-0.24899E+00,-0.24874E+00,-0.24848E+00,
- &-0.24822E+00,-0.24794E+00,-0.24766E+00,-0.24737E+00,-0.24707E+00/
-
- DATA (BNC06M(I),I=101,200)/
- &-0.24676E+00,-0.24645E+00,-0.24613E+00,-0.24580E+00,-0.24547E+00,
- &-0.24513E+00,-0.24479E+00,-0.24443E+00,-0.24408E+00,-0.24371E+00,
- &-0.24335E+00,-0.24297E+00,-0.24259E+00,-0.24221E+00,-0.24183E+00,
- &-0.24143E+00,-0.24104E+00,-0.24064E+00,-0.24024E+00,-0.23983E+00,
- &-0.23942E+00,-0.23901E+00,-0.23859E+00,-0.23817E+00,-0.23775E+00,
- &-0.23733E+00,-0.23690E+00,-0.23647E+00,-0.23604E+00,-0.23560E+00,
- &-0.23517E+00,-0.23473E+00,-0.23429E+00,-0.23385E+00,-0.23340E+00,
- &-0.23296E+00,-0.23251E+00,-0.23206E+00,-0.23161E+00,-0.23116E+00,
- &-0.23071E+00,-0.23025E+00,-0.22980E+00,-0.22934E+00,-0.22888E+00,
- &-0.22842E+00,-0.22796E+00,-0.22750E+00,-0.22704E+00,-0.22658E+00,
- &-0.22611E+00,-0.22565E+00,-0.22518E+00,-0.22472E+00,-0.22425E+00,
- &-0.22378E+00,-0.22331E+00,-0.22284E+00,-0.22237E+00,-0.22190E+00,
- &-0.22143E+00,-0.22096E+00,-0.22049E+00,-0.22001E+00,-0.21954E+00,
- &-0.21906E+00,-0.21859E+00,-0.21812E+00,-0.21764E+00,-0.21716E+00,
- &-0.21669E+00,-0.21621E+00,-0.21573E+00,-0.21526E+00,-0.21478E+00,
- &-0.21430E+00,-0.21382E+00,-0.21334E+00,-0.21286E+00,-0.21238E+00,
- &-0.21191E+00,-0.21143E+00,-0.21095E+00,-0.21047E+00,-0.20999E+00,
- &-0.20951E+00,-0.20903E+00,-0.20854E+00,-0.20806E+00,-0.20758E+00,
- &-0.20710E+00,-0.20662E+00,-0.20614E+00,-0.20566E+00,-0.20518E+00,
- &-0.20470E+00,-0.20422E+00,-0.20373E+00,-0.20325E+00,-0.20277E+00/
-
- DATA (BNC06M(I),I=201,300)/
- &-0.20229E+00,-0.20181E+00,-0.20133E+00,-0.20085E+00,-0.20037E+00,
- &-0.19989E+00,-0.19941E+00,-0.19892E+00,-0.19844E+00,-0.19796E+00,
- &-0.19748E+00,-0.19700E+00,-0.19652E+00,-0.19604E+00,-0.19556E+00,
- &-0.19508E+00,-0.19460E+00,-0.19412E+00,-0.19364E+00,-0.19316E+00,
- &-0.19269E+00,-0.19221E+00,-0.19173E+00,-0.19125E+00,-0.19077E+00,
- &-0.19029E+00,-0.18982E+00,-0.18934E+00,-0.18886E+00,-0.18838E+00,
- &-0.18791E+00,-0.18743E+00,-0.18695E+00,-0.18648E+00,-0.18600E+00,
- &-0.18553E+00,-0.18505E+00,-0.18458E+00,-0.18410E+00,-0.18363E+00,
- &-0.18315E+00,-0.18268E+00,-0.18221E+00,-0.18173E+00,-0.18126E+00,
- &-0.18079E+00,-0.18031E+00,-0.17984E+00,-0.17937E+00,-0.17890E+00,
- &-0.17843E+00,-0.17796E+00,-0.17749E+00,-0.17702E+00,-0.17655E+00,
- &-0.17608E+00,-0.17561E+00,-0.17514E+00,-0.17467E+00,-0.17420E+00,
- &-0.17373E+00,-0.17327E+00,-0.17280E+00,-0.17233E+00,-0.17187E+00,
- &-0.17140E+00,-0.17093E+00,-0.17047E+00,-0.17000E+00,-0.16954E+00,
- &-0.16908E+00,-0.16861E+00,-0.16815E+00,-0.16769E+00,-0.16722E+00,
- &-0.16676E+00,-0.16630E+00,-0.16584E+00,-0.16538E+00,-0.16492E+00,
- &-0.16446E+00,-0.16400E+00,-0.16354E+00,-0.16308E+00,-0.16262E+00,
- &-0.16216E+00,-0.16170E+00,-0.16124E+00,-0.16079E+00,-0.16033E+00,
- &-0.15987E+00,-0.15942E+00,-0.15896E+00,-0.15851E+00,-0.15805E+00,
- &-0.15760E+00,-0.15714E+00,-0.15669E+00,-0.15624E+00,-0.15579E+00/
-
- DATA (BNC06M(I),I=301,400)/
- &-0.15533E+00,-0.15488E+00,-0.15443E+00,-0.15398E+00,-0.15353E+00,
- &-0.15308E+00,-0.15263E+00,-0.15218E+00,-0.15173E+00,-0.15128E+00,
- &-0.15083E+00,-0.15039E+00,-0.14994E+00,-0.14949E+00,-0.14905E+00,
- &-0.14860E+00,-0.14816E+00,-0.14771E+00,-0.14727E+00,-0.14682E+00,
- &-0.14638E+00,-0.14594E+00,-0.14549E+00,-0.14505E+00,-0.14461E+00,
- &-0.14417E+00,-0.14373E+00,-0.14328E+00,-0.14284E+00,-0.14240E+00,
- &-0.14197E+00,-0.14153E+00,-0.14109E+00,-0.14065E+00,-0.14021E+00,
- &-0.13977E+00,-0.13934E+00,-0.13890E+00,-0.13847E+00,-0.13803E+00,
- &-0.13760E+00,-0.13716E+00,-0.13673E+00,-0.13629E+00,-0.13586E+00,
- &-0.13543E+00,-0.13499E+00,-0.13456E+00,-0.13413E+00,-0.13370E+00,
- &-0.13327E+00,-0.13284E+00,-0.13241E+00,-0.13198E+00,-0.13155E+00,
- &-0.13112E+00,-0.13069E+00,-0.13027E+00,-0.12984E+00,-0.12941E+00,
- &-0.12899E+00,-0.12856E+00,-0.12813E+00,-0.12771E+00,-0.12729E+00,
- &-0.12686E+00,-0.12644E+00,-0.12601E+00,-0.12559E+00,-0.12517E+00,
- &-0.12475E+00,-0.12433E+00,-0.12390E+00,-0.12348E+00,-0.12306E+00,
- &-0.12264E+00,-0.12222E+00,-0.12181E+00,-0.12139E+00,-0.12097E+00,
- &-0.12055E+00,-0.12013E+00,-0.11972E+00,-0.11930E+00,-0.11888E+00,
- &-0.11847E+00,-0.11805E+00,-0.11764E+00,-0.11722E+00,-0.11681E+00,
- &-0.11640E+00,-0.11598E+00,-0.11557E+00,-0.11516E+00,-0.11475E+00,
- &-0.11434E+00,-0.11393E+00,-0.11352E+00,-0.11311E+00,-0.11270E+00/
-
- DATA (BNC06M(I),I=401,500)/
- &-0.11229E+00,-0.11188E+00,-0.11147E+00,-0.11106E+00,-0.11066E+00,
- &-0.11025E+00,-0.10984E+00,-0.10944E+00,-0.10903E+00,-0.10862E+00,
- &-0.10822E+00,-0.10781E+00,-0.10741E+00,-0.10701E+00,-0.10660E+00,
- &-0.10620E+00,-0.10580E+00,-0.10540E+00,-0.10499E+00,-0.10459E+00,
- &-0.10419E+00,-0.10379E+00,-0.10339E+00,-0.10299E+00,-0.10259E+00,
- &-0.10220E+00,-0.10180E+00,-0.10140E+00,-0.10100E+00,-0.10060E+00,
- &-0.10021E+00,-0.99812E-01,-0.99416E-01,-0.99021E-01,-0.98626E-01,
- &-0.98231E-01,-0.97837E-01,-0.97443E-01,-0.97050E-01,-0.96657E-01,
- &-0.96264E-01,-0.95872E-01,-0.95480E-01,-0.95089E-01,-0.94698E-01,
- &-0.94308E-01,-0.93917E-01,-0.93528E-01,-0.93138E-01,-0.92749E-01,
- &-0.92361E-01,-0.91973E-01,-0.91585E-01,-0.91197E-01,-0.90810E-01,
- &-0.90424E-01,-0.90038E-01,-0.89652E-01,-0.89267E-01,-0.88882E-01,
- &-0.88497E-01,-0.88113E-01,-0.87729E-01,-0.87346E-01,-0.86963E-01,
- &-0.86580E-01,-0.86198E-01,-0.85816E-01,-0.85434E-01,-0.85053E-01,
- &-0.84673E-01,-0.84292E-01,-0.83912E-01,-0.83533E-01,-0.83154E-01,
- &-0.82775E-01,-0.82397E-01,-0.82019E-01,-0.81641E-01,-0.81264E-01,
- &-0.80887E-01,-0.80510E-01,-0.80134E-01,-0.79759E-01,-0.79383E-01,
- &-0.79008E-01,-0.78634E-01,-0.78260E-01,-0.77886E-01,-0.77512E-01,
- &-0.77139E-01,-0.76767E-01,-0.76394E-01,-0.76022E-01,-0.75651E-01,
- &-0.75280E-01,-0.74909E-01,-0.74538E-01,-0.74168E-01,-0.73799E-01/
-
- DATA (BNC06M(I),I=501,600)/
- &-0.73429E-01,-0.73060E-01,-0.72692E-01,-0.72324E-01,-0.71956E-01,
- &-0.71588E-01,-0.71221E-01,-0.70854E-01,-0.70488E-01,-0.70122E-01,
- &-0.69756E-01,-0.69391E-01,-0.69026E-01,-0.68661E-01,-0.68297E-01,
- &-0.67933E-01,-0.67570E-01,-0.67207E-01,-0.66844E-01,-0.66482E-01,
- &-0.66120E-01,-0.65758E-01,-0.65397E-01,-0.65036E-01,-0.64675E-01,
- &-0.64315E-01,-0.63955E-01,-0.63595E-01,-0.63236E-01,-0.62877E-01,
- &-0.62519E-01,-0.62161E-01,-0.61803E-01,-0.61446E-01,-0.61089E-01,
- &-0.60732E-01,-0.60375E-01,-0.60019E-01,-0.59664E-01,-0.59308E-01,
- &-0.58954E-01,-0.58599E-01,-0.58245E-01,-0.57891E-01,-0.57537E-01,
- &-0.57184E-01,-0.56831E-01,-0.56478E-01,-0.56126E-01,-0.55774E-01,
- &-0.55423E-01,-0.55072E-01,-0.54721E-01,-0.54370E-01,-0.54020E-01,
- &-0.53670E-01,-0.53321E-01,-0.52972E-01,-0.52623E-01,-0.52274E-01,
- &-0.51926E-01,-0.51578E-01,-0.51231E-01,-0.50884E-01,-0.50537E-01,
- &-0.50191E-01,-0.49844E-01,-0.49499E-01,-0.49153E-01,-0.48808E-01,
- &-0.48463E-01,-0.48119E-01,-0.47775E-01,-0.47431E-01,-0.47087E-01,
- &-0.46744E-01,-0.46401E-01,-0.46059E-01,-0.45717E-01,-0.45375E-01,
- &-0.45033E-01,-0.44692E-01,-0.44351E-01,-0.44011E-01,-0.43670E-01,
- &-0.43331E-01,-0.42991E-01,-0.42652E-01,-0.42313E-01,-0.41974E-01,
- &-0.41636E-01,-0.41298E-01,-0.40960E-01,-0.40623E-01,-0.40286E-01,
- &-0.39949E-01,-0.39613E-01,-0.39277E-01,-0.38941E-01,-0.38605E-01/
-
- DATA (BNC06M(I),I=601,700)/
- &-0.35001E-01,-0.31698E-01,-0.28424E-01,-0.25181E-01,-0.21967E-01,
- &-0.18782E-01,-0.15626E-01,-0.12497E-01,-0.93962E-02,-0.63224E-02,
- &-0.32753E-02,-0.25445E-03, 0.27406E-02, 0.57102E-02, 0.86548E-02,
- & 0.11575E-01, 0.14470E-01, 0.17342E-01, 0.20191E-01, 0.23016E-01,
- & 0.25819E-01, 0.28599E-01, 0.31357E-01, 0.34093E-01, 0.36808E-01,
- & 0.39502E-01, 0.42175E-01, 0.44827E-01, 0.47460E-01, 0.50072E-01,
- & 0.52665E-01, 0.55239E-01, 0.57793E-01, 0.60329E-01, 0.62847E-01,
- & 0.65346E-01, 0.67827E-01, 0.70291E-01, 0.72737E-01, 0.75166E-01,
- & 0.77577E-01, 0.79972E-01, 0.82351E-01, 0.84713E-01, 0.87059E-01,
- & 0.89390E-01, 0.91704E-01, 0.94003E-01, 0.96287E-01, 0.98556E-01,
- & 0.10081E+00, 0.10305E+00, 0.10527E+00, 0.10749E+00, 0.10968E+00,
- & 0.11186E+00, 0.11403E+00, 0.11619E+00, 0.11833E+00, 0.12046E+00,
- & 0.12257E+00, 0.12468E+00, 0.12677E+00, 0.12884E+00, 0.13091E+00,
- & 0.13296E+00, 0.13500E+00, 0.13703E+00, 0.13904E+00, 0.14105E+00,
- & 0.14304E+00, 0.14502E+00, 0.14699E+00, 0.14895E+00, 0.15090E+00,
- & 0.15283E+00, 0.15476E+00, 0.15668E+00, 0.15858E+00, 0.16047E+00,
- & 0.16236E+00, 0.16423E+00, 0.16609E+00, 0.16795E+00, 0.16979E+00,
- & 0.17162E+00, 0.17345E+00, 0.17526E+00, 0.17706E+00, 0.17886E+00,
- & 0.18064E+00, 0.18242E+00, 0.18419E+00, 0.18595E+00, 0.18769E+00,
- & 0.18944E+00, 0.19117E+00, 0.19289E+00, 0.19460E+00, 0.19631E+00/
-
- DATA (BNC06M(I),I=701,741)/
- & 0.19801E+00, 0.19970E+00, 0.20138E+00, 0.20305E+00, 0.20471E+00,
- & 0.20637E+00, 0.20802E+00, 0.20966E+00, 0.21129E+00, 0.21292E+00,
- & 0.21453E+00, 0.21614E+00, 0.21775E+00, 0.21934E+00, 0.22093E+00,
- & 0.22251E+00, 0.22408E+00, 0.22565E+00, 0.22721E+00, 0.22876E+00,
- & 0.23030E+00, 0.23184E+00, 0.23337E+00, 0.23490E+00, 0.23641E+00,
- & 0.23792E+00, 0.23943E+00, 0.24093E+00, 0.24242E+00, 0.24390E+00,
- & 0.24538E+00, 0.24685E+00, 0.24832E+00, 0.24978E+00, 0.25123E+00,
- & 0.25268E+00, 0.25412E+00, 0.25555E+00, 0.25698E+00, 0.25840E+00,
- & 0.25982E+00
- & /
-C
-C *** (2H,SO4)
-C
- DATA (BNC07M(I),I=1,100)/
- &-0.92967E-01,-0.20158E+00,-0.25546E+00,-0.29333E+00,-0.32290E+00,
- &-0.34726E+00,-0.36803E+00,-0.38614E+00,-0.40221E+00,-0.41665E+00,
- &-0.42977E+00,-0.44179E+00,-0.45288E+00,-0.46316E+00,-0.47275E+00,
- &-0.48173E+00,-0.49018E+00,-0.49815E+00,-0.50570E+00,-0.51286E+00,
- &-0.51967E+00,-0.52616E+00,-0.53237E+00,-0.53830E+00,-0.54400E+00,
- &-0.54947E+00,-0.55472E+00,-0.55979E+00,-0.56467E+00,-0.56938E+00,
- &-0.57394E+00,-0.57834E+00,-0.58261E+00,-0.58674E+00,-0.59075E+00,
- &-0.59465E+00,-0.59843E+00,-0.60211E+00,-0.60568E+00,-0.60916E+00,
- &-0.61255E+00,-0.61586E+00,-0.61908E+00,-0.62223E+00,-0.62530E+00,
- &-0.62830E+00,-0.63123E+00,-0.63409E+00,-0.63689E+00,-0.63963E+00,
- &-0.64231E+00,-0.64494E+00,-0.64751E+00,-0.65003E+00,-0.65250E+00,
- &-0.65493E+00,-0.65730E+00,-0.65964E+00,-0.66192E+00,-0.66417E+00,
- &-0.66638E+00,-0.66855E+00,-0.67068E+00,-0.67278E+00,-0.67484E+00,
- &-0.67686E+00,-0.67886E+00,-0.68082E+00,-0.68275E+00,-0.68465E+00,
- &-0.68652E+00,-0.68837E+00,-0.69019E+00,-0.69198E+00,-0.69375E+00,
- &-0.69549E+00,-0.69720E+00,-0.69890E+00,-0.70057E+00,-0.70222E+00,
- &-0.70385E+00,-0.70546E+00,-0.70704E+00,-0.70861E+00,-0.71016E+00,
- &-0.71169E+00,-0.71320E+00,-0.71470E+00,-0.71617E+00,-0.71763E+00,
- &-0.71908E+00,-0.72050E+00,-0.72192E+00,-0.72331E+00,-0.72470E+00,
- &-0.72606E+00,-0.72742E+00,-0.72875E+00,-0.73008E+00,-0.73139E+00/
-
- DATA (BNC07M(I),I=101,200)/
- &-0.73269E+00,-0.73398E+00,-0.73525E+00,-0.73651E+00,-0.73776E+00,
- &-0.73899E+00,-0.74022E+00,-0.74143E+00,-0.74263E+00,-0.74383E+00,
- &-0.74501E+00,-0.74617E+00,-0.74733E+00,-0.74848E+00,-0.74962E+00,
- &-0.75075E+00,-0.75186E+00,-0.75297E+00,-0.75407E+00,-0.75516E+00,
- &-0.75624E+00,-0.75731E+00,-0.75837E+00,-0.75942E+00,-0.76047E+00,
- &-0.76150E+00,-0.76253E+00,-0.76354E+00,-0.76455E+00,-0.76556E+00,
- &-0.76655E+00,-0.76753E+00,-0.76851E+00,-0.76948E+00,-0.77044E+00,
- &-0.77140E+00,-0.77235E+00,-0.77329E+00,-0.77422E+00,-0.77514E+00,
- &-0.77606E+00,-0.77697E+00,-0.77788E+00,-0.77878E+00,-0.77967E+00,
- &-0.78055E+00,-0.78143E+00,-0.78231E+00,-0.78317E+00,-0.78403E+00,
- &-0.78489E+00,-0.78573E+00,-0.78658E+00,-0.78741E+00,-0.78824E+00,
- &-0.78907E+00,-0.78989E+00,-0.79070E+00,-0.79151E+00,-0.79231E+00,
- &-0.79311E+00,-0.79390E+00,-0.79469E+00,-0.79547E+00,-0.79625E+00,
- &-0.79702E+00,-0.79779E+00,-0.79855E+00,-0.79930E+00,-0.80006E+00,
- &-0.80080E+00,-0.80155E+00,-0.80229E+00,-0.80302E+00,-0.80375E+00,
- &-0.80447E+00,-0.80519E+00,-0.80591E+00,-0.80662E+00,-0.80733E+00,
- &-0.80803E+00,-0.80873E+00,-0.80943E+00,-0.81012E+00,-0.81081E+00,
- &-0.81149E+00,-0.81217E+00,-0.81284E+00,-0.81351E+00,-0.81418E+00,
- &-0.81485E+00,-0.81551E+00,-0.81616E+00,-0.81682E+00,-0.81747E+00,
- &-0.81811E+00,-0.81875E+00,-0.81939E+00,-0.82003E+00,-0.82066E+00/
-
- DATA (BNC07M(I),I=201,300)/
- &-0.82129E+00,-0.82191E+00,-0.82254E+00,-0.82315E+00,-0.82377E+00,
- &-0.82438E+00,-0.82499E+00,-0.82560E+00,-0.82620E+00,-0.82680E+00,
- &-0.82740E+00,-0.82799E+00,-0.82858E+00,-0.82917E+00,-0.82975E+00,
- &-0.83033E+00,-0.83091E+00,-0.83149E+00,-0.83206E+00,-0.83263E+00,
- &-0.83320E+00,-0.83376E+00,-0.83433E+00,-0.83489E+00,-0.83544E+00,
- &-0.83600E+00,-0.83655E+00,-0.83710E+00,-0.83764E+00,-0.83819E+00,
- &-0.83873E+00,-0.83927E+00,-0.83980E+00,-0.84034E+00,-0.84087E+00,
- &-0.84140E+00,-0.84192E+00,-0.84245E+00,-0.84297E+00,-0.84349E+00,
- &-0.84401E+00,-0.84452E+00,-0.84503E+00,-0.84554E+00,-0.84605E+00,
- &-0.84656E+00,-0.84706E+00,-0.84756E+00,-0.84806E+00,-0.84856E+00,
- &-0.84905E+00,-0.84954E+00,-0.85003E+00,-0.85052E+00,-0.85101E+00,
- &-0.85149E+00,-0.85198E+00,-0.85246E+00,-0.85294E+00,-0.85341E+00,
- &-0.85389E+00,-0.85436E+00,-0.85483E+00,-0.85530E+00,-0.85576E+00,
- &-0.85623E+00,-0.85669E+00,-0.85715E+00,-0.85761E+00,-0.85807E+00,
- &-0.85852E+00,-0.85898E+00,-0.85943E+00,-0.85988E+00,-0.86033E+00,
- &-0.86077E+00,-0.86122E+00,-0.86166E+00,-0.86210E+00,-0.86254E+00,
- &-0.86298E+00,-0.86342E+00,-0.86385E+00,-0.86429E+00,-0.86472E+00,
- &-0.86515E+00,-0.86557E+00,-0.86600E+00,-0.86643E+00,-0.86685E+00,
- &-0.86727E+00,-0.86769E+00,-0.86811E+00,-0.86853E+00,-0.86894E+00,
- &-0.86936E+00,-0.86977E+00,-0.87018E+00,-0.87059E+00,-0.87100E+00/
-
- DATA (BNC07M(I),I=301,400)/
- &-0.87140E+00,-0.87181E+00,-0.87221E+00,-0.87261E+00,-0.87301E+00,
- &-0.87341E+00,-0.87381E+00,-0.87421E+00,-0.87460E+00,-0.87500E+00,
- &-0.87539E+00,-0.87578E+00,-0.87617E+00,-0.87656E+00,-0.87695E+00,
- &-0.87733E+00,-0.87772E+00,-0.87810E+00,-0.87848E+00,-0.87886E+00,
- &-0.87924E+00,-0.87962E+00,-0.87999E+00,-0.88037E+00,-0.88074E+00,
- &-0.88112E+00,-0.88149E+00,-0.88186E+00,-0.88223E+00,-0.88259E+00,
- &-0.88296E+00,-0.88333E+00,-0.88369E+00,-0.88405E+00,-0.88442E+00,
- &-0.88478E+00,-0.88514E+00,-0.88549E+00,-0.88585E+00,-0.88621E+00,
- &-0.88656E+00,-0.88692E+00,-0.88727E+00,-0.88762E+00,-0.88797E+00,
- &-0.88832E+00,-0.88867E+00,-0.88902E+00,-0.88936E+00,-0.88971E+00,
- &-0.89005E+00,-0.89039E+00,-0.89074E+00,-0.89108E+00,-0.89142E+00,
- &-0.89176E+00,-0.89209E+00,-0.89243E+00,-0.89277E+00,-0.89310E+00,
- &-0.89343E+00,-0.89377E+00,-0.89410E+00,-0.89443E+00,-0.89476E+00,
- &-0.89509E+00,-0.89541E+00,-0.89574E+00,-0.89607E+00,-0.89639E+00,
- &-0.89671E+00,-0.89704E+00,-0.89736E+00,-0.89768E+00,-0.89800E+00,
- &-0.89832E+00,-0.89864E+00,-0.89896E+00,-0.89927E+00,-0.89959E+00,
- &-0.89990E+00,-0.90022E+00,-0.90053E+00,-0.90084E+00,-0.90115E+00,
- &-0.90146E+00,-0.90177E+00,-0.90208E+00,-0.90239E+00,-0.90269E+00,
- &-0.90300E+00,-0.90330E+00,-0.90361E+00,-0.90391E+00,-0.90421E+00,
- &-0.90451E+00,-0.90481E+00,-0.90511E+00,-0.90541E+00,-0.90571E+00/
-
- DATA (BNC07M(I),I=401,500)/
- &-0.90601E+00,-0.90631E+00,-0.90660E+00,-0.90690E+00,-0.90719E+00,
- &-0.90748E+00,-0.90778E+00,-0.90807E+00,-0.90836E+00,-0.90865E+00,
- &-0.90894E+00,-0.90923E+00,-0.90952E+00,-0.90980E+00,-0.91009E+00,
- &-0.91038E+00,-0.91066E+00,-0.91095E+00,-0.91123E+00,-0.91151E+00,
- &-0.91179E+00,-0.91207E+00,-0.91236E+00,-0.91263E+00,-0.91291E+00,
- &-0.91319E+00,-0.91347E+00,-0.91375E+00,-0.91402E+00,-0.91430E+00,
- &-0.91457E+00,-0.91485E+00,-0.91512E+00,-0.91539E+00,-0.91567E+00,
- &-0.91594E+00,-0.91621E+00,-0.91648E+00,-0.91675E+00,-0.91702E+00,
- &-0.91728E+00,-0.91755E+00,-0.91782E+00,-0.91808E+00,-0.91835E+00,
- &-0.91861E+00,-0.91888E+00,-0.91914E+00,-0.91940E+00,-0.91967E+00,
- &-0.91993E+00,-0.92019E+00,-0.92045E+00,-0.92071E+00,-0.92097E+00,
- &-0.92123E+00,-0.92148E+00,-0.92174E+00,-0.92200E+00,-0.92225E+00,
- &-0.92251E+00,-0.92276E+00,-0.92302E+00,-0.92327E+00,-0.92352E+00,
- &-0.92378E+00,-0.92403E+00,-0.92428E+00,-0.92453E+00,-0.92478E+00,
- &-0.92503E+00,-0.92528E+00,-0.92552E+00,-0.92577E+00,-0.92602E+00,
- &-0.92627E+00,-0.92651E+00,-0.92676E+00,-0.92700E+00,-0.92725E+00,
- &-0.92749E+00,-0.92773E+00,-0.92798E+00,-0.92822E+00,-0.92846E+00,
- &-0.92870E+00,-0.92894E+00,-0.92918E+00,-0.92942E+00,-0.92966E+00,
- &-0.92990E+00,-0.93013E+00,-0.93037E+00,-0.93061E+00,-0.93084E+00,
- &-0.93108E+00,-0.93131E+00,-0.93155E+00,-0.93178E+00,-0.93202E+00/
-
- DATA (BNC07M(I),I=501,600)/
- &-0.93225E+00,-0.93248E+00,-0.93271E+00,-0.93294E+00,-0.93317E+00,
- &-0.93341E+00,-0.93363E+00,-0.93386E+00,-0.93409E+00,-0.93432E+00,
- &-0.93455E+00,-0.93478E+00,-0.93500E+00,-0.93523E+00,-0.93546E+00,
- &-0.93568E+00,-0.93591E+00,-0.93613E+00,-0.93636E+00,-0.93658E+00,
- &-0.93680E+00,-0.93702E+00,-0.93725E+00,-0.93747E+00,-0.93769E+00,
- &-0.93791E+00,-0.93813E+00,-0.93835E+00,-0.93857E+00,-0.93879E+00,
- &-0.93901E+00,-0.93923E+00,-0.93944E+00,-0.93966E+00,-0.93988E+00,
- &-0.94009E+00,-0.94031E+00,-0.94052E+00,-0.94074E+00,-0.94095E+00,
- &-0.94117E+00,-0.94138E+00,-0.94159E+00,-0.94181E+00,-0.94202E+00,
- &-0.94223E+00,-0.94244E+00,-0.94265E+00,-0.94286E+00,-0.94307E+00,
- &-0.94328E+00,-0.94349E+00,-0.94370E+00,-0.94391E+00,-0.94412E+00,
- &-0.94433E+00,-0.94453E+00,-0.94474E+00,-0.94495E+00,-0.94515E+00,
- &-0.94536E+00,-0.94556E+00,-0.94577E+00,-0.94597E+00,-0.94618E+00,
- &-0.94638E+00,-0.94658E+00,-0.94679E+00,-0.94699E+00,-0.94719E+00,
- &-0.94739E+00,-0.94759E+00,-0.94779E+00,-0.94799E+00,-0.94819E+00,
- &-0.94839E+00,-0.94859E+00,-0.94879E+00,-0.94899E+00,-0.94919E+00,
- &-0.94939E+00,-0.94958E+00,-0.94978E+00,-0.94998E+00,-0.95017E+00,
- &-0.95037E+00,-0.95057E+00,-0.95076E+00,-0.95096E+00,-0.95115E+00,
- &-0.95134E+00,-0.95154E+00,-0.95173E+00,-0.95192E+00,-0.95212E+00,
- &-0.95231E+00,-0.95250E+00,-0.95269E+00,-0.95288E+00,-0.95307E+00/
-
- DATA (BNC07M(I),I=601,700)/
- &-0.95511E+00,-0.95697E+00,-0.95879E+00,-0.96057E+00,-0.96233E+00,
- &-0.96406E+00,-0.96576E+00,-0.96743E+00,-0.96907E+00,-0.97069E+00,
- &-0.97228E+00,-0.97385E+00,-0.97539E+00,-0.97691E+00,-0.97841E+00,
- &-0.97989E+00,-0.98134E+00,-0.98277E+00,-0.98418E+00,-0.98558E+00,
- &-0.98695E+00,-0.98830E+00,-0.98964E+00,-0.99096E+00,-0.99226E+00,
- &-0.99354E+00,-0.99481E+00,-0.99606E+00,-0.99730E+00,-0.99852E+00,
- &-0.99972E+00,-0.10009E+01,-0.10021E+01,-0.10032E+01,-0.10044E+01,
- &-0.10055E+01,-0.10067E+01,-0.10078E+01,-0.10089E+01,-0.10099E+01,
- &-0.10110E+01,-0.10121E+01,-0.10131E+01,-0.10142E+01,-0.10152E+01,
- &-0.10162E+01,-0.10172E+01,-0.10182E+01,-0.10192E+01,-0.10201E+01,
- &-0.10211E+01,-0.10221E+01,-0.10230E+01,-0.10239E+01,-0.10249E+01,
- &-0.10258E+01,-0.10267E+01,-0.10276E+01,-0.10285E+01,-0.10293E+01,
- &-0.10302E+01,-0.10311E+01,-0.10319E+01,-0.10328E+01,-0.10336E+01,
- &-0.10345E+01,-0.10353E+01,-0.10361E+01,-0.10369E+01,-0.10377E+01,
- &-0.10385E+01,-0.10393E+01,-0.10401E+01,-0.10409E+01,-0.10417E+01,
- &-0.10424E+01,-0.10432E+01,-0.10439E+01,-0.10447E+01,-0.10454E+01,
- &-0.10461E+01,-0.10469E+01,-0.10476E+01,-0.10483E+01,-0.10490E+01,
- &-0.10497E+01,-0.10504E+01,-0.10511E+01,-0.10518E+01,-0.10525E+01,
- &-0.10532E+01,-0.10538E+01,-0.10545E+01,-0.10552E+01,-0.10558E+01,
- &-0.10565E+01,-0.10571E+01,-0.10578E+01,-0.10584E+01,-0.10591E+01/
-
- DATA (BNC07M(I),I=701,741)/
- &-0.10597E+01,-0.10603E+01,-0.10609E+01,-0.10616E+01,-0.10622E+01,
- &-0.10628E+01,-0.10634E+01,-0.10640E+01,-0.10646E+01,-0.10652E+01,
- &-0.10658E+01,-0.10663E+01,-0.10669E+01,-0.10675E+01,-0.10681E+01,
- &-0.10687E+01,-0.10692E+01,-0.10698E+01,-0.10703E+01,-0.10709E+01,
- &-0.10714E+01,-0.10720E+01,-0.10725E+01,-0.10731E+01,-0.10736E+01,
- &-0.10742E+01,-0.10747E+01,-0.10752E+01,-0.10757E+01,-0.10763E+01,
- &-0.10768E+01,-0.10773E+01,-0.10778E+01,-0.10783E+01,-0.10788E+01,
- &-0.10793E+01,-0.10798E+01,-0.10803E+01,-0.10808E+01,-0.10813E+01,
- &-0.10818E+01
- & /
-C
-C *** (H,HSO4)
-C
- DATA (BNC08M(I),I=1,100)/
- &-0.43840E-01,-0.87607E-01,-0.10559E+00,-0.11630E+00,-0.12329E+00,
- &-0.12797E+00,-0.13104E+00,-0.13292E+00,-0.13386E+00,-0.13406E+00,
- &-0.13363E+00,-0.13266E+00,-0.13123E+00,-0.12939E+00,-0.12719E+00,
- &-0.12466E+00,-0.12183E+00,-0.11873E+00,-0.11538E+00,-0.11178E+00,
- &-0.10797E+00,-0.10396E+00,-0.99747E-01,-0.95354E-01,-0.90787E-01,
- &-0.86056E-01,-0.81168E-01,-0.76132E-01,-0.70954E-01,-0.65641E-01,
- &-0.60198E-01,-0.54632E-01,-0.48948E-01,-0.43150E-01,-0.37245E-01,
- &-0.31235E-01,-0.25127E-01,-0.18924E-01,-0.12630E-01,-0.62488E-02,
- & 0.21565E-03, 0.67597E-02, 0.13380E-01, 0.20073E-01, 0.26837E-01,
- & 0.33667E-01, 0.40561E-01, 0.47517E-01, 0.54532E-01, 0.61603E-01,
- & 0.68729E-01, 0.75906E-01, 0.83134E-01, 0.90410E-01, 0.97733E-01,
- & 0.10510E+00, 0.11251E+00, 0.11997E+00, 0.12746E+00, 0.13500E+00,
- & 0.14258E+00, 0.15019E+00, 0.15784E+00, 0.16554E+00, 0.17327E+00,
- & 0.18103E+00, 0.18884E+00, 0.19668E+00, 0.20456E+00, 0.21248E+00,
- & 0.22044E+00, 0.22843E+00, 0.23647E+00, 0.24454E+00, 0.25266E+00,
- & 0.26081E+00, 0.26901E+00, 0.27725E+00, 0.28553E+00, 0.29386E+00,
- & 0.30223E+00, 0.31064E+00, 0.31909E+00, 0.32759E+00, 0.33614E+00,
- & 0.34473E+00, 0.35336E+00, 0.36204E+00, 0.37076E+00, 0.37953E+00,
- & 0.38834E+00, 0.39720E+00, 0.40609E+00, 0.41503E+00, 0.42401E+00,
- & 0.43303E+00, 0.44209E+00, 0.45118E+00, 0.46032E+00, 0.46948E+00/
-
- DATA (BNC08M(I),I=101,200)/
- & 0.47869E+00, 0.48792E+00, 0.49718E+00, 0.50648E+00, 0.51580E+00,
- & 0.52515E+00, 0.53452E+00, 0.54391E+00, 0.55333E+00, 0.56276E+00,
- & 0.57221E+00, 0.58168E+00, 0.59116E+00, 0.60066E+00, 0.61016E+00,
- & 0.61968E+00, 0.62920E+00, 0.63872E+00, 0.64826E+00, 0.65779E+00,
- & 0.66733E+00, 0.67687E+00, 0.68641E+00, 0.69595E+00, 0.70548E+00,
- & 0.71501E+00, 0.72454E+00, 0.73406E+00, 0.74357E+00, 0.75308E+00,
- & 0.76258E+00, 0.77207E+00, 0.78155E+00, 0.79102E+00, 0.80048E+00,
- & 0.80993E+00, 0.81936E+00, 0.82879E+00, 0.83820E+00, 0.84760E+00,
- & 0.85698E+00, 0.86635E+00, 0.87571E+00, 0.88505E+00, 0.89438E+00,
- & 0.90369E+00, 0.91298E+00, 0.92226E+00, 0.93153E+00, 0.94078E+00,
- & 0.95001E+00, 0.95923E+00, 0.96843E+00, 0.97761E+00, 0.98678E+00,
- & 0.99593E+00, 0.10051E+01, 0.10142E+01, 0.10233E+01, 0.10324E+01,
- & 0.10414E+01, 0.10505E+01, 0.10595E+01, 0.10685E+01, 0.10775E+01,
- & 0.10865E+01, 0.10954E+01, 0.11044E+01, 0.11133E+01, 0.11222E+01,
- & 0.11311E+01, 0.11399E+01, 0.11488E+01, 0.11576E+01, 0.11664E+01,
- & 0.11752E+01, 0.11840E+01, 0.11928E+01, 0.12015E+01, 0.12102E+01,
- & 0.12190E+01, 0.12276E+01, 0.12363E+01, 0.12450E+01, 0.12536E+01,
- & 0.12622E+01, 0.12708E+01, 0.12794E+01, 0.12879E+01, 0.12965E+01,
- & 0.13050E+01, 0.13135E+01, 0.13220E+01, 0.13305E+01, 0.13389E+01,
- & 0.13474E+01, 0.13558E+01, 0.13642E+01, 0.13726E+01, 0.13809E+01/
-
- DATA (BNC08M(I),I=201,300)/
- & 0.13893E+01, 0.13976E+01, 0.14059E+01, 0.14142E+01, 0.14225E+01,
- & 0.14307E+01, 0.14390E+01, 0.14472E+01, 0.14554E+01, 0.14636E+01,
- & 0.14718E+01, 0.14799E+01, 0.14881E+01, 0.14962E+01, 0.15043E+01,
- & 0.15124E+01, 0.15204E+01, 0.15285E+01, 0.15365E+01, 0.15445E+01,
- & 0.15525E+01, 0.15605E+01, 0.15685E+01, 0.15764E+01, 0.15843E+01,
- & 0.15923E+01, 0.16002E+01, 0.16080E+01, 0.16159E+01, 0.16237E+01,
- & 0.16316E+01, 0.16394E+01, 0.16472E+01, 0.16550E+01, 0.16627E+01,
- & 0.16705E+01, 0.16782E+01, 0.16859E+01, 0.16936E+01, 0.17013E+01,
- & 0.17090E+01, 0.17166E+01, 0.17243E+01, 0.17319E+01, 0.17395E+01,
- & 0.17471E+01, 0.17547E+01, 0.17622E+01, 0.17698E+01, 0.17773E+01,
- & 0.17848E+01, 0.17923E+01, 0.17998E+01, 0.18072E+01, 0.18147E+01,
- & 0.18221E+01, 0.18295E+01, 0.18369E+01, 0.18443E+01, 0.18517E+01,
- & 0.18591E+01, 0.18664E+01, 0.18737E+01, 0.18811E+01, 0.18884E+01,
- & 0.18956E+01, 0.19029E+01, 0.19102E+01, 0.19174E+01, 0.19246E+01,
- & 0.19318E+01, 0.19390E+01, 0.19462E+01, 0.19534E+01, 0.19605E+01,
- & 0.19677E+01, 0.19748E+01, 0.19819E+01, 0.19890E+01, 0.19961E+01,
- & 0.20032E+01, 0.20102E+01, 0.20173E+01, 0.20243E+01, 0.20313E+01,
- & 0.20383E+01, 0.20453E+01, 0.20523E+01, 0.20592E+01, 0.20662E+01,
- & 0.20731E+01, 0.20800E+01, 0.20869E+01, 0.20938E+01, 0.21007E+01,
- & 0.21075E+01, 0.21144E+01, 0.21212E+01, 0.21281E+01, 0.21349E+01/
-
- DATA (BNC08M(I),I=301,400)/
- & 0.21417E+01, 0.21485E+01, 0.21552E+01, 0.21620E+01, 0.21687E+01,
- & 0.21755E+01, 0.21822E+01, 0.21889E+01, 0.21956E+01, 0.22023E+01,
- & 0.22089E+01, 0.22156E+01, 0.22222E+01, 0.22289E+01, 0.22355E+01,
- & 0.22421E+01, 0.22487E+01, 0.22553E+01, 0.22619E+01, 0.22684E+01,
- & 0.22750E+01, 0.22815E+01, 0.22880E+01, 0.22945E+01, 0.23010E+01,
- & 0.23075E+01, 0.23140E+01, 0.23205E+01, 0.23269E+01, 0.23333E+01,
- & 0.23398E+01, 0.23462E+01, 0.23526E+01, 0.23590E+01, 0.23654E+01,
- & 0.23717E+01, 0.23781E+01, 0.23844E+01, 0.23908E+01, 0.23971E+01,
- & 0.24034E+01, 0.24097E+01, 0.24160E+01, 0.24223E+01, 0.24285E+01,
- & 0.24348E+01, 0.24410E+01, 0.24473E+01, 0.24535E+01, 0.24597E+01,
- & 0.24659E+01, 0.24721E+01, 0.24783E+01, 0.24844E+01, 0.24906E+01,
- & 0.24967E+01, 0.25029E+01, 0.25090E+01, 0.25151E+01, 0.25212E+01,
- & 0.25273E+01, 0.25334E+01, 0.25395E+01, 0.25455E+01, 0.25516E+01,
- & 0.25576E+01, 0.25636E+01, 0.25697E+01, 0.25757E+01, 0.25817E+01,
- & 0.25877E+01, 0.25936E+01, 0.25996E+01, 0.26056E+01, 0.26115E+01,
- & 0.26174E+01, 0.26234E+01, 0.26293E+01, 0.26352E+01, 0.26411E+01,
- & 0.26470E+01, 0.26529E+01, 0.26587E+01, 0.26646E+01, 0.26704E+01,
- & 0.26763E+01, 0.26821E+01, 0.26879E+01, 0.26937E+01, 0.26995E+01,
- & 0.27053E+01, 0.27111E+01, 0.27169E+01, 0.27226E+01, 0.27284E+01,
- & 0.27341E+01, 0.27398E+01, 0.27456E+01, 0.27513E+01, 0.27570E+01/
-
- DATA (BNC08M(I),I=401,500)/
- & 0.27627E+01, 0.27684E+01, 0.27740E+01, 0.27797E+01, 0.27854E+01,
- & 0.27910E+01, 0.27967E+01, 0.28023E+01, 0.28079E+01, 0.28135E+01,
- & 0.28191E+01, 0.28247E+01, 0.28303E+01, 0.28359E+01, 0.28415E+01,
- & 0.28470E+01, 0.28526E+01, 0.28581E+01, 0.28636E+01, 0.28692E+01,
- & 0.28747E+01, 0.28802E+01, 0.28857E+01, 0.28912E+01, 0.28966E+01,
- & 0.29021E+01, 0.29076E+01, 0.29130E+01, 0.29185E+01, 0.29239E+01,
- & 0.29293E+01, 0.29348E+01, 0.29402E+01, 0.29456E+01, 0.29510E+01,
- & 0.29564E+01, 0.29617E+01, 0.29671E+01, 0.29725E+01, 0.29778E+01,
- & 0.29832E+01, 0.29885E+01, 0.29938E+01, 0.29992E+01, 0.30045E+01,
- & 0.30098E+01, 0.30151E+01, 0.30204E+01, 0.30256E+01, 0.30309E+01,
- & 0.30362E+01, 0.30414E+01, 0.30467E+01, 0.30519E+01, 0.30572E+01,
- & 0.30624E+01, 0.30676E+01, 0.30728E+01, 0.30780E+01, 0.30832E+01,
- & 0.30884E+01, 0.30936E+01, 0.30987E+01, 0.31039E+01, 0.31091E+01,
- & 0.31142E+01, 0.31193E+01, 0.31245E+01, 0.31296E+01, 0.31347E+01,
- & 0.31398E+01, 0.31449E+01, 0.31500E+01, 0.31551E+01, 0.31602E+01,
- & 0.31653E+01, 0.31703E+01, 0.31754E+01, 0.31804E+01, 0.31855E+01,
- & 0.31905E+01, 0.31955E+01, 0.32006E+01, 0.32056E+01, 0.32106E+01,
- & 0.32156E+01, 0.32206E+01, 0.32256E+01, 0.32305E+01, 0.32355E+01,
- & 0.32405E+01, 0.32454E+01, 0.32504E+01, 0.32553E+01, 0.32603E+01,
- & 0.32652E+01, 0.32701E+01, 0.32750E+01, 0.32799E+01, 0.32848E+01/
-
- DATA (BNC08M(I),I=501,600)/
- & 0.32897E+01, 0.32946E+01, 0.32995E+01, 0.33044E+01, 0.33092E+01,
- & 0.33141E+01, 0.33189E+01, 0.33238E+01, 0.33286E+01, 0.33335E+01,
- & 0.33383E+01, 0.33431E+01, 0.33479E+01, 0.33527E+01, 0.33575E+01,
- & 0.33623E+01, 0.33671E+01, 0.33719E+01, 0.33766E+01, 0.33814E+01,
- & 0.33862E+01, 0.33909E+01, 0.33957E+01, 0.34004E+01, 0.34051E+01,
- & 0.34099E+01, 0.34146E+01, 0.34193E+01, 0.34240E+01, 0.34287E+01,
- & 0.34334E+01, 0.34381E+01, 0.34428E+01, 0.34475E+01, 0.34521E+01,
- & 0.34568E+01, 0.34615E+01, 0.34661E+01, 0.34707E+01, 0.34754E+01,
- & 0.34800E+01, 0.34846E+01, 0.34893E+01, 0.34939E+01, 0.34985E+01,
- & 0.35031E+01, 0.35077E+01, 0.35123E+01, 0.35169E+01, 0.35214E+01,
- & 0.35260E+01, 0.35306E+01, 0.35351E+01, 0.35397E+01, 0.35442E+01,
- & 0.35488E+01, 0.35533E+01, 0.35578E+01, 0.35624E+01, 0.35669E+01,
- & 0.35714E+01, 0.35759E+01, 0.35804E+01, 0.35849E+01, 0.35894E+01,
- & 0.35939E+01, 0.35983E+01, 0.36028E+01, 0.36073E+01, 0.36117E+01,
- & 0.36162E+01, 0.36206E+01, 0.36251E+01, 0.36295E+01, 0.36340E+01,
- & 0.36384E+01, 0.36428E+01, 0.36472E+01, 0.36516E+01, 0.36560E+01,
- & 0.36604E+01, 0.36648E+01, 0.36692E+01, 0.36736E+01, 0.36780E+01,
- & 0.36823E+01, 0.36867E+01, 0.36910E+01, 0.36954E+01, 0.36997E+01,
- & 0.37041E+01, 0.37084E+01, 0.37128E+01, 0.37171E+01, 0.37214E+01,
- & 0.37257E+01, 0.37300E+01, 0.37343E+01, 0.37386E+01, 0.37429E+01/
-
- DATA (BNC08M(I),I=601,700)/
- & 0.37890E+01, 0.38311E+01, 0.38727E+01, 0.39138E+01, 0.39544E+01,
- & 0.39945E+01, 0.40342E+01, 0.40734E+01, 0.41122E+01, 0.41506E+01,
- & 0.41885E+01, 0.42261E+01, 0.42632E+01, 0.42999E+01, 0.43363E+01,
- & 0.43722E+01, 0.44079E+01, 0.44431E+01, 0.44780E+01, 0.45125E+01,
- & 0.45467E+01, 0.45806E+01, 0.46141E+01, 0.46473E+01, 0.46802E+01,
- & 0.47128E+01, 0.47451E+01, 0.47771E+01, 0.48088E+01, 0.48402E+01,
- & 0.48713E+01, 0.49022E+01, 0.49327E+01, 0.49630E+01, 0.49931E+01,
- & 0.50229E+01, 0.50524E+01, 0.50817E+01, 0.51107E+01, 0.51395E+01,
- & 0.51681E+01, 0.51964E+01, 0.52245E+01, 0.52524E+01, 0.52800E+01,
- & 0.53074E+01, 0.53346E+01, 0.53616E+01, 0.53884E+01, 0.54150E+01,
- & 0.54414E+01, 0.54676E+01, 0.54936E+01, 0.55194E+01, 0.55450E+01,
- & 0.55704E+01, 0.55956E+01, 0.56206E+01, 0.56455E+01, 0.56702E+01,
- & 0.56947E+01, 0.57191E+01, 0.57432E+01, 0.57672E+01, 0.57911E+01,
- & 0.58148E+01, 0.58383E+01, 0.58616E+01, 0.58848E+01, 0.59079E+01,
- & 0.59308E+01, 0.59535E+01, 0.59761E+01, 0.59986E+01, 0.60209E+01,
- & 0.60430E+01, 0.60650E+01, 0.60869E+01, 0.61087E+01, 0.61303E+01,
- & 0.61517E+01, 0.61731E+01, 0.61943E+01, 0.62154E+01, 0.62363E+01,
- & 0.62572E+01, 0.62779E+01, 0.62984E+01, 0.63189E+01, 0.63392E+01,
- & 0.63595E+01, 0.63796E+01, 0.63996E+01, 0.64194E+01, 0.64392E+01,
- & 0.64588E+01, 0.64784E+01, 0.64978E+01, 0.65171E+01, 0.65363E+01/
-
- DATA (BNC08M(I),I=701,741)/
- & 0.65554E+01, 0.65744E+01, 0.65933E+01, 0.66121E+01, 0.66308E+01,
- & 0.66494E+01, 0.66679E+01, 0.66863E+01, 0.67046E+01, 0.67228E+01,
- & 0.67409E+01, 0.67589E+01, 0.67768E+01, 0.67947E+01, 0.68124E+01,
- & 0.68300E+01, 0.68476E+01, 0.68651E+01, 0.68824E+01, 0.68997E+01,
- & 0.69169E+01, 0.69341E+01, 0.69511E+01, 0.69680E+01, 0.69849E+01,
- & 0.70017E+01, 0.70184E+01, 0.70350E+01, 0.70516E+01, 0.70681E+01,
- & 0.70845E+01, 0.71008E+01, 0.71170E+01, 0.71332E+01, 0.71493E+01,
- & 0.71653E+01, 0.71812E+01, 0.71971E+01, 0.72129E+01, 0.72286E+01,
- & 0.72442E+01
- & /
-C
-C *** NH4HSO4
-C
- DATA (BNC09M(I),I=1,100)/
- &-0.45695E-01,-0.97041E-01,-0.12160E+00,-0.13842E+00,-0.15124E+00,
- &-0.16156E+00,-0.17015E+00,-0.17746E+00,-0.18378E+00,-0.18930E+00,
- &-0.19417E+00,-0.19849E+00,-0.20233E+00,-0.20577E+00,-0.20884E+00,
- &-0.21160E+00,-0.21406E+00,-0.21627E+00,-0.21823E+00,-0.21998E+00,
- &-0.22152E+00,-0.22288E+00,-0.22406E+00,-0.22508E+00,-0.22594E+00,
- &-0.22665E+00,-0.22723E+00,-0.22768E+00,-0.22800E+00,-0.22821E+00,
- &-0.22830E+00,-0.22828E+00,-0.22816E+00,-0.22794E+00,-0.22763E+00,
- &-0.22722E+00,-0.22673E+00,-0.22615E+00,-0.22549E+00,-0.22475E+00,
- &-0.22394E+00,-0.22305E+00,-0.22210E+00,-0.22108E+00,-0.21999E+00,
- &-0.21884E+00,-0.21763E+00,-0.21636E+00,-0.21503E+00,-0.21366E+00,
- &-0.21222E+00,-0.21074E+00,-0.20921E+00,-0.20763E+00,-0.20601E+00,
- &-0.20434E+00,-0.20263E+00,-0.20087E+00,-0.19908E+00,-0.19725E+00,
- &-0.19538E+00,-0.19347E+00,-0.19153E+00,-0.18955E+00,-0.18754E+00,
- &-0.18550E+00,-0.18342E+00,-0.18132E+00,-0.17918E+00,-0.17701E+00,
- &-0.17481E+00,-0.17258E+00,-0.17032E+00,-0.16804E+00,-0.16572E+00,
- &-0.16338E+00,-0.16101E+00,-0.15861E+00,-0.15619E+00,-0.15374E+00,
- &-0.15127E+00,-0.14877E+00,-0.14624E+00,-0.14369E+00,-0.14111E+00,
- &-0.13851E+00,-0.13588E+00,-0.13323E+00,-0.13056E+00,-0.12786E+00,
- &-0.12514E+00,-0.12240E+00,-0.11964E+00,-0.11686E+00,-0.11405E+00,
- &-0.11123E+00,-0.10839E+00,-0.10552E+00,-0.10264E+00,-0.99745E-01/
-
- DATA (BNC09M(I),I=101,200)/
- &-0.96831E-01,-0.93900E-01,-0.90954E-01,-0.87994E-01,-0.85020E-01,
- &-0.82033E-01,-0.79033E-01,-0.76023E-01,-0.73001E-01,-0.69969E-01,
- &-0.66929E-01,-0.63879E-01,-0.60822E-01,-0.57758E-01,-0.54687E-01,
- &-0.51611E-01,-0.48530E-01,-0.45444E-01,-0.42354E-01,-0.39261E-01,
- &-0.36165E-01,-0.33068E-01,-0.29968E-01,-0.26868E-01,-0.23766E-01,
- &-0.20665E-01,-0.17564E-01,-0.14463E-01,-0.11364E-01,-0.82653E-02,
- &-0.51688E-02,-0.20741E-02, 0.10182E-02, 0.41078E-02, 0.71947E-02,
- & 0.10278E-01, 0.13359E-01, 0.16436E-01, 0.19509E-01, 0.22578E-01,
- & 0.25643E-01, 0.28705E-01, 0.31761E-01, 0.34813E-01, 0.37861E-01,
- & 0.40903E-01, 0.43941E-01, 0.46974E-01, 0.50001E-01, 0.53024E-01,
- & 0.56041E-01, 0.59053E-01, 0.62059E-01, 0.65060E-01, 0.68056E-01,
- & 0.71045E-01, 0.74030E-01, 0.77008E-01, 0.79981E-01, 0.82948E-01,
- & 0.85909E-01, 0.88864E-01, 0.91813E-01, 0.94757E-01, 0.97694E-01,
- & 0.10063E+00, 0.10355E+00, 0.10647E+00, 0.10938E+00, 0.11229E+00,
- & 0.11519E+00, 0.11809E+00, 0.12098E+00, 0.12386E+00, 0.12674E+00,
- & 0.12961E+00, 0.13247E+00, 0.13533E+00, 0.13818E+00, 0.14103E+00,
- & 0.14387E+00, 0.14670E+00, 0.14953E+00, 0.15235E+00, 0.15517E+00,
- & 0.15798E+00, 0.16078E+00, 0.16358E+00, 0.16637E+00, 0.16915E+00,
- & 0.17193E+00, 0.17470E+00, 0.17747E+00, 0.18023E+00, 0.18299E+00,
- & 0.18573E+00, 0.18848E+00, 0.19121E+00, 0.19394E+00, 0.19667E+00/
-
- DATA (BNC09M(I),I=201,300)/
- & 0.19939E+00, 0.20210E+00, 0.20480E+00, 0.20751E+00, 0.21020E+00,
- & 0.21289E+00, 0.21557E+00, 0.21825E+00, 0.22092E+00, 0.22358E+00,
- & 0.22624E+00, 0.22890E+00, 0.23154E+00, 0.23419E+00, 0.23682E+00,
- & 0.23945E+00, 0.24208E+00, 0.24470E+00, 0.24731E+00, 0.24992E+00,
- & 0.25252E+00, 0.25512E+00, 0.25771E+00, 0.26029E+00, 0.26287E+00,
- & 0.26545E+00, 0.26802E+00, 0.27058E+00, 0.27314E+00, 0.27569E+00,
- & 0.27824E+00, 0.28078E+00, 0.28331E+00, 0.28584E+00, 0.28837E+00,
- & 0.29089E+00, 0.29340E+00, 0.29591E+00, 0.29841E+00, 0.30091E+00,
- & 0.30341E+00, 0.30589E+00, 0.30838E+00, 0.31086E+00, 0.31333E+00,
- & 0.31580E+00, 0.31826E+00, 0.32071E+00, 0.32317E+00, 0.32561E+00,
- & 0.32806E+00, 0.33049E+00, 0.33292E+00, 0.33535E+00, 0.33777E+00,
- & 0.34019E+00, 0.34260E+00, 0.34501E+00, 0.34741E+00, 0.34981E+00,
- & 0.35220E+00, 0.35459E+00, 0.35697E+00, 0.35935E+00, 0.36172E+00,
- & 0.36409E+00, 0.36645E+00, 0.36881E+00, 0.37117E+00, 0.37352E+00,
- & 0.37586E+00, 0.37820E+00, 0.38054E+00, 0.38287E+00, 0.38520E+00,
- & 0.38752E+00, 0.38983E+00, 0.39215E+00, 0.39446E+00, 0.39676E+00,
- & 0.39906E+00, 0.40135E+00, 0.40364E+00, 0.40593E+00, 0.40821E+00,
- & 0.41049E+00, 0.41276E+00, 0.41503E+00, 0.41729E+00, 0.41955E+00,
- & 0.42181E+00, 0.42406E+00, 0.42631E+00, 0.42855E+00, 0.43079E+00,
- & 0.43302E+00, 0.43525E+00, 0.43747E+00, 0.43970E+00, 0.44191E+00/
-
- DATA (BNC09M(I),I=301,400)/
- & 0.44413E+00, 0.44633E+00, 0.44854E+00, 0.45074E+00, 0.45294E+00,
- & 0.45513E+00, 0.45732E+00, 0.45950E+00, 0.46168E+00, 0.46386E+00,
- & 0.46603E+00, 0.46820E+00, 0.47036E+00, 0.47252E+00, 0.47468E+00,
- & 0.47683E+00, 0.47898E+00, 0.48113E+00, 0.48327E+00, 0.48540E+00,
- & 0.48754E+00, 0.48967E+00, 0.49179E+00, 0.49391E+00, 0.49603E+00,
- & 0.49814E+00, 0.50025E+00, 0.50236E+00, 0.50446E+00, 0.50656E+00,
- & 0.50866E+00, 0.51075E+00, 0.51284E+00, 0.51492E+00, 0.51700E+00,
- & 0.51908E+00, 0.52115E+00, 0.52322E+00, 0.52529E+00, 0.52735E+00,
- & 0.52941E+00, 0.53146E+00, 0.53352E+00, 0.53556E+00, 0.53761E+00,
- & 0.53965E+00, 0.54169E+00, 0.54372E+00, 0.54575E+00, 0.54778E+00,
- & 0.54980E+00, 0.55182E+00, 0.55384E+00, 0.55585E+00, 0.55786E+00,
- & 0.55987E+00, 0.56187E+00, 0.56387E+00, 0.56587E+00, 0.56786E+00,
- & 0.56985E+00, 0.57184E+00, 0.57382E+00, 0.57580E+00, 0.57778E+00,
- & 0.57975E+00, 0.58172E+00, 0.58369E+00, 0.58565E+00, 0.58761E+00,
- & 0.58957E+00, 0.59152E+00, 0.59348E+00, 0.59542E+00, 0.59737E+00,
- & 0.59931E+00, 0.60125E+00, 0.60318E+00, 0.60511E+00, 0.60704E+00,
- & 0.60897E+00, 0.61089E+00, 0.61281E+00, 0.61472E+00, 0.61664E+00,
- & 0.61855E+00, 0.62045E+00, 0.62236E+00, 0.62426E+00, 0.62616E+00,
- & 0.62805E+00, 0.62994E+00, 0.63183E+00, 0.63372E+00, 0.63560E+00,
- & 0.63748E+00, 0.63936E+00, 0.64123E+00, 0.64310E+00, 0.64497E+00/
-
- DATA (BNC09M(I),I=401,500)/
- & 0.64683E+00, 0.64870E+00, 0.65056E+00, 0.65241E+00, 0.65427E+00,
- & 0.65612E+00, 0.65796E+00, 0.65981E+00, 0.66165E+00, 0.66349E+00,
- & 0.66533E+00, 0.66716E+00, 0.66899E+00, 0.67082E+00, 0.67264E+00,
- & 0.67447E+00, 0.67629E+00, 0.67810E+00, 0.67992E+00, 0.68173E+00,
- & 0.68354E+00, 0.68534E+00, 0.68715E+00, 0.68895E+00, 0.69074E+00,
- & 0.69254E+00, 0.69433E+00, 0.69612E+00, 0.69791E+00, 0.69969E+00,
- & 0.70147E+00, 0.70325E+00, 0.70503E+00, 0.70680E+00, 0.70857E+00,
- & 0.71034E+00, 0.71211E+00, 0.71387E+00, 0.71563E+00, 0.71739E+00,
- & 0.71915E+00, 0.72090E+00, 0.72265E+00, 0.72440E+00, 0.72614E+00,
- & 0.72788E+00, 0.72962E+00, 0.73136E+00, 0.73310E+00, 0.73483E+00,
- & 0.73656E+00, 0.73829E+00, 0.74001E+00, 0.74174E+00, 0.74346E+00,
- & 0.74517E+00, 0.74689E+00, 0.74860E+00, 0.75031E+00, 0.75202E+00,
- & 0.75372E+00, 0.75543E+00, 0.75713E+00, 0.75883E+00, 0.76052E+00,
- & 0.76222E+00, 0.76391E+00, 0.76559E+00, 0.76728E+00, 0.76896E+00,
- & 0.77065E+00, 0.77233E+00, 0.77400E+00, 0.77568E+00, 0.77735E+00,
- & 0.77902E+00, 0.78069E+00, 0.78235E+00, 0.78401E+00, 0.78567E+00,
- & 0.78733E+00, 0.78899E+00, 0.79064E+00, 0.79229E+00, 0.79394E+00,
- & 0.79559E+00, 0.79723E+00, 0.79888E+00, 0.80052E+00, 0.80215E+00,
- & 0.80379E+00, 0.80542E+00, 0.80705E+00, 0.80868E+00, 0.81031E+00,
- & 0.81193E+00, 0.81356E+00, 0.81518E+00, 0.81679E+00, 0.81841E+00/
-
- DATA (BNC09M(I),I=501,600)/
- & 0.82002E+00, 0.82163E+00, 0.82324E+00, 0.82485E+00, 0.82646E+00,
- & 0.82806E+00, 0.82966E+00, 0.83126E+00, 0.83285E+00, 0.83445E+00,
- & 0.83604E+00, 0.83763E+00, 0.83922E+00, 0.84080E+00, 0.84239E+00,
- & 0.84397E+00, 0.84555E+00, 0.84713E+00, 0.84870E+00, 0.85028E+00,
- & 0.85185E+00, 0.85342E+00, 0.85498E+00, 0.85655E+00, 0.85811E+00,
- & 0.85967E+00, 0.86123E+00, 0.86279E+00, 0.86434E+00, 0.86590E+00,
- & 0.86745E+00, 0.86900E+00, 0.87054E+00, 0.87209E+00, 0.87363E+00,
- & 0.87517E+00, 0.87671E+00, 0.87825E+00, 0.87978E+00, 0.88132E+00,
- & 0.88285E+00, 0.88438E+00, 0.88590E+00, 0.88743E+00, 0.88895E+00,
- & 0.89047E+00, 0.89199E+00, 0.89351E+00, 0.89503E+00, 0.89654E+00,
- & 0.89805E+00, 0.89956E+00, 0.90107E+00, 0.90258E+00, 0.90408E+00,
- & 0.90558E+00, 0.90709E+00, 0.90858E+00, 0.91008E+00, 0.91158E+00,
- & 0.91307E+00, 0.91456E+00, 0.91605E+00, 0.91754E+00, 0.91902E+00,
- & 0.92051E+00, 0.92199E+00, 0.92347E+00, 0.92495E+00, 0.92642E+00,
- & 0.92790E+00, 0.92937E+00, 0.93084E+00, 0.93231E+00, 0.93378E+00,
- & 0.93525E+00, 0.93671E+00, 0.93817E+00, 0.93963E+00, 0.94109E+00,
- & 0.94255E+00, 0.94400E+00, 0.94546E+00, 0.94691E+00, 0.94836E+00,
- & 0.94981E+00, 0.95125E+00, 0.95270E+00, 0.95414E+00, 0.95558E+00,
- & 0.95702E+00, 0.95846E+00, 0.95990E+00, 0.96133E+00, 0.96276E+00,
- & 0.96419E+00, 0.96562E+00, 0.96705E+00, 0.96848E+00, 0.96990E+00/
-
- DATA (BNC09M(I),I=601,700)/
- & 0.98518E+00, 0.99915E+00, 0.10130E+01, 0.10266E+01, 0.10401E+01,
- & 0.10535E+01, 0.10667E+01, 0.10797E+01, 0.10927E+01, 0.11054E+01,
- & 0.11181E+01, 0.11306E+01, 0.11430E+01, 0.11553E+01, 0.11674E+01,
- & 0.11794E+01, 0.11913E+01, 0.12031E+01, 0.12148E+01, 0.12263E+01,
- & 0.12378E+01, 0.12491E+01, 0.12604E+01, 0.12715E+01, 0.12825E+01,
- & 0.12934E+01, 0.13043E+01, 0.13150E+01, 0.13257E+01, 0.13362E+01,
- & 0.13467E+01, 0.13570E+01, 0.13673E+01, 0.13775E+01, 0.13876E+01,
- & 0.13976E+01, 0.14075E+01, 0.14174E+01, 0.14272E+01, 0.14369E+01,
- & 0.14465E+01, 0.14560E+01, 0.14655E+01, 0.14749E+01, 0.14842E+01,
- & 0.14935E+01, 0.15027E+01, 0.15118E+01, 0.15208E+01, 0.15298E+01,
- & 0.15387E+01, 0.15476E+01, 0.15563E+01, 0.15651E+01, 0.15737E+01,
- & 0.15823E+01, 0.15908E+01, 0.15993E+01, 0.16077E+01, 0.16161E+01,
- & 0.16244E+01, 0.16326E+01, 0.16408E+01, 0.16489E+01, 0.16570E+01,
- & 0.16650E+01, 0.16730E+01, 0.16809E+01, 0.16888E+01, 0.16966E+01,
- & 0.17044E+01, 0.17121E+01, 0.17197E+01, 0.17274E+01, 0.17349E+01,
- & 0.17424E+01, 0.17499E+01, 0.17574E+01, 0.17647E+01, 0.17721E+01,
- & 0.17794E+01, 0.17866E+01, 0.17938E+01, 0.18010E+01, 0.18081E+01,
- & 0.18152E+01, 0.18222E+01, 0.18292E+01, 0.18362E+01, 0.18431E+01,
- & 0.18500E+01, 0.18568E+01, 0.18636E+01, 0.18704E+01, 0.18771E+01,
- & 0.18838E+01, 0.18905E+01, 0.18971E+01, 0.19037E+01, 0.19102E+01/
-
- DATA (BNC09M(I),I=701,741)/
- & 0.19167E+01, 0.19232E+01, 0.19296E+01, 0.19360E+01, 0.19424E+01,
- & 0.19488E+01, 0.19551E+01, 0.19613E+01, 0.19676E+01, 0.19738E+01,
- & 0.19800E+01, 0.19861E+01, 0.19922E+01, 0.19983E+01, 0.20044E+01,
- & 0.20104E+01, 0.20164E+01, 0.20223E+01, 0.20283E+01, 0.20342E+01,
- & 0.20401E+01, 0.20459E+01, 0.20517E+01, 0.20575E+01, 0.20633E+01,
- & 0.20690E+01, 0.20747E+01, 0.20804E+01, 0.20861E+01, 0.20917E+01,
- & 0.20973E+01, 0.21029E+01, 0.21084E+01, 0.21140E+01, 0.21195E+01,
- & 0.21249E+01, 0.21304E+01, 0.21358E+01, 0.21412E+01, 0.21466E+01,
- & 0.21520E+01
- & /
-C
-C *** (H,NO3)
-C
- DATA (BNC10M(I),I=1,100)/
- &-0.45175E-01,-0.93795E-01,-0.11560E+00,-0.12968E+00,-0.13980E+00,
- &-0.14745E+00,-0.15341E+00,-0.15813E+00,-0.16190E+00,-0.16492E+00,
- &-0.16733E+00,-0.16923E+00,-0.17072E+00,-0.17184E+00,-0.17265E+00,
- &-0.17319E+00,-0.17350E+00,-0.17360E+00,-0.17351E+00,-0.17326E+00,
- &-0.17286E+00,-0.17233E+00,-0.17167E+00,-0.17091E+00,-0.17006E+00,
- &-0.16911E+00,-0.16808E+00,-0.16698E+00,-0.16581E+00,-0.16458E+00,
- &-0.16330E+00,-0.16196E+00,-0.16057E+00,-0.15915E+00,-0.15768E+00,
- &-0.15618E+00,-0.15465E+00,-0.15309E+00,-0.15150E+00,-0.14989E+00,
- &-0.14825E+00,-0.14660E+00,-0.14492E+00,-0.14323E+00,-0.14152E+00,
- &-0.13980E+00,-0.13807E+00,-0.13633E+00,-0.13457E+00,-0.13281E+00,
- &-0.13104E+00,-0.12926E+00,-0.12747E+00,-0.12567E+00,-0.12387E+00,
- &-0.12206E+00,-0.12025E+00,-0.11843E+00,-0.11660E+00,-0.11477E+00,
- &-0.11294E+00,-0.11109E+00,-0.10924E+00,-0.10739E+00,-0.10552E+00,
- &-0.10365E+00,-0.10178E+00,-0.99891E-01,-0.97998E-01,-0.96096E-01,
- &-0.94186E-01,-0.92266E-01,-0.90336E-01,-0.88396E-01,-0.86445E-01,
- &-0.84484E-01,-0.82510E-01,-0.80525E-01,-0.78527E-01,-0.76516E-01,
- &-0.74493E-01,-0.72456E-01,-0.70405E-01,-0.68341E-01,-0.66263E-01,
- &-0.64170E-01,-0.62063E-01,-0.59942E-01,-0.57806E-01,-0.55656E-01,
- &-0.53491E-01,-0.51312E-01,-0.49119E-01,-0.46912E-01,-0.44691E-01,
- &-0.42457E-01,-0.40209E-01,-0.37948E-01,-0.35675E-01,-0.33389E-01/
-
- DATA (BNC10M(I),I=101,200)/
- &-0.31092E-01,-0.28783E-01,-0.26463E-01,-0.24132E-01,-0.21791E-01,
- &-0.19441E-01,-0.17081E-01,-0.14713E-01,-0.12336E-01,-0.99517E-02,
- &-0.75599E-02,-0.51613E-02,-0.27563E-02,-0.34542E-03, 0.20709E-02,
- & 0.44922E-02, 0.69181E-02, 0.93482E-02, 0.11782E-01, 0.14219E-01,
- & 0.16659E-01, 0.19102E-01, 0.21548E-01, 0.23995E-01, 0.26444E-01,
- & 0.28894E-01, 0.31345E-01, 0.33797E-01, 0.36250E-01, 0.38703E-01,
- & 0.41157E-01, 0.43610E-01, 0.46063E-01, 0.48516E-01, 0.50968E-01,
- & 0.53419E-01, 0.55870E-01, 0.58319E-01, 0.60768E-01, 0.63215E-01,
- & 0.65661E-01, 0.68105E-01, 0.70548E-01, 0.72990E-01, 0.75429E-01,
- & 0.77867E-01, 0.80303E-01, 0.82737E-01, 0.85169E-01, 0.87599E-01,
- & 0.90027E-01, 0.92453E-01, 0.94877E-01, 0.97298E-01, 0.99718E-01,
- & 0.10213E+00, 0.10455E+00, 0.10696E+00, 0.10937E+00, 0.11178E+00,
- & 0.11418E+00, 0.11659E+00, 0.11899E+00, 0.12138E+00, 0.12378E+00,
- & 0.12617E+00, 0.12856E+00, 0.13095E+00, 0.13333E+00, 0.13571E+00,
- & 0.13809E+00, 0.14047E+00, 0.14284E+00, 0.14521E+00, 0.14758E+00,
- & 0.14995E+00, 0.15231E+00, 0.15467E+00, 0.15702E+00, 0.15938E+00,
- & 0.16173E+00, 0.16408E+00, 0.16642E+00, 0.16876E+00, 0.17110E+00,
- & 0.17344E+00, 0.17577E+00, 0.17810E+00, 0.18043E+00, 0.18275E+00,
- & 0.18508E+00, 0.18739E+00, 0.18971E+00, 0.19202E+00, 0.19433E+00,
- & 0.19664E+00, 0.19894E+00, 0.20124E+00, 0.20354E+00, 0.20583E+00/
-
- DATA (BNC10M(I),I=201,300)/
- & 0.20812E+00, 0.21041E+00, 0.21269E+00, 0.21497E+00, 0.21725E+00,
- & 0.21953E+00, 0.22180E+00, 0.22407E+00, 0.22633E+00, 0.22860E+00,
- & 0.23086E+00, 0.23311E+00, 0.23537E+00, 0.23762E+00, 0.23986E+00,
- & 0.24211E+00, 0.24435E+00, 0.24658E+00, 0.24882E+00, 0.25105E+00,
- & 0.25328E+00, 0.25550E+00, 0.25772E+00, 0.25994E+00, 0.26216E+00,
- & 0.26437E+00, 0.26658E+00, 0.26878E+00, 0.27099E+00, 0.27319E+00,
- & 0.27538E+00, 0.27757E+00, 0.27976E+00, 0.28195E+00, 0.28413E+00,
- & 0.28631E+00, 0.28849E+00, 0.29066E+00, 0.29284E+00, 0.29500E+00,
- & 0.29717E+00, 0.29933E+00, 0.30149E+00, 0.30364E+00, 0.30579E+00,
- & 0.30794E+00, 0.31009E+00, 0.31223E+00, 0.31437E+00, 0.31650E+00,
- & 0.31864E+00, 0.32077E+00, 0.32289E+00, 0.32501E+00, 0.32713E+00,
- & 0.32925E+00, 0.33137E+00, 0.33348E+00, 0.33558E+00, 0.33769E+00,
- & 0.33979E+00, 0.34189E+00, 0.34398E+00, 0.34607E+00, 0.34816E+00,
- & 0.35025E+00, 0.35233E+00, 0.35441E+00, 0.35649E+00, 0.35856E+00,
- & 0.36063E+00, 0.36270E+00, 0.36476E+00, 0.36682E+00, 0.36888E+00,
- & 0.37093E+00, 0.37299E+00, 0.37503E+00, 0.37708E+00, 0.37912E+00,
- & 0.38116E+00, 0.38320E+00, 0.38523E+00, 0.38726E+00, 0.38929E+00,
- & 0.39131E+00, 0.39333E+00, 0.39535E+00, 0.39737E+00, 0.39938E+00,
- & 0.40139E+00, 0.40339E+00, 0.40540E+00, 0.40740E+00, 0.40940E+00,
- & 0.41139E+00, 0.41338E+00, 0.41537E+00, 0.41735E+00, 0.41934E+00/
-
- DATA (BNC10M(I),I=301,400)/
- & 0.42132E+00, 0.42329E+00, 0.42527E+00, 0.42724E+00, 0.42920E+00,
- & 0.43117E+00, 0.43313E+00, 0.43509E+00, 0.43705E+00, 0.43900E+00,
- & 0.44095E+00, 0.44290E+00, 0.44484E+00, 0.44678E+00, 0.44872E+00,
- & 0.45066E+00, 0.45259E+00, 0.45452E+00, 0.45645E+00, 0.45837E+00,
- & 0.46029E+00, 0.46221E+00, 0.46413E+00, 0.46604E+00, 0.46795E+00,
- & 0.46986E+00, 0.47176E+00, 0.47366E+00, 0.47556E+00, 0.47746E+00,
- & 0.47935E+00, 0.48124E+00, 0.48313E+00, 0.48502E+00, 0.48690E+00,
- & 0.48878E+00, 0.49065E+00, 0.49253E+00, 0.49440E+00, 0.49627E+00,
- & 0.49813E+00, 0.50000E+00, 0.50186E+00, 0.50371E+00, 0.50557E+00,
- & 0.50742E+00, 0.50927E+00, 0.51112E+00, 0.51296E+00, 0.51480E+00,
- & 0.51664E+00, 0.51848E+00, 0.52031E+00, 0.52214E+00, 0.52397E+00,
- & 0.52580E+00, 0.52762E+00, 0.52944E+00, 0.53126E+00, 0.53307E+00,
- & 0.53488E+00, 0.53669E+00, 0.53850E+00, 0.54031E+00, 0.54211E+00,
- & 0.54391E+00, 0.54570E+00, 0.54750E+00, 0.54929E+00, 0.55108E+00,
- & 0.55286E+00, 0.55465E+00, 0.55643E+00, 0.55821E+00, 0.55999E+00,
- & 0.56176E+00, 0.56353E+00, 0.56530E+00, 0.56707E+00, 0.56883E+00,
- & 0.57059E+00, 0.57235E+00, 0.57411E+00, 0.57586E+00, 0.57761E+00,
- & 0.57936E+00, 0.58111E+00, 0.58285E+00, 0.58459E+00, 0.58633E+00,
- & 0.58807E+00, 0.58980E+00, 0.59153E+00, 0.59326E+00, 0.59499E+00,
- & 0.59671E+00, 0.59843E+00, 0.60015E+00, 0.60187E+00, 0.60359E+00/
-
- DATA (BNC10M(I),I=401,500)/
- & 0.60530E+00, 0.60701E+00, 0.60872E+00, 0.61042E+00, 0.61212E+00,
- & 0.61383E+00, 0.61552E+00, 0.61722E+00, 0.61891E+00, 0.62060E+00,
- & 0.62229E+00, 0.62398E+00, 0.62566E+00, 0.62734E+00, 0.62902E+00,
- & 0.63070E+00, 0.63238E+00, 0.63405E+00, 0.63572E+00, 0.63739E+00,
- & 0.63905E+00, 0.64072E+00, 0.64238E+00, 0.64404E+00, 0.64569E+00,
- & 0.64735E+00, 0.64900E+00, 0.65065E+00, 0.65230E+00, 0.65394E+00,
- & 0.65559E+00, 0.65723E+00, 0.65887E+00, 0.66050E+00, 0.66214E+00,
- & 0.66377E+00, 0.66540E+00, 0.66703E+00, 0.66865E+00, 0.67027E+00,
- & 0.67190E+00, 0.67351E+00, 0.67513E+00, 0.67675E+00, 0.67836E+00,
- & 0.67997E+00, 0.68158E+00, 0.68318E+00, 0.68479E+00, 0.68639E+00,
- & 0.68799E+00, 0.68959E+00, 0.69118E+00, 0.69277E+00, 0.69437E+00,
- & 0.69595E+00, 0.69754E+00, 0.69913E+00, 0.70071E+00, 0.70229E+00,
- & 0.70387E+00, 0.70545E+00, 0.70702E+00, 0.70859E+00, 0.71016E+00,
- & 0.71173E+00, 0.71330E+00, 0.71486E+00, 0.71642E+00, 0.71798E+00,
- & 0.71954E+00, 0.72110E+00, 0.72265E+00, 0.72420E+00, 0.72575E+00,
- & 0.72730E+00, 0.72885E+00, 0.73039E+00, 0.73193E+00, 0.73347E+00,
- & 0.73501E+00, 0.73655E+00, 0.73808E+00, 0.73961E+00, 0.74114E+00,
- & 0.74267E+00, 0.74420E+00, 0.74572E+00, 0.74724E+00, 0.74876E+00,
- & 0.75028E+00, 0.75180E+00, 0.75331E+00, 0.75483E+00, 0.75634E+00,
- & 0.75784E+00, 0.75935E+00, 0.76086E+00, 0.76236E+00, 0.76386E+00/
-
- DATA (BNC10M(I),I=501,600)/
- & 0.76536E+00, 0.76686E+00, 0.76835E+00, 0.76985E+00, 0.77134E+00,
- & 0.77283E+00, 0.77431E+00, 0.77580E+00, 0.77728E+00, 0.77877E+00,
- & 0.78025E+00, 0.78173E+00, 0.78320E+00, 0.78468E+00, 0.78615E+00,
- & 0.78762E+00, 0.78909E+00, 0.79056E+00, 0.79202E+00, 0.79349E+00,
- & 0.79495E+00, 0.79641E+00, 0.79787E+00, 0.79933E+00, 0.80078E+00,
- & 0.80223E+00, 0.80368E+00, 0.80513E+00, 0.80658E+00, 0.80803E+00,
- & 0.80947E+00, 0.81091E+00, 0.81235E+00, 0.81379E+00, 0.81523E+00,
- & 0.81667E+00, 0.81810E+00, 0.81953E+00, 0.82096E+00, 0.82239E+00,
- & 0.82382E+00, 0.82524E+00, 0.82666E+00, 0.82809E+00, 0.82951E+00,
- & 0.83092E+00, 0.83234E+00, 0.83375E+00, 0.83517E+00, 0.83658E+00,
- & 0.83799E+00, 0.83940E+00, 0.84080E+00, 0.84221E+00, 0.84361E+00,
- & 0.84501E+00, 0.84641E+00, 0.84781E+00, 0.84920E+00, 0.85060E+00,
- & 0.85199E+00, 0.85338E+00, 0.85477E+00, 0.85616E+00, 0.85754E+00,
- & 0.85893E+00, 0.86031E+00, 0.86169E+00, 0.86307E+00, 0.86445E+00,
- & 0.86583E+00, 0.86720E+00, 0.86857E+00, 0.86995E+00, 0.87131E+00,
- & 0.87268E+00, 0.87405E+00, 0.87541E+00, 0.87678E+00, 0.87814E+00,
- & 0.87950E+00, 0.88086E+00, 0.88222E+00, 0.88357E+00, 0.88493E+00,
- & 0.88628E+00, 0.88763E+00, 0.88898E+00, 0.89033E+00, 0.89167E+00,
- & 0.89302E+00, 0.89436E+00, 0.89570E+00, 0.89704E+00, 0.89838E+00,
- & 0.89972E+00, 0.90105E+00, 0.90238E+00, 0.90372E+00, 0.90505E+00/
-
- DATA (BNC10M(I),I=601,700)/
- & 0.91933E+00, 0.93239E+00, 0.94531E+00, 0.95808E+00, 0.97072E+00,
- & 0.98322E+00, 0.99558E+00, 0.10078E+01, 0.10199E+01, 0.10319E+01,
- & 0.10438E+01, 0.10555E+01, 0.10671E+01, 0.10786E+01, 0.10900E+01,
- & 0.11013E+01, 0.11124E+01, 0.11235E+01, 0.11344E+01, 0.11453E+01,
- & 0.11560E+01, 0.11667E+01, 0.11772E+01, 0.11876E+01, 0.11980E+01,
- & 0.12082E+01, 0.12184E+01, 0.12285E+01, 0.12385E+01, 0.12484E+01,
- & 0.12582E+01, 0.12679E+01, 0.12776E+01, 0.12871E+01, 0.12966E+01,
- & 0.13060E+01, 0.13154E+01, 0.13246E+01, 0.13338E+01, 0.13429E+01,
- & 0.13519E+01, 0.13609E+01, 0.13698E+01, 0.13786E+01, 0.13874E+01,
- & 0.13960E+01, 0.14047E+01, 0.14132E+01, 0.14217E+01, 0.14301E+01,
- & 0.14385E+01, 0.14468E+01, 0.14550E+01, 0.14632E+01, 0.14713E+01,
- & 0.14794E+01, 0.14874E+01, 0.14954E+01, 0.15033E+01, 0.15111E+01,
- & 0.15189E+01, 0.15266E+01, 0.15343E+01, 0.15419E+01, 0.15495E+01,
- & 0.15570E+01, 0.15645E+01, 0.15719E+01, 0.15793E+01, 0.15866E+01,
- & 0.15939E+01, 0.16012E+01, 0.16084E+01, 0.16155E+01, 0.16226E+01,
- & 0.16297E+01, 0.16367E+01, 0.16436E+01, 0.16506E+01, 0.16574E+01,
- & 0.16643E+01, 0.16711E+01, 0.16778E+01, 0.16845E+01, 0.16912E+01,
- & 0.16979E+01, 0.17045E+01, 0.17110E+01, 0.17175E+01, 0.17240E+01,
- & 0.17305E+01, 0.17369E+01, 0.17433E+01, 0.17496E+01, 0.17559E+01,
- & 0.17622E+01, 0.17684E+01, 0.17746E+01, 0.17808E+01, 0.17869E+01/
-
- DATA (BNC10M(I),I=701,741)/
- & 0.17930E+01, 0.17991E+01, 0.18051E+01, 0.18111E+01, 0.18171E+01,
- & 0.18230E+01, 0.18289E+01, 0.18348E+01, 0.18406E+01, 0.18464E+01,
- & 0.18522E+01, 0.18580E+01, 0.18637E+01, 0.18694E+01, 0.18751E+01,
- & 0.18807E+01, 0.18863E+01, 0.18919E+01, 0.18974E+01, 0.19030E+01,
- & 0.19085E+01, 0.19139E+01, 0.19194E+01, 0.19248E+01, 0.19302E+01,
- & 0.19356E+01, 0.19409E+01, 0.19462E+01, 0.19515E+01, 0.19568E+01,
- & 0.19620E+01, 0.19672E+01, 0.19724E+01, 0.19776E+01, 0.19828E+01,
- & 0.19879E+01, 0.19930E+01, 0.19981E+01, 0.20031E+01, 0.20081E+01,
- & 0.20131E+01
- & /
-C
-C *** (H,Cl)
-C
- DATA (BNC11M(I),I=1,100)/
- &-0.44136E-01,-0.88680E-01,-0.10706E+00,-0.11800E+00,-0.12513E+00,
- &-0.12990E+00,-0.13304E+00,-0.13497E+00,-0.13598E+00,-0.13624E+00,
- &-0.13589E+00,-0.13503E+00,-0.13373E+00,-0.13205E+00,-0.13004E+00,
- &-0.12774E+00,-0.12517E+00,-0.12237E+00,-0.11935E+00,-0.11614E+00,
- &-0.11275E+00,-0.10920E+00,-0.10550E+00,-0.10166E+00,-0.97690E-01,
- &-0.93602E-01,-0.89404E-01,-0.85103E-01,-0.80706E-01,-0.76221E-01,
- &-0.71651E-01,-0.67004E-01,-0.62284E-01,-0.57497E-01,-0.52646E-01,
- &-0.47736E-01,-0.42771E-01,-0.37754E-01,-0.32690E-01,-0.27580E-01,
- &-0.22429E-01,-0.17239E-01,-0.12013E-01,-0.67523E-02,-0.14605E-02,
- & 0.38607E-02, 0.92093E-02, 0.14584E-01, 0.19982E-01, 0.25402E-01,
- & 0.30844E-01, 0.36306E-01, 0.41786E-01, 0.47284E-01, 0.52800E-01,
- & 0.58332E-01, 0.63879E-01, 0.69443E-01, 0.75021E-01, 0.80615E-01,
- & 0.86223E-01, 0.91847E-01, 0.97486E-01, 0.10314E+00, 0.10881E+00,
- & 0.11450E+00, 0.12020E+00, 0.12592E+00, 0.13166E+00, 0.13742E+00,
- & 0.14320E+00, 0.14899E+00, 0.15481E+00, 0.16065E+00, 0.16652E+00,
- & 0.17241E+00, 0.17832E+00, 0.18426E+00, 0.19022E+00, 0.19621E+00,
- & 0.20223E+00, 0.20827E+00, 0.21435E+00, 0.22045E+00, 0.22659E+00,
- & 0.23275E+00, 0.23894E+00, 0.24517E+00, 0.25142E+00, 0.25771E+00,
- & 0.26402E+00, 0.27037E+00, 0.27674E+00, 0.28315E+00, 0.28958E+00,
- & 0.29604E+00, 0.30253E+00, 0.30905E+00, 0.31559E+00, 0.32216E+00/
-
- DATA (BNC11M(I),I=101,200)/
- & 0.32875E+00, 0.33537E+00, 0.34201E+00, 0.34867E+00, 0.35535E+00,
- & 0.36205E+00, 0.36877E+00, 0.37550E+00, 0.38225E+00, 0.38902E+00,
- & 0.39580E+00, 0.40259E+00, 0.40939E+00, 0.41620E+00, 0.42302E+00,
- & 0.42985E+00, 0.43669E+00, 0.44353E+00, 0.45037E+00, 0.45722E+00,
- & 0.46408E+00, 0.47093E+00, 0.47779E+00, 0.48464E+00, 0.49150E+00,
- & 0.49835E+00, 0.50520E+00, 0.51205E+00, 0.51890E+00, 0.52574E+00,
- & 0.53258E+00, 0.53941E+00, 0.54624E+00, 0.55306E+00, 0.55988E+00,
- & 0.56669E+00, 0.57349E+00, 0.58029E+00, 0.58708E+00, 0.59386E+00,
- & 0.60063E+00, 0.60739E+00, 0.61415E+00, 0.62089E+00, 0.62763E+00,
- & 0.63436E+00, 0.64108E+00, 0.64779E+00, 0.65449E+00, 0.66118E+00,
- & 0.66786E+00, 0.67453E+00, 0.68118E+00, 0.68783E+00, 0.69447E+00,
- & 0.70110E+00, 0.70772E+00, 0.71432E+00, 0.72092E+00, 0.72750E+00,
- & 0.73408E+00, 0.74064E+00, 0.74719E+00, 0.75373E+00, 0.76026E+00,
- & 0.76678E+00, 0.77329E+00, 0.77978E+00, 0.78627E+00, 0.79274E+00,
- & 0.79920E+00, 0.80565E+00, 0.81209E+00, 0.81852E+00, 0.82493E+00,
- & 0.83134E+00, 0.83773E+00, 0.84411E+00, 0.85048E+00, 0.85683E+00,
- & 0.86318E+00, 0.86951E+00, 0.87583E+00, 0.88214E+00, 0.88844E+00,
- & 0.89473E+00, 0.90100E+00, 0.90726E+00, 0.91352E+00, 0.91975E+00,
- & 0.92598E+00, 0.93220E+00, 0.93840E+00, 0.94459E+00, 0.95077E+00,
- & 0.95694E+00, 0.96310E+00, 0.96924E+00, 0.97537E+00, 0.98149E+00/
-
- DATA (BNC11M(I),I=201,300)/
- & 0.98760E+00, 0.99370E+00, 0.99978E+00, 0.10059E+01, 0.10119E+01,
- & 0.10180E+01, 0.10240E+01, 0.10300E+01, 0.10360E+01, 0.10421E+01,
- & 0.10480E+01, 0.10540E+01, 0.10600E+01, 0.10659E+01, 0.10719E+01,
- & 0.10778E+01, 0.10837E+01, 0.10897E+01, 0.10956E+01, 0.11014E+01,
- & 0.11073E+01, 0.11132E+01, 0.11190E+01, 0.11249E+01, 0.11307E+01,
- & 0.11365E+01, 0.11423E+01, 0.11481E+01, 0.11539E+01, 0.11597E+01,
- & 0.11654E+01, 0.11712E+01, 0.11769E+01, 0.11827E+01, 0.11884E+01,
- & 0.11941E+01, 0.11998E+01, 0.12054E+01, 0.12111E+01, 0.12168E+01,
- & 0.12224E+01, 0.12281E+01, 0.12337E+01, 0.12393E+01, 0.12449E+01,
- & 0.12505E+01, 0.12561E+01, 0.12617E+01, 0.12672E+01, 0.12728E+01,
- & 0.12783E+01, 0.12838E+01, 0.12894E+01, 0.12949E+01, 0.13004E+01,
- & 0.13059E+01, 0.13113E+01, 0.13168E+01, 0.13223E+01, 0.13277E+01,
- & 0.13331E+01, 0.13386E+01, 0.13440E+01, 0.13494E+01, 0.13548E+01,
- & 0.13601E+01, 0.13655E+01, 0.13709E+01, 0.13762E+01, 0.13816E+01,
- & 0.13869E+01, 0.13922E+01, 0.13975E+01, 0.14028E+01, 0.14081E+01,
- & 0.14134E+01, 0.14187E+01, 0.14239E+01, 0.14292E+01, 0.14344E+01,
- & 0.14396E+01, 0.14449E+01, 0.14501E+01, 0.14553E+01, 0.14605E+01,
- & 0.14656E+01, 0.14708E+01, 0.14760E+01, 0.14811E+01, 0.14863E+01,
- & 0.14914E+01, 0.14965E+01, 0.15016E+01, 0.15067E+01, 0.15118E+01,
- & 0.15169E+01, 0.15220E+01, 0.15271E+01, 0.15321E+01, 0.15372E+01/
-
- DATA (BNC11M(I),I=301,400)/
- & 0.15422E+01, 0.15472E+01, 0.15523E+01, 0.15573E+01, 0.15623E+01,
- & 0.15673E+01, 0.15722E+01, 0.15772E+01, 0.15822E+01, 0.15871E+01,
- & 0.15921E+01, 0.15970E+01, 0.16019E+01, 0.16069E+01, 0.16118E+01,
- & 0.16167E+01, 0.16216E+01, 0.16265E+01, 0.16313E+01, 0.16362E+01,
- & 0.16410E+01, 0.16459E+01, 0.16507E+01, 0.16556E+01, 0.16604E+01,
- & 0.16652E+01, 0.16700E+01, 0.16748E+01, 0.16796E+01, 0.16844E+01,
- & 0.16891E+01, 0.16939E+01, 0.16987E+01, 0.17034E+01, 0.17081E+01,
- & 0.17129E+01, 0.17176E+01, 0.17223E+01, 0.17270E+01, 0.17317E+01,
- & 0.17364E+01, 0.17411E+01, 0.17457E+01, 0.17504E+01, 0.17551E+01,
- & 0.17597E+01, 0.17644E+01, 0.17690E+01, 0.17736E+01, 0.17782E+01,
- & 0.17828E+01, 0.17874E+01, 0.17920E+01, 0.17966E+01, 0.18012E+01,
- & 0.18057E+01, 0.18103E+01, 0.18149E+01, 0.18194E+01, 0.18239E+01,
- & 0.18285E+01, 0.18330E+01, 0.18375E+01, 0.18420E+01, 0.18465E+01,
- & 0.18510E+01, 0.18555E+01, 0.18600E+01, 0.18644E+01, 0.18689E+01,
- & 0.18733E+01, 0.18778E+01, 0.18822E+01, 0.18867E+01, 0.18911E+01,
- & 0.18955E+01, 0.18999E+01, 0.19043E+01, 0.19087E+01, 0.19131E+01,
- & 0.19175E+01, 0.19218E+01, 0.19262E+01, 0.19306E+01, 0.19349E+01,
- & 0.19393E+01, 0.19436E+01, 0.19479E+01, 0.19522E+01, 0.19566E+01,
- & 0.19609E+01, 0.19652E+01, 0.19695E+01, 0.19737E+01, 0.19780E+01,
- & 0.19823E+01, 0.19866E+01, 0.19908E+01, 0.19951E+01, 0.19993E+01/
-
- DATA (BNC11M(I),I=401,500)/
- & 0.20036E+01, 0.20078E+01, 0.20120E+01, 0.20162E+01, 0.20204E+01,
- & 0.20247E+01, 0.20289E+01, 0.20330E+01, 0.20372E+01, 0.20414E+01,
- & 0.20456E+01, 0.20497E+01, 0.20539E+01, 0.20581E+01, 0.20622E+01,
- & 0.20663E+01, 0.20705E+01, 0.20746E+01, 0.20787E+01, 0.20828E+01,
- & 0.20869E+01, 0.20910E+01, 0.20951E+01, 0.20992E+01, 0.21033E+01,
- & 0.21074E+01, 0.21114E+01, 0.21155E+01, 0.21196E+01, 0.21236E+01,
- & 0.21277E+01, 0.21317E+01, 0.21357E+01, 0.21398E+01, 0.21438E+01,
- & 0.21478E+01, 0.21518E+01, 0.21558E+01, 0.21598E+01, 0.21638E+01,
- & 0.21678E+01, 0.21717E+01, 0.21757E+01, 0.21797E+01, 0.21836E+01,
- & 0.21876E+01, 0.21915E+01, 0.21955E+01, 0.21994E+01, 0.22033E+01,
- & 0.22073E+01, 0.22112E+01, 0.22151E+01, 0.22190E+01, 0.22229E+01,
- & 0.22268E+01, 0.22307E+01, 0.22346E+01, 0.22384E+01, 0.22423E+01,
- & 0.22462E+01, 0.22500E+01, 0.22539E+01, 0.22577E+01, 0.22616E+01,
- & 0.22654E+01, 0.22692E+01, 0.22731E+01, 0.22769E+01, 0.22807E+01,
- & 0.22845E+01, 0.22883E+01, 0.22921E+01, 0.22959E+01, 0.22997E+01,
- & 0.23035E+01, 0.23072E+01, 0.23110E+01, 0.23148E+01, 0.23185E+01,
- & 0.23223E+01, 0.23260E+01, 0.23298E+01, 0.23335E+01, 0.23373E+01,
- & 0.23410E+01, 0.23447E+01, 0.23484E+01, 0.23521E+01, 0.23558E+01,
- & 0.23595E+01, 0.23632E+01, 0.23669E+01, 0.23706E+01, 0.23743E+01,
- & 0.23780E+01, 0.23816E+01, 0.23853E+01, 0.23890E+01, 0.23926E+01/
-
- DATA (BNC11M(I),I=501,600)/
- & 0.23963E+01, 0.23999E+01, 0.24036E+01, 0.24072E+01, 0.24108E+01,
- & 0.24144E+01, 0.24181E+01, 0.24217E+01, 0.24253E+01, 0.24289E+01,
- & 0.24325E+01, 0.24361E+01, 0.24397E+01, 0.24433E+01, 0.24468E+01,
- & 0.24504E+01, 0.24540E+01, 0.24575E+01, 0.24611E+01, 0.24647E+01,
- & 0.24682E+01, 0.24718E+01, 0.24753E+01, 0.24788E+01, 0.24824E+01,
- & 0.24859E+01, 0.24894E+01, 0.24929E+01, 0.24964E+01, 0.24999E+01,
- & 0.25034E+01, 0.25069E+01, 0.25104E+01, 0.25139E+01, 0.25174E+01,
- & 0.25209E+01, 0.25244E+01, 0.25278E+01, 0.25313E+01, 0.25348E+01,
- & 0.25382E+01, 0.25417E+01, 0.25451E+01, 0.25486E+01, 0.25520E+01,
- & 0.25554E+01, 0.25589E+01, 0.25623E+01, 0.25657E+01, 0.25691E+01,
- & 0.25725E+01, 0.25759E+01, 0.25793E+01, 0.25827E+01, 0.25861E+01,
- & 0.25895E+01, 0.25929E+01, 0.25963E+01, 0.25997E+01, 0.26030E+01,
- & 0.26064E+01, 0.26098E+01, 0.26131E+01, 0.26165E+01, 0.26198E+01,
- & 0.26232E+01, 0.26265E+01, 0.26298E+01, 0.26332E+01, 0.26365E+01,
- & 0.26398E+01, 0.26431E+01, 0.26465E+01, 0.26498E+01, 0.26531E+01,
- & 0.26564E+01, 0.26597E+01, 0.26630E+01, 0.26663E+01, 0.26696E+01,
- & 0.26728E+01, 0.26761E+01, 0.26794E+01, 0.26827E+01, 0.26859E+01,
- & 0.26892E+01, 0.26924E+01, 0.26957E+01, 0.26989E+01, 0.27022E+01,
- & 0.27054E+01, 0.27087E+01, 0.27119E+01, 0.27151E+01, 0.27184E+01,
- & 0.27216E+01, 0.27248E+01, 0.27280E+01, 0.27312E+01, 0.27344E+01/
-
- DATA (BNC11M(I),I=601,700)/
- & 0.27688E+01, 0.28002E+01, 0.28313E+01, 0.28620E+01, 0.28923E+01,
- & 0.29223E+01, 0.29519E+01, 0.29812E+01, 0.30102E+01, 0.30388E+01,
- & 0.30672E+01, 0.30952E+01, 0.31229E+01, 0.31504E+01, 0.31775E+01,
- & 0.32044E+01, 0.32310E+01, 0.32573E+01, 0.32834E+01, 0.33092E+01,
- & 0.33347E+01, 0.33601E+01, 0.33851E+01, 0.34099E+01, 0.34345E+01,
- & 0.34589E+01, 0.34830E+01, 0.35069E+01, 0.35306E+01, 0.35541E+01,
- & 0.35773E+01, 0.36004E+01, 0.36232E+01, 0.36459E+01, 0.36683E+01,
- & 0.36906E+01, 0.37127E+01, 0.37346E+01, 0.37563E+01, 0.37778E+01,
- & 0.37992E+01, 0.38203E+01, 0.38413E+01, 0.38622E+01, 0.38828E+01,
- & 0.39033E+01, 0.39237E+01, 0.39439E+01, 0.39639E+01, 0.39838E+01,
- & 0.40035E+01, 0.40231E+01, 0.40425E+01, 0.40618E+01, 0.40809E+01,
- & 0.40999E+01, 0.41188E+01, 0.41375E+01, 0.41561E+01, 0.41746E+01,
- & 0.41929E+01, 0.42111E+01, 0.42292E+01, 0.42472E+01, 0.42650E+01,
- & 0.42827E+01, 0.43003E+01, 0.43177E+01, 0.43351E+01, 0.43523E+01,
- & 0.43695E+01, 0.43865E+01, 0.44034E+01, 0.44202E+01, 0.44368E+01,
- & 0.44534E+01, 0.44699E+01, 0.44862E+01, 0.45025E+01, 0.45187E+01,
- & 0.45347E+01, 0.45507E+01, 0.45666E+01, 0.45823E+01, 0.45980E+01,
- & 0.46136E+01, 0.46291E+01, 0.46445E+01, 0.46598E+01, 0.46750E+01,
- & 0.46901E+01, 0.47051E+01, 0.47201E+01, 0.47350E+01, 0.47497E+01,
- & 0.47644E+01, 0.47791E+01, 0.47936E+01, 0.48080E+01, 0.48224E+01/
-
- DATA (BNC11M(I),I=701,741)/
- & 0.48367E+01, 0.48509E+01, 0.48651E+01, 0.48791E+01, 0.48931E+01,
- & 0.49070E+01, 0.49208E+01, 0.49346E+01, 0.49483E+01, 0.49619E+01,
- & 0.49755E+01, 0.49889E+01, 0.50023E+01, 0.50157E+01, 0.50290E+01,
- & 0.50422E+01, 0.50553E+01, 0.50684E+01, 0.50814E+01, 0.50943E+01,
- & 0.51072E+01, 0.51200E+01, 0.51327E+01, 0.51454E+01, 0.51580E+01,
- & 0.51706E+01, 0.51831E+01, 0.51956E+01, 0.52079E+01, 0.52203E+01,
- & 0.52325E+01, 0.52447E+01, 0.52569E+01, 0.52690E+01, 0.52810E+01,
- & 0.52930E+01, 0.53049E+01, 0.53168E+01, 0.53286E+01, 0.53404E+01,
- & 0.53521E+01
- & /
-C
-C *** NaHSO4
-C
- DATA (BNC12M(I),I=1,100)/
- &-0.45034E-01,-0.93528E-01,-0.11552E+00,-0.12992E+00,-0.14041E+00,
- &-0.14847E+00,-0.15486E+00,-0.16000E+00,-0.16419E+00,-0.16761E+00,
- &-0.17041E+00,-0.17267E+00,-0.17449E+00,-0.17591E+00,-0.17699E+00,
- &-0.17776E+00,-0.17826E+00,-0.17851E+00,-0.17853E+00,-0.17835E+00,
- &-0.17798E+00,-0.17743E+00,-0.17671E+00,-0.17585E+00,-0.17484E+00,
- &-0.17369E+00,-0.17241E+00,-0.17102E+00,-0.16951E+00,-0.16790E+00,
- &-0.16618E+00,-0.16436E+00,-0.16245E+00,-0.16045E+00,-0.15836E+00,
- &-0.15620E+00,-0.15396E+00,-0.15164E+00,-0.14925E+00,-0.14680E+00,
- &-0.14428E+00,-0.14170E+00,-0.13905E+00,-0.13635E+00,-0.13360E+00,
- &-0.13079E+00,-0.12794E+00,-0.12503E+00,-0.12208E+00,-0.11908E+00,
- &-0.11604E+00,-0.11296E+00,-0.10984E+00,-0.10667E+00,-0.10348E+00,
- &-0.10024E+00,-0.96972E-01,-0.93669E-01,-0.90333E-01,-0.86964E-01,
- &-0.83564E-01,-0.80133E-01,-0.76672E-01,-0.73181E-01,-0.69661E-01,
- &-0.66113E-01,-0.62536E-01,-0.58930E-01,-0.55297E-01,-0.51636E-01,
- &-0.47947E-01,-0.44230E-01,-0.40486E-01,-0.36714E-01,-0.32914E-01,
- &-0.29086E-01,-0.25231E-01,-0.21348E-01,-0.17437E-01,-0.13498E-01,
- &-0.95308E-02,-0.55358E-02,-0.15127E-02, 0.25383E-02, 0.66171E-02,
- & 0.10724E-01, 0.14858E-01, 0.19019E-01, 0.23208E-01, 0.27423E-01,
- & 0.31665E-01, 0.35933E-01, 0.40227E-01, 0.44545E-01, 0.48888E-01,
- & 0.53254E-01, 0.57644E-01, 0.62056E-01, 0.66490E-01, 0.70945E-01/
-
- DATA (BNC12M(I),I=101,200)/
- & 0.75420E-01, 0.79914E-01, 0.84426E-01, 0.88956E-01, 0.93502E-01,
- & 0.98063E-01, 0.10264E+00, 0.10723E+00, 0.11183E+00, 0.11644E+00,
- & 0.12107E+00, 0.12570E+00, 0.13035E+00, 0.13500E+00, 0.13966E+00,
- & 0.14432E+00, 0.14899E+00, 0.15366E+00, 0.15834E+00, 0.16302E+00,
- & 0.16771E+00, 0.17239E+00, 0.17708E+00, 0.18176E+00, 0.18645E+00,
- & 0.19113E+00, 0.19582E+00, 0.20050E+00, 0.20518E+00, 0.20985E+00,
- & 0.21452E+00, 0.21919E+00, 0.22386E+00, 0.22852E+00, 0.23317E+00,
- & 0.23782E+00, 0.24247E+00, 0.24711E+00, 0.25174E+00, 0.25637E+00,
- & 0.26099E+00, 0.26561E+00, 0.27021E+00, 0.27481E+00, 0.27941E+00,
- & 0.28400E+00, 0.28858E+00, 0.29315E+00, 0.29771E+00, 0.30227E+00,
- & 0.30682E+00, 0.31136E+00, 0.31590E+00, 0.32043E+00, 0.32494E+00,
- & 0.32946E+00, 0.33396E+00, 0.33845E+00, 0.34294E+00, 0.34742E+00,
- & 0.35189E+00, 0.35635E+00, 0.36080E+00, 0.36525E+00, 0.36968E+00,
- & 0.37411E+00, 0.37853E+00, 0.38294E+00, 0.38734E+00, 0.39174E+00,
- & 0.39612E+00, 0.40050E+00, 0.40487E+00, 0.40923E+00, 0.41358E+00,
- & 0.41792E+00, 0.42226E+00, 0.42658E+00, 0.43090E+00, 0.43521E+00,
- & 0.43951E+00, 0.44380E+00, 0.44808E+00, 0.45236E+00, 0.45662E+00,
- & 0.46088E+00, 0.46513E+00, 0.46937E+00, 0.47360E+00, 0.47782E+00,
- & 0.48204E+00, 0.48624E+00, 0.49044E+00, 0.49463E+00, 0.49881E+00,
- & 0.50298E+00, 0.50715E+00, 0.51130E+00, 0.51545E+00, 0.51959E+00/
-
- DATA (BNC12M(I),I=201,300)/
- & 0.52372E+00, 0.52784E+00, 0.53195E+00, 0.53606E+00, 0.54016E+00,
- & 0.54425E+00, 0.54833E+00, 0.55240E+00, 0.55646E+00, 0.56052E+00,
- & 0.56457E+00, 0.56861E+00, 0.57264E+00, 0.57666E+00, 0.58068E+00,
- & 0.58468E+00, 0.58868E+00, 0.59267E+00, 0.59666E+00, 0.60063E+00,
- & 0.60460E+00, 0.60856E+00, 0.61251E+00, 0.61645E+00, 0.62039E+00,
- & 0.62432E+00, 0.62824E+00, 0.63215E+00, 0.63606E+00, 0.63995E+00,
- & 0.64384E+00, 0.64772E+00, 0.65160E+00, 0.65546E+00, 0.65932E+00,
- & 0.66317E+00, 0.66702E+00, 0.67085E+00, 0.67468E+00, 0.67850E+00,
- & 0.68231E+00, 0.68612E+00, 0.68992E+00, 0.69371E+00, 0.69749E+00,
- & 0.70127E+00, 0.70504E+00, 0.70880E+00, 0.71256E+00, 0.71630E+00,
- & 0.72004E+00, 0.72378E+00, 0.72750E+00, 0.73122E+00, 0.73493E+00,
- & 0.73864E+00, 0.74233E+00, 0.74602E+00, 0.74971E+00, 0.75338E+00,
- & 0.75705E+00, 0.76071E+00, 0.76437E+00, 0.76802E+00, 0.77166E+00,
- & 0.77529E+00, 0.77892E+00, 0.78254E+00, 0.78616E+00, 0.78976E+00,
- & 0.79337E+00, 0.79696E+00, 0.80055E+00, 0.80413E+00, 0.80770E+00,
- & 0.81127E+00, 0.81483E+00, 0.81838E+00, 0.82193E+00, 0.82547E+00,
- & 0.82901E+00, 0.83253E+00, 0.83605E+00, 0.83957E+00, 0.84308E+00,
- & 0.84658E+00, 0.85008E+00, 0.85357E+00, 0.85705E+00, 0.86053E+00,
- & 0.86400E+00, 0.86746E+00, 0.87092E+00, 0.87437E+00, 0.87781E+00,
- & 0.88125E+00, 0.88469E+00, 0.88811E+00, 0.89153E+00, 0.89495E+00/
-
- DATA (BNC12M(I),I=301,400)/
- & 0.89836E+00, 0.90176E+00, 0.90516E+00, 0.90855E+00, 0.91193E+00,
- & 0.91531E+00, 0.91868E+00, 0.92205E+00, 0.92541E+00, 0.92876E+00,
- & 0.93211E+00, 0.93545E+00, 0.93879E+00, 0.94212E+00, 0.94545E+00,
- & 0.94877E+00, 0.95208E+00, 0.95539E+00, 0.95869E+00, 0.96199E+00,
- & 0.96528E+00, 0.96856E+00, 0.97184E+00, 0.97512E+00, 0.97839E+00,
- & 0.98165E+00, 0.98491E+00, 0.98816E+00, 0.99140E+00, 0.99464E+00,
- & 0.99788E+00, 0.10011E+01, 0.10043E+01, 0.10075E+01, 0.10108E+01,
- & 0.10140E+01, 0.10172E+01, 0.10204E+01, 0.10236E+01, 0.10267E+01,
- & 0.10299E+01, 0.10331E+01, 0.10363E+01, 0.10394E+01, 0.10426E+01,
- & 0.10458E+01, 0.10489E+01, 0.10520E+01, 0.10552E+01, 0.10583E+01,
- & 0.10614E+01, 0.10646E+01, 0.10677E+01, 0.10708E+01, 0.10739E+01,
- & 0.10770E+01, 0.10801E+01, 0.10832E+01, 0.10863E+01, 0.10894E+01,
- & 0.10924E+01, 0.10955E+01, 0.10986E+01, 0.11016E+01, 0.11047E+01,
- & 0.11078E+01, 0.11108E+01, 0.11138E+01, 0.11169E+01, 0.11199E+01,
- & 0.11229E+01, 0.11260E+01, 0.11290E+01, 0.11320E+01, 0.11350E+01,
- & 0.11380E+01, 0.11410E+01, 0.11440E+01, 0.11470E+01, 0.11500E+01,
- & 0.11530E+01, 0.11559E+01, 0.11589E+01, 0.11619E+01, 0.11648E+01,
- & 0.11678E+01, 0.11708E+01, 0.11737E+01, 0.11766E+01, 0.11796E+01,
- & 0.11825E+01, 0.11854E+01, 0.11884E+01, 0.11913E+01, 0.11942E+01,
- & 0.11971E+01, 0.12000E+01, 0.12029E+01, 0.12058E+01, 0.12087E+01/
-
- DATA (BNC12M(I),I=401,500)/
- & 0.12116E+01, 0.12145E+01, 0.12174E+01, 0.12202E+01, 0.12231E+01,
- & 0.12260E+01, 0.12289E+01, 0.12317E+01, 0.12346E+01, 0.12374E+01,
- & 0.12403E+01, 0.12431E+01, 0.12459E+01, 0.12488E+01, 0.12516E+01,
- & 0.12544E+01, 0.12572E+01, 0.12601E+01, 0.12629E+01, 0.12657E+01,
- & 0.12685E+01, 0.12713E+01, 0.12741E+01, 0.12769E+01, 0.12797E+01,
- & 0.12824E+01, 0.12852E+01, 0.12880E+01, 0.12908E+01, 0.12935E+01,
- & 0.12963E+01, 0.12990E+01, 0.13018E+01, 0.13046E+01, 0.13073E+01,
- & 0.13100E+01, 0.13128E+01, 0.13155E+01, 0.13182E+01, 0.13210E+01,
- & 0.13237E+01, 0.13264E+01, 0.13291E+01, 0.13318E+01, 0.13345E+01,
- & 0.13372E+01, 0.13399E+01, 0.13426E+01, 0.13453E+01, 0.13480E+01,
- & 0.13507E+01, 0.13534E+01, 0.13561E+01, 0.13587E+01, 0.13614E+01,
- & 0.13641E+01, 0.13667E+01, 0.13694E+01, 0.13720E+01, 0.13747E+01,
- & 0.13773E+01, 0.13800E+01, 0.13826E+01, 0.13852E+01, 0.13879E+01,
- & 0.13905E+01, 0.13931E+01, 0.13957E+01, 0.13984E+01, 0.14010E+01,
- & 0.14036E+01, 0.14062E+01, 0.14088E+01, 0.14114E+01, 0.14140E+01,
- & 0.14166E+01, 0.14191E+01, 0.14217E+01, 0.14243E+01, 0.14269E+01,
- & 0.14295E+01, 0.14320E+01, 0.14346E+01, 0.14372E+01, 0.14397E+01,
- & 0.14423E+01, 0.14448E+01, 0.14474E+01, 0.14499E+01, 0.14525E+01,
- & 0.14550E+01, 0.14575E+01, 0.14601E+01, 0.14626E+01, 0.14651E+01,
- & 0.14676E+01, 0.14702E+01, 0.14727E+01, 0.14752E+01, 0.14777E+01/
-
- DATA (BNC12M(I),I=501,600)/
- & 0.14802E+01, 0.14827E+01, 0.14852E+01, 0.14877E+01, 0.14902E+01,
- & 0.14927E+01, 0.14951E+01, 0.14976E+01, 0.15001E+01, 0.15026E+01,
- & 0.15051E+01, 0.15075E+01, 0.15100E+01, 0.15124E+01, 0.15149E+01,
- & 0.15174E+01, 0.15198E+01, 0.15223E+01, 0.15247E+01, 0.15271E+01,
- & 0.15296E+01, 0.15320E+01, 0.15345E+01, 0.15369E+01, 0.15393E+01,
- & 0.15417E+01, 0.15442E+01, 0.15466E+01, 0.15490E+01, 0.15514E+01,
- & 0.15538E+01, 0.15562E+01, 0.15586E+01, 0.15610E+01, 0.15634E+01,
- & 0.15658E+01, 0.15682E+01, 0.15706E+01, 0.15729E+01, 0.15753E+01,
- & 0.15777E+01, 0.15801E+01, 0.15824E+01, 0.15848E+01, 0.15872E+01,
- & 0.15895E+01, 0.15919E+01, 0.15943E+01, 0.15966E+01, 0.15990E+01,
- & 0.16013E+01, 0.16037E+01, 0.16060E+01, 0.16083E+01, 0.16107E+01,
- & 0.16130E+01, 0.16153E+01, 0.16177E+01, 0.16200E+01, 0.16223E+01,
- & 0.16246E+01, 0.16269E+01, 0.16292E+01, 0.16316E+01, 0.16339E+01,
- & 0.16362E+01, 0.16385E+01, 0.16408E+01, 0.16431E+01, 0.16453E+01,
- & 0.16476E+01, 0.16499E+01, 0.16522E+01, 0.16545E+01, 0.16568E+01,
- & 0.16590E+01, 0.16613E+01, 0.16636E+01, 0.16658E+01, 0.16681E+01,
- & 0.16704E+01, 0.16726E+01, 0.16749E+01, 0.16771E+01, 0.16794E+01,
- & 0.16816E+01, 0.16839E+01, 0.16861E+01, 0.16884E+01, 0.16906E+01,
- & 0.16928E+01, 0.16951E+01, 0.16973E+01, 0.16995E+01, 0.17018E+01,
- & 0.17040E+01, 0.17062E+01, 0.17084E+01, 0.17106E+01, 0.17128E+01/
-
- DATA (BNC12M(I),I=601,700)/
- & 0.17365E+01, 0.17582E+01, 0.17797E+01, 0.18009E+01, 0.18218E+01,
- & 0.18425E+01, 0.18630E+01, 0.18833E+01, 0.19033E+01, 0.19232E+01,
- & 0.19428E+01, 0.19622E+01, 0.19814E+01, 0.20004E+01, 0.20193E+01,
- & 0.20379E+01, 0.20563E+01, 0.20746E+01, 0.20927E+01, 0.21106E+01,
- & 0.21283E+01, 0.21459E+01, 0.21633E+01, 0.21806E+01, 0.21976E+01,
- & 0.22146E+01, 0.22313E+01, 0.22480E+01, 0.22644E+01, 0.22808E+01,
- & 0.22969E+01, 0.23130E+01, 0.23289E+01, 0.23447E+01, 0.23603E+01,
- & 0.23758E+01, 0.23912E+01, 0.24064E+01, 0.24215E+01, 0.24365E+01,
- & 0.24514E+01, 0.24662E+01, 0.24808E+01, 0.24953E+01, 0.25097E+01,
- & 0.25240E+01, 0.25382E+01, 0.25523E+01, 0.25663E+01, 0.25802E+01,
- & 0.25939E+01, 0.26076E+01, 0.26211E+01, 0.26346E+01, 0.26480E+01,
- & 0.26612E+01, 0.26744E+01, 0.26875E+01, 0.27005E+01, 0.27134E+01,
- & 0.27262E+01, 0.27389E+01, 0.27515E+01, 0.27640E+01, 0.27765E+01,
- & 0.27889E+01, 0.28012E+01, 0.28134E+01, 0.28255E+01, 0.28375E+01,
- & 0.28495E+01, 0.28614E+01, 0.28732E+01, 0.28849E+01, 0.28966E+01,
- & 0.29082E+01, 0.29197E+01, 0.29312E+01, 0.29425E+01, 0.29538E+01,
- & 0.29651E+01, 0.29762E+01, 0.29873E+01, 0.29984E+01, 0.30093E+01,
- & 0.30202E+01, 0.30311E+01, 0.30419E+01, 0.30526E+01, 0.30632E+01,
- & 0.30738E+01, 0.30843E+01, 0.30948E+01, 0.31052E+01, 0.31155E+01,
- & 0.31258E+01, 0.31361E+01, 0.31462E+01, 0.31564E+01, 0.31664E+01/
-
- DATA (BNC12M(I),I=701,741)/
- & 0.31764E+01, 0.31864E+01, 0.31963E+01, 0.32061E+01, 0.32159E+01,
- & 0.32257E+01, 0.32354E+01, 0.32450E+01, 0.32546E+01, 0.32641E+01,
- & 0.32736E+01, 0.32831E+01, 0.32925E+01, 0.33018E+01, 0.33111E+01,
- & 0.33203E+01, 0.33295E+01, 0.33387E+01, 0.33478E+01, 0.33569E+01,
- & 0.33659E+01, 0.33749E+01, 0.33838E+01, 0.33927E+01, 0.34016E+01,
- & 0.34104E+01, 0.34191E+01, 0.34278E+01, 0.34365E+01, 0.34452E+01,
- & 0.34538E+01, 0.34623E+01, 0.34708E+01, 0.34793E+01, 0.34878E+01,
- & 0.34962E+01, 0.35045E+01, 0.35128E+01, 0.35211E+01, 0.35294E+01,
- & 0.35376E+01
- & /
-C
-C *** (NH4)3H(SO4)2
-C
- DATA (BNC13M(I),I=1,100)/
- &-0.74160E-01,-0.16032E+00,-0.20289E+00,-0.23274E+00,-0.25599E+00,
- &-0.27511E+00,-0.29137E+00,-0.30552E+00,-0.31804E+00,-0.32926E+00,
- &-0.33941E+00,-0.34868E+00,-0.35720E+00,-0.36507E+00,-0.37238E+00,
- &-0.37919E+00,-0.38556E+00,-0.39153E+00,-0.39715E+00,-0.40245E+00,
- &-0.40745E+00,-0.41219E+00,-0.41668E+00,-0.42094E+00,-0.42499E+00,
- &-0.42884E+00,-0.43251E+00,-0.43600E+00,-0.43934E+00,-0.44252E+00,
- &-0.44556E+00,-0.44847E+00,-0.45124E+00,-0.45390E+00,-0.45644E+00,
- &-0.45887E+00,-0.46119E+00,-0.46342E+00,-0.46555E+00,-0.46759E+00,
- &-0.46955E+00,-0.47142E+00,-0.47321E+00,-0.47492E+00,-0.47656E+00,
- &-0.47813E+00,-0.47963E+00,-0.48107E+00,-0.48244E+00,-0.48376E+00,
- &-0.48501E+00,-0.48621E+00,-0.48736E+00,-0.48845E+00,-0.48950E+00,
- &-0.49049E+00,-0.49144E+00,-0.49234E+00,-0.49320E+00,-0.49402E+00,
- &-0.49480E+00,-0.49554E+00,-0.49623E+00,-0.49690E+00,-0.49752E+00,
- &-0.49812E+00,-0.49867E+00,-0.49920E+00,-0.49969E+00,-0.50015E+00,
- &-0.50059E+00,-0.50099E+00,-0.50136E+00,-0.50171E+00,-0.50203E+00,
- &-0.50232E+00,-0.50259E+00,-0.50283E+00,-0.50305E+00,-0.50324E+00,
- &-0.50341E+00,-0.50356E+00,-0.50369E+00,-0.50379E+00,-0.50387E+00,
- &-0.50393E+00,-0.50397E+00,-0.50399E+00,-0.50399E+00,-0.50397E+00,
- &-0.50393E+00,-0.50387E+00,-0.50380E+00,-0.50371E+00,-0.50360E+00,
- &-0.50347E+00,-0.50333E+00,-0.50317E+00,-0.50300E+00,-0.50281E+00/
-
- DATA (BNC13M(I),I=101,200)/
- &-0.50260E+00,-0.50239E+00,-0.50216E+00,-0.50191E+00,-0.50165E+00,
- &-0.50138E+00,-0.50110E+00,-0.50081E+00,-0.50050E+00,-0.50019E+00,
- &-0.49986E+00,-0.49953E+00,-0.49918E+00,-0.49882E+00,-0.49846E+00,
- &-0.49809E+00,-0.49771E+00,-0.49732E+00,-0.49692E+00,-0.49652E+00,
- &-0.49610E+00,-0.49569E+00,-0.49526E+00,-0.49483E+00,-0.49439E+00,
- &-0.49395E+00,-0.49350E+00,-0.49305E+00,-0.49259E+00,-0.49213E+00,
- &-0.49166E+00,-0.49119E+00,-0.49071E+00,-0.49023E+00,-0.48975E+00,
- &-0.48926E+00,-0.48877E+00,-0.48827E+00,-0.48777E+00,-0.48727E+00,
- &-0.48677E+00,-0.48626E+00,-0.48575E+00,-0.48523E+00,-0.48472E+00,
- &-0.48420E+00,-0.48368E+00,-0.48315E+00,-0.48263E+00,-0.48210E+00,
- &-0.48157E+00,-0.48104E+00,-0.48050E+00,-0.47997E+00,-0.47943E+00,
- &-0.47889E+00,-0.47835E+00,-0.47781E+00,-0.47727E+00,-0.47672E+00,
- &-0.47617E+00,-0.47563E+00,-0.47508E+00,-0.47453E+00,-0.47398E+00,
- &-0.47342E+00,-0.47287E+00,-0.47232E+00,-0.47176E+00,-0.47121E+00,
- &-0.47065E+00,-0.47009E+00,-0.46953E+00,-0.46897E+00,-0.46841E+00,
- &-0.46785E+00,-0.46729E+00,-0.46673E+00,-0.46617E+00,-0.46560E+00,
- &-0.46504E+00,-0.46448E+00,-0.46391E+00,-0.46335E+00,-0.46278E+00,
- &-0.46222E+00,-0.46165E+00,-0.46108E+00,-0.46052E+00,-0.45995E+00,
- &-0.45938E+00,-0.45882E+00,-0.45825E+00,-0.45768E+00,-0.45711E+00,
- &-0.45655E+00,-0.45598E+00,-0.45541E+00,-0.45484E+00,-0.45428E+00/
-
- DATA (BNC13M(I),I=201,300)/
- &-0.45371E+00,-0.45314E+00,-0.45257E+00,-0.45200E+00,-0.45144E+00,
- &-0.45087E+00,-0.45030E+00,-0.44973E+00,-0.44917E+00,-0.44860E+00,
- &-0.44803E+00,-0.44746E+00,-0.44690E+00,-0.44633E+00,-0.44576E+00,
- &-0.44520E+00,-0.44463E+00,-0.44406E+00,-0.44350E+00,-0.44293E+00,
- &-0.44237E+00,-0.44180E+00,-0.44124E+00,-0.44067E+00,-0.44011E+00,
- &-0.43954E+00,-0.43898E+00,-0.43842E+00,-0.43785E+00,-0.43729E+00,
- &-0.43673E+00,-0.43617E+00,-0.43560E+00,-0.43504E+00,-0.43448E+00,
- &-0.43392E+00,-0.43336E+00,-0.43280E+00,-0.43224E+00,-0.43168E+00,
- &-0.43112E+00,-0.43056E+00,-0.43000E+00,-0.42945E+00,-0.42889E+00,
- &-0.42833E+00,-0.42778E+00,-0.42722E+00,-0.42666E+00,-0.42611E+00,
- &-0.42555E+00,-0.42500E+00,-0.42445E+00,-0.42389E+00,-0.42334E+00,
- &-0.42279E+00,-0.42223E+00,-0.42168E+00,-0.42113E+00,-0.42058E+00,
- &-0.42003E+00,-0.41948E+00,-0.41893E+00,-0.41838E+00,-0.41783E+00,
- &-0.41729E+00,-0.41674E+00,-0.41619E+00,-0.41564E+00,-0.41510E+00,
- &-0.41455E+00,-0.41401E+00,-0.41346E+00,-0.41292E+00,-0.41238E+00,
- &-0.41183E+00,-0.41129E+00,-0.41075E+00,-0.41021E+00,-0.40967E+00,
- &-0.40913E+00,-0.40859E+00,-0.40805E+00,-0.40751E+00,-0.40697E+00,
- &-0.40643E+00,-0.40589E+00,-0.40536E+00,-0.40482E+00,-0.40429E+00,
- &-0.40375E+00,-0.40322E+00,-0.40268E+00,-0.40215E+00,-0.40161E+00,
- &-0.40108E+00,-0.40055E+00,-0.40002E+00,-0.39949E+00,-0.39896E+00/
-
- DATA (BNC13M(I),I=301,400)/
- &-0.39843E+00,-0.39790E+00,-0.39737E+00,-0.39684E+00,-0.39631E+00,
- &-0.39579E+00,-0.39526E+00,-0.39473E+00,-0.39421E+00,-0.39368E+00,
- &-0.39316E+00,-0.39263E+00,-0.39211E+00,-0.39159E+00,-0.39106E+00,
- &-0.39054E+00,-0.39002E+00,-0.38950E+00,-0.38898E+00,-0.38846E+00,
- &-0.38794E+00,-0.38742E+00,-0.38691E+00,-0.38639E+00,-0.38587E+00,
- &-0.38535E+00,-0.38484E+00,-0.38432E+00,-0.38381E+00,-0.38329E+00,
- &-0.38278E+00,-0.38227E+00,-0.38175E+00,-0.38124E+00,-0.38073E+00,
- &-0.38022E+00,-0.37971E+00,-0.37920E+00,-0.37869E+00,-0.37818E+00,
- &-0.37767E+00,-0.37717E+00,-0.37666E+00,-0.37615E+00,-0.37565E+00,
- &-0.37514E+00,-0.37464E+00,-0.37413E+00,-0.37363E+00,-0.37312E+00,
- &-0.37262E+00,-0.37212E+00,-0.37162E+00,-0.37112E+00,-0.37061E+00,
- &-0.37011E+00,-0.36961E+00,-0.36912E+00,-0.36862E+00,-0.36812E+00,
- &-0.36762E+00,-0.36712E+00,-0.36663E+00,-0.36613E+00,-0.36564E+00,
- &-0.36514E+00,-0.36465E+00,-0.36415E+00,-0.36366E+00,-0.36317E+00,
- &-0.36268E+00,-0.36218E+00,-0.36169E+00,-0.36120E+00,-0.36071E+00,
- &-0.36022E+00,-0.35973E+00,-0.35925E+00,-0.35876E+00,-0.35827E+00,
- &-0.35778E+00,-0.35730E+00,-0.35681E+00,-0.35633E+00,-0.35584E+00,
- &-0.35536E+00,-0.35487E+00,-0.35439E+00,-0.35391E+00,-0.35343E+00,
- &-0.35294E+00,-0.35246E+00,-0.35198E+00,-0.35150E+00,-0.35102E+00,
- &-0.35054E+00,-0.35006E+00,-0.34959E+00,-0.34911E+00,-0.34863E+00/
-
- DATA (BNC13M(I),I=401,500)/
- &-0.34816E+00,-0.34768E+00,-0.34720E+00,-0.34673E+00,-0.34625E+00,
- &-0.34578E+00,-0.34531E+00,-0.34483E+00,-0.34436E+00,-0.34389E+00,
- &-0.34342E+00,-0.34295E+00,-0.34248E+00,-0.34201E+00,-0.34154E+00,
- &-0.34107E+00,-0.34060E+00,-0.34013E+00,-0.33967E+00,-0.33920E+00,
- &-0.33873E+00,-0.33827E+00,-0.33780E+00,-0.33734E+00,-0.33687E+00,
- &-0.33641E+00,-0.33594E+00,-0.33548E+00,-0.33502E+00,-0.33456E+00,
- &-0.33410E+00,-0.33363E+00,-0.33317E+00,-0.33271E+00,-0.33225E+00,
- &-0.33180E+00,-0.33134E+00,-0.33088E+00,-0.33042E+00,-0.32996E+00,
- &-0.32951E+00,-0.32905E+00,-0.32860E+00,-0.32814E+00,-0.32769E+00,
- &-0.32723E+00,-0.32678E+00,-0.32633E+00,-0.32587E+00,-0.32542E+00,
- &-0.32497E+00,-0.32452E+00,-0.32407E+00,-0.32362E+00,-0.32317E+00,
- &-0.32272E+00,-0.32227E+00,-0.32182E+00,-0.32137E+00,-0.32092E+00,
- &-0.32048E+00,-0.32003E+00,-0.31958E+00,-0.31914E+00,-0.31869E+00,
- &-0.31825E+00,-0.31781E+00,-0.31736E+00,-0.31692E+00,-0.31648E+00,
- &-0.31603E+00,-0.31559E+00,-0.31515E+00,-0.31471E+00,-0.31427E+00,
- &-0.31383E+00,-0.31339E+00,-0.31295E+00,-0.31251E+00,-0.31207E+00,
- &-0.31163E+00,-0.31120E+00,-0.31076E+00,-0.31032E+00,-0.30989E+00,
- &-0.30945E+00,-0.30902E+00,-0.30858E+00,-0.30815E+00,-0.30771E+00,
- &-0.30728E+00,-0.30685E+00,-0.30642E+00,-0.30598E+00,-0.30555E+00,
- &-0.30512E+00,-0.30469E+00,-0.30426E+00,-0.30383E+00,-0.30340E+00/
-
- DATA (BNC13M(I),I=501,600)/
- &-0.30297E+00,-0.30254E+00,-0.30212E+00,-0.30169E+00,-0.30126E+00,
- &-0.30084E+00,-0.30041E+00,-0.29998E+00,-0.29956E+00,-0.29913E+00,
- &-0.29871E+00,-0.29828E+00,-0.29786E+00,-0.29744E+00,-0.29701E+00,
- &-0.29659E+00,-0.29617E+00,-0.29575E+00,-0.29533E+00,-0.29491E+00,
- &-0.29449E+00,-0.29407E+00,-0.29365E+00,-0.29323E+00,-0.29281E+00,
- &-0.29239E+00,-0.29197E+00,-0.29156E+00,-0.29114E+00,-0.29072E+00,
- &-0.29031E+00,-0.28989E+00,-0.28948E+00,-0.28906E+00,-0.28865E+00,
- &-0.28823E+00,-0.28782E+00,-0.28741E+00,-0.28700E+00,-0.28658E+00,
- &-0.28617E+00,-0.28576E+00,-0.28535E+00,-0.28494E+00,-0.28453E+00,
- &-0.28412E+00,-0.28371E+00,-0.28330E+00,-0.28289E+00,-0.28248E+00,
- &-0.28208E+00,-0.28167E+00,-0.28126E+00,-0.28085E+00,-0.28045E+00,
- &-0.28004E+00,-0.27964E+00,-0.27923E+00,-0.27883E+00,-0.27842E+00,
- &-0.27802E+00,-0.27762E+00,-0.27721E+00,-0.27681E+00,-0.27641E+00,
- &-0.27601E+00,-0.27561E+00,-0.27520E+00,-0.27480E+00,-0.27440E+00,
- &-0.27400E+00,-0.27360E+00,-0.27320E+00,-0.27281E+00,-0.27241E+00,
- &-0.27201E+00,-0.27161E+00,-0.27122E+00,-0.27082E+00,-0.27042E+00,
- &-0.27003E+00,-0.26963E+00,-0.26924E+00,-0.26884E+00,-0.26845E+00,
- &-0.26805E+00,-0.26766E+00,-0.26727E+00,-0.26687E+00,-0.26648E+00,
- &-0.26609E+00,-0.26570E+00,-0.26530E+00,-0.26491E+00,-0.26452E+00,
- &-0.26413E+00,-0.26374E+00,-0.26335E+00,-0.26296E+00,-0.26257E+00/
-
- DATA (BNC13M(I),I=601,700)/
- &-0.25840E+00,-0.25457E+00,-0.25078E+00,-0.24702E+00,-0.24330E+00,
- &-0.23961E+00,-0.23595E+00,-0.23233E+00,-0.22874E+00,-0.22518E+00,
- &-0.22165E+00,-0.21815E+00,-0.21469E+00,-0.21125E+00,-0.20784E+00,
- &-0.20447E+00,-0.20112E+00,-0.19779E+00,-0.19450E+00,-0.19123E+00,
- &-0.18799E+00,-0.18477E+00,-0.18158E+00,-0.17842E+00,-0.17528E+00,
- &-0.17217E+00,-0.16907E+00,-0.16601E+00,-0.16297E+00,-0.15995E+00,
- &-0.15695E+00,-0.15397E+00,-0.15102E+00,-0.14809E+00,-0.14518E+00,
- &-0.14229E+00,-0.13943E+00,-0.13658E+00,-0.13375E+00,-0.13095E+00,
- &-0.12816E+00,-0.12539E+00,-0.12265E+00,-0.11992E+00,-0.11721E+00,
- &-0.11452E+00,-0.11184E+00,-0.10919E+00,-0.10655E+00,-0.10393E+00,
- &-0.10133E+00,-0.98739E-01,-0.96170E-01,-0.93617E-01,-0.91081E-01,
- &-0.88561E-01,-0.86056E-01,-0.83568E-01,-0.81095E-01,-0.78637E-01,
- &-0.76195E-01,-0.73767E-01,-0.71355E-01,-0.68957E-01,-0.66573E-01,
- &-0.64204E-01,-0.61849E-01,-0.59507E-01,-0.57180E-01,-0.54866E-01,
- &-0.52566E-01,-0.50278E-01,-0.48004E-01,-0.45744E-01,-0.43495E-01,
- &-0.41260E-01,-0.39037E-01,-0.36827E-01,-0.34628E-01,-0.32442E-01,
- &-0.30268E-01,-0.28106E-01,-0.25955E-01,-0.23817E-01,-0.21689E-01,
- &-0.19573E-01,-0.17469E-01,-0.15375E-01,-0.13292E-01,-0.11221E-01,
- &-0.91596E-02,-0.71093E-02,-0.50696E-02,-0.30403E-02,-0.10211E-02,
- & 0.98760E-03, 0.29861E-02, 0.49747E-02, 0.69537E-02, 0.89224E-02/
-
- DATA (BNC13M(I),I=701,741)/
- & 0.10882E-01, 0.12831E-01, 0.14771E-01, 0.16702E-01, 0.18623E-01,
- & 0.20535E-01, 0.22438E-01, 0.24331E-01, 0.26216E-01, 0.28092E-01,
- & 0.29959E-01, 0.31817E-01, 0.33667E-01, 0.35508E-01, 0.37341E-01,
- & 0.39165E-01, 0.40981E-01, 0.42788E-01, 0.44588E-01, 0.46379E-01,
- & 0.48162E-01, 0.49937E-01, 0.51705E-01, 0.53465E-01, 0.55216E-01,
- & 0.56960E-01, 0.58697E-01, 0.60426E-01, 0.62147E-01, 0.63862E-01,
- & 0.65569E-01, 0.67268E-01, 0.68960E-01, 0.70645E-01, 0.72323E-01,
- & 0.73994E-01, 0.75658E-01, 0.77315E-01, 0.78966E-01, 0.80609E-01,
- & 0.82246E-01
- & /
- END
-
-
diff --git a/src/MNH/data_kmcf323a.f b/src/MNH/data_kmcf323a.f
deleted file mode 100644
index 228fe1d54101f7077f5cfd9caee0a0c1a48576e2..0000000000000000000000000000000000000000
--- a/src/MNH/data_kmcf323a.f
+++ /dev/null
@@ -1,2217 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 data_kmcf323a.f 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-C=======================================================================
-C
-C *** ISORROPIA CODE
-C *** BLOCK DATA KMCF323A
-C *** CONTAINS THE DATA FOR KUSSIK-MEISNER BINARY COEFFICIENT ARRAYS
-C NEEDED IN SUBROUTINE KM
-C
-C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
-C *** WRITTEN BY ATHANASIOS NENES
-C
-C=======================================================================
-C
- BLOCK DATA KMCF323
-C
-C *** Common block definition
-C
- COMMON /KMC323/
- &BNC01M( 741),BNC02M( 741),BNC03M( 741),BNC04M( 741),
- &BNC05M( 741),BNC06M( 741),BNC07M( 741),BNC08M( 741),
- &BNC09M( 741),BNC10M( 741),BNC11M( 741),BNC12M( 741),
- &BNC13M( 741)
-C
-C *** NaCl
-C
- DATA (BNC01M(I),I=1,100)/
- &-0.44252E-01,-0.92492E-01,-0.11448E+00,-0.12890E+00,-0.13941E+00,
- &-0.14750E+00,-0.15391E+00,-0.15911E+00,-0.16337E+00,-0.16690E+00,
- &-0.16982E+00,-0.17224E+00,-0.17425E+00,-0.17590E+00,-0.17724E+00,
- &-0.17831E+00,-0.17916E+00,-0.17979E+00,-0.18025E+00,-0.18054E+00,
- &-0.18068E+00,-0.18069E+00,-0.18058E+00,-0.18037E+00,-0.18006E+00,
- &-0.17965E+00,-0.17917E+00,-0.17861E+00,-0.17799E+00,-0.17730E+00,
- &-0.17656E+00,-0.17576E+00,-0.17492E+00,-0.17403E+00,-0.17310E+00,
- &-0.17213E+00,-0.17113E+00,-0.17010E+00,-0.16904E+00,-0.16795E+00,
- &-0.16684E+00,-0.16571E+00,-0.16455E+00,-0.16338E+00,-0.16219E+00,
- &-0.16098E+00,-0.15976E+00,-0.15852E+00,-0.15727E+00,-0.15601E+00,
- &-0.15473E+00,-0.15345E+00,-0.15216E+00,-0.15085E+00,-0.14954E+00,
- &-0.14822E+00,-0.14689E+00,-0.14556E+00,-0.14421E+00,-0.14286E+00,
- &-0.14150E+00,-0.14014E+00,-0.13876E+00,-0.13738E+00,-0.13599E+00,
- &-0.13459E+00,-0.13319E+00,-0.13177E+00,-0.13035E+00,-0.12892E+00,
- &-0.12748E+00,-0.12603E+00,-0.12457E+00,-0.12310E+00,-0.12162E+00,
- &-0.12013E+00,-0.11863E+00,-0.11712E+00,-0.11560E+00,-0.11407E+00,
- &-0.11253E+00,-0.11097E+00,-0.10940E+00,-0.10782E+00,-0.10623E+00,
- &-0.10463E+00,-0.10301E+00,-0.10138E+00,-0.99742E-01,-0.98090E-01,
- &-0.96425E-01,-0.94749E-01,-0.93061E-01,-0.91361E-01,-0.89649E-01,
- &-0.87927E-01,-0.86193E-01,-0.84448E-01,-0.82693E-01,-0.80928E-01/
-
- DATA (BNC01M(I),I=101,200)/
- &-0.79153E-01,-0.77368E-01,-0.75574E-01,-0.73772E-01,-0.71960E-01,
- &-0.70141E-01,-0.68314E-01,-0.66479E-01,-0.64638E-01,-0.62790E-01,
- &-0.60935E-01,-0.59075E-01,-0.57209E-01,-0.55338E-01,-0.53462E-01,
- &-0.51582E-01,-0.49697E-01,-0.47809E-01,-0.45917E-01,-0.44022E-01,
- &-0.42125E-01,-0.40224E-01,-0.38321E-01,-0.36416E-01,-0.34510E-01,
- &-0.32601E-01,-0.30691E-01,-0.28780E-01,-0.26868E-01,-0.24955E-01,
- &-0.23041E-01,-0.21127E-01,-0.19212E-01,-0.17298E-01,-0.15383E-01,
- &-0.13468E-01,-0.11553E-01,-0.96383E-02,-0.77240E-02,-0.58102E-02,
- &-0.38968E-02,-0.19841E-02,-0.72052E-04, 0.18393E-02, 0.37498E-02,
- & 0.56595E-02, 0.75683E-02, 0.94761E-02, 0.11383E-01, 0.13289E-01,
- & 0.15193E-01, 0.17097E-01, 0.18999E-01, 0.20900E-01, 0.22800E-01,
- & 0.24698E-01, 0.26595E-01, 0.28491E-01, 0.30386E-01, 0.32279E-01,
- & 0.34170E-01, 0.36060E-01, 0.37949E-01, 0.39836E-01, 0.41721E-01,
- & 0.43605E-01, 0.45488E-01, 0.47369E-01, 0.49248E-01, 0.51125E-01,
- & 0.53001E-01, 0.54875E-01, 0.56748E-01, 0.58618E-01, 0.60487E-01,
- & 0.62355E-01, 0.64220E-01, 0.66084E-01, 0.67946E-01, 0.69806E-01,
- & 0.71664E-01, 0.73521E-01, 0.75376E-01, 0.77228E-01, 0.79079E-01,
- & 0.80928E-01, 0.82775E-01, 0.84621E-01, 0.86464E-01, 0.88305E-01,
- & 0.90145E-01, 0.91982E-01, 0.93818E-01, 0.95651E-01, 0.97483E-01,
- & 0.99313E-01, 0.10114E+00, 0.10297E+00, 0.10479E+00, 0.10661E+00/
-
- DATA (BNC01M(I),I=201,300)/
- & 0.10843E+00, 0.11025E+00, 0.11206E+00, 0.11388E+00, 0.11569E+00,
- & 0.11750E+00, 0.11931E+00, 0.12111E+00, 0.12291E+00, 0.12472E+00,
- & 0.12651E+00, 0.12831E+00, 0.13011E+00, 0.13190E+00, 0.13369E+00,
- & 0.13548E+00, 0.13726E+00, 0.13905E+00, 0.14083E+00, 0.14261E+00,
- & 0.14439E+00, 0.14617E+00, 0.14794E+00, 0.14971E+00, 0.15148E+00,
- & 0.15325E+00, 0.15501E+00, 0.15678E+00, 0.15854E+00, 0.16030E+00,
- & 0.16205E+00, 0.16381E+00, 0.16556E+00, 0.16731E+00, 0.16906E+00,
- & 0.17080E+00, 0.17255E+00, 0.17429E+00, 0.17603E+00, 0.17777E+00,
- & 0.17950E+00, 0.18124E+00, 0.18297E+00, 0.18470E+00, 0.18642E+00,
- & 0.18815E+00, 0.18987E+00, 0.19159E+00, 0.19331E+00, 0.19502E+00,
- & 0.19674E+00, 0.19845E+00, 0.20016E+00, 0.20187E+00, 0.20357E+00,
- & 0.20527E+00, 0.20697E+00, 0.20867E+00, 0.21037E+00, 0.21206E+00,
- & 0.21376E+00, 0.21545E+00, 0.21714E+00, 0.21882E+00, 0.22050E+00,
- & 0.22219E+00, 0.22387E+00, 0.22554E+00, 0.22722E+00, 0.22889E+00,
- & 0.23056E+00, 0.23223E+00, 0.23390E+00, 0.23556E+00, 0.23723E+00,
- & 0.23889E+00, 0.24054E+00, 0.24220E+00, 0.24386E+00, 0.24551E+00,
- & 0.24716E+00, 0.24880E+00, 0.25045E+00, 0.25209E+00, 0.25374E+00,
- & 0.25538E+00, 0.25701E+00, 0.25865E+00, 0.26028E+00, 0.26191E+00,
- & 0.26354E+00, 0.26517E+00, 0.26679E+00, 0.26842E+00, 0.27004E+00,
- & 0.27166E+00, 0.27327E+00, 0.27489E+00, 0.27650E+00, 0.27811E+00/
-
- DATA (BNC01M(I),I=301,400)/
- & 0.27972E+00, 0.28132E+00, 0.28293E+00, 0.28453E+00, 0.28613E+00,
- & 0.28773E+00, 0.28933E+00, 0.29092E+00, 0.29251E+00, 0.29410E+00,
- & 0.29569E+00, 0.29728E+00, 0.29886E+00, 0.30044E+00, 0.30202E+00,
- & 0.30360E+00, 0.30518E+00, 0.30675E+00, 0.30832E+00, 0.30989E+00,
- & 0.31146E+00, 0.31303E+00, 0.31459E+00, 0.31615E+00, 0.31771E+00,
- & 0.31927E+00, 0.32083E+00, 0.32238E+00, 0.32393E+00, 0.32549E+00,
- & 0.32703E+00, 0.32858E+00, 0.33012E+00, 0.33167E+00, 0.33321E+00,
- & 0.33475E+00, 0.33628E+00, 0.33782E+00, 0.33935E+00, 0.34088E+00,
- & 0.34241E+00, 0.34394E+00, 0.34546E+00, 0.34699E+00, 0.34851E+00,
- & 0.35003E+00, 0.35155E+00, 0.35306E+00, 0.35458E+00, 0.35609E+00,
- & 0.35760E+00, 0.35911E+00, 0.36061E+00, 0.36212E+00, 0.36362E+00,
- & 0.36512E+00, 0.36662E+00, 0.36812E+00, 0.36961E+00, 0.37111E+00,
- & 0.37260E+00, 0.37409E+00, 0.37558E+00, 0.37706E+00, 0.37855E+00,
- & 0.38003E+00, 0.38151E+00, 0.38299E+00, 0.38447E+00, 0.38594E+00,
- & 0.38741E+00, 0.38889E+00, 0.39036E+00, 0.39182E+00, 0.39329E+00,
- & 0.39476E+00, 0.39622E+00, 0.39768E+00, 0.39914E+00, 0.40060E+00,
- & 0.40205E+00, 0.40350E+00, 0.40496E+00, 0.40641E+00, 0.40786E+00,
- & 0.40930E+00, 0.41075E+00, 0.41219E+00, 0.41363E+00, 0.41507E+00,
- & 0.41651E+00, 0.41795E+00, 0.41938E+00, 0.42081E+00, 0.42225E+00,
- & 0.42367E+00, 0.42510E+00, 0.42653E+00, 0.42795E+00, 0.42938E+00/
-
- DATA (BNC01M(I),I=401,500)/
- & 0.43080E+00, 0.43222E+00, 0.43363E+00, 0.43505E+00, 0.43646E+00,
- & 0.43788E+00, 0.43929E+00, 0.44070E+00, 0.44210E+00, 0.44351E+00,
- & 0.44491E+00, 0.44632E+00, 0.44772E+00, 0.44912E+00, 0.45051E+00,
- & 0.45191E+00, 0.45331E+00, 0.45470E+00, 0.45609E+00, 0.45748E+00,
- & 0.45887E+00, 0.46025E+00, 0.46164E+00, 0.46302E+00, 0.46440E+00,
- & 0.46578E+00, 0.46716E+00, 0.46854E+00, 0.46991E+00, 0.47128E+00,
- & 0.47266E+00, 0.47403E+00, 0.47539E+00, 0.47676E+00, 0.47813E+00,
- & 0.47949E+00, 0.48085E+00, 0.48221E+00, 0.48357E+00, 0.48493E+00,
- & 0.48629E+00, 0.48764E+00, 0.48899E+00, 0.49035E+00, 0.49170E+00,
- & 0.49304E+00, 0.49439E+00, 0.49574E+00, 0.49708E+00, 0.49842E+00,
- & 0.49976E+00, 0.50110E+00, 0.50244E+00, 0.50378E+00, 0.50511E+00,
- & 0.50644E+00, 0.50778E+00, 0.50911E+00, 0.51043E+00, 0.51176E+00,
- & 0.51309E+00, 0.51441E+00, 0.51573E+00, 0.51706E+00, 0.51838E+00,
- & 0.51969E+00, 0.52101E+00, 0.52233E+00, 0.52364E+00, 0.52495E+00,
- & 0.52626E+00, 0.52757E+00, 0.52888E+00, 0.53019E+00, 0.53149E+00,
- & 0.53280E+00, 0.53410E+00, 0.53540E+00, 0.53670E+00, 0.53800E+00,
- & 0.53929E+00, 0.54059E+00, 0.54188E+00, 0.54317E+00, 0.54446E+00,
- & 0.54575E+00, 0.54704E+00, 0.54833E+00, 0.54961E+00, 0.55090E+00,
- & 0.55218E+00, 0.55346E+00, 0.55474E+00, 0.55602E+00, 0.55730E+00,
- & 0.55857E+00, 0.55985E+00, 0.56112E+00, 0.56239E+00, 0.56366E+00/
-
- DATA (BNC01M(I),I=501,600)/
- & 0.56493E+00, 0.56620E+00, 0.56746E+00, 0.56873E+00, 0.56999E+00,
- & 0.57125E+00, 0.57251E+00, 0.57377E+00, 0.57503E+00, 0.57629E+00,
- & 0.57754E+00, 0.57879E+00, 0.58005E+00, 0.58130E+00, 0.58255E+00,
- & 0.58380E+00, 0.58504E+00, 0.58629E+00, 0.58753E+00, 0.58878E+00,
- & 0.59002E+00, 0.59126E+00, 0.59250E+00, 0.59374E+00, 0.59497E+00,
- & 0.59621E+00, 0.59744E+00, 0.59868E+00, 0.59991E+00, 0.60114E+00,
- & 0.60237E+00, 0.60359E+00, 0.60482E+00, 0.60605E+00, 0.60727E+00,
- & 0.60849E+00, 0.60971E+00, 0.61093E+00, 0.61215E+00, 0.61337E+00,
- & 0.61459E+00, 0.61580E+00, 0.61702E+00, 0.61823E+00, 0.61944E+00,
- & 0.62065E+00, 0.62186E+00, 0.62307E+00, 0.62427E+00, 0.62548E+00,
- & 0.62668E+00, 0.62788E+00, 0.62909E+00, 0.63029E+00, 0.63149E+00,
- & 0.63268E+00, 0.63388E+00, 0.63508E+00, 0.63627E+00, 0.63746E+00,
- & 0.63865E+00, 0.63985E+00, 0.64103E+00, 0.64222E+00, 0.64341E+00,
- & 0.64460E+00, 0.64578E+00, 0.64696E+00, 0.64815E+00, 0.64933E+00,
- & 0.65051E+00, 0.65169E+00, 0.65286E+00, 0.65404E+00, 0.65521E+00,
- & 0.65639E+00, 0.65756E+00, 0.65873E+00, 0.65990E+00, 0.66107E+00,
- & 0.66224E+00, 0.66341E+00, 0.66457E+00, 0.66574E+00, 0.66690E+00,
- & 0.66807E+00, 0.66923E+00, 0.67039E+00, 0.67155E+00, 0.67270E+00,
- & 0.67386E+00, 0.67502E+00, 0.67617E+00, 0.67733E+00, 0.67848E+00,
- & 0.67963E+00, 0.68078E+00, 0.68193E+00, 0.68308E+00, 0.68422E+00/
-
- DATA (BNC01M(I),I=601,700)/
- & 0.69654E+00, 0.70783E+00, 0.71902E+00, 0.73010E+00, 0.74108E+00,
- & 0.75196E+00, 0.76274E+00, 0.77342E+00, 0.78402E+00, 0.79451E+00,
- & 0.80492E+00, 0.81524E+00, 0.82547E+00, 0.83562E+00, 0.84568E+00,
- & 0.85566E+00, 0.86556E+00, 0.87538E+00, 0.88512E+00, 0.89479E+00,
- & 0.90437E+00, 0.91389E+00, 0.92333E+00, 0.93270E+00, 0.94200E+00,
- & 0.95123E+00, 0.96040E+00, 0.96949E+00, 0.97852E+00, 0.98749E+00,
- & 0.99639E+00, 0.10052E+01, 0.10140E+01, 0.10227E+01, 0.10314E+01,
- & 0.10400E+01, 0.10485E+01, 0.10570E+01, 0.10654E+01, 0.10738E+01,
- & 0.10821E+01, 0.10904E+01, 0.10986E+01, 0.11068E+01, 0.11149E+01,
- & 0.11230E+01, 0.11310E+01, 0.11389E+01, 0.11469E+01, 0.11547E+01,
- & 0.11625E+01, 0.11703E+01, 0.11780E+01, 0.11857E+01, 0.11934E+01,
- & 0.12010E+01, 0.12085E+01, 0.12160E+01, 0.12235E+01, 0.12309E+01,
- & 0.12383E+01, 0.12457E+01, 0.12530E+01, 0.12602E+01, 0.12675E+01,
- & 0.12747E+01, 0.12818E+01, 0.12889E+01, 0.12960E+01, 0.13031E+01,
- & 0.13101E+01, 0.13170E+01, 0.13240E+01, 0.13309E+01, 0.13378E+01,
- & 0.13446E+01, 0.13514E+01, 0.13582E+01, 0.13649E+01, 0.13716E+01,
- & 0.13783E+01, 0.13849E+01, 0.13915E+01, 0.13981E+01, 0.14047E+01,
- & 0.14112E+01, 0.14177E+01, 0.14241E+01, 0.14306E+01, 0.14370E+01,
- & 0.14434E+01, 0.14497E+01, 0.14560E+01, 0.14623E+01, 0.14686E+01,
- & 0.14748E+01, 0.14810E+01, 0.14872E+01, 0.14934E+01, 0.14995E+01/
-
- DATA (BNC01M(I),I=701,741)/
- & 0.15056E+01, 0.15117E+01, 0.15178E+01, 0.15238E+01, 0.15298E+01,
- & 0.15358E+01, 0.15418E+01, 0.15477E+01, 0.15536E+01, 0.15595E+01,
- & 0.15654E+01, 0.15713E+01, 0.15771E+01, 0.15829E+01, 0.15887E+01,
- & 0.15944E+01, 0.16002E+01, 0.16059E+01, 0.16116E+01, 0.16173E+01,
- & 0.16229E+01, 0.16286E+01, 0.16342E+01, 0.16398E+01, 0.16453E+01,
- & 0.16509E+01, 0.16564E+01, 0.16620E+01, 0.16675E+01, 0.16729E+01,
- & 0.16784E+01, 0.16838E+01, 0.16893E+01, 0.16947E+01, 0.17000E+01,
- & 0.17054E+01, 0.17108E+01, 0.17161E+01, 0.17214E+01, 0.17267E+01,
- & 0.17320E+01
- & /
-C
-C *** Na2SO4
-C
- DATA (BNC02M(I),I=1,100)/
- &-0.90612E-01,-0.19630E+00,-0.24862E+00,-0.28534E+00,-0.31396E+00,
- &-0.33750E+00,-0.35753E+00,-0.37498E+00,-0.39044E+00,-0.40431E+00,
- &-0.41689E+00,-0.42839E+00,-0.43899E+00,-0.44880E+00,-0.45794E+00,
- &-0.46648E+00,-0.47450E+00,-0.48206E+00,-0.48920E+00,-0.49596E+00,
- &-0.50238E+00,-0.50850E+00,-0.51433E+00,-0.51990E+00,-0.52523E+00,
- &-0.53034E+00,-0.53524E+00,-0.53996E+00,-0.54449E+00,-0.54886E+00,
- &-0.55307E+00,-0.55714E+00,-0.56107E+00,-0.56487E+00,-0.56855E+00,
- &-0.57212E+00,-0.57557E+00,-0.57892E+00,-0.58217E+00,-0.58533E+00,
- &-0.58840E+00,-0.59139E+00,-0.59429E+00,-0.59711E+00,-0.59986E+00,
- &-0.60254E+00,-0.60516E+00,-0.60770E+00,-0.61019E+00,-0.61261E+00,
- &-0.61498E+00,-0.61729E+00,-0.61954E+00,-0.62175E+00,-0.62391E+00,
- &-0.62602E+00,-0.62808E+00,-0.63010E+00,-0.63207E+00,-0.63401E+00,
- &-0.63590E+00,-0.63776E+00,-0.63958E+00,-0.64136E+00,-0.64311E+00,
- &-0.64483E+00,-0.64651E+00,-0.64816E+00,-0.64979E+00,-0.65138E+00,
- &-0.65294E+00,-0.65448E+00,-0.65599E+00,-0.65748E+00,-0.65894E+00,
- &-0.66037E+00,-0.66179E+00,-0.66318E+00,-0.66454E+00,-0.66589E+00,
- &-0.66722E+00,-0.66852E+00,-0.66981E+00,-0.67108E+00,-0.67233E+00,
- &-0.67356E+00,-0.67478E+00,-0.67598E+00,-0.67716E+00,-0.67832E+00,
- &-0.67947E+00,-0.68061E+00,-0.68173E+00,-0.68283E+00,-0.68392E+00,
- &-0.68500E+00,-0.68606E+00,-0.68711E+00,-0.68815E+00,-0.68918E+00/
-
- DATA (BNC02M(I),I=101,200)/
- &-0.69019E+00,-0.69119E+00,-0.69218E+00,-0.69315E+00,-0.69412E+00,
- &-0.69507E+00,-0.69601E+00,-0.69694E+00,-0.69786E+00,-0.69877E+00,
- &-0.69967E+00,-0.70056E+00,-0.70144E+00,-0.70230E+00,-0.70316E+00,
- &-0.70401E+00,-0.70485E+00,-0.70568E+00,-0.70650E+00,-0.70731E+00,
- &-0.70811E+00,-0.70890E+00,-0.70968E+00,-0.71046E+00,-0.71122E+00,
- &-0.71198E+00,-0.71273E+00,-0.71347E+00,-0.71420E+00,-0.71493E+00,
- &-0.71564E+00,-0.71635E+00,-0.71705E+00,-0.71775E+00,-0.71843E+00,
- &-0.71911E+00,-0.71978E+00,-0.72044E+00,-0.72110E+00,-0.72175E+00,
- &-0.72239E+00,-0.72302E+00,-0.72365E+00,-0.72427E+00,-0.72489E+00,
- &-0.72550E+00,-0.72610E+00,-0.72670E+00,-0.72729E+00,-0.72787E+00,
- &-0.72845E+00,-0.72902E+00,-0.72958E+00,-0.73014E+00,-0.73069E+00,
- &-0.73124E+00,-0.73178E+00,-0.73232E+00,-0.73285E+00,-0.73338E+00,
- &-0.73390E+00,-0.73441E+00,-0.73492E+00,-0.73542E+00,-0.73592E+00,
- &-0.73642E+00,-0.73691E+00,-0.73739E+00,-0.73787E+00,-0.73835E+00,
- &-0.73881E+00,-0.73928E+00,-0.73974E+00,-0.74020E+00,-0.74065E+00,
- &-0.74109E+00,-0.74154E+00,-0.74197E+00,-0.74241E+00,-0.74284E+00,
- &-0.74326E+00,-0.74368E+00,-0.74410E+00,-0.74451E+00,-0.74492E+00,
- &-0.74532E+00,-0.74572E+00,-0.74612E+00,-0.74651E+00,-0.74690E+00,
- &-0.74729E+00,-0.74767E+00,-0.74805E+00,-0.74842E+00,-0.74879E+00,
- &-0.74916E+00,-0.74952E+00,-0.74988E+00,-0.75023E+00,-0.75059E+00/
-
- DATA (BNC02M(I),I=201,300)/
- &-0.75094E+00,-0.75128E+00,-0.75162E+00,-0.75196E+00,-0.75230E+00,
- &-0.75263E+00,-0.75296E+00,-0.75328E+00,-0.75361E+00,-0.75393E+00,
- &-0.75424E+00,-0.75456E+00,-0.75487E+00,-0.75517E+00,-0.75548E+00,
- &-0.75578E+00,-0.75608E+00,-0.75637E+00,-0.75666E+00,-0.75695E+00,
- &-0.75724E+00,-0.75752E+00,-0.75781E+00,-0.75808E+00,-0.75836E+00,
- &-0.75863E+00,-0.75890E+00,-0.75917E+00,-0.75943E+00,-0.75970E+00,
- &-0.75996E+00,-0.76021E+00,-0.76047E+00,-0.76072E+00,-0.76097E+00,
- &-0.76122E+00,-0.76146E+00,-0.76170E+00,-0.76194E+00,-0.76218E+00,
- &-0.76241E+00,-0.76265E+00,-0.76288E+00,-0.76310E+00,-0.76333E+00,
- &-0.76355E+00,-0.76377E+00,-0.76399E+00,-0.76421E+00,-0.76442E+00,
- &-0.76463E+00,-0.76484E+00,-0.76505E+00,-0.76526E+00,-0.76546E+00,
- &-0.76566E+00,-0.76586E+00,-0.76606E+00,-0.76625E+00,-0.76645E+00,
- &-0.76664E+00,-0.76683E+00,-0.76701E+00,-0.76720E+00,-0.76738E+00,
- &-0.76756E+00,-0.76774E+00,-0.76792E+00,-0.76809E+00,-0.76827E+00,
- &-0.76844E+00,-0.76861E+00,-0.76877E+00,-0.76894E+00,-0.76910E+00,
- &-0.76927E+00,-0.76943E+00,-0.76959E+00,-0.76974E+00,-0.76990E+00,
- &-0.77005E+00,-0.77020E+00,-0.77035E+00,-0.77050E+00,-0.77065E+00,
- &-0.77079E+00,-0.77094E+00,-0.77108E+00,-0.77122E+00,-0.77135E+00,
- &-0.77149E+00,-0.77163E+00,-0.77176E+00,-0.77189E+00,-0.77202E+00,
- &-0.77215E+00,-0.77228E+00,-0.77240E+00,-0.77253E+00,-0.77265E+00/
-
- DATA (BNC02M(I),I=301,400)/
- &-0.77277E+00,-0.77289E+00,-0.77301E+00,-0.77312E+00,-0.77324E+00,
- &-0.77335E+00,-0.77346E+00,-0.77357E+00,-0.77368E+00,-0.77379E+00,
- &-0.77389E+00,-0.77400E+00,-0.77410E+00,-0.77420E+00,-0.77430E+00,
- &-0.77440E+00,-0.77450E+00,-0.77460E+00,-0.77469E+00,-0.77479E+00,
- &-0.77488E+00,-0.77497E+00,-0.77506E+00,-0.77515E+00,-0.77524E+00,
- &-0.77532E+00,-0.77541E+00,-0.77549E+00,-0.77557E+00,-0.77565E+00,
- &-0.77573E+00,-0.77581E+00,-0.77589E+00,-0.77596E+00,-0.77604E+00,
- &-0.77611E+00,-0.77618E+00,-0.77625E+00,-0.77632E+00,-0.77639E+00,
- &-0.77646E+00,-0.77652E+00,-0.77659E+00,-0.77665E+00,-0.77671E+00,
- &-0.77678E+00,-0.77684E+00,-0.77689E+00,-0.77695E+00,-0.77701E+00,
- &-0.77707E+00,-0.77712E+00,-0.77717E+00,-0.77723E+00,-0.77728E+00,
- &-0.77733E+00,-0.77738E+00,-0.77743E+00,-0.77747E+00,-0.77752E+00,
- &-0.77756E+00,-0.77761E+00,-0.77765E+00,-0.77769E+00,-0.77773E+00,
- &-0.77777E+00,-0.77781E+00,-0.77785E+00,-0.77789E+00,-0.77792E+00,
- &-0.77796E+00,-0.77799E+00,-0.77802E+00,-0.77805E+00,-0.77809E+00,
- &-0.77812E+00,-0.77814E+00,-0.77817E+00,-0.77820E+00,-0.77823E+00,
- &-0.77825E+00,-0.77827E+00,-0.77830E+00,-0.77832E+00,-0.77834E+00,
- &-0.77836E+00,-0.77838E+00,-0.77840E+00,-0.77842E+00,-0.77843E+00,
- &-0.77845E+00,-0.77846E+00,-0.77848E+00,-0.77849E+00,-0.77850E+00,
- &-0.77852E+00,-0.77853E+00,-0.77854E+00,-0.77855E+00,-0.77855E+00/
-
- DATA (BNC02M(I),I=401,500)/
- &-0.77856E+00,-0.77857E+00,-0.77857E+00,-0.77858E+00,-0.77858E+00,
- &-0.77858E+00,-0.77859E+00,-0.77859E+00,-0.77859E+00,-0.77859E+00,
- &-0.77859E+00,-0.77859E+00,-0.77858E+00,-0.77858E+00,-0.77857E+00,
- &-0.77857E+00,-0.77856E+00,-0.77856E+00,-0.77855E+00,-0.77854E+00,
- &-0.77853E+00,-0.77852E+00,-0.77851E+00,-0.77850E+00,-0.77849E+00,
- &-0.77848E+00,-0.77846E+00,-0.77845E+00,-0.77843E+00,-0.77842E+00,
- &-0.77840E+00,-0.77838E+00,-0.77837E+00,-0.77835E+00,-0.77833E+00,
- &-0.77831E+00,-0.77829E+00,-0.77827E+00,-0.77824E+00,-0.77822E+00,
- &-0.77820E+00,-0.77817E+00,-0.77815E+00,-0.77812E+00,-0.77810E+00,
- &-0.77807E+00,-0.77804E+00,-0.77801E+00,-0.77798E+00,-0.77795E+00,
- &-0.77792E+00,-0.77789E+00,-0.77786E+00,-0.77783E+00,-0.77780E+00,
- &-0.77776E+00,-0.77773E+00,-0.77769E+00,-0.77766E+00,-0.77762E+00,
- &-0.77758E+00,-0.77755E+00,-0.77751E+00,-0.77747E+00,-0.77743E+00,
- &-0.77739E+00,-0.77735E+00,-0.77731E+00,-0.77727E+00,-0.77722E+00,
- &-0.77718E+00,-0.77714E+00,-0.77709E+00,-0.77705E+00,-0.77700E+00,
- &-0.77695E+00,-0.77691E+00,-0.77686E+00,-0.77681E+00,-0.77676E+00,
- &-0.77672E+00,-0.77667E+00,-0.77662E+00,-0.77656E+00,-0.77651E+00,
- &-0.77646E+00,-0.77641E+00,-0.77636E+00,-0.77630E+00,-0.77625E+00,
- &-0.77619E+00,-0.77614E+00,-0.77608E+00,-0.77602E+00,-0.77597E+00,
- &-0.77591E+00,-0.77585E+00,-0.77579E+00,-0.77573E+00,-0.77567E+00/
-
- DATA (BNC02M(I),I=501,600)/
- &-0.77561E+00,-0.77555E+00,-0.77549E+00,-0.77543E+00,-0.77537E+00,
- &-0.77530E+00,-0.77524E+00,-0.77518E+00,-0.77511E+00,-0.77505E+00,
- &-0.77498E+00,-0.77491E+00,-0.77485E+00,-0.77478E+00,-0.77471E+00,
- &-0.77465E+00,-0.77458E+00,-0.77451E+00,-0.77444E+00,-0.77437E+00,
- &-0.77430E+00,-0.77423E+00,-0.77415E+00,-0.77408E+00,-0.77401E+00,
- &-0.77394E+00,-0.77386E+00,-0.77379E+00,-0.77371E+00,-0.77364E+00,
- &-0.77356E+00,-0.77349E+00,-0.77341E+00,-0.77333E+00,-0.77326E+00,
- &-0.77318E+00,-0.77310E+00,-0.77302E+00,-0.77294E+00,-0.77286E+00,
- &-0.77278E+00,-0.77270E+00,-0.77262E+00,-0.77254E+00,-0.77246E+00,
- &-0.77238E+00,-0.77229E+00,-0.77221E+00,-0.77213E+00,-0.77204E+00,
- &-0.77196E+00,-0.77187E+00,-0.77179E+00,-0.77170E+00,-0.77161E+00,
- &-0.77153E+00,-0.77144E+00,-0.77135E+00,-0.77126E+00,-0.77118E+00,
- &-0.77109E+00,-0.77100E+00,-0.77091E+00,-0.77082E+00,-0.77073E+00,
- &-0.77064E+00,-0.77054E+00,-0.77045E+00,-0.77036E+00,-0.77027E+00,
- &-0.77017E+00,-0.77008E+00,-0.76999E+00,-0.76989E+00,-0.76980E+00,
- &-0.76970E+00,-0.76961E+00,-0.76951E+00,-0.76941E+00,-0.76932E+00,
- &-0.76922E+00,-0.76912E+00,-0.76903E+00,-0.76893E+00,-0.76883E+00,
- &-0.76873E+00,-0.76863E+00,-0.76853E+00,-0.76843E+00,-0.76833E+00,
- &-0.76823E+00,-0.76813E+00,-0.76802E+00,-0.76792E+00,-0.76782E+00,
- &-0.76772E+00,-0.76761E+00,-0.76751E+00,-0.76741E+00,-0.76730E+00/
-
- DATA (BNC02M(I),I=601,700)/
- &-0.76615E+00,-0.76505E+00,-0.76391E+00,-0.76274E+00,-0.76154E+00,
- &-0.76031E+00,-0.75905E+00,-0.75775E+00,-0.75643E+00,-0.75509E+00,
- &-0.75371E+00,-0.75231E+00,-0.75089E+00,-0.74944E+00,-0.74797E+00,
- &-0.74647E+00,-0.74496E+00,-0.74342E+00,-0.74186E+00,-0.74028E+00,
- &-0.73868E+00,-0.73706E+00,-0.73542E+00,-0.73376E+00,-0.73209E+00,
- &-0.73040E+00,-0.72869E+00,-0.72696E+00,-0.72522E+00,-0.72346E+00,
- &-0.72169E+00,-0.71990E+00,-0.71810E+00,-0.71628E+00,-0.71445E+00,
- &-0.71261E+00,-0.71075E+00,-0.70888E+00,-0.70699E+00,-0.70510E+00,
- &-0.70319E+00,-0.70127E+00,-0.69934E+00,-0.69739E+00,-0.69544E+00,
- &-0.69347E+00,-0.69150E+00,-0.68951E+00,-0.68751E+00,-0.68551E+00,
- &-0.68349E+00,-0.68146E+00,-0.67943E+00,-0.67738E+00,-0.67533E+00,
- &-0.67326E+00,-0.67119E+00,-0.66911E+00,-0.66702E+00,-0.66493E+00,
- &-0.66282E+00,-0.66071E+00,-0.65859E+00,-0.65646E+00,-0.65432E+00,
- &-0.65218E+00,-0.65003E+00,-0.64787E+00,-0.64571E+00,-0.64354E+00,
- &-0.64136E+00,-0.63917E+00,-0.63698E+00,-0.63478E+00,-0.63258E+00,
- &-0.63037E+00,-0.62815E+00,-0.62593E+00,-0.62370E+00,-0.62147E+00,
- &-0.61923E+00,-0.61699E+00,-0.61474E+00,-0.61248E+00,-0.61022E+00,
- &-0.60795E+00,-0.60568E+00,-0.60341E+00,-0.60113E+00,-0.59884E+00,
- &-0.59655E+00,-0.59425E+00,-0.59195E+00,-0.58965E+00,-0.58734E+00,
- &-0.58503E+00,-0.58271E+00,-0.58039E+00,-0.57806E+00,-0.57573E+00/
-
- DATA (BNC02M(I),I=701,741)/
- &-0.57339E+00,-0.57106E+00,-0.56871E+00,-0.56637E+00,-0.56402E+00,
- &-0.56166E+00,-0.55930E+00,-0.55694E+00,-0.55458E+00,-0.55221E+00,
- &-0.54984E+00,-0.54746E+00,-0.54508E+00,-0.54270E+00,-0.54031E+00,
- &-0.53792E+00,-0.53553E+00,-0.53313E+00,-0.53073E+00,-0.52833E+00,
- &-0.52593E+00,-0.52352E+00,-0.52111E+00,-0.51869E+00,-0.51628E+00,
- &-0.51386E+00,-0.51144E+00,-0.50901E+00,-0.50658E+00,-0.50415E+00,
- &-0.50172E+00,-0.49928E+00,-0.49684E+00,-0.49440E+00,-0.49196E+00,
- &-0.48951E+00,-0.48706E+00,-0.48461E+00,-0.48216E+00,-0.47970E+00,
- &-0.47725E+00
- & /
-C
-C *** NaNO3
-C
- DATA (BNC03M(I),I=1,100)/
- &-0.45407E-01,-0.98699E-01,-0.12527E+00,-0.14402E+00,-0.15871E+00,
- &-0.17085E+00,-0.18123E+00,-0.19030E+00,-0.19838E+00,-0.20565E+00,
- &-0.21228E+00,-0.21836E+00,-0.22398E+00,-0.22921E+00,-0.23409E+00,
- &-0.23868E+00,-0.24300E+00,-0.24708E+00,-0.25095E+00,-0.25463E+00,
- &-0.25814E+00,-0.26149E+00,-0.26470E+00,-0.26777E+00,-0.27072E+00,
- &-0.27355E+00,-0.27628E+00,-0.27892E+00,-0.28146E+00,-0.28391E+00,
- &-0.28628E+00,-0.28858E+00,-0.29081E+00,-0.29297E+00,-0.29506E+00,
- &-0.29710E+00,-0.29907E+00,-0.30100E+00,-0.30287E+00,-0.30469E+00,
- &-0.30646E+00,-0.30819E+00,-0.30987E+00,-0.31152E+00,-0.31312E+00,
- &-0.31469E+00,-0.31622E+00,-0.31771E+00,-0.31918E+00,-0.32060E+00,
- &-0.32200E+00,-0.32337E+00,-0.32471E+00,-0.32602E+00,-0.32731E+00,
- &-0.32856E+00,-0.32980E+00,-0.33101E+00,-0.33220E+00,-0.33336E+00,
- &-0.33450E+00,-0.33563E+00,-0.33673E+00,-0.33781E+00,-0.33888E+00,
- &-0.33992E+00,-0.34095E+00,-0.34197E+00,-0.34296E+00,-0.34394E+00,
- &-0.34491E+00,-0.34586E+00,-0.34680E+00,-0.34772E+00,-0.34863E+00,
- &-0.34953E+00,-0.35042E+00,-0.35129E+00,-0.35216E+00,-0.35301E+00,
- &-0.35385E+00,-0.35468E+00,-0.35550E+00,-0.35632E+00,-0.35712E+00,
- &-0.35791E+00,-0.35870E+00,-0.35947E+00,-0.36024E+00,-0.36100E+00,
- &-0.36176E+00,-0.36250E+00,-0.36324E+00,-0.36397E+00,-0.36469E+00,
- &-0.36541E+00,-0.36612E+00,-0.36682E+00,-0.36752E+00,-0.36821E+00/
-
- DATA (BNC03M(I),I=101,200)/
- &-0.36889E+00,-0.36957E+00,-0.37024E+00,-0.37091E+00,-0.37157E+00,
- &-0.37222E+00,-0.37287E+00,-0.37351E+00,-0.37415E+00,-0.37478E+00,
- &-0.37540E+00,-0.37603E+00,-0.37664E+00,-0.37725E+00,-0.37785E+00,
- &-0.37845E+00,-0.37905E+00,-0.37964E+00,-0.38022E+00,-0.38080E+00,
- &-0.38137E+00,-0.38194E+00,-0.38251E+00,-0.38307E+00,-0.38362E+00,
- &-0.38417E+00,-0.38472E+00,-0.38526E+00,-0.38579E+00,-0.38632E+00,
- &-0.38685E+00,-0.38737E+00,-0.38789E+00,-0.38840E+00,-0.38891E+00,
- &-0.38942E+00,-0.38992E+00,-0.39042E+00,-0.39091E+00,-0.39140E+00,
- &-0.39188E+00,-0.39236E+00,-0.39284E+00,-0.39331E+00,-0.39378E+00,
- &-0.39424E+00,-0.39471E+00,-0.39516E+00,-0.39562E+00,-0.39607E+00,
- &-0.39651E+00,-0.39696E+00,-0.39740E+00,-0.39783E+00,-0.39827E+00,
- &-0.39870E+00,-0.39912E+00,-0.39954E+00,-0.39996E+00,-0.40038E+00,
- &-0.40079E+00,-0.40120E+00,-0.40161E+00,-0.40201E+00,-0.40241E+00,
- &-0.40281E+00,-0.40321E+00,-0.40360E+00,-0.40399E+00,-0.40437E+00,
- &-0.40476E+00,-0.40514E+00,-0.40552E+00,-0.40589E+00,-0.40626E+00,
- &-0.40663E+00,-0.40700E+00,-0.40736E+00,-0.40772E+00,-0.40808E+00,
- &-0.40844E+00,-0.40879E+00,-0.40914E+00,-0.40949E+00,-0.40984E+00,
- &-0.41018E+00,-0.41053E+00,-0.41086E+00,-0.41120E+00,-0.41154E+00,
- &-0.41187E+00,-0.41220E+00,-0.41252E+00,-0.41285E+00,-0.41317E+00,
- &-0.41349E+00,-0.41381E+00,-0.41413E+00,-0.41444E+00,-0.41475E+00/
-
- DATA (BNC03M(I),I=201,300)/
- &-0.41506E+00,-0.41537E+00,-0.41568E+00,-0.41598E+00,-0.41628E+00,
- &-0.41658E+00,-0.41688E+00,-0.41718E+00,-0.41747E+00,-0.41776E+00,
- &-0.41805E+00,-0.41834E+00,-0.41863E+00,-0.41891E+00,-0.41919E+00,
- &-0.41947E+00,-0.41975E+00,-0.42003E+00,-0.42030E+00,-0.42058E+00,
- &-0.42085E+00,-0.42112E+00,-0.42138E+00,-0.42165E+00,-0.42191E+00,
- &-0.42218E+00,-0.42244E+00,-0.42270E+00,-0.42296E+00,-0.42321E+00,
- &-0.42347E+00,-0.42372E+00,-0.42397E+00,-0.42422E+00,-0.42447E+00,
- &-0.42471E+00,-0.42496E+00,-0.42520E+00,-0.42544E+00,-0.42568E+00,
- &-0.42592E+00,-0.42616E+00,-0.42639E+00,-0.42663E+00,-0.42686E+00,
- &-0.42709E+00,-0.42732E+00,-0.42755E+00,-0.42778E+00,-0.42800E+00,
- &-0.42823E+00,-0.42845E+00,-0.42867E+00,-0.42889E+00,-0.42911E+00,
- &-0.42933E+00,-0.42954E+00,-0.42976E+00,-0.42997E+00,-0.43018E+00,
- &-0.43039E+00,-0.43060E+00,-0.43081E+00,-0.43102E+00,-0.43122E+00,
- &-0.43143E+00,-0.43163E+00,-0.43183E+00,-0.43203E+00,-0.43223E+00,
- &-0.43243E+00,-0.43262E+00,-0.43282E+00,-0.43301E+00,-0.43321E+00,
- &-0.43340E+00,-0.43359E+00,-0.43378E+00,-0.43397E+00,-0.43416E+00,
- &-0.43434E+00,-0.43453E+00,-0.43471E+00,-0.43489E+00,-0.43508E+00,
- &-0.43526E+00,-0.43544E+00,-0.43561E+00,-0.43579E+00,-0.43597E+00,
- &-0.43614E+00,-0.43632E+00,-0.43649E+00,-0.43666E+00,-0.43683E+00,
- &-0.43700E+00,-0.43717E+00,-0.43734E+00,-0.43751E+00,-0.43767E+00/
-
- DATA (BNC03M(I),I=301,400)/
- &-0.43784E+00,-0.43800E+00,-0.43816E+00,-0.43832E+00,-0.43848E+00,
- &-0.43864E+00,-0.43880E+00,-0.43896E+00,-0.43912E+00,-0.43927E+00,
- &-0.43943E+00,-0.43958E+00,-0.43974E+00,-0.43989E+00,-0.44004E+00,
- &-0.44019E+00,-0.44034E+00,-0.44049E+00,-0.44063E+00,-0.44078E+00,
- &-0.44093E+00,-0.44107E+00,-0.44122E+00,-0.44136E+00,-0.44150E+00,
- &-0.44164E+00,-0.44178E+00,-0.44192E+00,-0.44206E+00,-0.44220E+00,
- &-0.44234E+00,-0.44247E+00,-0.44261E+00,-0.44274E+00,-0.44288E+00,
- &-0.44301E+00,-0.44314E+00,-0.44327E+00,-0.44340E+00,-0.44353E+00,
- &-0.44366E+00,-0.44379E+00,-0.44392E+00,-0.44404E+00,-0.44417E+00,
- &-0.44430E+00,-0.44442E+00,-0.44454E+00,-0.44467E+00,-0.44479E+00,
- &-0.44491E+00,-0.44503E+00,-0.44515E+00,-0.44527E+00,-0.44539E+00,
- &-0.44550E+00,-0.44562E+00,-0.44574E+00,-0.44585E+00,-0.44596E+00,
- &-0.44608E+00,-0.44619E+00,-0.44630E+00,-0.44642E+00,-0.44653E+00,
- &-0.44664E+00,-0.44675E+00,-0.44686E+00,-0.44696E+00,-0.44707E+00,
- &-0.44718E+00,-0.44728E+00,-0.44739E+00,-0.44749E+00,-0.44760E+00,
- &-0.44770E+00,-0.44780E+00,-0.44791E+00,-0.44801E+00,-0.44811E+00,
- &-0.44821E+00,-0.44831E+00,-0.44841E+00,-0.44850E+00,-0.44860E+00,
- &-0.44870E+00,-0.44879E+00,-0.44889E+00,-0.44899E+00,-0.44908E+00,
- &-0.44917E+00,-0.44927E+00,-0.44936E+00,-0.44945E+00,-0.44954E+00,
- &-0.44963E+00,-0.44972E+00,-0.44981E+00,-0.44990E+00,-0.44999E+00/
-
- DATA (BNC03M(I),I=401,500)/
- &-0.45008E+00,-0.45016E+00,-0.45025E+00,-0.45034E+00,-0.45042E+00,
- &-0.45051E+00,-0.45059E+00,-0.45067E+00,-0.45076E+00,-0.45084E+00,
- &-0.45092E+00,-0.45100E+00,-0.45108E+00,-0.45116E+00,-0.45124E+00,
- &-0.45132E+00,-0.45140E+00,-0.45148E+00,-0.45156E+00,-0.45163E+00,
- &-0.45171E+00,-0.45179E+00,-0.45186E+00,-0.45194E+00,-0.45201E+00,
- &-0.45208E+00,-0.45216E+00,-0.45223E+00,-0.45230E+00,-0.45237E+00,
- &-0.45244E+00,-0.45252E+00,-0.45259E+00,-0.45266E+00,-0.45272E+00,
- &-0.45279E+00,-0.45286E+00,-0.45293E+00,-0.45300E+00,-0.45306E+00,
- &-0.45313E+00,-0.45319E+00,-0.45326E+00,-0.45332E+00,-0.45339E+00,
- &-0.45345E+00,-0.45351E+00,-0.45358E+00,-0.45364E+00,-0.45370E+00,
- &-0.45376E+00,-0.45382E+00,-0.45388E+00,-0.45394E+00,-0.45400E+00,
- &-0.45406E+00,-0.45412E+00,-0.45418E+00,-0.45423E+00,-0.45429E+00,
- &-0.45435E+00,-0.45440E+00,-0.45446E+00,-0.45452E+00,-0.45457E+00,
- &-0.45462E+00,-0.45468E+00,-0.45473E+00,-0.45478E+00,-0.45484E+00,
- &-0.45489E+00,-0.45494E+00,-0.45499E+00,-0.45504E+00,-0.45509E+00,
- &-0.45514E+00,-0.45519E+00,-0.45524E+00,-0.45529E+00,-0.45534E+00,
- &-0.45539E+00,-0.45543E+00,-0.45548E+00,-0.45553E+00,-0.45557E+00,
- &-0.45562E+00,-0.45567E+00,-0.45571E+00,-0.45575E+00,-0.45580E+00,
- &-0.45584E+00,-0.45589E+00,-0.45593E+00,-0.45597E+00,-0.45601E+00,
- &-0.45605E+00,-0.45610E+00,-0.45614E+00,-0.45618E+00,-0.45622E+00/
-
- DATA (BNC03M(I),I=501,600)/
- &-0.45626E+00,-0.45630E+00,-0.45634E+00,-0.45637E+00,-0.45641E+00,
- &-0.45645E+00,-0.45649E+00,-0.45653E+00,-0.45656E+00,-0.45660E+00,
- &-0.45663E+00,-0.45667E+00,-0.45670E+00,-0.45674E+00,-0.45677E+00,
- &-0.45681E+00,-0.45684E+00,-0.45688E+00,-0.45691E+00,-0.45694E+00,
- &-0.45697E+00,-0.45701E+00,-0.45704E+00,-0.45707E+00,-0.45710E+00,
- &-0.45713E+00,-0.45716E+00,-0.45719E+00,-0.45722E+00,-0.45725E+00,
- &-0.45728E+00,-0.45731E+00,-0.45733E+00,-0.45736E+00,-0.45739E+00,
- &-0.45742E+00,-0.45744E+00,-0.45747E+00,-0.45749E+00,-0.45752E+00,
- &-0.45755E+00,-0.45757E+00,-0.45759E+00,-0.45762E+00,-0.45764E+00,
- &-0.45767E+00,-0.45769E+00,-0.45771E+00,-0.45774E+00,-0.45776E+00,
- &-0.45778E+00,-0.45780E+00,-0.45782E+00,-0.45784E+00,-0.45787E+00,
- &-0.45789E+00,-0.45791E+00,-0.45793E+00,-0.45795E+00,-0.45796E+00,
- &-0.45798E+00,-0.45800E+00,-0.45802E+00,-0.45804E+00,-0.45806E+00,
- &-0.45807E+00,-0.45809E+00,-0.45811E+00,-0.45812E+00,-0.45814E+00,
- &-0.45815E+00,-0.45817E+00,-0.45819E+00,-0.45820E+00,-0.45821E+00,
- &-0.45823E+00,-0.45824E+00,-0.45826E+00,-0.45827E+00,-0.45828E+00,
- &-0.45830E+00,-0.45831E+00,-0.45832E+00,-0.45833E+00,-0.45834E+00,
- &-0.45836E+00,-0.45837E+00,-0.45838E+00,-0.45839E+00,-0.45840E+00,
- &-0.45841E+00,-0.45842E+00,-0.45843E+00,-0.45844E+00,-0.45845E+00,
- &-0.45845E+00,-0.45846E+00,-0.45847E+00,-0.45848E+00,-0.45849E+00/
-
- DATA (BNC03M(I),I=601,700)/
- &-0.45855E+00,-0.45858E+00,-0.45858E+00,-0.45856E+00,-0.45852E+00,
- &-0.45845E+00,-0.45836E+00,-0.45825E+00,-0.45812E+00,-0.45796E+00,
- &-0.45779E+00,-0.45759E+00,-0.45738E+00,-0.45715E+00,-0.45690E+00,
- &-0.45663E+00,-0.45634E+00,-0.45604E+00,-0.45573E+00,-0.45539E+00,
- &-0.45504E+00,-0.45468E+00,-0.45430E+00,-0.45390E+00,-0.45350E+00,
- &-0.45307E+00,-0.45264E+00,-0.45219E+00,-0.45173E+00,-0.45126E+00,
- &-0.45077E+00,-0.45027E+00,-0.44976E+00,-0.44924E+00,-0.44871E+00,
- &-0.44817E+00,-0.44762E+00,-0.44705E+00,-0.44648E+00,-0.44589E+00,
- &-0.44530E+00,-0.44470E+00,-0.44408E+00,-0.44346E+00,-0.44283E+00,
- &-0.44219E+00,-0.44154E+00,-0.44088E+00,-0.44022E+00,-0.43954E+00,
- &-0.43886E+00,-0.43817E+00,-0.43747E+00,-0.43676E+00,-0.43605E+00,
- &-0.43533E+00,-0.43460E+00,-0.43387E+00,-0.43313E+00,-0.43238E+00,
- &-0.43162E+00,-0.43086E+00,-0.43009E+00,-0.42932E+00,-0.42854E+00,
- &-0.42775E+00,-0.42695E+00,-0.42616E+00,-0.42535E+00,-0.42454E+00,
- &-0.42372E+00,-0.42290E+00,-0.42207E+00,-0.42124E+00,-0.42040E+00,
- &-0.41956E+00,-0.41871E+00,-0.41786E+00,-0.41700E+00,-0.41613E+00,
- &-0.41527E+00,-0.41439E+00,-0.41351E+00,-0.41263E+00,-0.41175E+00,
- &-0.41085E+00,-0.40996E+00,-0.40906E+00,-0.40815E+00,-0.40724E+00,
- &-0.40633E+00,-0.40542E+00,-0.40449E+00,-0.40357E+00,-0.40264E+00,
- &-0.40171E+00,-0.40077E+00,-0.39983E+00,-0.39889E+00,-0.39794E+00/
-
- DATA (BNC03M(I),I=701,741)/
- &-0.39699E+00,-0.39604E+00,-0.39508E+00,-0.39412E+00,-0.39315E+00,
- &-0.39218E+00,-0.39121E+00,-0.39024E+00,-0.38926E+00,-0.38828E+00,
- &-0.38729E+00,-0.38630E+00,-0.38531E+00,-0.38432E+00,-0.38332E+00,
- &-0.38232E+00,-0.38132E+00,-0.38032E+00,-0.37931E+00,-0.37830E+00,
- &-0.37729E+00,-0.37627E+00,-0.37525E+00,-0.37423E+00,-0.37320E+00,
- &-0.37218E+00,-0.37115E+00,-0.37012E+00,-0.36908E+00,-0.36804E+00,
- &-0.36701E+00,-0.36596E+00,-0.36492E+00,-0.36387E+00,-0.36282E+00,
- &-0.36177E+00,-0.36072E+00,-0.35967E+00,-0.35861E+00,-0.35755E+00,
- &-0.35649E+00
- & /
-C
-C *** (NH4)2SO4
-C
- DATA (BNC04M(I),I=1,100)/
- &-0.90672E-01,-0.19663E+00,-0.24920E+00,-0.28615E+00,-0.31499E+00,
- &-0.33875E+00,-0.35900E+00,-0.37665E+00,-0.39232E+00,-0.40639E+00,
- &-0.41917E+00,-0.43087E+00,-0.44165E+00,-0.45166E+00,-0.46098E+00,
- &-0.46971E+00,-0.47792E+00,-0.48566E+00,-0.49298E+00,-0.49992E+00,
- &-0.50652E+00,-0.51280E+00,-0.51881E+00,-0.52455E+00,-0.53005E+00,
- &-0.53532E+00,-0.54039E+00,-0.54527E+00,-0.54997E+00,-0.55450E+00,
- &-0.55887E+00,-0.56310E+00,-0.56718E+00,-0.57114E+00,-0.57497E+00,
- &-0.57868E+00,-0.58229E+00,-0.58578E+00,-0.58918E+00,-0.59248E+00,
- &-0.59570E+00,-0.59882E+00,-0.60186E+00,-0.60483E+00,-0.60771E+00,
- &-0.61053E+00,-0.61327E+00,-0.61595E+00,-0.61857E+00,-0.62112E+00,
- &-0.62362E+00,-0.62605E+00,-0.62844E+00,-0.63077E+00,-0.63305E+00,
- &-0.63528E+00,-0.63746E+00,-0.63960E+00,-0.64170E+00,-0.64375E+00,
- &-0.64576E+00,-0.64773E+00,-0.64967E+00,-0.65157E+00,-0.65343E+00,
- &-0.65526E+00,-0.65705E+00,-0.65882E+00,-0.66055E+00,-0.66225E+00,
- &-0.66393E+00,-0.66557E+00,-0.66719E+00,-0.66879E+00,-0.67036E+00,
- &-0.67190E+00,-0.67342E+00,-0.67492E+00,-0.67640E+00,-0.67785E+00,
- &-0.67928E+00,-0.68070E+00,-0.68209E+00,-0.68347E+00,-0.68482E+00,
- &-0.68616E+00,-0.68748E+00,-0.68879E+00,-0.69008E+00,-0.69135E+00,
- &-0.69260E+00,-0.69385E+00,-0.69507E+00,-0.69628E+00,-0.69748E+00,
- &-0.69867E+00,-0.69984E+00,-0.70099E+00,-0.70214E+00,-0.70327E+00/
-
- DATA (BNC04M(I),I=101,200)/
- &-0.70439E+00,-0.70549E+00,-0.70659E+00,-0.70767E+00,-0.70874E+00,
- &-0.70980E+00,-0.71085E+00,-0.71189E+00,-0.71291E+00,-0.71393E+00,
- &-0.71493E+00,-0.71593E+00,-0.71691E+00,-0.71789E+00,-0.71885E+00,
- &-0.71980E+00,-0.72075E+00,-0.72168E+00,-0.72261E+00,-0.72352E+00,
- &-0.72443E+00,-0.72532E+00,-0.72621E+00,-0.72709E+00,-0.72796E+00,
- &-0.72882E+00,-0.72967E+00,-0.73051E+00,-0.73135E+00,-0.73217E+00,
- &-0.73299E+00,-0.73380E+00,-0.73460E+00,-0.73540E+00,-0.73618E+00,
- &-0.73696E+00,-0.73773E+00,-0.73849E+00,-0.73925E+00,-0.74000E+00,
- &-0.74074E+00,-0.74147E+00,-0.74220E+00,-0.74292E+00,-0.74363E+00,
- &-0.74433E+00,-0.74503E+00,-0.74572E+00,-0.74641E+00,-0.74709E+00,
- &-0.74776E+00,-0.74843E+00,-0.74909E+00,-0.74974E+00,-0.75039E+00,
- &-0.75103E+00,-0.75167E+00,-0.75230E+00,-0.75292E+00,-0.75354E+00,
- &-0.75415E+00,-0.75476E+00,-0.75536E+00,-0.75596E+00,-0.75655E+00,
- &-0.75713E+00,-0.75771E+00,-0.75829E+00,-0.75886E+00,-0.75942E+00,
- &-0.75998E+00,-0.76054E+00,-0.76109E+00,-0.76163E+00,-0.76217E+00,
- &-0.76271E+00,-0.76324E+00,-0.76376E+00,-0.76428E+00,-0.76480E+00,
- &-0.76531E+00,-0.76582E+00,-0.76632E+00,-0.76682E+00,-0.76732E+00,
- &-0.76781E+00,-0.76829E+00,-0.76877E+00,-0.76925E+00,-0.76973E+00,
- &-0.77020E+00,-0.77066E+00,-0.77112E+00,-0.77158E+00,-0.77203E+00,
- &-0.77248E+00,-0.77293E+00,-0.77337E+00,-0.77381E+00,-0.77425E+00/
-
- DATA (BNC04M(I),I=201,300)/
- &-0.77468E+00,-0.77510E+00,-0.77553E+00,-0.77595E+00,-0.77637E+00,
- &-0.77678E+00,-0.77719E+00,-0.77760E+00,-0.77800E+00,-0.77840E+00,
- &-0.77880E+00,-0.77919E+00,-0.77958E+00,-0.77996E+00,-0.78035E+00,
- &-0.78073E+00,-0.78110E+00,-0.78148E+00,-0.78185E+00,-0.78222E+00,
- &-0.78258E+00,-0.78294E+00,-0.78330E+00,-0.78366E+00,-0.78401E+00,
- &-0.78436E+00,-0.78471E+00,-0.78505E+00,-0.78539E+00,-0.78573E+00,
- &-0.78607E+00,-0.78640E+00,-0.78673E+00,-0.78706E+00,-0.78738E+00,
- &-0.78770E+00,-0.78802E+00,-0.78834E+00,-0.78865E+00,-0.78896E+00,
- &-0.78927E+00,-0.78958E+00,-0.78988E+00,-0.79018E+00,-0.79048E+00,
- &-0.79078E+00,-0.79107E+00,-0.79136E+00,-0.79165E+00,-0.79194E+00,
- &-0.79222E+00,-0.79250E+00,-0.79278E+00,-0.79306E+00,-0.79333E+00,
- &-0.79361E+00,-0.79388E+00,-0.79415E+00,-0.79441E+00,-0.79467E+00,
- &-0.79494E+00,-0.79519E+00,-0.79545E+00,-0.79571E+00,-0.79596E+00,
- &-0.79621E+00,-0.79646E+00,-0.79670E+00,-0.79695E+00,-0.79719E+00,
- &-0.79743E+00,-0.79767E+00,-0.79790E+00,-0.79814E+00,-0.79837E+00,
- &-0.79860E+00,-0.79883E+00,-0.79906E+00,-0.79928E+00,-0.79950E+00,
- &-0.79972E+00,-0.79994E+00,-0.80016E+00,-0.80037E+00,-0.80058E+00,
- &-0.80080E+00,-0.80101E+00,-0.80121E+00,-0.80142E+00,-0.80162E+00,
- &-0.80182E+00,-0.80202E+00,-0.80222E+00,-0.80242E+00,-0.80261E+00,
- &-0.80281E+00,-0.80300E+00,-0.80319E+00,-0.80338E+00,-0.80356E+00/
-
- DATA (BNC04M(I),I=301,400)/
- &-0.80375E+00,-0.80393E+00,-0.80411E+00,-0.80429E+00,-0.80447E+00,
- &-0.80465E+00,-0.80482E+00,-0.80500E+00,-0.80517E+00,-0.80534E+00,
- &-0.80551E+00,-0.80567E+00,-0.80584E+00,-0.80600E+00,-0.80617E+00,
- &-0.80633E+00,-0.80649E+00,-0.80665E+00,-0.80680E+00,-0.80696E+00,
- &-0.80711E+00,-0.80726E+00,-0.80741E+00,-0.80756E+00,-0.80771E+00,
- &-0.80786E+00,-0.80800E+00,-0.80815E+00,-0.80829E+00,-0.80843E+00,
- &-0.80857E+00,-0.80871E+00,-0.80884E+00,-0.80898E+00,-0.80911E+00,
- &-0.80924E+00,-0.80937E+00,-0.80950E+00,-0.80963E+00,-0.80976E+00,
- &-0.80989E+00,-0.81001E+00,-0.81013E+00,-0.81026E+00,-0.81038E+00,
- &-0.81050E+00,-0.81062E+00,-0.81073E+00,-0.81085E+00,-0.81096E+00,
- &-0.81108E+00,-0.81119E+00,-0.81130E+00,-0.81141E+00,-0.81152E+00,
- &-0.81162E+00,-0.81173E+00,-0.81183E+00,-0.81194E+00,-0.81204E+00,
- &-0.81214E+00,-0.81224E+00,-0.81234E+00,-0.81244E+00,-0.81254E+00,
- &-0.81263E+00,-0.81273E+00,-0.81282E+00,-0.81291E+00,-0.81300E+00,
- &-0.81309E+00,-0.81318E+00,-0.81327E+00,-0.81336E+00,-0.81344E+00,
- &-0.81353E+00,-0.81361E+00,-0.81369E+00,-0.81377E+00,-0.81385E+00,
- &-0.81393E+00,-0.81401E+00,-0.81409E+00,-0.81416E+00,-0.81424E+00,
- &-0.81431E+00,-0.81439E+00,-0.81446E+00,-0.81453E+00,-0.81460E+00,
- &-0.81467E+00,-0.81474E+00,-0.81480E+00,-0.81487E+00,-0.81493E+00,
- &-0.81500E+00,-0.81506E+00,-0.81512E+00,-0.81518E+00,-0.81524E+00/
-
- DATA (BNC04M(I),I=401,500)/
- &-0.81530E+00,-0.81536E+00,-0.81542E+00,-0.81548E+00,-0.81553E+00,
- &-0.81559E+00,-0.81564E+00,-0.81569E+00,-0.81574E+00,-0.81580E+00,
- &-0.81585E+00,-0.81590E+00,-0.81594E+00,-0.81599E+00,-0.81604E+00,
- &-0.81608E+00,-0.81613E+00,-0.81617E+00,-0.81621E+00,-0.81626E+00,
- &-0.81630E+00,-0.81634E+00,-0.81638E+00,-0.81642E+00,-0.81645E+00,
- &-0.81649E+00,-0.81653E+00,-0.81656E+00,-0.81660E+00,-0.81663E+00,
- &-0.81666E+00,-0.81670E+00,-0.81673E+00,-0.81676E+00,-0.81679E+00,
- &-0.81682E+00,-0.81684E+00,-0.81687E+00,-0.81690E+00,-0.81692E+00,
- &-0.81695E+00,-0.81697E+00,-0.81700E+00,-0.81702E+00,-0.81704E+00,
- &-0.81706E+00,-0.81708E+00,-0.81710E+00,-0.81712E+00,-0.81714E+00,
- &-0.81715E+00,-0.81717E+00,-0.81719E+00,-0.81720E+00,-0.81721E+00,
- &-0.81723E+00,-0.81724E+00,-0.81725E+00,-0.81726E+00,-0.81727E+00,
- &-0.81728E+00,-0.81729E+00,-0.81730E+00,-0.81731E+00,-0.81732E+00,
- &-0.81732E+00,-0.81733E+00,-0.81733E+00,-0.81734E+00,-0.81734E+00,
- &-0.81734E+00,-0.81735E+00,-0.81735E+00,-0.81735E+00,-0.81735E+00,
- &-0.81735E+00,-0.81735E+00,-0.81734E+00,-0.81734E+00,-0.81734E+00,
- &-0.81733E+00,-0.81733E+00,-0.81732E+00,-0.81732E+00,-0.81731E+00,
- &-0.81730E+00,-0.81730E+00,-0.81729E+00,-0.81728E+00,-0.81727E+00,
- &-0.81726E+00,-0.81725E+00,-0.81724E+00,-0.81722E+00,-0.81721E+00,
- &-0.81720E+00,-0.81718E+00,-0.81717E+00,-0.81715E+00,-0.81714E+00/
-
- DATA (BNC04M(I),I=501,600)/
- &-0.81712E+00,-0.81710E+00,-0.81709E+00,-0.81707E+00,-0.81705E+00,
- &-0.81703E+00,-0.81701E+00,-0.81699E+00,-0.81697E+00,-0.81694E+00,
- &-0.81692E+00,-0.81690E+00,-0.81688E+00,-0.81685E+00,-0.81683E+00,
- &-0.81680E+00,-0.81677E+00,-0.81675E+00,-0.81672E+00,-0.81669E+00,
- &-0.81666E+00,-0.81664E+00,-0.81661E+00,-0.81658E+00,-0.81655E+00,
- &-0.81651E+00,-0.81648E+00,-0.81645E+00,-0.81642E+00,-0.81638E+00,
- &-0.81635E+00,-0.81632E+00,-0.81628E+00,-0.81625E+00,-0.81621E+00,
- &-0.81617E+00,-0.81614E+00,-0.81610E+00,-0.81606E+00,-0.81602E+00,
- &-0.81598E+00,-0.81594E+00,-0.81590E+00,-0.81586E+00,-0.81582E+00,
- &-0.81578E+00,-0.81574E+00,-0.81570E+00,-0.81565E+00,-0.81561E+00,
- &-0.81556E+00,-0.81552E+00,-0.81547E+00,-0.81543E+00,-0.81538E+00,
- &-0.81534E+00,-0.81529E+00,-0.81524E+00,-0.81519E+00,-0.81514E+00,
- &-0.81509E+00,-0.81504E+00,-0.81499E+00,-0.81494E+00,-0.81489E+00,
- &-0.81484E+00,-0.81479E+00,-0.81474E+00,-0.81468E+00,-0.81463E+00,
- &-0.81458E+00,-0.81452E+00,-0.81447E+00,-0.81441E+00,-0.81436E+00,
- &-0.81430E+00,-0.81424E+00,-0.81419E+00,-0.81413E+00,-0.81407E+00,
- &-0.81401E+00,-0.81395E+00,-0.81389E+00,-0.81383E+00,-0.81377E+00,
- &-0.81371E+00,-0.81365E+00,-0.81359E+00,-0.81353E+00,-0.81347E+00,
- &-0.81340E+00,-0.81334E+00,-0.81328E+00,-0.81321E+00,-0.81315E+00,
- &-0.81308E+00,-0.81302E+00,-0.81295E+00,-0.81288E+00,-0.81282E+00/
-
- DATA (BNC04M(I),I=601,700)/
- &-0.81207E+00,-0.81133E+00,-0.81056E+00,-0.80975E+00,-0.80890E+00,
- &-0.80801E+00,-0.80709E+00,-0.80614E+00,-0.80515E+00,-0.80414E+00,
- &-0.80309E+00,-0.80201E+00,-0.80090E+00,-0.79977E+00,-0.79861E+00,
- &-0.79742E+00,-0.79620E+00,-0.79496E+00,-0.79370E+00,-0.79241E+00,
- &-0.79110E+00,-0.78976E+00,-0.78841E+00,-0.78703E+00,-0.78563E+00,
- &-0.78421E+00,-0.78277E+00,-0.78131E+00,-0.77984E+00,-0.77834E+00,
- &-0.77683E+00,-0.77529E+00,-0.77374E+00,-0.77218E+00,-0.77060E+00,
- &-0.76900E+00,-0.76738E+00,-0.76575E+00,-0.76411E+00,-0.76245E+00,
- &-0.76077E+00,-0.75908E+00,-0.75738E+00,-0.75566E+00,-0.75393E+00,
- &-0.75219E+00,-0.75044E+00,-0.74867E+00,-0.74689E+00,-0.74510E+00,
- &-0.74329E+00,-0.74148E+00,-0.73965E+00,-0.73781E+00,-0.73596E+00,
- &-0.73411E+00,-0.73224E+00,-0.73036E+00,-0.72847E+00,-0.72657E+00,
- &-0.72466E+00,-0.72274E+00,-0.72081E+00,-0.71887E+00,-0.71692E+00,
- &-0.71497E+00,-0.71300E+00,-0.71103E+00,-0.70905E+00,-0.70706E+00,
- &-0.70506E+00,-0.70306E+00,-0.70104E+00,-0.69902E+00,-0.69699E+00,
- &-0.69496E+00,-0.69291E+00,-0.69086E+00,-0.68880E+00,-0.68674E+00,
- &-0.68467E+00,-0.68259E+00,-0.68050E+00,-0.67841E+00,-0.67631E+00,
- &-0.67421E+00,-0.67210E+00,-0.66998E+00,-0.66786E+00,-0.66573E+00,
- &-0.66359E+00,-0.66145E+00,-0.65930E+00,-0.65715E+00,-0.65499E+00,
- &-0.65283E+00,-0.65066E+00,-0.64849E+00,-0.64631E+00,-0.64413E+00/
-
- DATA (BNC04M(I),I=701,741)/
- &-0.64194E+00,-0.63974E+00,-0.63755E+00,-0.63534E+00,-0.63313E+00,
- &-0.63092E+00,-0.62870E+00,-0.62648E+00,-0.62425E+00,-0.62202E+00,
- &-0.61979E+00,-0.61755E+00,-0.61530E+00,-0.61305E+00,-0.61080E+00,
- &-0.60854E+00,-0.60628E+00,-0.60402E+00,-0.60175E+00,-0.59948E+00,
- &-0.59720E+00,-0.59492E+00,-0.59264E+00,-0.59035E+00,-0.58806E+00,
- &-0.58576E+00,-0.58346E+00,-0.58116E+00,-0.57886E+00,-0.57655E+00,
- &-0.57424E+00,-0.57192E+00,-0.56960E+00,-0.56728E+00,-0.56496E+00,
- &-0.56263E+00,-0.56030E+00,-0.55796E+00,-0.55562E+00,-0.55328E+00,
- &-0.55094E+00
- & /
-C
-C *** NH4NO3
-C
- DATA (BNC05M(I),I=1,100)/
- &-0.45808E-01,-0.10090E+00,-0.12914E+00,-0.14948E+00,-0.16569E+00,
- &-0.17932E+00,-0.19115E+00,-0.20166E+00,-0.21113E+00,-0.21978E+00,
- &-0.22776E+00,-0.23518E+00,-0.24211E+00,-0.24864E+00,-0.25481E+00,
- &-0.26066E+00,-0.26624E+00,-0.27156E+00,-0.27665E+00,-0.28154E+00,
- &-0.28625E+00,-0.29078E+00,-0.29515E+00,-0.29938E+00,-0.30348E+00,
- &-0.30744E+00,-0.31129E+00,-0.31503E+00,-0.31867E+00,-0.32220E+00,
- &-0.32565E+00,-0.32900E+00,-0.33228E+00,-0.33547E+00,-0.33859E+00,
- &-0.34163E+00,-0.34461E+00,-0.34752E+00,-0.35037E+00,-0.35315E+00,
- &-0.35588E+00,-0.35855E+00,-0.36117E+00,-0.36373E+00,-0.36625E+00,
- &-0.36872E+00,-0.37113E+00,-0.37351E+00,-0.37584E+00,-0.37813E+00,
- &-0.38038E+00,-0.38259E+00,-0.38476E+00,-0.38689E+00,-0.38899E+00,
- &-0.39106E+00,-0.39309E+00,-0.39509E+00,-0.39706E+00,-0.39900E+00,
- &-0.40091E+00,-0.40280E+00,-0.40466E+00,-0.40649E+00,-0.40830E+00,
- &-0.41009E+00,-0.41185E+00,-0.41359E+00,-0.41531E+00,-0.41701E+00,
- &-0.41870E+00,-0.42036E+00,-0.42201E+00,-0.42364E+00,-0.42526E+00,
- &-0.42686E+00,-0.42844E+00,-0.43001E+00,-0.43157E+00,-0.43312E+00,
- &-0.43465E+00,-0.43617E+00,-0.43768E+00,-0.43918E+00,-0.44067E+00,
- &-0.44215E+00,-0.44362E+00,-0.44508E+00,-0.44653E+00,-0.44798E+00,
- &-0.44941E+00,-0.45084E+00,-0.45226E+00,-0.45367E+00,-0.45508E+00,
- &-0.45647E+00,-0.45786E+00,-0.45924E+00,-0.46062E+00,-0.46199E+00/
-
- DATA (BNC05M(I),I=101,200)/
- &-0.46335E+00,-0.46470E+00,-0.46605E+00,-0.46739E+00,-0.46872E+00,
- &-0.47005E+00,-0.47137E+00,-0.47269E+00,-0.47399E+00,-0.47529E+00,
- &-0.47658E+00,-0.47787E+00,-0.47915E+00,-0.48042E+00,-0.48169E+00,
- &-0.48295E+00,-0.48420E+00,-0.48544E+00,-0.48668E+00,-0.48791E+00,
- &-0.48913E+00,-0.49035E+00,-0.49156E+00,-0.49276E+00,-0.49396E+00,
- &-0.49515E+00,-0.49633E+00,-0.49750E+00,-0.49867E+00,-0.49983E+00,
- &-0.50099E+00,-0.50213E+00,-0.50327E+00,-0.50441E+00,-0.50553E+00,
- &-0.50665E+00,-0.50777E+00,-0.50887E+00,-0.50997E+00,-0.51107E+00,
- &-0.51215E+00,-0.51323E+00,-0.51431E+00,-0.51538E+00,-0.51644E+00,
- &-0.51749E+00,-0.51854E+00,-0.51959E+00,-0.52062E+00,-0.52166E+00,
- &-0.52268E+00,-0.52370E+00,-0.52471E+00,-0.52572E+00,-0.52672E+00,
- &-0.52772E+00,-0.52871E+00,-0.52969E+00,-0.53067E+00,-0.53165E+00,
- &-0.53261E+00,-0.53358E+00,-0.53454E+00,-0.53549E+00,-0.53643E+00,
- &-0.53738E+00,-0.53831E+00,-0.53924E+00,-0.54017E+00,-0.54109E+00,
- &-0.54201E+00,-0.54292E+00,-0.54383E+00,-0.54473E+00,-0.54563E+00,
- &-0.54652E+00,-0.54741E+00,-0.54829E+00,-0.54917E+00,-0.55004E+00,
- &-0.55091E+00,-0.55177E+00,-0.55263E+00,-0.55349E+00,-0.55434E+00,
- &-0.55518E+00,-0.55603E+00,-0.55686E+00,-0.55770E+00,-0.55853E+00,
- &-0.55935E+00,-0.56017E+00,-0.56099E+00,-0.56180E+00,-0.56261E+00,
- &-0.56341E+00,-0.56422E+00,-0.56501E+00,-0.56580E+00,-0.56659E+00/
-
- DATA (BNC05M(I),I=201,300)/
- &-0.56738E+00,-0.56816E+00,-0.56893E+00,-0.56971E+00,-0.57048E+00,
- &-0.57124E+00,-0.57200E+00,-0.57276E+00,-0.57351E+00,-0.57426E+00,
- &-0.57501E+00,-0.57575E+00,-0.57649E+00,-0.57723E+00,-0.57796E+00,
- &-0.57869E+00,-0.57942E+00,-0.58014E+00,-0.58086E+00,-0.58157E+00,
- &-0.58228E+00,-0.58299E+00,-0.58370E+00,-0.58440E+00,-0.58510E+00,
- &-0.58579E+00,-0.58648E+00,-0.58717E+00,-0.58786E+00,-0.58854E+00,
- &-0.58922E+00,-0.58989E+00,-0.59057E+00,-0.59124E+00,-0.59190E+00,
- &-0.59257E+00,-0.59323E+00,-0.59388E+00,-0.59454E+00,-0.59519E+00,
- &-0.59584E+00,-0.59648E+00,-0.59712E+00,-0.59776E+00,-0.59840E+00,
- &-0.59903E+00,-0.59966E+00,-0.60029E+00,-0.60092E+00,-0.60154E+00,
- &-0.60216E+00,-0.60278E+00,-0.60339E+00,-0.60400E+00,-0.60461E+00,
- &-0.60522E+00,-0.60582E+00,-0.60642E+00,-0.60702E+00,-0.60761E+00,
- &-0.60820E+00,-0.60879E+00,-0.60938E+00,-0.60997E+00,-0.61055E+00,
- &-0.61113E+00,-0.61170E+00,-0.61228E+00,-0.61285E+00,-0.61342E+00,
- &-0.61399E+00,-0.61455E+00,-0.61511E+00,-0.61567E+00,-0.61623E+00,
- &-0.61678E+00,-0.61734E+00,-0.61789E+00,-0.61843E+00,-0.61898E+00,
- &-0.61952E+00,-0.62006E+00,-0.62060E+00,-0.62114E+00,-0.62167E+00,
- &-0.62220E+00,-0.62273E+00,-0.62326E+00,-0.62378E+00,-0.62430E+00,
- &-0.62482E+00,-0.62534E+00,-0.62586E+00,-0.62637E+00,-0.62688E+00,
- &-0.62739E+00,-0.62790E+00,-0.62840E+00,-0.62891E+00,-0.62941E+00/
-
- DATA (BNC05M(I),I=301,400)/
- &-0.62990E+00,-0.63040E+00,-0.63090E+00,-0.63139E+00,-0.63188E+00,
- &-0.63237E+00,-0.63285E+00,-0.63334E+00,-0.63382E+00,-0.63430E+00,
- &-0.63478E+00,-0.63525E+00,-0.63573E+00,-0.63620E+00,-0.63667E+00,
- &-0.63714E+00,-0.63760E+00,-0.63807E+00,-0.63853E+00,-0.63899E+00,
- &-0.63945E+00,-0.63991E+00,-0.64036E+00,-0.64081E+00,-0.64127E+00,
- &-0.64171E+00,-0.64216E+00,-0.64261E+00,-0.64305E+00,-0.64349E+00,
- &-0.64393E+00,-0.64437E+00,-0.64481E+00,-0.64524E+00,-0.64568E+00,
- &-0.64611E+00,-0.64654E+00,-0.64696E+00,-0.64739E+00,-0.64782E+00,
- &-0.64824E+00,-0.64866E+00,-0.64908E+00,-0.64950E+00,-0.64991E+00,
- &-0.65033E+00,-0.65074E+00,-0.65115E+00,-0.65156E+00,-0.65197E+00,
- &-0.65237E+00,-0.65278E+00,-0.65318E+00,-0.65358E+00,-0.65398E+00,
- &-0.65438E+00,-0.65477E+00,-0.65517E+00,-0.65556E+00,-0.65595E+00,
- &-0.65634E+00,-0.65673E+00,-0.65712E+00,-0.65750E+00,-0.65788E+00,
- &-0.65827E+00,-0.65865E+00,-0.65903E+00,-0.65940E+00,-0.65978E+00,
- &-0.66016E+00,-0.66053E+00,-0.66090E+00,-0.66127E+00,-0.66164E+00,
- &-0.66201E+00,-0.66237E+00,-0.66274E+00,-0.66310E+00,-0.66346E+00,
- &-0.66382E+00,-0.66418E+00,-0.66454E+00,-0.66489E+00,-0.66525E+00,
- &-0.66560E+00,-0.66595E+00,-0.66630E+00,-0.66665E+00,-0.66700E+00,
- &-0.66734E+00,-0.66769E+00,-0.66803E+00,-0.66837E+00,-0.66871E+00,
- &-0.66905E+00,-0.66939E+00,-0.66973E+00,-0.67006E+00,-0.67040E+00/
-
- DATA (BNC05M(I),I=401,500)/
- &-0.67073E+00,-0.67106E+00,-0.67139E+00,-0.67172E+00,-0.67205E+00,
- &-0.67237E+00,-0.67270E+00,-0.67302E+00,-0.67335E+00,-0.67367E+00,
- &-0.67399E+00,-0.67431E+00,-0.67462E+00,-0.67494E+00,-0.67525E+00,
- &-0.67557E+00,-0.67588E+00,-0.67619E+00,-0.67650E+00,-0.67681E+00,
- &-0.67712E+00,-0.67742E+00,-0.67773E+00,-0.67803E+00,-0.67834E+00,
- &-0.67864E+00,-0.67894E+00,-0.67924E+00,-0.67954E+00,-0.67983E+00,
- &-0.68013E+00,-0.68042E+00,-0.68072E+00,-0.68101E+00,-0.68130E+00,
- &-0.68159E+00,-0.68188E+00,-0.68217E+00,-0.68246E+00,-0.68274E+00,
- &-0.68303E+00,-0.68331E+00,-0.68359E+00,-0.68387E+00,-0.68415E+00,
- &-0.68443E+00,-0.68471E+00,-0.68499E+00,-0.68526E+00,-0.68554E+00,
- &-0.68581E+00,-0.68608E+00,-0.68635E+00,-0.68663E+00,-0.68689E+00,
- &-0.68716E+00,-0.68743E+00,-0.68770E+00,-0.68796E+00,-0.68823E+00,
- &-0.68849E+00,-0.68875E+00,-0.68901E+00,-0.68927E+00,-0.68953E+00,
- &-0.68979E+00,-0.69005E+00,-0.69030E+00,-0.69056E+00,-0.69081E+00,
- &-0.69107E+00,-0.69132E+00,-0.69157E+00,-0.69182E+00,-0.69207E+00,
- &-0.69232E+00,-0.69256E+00,-0.69281E+00,-0.69306E+00,-0.69330E+00,
- &-0.69354E+00,-0.69379E+00,-0.69403E+00,-0.69427E+00,-0.69451E+00,
- &-0.69475E+00,-0.69498E+00,-0.69522E+00,-0.69546E+00,-0.69569E+00,
- &-0.69593E+00,-0.69616E+00,-0.69639E+00,-0.69662E+00,-0.69685E+00,
- &-0.69708E+00,-0.69731E+00,-0.69754E+00,-0.69777E+00,-0.69799E+00/
-
- DATA (BNC05M(I),I=501,600)/
- &-0.69822E+00,-0.69844E+00,-0.69867E+00,-0.69889E+00,-0.69911E+00,
- &-0.69933E+00,-0.69955E+00,-0.69977E+00,-0.69999E+00,-0.70020E+00,
- &-0.70042E+00,-0.70064E+00,-0.70085E+00,-0.70107E+00,-0.70128E+00,
- &-0.70149E+00,-0.70170E+00,-0.70191E+00,-0.70212E+00,-0.70233E+00,
- &-0.70254E+00,-0.70275E+00,-0.70295E+00,-0.70316E+00,-0.70336E+00,
- &-0.70357E+00,-0.70377E+00,-0.70397E+00,-0.70417E+00,-0.70438E+00,
- &-0.70458E+00,-0.70477E+00,-0.70497E+00,-0.70517E+00,-0.70537E+00,
- &-0.70556E+00,-0.70576E+00,-0.70595E+00,-0.70615E+00,-0.70634E+00,
- &-0.70653E+00,-0.70672E+00,-0.70691E+00,-0.70710E+00,-0.70729E+00,
- &-0.70748E+00,-0.70767E+00,-0.70786E+00,-0.70804E+00,-0.70823E+00,
- &-0.70841E+00,-0.70860E+00,-0.70878E+00,-0.70896E+00,-0.70914E+00,
- &-0.70932E+00,-0.70950E+00,-0.70968E+00,-0.70986E+00,-0.71004E+00,
- &-0.71022E+00,-0.71040E+00,-0.71057E+00,-0.71075E+00,-0.71092E+00,
- &-0.71109E+00,-0.71127E+00,-0.71144E+00,-0.71161E+00,-0.71178E+00,
- &-0.71195E+00,-0.71212E+00,-0.71229E+00,-0.71246E+00,-0.71263E+00,
- &-0.71279E+00,-0.71296E+00,-0.71313E+00,-0.71329E+00,-0.71346E+00,
- &-0.71362E+00,-0.71378E+00,-0.71394E+00,-0.71411E+00,-0.71427E+00,
- &-0.71443E+00,-0.71459E+00,-0.71474E+00,-0.71490E+00,-0.71506E+00,
- &-0.71522E+00,-0.71537E+00,-0.71553E+00,-0.71568E+00,-0.71584E+00,
- &-0.71599E+00,-0.71614E+00,-0.71630E+00,-0.71645E+00,-0.71660E+00/
-
- DATA (BNC05M(I),I=601,700)/
- &-0.71819E+00,-0.71960E+00,-0.72096E+00,-0.72225E+00,-0.72349E+00,
- &-0.72467E+00,-0.72581E+00,-0.72689E+00,-0.72792E+00,-0.72891E+00,
- &-0.72985E+00,-0.73074E+00,-0.73159E+00,-0.73240E+00,-0.73316E+00,
- &-0.73389E+00,-0.73457E+00,-0.73522E+00,-0.73583E+00,-0.73640E+00,
- &-0.73694E+00,-0.73744E+00,-0.73791E+00,-0.73835E+00,-0.73875E+00,
- &-0.73912E+00,-0.73947E+00,-0.73978E+00,-0.74006E+00,-0.74032E+00,
- &-0.74055E+00,-0.74075E+00,-0.74093E+00,-0.74107E+00,-0.74120E+00,
- &-0.74130E+00,-0.74137E+00,-0.74142E+00,-0.74145E+00,-0.74146E+00,
- &-0.74144E+00,-0.74141E+00,-0.74135E+00,-0.74127E+00,-0.74117E+00,
- &-0.74105E+00,-0.74092E+00,-0.74076E+00,-0.74058E+00,-0.74039E+00,
- &-0.74018E+00,-0.73995E+00,-0.73971E+00,-0.73945E+00,-0.73917E+00,
- &-0.73887E+00,-0.73856E+00,-0.73824E+00,-0.73790E+00,-0.73754E+00,
- &-0.73717E+00,-0.73679E+00,-0.73639E+00,-0.73598E+00,-0.73555E+00,
- &-0.73512E+00,-0.73466E+00,-0.73420E+00,-0.73372E+00,-0.73324E+00,
- &-0.73273E+00,-0.73222E+00,-0.73170E+00,-0.73116E+00,-0.73062E+00,
- &-0.73006E+00,-0.72949E+00,-0.72891E+00,-0.72832E+00,-0.72772E+00,
- &-0.72711E+00,-0.72649E+00,-0.72587E+00,-0.72523E+00,-0.72458E+00,
- &-0.72392E+00,-0.72325E+00,-0.72258E+00,-0.72190E+00,-0.72120E+00,
- &-0.72050E+00,-0.71979E+00,-0.71907E+00,-0.71835E+00,-0.71762E+00,
- &-0.71687E+00,-0.71613E+00,-0.71537E+00,-0.71460E+00,-0.71383E+00/
-
- DATA (BNC05M(I),I=701,741)/
- &-0.71305E+00,-0.71227E+00,-0.71148E+00,-0.71068E+00,-0.70987E+00,
- &-0.70906E+00,-0.70824E+00,-0.70741E+00,-0.70658E+00,-0.70574E+00,
- &-0.70490E+00,-0.70404E+00,-0.70319E+00,-0.70232E+00,-0.70146E+00,
- &-0.70058E+00,-0.69970E+00,-0.69882E+00,-0.69792E+00,-0.69703E+00,
- &-0.69613E+00,-0.69522E+00,-0.69431E+00,-0.69339E+00,-0.69247E+00,
- &-0.69154E+00,-0.69061E+00,-0.68967E+00,-0.68873E+00,-0.68778E+00,
- &-0.68683E+00,-0.68588E+00,-0.68492E+00,-0.68395E+00,-0.68298E+00,
- &-0.68201E+00,-0.68103E+00,-0.68005E+00,-0.67907E+00,-0.67808E+00,
- &-0.67708E+00
- & /
-C
-C *** NH4Cl
-C
- DATA (BNC06M(I),I=1,100)/
- &-0.44830E-01,-0.95566E-01,-0.11981E+00,-0.13634E+00,-0.14889E+00,
- &-0.15895E+00,-0.16730E+00,-0.17439E+00,-0.18052E+00,-0.18588E+00,
- &-0.19061E+00,-0.19483E+00,-0.19861E+00,-0.20202E+00,-0.20511E+00,
- &-0.20792E+00,-0.21049E+00,-0.21283E+00,-0.21498E+00,-0.21696E+00,
- &-0.21878E+00,-0.22046E+00,-0.22201E+00,-0.22344E+00,-0.22477E+00,
- &-0.22600E+00,-0.22714E+00,-0.22819E+00,-0.22917E+00,-0.23007E+00,
- &-0.23091E+00,-0.23169E+00,-0.23242E+00,-0.23308E+00,-0.23370E+00,
- &-0.23428E+00,-0.23481E+00,-0.23530E+00,-0.23575E+00,-0.23616E+00,
- &-0.23655E+00,-0.23690E+00,-0.23722E+00,-0.23751E+00,-0.23778E+00,
- &-0.23802E+00,-0.23824E+00,-0.23843E+00,-0.23861E+00,-0.23876E+00,
- &-0.23890E+00,-0.23901E+00,-0.23911E+00,-0.23919E+00,-0.23926E+00,
- &-0.23931E+00,-0.23934E+00,-0.23936E+00,-0.23937E+00,-0.23936E+00,
- &-0.23934E+00,-0.23931E+00,-0.23926E+00,-0.23921E+00,-0.23914E+00,
- &-0.23906E+00,-0.23896E+00,-0.23886E+00,-0.23874E+00,-0.23862E+00,
- &-0.23848E+00,-0.23833E+00,-0.23818E+00,-0.23801E+00,-0.23783E+00,
- &-0.23764E+00,-0.23744E+00,-0.23723E+00,-0.23701E+00,-0.23678E+00,
- &-0.23654E+00,-0.23630E+00,-0.23604E+00,-0.23577E+00,-0.23549E+00,
- &-0.23520E+00,-0.23491E+00,-0.23460E+00,-0.23429E+00,-0.23397E+00,
- &-0.23363E+00,-0.23329E+00,-0.23295E+00,-0.23259E+00,-0.23222E+00,
- &-0.23185E+00,-0.23147E+00,-0.23108E+00,-0.23069E+00,-0.23028E+00/
-
- DATA (BNC06M(I),I=101,200)/
- &-0.22987E+00,-0.22946E+00,-0.22903E+00,-0.22860E+00,-0.22817E+00,
- &-0.22773E+00,-0.22728E+00,-0.22682E+00,-0.22637E+00,-0.22590E+00,
- &-0.22543E+00,-0.22496E+00,-0.22448E+00,-0.22400E+00,-0.22351E+00,
- &-0.22302E+00,-0.22253E+00,-0.22203E+00,-0.22153E+00,-0.22102E+00,
- &-0.22051E+00,-0.22000E+00,-0.21949E+00,-0.21897E+00,-0.21845E+00,
- &-0.21792E+00,-0.21740E+00,-0.21687E+00,-0.21634E+00,-0.21581E+00,
- &-0.21527E+00,-0.21474E+00,-0.21420E+00,-0.21366E+00,-0.21311E+00,
- &-0.21257E+00,-0.21202E+00,-0.21148E+00,-0.21093E+00,-0.21038E+00,
- &-0.20983E+00,-0.20927E+00,-0.20872E+00,-0.20816E+00,-0.20761E+00,
- &-0.20705E+00,-0.20649E+00,-0.20593E+00,-0.20537E+00,-0.20480E+00,
- &-0.20424E+00,-0.20368E+00,-0.20311E+00,-0.20254E+00,-0.20198E+00,
- &-0.20141E+00,-0.20084E+00,-0.20027E+00,-0.19970E+00,-0.19913E+00,
- &-0.19856E+00,-0.19799E+00,-0.19742E+00,-0.19684E+00,-0.19627E+00,
- &-0.19569E+00,-0.19512E+00,-0.19454E+00,-0.19397E+00,-0.19339E+00,
- &-0.19281E+00,-0.19224E+00,-0.19166E+00,-0.19108E+00,-0.19050E+00,
- &-0.18992E+00,-0.18934E+00,-0.18876E+00,-0.18818E+00,-0.18760E+00,
- &-0.18702E+00,-0.18644E+00,-0.18586E+00,-0.18528E+00,-0.18469E+00,
- &-0.18411E+00,-0.18353E+00,-0.18295E+00,-0.18236E+00,-0.18178E+00,
- &-0.18120E+00,-0.18061E+00,-0.18003E+00,-0.17945E+00,-0.17886E+00,
- &-0.17828E+00,-0.17770E+00,-0.17711E+00,-0.17653E+00,-0.17594E+00/
-
- DATA (BNC06M(I),I=201,300)/
- &-0.17536E+00,-0.17478E+00,-0.17419E+00,-0.17361E+00,-0.17302E+00,
- &-0.17244E+00,-0.17186E+00,-0.17127E+00,-0.17069E+00,-0.17010E+00,
- &-0.16952E+00,-0.16893E+00,-0.16835E+00,-0.16777E+00,-0.16718E+00,
- &-0.16660E+00,-0.16601E+00,-0.16543E+00,-0.16485E+00,-0.16426E+00,
- &-0.16368E+00,-0.16310E+00,-0.16251E+00,-0.16193E+00,-0.16135E+00,
- &-0.16076E+00,-0.16018E+00,-0.15960E+00,-0.15902E+00,-0.15843E+00,
- &-0.15785E+00,-0.15727E+00,-0.15669E+00,-0.15611E+00,-0.15553E+00,
- &-0.15494E+00,-0.15436E+00,-0.15378E+00,-0.15320E+00,-0.15262E+00,
- &-0.15204E+00,-0.15146E+00,-0.15088E+00,-0.15030E+00,-0.14972E+00,
- &-0.14914E+00,-0.14857E+00,-0.14799E+00,-0.14741E+00,-0.14683E+00,
- &-0.14625E+00,-0.14567E+00,-0.14510E+00,-0.14452E+00,-0.14394E+00,
- &-0.14337E+00,-0.14279E+00,-0.14221E+00,-0.14164E+00,-0.14106E+00,
- &-0.14049E+00,-0.13991E+00,-0.13934E+00,-0.13876E+00,-0.13819E+00,
- &-0.13762E+00,-0.13704E+00,-0.13647E+00,-0.13590E+00,-0.13532E+00,
- &-0.13475E+00,-0.13418E+00,-0.13361E+00,-0.13304E+00,-0.13247E+00,
- &-0.13190E+00,-0.13132E+00,-0.13075E+00,-0.13019E+00,-0.12962E+00,
- &-0.12905E+00,-0.12848E+00,-0.12791E+00,-0.12734E+00,-0.12677E+00,
- &-0.12621E+00,-0.12564E+00,-0.12507E+00,-0.12451E+00,-0.12394E+00,
- &-0.12337E+00,-0.12281E+00,-0.12224E+00,-0.12168E+00,-0.12111E+00,
- &-0.12055E+00,-0.11999E+00,-0.11942E+00,-0.11886E+00,-0.11830E+00/
-
- DATA (BNC06M(I),I=301,400)/
- &-0.11773E+00,-0.11717E+00,-0.11661E+00,-0.11605E+00,-0.11549E+00,
- &-0.11493E+00,-0.11437E+00,-0.11381E+00,-0.11325E+00,-0.11269E+00,
- &-0.11213E+00,-0.11157E+00,-0.11101E+00,-0.11046E+00,-0.10990E+00,
- &-0.10934E+00,-0.10879E+00,-0.10823E+00,-0.10767E+00,-0.10712E+00,
- &-0.10656E+00,-0.10601E+00,-0.10546E+00,-0.10490E+00,-0.10435E+00,
- &-0.10379E+00,-0.10324E+00,-0.10269E+00,-0.10214E+00,-0.10159E+00,
- &-0.10103E+00,-0.10048E+00,-0.99932E-01,-0.99382E-01,-0.98832E-01,
- &-0.98283E-01,-0.97734E-01,-0.97185E-01,-0.96637E-01,-0.96089E-01,
- &-0.95541E-01,-0.94994E-01,-0.94447E-01,-0.93901E-01,-0.93355E-01,
- &-0.92809E-01,-0.92264E-01,-0.91719E-01,-0.91174E-01,-0.90630E-01,
- &-0.90086E-01,-0.89543E-01,-0.89000E-01,-0.88457E-01,-0.87915E-01,
- &-0.87373E-01,-0.86831E-01,-0.86290E-01,-0.85750E-01,-0.85209E-01,
- &-0.84669E-01,-0.84130E-01,-0.83590E-01,-0.83051E-01,-0.82513E-01,
- &-0.81975E-01,-0.81437E-01,-0.80900E-01,-0.80363E-01,-0.79826E-01,
- &-0.79290E-01,-0.78754E-01,-0.78219E-01,-0.77684E-01,-0.77149E-01,
- &-0.76615E-01,-0.76081E-01,-0.75547E-01,-0.75014E-01,-0.74481E-01,
- &-0.73949E-01,-0.73417E-01,-0.72885E-01,-0.72354E-01,-0.71823E-01,
- &-0.71293E-01,-0.70763E-01,-0.70233E-01,-0.69703E-01,-0.69174E-01,
- &-0.68646E-01,-0.68117E-01,-0.67590E-01,-0.67062E-01,-0.66535E-01,
- &-0.66008E-01,-0.65482E-01,-0.64956E-01,-0.64430E-01,-0.63905E-01/
-
- DATA (BNC06M(I),I=401,500)/
- &-0.63380E-01,-0.62856E-01,-0.62331E-01,-0.61808E-01,-0.61284E-01,
- &-0.60761E-01,-0.60239E-01,-0.59716E-01,-0.59194E-01,-0.58673E-01,
- &-0.58152E-01,-0.57631E-01,-0.57111E-01,-0.56591E-01,-0.56071E-01,
- &-0.55552E-01,-0.55033E-01,-0.54514E-01,-0.53996E-01,-0.53478E-01,
- &-0.52961E-01,-0.52444E-01,-0.51927E-01,-0.51410E-01,-0.50894E-01,
- &-0.50379E-01,-0.49864E-01,-0.49349E-01,-0.48834E-01,-0.48320E-01,
- &-0.47806E-01,-0.47293E-01,-0.46780E-01,-0.46267E-01,-0.45755E-01,
- &-0.45243E-01,-0.44731E-01,-0.44220E-01,-0.43709E-01,-0.43198E-01,
- &-0.42688E-01,-0.42178E-01,-0.41669E-01,-0.41160E-01,-0.40651E-01,
- &-0.40143E-01,-0.39635E-01,-0.39127E-01,-0.38620E-01,-0.38113E-01,
- &-0.37606E-01,-0.37100E-01,-0.36594E-01,-0.36088E-01,-0.35583E-01,
- &-0.35078E-01,-0.34574E-01,-0.34070E-01,-0.33566E-01,-0.33063E-01,
- &-0.32560E-01,-0.32057E-01,-0.31554E-01,-0.31052E-01,-0.30551E-01,
- &-0.30049E-01,-0.29548E-01,-0.29048E-01,-0.28548E-01,-0.28048E-01,
- &-0.27548E-01,-0.27049E-01,-0.26550E-01,-0.26051E-01,-0.25553E-01,
- &-0.25055E-01,-0.24558E-01,-0.24061E-01,-0.23564E-01,-0.23067E-01,
- &-0.22571E-01,-0.22075E-01,-0.21580E-01,-0.21085E-01,-0.20590E-01,
- &-0.20096E-01,-0.19602E-01,-0.19108E-01,-0.18614E-01,-0.18121E-01,
- &-0.17629E-01,-0.17136E-01,-0.16644E-01,-0.16153E-01,-0.15661E-01,
- &-0.15170E-01,-0.14679E-01,-0.14189E-01,-0.13699E-01,-0.13209E-01/
-
- DATA (BNC06M(I),I=501,600)/
- &-0.12720E-01,-0.12231E-01,-0.11742E-01,-0.11254E-01,-0.10766E-01,
- &-0.10278E-01,-0.97905E-02,-0.93034E-02,-0.88167E-02,-0.83303E-02,
- &-0.78442E-02,-0.73585E-02,-0.68730E-02,-0.63879E-02,-0.59032E-02,
- &-0.54187E-02,-0.49346E-02,-0.44508E-02,-0.39674E-02,-0.34842E-02,
- &-0.30014E-02,-0.25189E-02,-0.20367E-02,-0.15548E-02,-0.10733E-02,
- &-0.59210E-03,-0.11121E-03, 0.36935E-03, 0.84963E-03, 0.13296E-02,
- & 0.18092E-02, 0.22885E-02, 0.27674E-02, 0.32461E-02, 0.37244E-02,
- & 0.42024E-02, 0.46802E-02, 0.51576E-02, 0.56347E-02, 0.61114E-02,
- & 0.65879E-02, 0.70641E-02, 0.75399E-02, 0.80154E-02, 0.84906E-02,
- & 0.89655E-02, 0.94401E-02, 0.99143E-02, 0.10388E-01, 0.10862E-01,
- & 0.11335E-01, 0.11808E-01, 0.12281E-01, 0.12753E-01, 0.13226E-01,
- & 0.13697E-01, 0.14169E-01, 0.14640E-01, 0.15111E-01, 0.15582E-01,
- & 0.16052E-01, 0.16522E-01, 0.16991E-01, 0.17461E-01, 0.17930E-01,
- & 0.18399E-01, 0.18867E-01, 0.19335E-01, 0.19803E-01, 0.20271E-01,
- & 0.20738E-01, 0.21205E-01, 0.21672E-01, 0.22138E-01, 0.22604E-01,
- & 0.23070E-01, 0.23535E-01, 0.24000E-01, 0.24465E-01, 0.24930E-01,
- & 0.25394E-01, 0.25858E-01, 0.26322E-01, 0.26785E-01, 0.27248E-01,
- & 0.27711E-01, 0.28174E-01, 0.28636E-01, 0.29098E-01, 0.29560E-01,
- & 0.30021E-01, 0.30482E-01, 0.30943E-01, 0.31403E-01, 0.31864E-01,
- & 0.32324E-01, 0.32783E-01, 0.33242E-01, 0.33702E-01, 0.34160E-01/
-
- DATA (BNC06M(I),I=601,700)/
- & 0.39099E-01, 0.43640E-01, 0.48155E-01, 0.52641E-01, 0.57101E-01,
- & 0.61535E-01, 0.65943E-01, 0.70325E-01, 0.74682E-01, 0.79014E-01,
- & 0.83322E-01, 0.87606E-01, 0.91866E-01, 0.96103E-01, 0.10032E+00,
- & 0.10451E+00, 0.10868E+00, 0.11282E+00, 0.11695E+00, 0.12105E+00,
- & 0.12514E+00, 0.12920E+00, 0.13324E+00, 0.13726E+00, 0.14127E+00,
- & 0.14525E+00, 0.14921E+00, 0.15316E+00, 0.15709E+00, 0.16099E+00,
- & 0.16488E+00, 0.16876E+00, 0.17261E+00, 0.17645E+00, 0.18027E+00,
- & 0.18407E+00, 0.18786E+00, 0.19163E+00, 0.19538E+00, 0.19912E+00,
- & 0.20284E+00, 0.20655E+00, 0.21024E+00, 0.21391E+00, 0.21757E+00,
- & 0.22122E+00, 0.22485E+00, 0.22847E+00, 0.23207E+00, 0.23566E+00,
- & 0.23924E+00, 0.24280E+00, 0.24634E+00, 0.24988E+00, 0.25340E+00,
- & 0.25691E+00, 0.26040E+00, 0.26389E+00, 0.26735E+00, 0.27081E+00,
- & 0.27426E+00, 0.27769E+00, 0.28111E+00, 0.28452E+00, 0.28792E+00,
- & 0.29130E+00, 0.29468E+00, 0.29804E+00, 0.30139E+00, 0.30473E+00,
- & 0.30806E+00, 0.31138E+00, 0.31469E+00, 0.31799E+00, 0.32127E+00,
- & 0.32455E+00, 0.32782E+00, 0.33107E+00, 0.33432E+00, 0.33756E+00,
- & 0.34078E+00, 0.34400E+00, 0.34721E+00, 0.35040E+00, 0.35359E+00,
- & 0.35677E+00, 0.35994E+00, 0.36310E+00, 0.36625E+00, 0.36940E+00,
- & 0.37253E+00, 0.37565E+00, 0.37877E+00, 0.38188E+00, 0.38498E+00,
- & 0.38807E+00, 0.39115E+00, 0.39423E+00, 0.39729E+00, 0.40035E+00/
-
- DATA (BNC06M(I),I=701,741)/
- & 0.40340E+00, 0.40644E+00, 0.40947E+00, 0.41250E+00, 0.41552E+00,
- & 0.41853E+00, 0.42153E+00, 0.42453E+00, 0.42752E+00, 0.43050E+00,
- & 0.43347E+00, 0.43644E+00, 0.43939E+00, 0.44235E+00, 0.44529E+00,
- & 0.44823E+00, 0.45116E+00, 0.45408E+00, 0.45700E+00, 0.45991E+00,
- & 0.46281E+00, 0.46571E+00, 0.46860E+00, 0.47149E+00, 0.47436E+00,
- & 0.47723E+00, 0.48010E+00, 0.48296E+00, 0.48581E+00, 0.48865E+00,
- & 0.49149E+00, 0.49433E+00, 0.49715E+00, 0.49998E+00, 0.50279E+00,
- & 0.50560E+00, 0.50840E+00, 0.51120E+00, 0.51399E+00, 0.51678E+00,
- & 0.51956E+00
- & /
-C
-C *** (2H,SO4)
-C
- DATA (BNC07M(I),I=1,100)/
- &-0.90523E-01,-0.19581E+00,-0.24777E+00,-0.28414E+00,-0.31242E+00,
- &-0.33564E+00,-0.35536E+00,-0.37250E+00,-0.38765E+00,-0.40122E+00,
- &-0.41351E+00,-0.42472E+00,-0.43503E+00,-0.44456E+00,-0.45341E+00,
- &-0.46168E+00,-0.46943E+00,-0.47672E+00,-0.48359E+00,-0.49009E+00,
- &-0.49625E+00,-0.50210E+00,-0.50767E+00,-0.51299E+00,-0.51807E+00,
- &-0.52293E+00,-0.52759E+00,-0.53206E+00,-0.53635E+00,-0.54048E+00,
- &-0.54446E+00,-0.54830E+00,-0.55200E+00,-0.55557E+00,-0.55902E+00,
- &-0.56236E+00,-0.56559E+00,-0.56872E+00,-0.57176E+00,-0.57470E+00,
- &-0.57756E+00,-0.58033E+00,-0.58303E+00,-0.58564E+00,-0.58819E+00,
- &-0.59067E+00,-0.59308E+00,-0.59543E+00,-0.59772E+00,-0.59995E+00,
- &-0.60213E+00,-0.60425E+00,-0.60632E+00,-0.60834E+00,-0.61031E+00,
- &-0.61224E+00,-0.61412E+00,-0.61596E+00,-0.61775E+00,-0.61951E+00,
- &-0.62123E+00,-0.62292E+00,-0.62456E+00,-0.62618E+00,-0.62776E+00,
- &-0.62930E+00,-0.63082E+00,-0.63230E+00,-0.63376E+00,-0.63519E+00,
- &-0.63659E+00,-0.63796E+00,-0.63931E+00,-0.64063E+00,-0.64193E+00,
- &-0.64320E+00,-0.64445E+00,-0.64568E+00,-0.64689E+00,-0.64808E+00,
- &-0.64924E+00,-0.65039E+00,-0.65152E+00,-0.65263E+00,-0.65372E+00,
- &-0.65479E+00,-0.65584E+00,-0.65688E+00,-0.65790E+00,-0.65891E+00,
- &-0.65990E+00,-0.66087E+00,-0.66183E+00,-0.66278E+00,-0.66371E+00,
- &-0.66463E+00,-0.66553E+00,-0.66642E+00,-0.66730E+00,-0.66816E+00/
-
- DATA (BNC07M(I),I=101,200)/
- &-0.66901E+00,-0.66985E+00,-0.67068E+00,-0.67149E+00,-0.67230E+00,
- &-0.67309E+00,-0.67387E+00,-0.67464E+00,-0.67540E+00,-0.67615E+00,
- &-0.67689E+00,-0.67762E+00,-0.67834E+00,-0.67905E+00,-0.67975E+00,
- &-0.68044E+00,-0.68112E+00,-0.68179E+00,-0.68245E+00,-0.68310E+00,
- &-0.68375E+00,-0.68438E+00,-0.68501E+00,-0.68563E+00,-0.68624E+00,
- &-0.68684E+00,-0.68743E+00,-0.68802E+00,-0.68860E+00,-0.68917E+00,
- &-0.68973E+00,-0.69029E+00,-0.69083E+00,-0.69137E+00,-0.69191E+00,
- &-0.69243E+00,-0.69295E+00,-0.69347E+00,-0.69397E+00,-0.69447E+00,
- &-0.69497E+00,-0.69545E+00,-0.69593E+00,-0.69641E+00,-0.69688E+00,
- &-0.69734E+00,-0.69779E+00,-0.69824E+00,-0.69869E+00,-0.69912E+00,
- &-0.69956E+00,-0.69998E+00,-0.70041E+00,-0.70082E+00,-0.70123E+00,
- &-0.70164E+00,-0.70204E+00,-0.70243E+00,-0.70282E+00,-0.70321E+00,
- &-0.70359E+00,-0.70396E+00,-0.70433E+00,-0.70470E+00,-0.70506E+00,
- &-0.70541E+00,-0.70577E+00,-0.70611E+00,-0.70646E+00,-0.70679E+00,
- &-0.70713E+00,-0.70746E+00,-0.70778E+00,-0.70810E+00,-0.70842E+00,
- &-0.70873E+00,-0.70904E+00,-0.70934E+00,-0.70964E+00,-0.70994E+00,
- &-0.71023E+00,-0.71052E+00,-0.71081E+00,-0.71109E+00,-0.71137E+00,
- &-0.71164E+00,-0.71191E+00,-0.71218E+00,-0.71244E+00,-0.71270E+00,
- &-0.71296E+00,-0.71321E+00,-0.71346E+00,-0.71371E+00,-0.71395E+00,
- &-0.71419E+00,-0.71443E+00,-0.71466E+00,-0.71489E+00,-0.71512E+00/
-
- DATA (BNC07M(I),I=201,300)/
- &-0.71534E+00,-0.71556E+00,-0.71578E+00,-0.71599E+00,-0.71620E+00,
- &-0.71641E+00,-0.71662E+00,-0.71682E+00,-0.71702E+00,-0.71722E+00,
- &-0.71741E+00,-0.71760E+00,-0.71779E+00,-0.71798E+00,-0.71816E+00,
- &-0.71834E+00,-0.71852E+00,-0.71870E+00,-0.71887E+00,-0.71904E+00,
- &-0.71921E+00,-0.71937E+00,-0.71954E+00,-0.71970E+00,-0.71986E+00,
- &-0.72001E+00,-0.72016E+00,-0.72032E+00,-0.72046E+00,-0.72061E+00,
- &-0.72075E+00,-0.72090E+00,-0.72103E+00,-0.72117E+00,-0.72131E+00,
- &-0.72144E+00,-0.72157E+00,-0.72170E+00,-0.72182E+00,-0.72195E+00,
- &-0.72207E+00,-0.72219E+00,-0.72231E+00,-0.72242E+00,-0.72254E+00,
- &-0.72265E+00,-0.72276E+00,-0.72287E+00,-0.72297E+00,-0.72307E+00,
- &-0.72318E+00,-0.72328E+00,-0.72337E+00,-0.72347E+00,-0.72356E+00,
- &-0.72366E+00,-0.72375E+00,-0.72384E+00,-0.72392E+00,-0.72401E+00,
- &-0.72409E+00,-0.72417E+00,-0.72425E+00,-0.72433E+00,-0.72441E+00,
- &-0.72448E+00,-0.72455E+00,-0.72463E+00,-0.72470E+00,-0.72476E+00,
- &-0.72483E+00,-0.72489E+00,-0.72496E+00,-0.72502E+00,-0.72508E+00,
- &-0.72514E+00,-0.72519E+00,-0.72525E+00,-0.72530E+00,-0.72535E+00,
- &-0.72540E+00,-0.72545E+00,-0.72550E+00,-0.72555E+00,-0.72559E+00,
- &-0.72563E+00,-0.72568E+00,-0.72572E+00,-0.72576E+00,-0.72579E+00,
- &-0.72583E+00,-0.72586E+00,-0.72590E+00,-0.72593E+00,-0.72596E+00,
- &-0.72599E+00,-0.72602E+00,-0.72604E+00,-0.72607E+00,-0.72609E+00/
-
- DATA (BNC07M(I),I=301,400)/
- &-0.72611E+00,-0.72613E+00,-0.72615E+00,-0.72617E+00,-0.72619E+00,
- &-0.72621E+00,-0.72622E+00,-0.72623E+00,-0.72625E+00,-0.72626E+00,
- &-0.72627E+00,-0.72628E+00,-0.72628E+00,-0.72629E+00,-0.72629E+00,
- &-0.72630E+00,-0.72630E+00,-0.72630E+00,-0.72630E+00,-0.72630E+00,
- &-0.72630E+00,-0.72630E+00,-0.72629E+00,-0.72629E+00,-0.72628E+00,
- &-0.72627E+00,-0.72627E+00,-0.72626E+00,-0.72624E+00,-0.72623E+00,
- &-0.72622E+00,-0.72621E+00,-0.72619E+00,-0.72617E+00,-0.72616E+00,
- &-0.72614E+00,-0.72612E+00,-0.72610E+00,-0.72608E+00,-0.72606E+00,
- &-0.72603E+00,-0.72601E+00,-0.72598E+00,-0.72596E+00,-0.72593E+00,
- &-0.72590E+00,-0.72587E+00,-0.72584E+00,-0.72581E+00,-0.72578E+00,
- &-0.72575E+00,-0.72571E+00,-0.72568E+00,-0.72564E+00,-0.72561E+00,
- &-0.72557E+00,-0.72553E+00,-0.72549E+00,-0.72545E+00,-0.72541E+00,
- &-0.72537E+00,-0.72532E+00,-0.72528E+00,-0.72524E+00,-0.72519E+00,
- &-0.72514E+00,-0.72510E+00,-0.72505E+00,-0.72500E+00,-0.72495E+00,
- &-0.72490E+00,-0.72485E+00,-0.72480E+00,-0.72474E+00,-0.72469E+00,
- &-0.72463E+00,-0.72458E+00,-0.72452E+00,-0.72446E+00,-0.72441E+00,
- &-0.72435E+00,-0.72429E+00,-0.72423E+00,-0.72417E+00,-0.72411E+00,
- &-0.72404E+00,-0.72398E+00,-0.72392E+00,-0.72385E+00,-0.72379E+00,
- &-0.72372E+00,-0.72365E+00,-0.72358E+00,-0.72352E+00,-0.72345E+00,
- &-0.72338E+00,-0.72331E+00,-0.72323E+00,-0.72316E+00,-0.72309E+00/
-
- DATA (BNC07M(I),I=401,500)/
- &-0.72302E+00,-0.72294E+00,-0.72287E+00,-0.72279E+00,-0.72271E+00,
- &-0.72264E+00,-0.72256E+00,-0.72248E+00,-0.72240E+00,-0.72232E+00,
- &-0.72224E+00,-0.72216E+00,-0.72208E+00,-0.72200E+00,-0.72191E+00,
- &-0.72183E+00,-0.72175E+00,-0.72166E+00,-0.72158E+00,-0.72149E+00,
- &-0.72140E+00,-0.72131E+00,-0.72123E+00,-0.72114E+00,-0.72105E+00,
- &-0.72096E+00,-0.72087E+00,-0.72078E+00,-0.72069E+00,-0.72059E+00,
- &-0.72050E+00,-0.72041E+00,-0.72031E+00,-0.72022E+00,-0.72012E+00,
- &-0.72003E+00,-0.71993E+00,-0.71983E+00,-0.71973E+00,-0.71964E+00,
- &-0.71954E+00,-0.71944E+00,-0.71934E+00,-0.71924E+00,-0.71914E+00,
- &-0.71903E+00,-0.71893E+00,-0.71883E+00,-0.71873E+00,-0.71862E+00,
- &-0.71852E+00,-0.71841E+00,-0.71831E+00,-0.71820E+00,-0.71809E+00,
- &-0.71799E+00,-0.71788E+00,-0.71777E+00,-0.71766E+00,-0.71755E+00,
- &-0.71744E+00,-0.71733E+00,-0.71722E+00,-0.71711E+00,-0.71700E+00,
- &-0.71689E+00,-0.71677E+00,-0.71666E+00,-0.71655E+00,-0.71643E+00,
- &-0.71632E+00,-0.71620E+00,-0.71609E+00,-0.71597E+00,-0.71585E+00,
- &-0.71574E+00,-0.71562E+00,-0.71550E+00,-0.71538E+00,-0.71526E+00,
- &-0.71514E+00,-0.71502E+00,-0.71490E+00,-0.71478E+00,-0.71466E+00,
- &-0.71454E+00,-0.71442E+00,-0.71429E+00,-0.71417E+00,-0.71405E+00,
- &-0.71392E+00,-0.71380E+00,-0.71367E+00,-0.71355E+00,-0.71342E+00,
- &-0.71329E+00,-0.71317E+00,-0.71304E+00,-0.71291E+00,-0.71278E+00/
-
- DATA (BNC07M(I),I=501,600)/
- &-0.71266E+00,-0.71253E+00,-0.71240E+00,-0.71227E+00,-0.71214E+00,
- &-0.71201E+00,-0.71187E+00,-0.71174E+00,-0.71161E+00,-0.71148E+00,
- &-0.71135E+00,-0.71121E+00,-0.71108E+00,-0.71094E+00,-0.71081E+00,
- &-0.71068E+00,-0.71054E+00,-0.71040E+00,-0.71027E+00,-0.71013E+00,
- &-0.70999E+00,-0.70986E+00,-0.70972E+00,-0.70958E+00,-0.70944E+00,
- &-0.70930E+00,-0.70917E+00,-0.70903E+00,-0.70889E+00,-0.70875E+00,
- &-0.70860E+00,-0.70846E+00,-0.70832E+00,-0.70818E+00,-0.70804E+00,
- &-0.70790E+00,-0.70775E+00,-0.70761E+00,-0.70747E+00,-0.70732E+00,
- &-0.70718E+00,-0.70703E+00,-0.70689E+00,-0.70674E+00,-0.70660E+00,
- &-0.70645E+00,-0.70630E+00,-0.70616E+00,-0.70601E+00,-0.70586E+00,
- &-0.70571E+00,-0.70556E+00,-0.70542E+00,-0.70527E+00,-0.70512E+00,
- &-0.70497E+00,-0.70482E+00,-0.70467E+00,-0.70452E+00,-0.70436E+00,
- &-0.70421E+00,-0.70406E+00,-0.70391E+00,-0.70376E+00,-0.70360E+00,
- &-0.70345E+00,-0.70330E+00,-0.70314E+00,-0.70299E+00,-0.70284E+00,
- &-0.70268E+00,-0.70253E+00,-0.70237E+00,-0.70222E+00,-0.70206E+00,
- &-0.70190E+00,-0.70175E+00,-0.70159E+00,-0.70143E+00,-0.70127E+00,
- &-0.70112E+00,-0.70096E+00,-0.70080E+00,-0.70064E+00,-0.70048E+00,
- &-0.70032E+00,-0.70016E+00,-0.70000E+00,-0.69984E+00,-0.69968E+00,
- &-0.69952E+00,-0.69936E+00,-0.69920E+00,-0.69904E+00,-0.69887E+00,
- &-0.69871E+00,-0.69855E+00,-0.69839E+00,-0.69822E+00,-0.69806E+00/
-
- DATA (BNC07M(I),I=601,700)/
- &-0.69627E+00,-0.69459E+00,-0.69289E+00,-0.69115E+00,-0.68939E+00,
- &-0.68761E+00,-0.68581E+00,-0.68398E+00,-0.68213E+00,-0.68026E+00,
- &-0.67837E+00,-0.67646E+00,-0.67453E+00,-0.67259E+00,-0.67062E+00,
- &-0.66864E+00,-0.66664E+00,-0.66463E+00,-0.66260E+00,-0.66055E+00,
- &-0.65849E+00,-0.65641E+00,-0.65433E+00,-0.65222E+00,-0.65011E+00,
- &-0.64798E+00,-0.64584E+00,-0.64368E+00,-0.64152E+00,-0.63934E+00,
- &-0.63715E+00,-0.63495E+00,-0.63274E+00,-0.63052E+00,-0.62829E+00,
- &-0.62605E+00,-0.62380E+00,-0.62154E+00,-0.61927E+00,-0.61700E+00,
- &-0.61471E+00,-0.61242E+00,-0.61011E+00,-0.60780E+00,-0.60548E+00,
- &-0.60316E+00,-0.60082E+00,-0.59848E+00,-0.59613E+00,-0.59378E+00,
- &-0.59141E+00,-0.58904E+00,-0.58667E+00,-0.58428E+00,-0.58189E+00,
- &-0.57950E+00,-0.57710E+00,-0.57469E+00,-0.57228E+00,-0.56986E+00,
- &-0.56743E+00,-0.56500E+00,-0.56257E+00,-0.56013E+00,-0.55768E+00,
- &-0.55523E+00,-0.55278E+00,-0.55032E+00,-0.54785E+00,-0.54538E+00,
- &-0.54291E+00,-0.54043E+00,-0.53795E+00,-0.53546E+00,-0.53297E+00,
- &-0.53047E+00,-0.52797E+00,-0.52547E+00,-0.52296E+00,-0.52045E+00,
- &-0.51793E+00,-0.51541E+00,-0.51289E+00,-0.51037E+00,-0.50784E+00,
- &-0.50530E+00,-0.50277E+00,-0.50023E+00,-0.49769E+00,-0.49514E+00,
- &-0.49259E+00,-0.49004E+00,-0.48749E+00,-0.48493E+00,-0.48237E+00,
- &-0.47980E+00,-0.47724E+00,-0.47467E+00,-0.47210E+00,-0.46952E+00/
-
- DATA (BNC07M(I),I=701,741)/
- &-0.46694E+00,-0.46436E+00,-0.46178E+00,-0.45920E+00,-0.45661E+00,
- &-0.45402E+00,-0.45143E+00,-0.44884E+00,-0.44624E+00,-0.44364E+00,
- &-0.44104E+00,-0.43844E+00,-0.43583E+00,-0.43322E+00,-0.43062E+00,
- &-0.42800E+00,-0.42539E+00,-0.42278E+00,-0.42016E+00,-0.41754E+00,
- &-0.41492E+00,-0.41230E+00,-0.40967E+00,-0.40704E+00,-0.40442E+00,
- &-0.40179E+00,-0.39916E+00,-0.39652E+00,-0.39389E+00,-0.39125E+00,
- &-0.38861E+00,-0.38597E+00,-0.38333E+00,-0.38069E+00,-0.37805E+00,
- &-0.37540E+00,-0.37275E+00,-0.37010E+00,-0.36746E+00,-0.36480E+00,
- &-0.36215E+00
- & /
-C
-C *** (H,HSO4)
-C
- DATA (BNC08M(I),I=1,100)/
- &-0.42949E-01,-0.86374E-01,-0.10452E+00,-0.11550E+00,-0.12283E+00,
- &-0.12787E+00,-0.13133E+00,-0.13362E+00,-0.13499E+00,-0.13563E+00,
- &-0.13565E+00,-0.13515E+00,-0.13421E+00,-0.13286E+00,-0.13117E+00,
- &-0.12916E+00,-0.12686E+00,-0.12431E+00,-0.12150E+00,-0.11848E+00,
- &-0.11525E+00,-0.11182E+00,-0.10821E+00,-0.10442E+00,-0.10047E+00,
- &-0.96373E-01,-0.92125E-01,-0.87738E-01,-0.83218E-01,-0.78573E-01,
- &-0.73807E-01,-0.68926E-01,-0.63935E-01,-0.58840E-01,-0.53644E-01,
- &-0.48353E-01,-0.42970E-01,-0.37499E-01,-0.31944E-01,-0.26309E-01,
- &-0.20597E-01,-0.14812E-01,-0.89563E-02,-0.30333E-02, 0.29541E-02,
- & 0.90031E-02, 0.15111E-01, 0.21276E-01, 0.27495E-01, 0.33766E-01,
- & 0.40087E-01, 0.46455E-01, 0.52870E-01, 0.59330E-01, 0.65832E-01,
- & 0.72376E-01, 0.78960E-01, 0.85584E-01, 0.92245E-01, 0.98943E-01,
- & 0.10568E+00, 0.11245E+00, 0.11925E+00, 0.12610E+00, 0.13297E+00,
- & 0.13988E+00, 0.14682E+00, 0.15380E+00, 0.16082E+00, 0.16786E+00,
- & 0.17494E+00, 0.18206E+00, 0.18921E+00, 0.19640E+00, 0.20363E+00,
- & 0.21089E+00, 0.21819E+00, 0.22552E+00, 0.23290E+00, 0.24031E+00,
- & 0.24776E+00, 0.25525E+00, 0.26278E+00, 0.27035E+00, 0.27796E+00,
- & 0.28561E+00, 0.29330E+00, 0.30102E+00, 0.30879E+00, 0.31660E+00,
- & 0.32445E+00, 0.33233E+00, 0.34025E+00, 0.34821E+00, 0.35621E+00,
- & 0.36424E+00, 0.37231E+00, 0.38041E+00, 0.38854E+00, 0.39670E+00/
-
- DATA (BNC08M(I),I=101,200)/
- & 0.40490E+00, 0.41312E+00, 0.42137E+00, 0.42964E+00, 0.43795E+00,
- & 0.44627E+00, 0.45461E+00, 0.46298E+00, 0.47136E+00, 0.47976E+00,
- & 0.48818E+00, 0.49661E+00, 0.50506E+00, 0.51351E+00, 0.52198E+00,
- & 0.53045E+00, 0.53893E+00, 0.54742E+00, 0.55591E+00, 0.56440E+00,
- & 0.57290E+00, 0.58139E+00, 0.58989E+00, 0.59839E+00, 0.60688E+00,
- & 0.61537E+00, 0.62386E+00, 0.63234E+00, 0.64082E+00, 0.64929E+00,
- & 0.65776E+00, 0.66621E+00, 0.67466E+00, 0.68310E+00, 0.69153E+00,
- & 0.69995E+00, 0.70837E+00, 0.71677E+00, 0.72516E+00, 0.73353E+00,
- & 0.74190E+00, 0.75026E+00, 0.75860E+00, 0.76693E+00, 0.77525E+00,
- & 0.78355E+00, 0.79184E+00, 0.80012E+00, 0.80838E+00, 0.81663E+00,
- & 0.82487E+00, 0.83309E+00, 0.84130E+00, 0.84949E+00, 0.85767E+00,
- & 0.86583E+00, 0.87398E+00, 0.88212E+00, 0.89024E+00, 0.89834E+00,
- & 0.90643E+00, 0.91451E+00, 0.92256E+00, 0.93061E+00, 0.93864E+00,
- & 0.94665E+00, 0.95465E+00, 0.96263E+00, 0.97060E+00, 0.97855E+00,
- & 0.98648E+00, 0.99440E+00, 0.10023E+01, 0.10102E+01, 0.10181E+01,
- & 0.10259E+01, 0.10338E+01, 0.10416E+01, 0.10494E+01, 0.10572E+01,
- & 0.10650E+01, 0.10727E+01, 0.10805E+01, 0.10882E+01, 0.10959E+01,
- & 0.11036E+01, 0.11113E+01, 0.11190E+01, 0.11266E+01, 0.11343E+01,
- & 0.11419E+01, 0.11495E+01, 0.11571E+01, 0.11647E+01, 0.11722E+01,
- & 0.11798E+01, 0.11873E+01, 0.11948E+01, 0.12023E+01, 0.12098E+01/
-
- DATA (BNC08M(I),I=201,300)/
- & 0.12173E+01, 0.12247E+01, 0.12321E+01, 0.12396E+01, 0.12470E+01,
- & 0.12544E+01, 0.12617E+01, 0.12691E+01, 0.12764E+01, 0.12838E+01,
- & 0.12911E+01, 0.12984E+01, 0.13057E+01, 0.13129E+01, 0.13202E+01,
- & 0.13274E+01, 0.13346E+01, 0.13418E+01, 0.13490E+01, 0.13562E+01,
- & 0.13634E+01, 0.13705E+01, 0.13777E+01, 0.13848E+01, 0.13919E+01,
- & 0.13990E+01, 0.14060E+01, 0.14131E+01, 0.14202E+01, 0.14272E+01,
- & 0.14342E+01, 0.14412E+01, 0.14482E+01, 0.14552E+01, 0.14621E+01,
- & 0.14691E+01, 0.14760E+01, 0.14829E+01, 0.14898E+01, 0.14967E+01,
- & 0.15036E+01, 0.15104E+01, 0.15173E+01, 0.15241E+01, 0.15309E+01,
- & 0.15377E+01, 0.15445E+01, 0.15513E+01, 0.15581E+01, 0.15648E+01,
- & 0.15716E+01, 0.15783E+01, 0.15850E+01, 0.15917E+01, 0.15984E+01,
- & 0.16051E+01, 0.16117E+01, 0.16184E+01, 0.16250E+01, 0.16316E+01,
- & 0.16382E+01, 0.16448E+01, 0.16514E+01, 0.16579E+01, 0.16645E+01,
- & 0.16710E+01, 0.16776E+01, 0.16841E+01, 0.16906E+01, 0.16971E+01,
- & 0.17035E+01, 0.17100E+01, 0.17165E+01, 0.17229E+01, 0.17293E+01,
- & 0.17357E+01, 0.17421E+01, 0.17485E+01, 0.17549E+01, 0.17613E+01,
- & 0.17676E+01, 0.17740E+01, 0.17803E+01, 0.17866E+01, 0.17929E+01,
- & 0.17992E+01, 0.18055E+01, 0.18117E+01, 0.18180E+01, 0.18242E+01,
- & 0.18305E+01, 0.18367E+01, 0.18429E+01, 0.18491E+01, 0.18553E+01,
- & 0.18614E+01, 0.18676E+01, 0.18738E+01, 0.18799E+01, 0.18860E+01/
-
- DATA (BNC08M(I),I=301,400)/
- & 0.18921E+01, 0.18982E+01, 0.19043E+01, 0.19104E+01, 0.19165E+01,
- & 0.19225E+01, 0.19286E+01, 0.19346E+01, 0.19407E+01, 0.19467E+01,
- & 0.19527E+01, 0.19587E+01, 0.19646E+01, 0.19706E+01, 0.19766E+01,
- & 0.19825E+01, 0.19885E+01, 0.19944E+01, 0.20003E+01, 0.20062E+01,
- & 0.20121E+01, 0.20180E+01, 0.20239E+01, 0.20297E+01, 0.20356E+01,
- & 0.20414E+01, 0.20473E+01, 0.20531E+01, 0.20589E+01, 0.20647E+01,
- & 0.20705E+01, 0.20763E+01, 0.20820E+01, 0.20878E+01, 0.20935E+01,
- & 0.20993E+01, 0.21050E+01, 0.21107E+01, 0.21164E+01, 0.21221E+01,
- & 0.21278E+01, 0.21335E+01, 0.21392E+01, 0.21448E+01, 0.21505E+01,
- & 0.21561E+01, 0.21618E+01, 0.21674E+01, 0.21730E+01, 0.21786E+01,
- & 0.21842E+01, 0.21898E+01, 0.21953E+01, 0.22009E+01, 0.22065E+01,
- & 0.22120E+01, 0.22175E+01, 0.22231E+01, 0.22286E+01, 0.22341E+01,
- & 0.22396E+01, 0.22451E+01, 0.22506E+01, 0.22560E+01, 0.22615E+01,
- & 0.22669E+01, 0.22724E+01, 0.22778E+01, 0.22832E+01, 0.22887E+01,
- & 0.22941E+01, 0.22995E+01, 0.23048E+01, 0.23102E+01, 0.23156E+01,
- & 0.23210E+01, 0.23263E+01, 0.23317E+01, 0.23370E+01, 0.23423E+01,
- & 0.23476E+01, 0.23529E+01, 0.23582E+01, 0.23635E+01, 0.23688E+01,
- & 0.23741E+01, 0.23794E+01, 0.23846E+01, 0.23899E+01, 0.23951E+01,
- & 0.24003E+01, 0.24056E+01, 0.24108E+01, 0.24160E+01, 0.24212E+01,
- & 0.24264E+01, 0.24316E+01, 0.24367E+01, 0.24419E+01, 0.24471E+01/
-
- DATA (BNC08M(I),I=401,500)/
- & 0.24522E+01, 0.24574E+01, 0.24625E+01, 0.24676E+01, 0.24727E+01,
- & 0.24778E+01, 0.24829E+01, 0.24880E+01, 0.24931E+01, 0.24982E+01,
- & 0.25033E+01, 0.25083E+01, 0.25134E+01, 0.25184E+01, 0.25235E+01,
- & 0.25285E+01, 0.25335E+01, 0.25385E+01, 0.25436E+01, 0.25486E+01,
- & 0.25535E+01, 0.25585E+01, 0.25635E+01, 0.25685E+01, 0.25734E+01,
- & 0.25784E+01, 0.25833E+01, 0.25883E+01, 0.25932E+01, 0.25981E+01,
- & 0.26031E+01, 0.26080E+01, 0.26129E+01, 0.26178E+01, 0.26226E+01,
- & 0.26275E+01, 0.26324E+01, 0.26373E+01, 0.26421E+01, 0.26470E+01,
- & 0.26518E+01, 0.26567E+01, 0.26615E+01, 0.26663E+01, 0.26711E+01,
- & 0.26759E+01, 0.26807E+01, 0.26855E+01, 0.26903E+01, 0.26951E+01,
- & 0.26999E+01, 0.27046E+01, 0.27094E+01, 0.27141E+01, 0.27189E+01,
- & 0.27236E+01, 0.27284E+01, 0.27331E+01, 0.27378E+01, 0.27425E+01,
- & 0.27472E+01, 0.27519E+01, 0.27566E+01, 0.27613E+01, 0.27660E+01,
- & 0.27706E+01, 0.27753E+01, 0.27800E+01, 0.27846E+01, 0.27893E+01,
- & 0.27939E+01, 0.27985E+01, 0.28031E+01, 0.28078E+01, 0.28124E+01,
- & 0.28170E+01, 0.28216E+01, 0.28262E+01, 0.28308E+01, 0.28353E+01,
- & 0.28399E+01, 0.28445E+01, 0.28490E+01, 0.28536E+01, 0.28581E+01,
- & 0.28627E+01, 0.28672E+01, 0.28717E+01, 0.28763E+01, 0.28808E+01,
- & 0.28853E+01, 0.28898E+01, 0.28943E+01, 0.28988E+01, 0.29033E+01,
- & 0.29077E+01, 0.29122E+01, 0.29167E+01, 0.29211E+01, 0.29256E+01/
-
- DATA (BNC08M(I),I=501,600)/
- & 0.29300E+01, 0.29345E+01, 0.29389E+01, 0.29433E+01, 0.29478E+01,
- & 0.29522E+01, 0.29566E+01, 0.29610E+01, 0.29654E+01, 0.29698E+01,
- & 0.29742E+01, 0.29786E+01, 0.29830E+01, 0.29873E+01, 0.29917E+01,
- & 0.29960E+01, 0.30004E+01, 0.30047E+01, 0.30091E+01, 0.30134E+01,
- & 0.30178E+01, 0.30221E+01, 0.30264E+01, 0.30307E+01, 0.30350E+01,
- & 0.30393E+01, 0.30436E+01, 0.30479E+01, 0.30522E+01, 0.30565E+01,
- & 0.30608E+01, 0.30650E+01, 0.30693E+01, 0.30735E+01, 0.30778E+01,
- & 0.30820E+01, 0.30863E+01, 0.30905E+01, 0.30947E+01, 0.30990E+01,
- & 0.31032E+01, 0.31074E+01, 0.31116E+01, 0.31158E+01, 0.31200E+01,
- & 0.31242E+01, 0.31284E+01, 0.31326E+01, 0.31367E+01, 0.31409E+01,
- & 0.31451E+01, 0.31492E+01, 0.31534E+01, 0.31576E+01, 0.31617E+01,
- & 0.31658E+01, 0.31700E+01, 0.31741E+01, 0.31782E+01, 0.31823E+01,
- & 0.31865E+01, 0.31906E+01, 0.31947E+01, 0.31988E+01, 0.32029E+01,
- & 0.32069E+01, 0.32110E+01, 0.32151E+01, 0.32192E+01, 0.32232E+01,
- & 0.32273E+01, 0.32314E+01, 0.32354E+01, 0.32395E+01, 0.32435E+01,
- & 0.32476E+01, 0.32516E+01, 0.32556E+01, 0.32596E+01, 0.32637E+01,
- & 0.32677E+01, 0.32717E+01, 0.32757E+01, 0.32797E+01, 0.32837E+01,
- & 0.32877E+01, 0.32916E+01, 0.32956E+01, 0.32996E+01, 0.33036E+01,
- & 0.33075E+01, 0.33115E+01, 0.33154E+01, 0.33194E+01, 0.33233E+01,
- & 0.33273E+01, 0.33312E+01, 0.33352E+01, 0.33391E+01, 0.33430E+01/
-
- DATA (BNC08M(I),I=601,700)/
- & 0.33851E+01, 0.34236E+01, 0.34616E+01, 0.34992E+01, 0.35364E+01,
- & 0.35732E+01, 0.36095E+01, 0.36455E+01, 0.36811E+01, 0.37163E+01,
- & 0.37511E+01, 0.37856E+01, 0.38198E+01, 0.38535E+01, 0.38870E+01,
- & 0.39201E+01, 0.39529E+01, 0.39854E+01, 0.40175E+01, 0.40494E+01,
- & 0.40809E+01, 0.41122E+01, 0.41432E+01, 0.41738E+01, 0.42043E+01,
- & 0.42344E+01, 0.42643E+01, 0.42939E+01, 0.43232E+01, 0.43523E+01,
- & 0.43812E+01, 0.44098E+01, 0.44382E+01, 0.44663E+01, 0.44942E+01,
- & 0.45219E+01, 0.45494E+01, 0.45766E+01, 0.46036E+01, 0.46304E+01,
- & 0.46570E+01, 0.46834E+01, 0.47096E+01, 0.47356E+01, 0.47614E+01,
- & 0.47870E+01, 0.48124E+01, 0.48377E+01, 0.48627E+01, 0.48876E+01,
- & 0.49123E+01, 0.49368E+01, 0.49611E+01, 0.49853E+01, 0.50093E+01,
- & 0.50331E+01, 0.50568E+01, 0.50803E+01, 0.51036E+01, 0.51268E+01,
- & 0.51499E+01, 0.51728E+01, 0.51955E+01, 0.52181E+01, 0.52406E+01,
- & 0.52629E+01, 0.52850E+01, 0.53071E+01, 0.53290E+01, 0.53507E+01,
- & 0.53723E+01, 0.53938E+01, 0.54152E+01, 0.54364E+01, 0.54575E+01,
- & 0.54785E+01, 0.54993E+01, 0.55200E+01, 0.55406E+01, 0.55611E+01,
- & 0.55815E+01, 0.56018E+01, 0.56219E+01, 0.56419E+01, 0.56618E+01,
- & 0.56816E+01, 0.57013E+01, 0.57209E+01, 0.57404E+01, 0.57597E+01,
- & 0.57790E+01, 0.57982E+01, 0.58172E+01, 0.58362E+01, 0.58550E+01,
- & 0.58738E+01, 0.58925E+01, 0.59110E+01, 0.59295E+01, 0.59479E+01/
-
- DATA (BNC08M(I),I=701,741)/
- & 0.59661E+01, 0.59843E+01, 0.60024E+01, 0.60204E+01, 0.60384E+01,
- & 0.60562E+01, 0.60739E+01, 0.60916E+01, 0.61092E+01, 0.61266E+01,
- & 0.61440E+01, 0.61614E+01, 0.61786E+01, 0.61957E+01, 0.62128E+01,
- & 0.62298E+01, 0.62467E+01, 0.62636E+01, 0.62803E+01, 0.62970E+01,
- & 0.63136E+01, 0.63301E+01, 0.63466E+01, 0.63630E+01, 0.63793E+01,
- & 0.63955E+01, 0.64117E+01, 0.64278E+01, 0.64438E+01, 0.64598E+01,
- & 0.64757E+01, 0.64915E+01, 0.65073E+01, 0.65229E+01, 0.65386E+01,
- & 0.65541E+01, 0.65696E+01, 0.65850E+01, 0.66004E+01, 0.66157E+01,
- & 0.66309E+01
- & /
-C
-C *** NH4HSO4
-C
- DATA (BNC09M(I),I=1,100)/
- &-0.44571E-01,-0.94628E-01,-0.11852E+00,-0.13486E+00,-0.14728E+00,
- &-0.15726E+00,-0.16555E+00,-0.17260E+00,-0.17867E+00,-0.18397E+00,
- &-0.18863E+00,-0.19275E+00,-0.19642E+00,-0.19969E+00,-0.20262E+00,
- &-0.20523E+00,-0.20757E+00,-0.20965E+00,-0.21150E+00,-0.21315E+00,
- &-0.21460E+00,-0.21587E+00,-0.21698E+00,-0.21793E+00,-0.21873E+00,
- &-0.21940E+00,-0.21993E+00,-0.22034E+00,-0.22063E+00,-0.22082E+00,
- &-0.22089E+00,-0.22087E+00,-0.22075E+00,-0.22053E+00,-0.22023E+00,
- &-0.21984E+00,-0.21937E+00,-0.21882E+00,-0.21820E+00,-0.21750E+00,
- &-0.21673E+00,-0.21590E+00,-0.21500E+00,-0.21404E+00,-0.21302E+00,
- &-0.21194E+00,-0.21081E+00,-0.20962E+00,-0.20838E+00,-0.20709E+00,
- &-0.20575E+00,-0.20436E+00,-0.20293E+00,-0.20146E+00,-0.19994E+00,
- &-0.19838E+00,-0.19679E+00,-0.19515E+00,-0.19348E+00,-0.19177E+00,
- &-0.19003E+00,-0.18826E+00,-0.18645E+00,-0.18461E+00,-0.18274E+00,
- &-0.18084E+00,-0.17890E+00,-0.17694E+00,-0.17496E+00,-0.17294E+00,
- &-0.17090E+00,-0.16882E+00,-0.16673E+00,-0.16460E+00,-0.16246E+00,
- &-0.16028E+00,-0.15808E+00,-0.15586E+00,-0.15361E+00,-0.15134E+00,
- &-0.14905E+00,-0.14673E+00,-0.14439E+00,-0.14202E+00,-0.13963E+00,
- &-0.13722E+00,-0.13479E+00,-0.13234E+00,-0.12987E+00,-0.12737E+00,
- &-0.12485E+00,-0.12232E+00,-0.11976E+00,-0.11719E+00,-0.11460E+00,
- &-0.11199E+00,-0.10936E+00,-0.10671E+00,-0.10405E+00,-0.10137E+00/
-
- DATA (BNC09M(I),I=101,200)/
- &-0.98681E-01,-0.95974E-01,-0.93253E-01,-0.90519E-01,-0.87773E-01,
- &-0.85014E-01,-0.82245E-01,-0.79465E-01,-0.76675E-01,-0.73876E-01,
- &-0.71069E-01,-0.68253E-01,-0.65431E-01,-0.62602E-01,-0.59767E-01,
- &-0.56926E-01,-0.54081E-01,-0.51232E-01,-0.48379E-01,-0.45522E-01,
- &-0.42663E-01,-0.39802E-01,-0.36939E-01,-0.34075E-01,-0.31210E-01,
- &-0.28345E-01,-0.25479E-01,-0.22614E-01,-0.19749E-01,-0.16885E-01,
- &-0.14023E-01,-0.11162E-01,-0.83023E-02,-0.54449E-02,-0.25898E-02,
- & 0.26281E-03, 0.31128E-02, 0.59598E-02, 0.88039E-02, 0.11645E-01,
- & 0.14482E-01, 0.17316E-01, 0.20147E-01, 0.22973E-01, 0.25796E-01,
- & 0.28615E-01, 0.31429E-01, 0.34240E-01, 0.37046E-01, 0.39848E-01,
- & 0.42645E-01, 0.45438E-01, 0.48226E-01, 0.51010E-01, 0.53789E-01,
- & 0.56563E-01, 0.59333E-01, 0.62097E-01, 0.64857E-01, 0.67612E-01,
- & 0.70362E-01, 0.73107E-01, 0.75847E-01, 0.78581E-01, 0.81311E-01,
- & 0.84036E-01, 0.86755E-01, 0.89470E-01, 0.92179E-01, 0.94883E-01,
- & 0.97582E-01, 0.10028E+00, 0.10296E+00, 0.10565E+00, 0.10832E+00,
- & 0.11100E+00, 0.11367E+00, 0.11633E+00, 0.11898E+00, 0.12164E+00,
- & 0.12428E+00, 0.12692E+00, 0.12956E+00, 0.13219E+00, 0.13482E+00,
- & 0.13744E+00, 0.14005E+00, 0.14266E+00, 0.14526E+00, 0.14786E+00,
- & 0.15046E+00, 0.15304E+00, 0.15563E+00, 0.15821E+00, 0.16078E+00,
- & 0.16335E+00, 0.16591E+00, 0.16847E+00, 0.17102E+00, 0.17356E+00/
-
- DATA (BNC09M(I),I=201,300)/
- & 0.17611E+00, 0.17864E+00, 0.18117E+00, 0.18370E+00, 0.18622E+00,
- & 0.18874E+00, 0.19125E+00, 0.19375E+00, 0.19626E+00, 0.19875E+00,
- & 0.20124E+00, 0.20373E+00, 0.20621E+00, 0.20868E+00, 0.21115E+00,
- & 0.21362E+00, 0.21608E+00, 0.21854E+00, 0.22099E+00, 0.22343E+00,
- & 0.22588E+00, 0.22831E+00, 0.23074E+00, 0.23317E+00, 0.23559E+00,
- & 0.23801E+00, 0.24042E+00, 0.24283E+00, 0.24523E+00, 0.24763E+00,
- & 0.25002E+00, 0.25241E+00, 0.25479E+00, 0.25717E+00, 0.25955E+00,
- & 0.26192E+00, 0.26428E+00, 0.26664E+00, 0.26900E+00, 0.27135E+00,
- & 0.27370E+00, 0.27604E+00, 0.27838E+00, 0.28071E+00, 0.28304E+00,
- & 0.28536E+00, 0.28768E+00, 0.29000E+00, 0.29231E+00, 0.29462E+00,
- & 0.29692E+00, 0.29922E+00, 0.30151E+00, 0.30380E+00, 0.30609E+00,
- & 0.30837E+00, 0.31064E+00, 0.31291E+00, 0.31518E+00, 0.31745E+00,
- & 0.31971E+00, 0.32196E+00, 0.32421E+00, 0.32646E+00, 0.32870E+00,
- & 0.33094E+00, 0.33317E+00, 0.33540E+00, 0.33763E+00, 0.33985E+00,
- & 0.34207E+00, 0.34428E+00, 0.34649E+00, 0.34870E+00, 0.35090E+00,
- & 0.35310E+00, 0.35529E+00, 0.35748E+00, 0.35967E+00, 0.36185E+00,
- & 0.36403E+00, 0.36620E+00, 0.36837E+00, 0.37054E+00, 0.37270E+00,
- & 0.37486E+00, 0.37702E+00, 0.37917E+00, 0.38131E+00, 0.38346E+00,
- & 0.38560E+00, 0.38773E+00, 0.38987E+00, 0.39199E+00, 0.39412E+00,
- & 0.39624E+00, 0.39836E+00, 0.40047E+00, 0.40258E+00, 0.40469E+00/
-
- DATA (BNC09M(I),I=301,400)/
- & 0.40679E+00, 0.40889E+00, 0.41099E+00, 0.41308E+00, 0.41517E+00,
- & 0.41725E+00, 0.41933E+00, 0.42141E+00, 0.42349E+00, 0.42556E+00,
- & 0.42763E+00, 0.42969E+00, 0.43175E+00, 0.43381E+00, 0.43586E+00,
- & 0.43791E+00, 0.43996E+00, 0.44200E+00, 0.44404E+00, 0.44608E+00,
- & 0.44811E+00, 0.45014E+00, 0.45217E+00, 0.45419E+00, 0.45621E+00,
- & 0.45823E+00, 0.46024E+00, 0.46225E+00, 0.46426E+00, 0.46626E+00,
- & 0.46826E+00, 0.47026E+00, 0.47225E+00, 0.47424E+00, 0.47623E+00,
- & 0.47821E+00, 0.48020E+00, 0.48217E+00, 0.48415E+00, 0.48612E+00,
- & 0.48809E+00, 0.49005E+00, 0.49202E+00, 0.49397E+00, 0.49593E+00,
- & 0.49788E+00, 0.49983E+00, 0.50178E+00, 0.50372E+00, 0.50566E+00,
- & 0.50760E+00, 0.50954E+00, 0.51147E+00, 0.51340E+00, 0.51532E+00,
- & 0.51725E+00, 0.51917E+00, 0.52108E+00, 0.52300E+00, 0.52491E+00,
- & 0.52682E+00, 0.52872E+00, 0.53062E+00, 0.53252E+00, 0.53442E+00,
- & 0.53631E+00, 0.53820E+00, 0.54009E+00, 0.54198E+00, 0.54386E+00,
- & 0.54574E+00, 0.54761E+00, 0.54949E+00, 0.55136E+00, 0.55323E+00,
- & 0.55509E+00, 0.55696E+00, 0.55882E+00, 0.56067E+00, 0.56253E+00,
- & 0.56438E+00, 0.56623E+00, 0.56807E+00, 0.56992E+00, 0.57176E+00,
- & 0.57360E+00, 0.57543E+00, 0.57726E+00, 0.57909E+00, 0.58092E+00,
- & 0.58275E+00, 0.58457E+00, 0.58639E+00, 0.58821E+00, 0.59002E+00,
- & 0.59183E+00, 0.59364E+00, 0.59545E+00, 0.59725E+00, 0.59905E+00/
-
- DATA (BNC09M(I),I=401,500)/
- & 0.60085E+00, 0.60265E+00, 0.60444E+00, 0.60623E+00, 0.60802E+00,
- & 0.60981E+00, 0.61159E+00, 0.61337E+00, 0.61515E+00, 0.61693E+00,
- & 0.61870E+00, 0.62047E+00, 0.62224E+00, 0.62401E+00, 0.62577E+00,
- & 0.62753E+00, 0.62929E+00, 0.63105E+00, 0.63280E+00, 0.63455E+00,
- & 0.63630E+00, 0.63805E+00, 0.63980E+00, 0.64154E+00, 0.64328E+00,
- & 0.64501E+00, 0.64675E+00, 0.64848E+00, 0.65021E+00, 0.65194E+00,
- & 0.65367E+00, 0.65539E+00, 0.65711E+00, 0.65883E+00, 0.66055E+00,
- & 0.66226E+00, 0.66397E+00, 0.66568E+00, 0.66739E+00, 0.66909E+00,
- & 0.67080E+00, 0.67250E+00, 0.67419E+00, 0.67589E+00, 0.67758E+00,
- & 0.67928E+00, 0.68096E+00, 0.68265E+00, 0.68434E+00, 0.68602E+00,
- & 0.68770E+00, 0.68938E+00, 0.69105E+00, 0.69273E+00, 0.69440E+00,
- & 0.69607E+00, 0.69774E+00, 0.69940E+00, 0.70106E+00, 0.70273E+00,
- & 0.70438E+00, 0.70604E+00, 0.70770E+00, 0.70935E+00, 0.71100E+00,
- & 0.71265E+00, 0.71429E+00, 0.71594E+00, 0.71758E+00, 0.71922E+00,
- & 0.72086E+00, 0.72249E+00, 0.72413E+00, 0.72576E+00, 0.72739E+00,
- & 0.72901E+00, 0.73064E+00, 0.73226E+00, 0.73388E+00, 0.73550E+00,
- & 0.73712E+00, 0.73874E+00, 0.74035E+00, 0.74196E+00, 0.74357E+00,
- & 0.74518E+00, 0.74678E+00, 0.74839E+00, 0.74999E+00, 0.75159E+00,
- & 0.75318E+00, 0.75478E+00, 0.75637E+00, 0.75796E+00, 0.75955E+00,
- & 0.76114E+00, 0.76273E+00, 0.76431E+00, 0.76589E+00, 0.76747E+00/
-
- DATA (BNC09M(I),I=501,600)/
- & 0.76905E+00, 0.77063E+00, 0.77220E+00, 0.77377E+00, 0.77534E+00,
- & 0.77691E+00, 0.77848E+00, 0.78004E+00, 0.78161E+00, 0.78317E+00,
- & 0.78473E+00, 0.78629E+00, 0.78784E+00, 0.78939E+00, 0.79095E+00,
- & 0.79250E+00, 0.79404E+00, 0.79559E+00, 0.79714E+00, 0.79868E+00,
- & 0.80022E+00, 0.80176E+00, 0.80330E+00, 0.80483E+00, 0.80636E+00,
- & 0.80790E+00, 0.80943E+00, 0.81096E+00, 0.81248E+00, 0.81401E+00,
- & 0.81553E+00, 0.81705E+00, 0.81857E+00, 0.82009E+00, 0.82160E+00,
- & 0.82312E+00, 0.82463E+00, 0.82614E+00, 0.82765E+00, 0.82916E+00,
- & 0.83066E+00, 0.83217E+00, 0.83367E+00, 0.83517E+00, 0.83667E+00,
- & 0.83817E+00, 0.83966E+00, 0.84116E+00, 0.84265E+00, 0.84414E+00,
- & 0.84563E+00, 0.84711E+00, 0.84860E+00, 0.85008E+00, 0.85157E+00,
- & 0.85305E+00, 0.85452E+00, 0.85600E+00, 0.85748E+00, 0.85895E+00,
- & 0.86042E+00, 0.86189E+00, 0.86336E+00, 0.86483E+00, 0.86629E+00,
- & 0.86776E+00, 0.86922E+00, 0.87068E+00, 0.87214E+00, 0.87360E+00,
- & 0.87506E+00, 0.87651E+00, 0.87796E+00, 0.87941E+00, 0.88086E+00,
- & 0.88231E+00, 0.88376E+00, 0.88520E+00, 0.88665E+00, 0.88809E+00,
- & 0.88953E+00, 0.89097E+00, 0.89240E+00, 0.89384E+00, 0.89527E+00,
- & 0.89671E+00, 0.89814E+00, 0.89957E+00, 0.90099E+00, 0.90242E+00,
- & 0.90385E+00, 0.90527E+00, 0.90669E+00, 0.90811E+00, 0.90953E+00,
- & 0.91095E+00, 0.91236E+00, 0.91378E+00, 0.91519E+00, 0.91660E+00/
-
- DATA (BNC09M(I),I=601,700)/
- & 0.93176E+00, 0.94563E+00, 0.95937E+00, 0.97297E+00, 0.98643E+00,
- & 0.99976E+00, 0.10130E+01, 0.10260E+01, 0.10390E+01, 0.10518E+01,
- & 0.10645E+01, 0.10771E+01, 0.10896E+01, 0.11020E+01, 0.11142E+01,
- & 0.11264E+01, 0.11384E+01, 0.11504E+01, 0.11622E+01, 0.11740E+01,
- & 0.11856E+01, 0.11972E+01, 0.12086E+01, 0.12200E+01, 0.12313E+01,
- & 0.12425E+01, 0.12536E+01, 0.12646E+01, 0.12755E+01, 0.12864E+01,
- & 0.12971E+01, 0.13078E+01, 0.13184E+01, 0.13290E+01, 0.13394E+01,
- & 0.13498E+01, 0.13601E+01, 0.13704E+01, 0.13805E+01, 0.13906E+01,
- & 0.14006E+01, 0.14106E+01, 0.14205E+01, 0.14303E+01, 0.14401E+01,
- & 0.14498E+01, 0.14594E+01, 0.14690E+01, 0.14785E+01, 0.14880E+01,
- & 0.14974E+01, 0.15067E+01, 0.15160E+01, 0.15252E+01, 0.15344E+01,
- & 0.15435E+01, 0.15526E+01, 0.15616E+01, 0.15706E+01, 0.15795E+01,
- & 0.15883E+01, 0.15971E+01, 0.16059E+01, 0.16146E+01, 0.16233E+01,
- & 0.16319E+01, 0.16404E+01, 0.16489E+01, 0.16574E+01, 0.16658E+01,
- & 0.16742E+01, 0.16825E+01, 0.16908E+01, 0.16991E+01, 0.17073E+01,
- & 0.17155E+01, 0.17236E+01, 0.17317E+01, 0.17397E+01, 0.17477E+01,
- & 0.17557E+01, 0.17636E+01, 0.17715E+01, 0.17793E+01, 0.17871E+01,
- & 0.17949E+01, 0.18026E+01, 0.18103E+01, 0.18180E+01, 0.18256E+01,
- & 0.18332E+01, 0.18408E+01, 0.18483E+01, 0.18558E+01, 0.18632E+01,
- & 0.18707E+01, 0.18780E+01, 0.18854E+01, 0.18927E+01, 0.19000E+01/
-
- DATA (BNC09M(I),I=701,741)/
- & 0.19073E+01, 0.19145E+01, 0.19217E+01, 0.19289E+01, 0.19360E+01,
- & 0.19431E+01, 0.19502E+01, 0.19572E+01, 0.19643E+01, 0.19713E+01,
- & 0.19782E+01, 0.19852E+01, 0.19921E+01, 0.19989E+01, 0.20058E+01,
- & 0.20126E+01, 0.20194E+01, 0.20262E+01, 0.20329E+01, 0.20397E+01,
- & 0.20464E+01, 0.20530E+01, 0.20597E+01, 0.20663E+01, 0.20729E+01,
- & 0.20794E+01, 0.20860E+01, 0.20925E+01, 0.20990E+01, 0.21055E+01,
- & 0.21119E+01, 0.21184E+01, 0.21248E+01, 0.21311E+01, 0.21375E+01,
- & 0.21438E+01, 0.21502E+01, 0.21564E+01, 0.21627E+01, 0.21690E+01,
- & 0.21752E+01
- & /
-C
-C *** (H,NO3)
-C
- DATA (BNC10M(I),I=1,100)/
- &-0.44117E-01,-0.91788E-01,-0.11327E+00,-0.12721E+00,-0.13727E+00,
- &-0.14491E+00,-0.15090E+00,-0.15568E+00,-0.15952E+00,-0.16263E+00,
- &-0.16514E+00,-0.16716E+00,-0.16876E+00,-0.17001E+00,-0.17095E+00,
- &-0.17163E+00,-0.17207E+00,-0.17231E+00,-0.17237E+00,-0.17227E+00,
- &-0.17202E+00,-0.17164E+00,-0.17114E+00,-0.17054E+00,-0.16983E+00,
- &-0.16904E+00,-0.16817E+00,-0.16723E+00,-0.16622E+00,-0.16515E+00,
- &-0.16402E+00,-0.16284E+00,-0.16161E+00,-0.16034E+00,-0.15903E+00,
- &-0.15768E+00,-0.15630E+00,-0.15489E+00,-0.15346E+00,-0.15199E+00,
- &-0.15051E+00,-0.14900E+00,-0.14747E+00,-0.14592E+00,-0.14436E+00,
- &-0.14278E+00,-0.14119E+00,-0.13959E+00,-0.13797E+00,-0.13635E+00,
- &-0.13471E+00,-0.13306E+00,-0.13141E+00,-0.12974E+00,-0.12807E+00,
- &-0.12639E+00,-0.12471E+00,-0.12301E+00,-0.12131E+00,-0.11961E+00,
- &-0.11789E+00,-0.11617E+00,-0.11445E+00,-0.11271E+00,-0.11097E+00,
- &-0.10922E+00,-0.10746E+00,-0.10570E+00,-0.10392E+00,-0.10214E+00,
- &-0.10035E+00,-0.98551E-01,-0.96741E-01,-0.94920E-01,-0.93090E-01,
- &-0.91248E-01,-0.89396E-01,-0.87532E-01,-0.85656E-01,-0.83769E-01,
- &-0.81869E-01,-0.79957E-01,-0.78032E-01,-0.76093E-01,-0.74142E-01,
- &-0.72178E-01,-0.70201E-01,-0.68210E-01,-0.66206E-01,-0.64188E-01,
- &-0.62157E-01,-0.60114E-01,-0.58057E-01,-0.55987E-01,-0.53905E-01,
- &-0.51810E-01,-0.49703E-01,-0.47584E-01,-0.45454E-01,-0.43312E-01/
-
- DATA (BNC10M(I),I=101,200)/
- &-0.41159E-01,-0.38996E-01,-0.36823E-01,-0.34640E-01,-0.32448E-01,
- &-0.30246E-01,-0.28037E-01,-0.25819E-01,-0.23593E-01,-0.21360E-01,
- &-0.19121E-01,-0.16875E-01,-0.14623E-01,-0.12366E-01,-0.10103E-01,
- &-0.78360E-02,-0.55644E-02,-0.32889E-02,-0.10096E-02, 0.12729E-02,
- & 0.35583E-02, 0.58464E-02, 0.81368E-02, 0.10429E-01, 0.12723E-01,
- & 0.15019E-01, 0.17316E-01, 0.19614E-01, 0.21913E-01, 0.24212E-01,
- & 0.26512E-01, 0.28812E-01, 0.31112E-01, 0.33412E-01, 0.35712E-01,
- & 0.38011E-01, 0.40310E-01, 0.42608E-01, 0.44905E-01, 0.47202E-01,
- & 0.49497E-01, 0.51792E-01, 0.54085E-01, 0.56377E-01, 0.58668E-01,
- & 0.60958E-01, 0.63246E-01, 0.65533E-01, 0.67818E-01, 0.70101E-01,
- & 0.72383E-01, 0.74663E-01, 0.76942E-01, 0.79218E-01, 0.81493E-01,
- & 0.83766E-01, 0.86037E-01, 0.88307E-01, 0.90574E-01, 0.92839E-01,
- & 0.95102E-01, 0.97364E-01, 0.99623E-01, 0.10188E+00, 0.10413E+00,
- & 0.10639E+00, 0.10864E+00, 0.11089E+00, 0.11313E+00, 0.11538E+00,
- & 0.11762E+00, 0.11986E+00, 0.12210E+00, 0.12433E+00, 0.12656E+00,
- & 0.12879E+00, 0.13102E+00, 0.13325E+00, 0.13547E+00, 0.13769E+00,
- & 0.13991E+00, 0.14213E+00, 0.14434E+00, 0.14655E+00, 0.14876E+00,
- & 0.15096E+00, 0.15317E+00, 0.15537E+00, 0.15757E+00, 0.15976E+00,
- & 0.16196E+00, 0.16415E+00, 0.16634E+00, 0.16852E+00, 0.17071E+00,
- & 0.17289E+00, 0.17506E+00, 0.17724E+00, 0.17941E+00, 0.18158E+00/
-
- DATA (BNC10M(I),I=201,300)/
- & 0.18375E+00, 0.18591E+00, 0.18808E+00, 0.19024E+00, 0.19239E+00,
- & 0.19455E+00, 0.19670E+00, 0.19885E+00, 0.20099E+00, 0.20314E+00,
- & 0.20528E+00, 0.20742E+00, 0.20955E+00, 0.21168E+00, 0.21381E+00,
- & 0.21594E+00, 0.21807E+00, 0.22019E+00, 0.22231E+00, 0.22442E+00,
- & 0.22654E+00, 0.22865E+00, 0.23076E+00, 0.23286E+00, 0.23497E+00,
- & 0.23707E+00, 0.23916E+00, 0.24126E+00, 0.24335E+00, 0.24544E+00,
- & 0.24753E+00, 0.24961E+00, 0.25169E+00, 0.25377E+00, 0.25584E+00,
- & 0.25792E+00, 0.25999E+00, 0.26205E+00, 0.26412E+00, 0.26618E+00,
- & 0.26824E+00, 0.27029E+00, 0.27235E+00, 0.27440E+00, 0.27645E+00,
- & 0.27849E+00, 0.28054E+00, 0.28257E+00, 0.28461E+00, 0.28665E+00,
- & 0.28868E+00, 0.29071E+00, 0.29273E+00, 0.29476E+00, 0.29678E+00,
- & 0.29880E+00, 0.30081E+00, 0.30282E+00, 0.30483E+00, 0.30684E+00,
- & 0.30884E+00, 0.31085E+00, 0.31285E+00, 0.31484E+00, 0.31684E+00,
- & 0.31883E+00, 0.32081E+00, 0.32280E+00, 0.32478E+00, 0.32676E+00,
- & 0.32874E+00, 0.33072E+00, 0.33269E+00, 0.33466E+00, 0.33662E+00,
- & 0.33859E+00, 0.34055E+00, 0.34251E+00, 0.34446E+00, 0.34642E+00,
- & 0.34837E+00, 0.35032E+00, 0.35226E+00, 0.35420E+00, 0.35615E+00,
- & 0.35808E+00, 0.36002E+00, 0.36195E+00, 0.36388E+00, 0.36581E+00,
- & 0.36773E+00, 0.36965E+00, 0.37157E+00, 0.37349E+00, 0.37540E+00,
- & 0.37731E+00, 0.37922E+00, 0.38113E+00, 0.38303E+00, 0.38494E+00/
-
- DATA (BNC10M(I),I=301,400)/
- & 0.38683E+00, 0.38873E+00, 0.39062E+00, 0.39251E+00, 0.39440E+00,
- & 0.39629E+00, 0.39817E+00, 0.40005E+00, 0.40193E+00, 0.40381E+00,
- & 0.40568E+00, 0.40755E+00, 0.40942E+00, 0.41128E+00, 0.41315E+00,
- & 0.41501E+00, 0.41687E+00, 0.41872E+00, 0.42057E+00, 0.42242E+00,
- & 0.42427E+00, 0.42612E+00, 0.42796E+00, 0.42980E+00, 0.43164E+00,
- & 0.43348E+00, 0.43531E+00, 0.43714E+00, 0.43897E+00, 0.44079E+00,
- & 0.44262E+00, 0.44444E+00, 0.44626E+00, 0.44807E+00, 0.44989E+00,
- & 0.45170E+00, 0.45351E+00, 0.45532E+00, 0.45712E+00, 0.45892E+00,
- & 0.46072E+00, 0.46252E+00, 0.46431E+00, 0.46611E+00, 0.46790E+00,
- & 0.46968E+00, 0.47147E+00, 0.47325E+00, 0.47503E+00, 0.47681E+00,
- & 0.47859E+00, 0.48036E+00, 0.48213E+00, 0.48390E+00, 0.48567E+00,
- & 0.48743E+00, 0.48919E+00, 0.49095E+00, 0.49271E+00, 0.49446E+00,
- & 0.49622E+00, 0.49797E+00, 0.49972E+00, 0.50146E+00, 0.50321E+00,
- & 0.50495E+00, 0.50669E+00, 0.50842E+00, 0.51016E+00, 0.51189E+00,
- & 0.51362E+00, 0.51535E+00, 0.51707E+00, 0.51880E+00, 0.52052E+00,
- & 0.52224E+00, 0.52395E+00, 0.52567E+00, 0.52738E+00, 0.52909E+00,
- & 0.53080E+00, 0.53251E+00, 0.53421E+00, 0.53591E+00, 0.53761E+00,
- & 0.53931E+00, 0.54100E+00, 0.54269E+00, 0.54439E+00, 0.54607E+00,
- & 0.54776E+00, 0.54944E+00, 0.55113E+00, 0.55281E+00, 0.55448E+00,
- & 0.55616E+00, 0.55783E+00, 0.55951E+00, 0.56118E+00, 0.56284E+00/
-
- DATA (BNC10M(I),I=401,500)/
- & 0.56451E+00, 0.56617E+00, 0.56783E+00, 0.56949E+00, 0.57115E+00,
- & 0.57280E+00, 0.57446E+00, 0.57611E+00, 0.57775E+00, 0.57940E+00,
- & 0.58105E+00, 0.58269E+00, 0.58433E+00, 0.58597E+00, 0.58760E+00,
- & 0.58924E+00, 0.59087E+00, 0.59250E+00, 0.59413E+00, 0.59576E+00,
- & 0.59738E+00, 0.59900E+00, 0.60062E+00, 0.60224E+00, 0.60386E+00,
- & 0.60547E+00, 0.60708E+00, 0.60869E+00, 0.61030E+00, 0.61191E+00,
- & 0.61351E+00, 0.61512E+00, 0.61672E+00, 0.61832E+00, 0.61991E+00,
- & 0.62151E+00, 0.62310E+00, 0.62469E+00, 0.62628E+00, 0.62787E+00,
- & 0.62945E+00, 0.63104E+00, 0.63262E+00, 0.63420E+00, 0.63577E+00,
- & 0.63735E+00, 0.63892E+00, 0.64050E+00, 0.64207E+00, 0.64363E+00,
- & 0.64520E+00, 0.64676E+00, 0.64833E+00, 0.64989E+00, 0.65145E+00,
- & 0.65300E+00, 0.65456E+00, 0.65611E+00, 0.65766E+00, 0.65921E+00,
- & 0.66076E+00, 0.66231E+00, 0.66385E+00, 0.66539E+00, 0.66693E+00,
- & 0.66847E+00, 0.67001E+00, 0.67154E+00, 0.67308E+00, 0.67461E+00,
- & 0.67614E+00, 0.67767E+00, 0.67919E+00, 0.68072E+00, 0.68224E+00,
- & 0.68376E+00, 0.68528E+00, 0.68680E+00, 0.68831E+00, 0.68983E+00,
- & 0.69134E+00, 0.69285E+00, 0.69436E+00, 0.69587E+00, 0.69737E+00,
- & 0.69887E+00, 0.70038E+00, 0.70188E+00, 0.70337E+00, 0.70487E+00,
- & 0.70636E+00, 0.70786E+00, 0.70935E+00, 0.71084E+00, 0.71233E+00,
- & 0.71381E+00, 0.71530E+00, 0.71678E+00, 0.71826E+00, 0.71974E+00/
-
- DATA (BNC10M(I),I=501,600)/
- & 0.72122E+00, 0.72270E+00, 0.72417E+00, 0.72564E+00, 0.72712E+00,
- & 0.72859E+00, 0.73005E+00, 0.73152E+00, 0.73298E+00, 0.73445E+00,
- & 0.73591E+00, 0.73737E+00, 0.73883E+00, 0.74028E+00, 0.74174E+00,
- & 0.74319E+00, 0.74464E+00, 0.74609E+00, 0.74754E+00, 0.74899E+00,
- & 0.75043E+00, 0.75188E+00, 0.75332E+00, 0.75476E+00, 0.75620E+00,
- & 0.75764E+00, 0.75907E+00, 0.76051E+00, 0.76194E+00, 0.76337E+00,
- & 0.76480E+00, 0.76623E+00, 0.76766E+00, 0.76908E+00, 0.77050E+00,
- & 0.77193E+00, 0.77335E+00, 0.77476E+00, 0.77618E+00, 0.77760E+00,
- & 0.77901E+00, 0.78042E+00, 0.78183E+00, 0.78324E+00, 0.78465E+00,
- & 0.78606E+00, 0.78746E+00, 0.78887E+00, 0.79027E+00, 0.79167E+00,
- & 0.79307E+00, 0.79447E+00, 0.79586E+00, 0.79726E+00, 0.79865E+00,
- & 0.80004E+00, 0.80143E+00, 0.80282E+00, 0.80421E+00, 0.80559E+00,
- & 0.80698E+00, 0.80836E+00, 0.80974E+00, 0.81112E+00, 0.81250E+00,
- & 0.81388E+00, 0.81525E+00, 0.81663E+00, 0.81800E+00, 0.81937E+00,
- & 0.82074E+00, 0.82211E+00, 0.82348E+00, 0.82484E+00, 0.82621E+00,
- & 0.82757E+00, 0.82893E+00, 0.83029E+00, 0.83165E+00, 0.83301E+00,
- & 0.83436E+00, 0.83572E+00, 0.83707E+00, 0.83842E+00, 0.83977E+00,
- & 0.84112E+00, 0.84247E+00, 0.84381E+00, 0.84516E+00, 0.84650E+00,
- & 0.84784E+00, 0.84918E+00, 0.85052E+00, 0.85186E+00, 0.85320E+00,
- & 0.85453E+00, 0.85586E+00, 0.85720E+00, 0.85853E+00, 0.85986E+00/
-
- DATA (BNC10M(I),I=601,700)/
- & 0.87414E+00, 0.88722E+00, 0.90017E+00, 0.91300E+00, 0.92570E+00,
- & 0.93828E+00, 0.95075E+00, 0.96310E+00, 0.97533E+00, 0.98746E+00,
- & 0.99947E+00, 0.10114E+01, 0.10232E+01, 0.10349E+01, 0.10465E+01,
- & 0.10580E+01, 0.10694E+01, 0.10807E+01, 0.10919E+01, 0.11030E+01,
- & 0.11141E+01, 0.11250E+01, 0.11358E+01, 0.11466E+01, 0.11573E+01,
- & 0.11679E+01, 0.11784E+01, 0.11889E+01, 0.11992E+01, 0.12095E+01,
- & 0.12197E+01, 0.12299E+01, 0.12399E+01, 0.12499E+01, 0.12598E+01,
- & 0.12697E+01, 0.12795E+01, 0.12892E+01, 0.12988E+01, 0.13084E+01,
- & 0.13179E+01, 0.13274E+01, 0.13367E+01, 0.13461E+01, 0.13553E+01,
- & 0.13645E+01, 0.13737E+01, 0.13828E+01, 0.13918E+01, 0.14008E+01,
- & 0.14097E+01, 0.14186E+01, 0.14274E+01, 0.14362E+01, 0.14449E+01,
- & 0.14535E+01, 0.14621E+01, 0.14707E+01, 0.14792E+01, 0.14876E+01,
- & 0.14960E+01, 0.15044E+01, 0.15127E+01, 0.15210E+01, 0.15292E+01,
- & 0.15374E+01, 0.15455E+01, 0.15536E+01, 0.15616E+01, 0.15696E+01,
- & 0.15776E+01, 0.15855E+01, 0.15934E+01, 0.16012E+01, 0.16090E+01,
- & 0.16168E+01, 0.16245E+01, 0.16322E+01, 0.16398E+01, 0.16474E+01,
- & 0.16550E+01, 0.16625E+01, 0.16700E+01, 0.16774E+01, 0.16849E+01,
- & 0.16922E+01, 0.16996E+01, 0.17069E+01, 0.17142E+01, 0.17214E+01,
- & 0.17286E+01, 0.17358E+01, 0.17430E+01, 0.17501E+01, 0.17572E+01,
- & 0.17642E+01, 0.17712E+01, 0.17782E+01, 0.17852E+01, 0.17921E+01/
-
- DATA (BNC10M(I),I=701,741)/
- & 0.17990E+01, 0.18059E+01, 0.18127E+01, 0.18195E+01, 0.18263E+01,
- & 0.18331E+01, 0.18398E+01, 0.18465E+01, 0.18532E+01, 0.18598E+01,
- & 0.18664E+01, 0.18730E+01, 0.18796E+01, 0.18861E+01, 0.18926E+01,
- & 0.18991E+01, 0.19056E+01, 0.19120E+01, 0.19184E+01, 0.19248E+01,
- & 0.19312E+01, 0.19375E+01, 0.19439E+01, 0.19502E+01, 0.19564E+01,
- & 0.19627E+01, 0.19689E+01, 0.19751E+01, 0.19813E+01, 0.19874E+01,
- & 0.19936E+01, 0.19997E+01, 0.20058E+01, 0.20118E+01, 0.20179E+01,
- & 0.20239E+01, 0.20299E+01, 0.20359E+01, 0.20419E+01, 0.20478E+01,
- & 0.20537E+01
- & /
-C
-C *** (H,Cl)
-C
- DATA (BNC11M(I),I=1,100)/
- &-0.43207E-01,-0.87312E-01,-0.10580E+00,-0.11699E+00,-0.12443E+00,
- &-0.12956E+00,-0.13308E+00,-0.13541E+00,-0.13684E+00,-0.13754E+00,
- &-0.13763E+00,-0.13723E+00,-0.13639E+00,-0.13519E+00,-0.13367E+00,
- &-0.13185E+00,-0.12978E+00,-0.12749E+00,-0.12498E+00,-0.12229E+00,
- &-0.11943E+00,-0.11640E+00,-0.11324E+00,-0.10994E+00,-0.10651E+00,
- &-0.10298E+00,-0.99331E-01,-0.95587E-01,-0.91752E-01,-0.87830E-01,
- &-0.83828E-01,-0.79751E-01,-0.75605E-01,-0.71393E-01,-0.67121E-01,
- &-0.62791E-01,-0.58408E-01,-0.53976E-01,-0.49497E-01,-0.44974E-01,
- &-0.40412E-01,-0.35811E-01,-0.31175E-01,-0.26506E-01,-0.21806E-01,
- &-0.17077E-01,-0.12322E-01,-0.75410E-02,-0.27366E-02, 0.20900E-02,
- & 0.69376E-02, 0.11805E-01, 0.16691E-01, 0.21595E-01, 0.26516E-01,
- & 0.31453E-01, 0.36406E-01, 0.41374E-01, 0.46358E-01, 0.51356E-01,
- & 0.56370E-01, 0.61398E-01, 0.66441E-01, 0.71499E-01, 0.76572E-01,
- & 0.81661E-01, 0.86766E-01, 0.91888E-01, 0.97027E-01, 0.10218E+00,
- & 0.10736E+00, 0.11255E+00, 0.11777E+00, 0.12300E+00, 0.12825E+00,
- & 0.13353E+00, 0.13883E+00, 0.14415E+00, 0.14950E+00, 0.15487E+00,
- & 0.16026E+00, 0.16568E+00, 0.17113E+00, 0.17660E+00, 0.18210E+00,
- & 0.18763E+00, 0.19318E+00, 0.19876E+00, 0.20437E+00, 0.21000E+00,
- & 0.21567E+00, 0.22136E+00, 0.22707E+00, 0.23281E+00, 0.23858E+00,
- & 0.24438E+00, 0.25020E+00, 0.25604E+00, 0.26190E+00, 0.26779E+00/
-
- DATA (BNC11M(I),I=101,200)/
- & 0.27370E+00, 0.27964E+00, 0.28559E+00, 0.29156E+00, 0.29755E+00,
- & 0.30356E+00, 0.30958E+00, 0.31562E+00, 0.32167E+00, 0.32774E+00,
- & 0.33382E+00, 0.33991E+00, 0.34601E+00, 0.35211E+00, 0.35823E+00,
- & 0.36435E+00, 0.37048E+00, 0.37662E+00, 0.38276E+00, 0.38890E+00,
- & 0.39505E+00, 0.40120E+00, 0.40734E+00, 0.41349E+00, 0.41964E+00,
- & 0.42579E+00, 0.43194E+00, 0.43809E+00, 0.44423E+00, 0.45037E+00,
- & 0.45651E+00, 0.46264E+00, 0.46877E+00, 0.47489E+00, 0.48101E+00,
- & 0.48712E+00, 0.49323E+00, 0.49933E+00, 0.50543E+00, 0.51151E+00,
- & 0.51759E+00, 0.52367E+00, 0.52973E+00, 0.53579E+00, 0.54185E+00,
- & 0.54789E+00, 0.55392E+00, 0.55995E+00, 0.56597E+00, 0.57198E+00,
- & 0.57798E+00, 0.58398E+00, 0.58996E+00, 0.59594E+00, 0.60190E+00,
- & 0.60786E+00, 0.61381E+00, 0.61975E+00, 0.62568E+00, 0.63160E+00,
- & 0.63751E+00, 0.64341E+00, 0.64930E+00, 0.65519E+00, 0.66106E+00,
- & 0.66692E+00, 0.67277E+00, 0.67862E+00, 0.68445E+00, 0.69028E+00,
- & 0.69609E+00, 0.70189E+00, 0.70769E+00, 0.71347E+00, 0.71925E+00,
- & 0.72501E+00, 0.73076E+00, 0.73651E+00, 0.74224E+00, 0.74796E+00,
- & 0.75368E+00, 0.75938E+00, 0.76507E+00, 0.77076E+00, 0.77643E+00,
- & 0.78209E+00, 0.78774E+00, 0.79339E+00, 0.79902E+00, 0.80464E+00,
- & 0.81025E+00, 0.81585E+00, 0.82144E+00, 0.82702E+00, 0.83259E+00,
- & 0.83815E+00, 0.84370E+00, 0.84924E+00, 0.85477E+00, 0.86029E+00/
-
- DATA (BNC11M(I),I=201,300)/
- & 0.86580E+00, 0.87129E+00, 0.87678E+00, 0.88226E+00, 0.88773E+00,
- & 0.89318E+00, 0.89863E+00, 0.90407E+00, 0.90949E+00, 0.91491E+00,
- & 0.92032E+00, 0.92571E+00, 0.93110E+00, 0.93647E+00, 0.94184E+00,
- & 0.94720E+00, 0.95254E+00, 0.95788E+00, 0.96320E+00, 0.96852E+00,
- & 0.97382E+00, 0.97912E+00, 0.98440E+00, 0.98968E+00, 0.99494E+00,
- & 0.10002E+01, 0.10054E+01, 0.10107E+01, 0.10159E+01, 0.10211E+01,
- & 0.10263E+01, 0.10315E+01, 0.10367E+01, 0.10419E+01, 0.10470E+01,
- & 0.10522E+01, 0.10574E+01, 0.10625E+01, 0.10676E+01, 0.10727E+01,
- & 0.10778E+01, 0.10829E+01, 0.10880E+01, 0.10931E+01, 0.10982E+01,
- & 0.11032E+01, 0.11083E+01, 0.11133E+01, 0.11184E+01, 0.11234E+01,
- & 0.11284E+01, 0.11334E+01, 0.11384E+01, 0.11434E+01, 0.11484E+01,
- & 0.11533E+01, 0.11583E+01, 0.11632E+01, 0.11682E+01, 0.11731E+01,
- & 0.11780E+01, 0.11829E+01, 0.11878E+01, 0.11927E+01, 0.11976E+01,
- & 0.12025E+01, 0.12074E+01, 0.12122E+01, 0.12171E+01, 0.12219E+01,
- & 0.12267E+01, 0.12315E+01, 0.12364E+01, 0.12412E+01, 0.12460E+01,
- & 0.12507E+01, 0.12555E+01, 0.12603E+01, 0.12650E+01, 0.12698E+01,
- & 0.12745E+01, 0.12793E+01, 0.12840E+01, 0.12887E+01, 0.12934E+01,
- & 0.12981E+01, 0.13028E+01, 0.13075E+01, 0.13122E+01, 0.13168E+01,
- & 0.13215E+01, 0.13261E+01, 0.13308E+01, 0.13354E+01, 0.13400E+01,
- & 0.13447E+01, 0.13493E+01, 0.13539E+01, 0.13585E+01, 0.13630E+01/
-
- DATA (BNC11M(I),I=301,400)/
- & 0.13676E+01, 0.13722E+01, 0.13767E+01, 0.13813E+01, 0.13858E+01,
- & 0.13904E+01, 0.13949E+01, 0.13994E+01, 0.14039E+01, 0.14084E+01,
- & 0.14129E+01, 0.14174E+01, 0.14219E+01, 0.14264E+01, 0.14308E+01,
- & 0.14353E+01, 0.14397E+01, 0.14442E+01, 0.14486E+01, 0.14530E+01,
- & 0.14574E+01, 0.14618E+01, 0.14662E+01, 0.14706E+01, 0.14750E+01,
- & 0.14794E+01, 0.14838E+01, 0.14881E+01, 0.14925E+01, 0.14968E+01,
- & 0.15012E+01, 0.15055E+01, 0.15099E+01, 0.15142E+01, 0.15185E+01,
- & 0.15228E+01, 0.15271E+01, 0.15314E+01, 0.15357E+01, 0.15399E+01,
- & 0.15442E+01, 0.15485E+01, 0.15527E+01, 0.15570E+01, 0.15612E+01,
- & 0.15654E+01, 0.15697E+01, 0.15739E+01, 0.15781E+01, 0.15823E+01,
- & 0.15865E+01, 0.15907E+01, 0.15949E+01, 0.15991E+01, 0.16032E+01,
- & 0.16074E+01, 0.16115E+01, 0.16157E+01, 0.16198E+01, 0.16240E+01,
- & 0.16281E+01, 0.16322E+01, 0.16363E+01, 0.16405E+01, 0.16446E+01,
- & 0.16487E+01, 0.16527E+01, 0.16568E+01, 0.16609E+01, 0.16650E+01,
- & 0.16690E+01, 0.16731E+01, 0.16771E+01, 0.16812E+01, 0.16852E+01,
- & 0.16893E+01, 0.16933E+01, 0.16973E+01, 0.17013E+01, 0.17053E+01,
- & 0.17093E+01, 0.17133E+01, 0.17173E+01, 0.17213E+01, 0.17252E+01,
- & 0.17292E+01, 0.17332E+01, 0.17371E+01, 0.17411E+01, 0.17450E+01,
- & 0.17490E+01, 0.17529E+01, 0.17568E+01, 0.17607E+01, 0.17646E+01,
- & 0.17685E+01, 0.17724E+01, 0.17763E+01, 0.17802E+01, 0.17841E+01/
-
- DATA (BNC11M(I),I=401,500)/
- & 0.17880E+01, 0.17919E+01, 0.17957E+01, 0.17996E+01, 0.18034E+01,
- & 0.18073E+01, 0.18111E+01, 0.18150E+01, 0.18188E+01, 0.18226E+01,
- & 0.18264E+01, 0.18302E+01, 0.18340E+01, 0.18378E+01, 0.18416E+01,
- & 0.18454E+01, 0.18492E+01, 0.18530E+01, 0.18568E+01, 0.18605E+01,
- & 0.18643E+01, 0.18680E+01, 0.18718E+01, 0.18755E+01, 0.18793E+01,
- & 0.18830E+01, 0.18867E+01, 0.18904E+01, 0.18942E+01, 0.18979E+01,
- & 0.19016E+01, 0.19053E+01, 0.19090E+01, 0.19127E+01, 0.19163E+01,
- & 0.19200E+01, 0.19237E+01, 0.19274E+01, 0.19310E+01, 0.19347E+01,
- & 0.19383E+01, 0.19420E+01, 0.19456E+01, 0.19493E+01, 0.19529E+01,
- & 0.19565E+01, 0.19601E+01, 0.19637E+01, 0.19674E+01, 0.19710E+01,
- & 0.19746E+01, 0.19782E+01, 0.19817E+01, 0.19853E+01, 0.19889E+01,
- & 0.19925E+01, 0.19960E+01, 0.19996E+01, 0.20032E+01, 0.20067E+01,
- & 0.20103E+01, 0.20138E+01, 0.20174E+01, 0.20209E+01, 0.20244E+01,
- & 0.20279E+01, 0.20315E+01, 0.20350E+01, 0.20385E+01, 0.20420E+01,
- & 0.20455E+01, 0.20490E+01, 0.20525E+01, 0.20560E+01, 0.20594E+01,
- & 0.20629E+01, 0.20664E+01, 0.20698E+01, 0.20733E+01, 0.20768E+01,
- & 0.20802E+01, 0.20837E+01, 0.20871E+01, 0.20905E+01, 0.20940E+01,
- & 0.20974E+01, 0.21008E+01, 0.21042E+01, 0.21077E+01, 0.21111E+01,
- & 0.21145E+01, 0.21179E+01, 0.21213E+01, 0.21247E+01, 0.21280E+01,
- & 0.21314E+01, 0.21348E+01, 0.21382E+01, 0.21415E+01, 0.21449E+01/
-
- DATA (BNC11M(I),I=501,600)/
- & 0.21483E+01, 0.21516E+01, 0.21550E+01, 0.21583E+01, 0.21617E+01,
- & 0.21650E+01, 0.21683E+01, 0.21717E+01, 0.21750E+01, 0.21783E+01,
- & 0.21816E+01, 0.21849E+01, 0.21882E+01, 0.21915E+01, 0.21948E+01,
- & 0.21981E+01, 0.22014E+01, 0.22047E+01, 0.22080E+01, 0.22113E+01,
- & 0.22145E+01, 0.22178E+01, 0.22211E+01, 0.22243E+01, 0.22276E+01,
- & 0.22308E+01, 0.22341E+01, 0.22373E+01, 0.22406E+01, 0.22438E+01,
- & 0.22470E+01, 0.22503E+01, 0.22535E+01, 0.22567E+01, 0.22599E+01,
- & 0.22631E+01, 0.22663E+01, 0.22695E+01, 0.22727E+01, 0.22759E+01,
- & 0.22791E+01, 0.22823E+01, 0.22855E+01, 0.22887E+01, 0.22918E+01,
- & 0.22950E+01, 0.22982E+01, 0.23013E+01, 0.23045E+01, 0.23076E+01,
- & 0.23108E+01, 0.23139E+01, 0.23171E+01, 0.23202E+01, 0.23234E+01,
- & 0.23265E+01, 0.23296E+01, 0.23327E+01, 0.23359E+01, 0.23390E+01,
- & 0.23421E+01, 0.23452E+01, 0.23483E+01, 0.23514E+01, 0.23545E+01,
- & 0.23576E+01, 0.23607E+01, 0.23638E+01, 0.23668E+01, 0.23699E+01,
- & 0.23730E+01, 0.23761E+01, 0.23791E+01, 0.23822E+01, 0.23853E+01,
- & 0.23883E+01, 0.23914E+01, 0.23944E+01, 0.23975E+01, 0.24005E+01,
- & 0.24035E+01, 0.24066E+01, 0.24096E+01, 0.24126E+01, 0.24156E+01,
- & 0.24187E+01, 0.24217E+01, 0.24247E+01, 0.24277E+01, 0.24307E+01,
- & 0.24337E+01, 0.24367E+01, 0.24397E+01, 0.24427E+01, 0.24457E+01,
- & 0.24487E+01, 0.24516E+01, 0.24546E+01, 0.24576E+01, 0.24606E+01/
-
- DATA (BNC11M(I),I=601,700)/
- & 0.24924E+01, 0.25216E+01, 0.25504E+01, 0.25789E+01, 0.26071E+01,
- & 0.26349E+01, 0.26625E+01, 0.26898E+01, 0.27168E+01, 0.27435E+01,
- & 0.27699E+01, 0.27961E+01, 0.28220E+01, 0.28477E+01, 0.28731E+01,
- & 0.28982E+01, 0.29231E+01, 0.29478E+01, 0.29722E+01, 0.29965E+01,
- & 0.30205E+01, 0.30442E+01, 0.30678E+01, 0.30911E+01, 0.31143E+01,
- & 0.31372E+01, 0.31599E+01, 0.31825E+01, 0.32048E+01, 0.32270E+01,
- & 0.32490E+01, 0.32708E+01, 0.32924E+01, 0.33138E+01, 0.33351E+01,
- & 0.33562E+01, 0.33771E+01, 0.33979E+01, 0.34185E+01, 0.34389E+01,
- & 0.34592E+01, 0.34794E+01, 0.34993E+01, 0.35192E+01, 0.35389E+01,
- & 0.35584E+01, 0.35778E+01, 0.35971E+01, 0.36162E+01, 0.36352E+01,
- & 0.36541E+01, 0.36728E+01, 0.36914E+01, 0.37099E+01, 0.37282E+01,
- & 0.37465E+01, 0.37646E+01, 0.37826E+01, 0.38004E+01, 0.38182E+01,
- & 0.38358E+01, 0.38533E+01, 0.38707E+01, 0.38880E+01, 0.39052E+01,
- & 0.39223E+01, 0.39393E+01, 0.39562E+01, 0.39729E+01, 0.39896E+01,
- & 0.40062E+01, 0.40226E+01, 0.40390E+01, 0.40553E+01, 0.40715E+01,
- & 0.40876E+01, 0.41035E+01, 0.41194E+01, 0.41353E+01, 0.41510E+01,
- & 0.41666E+01, 0.41822E+01, 0.41976E+01, 0.42130E+01, 0.42283E+01,
- & 0.42435E+01, 0.42586E+01, 0.42737E+01, 0.42886E+01, 0.43035E+01,
- & 0.43183E+01, 0.43330E+01, 0.43477E+01, 0.43623E+01, 0.43768E+01,
- & 0.43912E+01, 0.44056E+01, 0.44198E+01, 0.44341E+01, 0.44482E+01/
-
- DATA (BNC11M(I),I=701,741)/
- & 0.44623E+01, 0.44763E+01, 0.44902E+01, 0.45041E+01, 0.45179E+01,
- & 0.45316E+01, 0.45453E+01, 0.45589E+01, 0.45724E+01, 0.45859E+01,
- & 0.45993E+01, 0.46126E+01, 0.46259E+01, 0.46391E+01, 0.46523E+01,
- & 0.46654E+01, 0.46785E+01, 0.46915E+01, 0.47044E+01, 0.47173E+01,
- & 0.47301E+01, 0.47428E+01, 0.47555E+01, 0.47682E+01, 0.47808E+01,
- & 0.47933E+01, 0.48058E+01, 0.48183E+01, 0.48306E+01, 0.48430E+01,
- & 0.48552E+01, 0.48675E+01, 0.48797E+01, 0.48918E+01, 0.49039E+01,
- & 0.49159E+01, 0.49279E+01, 0.49398E+01, 0.49517E+01, 0.49635E+01,
- & 0.49753E+01
- & /
-C
-C *** NaHSO4
-C
- DATA (BNC12M(I),I=1,100)/
- &-0.43994E-01,-0.91554E-01,-0.11320E+00,-0.12742E+00,-0.13780E+00,
- &-0.14581E+00,-0.15217E+00,-0.15732E+00,-0.16153E+00,-0.16499E+00,
- &-0.16783E+00,-0.17017E+00,-0.17206E+00,-0.17357E+00,-0.17474E+00,
- &-0.17562E+00,-0.17624E+00,-0.17661E+00,-0.17677E+00,-0.17673E+00,
- &-0.17650E+00,-0.17610E+00,-0.17555E+00,-0.17485E+00,-0.17402E+00,
- &-0.17305E+00,-0.17197E+00,-0.17076E+00,-0.16946E+00,-0.16805E+00,
- &-0.16654E+00,-0.16494E+00,-0.16325E+00,-0.16148E+00,-0.15962E+00,
- &-0.15770E+00,-0.15570E+00,-0.15363E+00,-0.15149E+00,-0.14929E+00,
- &-0.14703E+00,-0.14471E+00,-0.14234E+00,-0.13991E+00,-0.13743E+00,
- &-0.13490E+00,-0.13232E+00,-0.12970E+00,-0.12704E+00,-0.12433E+00,
- &-0.12159E+00,-0.11880E+00,-0.11598E+00,-0.11312E+00,-0.11023E+00,
- &-0.10730E+00,-0.10434E+00,-0.10135E+00,-0.98326E-01,-0.95275E-01,
- &-0.92194E-01,-0.89084E-01,-0.85947E-01,-0.82782E-01,-0.79591E-01,
- &-0.76372E-01,-0.73128E-01,-0.69857E-01,-0.66561E-01,-0.63239E-01,
- &-0.59892E-01,-0.56519E-01,-0.53121E-01,-0.49698E-01,-0.46250E-01,
- &-0.42776E-01,-0.39277E-01,-0.35752E-01,-0.32203E-01,-0.28628E-01,
- &-0.25027E-01,-0.21401E-01,-0.17750E-01,-0.14074E-01,-0.10373E-01,
- &-0.66461E-02,-0.28948E-02, 0.88116E-03, 0.46816E-02, 0.85060E-02,
- & 0.12354E-01, 0.16226E-01, 0.20121E-01, 0.24038E-01, 0.27977E-01,
- & 0.31937E-01, 0.35918E-01, 0.39920E-01, 0.43941E-01, 0.47981E-01/
-
- DATA (BNC12M(I),I=101,200)/
- & 0.52038E-01, 0.56113E-01, 0.60205E-01, 0.64312E-01, 0.68434E-01,
- & 0.72570E-01, 0.76719E-01, 0.80880E-01, 0.85053E-01, 0.89237E-01,
- & 0.93430E-01, 0.97632E-01, 0.10184E+00, 0.10606E+00, 0.11028E+00,
- & 0.11451E+00, 0.11875E+00, 0.12299E+00, 0.12723E+00, 0.13148E+00,
- & 0.13572E+00, 0.13997E+00, 0.14422E+00, 0.14848E+00, 0.15273E+00,
- & 0.15698E+00, 0.16123E+00, 0.16548E+00, 0.16972E+00, 0.17397E+00,
- & 0.17821E+00, 0.18245E+00, 0.18668E+00, 0.19091E+00, 0.19514E+00,
- & 0.19936E+00, 0.20358E+00, 0.20780E+00, 0.21201E+00, 0.21621E+00,
- & 0.22041E+00, 0.22460E+00, 0.22879E+00, 0.23297E+00, 0.23715E+00,
- & 0.24132E+00, 0.24549E+00, 0.24964E+00, 0.25379E+00, 0.25794E+00,
- & 0.26208E+00, 0.26621E+00, 0.27034E+00, 0.27445E+00, 0.27857E+00,
- & 0.28267E+00, 0.28677E+00, 0.29086E+00, 0.29494E+00, 0.29902E+00,
- & 0.30309E+00, 0.30715E+00, 0.31121E+00, 0.31526E+00, 0.31930E+00,
- & 0.32333E+00, 0.32736E+00, 0.33138E+00, 0.33539E+00, 0.33940E+00,
- & 0.34340E+00, 0.34739E+00, 0.35137E+00, 0.35534E+00, 0.35931E+00,
- & 0.36327E+00, 0.36723E+00, 0.37117E+00, 0.37511E+00, 0.37904E+00,
- & 0.38297E+00, 0.38688E+00, 0.39079E+00, 0.39469E+00, 0.39859E+00,
- & 0.40248E+00, 0.40635E+00, 0.41023E+00, 0.41409E+00, 0.41795E+00,
- & 0.42180E+00, 0.42564E+00, 0.42948E+00, 0.43331E+00, 0.43713E+00,
- & 0.44094E+00, 0.44475E+00, 0.44854E+00, 0.45234E+00, 0.45612E+00/
-
- DATA (BNC12M(I),I=201,300)/
- & 0.45990E+00, 0.46367E+00, 0.46743E+00, 0.47119E+00, 0.47493E+00,
- & 0.47868E+00, 0.48241E+00, 0.48614E+00, 0.48986E+00, 0.49357E+00,
- & 0.49727E+00, 0.50097E+00, 0.50466E+00, 0.50835E+00, 0.51203E+00,
- & 0.51570E+00, 0.51936E+00, 0.52302E+00, 0.52667E+00, 0.53031E+00,
- & 0.53395E+00, 0.53757E+00, 0.54120E+00, 0.54481E+00, 0.54842E+00,
- & 0.55202E+00, 0.55562E+00, 0.55920E+00, 0.56279E+00, 0.56636E+00,
- & 0.56993E+00, 0.57349E+00, 0.57704E+00, 0.58059E+00, 0.58413E+00,
- & 0.58767E+00, 0.59120E+00, 0.59472E+00, 0.59823E+00, 0.60174E+00,
- & 0.60524E+00, 0.60874E+00, 0.61223E+00, 0.61571E+00, 0.61919E+00,
- & 0.62266E+00, 0.62612E+00, 0.62958E+00, 0.63303E+00, 0.63647E+00,
- & 0.63991E+00, 0.64334E+00, 0.64677E+00, 0.65019E+00, 0.65360E+00,
- & 0.65701E+00, 0.66041E+00, 0.66380E+00, 0.66719E+00, 0.67057E+00,
- & 0.67395E+00, 0.67732E+00, 0.68068E+00, 0.68404E+00, 0.68740E+00,
- & 0.69074E+00, 0.69408E+00, 0.69742E+00, 0.70074E+00, 0.70407E+00,
- & 0.70738E+00, 0.71069E+00, 0.71400E+00, 0.71730E+00, 0.72059E+00,
- & 0.72388E+00, 0.72716E+00, 0.73044E+00, 0.73371E+00, 0.73697E+00,
- & 0.74023E+00, 0.74349E+00, 0.74673E+00, 0.74997E+00, 0.75321E+00,
- & 0.75644E+00, 0.75967E+00, 0.76289E+00, 0.76610E+00, 0.76931E+00,
- & 0.77251E+00, 0.77571E+00, 0.77890E+00, 0.78209E+00, 0.78527E+00,
- & 0.78845E+00, 0.79162E+00, 0.79478E+00, 0.79794E+00, 0.80110E+00/
-
- DATA (BNC12M(I),I=301,400)/
- & 0.80424E+00, 0.80739E+00, 0.81053E+00, 0.81366E+00, 0.81679E+00,
- & 0.81991E+00, 0.82303E+00, 0.82614E+00, 0.82925E+00, 0.83235E+00,
- & 0.83545E+00, 0.83854E+00, 0.84163E+00, 0.84471E+00, 0.84778E+00,
- & 0.85085E+00, 0.85392E+00, 0.85698E+00, 0.86004E+00, 0.86309E+00,
- & 0.86614E+00, 0.86918E+00, 0.87221E+00, 0.87525E+00, 0.87827E+00,
- & 0.88129E+00, 0.88431E+00, 0.88732E+00, 0.89033E+00, 0.89333E+00,
- & 0.89633E+00, 0.89932E+00, 0.90231E+00, 0.90529E+00, 0.90827E+00,
- & 0.91124E+00, 0.91421E+00, 0.91718E+00, 0.92014E+00, 0.92309E+00,
- & 0.92604E+00, 0.92899E+00, 0.93193E+00, 0.93486E+00, 0.93779E+00,
- & 0.94072E+00, 0.94364E+00, 0.94656E+00, 0.94947E+00, 0.95238E+00,
- & 0.95529E+00, 0.95819E+00, 0.96108E+00, 0.96397E+00, 0.96686E+00,
- & 0.96974E+00, 0.97262E+00, 0.97549E+00, 0.97836E+00, 0.98122E+00,
- & 0.98408E+00, 0.98694E+00, 0.98979E+00, 0.99264E+00, 0.99548E+00,
- & 0.99832E+00, 0.10012E+01, 0.10040E+01, 0.10068E+01, 0.10096E+01,
- & 0.10124E+01, 0.10153E+01, 0.10181E+01, 0.10209E+01, 0.10237E+01,
- & 0.10265E+01, 0.10293E+01, 0.10320E+01, 0.10348E+01, 0.10376E+01,
- & 0.10404E+01, 0.10431E+01, 0.10459E+01, 0.10487E+01, 0.10514E+01,
- & 0.10542E+01, 0.10569E+01, 0.10597E+01, 0.10624E+01, 0.10652E+01,
- & 0.10679E+01, 0.10706E+01, 0.10734E+01, 0.10761E+01, 0.10788E+01,
- & 0.10815E+01, 0.10842E+01, 0.10869E+01, 0.10896E+01, 0.10923E+01/
-
- DATA (BNC12M(I),I=401,500)/
- & 0.10950E+01, 0.10977E+01, 0.11004E+01, 0.11031E+01, 0.11058E+01,
- & 0.11084E+01, 0.11111E+01, 0.11138E+01, 0.11165E+01, 0.11191E+01,
- & 0.11218E+01, 0.11244E+01, 0.11271E+01, 0.11297E+01, 0.11324E+01,
- & 0.11350E+01, 0.11376E+01, 0.11403E+01, 0.11429E+01, 0.11455E+01,
- & 0.11481E+01, 0.11507E+01, 0.11534E+01, 0.11560E+01, 0.11586E+01,
- & 0.11612E+01, 0.11638E+01, 0.11664E+01, 0.11690E+01, 0.11715E+01,
- & 0.11741E+01, 0.11767E+01, 0.11793E+01, 0.11819E+01, 0.11844E+01,
- & 0.11870E+01, 0.11896E+01, 0.11921E+01, 0.11947E+01, 0.11972E+01,
- & 0.11998E+01, 0.12023E+01, 0.12049E+01, 0.12074E+01, 0.12099E+01,
- & 0.12125E+01, 0.12150E+01, 0.12175E+01, 0.12200E+01, 0.12226E+01,
- & 0.12251E+01, 0.12276E+01, 0.12301E+01, 0.12326E+01, 0.12351E+01,
- & 0.12376E+01, 0.12401E+01, 0.12426E+01, 0.12451E+01, 0.12475E+01,
- & 0.12500E+01, 0.12525E+01, 0.12550E+01, 0.12575E+01, 0.12599E+01,
- & 0.12624E+01, 0.12649E+01, 0.12673E+01, 0.12698E+01, 0.12722E+01,
- & 0.12747E+01, 0.12771E+01, 0.12796E+01, 0.12820E+01, 0.12844E+01,
- & 0.12869E+01, 0.12893E+01, 0.12917E+01, 0.12941E+01, 0.12966E+01,
- & 0.12990E+01, 0.13014E+01, 0.13038E+01, 0.13062E+01, 0.13086E+01,
- & 0.13110E+01, 0.13134E+01, 0.13158E+01, 0.13182E+01, 0.13206E+01,
- & 0.13230E+01, 0.13254E+01, 0.13278E+01, 0.13301E+01, 0.13325E+01,
- & 0.13349E+01, 0.13373E+01, 0.13396E+01, 0.13420E+01, 0.13443E+01/
-
- DATA (BNC12M(I),I=501,600)/
- & 0.13467E+01, 0.13491E+01, 0.13514E+01, 0.13538E+01, 0.13561E+01,
- & 0.13584E+01, 0.13608E+01, 0.13631E+01, 0.13655E+01, 0.13678E+01,
- & 0.13701E+01, 0.13724E+01, 0.13748E+01, 0.13771E+01, 0.13794E+01,
- & 0.13817E+01, 0.13840E+01, 0.13863E+01, 0.13886E+01, 0.13909E+01,
- & 0.13932E+01, 0.13955E+01, 0.13978E+01, 0.14001E+01, 0.14024E+01,
- & 0.14047E+01, 0.14070E+01, 0.14093E+01, 0.14115E+01, 0.14138E+01,
- & 0.14161E+01, 0.14184E+01, 0.14206E+01, 0.14229E+01, 0.14252E+01,
- & 0.14274E+01, 0.14297E+01, 0.14319E+01, 0.14342E+01, 0.14364E+01,
- & 0.14387E+01, 0.14409E+01, 0.14431E+01, 0.14454E+01, 0.14476E+01,
- & 0.14499E+01, 0.14521E+01, 0.14543E+01, 0.14565E+01, 0.14588E+01,
- & 0.14610E+01, 0.14632E+01, 0.14654E+01, 0.14676E+01, 0.14698E+01,
- & 0.14720E+01, 0.14742E+01, 0.14764E+01, 0.14786E+01, 0.14808E+01,
- & 0.14830E+01, 0.14852E+01, 0.14874E+01, 0.14896E+01, 0.14918E+01,
- & 0.14940E+01, 0.14961E+01, 0.14983E+01, 0.15005E+01, 0.15027E+01,
- & 0.15048E+01, 0.15070E+01, 0.15092E+01, 0.15113E+01, 0.15135E+01,
- & 0.15156E+01, 0.15178E+01, 0.15199E+01, 0.15221E+01, 0.15242E+01,
- & 0.15264E+01, 0.15285E+01, 0.15307E+01, 0.15328E+01, 0.15349E+01,
- & 0.15371E+01, 0.15392E+01, 0.15413E+01, 0.15434E+01, 0.15456E+01,
- & 0.15477E+01, 0.15498E+01, 0.15519E+01, 0.15540E+01, 0.15561E+01,
- & 0.15583E+01, 0.15604E+01, 0.15625E+01, 0.15646E+01, 0.15667E+01/
-
- DATA (BNC12M(I),I=601,700)/
- & 0.15892E+01, 0.16098E+01, 0.16302E+01, 0.16504E+01, 0.16704E+01,
- & 0.16902E+01, 0.17098E+01, 0.17291E+01, 0.17483E+01, 0.17673E+01,
- & 0.17861E+01, 0.18047E+01, 0.18232E+01, 0.18415E+01, 0.18596E+01,
- & 0.18775E+01, 0.18953E+01, 0.19129E+01, 0.19304E+01, 0.19477E+01,
- & 0.19648E+01, 0.19818E+01, 0.19987E+01, 0.20154E+01, 0.20320E+01,
- & 0.20484E+01, 0.20647E+01, 0.20809E+01, 0.20969E+01, 0.21129E+01,
- & 0.21286E+01, 0.21443E+01, 0.21598E+01, 0.21752E+01, 0.21905E+01,
- & 0.22057E+01, 0.22208E+01, 0.22357E+01, 0.22506E+01, 0.22653E+01,
- & 0.22799E+01, 0.22945E+01, 0.23089E+01, 0.23232E+01, 0.23374E+01,
- & 0.23515E+01, 0.23656E+01, 0.23795E+01, 0.23933E+01, 0.24071E+01,
- & 0.24207E+01, 0.24343E+01, 0.24477E+01, 0.24611E+01, 0.24744E+01,
- & 0.24876E+01, 0.25007E+01, 0.25138E+01, 0.25267E+01, 0.25396E+01,
- & 0.25524E+01, 0.25651E+01, 0.25778E+01, 0.25903E+01, 0.26028E+01,
- & 0.26152E+01, 0.26276E+01, 0.26398E+01, 0.26520E+01, 0.26642E+01,
- & 0.26762E+01, 0.26882E+01, 0.27001E+01, 0.27120E+01, 0.27238E+01,
- & 0.27355E+01, 0.27472E+01, 0.27588E+01, 0.27703E+01, 0.27818E+01,
- & 0.27932E+01, 0.28045E+01, 0.28158E+01, 0.28270E+01, 0.28382E+01,
- & 0.28493E+01, 0.28604E+01, 0.28714E+01, 0.28823E+01, 0.28932E+01,
- & 0.29040E+01, 0.29148E+01, 0.29256E+01, 0.29362E+01, 0.29468E+01,
- & 0.29574E+01, 0.29679E+01, 0.29784E+01, 0.29888E+01, 0.29992E+01/
-
- DATA (BNC12M(I),I=701,741)/
- & 0.30095E+01, 0.30198E+01, 0.30300E+01, 0.30402E+01, 0.30503E+01,
- & 0.30604E+01, 0.30705E+01, 0.30805E+01, 0.30904E+01, 0.31003E+01,
- & 0.31102E+01, 0.31200E+01, 0.31298E+01, 0.31395E+01, 0.31492E+01,
- & 0.31588E+01, 0.31684E+01, 0.31780E+01, 0.31875E+01, 0.31970E+01,
- & 0.32065E+01, 0.32159E+01, 0.32252E+01, 0.32346E+01, 0.32439E+01,
- & 0.32531E+01, 0.32623E+01, 0.32715E+01, 0.32807E+01, 0.32898E+01,
- & 0.32988E+01, 0.33079E+01, 0.33169E+01, 0.33258E+01, 0.33348E+01,
- & 0.33436E+01, 0.33525E+01, 0.33613E+01, 0.33701E+01, 0.33789E+01,
- & 0.33876E+01
- & /
-C
-C *** (NH4)3H(SO4)2
-C
- DATA (BNC13M(I),I=1,100)/
- &-0.72232E-01,-0.15583E+00,-0.19693E+00,-0.22563E+00,-0.24790E+00,
- &-0.26615E+00,-0.28162E+00,-0.29503E+00,-0.30686E+00,-0.31742E+00,
- &-0.32695E+00,-0.33562E+00,-0.34356E+00,-0.35087E+00,-0.35764E+00,
- &-0.36392E+00,-0.36978E+00,-0.37525E+00,-0.38039E+00,-0.38521E+00,
- &-0.38975E+00,-0.39403E+00,-0.39808E+00,-0.40190E+00,-0.40552E+00,
- &-0.40895E+00,-0.41221E+00,-0.41530E+00,-0.41823E+00,-0.42103E+00,
- &-0.42368E+00,-0.42620E+00,-0.42861E+00,-0.43090E+00,-0.43307E+00,
- &-0.43515E+00,-0.43712E+00,-0.43900E+00,-0.44079E+00,-0.44249E+00,
- &-0.44411E+00,-0.44565E+00,-0.44712E+00,-0.44851E+00,-0.44984E+00,
- &-0.45109E+00,-0.45229E+00,-0.45342E+00,-0.45449E+00,-0.45551E+00,
- &-0.45647E+00,-0.45738E+00,-0.45823E+00,-0.45904E+00,-0.45980E+00,
- &-0.46052E+00,-0.46119E+00,-0.46182E+00,-0.46241E+00,-0.46296E+00,
- &-0.46347E+00,-0.46394E+00,-0.46438E+00,-0.46478E+00,-0.46515E+00,
- &-0.46549E+00,-0.46579E+00,-0.46607E+00,-0.46631E+00,-0.46653E+00,
- &-0.46671E+00,-0.46687E+00,-0.46701E+00,-0.46711E+00,-0.46720E+00,
- &-0.46725E+00,-0.46729E+00,-0.46730E+00,-0.46728E+00,-0.46725E+00,
- &-0.46719E+00,-0.46711E+00,-0.46701E+00,-0.46689E+00,-0.46675E+00,
- &-0.46659E+00,-0.46641E+00,-0.46621E+00,-0.46599E+00,-0.46576E+00,
- &-0.46550E+00,-0.46523E+00,-0.46495E+00,-0.46465E+00,-0.46433E+00,
- &-0.46399E+00,-0.46364E+00,-0.46328E+00,-0.46290E+00,-0.46251E+00/
-
- DATA (BNC13M(I),I=101,200)/
- &-0.46211E+00,-0.46169E+00,-0.46125E+00,-0.46081E+00,-0.46035E+00,
- &-0.45989E+00,-0.45941E+00,-0.45892E+00,-0.45842E+00,-0.45791E+00,
- &-0.45739E+00,-0.45686E+00,-0.45632E+00,-0.45577E+00,-0.45522E+00,
- &-0.45465E+00,-0.45408E+00,-0.45350E+00,-0.45291E+00,-0.45232E+00,
- &-0.45172E+00,-0.45111E+00,-0.45050E+00,-0.44988E+00,-0.44926E+00,
- &-0.44863E+00,-0.44799E+00,-0.44735E+00,-0.44671E+00,-0.44606E+00,
- &-0.44540E+00,-0.44474E+00,-0.44408E+00,-0.44342E+00,-0.44274E+00,
- &-0.44207E+00,-0.44139E+00,-0.44071E+00,-0.44003E+00,-0.43934E+00,
- &-0.43865E+00,-0.43796E+00,-0.43726E+00,-0.43656E+00,-0.43586E+00,
- &-0.43515E+00,-0.43445E+00,-0.43374E+00,-0.43303E+00,-0.43231E+00,
- &-0.43160E+00,-0.43088E+00,-0.43016E+00,-0.42944E+00,-0.42872E+00,
- &-0.42799E+00,-0.42727E+00,-0.42654E+00,-0.42581E+00,-0.42508E+00,
- &-0.42435E+00,-0.42361E+00,-0.42288E+00,-0.42214E+00,-0.42140E+00,
- &-0.42067E+00,-0.41993E+00,-0.41918E+00,-0.41844E+00,-0.41770E+00,
- &-0.41696E+00,-0.41621E+00,-0.41547E+00,-0.41472E+00,-0.41397E+00,
- &-0.41322E+00,-0.41248E+00,-0.41173E+00,-0.41098E+00,-0.41023E+00,
- &-0.40947E+00,-0.40872E+00,-0.40797E+00,-0.40722E+00,-0.40646E+00,
- &-0.40571E+00,-0.40496E+00,-0.40420E+00,-0.40345E+00,-0.40269E+00,
- &-0.40193E+00,-0.40118E+00,-0.40042E+00,-0.39967E+00,-0.39891E+00,
- &-0.39815E+00,-0.39739E+00,-0.39664E+00,-0.39588E+00,-0.39512E+00/
-
- DATA (BNC13M(I),I=201,300)/
- &-0.39436E+00,-0.39361E+00,-0.39285E+00,-0.39209E+00,-0.39133E+00,
- &-0.39057E+00,-0.38981E+00,-0.38906E+00,-0.38830E+00,-0.38754E+00,
- &-0.38678E+00,-0.38602E+00,-0.38526E+00,-0.38451E+00,-0.38375E+00,
- &-0.38299E+00,-0.38223E+00,-0.38147E+00,-0.38071E+00,-0.37996E+00,
- &-0.37920E+00,-0.37844E+00,-0.37768E+00,-0.37693E+00,-0.37617E+00,
- &-0.37541E+00,-0.37466E+00,-0.37390E+00,-0.37314E+00,-0.37239E+00,
- &-0.37163E+00,-0.37087E+00,-0.37012E+00,-0.36936E+00,-0.36861E+00,
- &-0.36785E+00,-0.36710E+00,-0.36634E+00,-0.36559E+00,-0.36484E+00,
- &-0.36408E+00,-0.36333E+00,-0.36258E+00,-0.36182E+00,-0.36107E+00,
- &-0.36032E+00,-0.35957E+00,-0.35882E+00,-0.35807E+00,-0.35732E+00,
- &-0.35656E+00,-0.35581E+00,-0.35507E+00,-0.35432E+00,-0.35357E+00,
- &-0.35282E+00,-0.35207E+00,-0.35132E+00,-0.35057E+00,-0.34983E+00,
- &-0.34908E+00,-0.34833E+00,-0.34759E+00,-0.34684E+00,-0.34610E+00,
- &-0.34535E+00,-0.34461E+00,-0.34386E+00,-0.34312E+00,-0.34237E+00,
- &-0.34163E+00,-0.34089E+00,-0.34015E+00,-0.33940E+00,-0.33866E+00,
- &-0.33792E+00,-0.33718E+00,-0.33644E+00,-0.33570E+00,-0.33496E+00,
- &-0.33422E+00,-0.33348E+00,-0.33275E+00,-0.33201E+00,-0.33127E+00,
- &-0.33053E+00,-0.32980E+00,-0.32906E+00,-0.32833E+00,-0.32759E+00,
- &-0.32686E+00,-0.32612E+00,-0.32539E+00,-0.32465E+00,-0.32392E+00,
- &-0.32319E+00,-0.32246E+00,-0.32172E+00,-0.32099E+00,-0.32026E+00/
-
- DATA (BNC13M(I),I=301,400)/
- &-0.31953E+00,-0.31880E+00,-0.31807E+00,-0.31734E+00,-0.31662E+00,
- &-0.31589E+00,-0.31516E+00,-0.31443E+00,-0.31371E+00,-0.31298E+00,
- &-0.31225E+00,-0.31153E+00,-0.31080E+00,-0.31008E+00,-0.30936E+00,
- &-0.30863E+00,-0.30791E+00,-0.30719E+00,-0.30646E+00,-0.30574E+00,
- &-0.30502E+00,-0.30430E+00,-0.30358E+00,-0.30286E+00,-0.30214E+00,
- &-0.30142E+00,-0.30070E+00,-0.29999E+00,-0.29927E+00,-0.29855E+00,
- &-0.29784E+00,-0.29712E+00,-0.29640E+00,-0.29569E+00,-0.29497E+00,
- &-0.29426E+00,-0.29355E+00,-0.29283E+00,-0.29212E+00,-0.29141E+00,
- &-0.29070E+00,-0.28999E+00,-0.28927E+00,-0.28856E+00,-0.28785E+00,
- &-0.28714E+00,-0.28644E+00,-0.28573E+00,-0.28502E+00,-0.28431E+00,
- &-0.28360E+00,-0.28290E+00,-0.28219E+00,-0.28149E+00,-0.28078E+00,
- &-0.28008E+00,-0.27937E+00,-0.27867E+00,-0.27796E+00,-0.27726E+00,
- &-0.27656E+00,-0.27586E+00,-0.27516E+00,-0.27445E+00,-0.27375E+00,
- &-0.27305E+00,-0.27235E+00,-0.27165E+00,-0.27096E+00,-0.27026E+00,
- &-0.26956E+00,-0.26886E+00,-0.26817E+00,-0.26747E+00,-0.26677E+00,
- &-0.26608E+00,-0.26538E+00,-0.26469E+00,-0.26399E+00,-0.26330E+00,
- &-0.26261E+00,-0.26192E+00,-0.26122E+00,-0.26053E+00,-0.25984E+00,
- &-0.25915E+00,-0.25846E+00,-0.25777E+00,-0.25708E+00,-0.25639E+00,
- &-0.25570E+00,-0.25501E+00,-0.25433E+00,-0.25364E+00,-0.25295E+00,
- &-0.25227E+00,-0.25158E+00,-0.25090E+00,-0.25021E+00,-0.24953E+00/
-
- DATA (BNC13M(I),I=401,500)/
- &-0.24884E+00,-0.24816E+00,-0.24748E+00,-0.24679E+00,-0.24611E+00,
- &-0.24543E+00,-0.24475E+00,-0.24407E+00,-0.24339E+00,-0.24271E+00,
- &-0.24203E+00,-0.24135E+00,-0.24067E+00,-0.23999E+00,-0.23931E+00,
- &-0.23864E+00,-0.23796E+00,-0.23728E+00,-0.23661E+00,-0.23593E+00,
- &-0.23526E+00,-0.23458E+00,-0.23391E+00,-0.23323E+00,-0.23256E+00,
- &-0.23189E+00,-0.23122E+00,-0.23054E+00,-0.22987E+00,-0.22920E+00,
- &-0.22853E+00,-0.22786E+00,-0.22719E+00,-0.22652E+00,-0.22585E+00,
- &-0.22519E+00,-0.22452E+00,-0.22385E+00,-0.22318E+00,-0.22252E+00,
- &-0.22185E+00,-0.22118E+00,-0.22052E+00,-0.21985E+00,-0.21919E+00,
- &-0.21853E+00,-0.21786E+00,-0.21720E+00,-0.21654E+00,-0.21587E+00,
- &-0.21521E+00,-0.21455E+00,-0.21389E+00,-0.21323E+00,-0.21257E+00,
- &-0.21191E+00,-0.21125E+00,-0.21059E+00,-0.20993E+00,-0.20927E+00,
- &-0.20862E+00,-0.20796E+00,-0.20730E+00,-0.20665E+00,-0.20599E+00,
- &-0.20534E+00,-0.20468E+00,-0.20403E+00,-0.20337E+00,-0.20272E+00,
- &-0.20206E+00,-0.20141E+00,-0.20076E+00,-0.20011E+00,-0.19945E+00,
- &-0.19880E+00,-0.19815E+00,-0.19750E+00,-0.19685E+00,-0.19620E+00,
- &-0.19555E+00,-0.19490E+00,-0.19426E+00,-0.19361E+00,-0.19296E+00,
- &-0.19231E+00,-0.19167E+00,-0.19102E+00,-0.19037E+00,-0.18973E+00,
- &-0.18908E+00,-0.18844E+00,-0.18779E+00,-0.18715E+00,-0.18651E+00,
- &-0.18586E+00,-0.18522E+00,-0.18458E+00,-0.18393E+00,-0.18329E+00/
-
- DATA (BNC13M(I),I=501,600)/
- &-0.18265E+00,-0.18201E+00,-0.18137E+00,-0.18073E+00,-0.18009E+00,
- &-0.17945E+00,-0.17881E+00,-0.17817E+00,-0.17754E+00,-0.17690E+00,
- &-0.17626E+00,-0.17563E+00,-0.17499E+00,-0.17435E+00,-0.17372E+00,
- &-0.17308E+00,-0.17245E+00,-0.17181E+00,-0.17118E+00,-0.17054E+00,
- &-0.16991E+00,-0.16928E+00,-0.16865E+00,-0.16801E+00,-0.16738E+00,
- &-0.16675E+00,-0.16612E+00,-0.16549E+00,-0.16486E+00,-0.16423E+00,
- &-0.16360E+00,-0.16297E+00,-0.16234E+00,-0.16171E+00,-0.16108E+00,
- &-0.16046E+00,-0.15983E+00,-0.15920E+00,-0.15858E+00,-0.15795E+00,
- &-0.15732E+00,-0.15670E+00,-0.15607E+00,-0.15545E+00,-0.15483E+00,
- &-0.15420E+00,-0.15358E+00,-0.15295E+00,-0.15233E+00,-0.15171E+00,
- &-0.15109E+00,-0.15047E+00,-0.14984E+00,-0.14922E+00,-0.14860E+00,
- &-0.14798E+00,-0.14736E+00,-0.14674E+00,-0.14612E+00,-0.14551E+00,
- &-0.14489E+00,-0.14427E+00,-0.14365E+00,-0.14303E+00,-0.14242E+00,
- &-0.14180E+00,-0.14119E+00,-0.14057E+00,-0.13995E+00,-0.13934E+00,
- &-0.13872E+00,-0.13811E+00,-0.13750E+00,-0.13688E+00,-0.13627E+00,
- &-0.13566E+00,-0.13504E+00,-0.13443E+00,-0.13382E+00,-0.13321E+00,
- &-0.13260E+00,-0.13198E+00,-0.13137E+00,-0.13076E+00,-0.13015E+00,
- &-0.12954E+00,-0.12894E+00,-0.12833E+00,-0.12772E+00,-0.12711E+00,
- &-0.12650E+00,-0.12590E+00,-0.12529E+00,-0.12468E+00,-0.12408E+00,
- &-0.12347E+00,-0.12286E+00,-0.12226E+00,-0.12165E+00,-0.12105E+00/
-
- DATA (BNC13M(I),I=601,700)/
- &-0.11454E+00,-0.10855E+00,-0.10259E+00,-0.96662E-01,-0.90767E-01,
- &-0.84905E-01,-0.79073E-01,-0.73271E-01,-0.67500E-01,-0.61758E-01,
- &-0.56045E-01,-0.50360E-01,-0.44704E-01,-0.39075E-01,-0.33474E-01,
- &-0.27900E-01,-0.22352E-01,-0.16830E-01,-0.11333E-01,-0.58624E-02,
- &-0.41621E-03, 0.50053E-02, 0.10403E-01, 0.15776E-01, 0.21127E-01,
- & 0.26454E-01, 0.31758E-01, 0.37040E-01, 0.42299E-01, 0.47537E-01,
- & 0.52753E-01, 0.57949E-01, 0.63123E-01, 0.68276E-01, 0.73409E-01,
- & 0.78522E-01, 0.83616E-01, 0.88690E-01, 0.93744E-01, 0.98779E-01,
- & 0.10380E+00, 0.10879E+00, 0.11377E+00, 0.11874E+00, 0.12368E+00,
- & 0.12861E+00, 0.13352E+00, 0.13841E+00, 0.14328E+00, 0.14814E+00,
- & 0.15298E+00, 0.15781E+00, 0.16262E+00, 0.16741E+00, 0.17219E+00,
- & 0.17695E+00, 0.18170E+00, 0.18643E+00, 0.19115E+00, 0.19585E+00,
- & 0.20054E+00, 0.20521E+00, 0.20987E+00, 0.21452E+00, 0.21915E+00,
- & 0.22376E+00, 0.22837E+00, 0.23296E+00, 0.23753E+00, 0.24210E+00,
- & 0.24665E+00, 0.25119E+00, 0.25571E+00, 0.26022E+00, 0.26472E+00,
- & 0.26921E+00, 0.27369E+00, 0.27815E+00, 0.28260E+00, 0.28704E+00,
- & 0.29147E+00, 0.29588E+00, 0.30029E+00, 0.30468E+00, 0.30907E+00,
- & 0.31344E+00, 0.31780E+00, 0.32215E+00, 0.32649E+00, 0.33081E+00,
- & 0.33513E+00, 0.33944E+00, 0.34374E+00, 0.34802E+00, 0.35230E+00,
- & 0.35656E+00, 0.36082E+00, 0.36507E+00, 0.36930E+00, 0.37353E+00/
-
- DATA (BNC13M(I),I=701,741)/
- & 0.37775E+00, 0.38196E+00, 0.38616E+00, 0.39035E+00, 0.39453E+00,
- & 0.39870E+00, 0.40286E+00, 0.40701E+00, 0.41116E+00, 0.41529E+00,
- & 0.41942E+00, 0.42354E+00, 0.42764E+00, 0.43175E+00, 0.43584E+00,
- & 0.43992E+00, 0.44400E+00, 0.44807E+00, 0.45213E+00, 0.45618E+00,
- & 0.46022E+00, 0.46426E+00, 0.46828E+00, 0.47230E+00, 0.47632E+00,
- & 0.48032E+00, 0.48432E+00, 0.48831E+00, 0.49229E+00, 0.49626E+00,
- & 0.50023E+00, 0.50419E+00, 0.50814E+00, 0.51209E+00, 0.51603E+00,
- & 0.51996E+00, 0.52388E+00, 0.52780E+00, 0.53171E+00, 0.53562E+00,
- & 0.53951E+00
- & /
- END
-
diff --git a/src/MNH/deallocate_model1.f90 b/src/MNH/deallocate_model1.f90
index dc3107d54dd4857b1857c4a2692638d4e9a4c3c8..3b0b4673893c19604b474aa94d5979f9d97c7b50 100644
--- a/src/MNH/deallocate_model1.f90
+++ b/src/MNH/deallocate_model1.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!############################
@@ -65,9 +65,10 @@ END MODULE MODI_DEALLOCATE_MODEL1
!! 01/2004 V. Masson surface externalization
!! 06/2012 M.Tomasini add 2D nesting ADVFRC
!! 10/2016 M.Mazoyer New KHKO output fields
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! 02/2019 C.Lac add rain fraction as an output field
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! C. Lac 02/2019: add rain fraction as an output field
! P. Wautelet 07/06/2019: bugfix: deallocate XLSRVM only if allocated
+! S. Riette 04/2020: XHL* fields
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -105,6 +106,7 @@ USE MODD_ADV_n
USE MODD_PAST_FIELD_n
USE MODD_TURB_n
USE MODD_PARAM_C2R2, ONLY :LSUPSAT
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -185,6 +187,13 @@ IF ( ASSOCIATED(XSRCT) .AND. KCALL==3 ) THEN
DEALLOCATE(XSIGS)
END IF
!
+IF ( ASSOCIATED(XHLC_HRC) .AND. KCALL==3 ) THEN
+ DEALLOCATE(XHLC_HRC)
+ DEALLOCATE(XHLC_HCF)
+ DEALLOCATE(XHLI_HRI)
+ DEALLOCATE(XHLI_HCF)
+END IF
+!
IF ( ASSOCIATED(XCLDFR) .AND. KCALL==2 ) THEN
DEALLOCATE(XCLDFR)
END IF
@@ -455,9 +464,6 @@ IF ( ALLOCATED(XUFRC) .AND. KCALL == 4 ) THEN
DEALLOCATE(XGYTHFRC)
DEALLOCATE(XPGROUNDFRC)
END IF
-IF ( ALLOCATED(XWTFRC) .AND. KCALL == 4 ) THEN
- DEALLOCATE(XWTFRC)
-END IF
!
!* 12. Module MODD_ICE_CONC$n
!
diff --git a/src/MNH/default_desfmn.f90 b/src/MNH/default_desfmn.f90
index 38c7bba55cb86e02d0f9edc6ad19b085f384dacf..c1be2c51e65e7c16f078c8010a3e21b7f2bf4727 100644
--- a/src/MNH/default_desfmn.f90
+++ b/src/MNH/default_desfmn.f90
@@ -1,8 +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: /home/cvsroot/MNH-VX-Y-Z/src/MNH/default_desfmn.f90,v _
!-----------------------------------------------------------------
! ###########################
MODULE MODI_DEFAULT_DESFM_n
@@ -88,38 +87,16 @@ 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
-!! LBU_RU,LBU_RV,LBU_RW,LBU_RTH,LBU_RTKE,LBU_RRV,LBU_RRC,LBU_RRR
-!! LBU_RRI,LBU_RRS,LBU_RRG,LBU_RRH,LBU_RSVx
-!! NADVXU, NADVYU, NADVZU, NCURVU, NCORU, NDIFU, NRELU, NHTURBU,
-!! NVTURBU, NPRESU
-!! NADVXV, NADVYV, NADVZV, NCURVV, NCORV, NDIFV, NRELV, NHTURBV,
-!! NVTURBV, NPRESV
-!! NADVXW, NADVYW, NADVZW, NCURVW, NCORW, NGRAVW, NDIFW, NRELW,
-!! NHTURBW, NVTURBW, NPRESW
-!! NADVXTH, NADVYTH, NADVZTH, NPREFTH, NDIFTH, NRELTH, NHTURBTH,
-!! NVTURBTH, NREVATH, NCONDTH
-!! NADVXTKE, NADVYTKE, NADVZTKE, NDIFTKE, NDPTKE, NTPTKE, NDISSTKE,
-!! NTRTKE
-!! NADVXRV, NADVYRV, NADVZRV, NDIFRV, NRELRV, NHTURBRV, NVTURBRV,
-!! NREVARV, NCONDRV
-!! NADVXRC, NADVYRC, NADVZRC, NDIFRC, NHTURBRC, NVTURBRC, NACCRRC,
-!! NAUTORC, NCONDRC
-!! NADVXRR, NADVYRR, NADVZRR, NDIFRR, NACCRRR, NAUTORR, NREVARR,
-!! NSEDIRR
-!! NADVXRI, NADVYRI, NADVZRI, NDIFRI
-!! NADVXRS, NADVYRS, NADVZRS, NDIFRS
-!! NADVXRG, NADVYRG, NADVZRG, NDIFRG
-!! NADVXRH, NADVYRH, NADVZRH, NDIFRH
-!! NADVXSVx, NADVYSVx, NADVZSVx, NDIFSVx, NHTURBSVx, NVTURBSVx
!!
-!! Module MODD_BLANK :
+!! 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
!!
@@ -169,7 +146,7 @@ END MODULE MODI_DEFAULT_DESFM_n
!! Modifications 25/04/96 (Suhre) add the blank module
!! Modifications 29/07/96 (Pinty&Suhre) add module MODD_FRC
!! Modifications 11/04/96 (Pinty) add the rain-ice scheme and modify
-!! the splitted arrays in MODD_PARAM_RAD_n
+!! the split arrays in MODD_PARAM_RAD_n
!! Modifications 11/01/97 (Pinty) add the deep convection scheme
!! Modifications 24/11/96 (Masson) add LREFRESH_ALL in deep convection
!! Modifications 12/02/96 (Lafore) transformation to DEFAULT_DESFM_n for spawning
@@ -211,7 +188,7 @@ END MODULE MODI_DEFAULT_DESFM_n
!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX
!! put NCH_VEC_LENGTH = 50 instead of 1000
!!
-!! 04/2016 (C.LAC) negative contribution to the budget splitted between advection, turbulence and microphysics for KHKO/C2R2
+!! 04/2016 (C.LAC) negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2
!! Modification 01/2016 (JP Pinty) Add LIMA
!! Modification 24/03/16 (Leriche) remove LCH_SURFACE_FLUX
!! put NCH_VEC_LENGTH = 50 instead of 1000
@@ -229,7 +206,19 @@ END MODULE MODI_DEFAULT_DESFM_n
!! 01/2019 (R. Honnert) add reduction of the mass-flux surface closure with the resolution
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
!! 05/2019 F.Brient add tracer emission from the top of the boundary-layer
-!!
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+! P. Wautelet 17/04/2020: move budgets switch values into modd_budget
+! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+! F. Auguste, T. Nagel 02/2021: add IBM defaults parameters
+! T. Nagel 02/2021: add turbulence recycling defaults parameters
+! P-A Joulin 21/05/2021: add Wind turbines
+! S. Riette 21/05/2021: add options to PDF subgrid scheme
+! D. Ricard 05/2021: add the contribution of Leonard terms in the turbulence scheme
+! JL Redelsperger 06/2021: add parameters allowing to active idealized oceanic convection
+! B. Vie 06/2021: add prognostic supersaturation for LIMA
+! Q. Rodier 06/2021: modify default value to LGZ=F (grey-zone corr.), LSEDI and OSEDC=T (LIMA sedimentation)
+! F. Couvreux 06/2021: add LRELAX_UVMEAN_FRC
+! Q. Rodier 07/2021: modify XPOND=1
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -255,8 +244,11 @@ USE MODD_LES
USE MODD_PARAM_RAD_n
#ifdef MNH_ECRAD
USE MODD_PARAM_ECRAD_n
+#if ( VER_ECRAD == 140 )
+USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH
+#endif
#endif
-USE MODD_BLANK
+USE MODD_BLANK_n
USE MODD_FRC
USE MODD_PARAM_ICE
USE MODD_PARAM_C2R2
@@ -272,24 +264,31 @@ USE MODD_SALT
USE MODD_PASPOL
USE MODD_CONDSAMP
USE MODD_MEAN_FIELD
-USE MODD_DRAGTREE
-!
-!
-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_DRAGTREE_n
+USE MODD_DRAGBLDG_n
+USE MODD_EOL_MAIN
+USE MODD_EOL_ADNR
+USE MODD_EOL_ALM
+USE MODD_EOL_SHARED_IO
+USE MODD_ALLSTATION_n
+!
+!
+USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LSEDI, LHHONI, LSNOW, LHAIL, LMEYERS, &
+ NMOD_IFN, XIFN_CONC, LIFN_HOM, CIFN_SPECIES, &
+ CINT_MIXING, NMOD_IMM, NIND_SPECIE, &
+ CPRISTINE_ICE_LIMA, CHEVRIMED_ICE_LIMA, &
+ XFACTNUC_DEP, XFACTNUC_CON, &
+ OWARM=>LWARM, LACTI, ORAIN=>LRAIN, OSEDC=>LSEDC, &
+ OACTIT=>LACTIT, LBOUND, LSPRO, LADJ, &
+ NMOD_CCN, XCCN_CONC, &
+ LCCN_HOM, CCCN_MODES, &
+ YALPHAR=>XALPHAR, YNUR=>XNUR, &
+ YALPHAC=>XALPHAC, YNUC=>XNUC, CINI_CCN=>HINI_CCN, &
+ CTYPE_CCN=>HTYPE_CCN, YFSOLUB_CCN=>XFSOLUB_CCN, &
+ YACTEMP_CCN=>XACTEMP_CCN, YAERDIFF=>XAERDIFF, &
+ YAERHEIGHT=>XAERHEIGHT, &
+ LSCAV, LAERO_MASS, NPHILLIPS, &
+ ODEPOC=>LDEPOC, OVDEPOC=>XVDEPOC, OACTTKE=>LACTTKE, &
LPTSPLIT, L_LFEEDBACKT=>LFEEDBACKT, L_NMAXITER=>NMAXITER, &
L_XMRSTEP=>XMRSTEP, L_XTSTEP_TS=>XTSTEP_TS
!
@@ -299,6 +298,9 @@ USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
USE MODD_DRAG_n
USE MODD_VISCOSITY
+USE MODD_RECYCL_PARAM_n
+USE MODD_IBM_PARAM_n
+USE MODD_IBM_LSF
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
#endif
@@ -368,6 +370,7 @@ LUSERI = .FALSE.
LUSERS = .FALSE.
LUSERG = .FALSE.
LUSERH = .FALSE.
+LOCEAN = .FALSE.
!NSV = 0
!NSV_USER = 0
LUSECI = .FALSE.
@@ -500,7 +503,7 @@ NLBLY(:) = 1
XCPHASE = 20.
XCPHASE_PBL = 0.
XCARPKMAX = XUNDEF
-XPOND = 0.2
+XPOND = 1.0
!
!-------------------------------------------------------------------------------
!
@@ -525,17 +528,28 @@ XTNUDGING = 21600.
XIMPL = 1.
XKEMIN = 0.01
XCEDIS = 0.84
+XCADAP = 0.5
CTURBLEN = 'BL89'
CTURBDIM = '1DIM'
LTURB_FLX =.FALSE.
LTURB_DIAG=.FALSE.
LSUBG_COND=.FALSE.
CSUBG_AUCV='NONE'
+CSUBG_AUCV_RI='NONE'
LSIGMAS =.TRUE.
LSIG_CONV =.FALSE.
LRMC01 =.FALSE.
CTOM ='NONE'
VSIGQSAT = 0.02
+CCONDENS='CB02'
+CLAMBDA3='CB'
+CSUBG_MF_PDF='TRIANGLE'
+LHGRAD =.FALSE.
+XCOEFHGRADTHL = 1.0
+XCOEFHGRADRM = 1.0
+XALTHGRAD = 2000.0
+XCLDTHOLD = -1.0
+
!-------------------------------------------------------------------------------
!
!* 10b. SET DEFAULT VALUES FOR MODD_DRAGTREE :
@@ -544,6 +558,54 @@ VSIGQSAT = 0.02
LDRAGTREE = .FALSE.
LDEPOTREE = .FALSE.
XVDEPOTREE = 0.02 ! 2 cm/s
+!------------------------------------------------------------------------------
+!
+!* 10c. SET DEFAULT VALUES FOR MODD_DRAGB
+! ----------------------------------
+!
+LDRAGBLDG = .FALSE.
+!
+!* 10d. SET DEFAULT VALUES FOR MODD_EOL* :
+! ----------------------------------
+!
+! 10d.i) MODD_EOL_MAIN
+!
+LMAIN_EOL = .FALSE.
+CMETH_EOL = 'ADNR'
+CSMEAR = '3LIN'
+NMODEL_EOL = 1
+!
+! 10d.ii) MODD_EOL_SHARED_IO
+!
+CFARM_CSVDATA = 'data_farm.csv'
+CTURBINE_CSVDATA = 'data_turbine.csv'
+CBLADE_CSVDATA = 'data_blade.csv'
+CAIRFOIL_CSVDATA = 'data_airfoil.csv'
+!
+CINTERP = 'CLS'
+!
+! 10d.iii) MODD_EOL_ALM
+!
+NNB_BLAELT = 42
+LTIMESPLIT = .FALSE.
+LTIPLOSSG = .TRUE.
+LTECOUTPTS = .FALSE.
+!
+!------------------------------------------------------------------------------
+!* 10.e SET DEFAULT VALUES FOR MODD_ALLSTATION_n :
+! ----------------------------------
+!
+NNUMB_STAT = 0
+XSTEP_STAT = 60.0
+XX_STAT(:) = XUNDEF
+XY_STAT(:) = XUNDEF
+XZ_STAT(:) = XUNDEF
+XLAT_STAT(:) = XUNDEF
+XLON_STAT(:) = XUNDEF
+CNAME_STAT(:) = ''
+CTYPE_STAT(:) = ''
+CFILE_STAT = 'NO_INPUT_CSV'
+LDIAG_SURFRAD = .TRUE.
!
!-------------------------------------------------------------------------------
!
@@ -573,309 +635,6 @@ IF (KMI == 1) THEN
! 11.3 Variables for the mask
!
NBUMASK = 1
-!
-! 11.4 Variables for budget and processes choice
- LBU_RU = .FALSE.
- NASSEU = 0
- NNESTU = 0
- NADVU = 0
- NFRCU = 0
- NNUDU = 0
- NCURVU = 0
- NCORU = 0
- NDIFU = 0
- NRELU = 0
- NMAFLU = 0
- NDRAGU = 0
- NVTURBU = 0
- NHTURBU = 0
- NPRESU = 0
-!
-! Budget of RV
- LBU_RV = .FALSE.
- NASSEV = 0
- NNESTV = 0
- NADVV = 0
- NFRCV = 0
- NNUDV = 0
- NCURVV = 0
- NCORV = 0
- NDIFV = 0
- NRELV = 0
- NMAFLV = 0
- NDRAGV = 0
- NVTURBV = 0
- NHTURBV = 0
- NPRESV = 0
-!
-! Budget of RW
- LBU_RW = .FALSE.
- NASSEW = 0
- NNESTW = 0
- NADVW = 0
- NFRCW = 0
- NNUDW = 0
- NCURVW = 0
- NCORW = 0
- NGRAVW = 0
- NDIFW = 0
- NRELW = 0
- NVTURBW = 0
- NHTURBW = 0
- NPRESW = 0
-!
-! Budget of RTH
- LBU_RTH = .FALSE.
- NASSETH = 0
- NNESTTH = 0
- NADVTH = 0
- NFRCTH = 0
- NNUDTH = 0
- NPREFTH = 0
- NDIFTH = 0
- NRELTH = 0
- NRADTH = 0
- NDCONVTH = 0
- NMAFLTH = 0
- NVTURBTH = 0
- NHTURBTH = 0
- NDISSHTH = 0
- NNEGATH = 0
- NNEADVTH = 0
- NNETURTH = 0
- NNECONTH = 0
- NREVATH = 0
- NCONDTH = 0
- NHENUTH = 0
- NHONTH = 0
- NSFRTH = 0
- NDEPSTH = 0
- NDEPGTH = 0
- NREVATH = 0
- NRIMTH = 0
- NACCTH = 0
- NCFRZTH = 0
- NWETGTH = 0
- NDRYGTH = 0
- NWETHTH = 0
- NDRYHTH = 0
- NGMLTTH = 0
- NIMLTTH = 0
- NBERFITH = 0
- NCDEPITH = 0
- NHMLTTH = 0
- NCORRTH = 0
- NADJUTH = 0
-!
-! Budget of RTKE
- LBU_RTKE = .FALSE.
- NASSETKE = 0
- NADVTKE = 0
- NFRCTKE = 0
- NDIFTKE = 0
- NRELTKE = 0
- NDRAGTKE = 0
- NDPTKE = 0
- NTPTKE = 0
- NDISSTKE = 0
- NTRTKE = 0
-!
-! Budget of RRV
- LBU_RRV = .FALSE.
- NASSERV = 0
- NNESTRV = 0
- NADVRV = 0
- NFRCRV = 0
- NNUDRV = 0
- NDIFRV = 0
- NRELRV = 0
- NDCONVRV = 0
- NMAFLRV = 0
- NVTURBRV = 0
- NHTURBRV = 0
- NNEGARV = 0
- NNETURRV = 0
- NNECONRV = 0
- NNEADVRV = 0
- NREVARV = 0
- NCONDRV = 0
- NHENURV = 0
- NDEPSRV = 0
- NDEPGRV = 0
- NREVARV = 0
- NCDEPIRV = 0
- NCORRRV = 0
- NADJURV = 0
-!
-! Budget of RRC
- LBU_RRC = .FALSE.
- NASSERC = 0
- NNESTRC = 0
- NADVRC = 0
- NFRCRC = 0
- NDIFRC = 0
- NRELRC = 0
- NDCONVRC = 0
- NVTURBRC = 0
- NHTURBRC = 0
- NNEGARC = 0
- NNETURRC = 0
- NNECONRC = 0
- NNEADVRC = 0
- NACCRRC = 0
- NAUTORC = 0
- NCONDRC = 0
- NAUTORC = 0
- NACCRRC = 0
- NHONRC = 0
- NRIMRC = 0
- NCMELRC = 0
- NWETGRC = 0
- NDRYGRC = 0
- NIMLTRC = 0
- NBERFIRC = 0
- NCDEPIRC = 0
- NWETHRC = 0
- NDRYHRC = 0
- NCORRRC = 0
- NADJURC = 0
- NDEPORC = 0
- NDEPOTRRC = 0
-!
-! Budget of RRR
- LBU_RRR = .FALSE.
- NASSERR = 0
- NNESTRR = 0
- NADVRR = 0
- NFRCRR = 0
- NDIFRR = 0
- NRELRR = 0
- NNEGARR = 0
- NACCRRR = 0
- NAUTORR = 0
- NREVARR = 0
- NSEDIRR = 0
- NSFRRR = 0
- NACCRR = 0
- NCMELRR = 0
- NCFRZRR = 0
- NWETGRR = 0
- NDRYGRR = 0
- NGMLTRR = 0
- NWETHRR = 0
- NDRYHRR = 0
- NHMLTRR = 0
- NCORRRR = 0
-!
-! Budget of RRI
- LBU_RRI = .FALSE.
- NASSERI = 0
- NNESTRI = 0
- NADVRI = 0
- NFRCRI = 0
- NDIFRI = 0
- NRELRI = 0
- NDCONVRI = 0
- NVTURBRI = 0
- NHTURBRI = 0
- NNEGARI = 0
- NSEDIRI = 0
- NHENURI = 0
- NHONRI = 0
- NAGGSRI = 0
- NAUTSRI = 0
- NCFRZRI = 0
- NWETGRI = 0
- NDRYGRI = 0
- NIMLTRI = 0
- NBERFIRI = 0
- NCDEPIRI = 0
- NWETHRI = 0
- NDRYHRI = 0
- NCORRRI = 0
- NADJURI = 0
-!
-! Budget of RRS
- LBU_RRS = .FALSE.
- NASSERS = 0
- NNESTRS = 0
- NADVRS = 0
- NFRCRS = 0
- NDIFRS = 0
- NRELRS = 0
- NNEGARS = 0
- NSEDIRS = 0
- NDEPSRS = 0
- NAGGSRS = 0
- NAUTSRS = 0
- NRIMRS = 0
- NACCRS = 0
- NCMELRS = 0
- NWETGRS = 0
- NDRYGRS = 0
- NWETHRS = 0
- NDRYHRS = 0
- NCORRRS = 0
-!
-! Budget of RRG
- LBU_RRG = .FALSE.
- NASSERG = 0
- NNESTRG = 0
- NADVRG = 0
- NFRCRG = 0
- NDIFRG = 0
- NRELRG = 0
- NNEGARG = 0
- NSEDIRG = 0
- NSFRRG = 0
- NDEPGRG = 0
- NRIMRG = 0
- NACCRG = 0
- NCMELRG = 0
- NCFRZRG = 0
- NWETGRG = 0
- NDRYGRG = 0
- NGMLTRG = 0
- NWETHRG = 0
- NDRYHRG = 0
- NCORRRG = 0
- NHGCVRG = 0
- NGHCVRG = 0
-!
-! Budget of RRH
- LBU_RRH = .FALSE.
- NASSERH = 0
- NNESTRH = 0
- NADVRH = 0
- NFRCRH = 0
- NDIFRH = 0
- NRELRH = 0
- NNEGARH = 0
- NWETGRH = 0
- NWETHRH = 0
- NDRYHRH = 0
- NHMLTRH = 0
- NCORRRH = 0
- NHGCVRH = 0
- NGHCVRH = 0
-!
-! Budget of RSVx
- LBU_RSV = .FALSE.
- NASSESV = 0
- NNESTSV = 0
- NADVSV = 0
- NFRCSV = 0
- NDIFSV = 0
- NRELSV = 0
- NDCONVSV = 0
- NMAFLSV = 0
- NVTURBSV = 0
- NHTURBSV = 0
- NCHEMSV = 0
- NNEGASV = 0
- NDEPOTRSV = 0
-!
-!
END IF
!
!-------------------------------------------------------------------------------
@@ -968,8 +727,27 @@ LFIX_DAT=.FALSE.
!* 13bis. SET DEFAULT VALUES FOR MODD_PARAM_ECRAD_n :
! ---------------------------------------
!
+#if ( VER_ECRAD == 101 )
NSWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
NLWSOLVER = 0 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+#endif
+#if ( VER_ECRAD == 140 )
+LSPEC_ALB = .FALSE.
+LSPEC_EMISS = .FALSE.
+
+
+!ALLOCATE(USER_ALB_DIFF(NSWB_MNH))
+!ALLOCATE(USER_ALB_DIR(NSWB_MNH))
+!ALLOCATE(USER_EMISS(NLWB_MNH))
+!PRINT*,USER_ALB_DIFF
+!USER_ALB_DIFF = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+!USER_ALB_DIR = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+!USER_EMISS = (/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/)
+SURF_TYPE="SNOW"
+
+NLWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+NSWSOLVER = 1 ! 0: 'McICA 1: 'SPARTACUS' 2: 'SPARTACUS' + 3D effect
+#endif
! LEFF3D = .TRUE.
! LSIDEM = .TRUE.
NREG = 3 ! Number of cloudy regions (3=TripleClouds)
@@ -991,50 +769,44 @@ XCLOUD_FRAC_STD = 1.0_JPRB ! change to 0.75 for more realistic distribution
#endif
!-------------------------------------------------------------------------------
!
-!* 14. SET DEFAULT VALUES FOR MODD_BLANK :
+!* 14. SET DEFAULT VALUES FOR MODD_BLANK_n :
! -----------------------------------
!
-IF (KMI == 1) THEN
- XDUMMY1 = 0.
- XDUMMY2 = 0.
- XDUMMY3 = 0.
- XDUMMY4 = 0.
- XDUMMY5 = 0.
- XDUMMY6 = 0.
- XDUMMY7 = 0.
- XDUMMY8 = 0.
- XDUMMY=0.
-!
- NDUMMY1 = 0
- NDUMMY2 = 0
- NDUMMY3 = 0
- NDUMMY4 = 0
- NDUMMY5 = 0
- NDUMMY6 = 0
- NDUMMY7 = 0
- NDUMMY8 = 0
- NDUMMY=0
-!
- LDUMMY1 = .TRUE.
- LDUMMY2 = .TRUE.
- LDUMMY3 = .TRUE.
- LDUMMY4 = .TRUE.
- LDUMMY5 = .TRUE.
- LDUMMY6 = .TRUE.
- LDUMMY7 = .TRUE.
- LDUMMY8 = .TRUE.
- LDUMMY=.TRUE.
-!
- CDUMMY1 = ' '
- CDUMMY2 = ' '
- CDUMMY3 = ' '
- CDUMMY4 = ' '
- CDUMMY5 = ' '
- CDUMMY6 = ' '
- CDUMMY7 = ' '
- CDUMMY8 = ' '
- CDUMMY= ' '
-END IF
+XDUMMY1 = 0.
+XDUMMY2 = 0.
+XDUMMY3 = 0.
+XDUMMY4 = 0.
+XDUMMY5 = 0.
+XDUMMY6 = 0.
+XDUMMY7 = 0.
+XDUMMY8 = 0.
+!
+NDUMMY1 = 0
+NDUMMY2 = 0
+NDUMMY3 = 0
+NDUMMY4 = 0
+NDUMMY5 = 0
+NDUMMY6 = 0
+NDUMMY7 = 0
+NDUMMY8 = 0
+!
+LDUMMY1 = .TRUE.
+LDUMMY2 = .TRUE.
+LDUMMY3 = .TRUE.
+LDUMMY4 = .TRUE.
+LDUMMY5 = .TRUE.
+LDUMMY6 = .TRUE.
+LDUMMY7 = .TRUE.
+LDUMMY8 = .TRUE.
+!
+CDUMMY1 = ' '
+CDUMMY2 = ' '
+CDUMMY3 = ' '
+CDUMMY4 = ' '
+CDUMMY5 = ' '
+CDUMMY6 = ' '
+CDUMMY7 = ' '
+CDUMMY8 = ' '
!
!------------------------------------------------------------------------------
!
@@ -1049,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"
@@ -1056,6 +829,11 @@ IF (KMI == 1) THEN
XUTRANS = 0.0
XVTRANS = 0.0
LPGROUND_FRC = .FALSE.
+ LDEEPOC = .FALSE.
+ XCENTX_OC = 16000.
+ XCENTY_OC = 16000.
+ XRADX_OC = 8000.
+ XRADY_OC = 8000.
END IF
!
!-------------------------------------------------------------------------------
@@ -1065,7 +843,7 @@ END IF
! ---------------------------------------
!
IF (KMI == 1) THEN
- LRED = .FALSE.
+ LRED = .TRUE.
LWARM = .TRUE.
CPRISTINE_ICE = 'PLAT'
LSEDIC = .TRUE.
@@ -1149,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
!
!-------------------------------------------------------------------------------
@@ -1209,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.
@@ -1243,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'
@@ -1496,5 +1276,129 @@ IF (KMI == 1) THEN
XHSTART = 0.
ENDIF
!
+!-------------------------------------------------------------------------------
+!
+!* 31. SET DEFAULT VALUES FOR MODD_IBM_PARAMn
+! --------------------------------------
+!
+ LIBM = .FALSE.
+ LIBM_TROUBLE = .FALSE.
+ CIBM_ADV = 'NOTHIN'
+ XIBM_EPSI = 1.E-9
+ XIBM_IEPS = 1.E+9
+ NIBM_ITR = 8
+ XIBM_RUG = 0.01 ! (m^1.s^-0)
+ XIBM_VISC = 1.56e-5 ! (m^2.s^-1)
+ XIBM_CNU = 0.06 ! (m^0.s^-0)
+
+ NIBM_LAYER_P = 2
+ NIBM_LAYER_Q = 2
+ NIBM_LAYER_R = 2
+ NIBM_LAYER_S = 2
+ NIBM_LAYER_T = 2
+ NIBM_LAYER_E = 2
+ NIBM_LAYER_V = 2
+
+ XIBM_RADIUS_P = 2.
+ XIBM_RADIUS_Q = 2.
+ XIBM_RADIUS_R = 2.
+ XIBM_RADIUS_S = 2.
+ XIBM_RADIUS_T = 2.
+ XIBM_RADIUS_E = 2.
+ XIBM_RADIUS_V = 2.
+
+ XIBM_POWERS_P = 1.
+ XIBM_POWERS_Q = 1.
+ XIBM_POWERS_R = 1.
+ XIBM_POWERS_S = 1.
+ XIBM_POWERS_T = 1.
+ XIBM_POWERS_E = 1.
+ XIBM_POWERS_V = 1.
+
+ CIBM_MODE_INTE3_P = 'LAI'
+ CIBM_MODE_INTE3_Q = 'LAI'
+ CIBM_MODE_INTE3_R = 'LAI'
+ CIBM_MODE_INTE3_S = 'LAI'
+ CIBM_MODE_INTE3_T = 'LAI'
+ CIBM_MODE_INTE3_E = 'LAI'
+ CIBM_MODE_INTE3_V = 'LAI'
+
+ CIBM_MODE_INTE1_P = 'CL2'
+ CIBM_MODE_INTE1_Q = 'CL2'
+ CIBM_MODE_INTE1_R = 'CL2'
+ CIBM_MODE_INTE1_S = 'CL2'
+ CIBM_MODE_INTE1_T = 'CL2'
+ CIBM_MODE_INTE1_E = 'CL2'
+ CIBM_MODE_INTE1NV = 'CL2'
+ CIBM_MODE_INTE1TV = 'CL2'
+ CIBM_MODE_INTE1CV = 'CL2'
+
+ CIBM_MODE_BOUND_P = 'SYM'
+ CIBM_MODE_BOUND_Q = 'SYM'
+ CIBM_MODE_BOUND_R = 'SYM'
+ CIBM_MODE_BOUND_S = 'SYM'
+ CIBM_MODE_BOUND_T = 'SYM'
+ CIBM_MODE_BOUND_E = 'SYM'
+ CIBM_MODE_BOUNT_V = 'ASY'
+ CIBM_MODE_BOUNN_V = 'ASY'
+ CIBM_MODE_BOUNC_V = 'ASY'
+
+ XIBM_FORC_BOUND_P = 0.
+ XIBM_FORC_BOUND_Q = 0.
+ XIBM_FORC_BOUND_R = 0.
+ XIBM_FORC_BOUND_S = 0.
+ XIBM_FORC_BOUND_T = 0.
+ XIBM_FORC_BOUND_E = 0.
+ XIBM_FORC_BOUNN_V = 0.
+ XIBM_FORC_BOUNT_V = 0.
+ XIBM_FORC_BOUNC_V = 0.
+
+ CIBM_TYPE_BOUND_P = 'NEU'
+ CIBM_TYPE_BOUND_Q = 'NEU'
+ CIBM_TYPE_BOUND_R = 'NEU'
+ CIBM_TYPE_BOUND_S = 'NEU'
+ CIBM_TYPE_BOUND_T = 'NEU'
+ CIBM_TYPE_BOUND_E = 'NEU'
+ CIBM_TYPE_BOUNT_V = 'DIR'
+ CIBM_TYPE_BOUNN_V = 'DIR'
+ CIBM_TYPE_BOUNC_V = 'DIR'
+
+ CIBM_FORC_BOUND_P = 'CST'
+ CIBM_FORC_BOUND_Q = 'CST'
+ CIBM_FORC_BOUND_R = 'CST'
+ CIBM_FORC_BOUND_S = 'CST'
+ CIBM_FORC_BOUND_T = 'CST'
+ CIBM_FORC_BOUND_E = 'CST'
+ CIBM_FORC_BOUNN_V = 'CST'
+ CIBM_FORC_BOUNT_V = 'CST'
+ CIBM_FORC_BOUNC_V = 'CST'
+ CIBM_FORC_BOUNR_V = 'CST'
+
+!
+!-------------------------------------------------------------------------------
+!
+!* 32. SET DEFAULT VALUES FOR MODD_RECYCL_PARAMn
+! --------------------------------------
+!
+ LRECYCL = .FALSE.
+ LRECYCLN = .FALSE.
+ LRECYCLW = .FALSE.
+ LRECYCLE = .FALSE.
+ LRECYCLS = .FALSE.
+ XDRECYCLN = 0.
+ XARECYCLN = 0.
+ XDRECYCLW = 0.
+ XARECYCLW = 0.
+ XDRECYCLS = 0.
+ XARECYCLS = 0.
+ XDRECYCLE = 0.
+ XARECYCLE = 0.
+ XTMOY = 0.
+ XTMOYCOUNT = 0.
+ XNUMBELT = 28.
+ XRCOEFF = 0.2
+ XTBVTOP = 500.
+ XTBVBOT = 300.
+!
!
END SUBROUTINE DEFAULT_DESFM_n
diff --git a/src/MNH/default_expre.f90 b/src/MNH/default_expre.f90
index 6c158a6c4e3d218dbae5664a8d1b8ebc00f8a0bf..b3c6d1d1a1f44232c5dd5047bca3b918f4eea2aa 100644
--- a/src/MNH/default_expre.f90
+++ b/src/MNH/default_expre.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 prep_ideal 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #########################
MODULE MODI_DEFAULT_EXPRE
! #########################
@@ -95,6 +90,7 @@ END MODULE MODI_DEFAULT_EXPRE
!! add the uniform soil values 05/02/96 (J.Stein)
!! removes default values for ground variables 26/11/96 (V.Masson)
!! add default value for LBOUSS 11/07/13 (C.Lac)
+!! add default value LOCEAN LCOUPLES /03/21 (JL Redelsperger)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -103,6 +99,7 @@ USE MODD_CONF ! declarative modules
USE MODD_DIM_n
USE MODD_GRID
USE MODD_REF
+USE MODD_DYN_n, ONLY : LOCEAN
!
IMPLICIT NONE
!
@@ -140,7 +137,9 @@ XLATORI = 37.
!* 4. SET DEFAULT VALUES FOR MODD_REF :
! --------------------------------
!
-LBOUSS = .FALSE.
+LBOUSS = .FALSE.
+LOCEAN = .FALSE.
+LCOUPLES= .FALSE.
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/dflux_corr.f90 b/src/MNH/dflux_corr.f90
deleted file mode 100644
index fec030ec7aa25c9434f803dea97a2853cf983a1d..0000000000000000000000000000000000000000
--- a/src/MNH/dflux_corr.f90
+++ /dev/null
@@ -1,307 +0,0 @@
-!MNH_LIC Copyright 1998-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ##########################
- MODULE MODI_DFLUX_CORR
-! ##########################
-!
-INTERFACE
-!
-! ######################################################################
- SUBROUTINE DFLUX_CORR ( HLBCX, HLBCY, PTSTEP, PMIN, &
- PRHODJ, PAM, PAT, PRUCT, PRVCT, PRWCT, &
- PFX, PFY, PFZ)
-! ######################################################################
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-REAL, INTENT(IN) :: PTSTEP ! Double time step
-REAL, INTENT(IN) :: PMIN
- ! Absolute minimum variable
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
- ! (Rho) dry *jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAM
- ! Variable at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAT
- ! Variable at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! Contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX, PFY, PFZ
- ! Flux components
-!
-END SUBROUTINE DFLUX_CORR
-!
-END INTERFACE
-!
-END MODULE MODI_DFLUX_CORR
-!
-!
-!
-! ######################################################################
- SUBROUTINE DFLUX_CORR ( HLBCX, HLBCY, PTSTEP, PMIN, &
- PRHODJ, PAM, PAT, PRUCT, PRVCT, PRWCT, &
- PFX, PFY, PFZ)
-! ######################################################################
-!
-!!**** *DFLUX_CORR* - calculates the advective tendencies fluxes by means of
-!! the Directional Flux-Corrected Transport and
-!! the Flux-Corrected Transport advection schemes
-!!
-!! PURPOSE
-!! -------
-!!
-!! The purpose of the routine is to calculate the advection of a scalar.
-!! A centred advection scheme is used (leapfrog). Two corrections of
-!! the fluxes are is applied (DFCT and FCT) to insure that the total
-!! resulting scheme is positive definite.
-!! The advection scheme is second-order on time and on space.
-!
-!!** METHOD
-!! ------
-!!
-!! First, the advective flux is calculated. Second the flux is corrected
-!! using the Directional-Flux-Corrected Transport method.
-!! Second, the advective flux is calculated. Eventually the flux is corrected
-!! using the Flux-Corrected Transport method. This method implies the
-!! calculation of one limiting factors: BETAOUT. The
-!! first factor insures that the calculated flux is less than its respective
-!! analytical value (nonoscillatory condition).
-!!
-!! EXTERNAL
-!! --------
-!! GET_DIM_EXT_ll : get extended sub-domain sizes
-!! ADD3DFIELD_ll : add a field to 3D-list
-!! UPDATE_HALO_ll : update internal halos
-!! UPDATE_BOUNDARIES_ll : update external boundaries
-!! LWEAST_ll,LEAST_ll,LNORTH_ll,LSOUTH_ll : position functions
-!! MXM,MYM,MZM : Shuman functions (mean operators)
-!! DXF,DYF,DZF : Shuman functions (finite difference operators)
-!! CLEANLIST_ll : deaalocate a list
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! JPHEXT, JPVEXT
-!! MODD CONF:CCONF
-!!
-!! REFERENCE
-!! ---------
-!! Book1 of documentation (FCT scheme)
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Lafore *Meteo-France*
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! original 27/03/98
-!! V. Masson 24/11/97 removes the DO loops
-!! P. Jabouille 24/09/98 parallelize the code
-!! J. Stein 05/04/99 : bug for the case PMIN /= 0 + lbc
-!! JP Pinty & 12/10/98 : Vectorization of the first loops
-!! J Escobar
-!! J. Stein & 20/03/01 : bug for the open case at the boundary
-!! P. Jabouille
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_CONF
-USE MODD_PARAMETERS
-USE MODI_SHUMAN
-!
-IMPLICIT NONE
-!
-!* 0.1 DECLARATIONS OF ARGUMENTS
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-!
-REAL, INTENT(IN) :: PTSTEP
- ! Double Time step
-REAL, INTENT(IN) :: PMIN
- ! Absolute minimum variable
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
- ! (Rho) dry *jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAM
- ! Variable at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PAT
- ! Variable at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT ! contravariant
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVCT ! components
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRWCT ! of momentum
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX, PFY, PFZ
- ! Flux component
-!
-!* 0.2 DECLARATIONS OF LOCAL VARIABLES
-!
-!
-INTEGER:: IIU,IJU,IKU ! Size array in the x, y,
- ! and z directions
-INTEGER:: JI,JJ,JK ! Loop index in the x, y,
- ! and z directions
-REAL :: ZEPSILON ! Variable to ensure that the
- ! limiting factor is zero
-!
-!
-REAL,DIMENSION(SIZE(PAT,1),SIZE(PAT,2),SIZE(PAT,3)):: ZFOUT
- ! The outgoing flux of the grid cell
- ! (located at mass point)
-REAL,DIMENSION(SIZE(PAT,1),SIZE(PAT,2),SIZE(PAT,3)):: ZBETAOUT
- ! The outgoing limiting factor
-INTEGER :: IINFO_ll ! return code of parallel routine
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-!
-!* 0.3 PROLOGUE
-!
-NULLIFY(TZFIELDS_ll)
-!
-CALL GET_DIM_EXT_ll ('B',IIU,IJU)
-IKU=SIZE(PRUCT,3)
-!
-ZEPSILON=1.0E-15
-!
-!------------------------------------------------------------------------------
-!
-!
-!* 1. First limitation on a directional base
-! --------------------------------------
-!
-ZBETAOUT(:,:,:) = -PRHODJ(:,:,:)*(PAM(:,:,:)-PMIN)/PTSTEP ! First limiter
-!
-!* 1.1 X-direction
-!
-ZFOUT(2:IIU,:,:) = -ZBETAOUT(1:IIU-1,:,:) ! Second limiter
-ZFOUT(1,:,:) = 0.0
-!
-PFX(:,:,:) = PRUCT(:,:,:) * MXM (PAT(:,:,:))
-PFX(:,:,:) = (0.5+SIGN(0.5,PRUCT(:,:,:)))*MIN( PFX(:,:,:),ZFOUT(:,:,:) ) &
- +(0.5-SIGN(0.5,PRUCT(:,:,:)))*MAX( PFX(:,:,:),ZBETAOUT(:,:,:) )
-!
-!* 1.2 Y-direction
-!
-ZFOUT(:,2:IJU,:) = -ZBETAOUT(:,1:IJU-1,:) ! Second limiter
-ZFOUT(:,1,:) = 0.0
-!
-PFY(:,:,:) = PRVCT(:,:,:) * MYM (PAT(:,:,:))
-PFY(:,:,:) = (0.5+SIGN(0.5,PRVCT(:,:,:)))*MIN( PFY(:,:,:),ZFOUT(:,:,:) ) &
- +(0.5-SIGN(0.5,PRVCT(:,:,:)))*MAX( PFY(:,:,:),ZBETAOUT(:,:,:) )
-!
-!* 1.3 Z-direction
-!
-ZFOUT(:,:,2:IKU) = -ZBETAOUT(:,:,1:IKU-1) ! Second limiter
-ZFOUT(:,:,1) = 0.0
-!
-PFZ(:,:,:) = PRWCT(:,:,:) * MZM (PAT(:,:,:))
-PFZ(:,:,:) = (0.5+SIGN(0.5,PRWCT(:,:,:)))*MIN( PFZ(:,:,:),ZFOUT(:,:,:) ) &
- +(0.5-SIGN(0.5,PRWCT(:,:,:)))*MAX( PFZ(:,:,:),ZBETAOUT(:,:,:) )
-!
-!
-!------------------------------------------------------------------------------
-!* 3. Flux-OUT calculation
-! ---------------------
-!
-DO JK=2,IKU-1
- DO JJ=2,IJU-1
- DO JI=2,IIU-1
- ZFOUT(JI,JJ,JK) = MAX(0.,PFX(JI+1,JJ,JK)) &
- - MIN(0.,PFX(JI, JJ,JK)) &
- + MAX(0.,PFY(JI,JJ+1,JK)) &
- - MIN(0.,PFY(JI,JJ ,JK)) &
- + MAX(0.,PFZ(JI,JJ,JK+1)) &
- - MIN(0.,PFZ(JI,JJ,JK ))
- END DO
- END DO
-END DO
-!
-!
-!------------------------------------------------------------------------------
-!* 4. BETAOUT calculation
-! -------------------
-ZBETAOUT(:,:,:) =(PAM(:,:,:)-PMIN)/ &
- (PTSTEP*ZFOUT(:,:,:)/PRHODJ(:,:,:)+ZEPSILON)
-!
-ZBETAOUT(:,:,1) = 1. ! no limitation outside the physical domain
-ZBETAOUT(:,:,IKU) = 1. ! because no velocity is available
-!
-!
-! Update halo and apply possible cyclic boundary conditions
-!
-!!$IF(NHALO == 1 .OR. HLBCX(1)=='CYCL' .OR. HLBCY(1)=='CYCL') THEN
-IF(HLBCX(1)=='CYCL' .OR. HLBCY(1)=='CYCL') THEN
- CALL ADD3DFIELD_ll( TZFIELDS_ll, ZBETAOUT, 'DFLUX_CORR::ZBETAOUT' )
-!!$ IF(NHALO == 1) THEN
- CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-!!$ ELSE
-!!$ IF(HLBCX(1)=='CYCL') CALL UPDATE_BOUNDARIES_ll('XX',TZFIELDS_ll,IINFO_ll)
-!!$ IF(HLBCY(1)=='CYCL') CALL UPDATE_BOUNDARIES_ll('YY',TZFIELDS_ll,IINFO_ll)
-!!$ END IF
- CALL CLEANLIST_ll(TZFIELDS_ll)
-ENDIF
-!
-!
-IF (HLBCX(1)/='CYCL') THEN
- IF (LWEST_ll( )) ZBETAOUT(1,:,:) = 1. ! no limitation outside the physical domain
- IF (LEAST_ll( )) ZBETAOUT(IIU,:,:) = 1. ! because no velocity is available
-END IF
-!
-IF (HLBCY(1)/='CYCL') THEN
- IF (LSOUTH_ll( )) ZBETAOUT(:,1,:) = 1. ! no limitation outside the physical domain
- IF (LNORTH_ll( )) ZBETAOUT(:,IJU,:) = 1. ! because no velocity is available
-END IF
-!
-!
-!------------------------------------------------------------------------------
-!* 4. Second Flux limitation
-! ----------------------
-!
-!
- ! x-component
- !
-ZFOUT(2:IIU,:,:) = ZBETAOUT(1:IIU-1,:,:)
-PFX(:,:,:) = MIN(1., ZFOUT(:,:,:)) * MAX(0.,PFX(:,:,:)) &
- + MIN(1., ZBETAOUT(:,:,:)) * MIN(0.,PFX(:,:,:))
- ! y-component
- !
-ZFOUT(:,2:IJU,:) = ZBETAOUT(:,1:IJU-1,:)
-PFY(:,:,:) = MIN(1., ZFOUT(:,:,:)) * MAX(0.,PFY(:,:,:)) &
- + MIN(1., ZBETAOUT(:,:,:)) * MIN(0.,PFY(:,:,:))
- ! z-component
- !
-ZFOUT(:,:,2:IKU) = ZBETAOUT(:,:,1:IKU-1)
-PFZ(:,:,:) = MIN(1., ZFOUT(:,:,:)) * MAX(0.,PFZ(:,:,:)) &
- + MIN(1., ZBETAOUT(:,:,:)) * MIN(0.,PFZ(:,:,:))
-!
-!------------------------------------------------------------------------------
-!
-!* 5. Boundary conditions for the flux cyclic case
-! --------------------------------------------
-!
- ! x-direction
-IF (HLBCX(1)=='CYCL') THEN
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PFX, 'DFLUX_CORR::PFX' )
- CALL UPDATE_BOUNDARIES_ll('XX',TZFIELDS_ll, IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-ENDIF
- ! y-direction
-IF (HLBCY(1)=='CYCL') THEN
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PFY, 'DFLUX_CORR::PFY' )
- CALL UPDATE_BOUNDARIES_ll('YY',TZFIELDS_ll, IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-ENDIF
-!
-!
-!------------------------------------------------------------------------------
-END SUBROUTINE DFLUX_CORR
diff --git a/src/MNH/diag.f90 b/src/MNH/diag.f90
index 8a2502ed39a3ea995f051f66f54b1660c048f86e..4bfd2dc5e8e8453068b95e8dc0ae6f41c16faa3e 100644
--- a/src/MNH/diag.f90
+++ b/src/MNH/diag.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1999-2019 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.
@@ -92,6 +92,8 @@
! P. Wautelet 11/02/2019: added missing use of MODI_CH_MONITOR_n
! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
! P. Wautelet 26/07/2019: bug correction: deallocate of zsea and ztown done too early
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -140,31 +142,34 @@ USE MODD_TURB_n
USE MODD_VAR_ll
!
USE MODE_DATETIME
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
USE MODE_IO_FIELD_WRITE, only: IO_Header_write
USE MODE_IO, only: IO_Config_set, IO_Init
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list,IO_Filelist_print
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_ll
+#ifdef MNH_IOLFI
+use mode_menu_diachro, only: MENU_DIACHRO
+#endif
USE MODE_MNH_TIMING
USE MODE_MODELN_HANDLER
USE MODE_MSG
USE MODE_POS
USE MODE_TIME
+use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
!
USE MODI_AIRCRAFT_BALLOON
USE MODI_CH_MONITOR_n
USE MODI_COMPUTE_R00
USE MODI_DIAG_SURF_ATM_N
USE MODI_INIT_MNH
-USE MODI_MENU_DIACHRO
USE MODI_MNHGET_SURF_PARAM_n
USE MODI_PHYS_PARAM_n
USE MODI_VERSION
USE MODI_WRITE_AIRCRAFT_BALLOON
-USE MODI_WRITE_DIAG_SURF_ATM_N
+USE MODI_WRITE_DIAG_SURF_ATM_N
USE MODI_WRITE_LFIFM1_FOR_DIAG
USE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
-USE MODI_WRITE_LFIFMN_FORDIACHRO_n
USE MODI_WRITE_SURF_ATM_N
!
USE MODN_CONFIO, ONLY: NAM_CONFIO
@@ -177,6 +182,7 @@ IMPLICIT NONE
!* 0.1 declarations of local variables
!
TYPE(DATE_TIME) :: TXDTBAL ! current time and date for BALLOON and AIRCRAFT trajectories
+TYPE(DATE_TIME) :: TPDTCUR_SAVE
CHARACTER (LEN=28), DIMENSION(1) :: YINIFILE ! names of the INPUT FM-file
CHARACTER (LEN=28), DIMENSION(1) :: YINIFILEPGD ! names of the INPUT FM-file
CHARACTER (LEN=5) :: YSUFFIX ! character string for the OUTPUT FM-file number
@@ -186,10 +192,9 @@ CHARACTER (LEN=4) :: YTURB ! initial flag to call to turbulence schemes
! CHARACTER (LEN=40) :: YFMT,YFMT2! format for cpu analysis printing
INTEGER :: ILUOUT0 ! Logical unit number for the output listing
REAL(kind=MNHTIME), DIMENSION(2) :: ZTIME0, ZTIME1, ZTIME2, ZRAD, ZDCONV, ZSHADOWS, ZGROUND, &
- ZTRACER, ZDRAG, ZTURB, ZMAFL, ZCHEM, ZTIME_BU ! CPU times
+ ZTRACER, ZDRAG, ZTURB, ZMAFL, ZCHEM, ZTIME_BU, ZEOL ! CPU times
REAL(kind=MNHTIME), DIMENSION(2) :: ZSTART, ZINIT, ZWRIT, ZBALL, ZPHYS, ZSURF, ZWRITS, ZTRAJ ! storing variables
INTEGER(KIND=LFIINT) :: INPRAR ! number of articles predicted in the LFIFM file
-LOGICAL :: GCLOSE_OUT = .FALSE. ! conditional closure of the OUTPUT FM-file
INTEGER :: ISTEPBAL ! loop indice for balloons and aircraft
INTEGER :: ILUNAM ! Logical unit numbers for the namelist file
! and for output_listing file
@@ -200,7 +205,6 @@ LOGICAL:: GCLOUD_ONLY ! conditionnal radiation computations for
! the only cloudy columns
!
INTEGER :: IIU, IJU, IKU
-INTEGER :: IINFO_ll ! return code for _ll routines
REAL, DIMENSION(:,:),ALLOCATABLE :: ZSEA,ZTOWN
REAL, DIMENSION(:,:,:,:),ALLOCATABLE :: ZWETDEPAER
!
@@ -533,11 +537,14 @@ IF ( LAIRCRAFT_BALLOON ) THEN
WRITE(ILUOUT0,*) 'DIAG AFTER OPEN DIACHRONIC FILE'
WRITE(ILUOUT0,*) ' '
!
- TXDTBAL%TDATE%YEAR = TDTCUR%TDATE%YEAR
- TXDTBAL%TDATE%MONTH = TDTCUR%TDATE%MONTH
- TXDTBAL%TDATE%DAY = TDTCUR%TDATE%DAY
- TXDTBAL%TIME = TDTCUR%TIME - NTIME_AIRCRAFT_BALLOON/2.
+ TPDTCUR_SAVE = TDTCUR
+!
+ TXDTBAL%nyear = TDTCUR%nyear
+ TXDTBAL%nmonth = TDTCUR%nmonth
+ TXDTBAL%nday = TDTCUR%nday
+ TXDTBAL%xtime = TDTCUR%xtime - NTIME_AIRCRAFT_BALLOON/2.
CALL DATETIME_CORRECTDATE(TXDTBAL)
+ TDTCUR = TXDTBAL !TDTCUR is used in AIRCRAFT_BALLOON
!
ALLOCATE (ZSEA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
ALLOCATE (ZTOWN(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
@@ -546,19 +553,24 @@ IF ( LAIRCRAFT_BALLOON ) THEN
CALL MNHGET_SURF_PARAM_n (PSEA=ZSEA(:,:),PTOWN=ZTOWN(:,:))
DO ISTEPBAL=1,NTIME_AIRCRAFT_BALLOON,INT(XSTEP_AIRCRAFT_BALLOON)
CALL AIRCRAFT_BALLOON(XSTEP_AIRCRAFT_BALLOON, &
- TDTEXP, TDTMOD, TDTCUR, TXDTBAL, &
XXHAT, XYHAT, XZZ, XMAP, XLONORI, XLATORI, &
XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, &
XTKET, XTSRAD, XRHODREF,XCIT,ZSEA)
-!
- TXDTBAL%TIME=TXDTBAL%TIME + XSTEP_AIRCRAFT_BALLOON
+
+ TXDTBAL%xtime = TXDTBAL%xtime + XSTEP_AIRCRAFT_BALLOON
CALL DATETIME_CORRECTDATE(TXDTBAL)
+ TDTCUR = TXDTBAL !TDTCUR is used in AIRCRAFT_BALLOON
ENDDO
DEALLOCATE (ZSEA,ZTOWN)
+!
+ TDTCUR = TPDTCUR_SAVE
+!
CALL IO_Header_write(TZDIACFILE)
CALL WRITE_LFIFMN_FORDIACHRO_n(TZDIACFILE)
CALL WRITE_AIRCRAFT_BALLOON(TZDIACFILE)
+#ifdef MNH_IOLFI
CALL MENU_DIACHRO(TZDIACFILE,'END')
+#endif
CALL IO_File_close(TZDIACFILE)
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) 'DIAG AFTER CLOSE DIACHRONIC FILE'
@@ -671,7 +683,6 @@ END IF
!
!* call to physics monitor
!
-GCLOSE_OUT=.TRUE.
ZRAD = 0.0_MNHTIME
ZSHADOWS = 0.0_MNHTIME
ZDCONV = 0.0_MNHTIME
@@ -681,12 +692,13 @@ ZTURB = 0.0_MNHTIME
ZDRAG = 0.0_MNHTIME
ZMAFL = 0.0_MNHTIME
ZCHEM = 0.0_MNHTIME
+ZEOL = 0.0_MNHTIME
XTIME_LES = 0.0_MNHTIME
XTIME_LES_BU_PROCESS = 0.0_MNHTIME
XTIME_BU_PROCESS = 0.0_MNHTIME
-CALL PHYS_PARAM_n(1,TOUTDATAFILE,GCLOSE_OUT, &
- ZRAD,ZSHADOWS,ZDCONV,ZGROUND,ZMAFL,ZDRAG, &
- ZTURB,ZTRACER, ZTIME_BU,ZWETDEPAER,GMASKkids,GCLOUD_ONLY)
+CALL PHYS_PARAM_n( 1, TOUTDATAFILE, &
+ ZRAD, ZSHADOWS, ZDCONV, ZGROUND, ZMAFL, ZDRAG,ZEOL, &
+ ZTURB, ZTRACER, ZTIME_BU, ZWETDEPAER, GMASKkids, GCLOUD_ONLY )
WRITE(ILUOUT0,*) 'DIAG AFTER PHYS_PARAM1'
IF (LCHEMDIAG) THEN
CALL CH_MONITOR_n(ZWETDEPAER,1,XTSTEP, ILUOUT0, NVERB)
@@ -747,11 +759,8 @@ ZTIME1=ZTIME2
!
DEALLOCATE(GMASKkids)
DEALLOCATE(ZWETDEPAER)
-IF (GCLOSE_OUT) THEN
- GCLOSE_OUT=.FALSE.
- CALL IO_File_close(TOUTDATAFILE)
-END IF
!
+CALL IO_File_close(TOUTDATAFILE)
CALL IO_File_close(TINIFILE)
IF (LEN_TRIM(CINIFILEPGD)>0) CALL IO_File_close(TINIFILEPGD)
CALL IO_File_close(TLUOUT)
@@ -800,8 +809,6 @@ ZTIME2=ZTIME2-ZTIME0
!WRITE(ILUOUT0,*) '|---------------------| -------------------|-------------------|'
!
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
-!
WRITE(ILUOUT0,*) ' '
WRITE(ILUOUT0,*) '***************************** **************'
WRITE(ILUOUT0,*) '* EXIT DIAG CORRECTLY *'
@@ -809,13 +816,12 @@ WRITE(ILUOUT0,*) '**************************** ***************'
!WRITE(ILUOUT0,*) ' (see time analysis in ',TRIM(TLUOUT0%CNAME),' )'
WRITE(ILUOUT0,*) ' '
!
-CALL IO_File_close(TLUOUT0)
!-------------------------------------------------------------------------------
!
!* 10. FINALIZE THE PARALLEL SESSION
! -----------------------------
!
-CALL END_PARA_ll(IINFO_ll)
+CALL FINALIZE_MNH()
!
!-------------------------------------------------------------------------------
END PROGRAM DIAG
diff --git a/src/MNH/drag_bld.f90 b/src/MNH/drag_bld.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fbb25dc13bdcb4837a23d39130417db344f58a48
--- /dev/null
+++ b/src/MNH/drag_bld.f90
@@ -0,0 +1,251 @@
+!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_DRAG_BLD
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE DRAG_BLD(PTSTEP, PUT, PVT, PTKET, PRHODJ, PZZ, PRUS, PRVS, PRTKES )
+ !
+ REAL, INTENT(IN) :: PTSTEP ! Time step
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT ! variables
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! at t
+ !
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
+ !
+ END SUBROUTINE DRAG_BLD
+
+ END INTERFACE
+
+END MODULE MODI_DRAG_BLD
+!
+! ###################################################################
+SUBROUTINE DRAG_BLD(PTSTEP, PUT, PVT, PTKET, PRHODJ, PZZ, PRUS, PRVS, PRTKES )
+ ! ###################################################################
+ !
+ !!**** *DRAG_BLD_n * -
+ !!
+ !! PURPOSE
+ !! -------
+ !
+ ! Drag force due to buildings
+ !
+ !!** METHOD
+ !! ------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! R. Schoetter
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 09/2019
+ ! P. Wautelet 04/03/2021: budgets: add DRAGB source term
+ !!---------------------------------------------------------------
+ !
+ !* 0. DECLARATIONS
+ ! ------------
+ !
+ use modd_budget, only: lbudget_u, lbudget_v, lbudget_tke, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_TKE, &
+ tbudgets
+ USE MODD_CONF
+ USE MODD_CST
+ USE MODD_DRAGBLDG_n
+ USE MODD_DYN
+ USE MODD_DYN_n
+ USE MODD_GROUND_PAR
+ USE MODD_NSV
+ USE MODD_PGDFIELDS
+
+ use mode_budget, only: Budget_store_init, Budget_store_end
+
+ USE MODI_MNHGET_SURF_PARAM_n
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !* 0.1 Declarations of dummy arguments :
+ !
+ REAL, INTENT(IN) :: PTSTEP ! Time step
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT ! variables
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKET ! at t
+ !
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
+ !
+ !* 0.2 Declarations of local variables :
+ !
+ INTEGER :: IIU,IJU,IKU,IKV ! array size along the k direction
+ INTEGER :: JI, JJ, JK ! loop index
+ INTEGER :: INFO_ll
+ !
+ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
+ ZWORK1, ZWORK2, ZWORK3, ZUT_SCAL, ZVT_SCAL, &
+ ZUS, ZVS, ZTKES, ZTKET
+ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
+ ZCDRAG, ZDENSITY
+ !
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZH_BUILD_PGD
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZWALL_O_HOR_PGD
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZFRAC_TOWN_PGD
+ !
+ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: &
+ ZH_BLD,ZF_BLD ! Building height, frontal density
+ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZT,ZEXN,ZLV,ZCPH
+ !
+ !* 0.3 Initialization
+ !
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'DRAGB', prus (:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'DRAGB', prvs (:, :, :) )
+ if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'DRAGB', prtkes(:, :, :) )
+
+ IIU = SIZE(PUT,1)
+ IJU = SIZE(PUT,2)
+ IKU = SIZE(PUT,3)
+ !
+ ZUS (:,:,:) = 0.0
+ ZVS (:,:,:) = 0.0
+ ZTKES (:,:,:) = 0.0
+ !
+ ZH_BLD (:,:) = 0.
+ ZF_BLD (:,:) = 0.
+ !
+ ZCDRAG (:,:,:) = 0.
+ ZDENSITY (:,:,:) = 0.
+ !
+ ALLOCATE(ZFRAC_TOWN_PGD(IIU,IJU))
+ ALLOCATE(ZH_BUILD_PGD(IIU,IJU))
+ ALLOCATE(ZWALL_O_HOR_PGD(IIU,IJU))
+ !
+ ZFRAC_TOWN_PGD (:,:) = XUNDEF
+ ZH_BUILD_PGD (:,:) = XUNDEF
+ ZWALL_O_HOR_PGD (:,:) = XUNDEF
+ !
+ CALL MNHGET_SURF_PARAM_n( PTOWN=ZFRAC_TOWN_PGD, &
+ PBUILD_HEIGHT=ZH_BUILD_PGD, &
+ PWALL_O_HOR=ZWALL_O_HOR_PGD )
+ !
+ ! FIXME: Some values of ZFRAC_TOWN_PGD are 999. This is a bit strange since the
+ ! TOWN fraction should be defined everywhere.
+ ! It is set to 0.0 provisionally
+ !
+ WHERE(ZFRAC_TOWN_PGD(:,:).GT.1.0) ZFRAC_TOWN_PGD(:,:)=0.0
+ !
+ ! The values for wall density and building height are set to 0.0 where the Town fraction is 0.0
+ ! For the wall density this would not be necessary since it will be multiplied by the town
+ ! fraction anyway.
+ !
+ WHERE(ZFRAC_TOWN_PGD(:,:).EQ.0.0)
+ ZWALL_O_HOR_PGD(:,:) = 0.0
+ ZH_BUILD_PGD(:,:) = 0.0
+ ENDWHERE
+ !
+ ! For buildings, the frontal wall area density is calculated [m^2(walls facing the wind)/m^2]
+ ! The division by PI means that cylindrical buildings are assumed (circle perimeter = PI*D, circle frontal area = D)
+ ! [m^2(walls facing the wind)/m^2]=[m^2(wall)/m^2(town)*m^2(town)/m^2/PI]
+ ! It will be assumed that the frontal wall area is equally distributed with height (all buildings same height)
+ !
+ ZH_BLD(:,:) = ZH_BUILD_PGD(:,:)
+ ZF_BLD(:,:) = ZFRAC_TOWN_PGD(:,:)*ZWALL_O_HOR_PGD(:,:)/XPI
+ !
+ DEALLOCATE(ZFRAC_TOWN_PGD)
+ DEALLOCATE(ZH_BUILD_PGD)
+ DEALLOCATE(ZWALL_O_HOR_PGD)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !
+ !* 1. COMPUTES THE TRUE VELOCITY COMPONENTS
+ ! -------------------------------------
+ !
+ ZUT_SCAL(:,:,:) = MXF(PUT(:,:,:))
+ ZVT_SCAL(:,:,:) = MYF(PVT(:,:,:))
+ ZTKET(:,:,:) = PTKET(:,:,:)
+ !-------------------------------------------------------------------------------
+ !
+ !* 1. Computations of wind tendency due to canopy drag
+ ! ------------------------------------------------
+ !
+ ! Ext = - Cdrag * u- * u- * Sv tree canopy drag
+ ! - u'w'(ground) * Sh horizontal surfaces (ground)
+ ! ------------------------------
+ !
+ DO JJ=2,(IJU-1)
+ DO JI=2,(IIU-1)
+ !
+ ! Set density and drag coefficient for buildings
+ !
+ IF (ZH_BLD(JI,JJ) /= 0) THEN
+ !
+ DO JK=2,(IKU-1)
+ !
+ IF ( (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) .LT. ZH_BLD(JI,JJ) ) THEN
+ !
+ ! FIXME: Check literature values for the drag coefficient here
+ !
+ ZCDRAG(JI,JJ,JK) = 0.2
+ !
+ ! A uniform distribution of building heights is assumed
+ !
+ ZDENSITY(JI,JJ,JK) = ZF_BLD(JI,JJ) / ZH_BLD(JI,JJ)
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDIF
+ !
+ ENDDO
+ ENDDO
+ !
+ !* 1.2 Drag force by wall surfaces
+ ! ---------------------------
+ !
+ !* drag force by vertical surfaces
+ !
+ ZUS(:,:,:) = PUT(:,:,:)/( 1.0 + MXM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
+ !
+ ZVS(:,:,:) = PVT(:,:,:)/( 1.0 + MYM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
+ !
+ PRUS(:,:,:) = PRUS(:,:,:) + (ZUS(:,:,:)-PUT(:,:,:)) * MXM(PRHODJ(:,:,:)) / PTSTEP
+ !
+ PRVS(:,:,:) = PRVS(:,:,:) + (ZVS(:,:,:)-PVT(:,:,:)) * MYM(PRHODJ(:,:,:)) / PTSTEP
+ !
+ !* 3. Computations of TKE tendency due to canopy drag
+ ! ------------------------------------------------
+ !* 3.1 Creation of TKE by wake
+ ! -----------------------
+ !
+ ! from Kanda and Hino (1994)
+ !
+ ! Ext = + Cd * u+^3 * Sv/Vair vertical surfaces or trees
+ !
+ ! with Vair = Vair/Vtot * Vtot = (Vair/Vtot) * Stot * Dz
+ ! and Sv/Vair = (Sv/Stot) * Stot/Vair = (Sv/Stot) / (Vair/Vtot) / Dz
+ !
+ ZTKES(:,:,:) = ZTKET(:,:,:) + &
+ PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) * (SQRT( ZUT_SCAL(:,:,:)**2 + ZVT_SCAL(:,:,:)**2 ))**3
+ !
+ PRTKES(:,:,:) = PRTKES(:,:,:) + (ZTKES(:,:,:)-ZTKET(:,:,:))*PRHODJ(:,:,:)/PTSTEP
+
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'DRAGB', prus (:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'DRAGB', prvs (:, :, :) )
+ if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'DRAGB', prtkes(:, :, :) )
+
+END SUBROUTINE DRAG_BLD
diff --git a/src/MNH/drag_veg.f90 b/src/MNH/drag_veg.f90
index ce157a15406a436c180f33162b87687868ab56a1..453bf94c2ae5ed4b865a02fa87e2180003eaf228 100644
--- a/src/MNH/drag_veg.f90
+++ b/src/MNH/drag_veg.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! #######################
MODULE MODI_DRAG_VEG
! #######################
@@ -11,7 +12,7 @@ INTERFACE
SUBROUTINE DRAG_VEG(PTSTEP,PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
HCLOUD,PPABST,PTHT,PRT,PSVT, &
PRHODJ,PZZ,PRUS, PRVS, PRTKES, &
- PTHS,PRRS,PSVS)
+ PRRS,PSVS)
!
REAL, INTENT(IN) :: PTSTEP ! Time step
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT ! variables
@@ -26,17 +27,12 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! at t
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-!
-
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS
-!
!
-
END SUBROUTINE DRAG_VEG
END INTERFACE
@@ -47,7 +43,7 @@ END MODULE MODI_DRAG_VEG
SUBROUTINE DRAG_VEG(PTSTEP,PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
HCLOUD,PPABST,PTHT,PRT,PSVT, &
PRHODJ,PZZ,PRUS, PRVS, PRTKES, &
- PTHS,PRRS,PSVS)
+ PRRS,PSVS)
! ###################################################################
!
!!**** *DRAG_VEG_n * -
@@ -73,29 +69,37 @@ SUBROUTINE DRAG_VEG(PTSTEP,PUT,PVT,PTKET,ODEPOTREE, PVDEPOTREE, &
!! S. Donier 06/2015 : bug surface aerosols
!! C.Lac 07/2016 : Add droplet deposition
!! C.Lac 10/2017 : Correction on deposition
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+! C. Lac 02/2020: correction missing condition for budget on RC and SV
+! P. Wautelet 04/02/2021: budgets: bugfixes for LDRAGTREE if LIMA + small optimisations and verifications
!!---------------------------------------------------------------
!
!
!* 0. DECLARATIONS
! ------------
!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_rc, lbudget_sv, lbudget_tke, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_RC, NBUDGET_SV1, NBUDGET_TKE, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_DYN
USE MODD_DYN_n
-USE MODD_VEG_n
-USE MODD_BUDGET
-USE MODD_PARAM_C2R2
+USE MODD_GROUND_PAR
USE MODD_NSV
-
-!
-USE MODI_SHUMAN
+USE MODD_PARAM_C2R2
+USE MODD_PARAM_LIMA, ONLY: LWARM_LIMA => LWARM
+USE MODD_PARAM_n, only: CSURF, CTURB
USE MODD_PGDFIELDS
-USE MODD_GROUND_PAR
+USE MODD_VEG_n
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_msg
+
USE MODI_MNHGET_SURF_PARAM_n
-USE MODI_BUDGET
+USE MODI_SHUMAN
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -113,15 +117,11 @@ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! at t
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-!
-
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS ! Sources of Momentum
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTKES ! Sources of Tke
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS
-!
!
!* 0.2 Declarations of local variables :
!
@@ -129,43 +129,53 @@ INTEGER :: IIU,IJU,IKU,IKV ! array size along the k direction
INTEGER :: JI, JJ, JK ! loop index
!
!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZH_TREE_PGD ! surface cover types
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZLAI_PGD ! surface cover types
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
- ZWORK1, ZWORK2, ZWORK3, ZUT, ZVT, &
+ ZWORK1, ZWORK2, ZWORK3, ZUT_SCAL, ZVT_SCAL, &
ZUS, ZVS, ZTKES, ZTKET
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: &
ZCDRAG, ZDENSITY
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2)) :: &
- ZVH,ZLAI ! LAI, Vegetation height
+ ZH,ZLAI ! LAI, Vegetation height
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZT,ZEXN,ZLV,ZCPH
LOGICAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) &
:: GDEP
REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)):: ZWDEPR,ZWDEPS
+IF ( CSURF /= 'EXTE' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'CSURF/=EXTE not allowed' )
+
+!Condition necessary because PTKET is used (and must be allocated)
+IF ( CTURB /= 'TKEL' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'CTURB/=TKEL not allowed' )
!
-!
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
+if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'DRAG', prtkes(:, :, :) )
+
+if ( odepotree ) then
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPOTR', prrs(:, :, :, 2) )
+ if ( lbudget_sv .and. ( hcloud=='C2R2' .or. hcloud=='KHKO' ) ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1-1+(NSV_C2R2BEG+1)), 'DEPOTR', psvs(:, :, :, NSV_C2R2BEG+1) )
+ if ( lbudget_sv .and. hcloud=='LIMA' ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1-1+NSV_LIMA_NC), 'DEPOTR', psvs(:, :, :, NSV_LIMA_NC) )
+end if
+
IIU = SIZE(PUT,1)
IJU = SIZE(PUT,2)
IKU = SIZE(PUT,3)
!
-!* 0.3 Initialisation de kelkes variables
-!
-ZVH(:,:)=0.
-ZLAI(:,:)=0.
-ZCDRAG(:,:,:)=0.
-ZDENSITY(:,:,:)=0.
+ZUS (:,:,:) = 0.0
+ZVS (:,:,:) = 0.0
+ZTKES (:,:,:) = 0.0
!
-ALLOCATE(ZH_TREE_PGD(IIU,IJU))
-ALLOCATE(ZLAI_PGD(IIU,IJU))
+ZH (:,:) = XUNDEF
+ZLAI(:,:) = XUNDEF
!
-CALL MNHGET_SURF_PARAM_n(PH_TREE=ZH_TREE_PGD,PLAI_TREE=ZLAI_PGD)
+ZCDRAG (:,:,:) = 0.
+ZDENSITY (:,:,:) = 0.
!
-ZVH(:,:)=ZH_TREE_PGD(:,:)
-ZLAI(:,:)=ZLAI_PGD(:,:)
+CALL MNHGET_SURF_PARAM_n( PH_TREE = ZH, PLAI_TREE = ZLAI )
!
-DEALLOCATE(ZH_TREE_PGD)
-DEALLOCATE(ZLAI_PGD)
+WHERE ( ZH (:,:) > (XUNDEF-1.) ) ZH (:,:) = 0.0
+WHERE ( ZLAI (:,:) > (XUNDEF-1.) ) ZLAI (:,:) = 0.0
!
!-------------------------------------------------------------------------------
!
@@ -173,9 +183,9 @@ DEALLOCATE(ZLAI_PGD)
!* 1. COMPUTES THE TRUE VELOCITY COMPONENTS
! -------------------------------------
!
-ZUT(:,:,:) = PUT(:,:,:)
-ZVT(:,:,:) = PVT(:,:,:)
-ZTKET(:,:,:) = PTKET(:,:,:)
+ZUT_SCAL(:,:,:) = MXF(PUT(:,:,:))
+ZVT_SCAL(:,:,:) = MYF(PVT(:,:,:))
+ZTKET(:,:,:) = PTKET(:,:,:)
!-------------------------------------------------------------------------------
!
!* 1. Computations of wind tendency due to canopy drag
@@ -190,35 +200,46 @@ ZTKET(:,:,:) = PTKET(:,:,:)
! ------------------------------
!
GDEP(:,:,:) = .FALSE.
+!
DO JJ=2,(IJU-1)
- DO JI=2,(IIU-1)
- IF (ZVH(JI,JJ) /= 0) THEN
- DO JK=2,(IKU-1)
- IF ((ZVH(JI,JJ)+PZZ(JI,JJ,2))<PZZ(JI,JJ,JK)) EXIT
- IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO')) THEN
- IF ((PRRS(JI,JJ,JK,2) >0.) .AND. (PSVS(JI,JJ,JK,NSV_C2R2BEG+1) >0.)) &
- GDEP(JI,JJ,JK) = .TRUE.
- ELSE IF (HCLOUD /= 'NONE' .AND. HCLOUD /= 'REVE') THEN
- IF (PRRS(JI,JJ,JK,2) >0.) GDEP(JI,JJ,JK) = .TRUE.
- END IF
- ZCDRAG(JI,JJ,JK) = 0.2 !0.075
- ZDENSITY(JI,JJ,JK) = MAX((4 * (ZLAI(JI,JJ) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (ZVH(JI,JJ)-(PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)))/&
- ZVH(JI,JJ)**3)-&
- (0.30*((ZLAI(JI,JJ) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
- (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) /&
- (ZVH(JI,JJ)**3))-ZLAI(JI,JJ))))/&
- ZVH(JI,JJ), 0.)
-
-
- END DO
- END IF
- END DO
-END DO
+ DO JI=2,(IIU-1)
+ !
+ ! Set density and drag coefficient for vegetation
+ !
+ IF (ZH(JI,JJ) /= 0) THEN
+ !
+ DO JK=2,(IKU-1)
+ !
+ IF ( (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) .LT. ZH(JI,JJ) ) THEN
+ !
+ IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO')) THEN
+ IF ((PRRS(JI,JJ,JK,2) >0.) .AND. (PSVS(JI,JJ,JK,NSV_C2R2BEG+1) >0.)) &
+ GDEP(JI,JJ,JK) = .TRUE.
+ ELSE IF (HCLOUD /= 'NONE' .AND. HCLOUD /= 'REVE') THEN
+ IF (PRRS(JI,JJ,JK,2) >0.) GDEP(JI,JJ,JK) = .TRUE.
+ ENDIF
+ !
+ ZCDRAG(JI,JJ,JK) = 0.2 !0.075
+ ZDENSITY(JI,JJ,JK) = MAX((4 * (ZLAI(JI,JJ) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (ZH(JI,JJ)-(PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)))/&
+ ZH(JI,JJ)**3)-&
+ (0.30*((ZLAI(JI,JJ) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) *&
+ (PZZ(JI,JJ,JK)-PZZ(JI,JJ,2)) /&
+ (ZH(JI,JJ)**3))-ZLAI(JI,JJ))))/&
+ ZH(JI,JJ), 0.)
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDIF
+ !
+ ENDDO
+ENDDO
+!
! To exclude the first vertical level already dealt in rain_ice or rain_c2r2_khko
GDEP(:,:,2) = .FALSE.
!
@@ -227,17 +248,21 @@ GDEP(:,:,2) = .FALSE.
!
!* drag force by vertical surfaces
!
-ZUS(:,:,:)= ZUT(:,:,:)/(1 + ZCDRAG(:,:,:)* ZDENSITY(:,:,:)*PTSTEP &
- *SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2))
+ZUS(:,:,:) = PUT(:,:,:)/( 1.0 + MXM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
!
-ZVS(:,:,:)= ZVT(:,:,:)/(1 + ZCDRAG(:,:,:)* ZDENSITY(:,:,:)*PTSTEP &
- *SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2))
+ZVS(:,:,:) = PVT(:,:,:)/( 1.0 + MYM ( ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * PTSTEP * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2) ) )
!
-PRUS(:,:,:)=PRUS(:,:,:)+((ZUS(:,:,:)-ZUT(:,:,:))*PRHODJ(:,:,:))/PTSTEP
+PRUS(:,:,:) = PRUS(:,:,:) + (ZUS(:,:,:)-PUT(:,:,:)) * MXM(PRHODJ(:,:,:)) / PTSTEP
!
-PRVS(:,:,:)=PRVS(:,:,:)+((ZVS(:,:,:)-ZVT(:,:,:))*PRHODJ(:,:,:))/PTSTEP
+PRVS(:,:,:) = PRVS(:,:,:) + (ZVS(:,:,:)-PVT(:,:,:)) * MYM(PRHODJ(:,:,:)) / PTSTEP
!
IF (ODEPOTREE) THEN
+ IF ( HCLOUD == 'NONE' ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'LDEPOTREE=T not allowed if CCLOUD=NONE' )
+ IF ( HCLOUD == 'LIMA' .AND. .NOT. LWARM_LIMA ) &
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DRAG_VEG', 'LDEPOTREE=T not allowed if CCLOUD=LIMA and LWARM=F' )
+
ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
@@ -247,20 +272,27 @@ IF (ODEPOTREE) THEN
WHERE (GDEP)
ZWDEPR(:,:,:)= PVDEPOTREE * PRT(:,:,:,2) * PRHODJ(:,:,:)
END WHERE
- IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO') .OR. (HCLOUD=='LIMA')) THEN
- WHERE (GDEP)
- ZWDEPS(:,:,:)= PVDEPOTREE * PSVT(:,:,:,NSV_C2R2BEG+1) * PRHODJ(:,:,:)
- END WHERE
+ IF ( HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' ) THEN
+ WHERE (GDEP)
+ ZWDEPS(:,:,:)= PVDEPOTREE * PSVT(:,:,:,NSV_C2R2BEG+1) * PRHODJ(:,:,:)
+ END WHERE
+ ELSE IF ( HCLOUD == 'LIMA' ) THEN
+ WHERE (GDEP)
+ ZWDEPS(:,:,:)= PVDEPOTREE * PSVT(:,:,:,NSV_LIMA_NC) * PRHODJ(:,:,:)
+ END WHERE
END IF
DO JJ=2,(IJU-1)
DO JI=2,(IIU-1)
DO JK=2,(IKU-2)
IF (GDEP(JI,JJ,JK)) THEN
- PRRS(JI,JJ,JK,2) = PRRS(JI,JJ,JK,2) + (ZWDEPR(JI,JJ,JK+1)-ZWDEPR(JI,JJ,JK))/ &
- (PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
- IF ((HCLOUD=='C2R2') .OR. (HCLOUD=='KHKO').OR. (HCLOUD=='LIMA')) THEN
- PSVS(JI,JJ,JK,NSV_C2R2BEG+1) = PSVS(JI,JJ,JK,NSV_C2R2BEG+1) + &
- (ZWDEPS(JI,JJ,JK+1)-ZWDEPS(JI,JJ,JK))/(PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
+ PRRS(JI,JJ,JK,2) = PRRS(JI,JJ,JK,2) + (ZWDEPR(JI,JJ,JK+1)-ZWDEPR(JI,JJ,JK))/ &
+ (PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
+ IF ( HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' ) THEN
+ PSVS(JI,JJ,JK,NSV_C2R2BEG+1) = PSVS(JI,JJ,JK,NSV_C2R2BEG+1) + &
+ (ZWDEPS(JI,JJ,JK+1)-ZWDEPS(JI,JJ,JK))/(PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
+ ELSE IF ( HCLOUD == 'LIMA' ) THEN
+ PSVS(JI,JJ,JK,NSV_LIMA_NC) = PSVS(JI,JJ,JK,NSV_LIMA_NC) + &
+ (ZWDEPS(JI,JJ,JK+1)-ZWDEPS(JI,JJ,JK))/(PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))
END IF
END IF
END DO
@@ -270,12 +302,6 @@ IF (ODEPOTREE) THEN
!
END IF
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'DRAG_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'DRAG_BU_RV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'DEPOTR_BU_RRC')
-IF (LBUDGET_SV) CALL BUDGET (PSVS(:,:,:,NSV_C2R2BEG+1),14+(NSV_C2R2BEG-1),'DEPOTR_BU_RSV')
-!
-!
!* 3. Computations of TKE tendency due to canopy drag
! ------------------------------------------------
@@ -291,15 +317,22 @@ IF (LBUDGET_SV) CALL BUDGET (PSVS(:,:,:,NSV_C2R2BEG+1),14+(NSV_C2R2BEG-1),'DEPOT
! with Vair = Vair/Vtot * Vtot = (Vair/Vtot) * Stot * Dz
! and Sv/Vair = (Sv/Stot) * Stot/Vair = (Sv/Stot) / (Vair/Vtot) / Dz
!
-!ZTKES(:,:,:)= (ZTKET(:,:,:) + (ZCDRAG(:,:,:)* ZDENSITY(:,:,:) &
-! *(SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2))**3)) /&
-! (1.+(2.*ZCDRAG(:,:,:)* ZDENSITY(:,:,:)*SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2)))
-ZTKES(:,:,:)= (ZTKET(:,:,:) + (ZCDRAG(:,:,:)* ZDENSITY(:,:,:) &
- *(SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2))**3))*PTSTEP /&
- (1.+PTSTEP*ZCDRAG(:,:,:)* ZDENSITY(:,:,:)*SQRT(ZUT(:,:,:)**2+ZVT(:,:,:)**2))
-!
-PRTKES(:,:,:)=PRTKES(:,:,:)+((ZTKES(:,:,:)-ZTKET(:,:,:))*PRHODJ(:,:,:)/PTSTEP)
-!
-IF (LBUDGET_TKE) CALL BUDGET (PRTKES(:,:,:),5,'DRAG_BU_RTKE')
+ZTKES(:,:,:)= ( ZTKET(:,:,:) + PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) &
+ * (SQRT( ZUT_SCAL(:,:,:)**2 + ZVT_SCAL(:,:,:)**2 ))**3 ) / &
+ ( 1. + PTSTEP * ZCDRAG(:,:,:) * ZDENSITY(:,:,:) * SQRT(ZUT_SCAL(:,:,:)**2+ZVT_SCAL(:,:,:)**2))
!
+PRTKES(:,:,:) = PRTKES(:,:,:) + (ZTKES(:,:,:)-ZTKET(:,:,:))*PRHODJ(:,:,:)/PTSTEP
+
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'DRAG', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'DRAG', prvs (:, :, :) )
+if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'DRAG', prtkes(:, :, :) )
+
+if ( odepotree ) then
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPOTR', prrs(:, :, :, 2) )
+ if ( lbudget_sv .and. ( hcloud=='C2R2' .or. hcloud=='KHKO' ) ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1-1+(NSV_C2R2BEG+1)), 'DEPOTR', psvs(:, :, :, NSV_C2R2BEG+1) )
+ if ( lbudget_sv .and. hcloud=='LIMA' ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1-1+NSV_LIMA_NC), 'DEPOTR', psvs(:, :, :, NSV_LIMA_NC) )
+end if
+
END SUBROUTINE DRAG_VEG
diff --git a/src/MNH/dry_mass.f90 b/src/MNH/dry_mass.f90
deleted file mode 100644
index 0930b058b29fdba1f2fc20ca2a16b87786b1d78e..0000000000000000000000000000000000000000
--- a/src/MNH/dry_mass.f90
+++ /dev/null
@@ -1,162 +0,0 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######spl
- MODULE MODI_DRY_MASS
-! ####################
-INTERFACE
- SUBROUTINE DRY_MASS(PTHV,PR,PJ,PPABS,PDRYMASS)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHV ! virtual potential temperature
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ ! jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABS ! absolute pressure
-!
-REAL, INTENT(OUT) :: PDRYMASS ! dry mass
-!
-END SUBROUTINE DRY_MASS
-END INTERFACE
-END MODULE MODI_DRY_MASS
-! ######spl
- SUBROUTINE DRY_MASS(PTHV,PR,PJ,PPABS,PDRYMASS)
-! ##########################################
-!
-!!**** *DRY_MASS* - computation of the total dry air mass
-!!
-!! PURPOSE
-!! -------
-!! This routine computes the total dry mass in the whole domain from
-!! the virtual potential temperature, the mixing ratio, the local Exner
-!! function at the top of the model and the Jacobian.
-!!
-!!** METHOD
-!! ------
-!!
-!! 1 The local Exner function in computed by integration of the hydrostatic
-!! relation from top (PEXNTOP2D) to bottom (routine COMPUTE_EXNER_FROM_TOP).
-!!
-!!
-!! 2 The Exner function at mass level is computed as follows and linearly
-!! extrapolated for the uppest non-physical level
-!! (routine COMPUTE_EXNER_FROM_TOP).
-!!
-!! 3 rhod is deduced by the relation:
-!!
-!!
-!! P / (PI)
-!! rhod= ----------------
-!! Rd thetav (1+rw)
-!!
-!! 4 The total dry mass is deduced from rhod and the Jacobian (the integration
-!! is performed on the inner points):
-!!
-!! Md= SUM rhod J*
-!! i,j,k
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! routine COMPUTE_EXNER_FROM_TOP : to compute the hydrostatic Exner function
-!!
-!! module MODI_COMPUTE_EXNER_FROM_TOP
-!! SUM3D_ll : distributed function equivalent to SUM
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_CONF : contains configuration variables for all models.
-!! NVERB : verbosity level for output-listing
-!! Module MODD_LUNIT_n : contains logical unit names for all models
-!! TLUOUT : name of output-listing
-!! Module MODD_GRID1 : contains grid variables for model1
-!! XZZ : altitude of the w points
-!! Module MODD_CST : contains physical constants
-!! XG : gravity constant
-!! XCPD: specific heat for dry air at constant pressure
-!! XP00: reference pressure
-!! XRD : gas constant for dry air
-!! Module MODD_PARAMETERS
-!! JPVEXT;JPHEXT
-!! Module MODD_FIELD1 : contains the prognostic fields of model1
-!! XDRYMASST : total dry mass at t
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 13/12/94
-!! Sept. 21, 1995 (J.Stein and V.Masson) surface pressure
-!! Jan. 09, 1996 (V. Masson) hydrostatic pressure at mass
-!! point
-!! March 06, 1996 (V. Masson) call to COMPUTE_EXNER_FROM_TOP
-!! Jan 15, 1997 (Stein,Lafore) Durran anelastic equation
-!! Jun 10, 1997 (V. Masson) use absolute pressure
-!! Jul 10, 1997 (V. Masson) removes use to modules of model 1
-!! Nov 21, 1997 (V. Masson) use all water species
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CONF ! declaration modules
-USE MODD_LUNIT_n, ONLY : TLUOUT
-USE MODD_CST
-USE MODD_PARAMETERS
-!
-USE MODE_ll
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHV ! virtual potential temperature
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PR ! water mixing ratio
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ ! jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABS ! absolute pressure
-!
-REAL, INTENT(OUT) :: PDRYMASS ! dry mass
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-INTEGER :: JRR
-REAL, DIMENSION(SIZE(PJ,1),SIZE(PJ,2),SIZE(PJ,3)) :: ZRHOD, ZSUMR
-INTEGER :: IINFO_ll ! return code of parallel routine
-!-------------------------------------------------------------------------------
-!
-!
-!* 1. COMPUTATION OF RHOD
-! -------------------
-!
-!
-ZSUMR(:,:,:) = 0.
-DO JRR=1,SIZE(PR,4)
- ZSUMR(:,:,:) = ZSUMR(:,:,:) + PR(:,:,:,JRR)
-END DO
-!
-ZRHOD(:,:,:)=PPABS(:,:,:)/(PPABS(:,:,:)/XP00)**(XRD/XCPD) &
- /(XRD*PTHV(:,:,:)*(1.+ZSUMR(:,:,:)))
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. COMPUTATION OF THE TOTAL DRY MASS
-! ---------------------------------
-!
-PDRYMASS=SUM3D_ll(PJ(:,:,:)*ZRHOD(:,:,:),IINFO_ll)
-!
-!-------------------------------------------------------------------------------
-!
-WRITE(TLUOUT%NLU,*) 'Routine DRYMASS completed'
-!
-END SUBROUTINE DRY_MASS
diff --git a/src/MNH/dummy_gr_index.f90 b/src/MNH/dummy_gr_index.f90
deleted file mode 100644
index 1bdac1193951e1c0dcb72899d967f866d4eda71f..0000000000000000000000000000000000000000
--- a/src/MNH/dummy_gr_index.f90
+++ /dev/null
@@ -1,86 +0,0 @@
-!MNH_LIC Copyright 1997-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #####################
- MODULE MODI_DUMMY_GR_INDEX
-! #####################
-INTERFACE
- FUNCTION DUMMY_GR_INDEX(HFIELD,HDUMMY_GR_NAME) RESULT(KINDEX)
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! name of PGD field
-CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HDUMMY_GR_NAME ! names of PGD field
-INTEGER :: KINDEX ! index of this field
-!
-END FUNCTION DUMMY_GR_INDEX
-END INTERFACE
-END MODULE MODI_DUMMY_GR_INDEX
-!
-! #########################################
- FUNCTION DUMMY_GR_INDEX(HFIELD,HDUMMY_GR_NAME) RESULT(KINDEX)
-! #########################################
-!
-!!
-!! PURPOSE
-!! -------
-!!
-!! routine to retrive the index of a PGD field in LNOCLASS_PGD array
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 15/12/97
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!!
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-use mode_msg
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFIELD ! name of PGD field
-CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HDUMMY_GR_NAME ! names of PGD field
-INTEGER :: KINDEX ! index of this field
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: JDUMMY ! loop control
-!-------------------------------------------------------------------------------
-!
-DO JDUMMY=1,1000
- IF (HFIELD==HDUMMY_GR_NAME(JDUMMY)) THEN
- KINDEX = JDUMMY
- RETURN
- END IF
- IF (LEN_TRIM(HFIELD)==0) THEN
- call Print_msg(NVERB_FATAL,'GEN','DUMMY_GR_INDEX','LEN_TRIM(HFIELD)=0')
- ENDIF
-END DO
-!-------------------------------------------------------------------------------
-!
-END FUNCTION DUMMY_GR_INDEX
diff --git a/src/MNH/dyn_sources.f90 b/src/MNH/dyn_sources.f90
index 3972eae3c41a1702aa2c2c30fae8978658d54933..052eeebc48a26257ef84181bf9b6dca44471d888 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.
@@ -106,7 +106,6 @@ END MODULE MODI_DYN_SOURCES
!! 'CART' for cartesian box configuration
!! 'MASK' for budget zone defined by a mask
!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
!! LBU_RTH : logical for budget of RTH (potential temperature)
!! .TRUE. = budget of RTH
!! .FALSE. = no budget of RTH
@@ -147,22 +146,26 @@ END MODULE MODI_DYN_SOURCES
!! Correction 06/10 (C.Lac) Exclude L1D for Coriolis term
!! Modification 03/11 (C.Lac) Split the gravity term due to buoyancy
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_DYN
+USE MODD_DYN_n, ONLY: LOCEAN
!
-USE MODI_SHUMAN
-USE MODI_GRADIENT_M
-USE MODI_BUDGET
-!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_MPPDB
-!
+
+USE MODI_GRADIENT_M
+USE MODI_SHUMAN
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -220,8 +223,11 @@ IKU = SIZE(PUT,3)
!
! Only when earth rotation is considered but not in 1D and CARTESIAN cases
!
-IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN
- IF ( LTHINSHELL ) THEN ! THINSHELL approximation
+IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'CURV', prus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'CURV', prvs(:, :, :) )
+
+ IF ( LTHINSHELL ) THEN ! THINSHELL approximation
!
ZWORK1(:,:,:) = SPREAD( PCURVX(:,:),DIM=3,NCOPIES=IKU ) / XRADIUS
ZWORK2(:,:,:) = SPREAD( PCURVY(:,:),DIM=3,NCOPIES=IKU ) / XRADIUS
@@ -235,7 +241,8 @@ IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN
- ZRVT * MYM( MXF(PUT) * ZWORK2 )
!
ELSE ! NO THINSHELL approximation
-!
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'CURV', prws(:, :, :) )
+
ZWORK3(:,:,:) = 1.0 / ( XRADIUS + MZF(PZZ(:,:,:)) )
ZWORK1(:,:,:) = SPREAD( PCURVX(:,:),DIM=3,NCOPIES=IKU )
ZWORK2(:,:,:) = SPREAD( PCURVY(:,:),DIM=3,NCOPIES=IKU )
@@ -258,14 +265,14 @@ IF ((.NOT.L1D).AND.(.NOT.LCARTESIAN) ) THEN
!
PRWS(:,:,:) = PRWS &
+MZM( ( MXF(ZRUT*PUT) + MYF(ZRVT*PVT) ) * ZWORK3 )
-!
+
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'CURV', prws(:, :, :) )
END IF
-!
+
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'CURV', prus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'CURV', prvs(:, :, :) )
END IF
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'CURV_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'CURV_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'CURV_BU_RW')
!
!-------------------------------------------------------------------------------
!
@@ -273,14 +280,17 @@ IF (LBUDGET_W) CALL BUDGET (PRWS,3,'CURV_BU_RW')
! ---------------------------
!
IF (LCORIO) THEN
-!
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'COR', prus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'COR', prvs(:, :, :) )
+
ZWORK3(:,:,:) = SPREAD( PCORIOZ(:,:),DIM=3,NCOPIES=IKU ) * PRHODJ(:,:,:)
!
PRUS(:,:,:) = PRUS + MXM( ZWORK3 * MYF(PVT) )
PRVS(:,:,:) = PRVS - MYM( ZWORK3 * MXF(PUT) )
!
IF ((.NOT.LTHINSHELL) .AND. (.NOT.L1D)) THEN
-!
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'COR', prws(:, :, :) )
+
ZWORK1(:,:,:) = SPREAD( PCORIOX(:,:),DIM=3,NCOPIES=IKU) * PRHODJ(:,:,:)
ZWORK2(:,:,:) = SPREAD( PCORIOY(:,:),DIM=3,NCOPIES=IKU) * PRHODJ(:,:,:)
!
@@ -289,14 +299,14 @@ IF (LCORIO) THEN
PRVS(:,:,:) = PRVS - MYM( ZWORK1 * MZF(PWT) )
!
PRWS(:,:,:) = PRWS + MZM( ZWORK2 * MXF(PUT) + ZWORK1 * MYF(PVT) )
-!
+
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'COR', prws(:, :, :) )
END IF
+
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'COR', prus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'COR', prvs(:, :, :) )
+END IF
!
-END IF
-!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'COR_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'COR_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'COR_BU_RW')
!
!-------------------------------------------------------------------------------
!
@@ -310,9 +320,12 @@ ELSE
ENDIF
!
IF( .NOT.L1D ) THEN
+ IF (.NOT. LOCEAN) THEN
!
IF (KRR > 0) THEN
- ZCPD_OV_RD = XCPD / XRD
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'PREF', prths(:, :, :) )
+
+ ZCPD_OV_RD = XCPD / XRD
ZG_OV_CPD = -XG / XCPD
!
! stores the specific heat capacity (Cph) in ZWORK1
@@ -332,10 +345,10 @@ IF( .NOT.L1D ) THEN
* ( ( XRD + XRV * PRT(:,:,:,1) ) * ZCPD_OV_RD / ZWORK1(:,:,:) - 1. ) &
* PTHT(:,:,:)/PEXNREF(:,:,:)*MZF(PWT(:,:,:))*(ZG_OV_CPD/PTHVREF(:,:,:) &
-ZD1*4./7.*PEXNREF(:,:,:)/( XRADIUS+MZF(PZZ(:,:,:)) ))
-!
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'PREF', prths(:, :, :) )
END IF
-!
- IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'PREF_BU_RTH')
+ END IF
!
END IF
!
diff --git a/src/MNH/eddyUV_flux_one_wayn.f90 b/src/MNH/eddyUV_flux_one_wayn.f90
index 61bd982228fbcfb2ceafc541a9da7ed977167167..93c8fe46c51316c64ea58845e09213866a46fb96 100644
--- a/src/MNH/eddyUV_flux_one_wayn.f90
+++ b/src/MNH/eddyUV_flux_one_wayn.f90
@@ -56,21 +56,21 @@ END MODULE MODI_EDDYUV_FLUX_ONE_WAY_n
!!
! ##################################################################################
!
+USE MODD_BIKHARDT_n
USE MODD_DEF_EDDYUV_FLUX_n
-USE MODD_FIELD_n, ONLY:XRVS
+use modd_field, only: tfieldlist
+USE MODD_FIELD_n, ONLY: XRVS
USE MODD_GRID_n
-USE MODD_REF_n, ONLY:XRHODJ
-
USE MODD_METRICS_n
-USE MODI_GRADIENT_U
-!
-USE MODD_BIKHARDT_n
USE MODD_NESTING
-!
+USE MODD_REF_n, ONLY: XRHODJ
+
use mode_bikhardt
-USE MODE_FIELD, ONLY : TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
-use mode_tools_ll, only: GET_INDICE_ll
-!
+use mode_field, only: Find_field_id_from_mnhname
+use mode_tools_ll, only: GET_INDICE_ll
+
+USE MODI_GRADIENT_U
+
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KMI ! Model index
diff --git a/src/MNH/eddyUV_fluxn.f90 b/src/MNH/eddyUV_fluxn.f90
index b0110fc06efb05e4453294188521cc9c74da8129..f4879b6031859028fd3dba4e8e23c4a87a52b070 100644
--- a/src/MNH/eddyUV_fluxn.f90
+++ b/src/MNH/eddyUV_fluxn.f90
@@ -72,10 +72,8 @@ USE MODE_ll
!
USE MODD_PARAMETERS
USE MODD_CONF
-USE MODD_BUDGET
!
USE MODI_SHUMAN
-USE MODI_BUDGET
USE MODD_CST
!
USE MODD_DIM_n
diff --git a/src/MNH/eddy_flux_one_wayn.f90 b/src/MNH/eddy_flux_one_wayn.f90
index 0dfda6a59cecf2a8608eba6e2ab0c15ec1d602f3..40773ec8d8d091754aa4856860b87bd7be004815 100644
--- a/src/MNH/eddy_flux_one_wayn.f90
+++ b/src/MNH/eddy_flux_one_wayn.f90
@@ -56,21 +56,21 @@ END MODULE MODI_EDDY_FLUX_ONE_WAY_n
!!
! ##################################################################################
!
+USE MODD_BIKHARDT_n
USE MODD_DEF_EDDY_FLUX_n
-USE MODD_FIELD_n, ONLY:XRTHS
-USE MODD_REF_n, ONLY:XRHODJ
+use modd_field, only: tfieldlist
+USE MODD_FIELD_n, ONLY: XRTHS
USE MODD_GRID_n
-
USE MODD_METRICS_n
-USE MODI_GRADIENT_W
-USE MODI_GRADIENT_U
-!
-USE MODD_BIKHARDT_n
USE MODD_NESTING
-!
+USE MODD_REF_n, ONLY: XRHODJ
+
use mode_bikhardt
-USE MODE_FIELD, ONLY : TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
-!
+use mode_field, only: Find_field_id_from_mnhname
+
+USE MODI_GRADIENT_W
+USE MODI_GRADIENT_U
+
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KMI ! Model index
diff --git a/src/MNH/eddy_fluxn.f90 b/src/MNH/eddy_fluxn.f90
index 484bfe0d27527e9856eba19007380f1d6e65f1d1..ed52def268d0ea872591a158078514d3fef3316e 100644
--- a/src/MNH/eddy_fluxn.f90
+++ b/src/MNH/eddy_fluxn.f90
@@ -76,10 +76,8 @@ USE MODE_ll
!
USE MODD_PARAMETERS
USE MODD_CONF
-USE MODD_BUDGET
!
USE MODI_SHUMAN
-USE MODI_BUDGET
USE MODD_CST
!
USE MODD_DIM_n
diff --git a/src/MNH/elec_trid.f90 b/src/MNH/elec_trid.f90
deleted file mode 100644
index 2a8c5aad1ee4b91a34724b3e98f5fb61dfa75f39..0000000000000000000000000000000000000000
--- a/src/MNH/elec_trid.f90
+++ /dev/null
@@ -1,679 +0,0 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #####################
- MODULE MODI_ELEC_TRID
-! #####################
-!
-INTERFACE
-!
- SUBROUTINE ELEC_TRID(HLBCX,HLBCY, &
- PMAP,PDXHAT,PDYHAT,PDXHATM,PDYHATM,PRHOM, &
- PAF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY, &
- PRHODJ,PTHVREF,PZZ,PBFY,PEPOTFW_TOP )
-!
-IMPLICIT NONE
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! x-direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference * J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
- ! Temperature of the reference state
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! scale factor
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
-!
-REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
-REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
-!
-REAL, INTENT(OUT) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(OUT) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(OUT) :: PRHOM ! mean of XRHODJ on the plane
- ! x y localized at a mass
- ! level
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBFY ! elements (yslice) of the tri-diag.
- ! matrix in the pressure eq.
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEPOTFW_TOP ! top boundary condition of
- ! the tri-diag. system; it
- ! has the dimension of an
- ! electrical potential
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXY ! - along y
-
-!
-END SUBROUTINE ELEC_TRID
-!
-END INTERFACE
-!
-END MODULE MODI_ELEC_TRID
-!
-! ###################################################################
- SUBROUTINE ELEC_TRID(HLBCX,HLBCY, &
- PMAP,PDXHAT,PDYHAT,PDXHATM,PDYHATM,PRHOM, &
- PAF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY, &
- PRHODJ,PTHVREF,PZZ,PBFY,PEPOTFW_TOP )
-! ####################################################################
-!
-!!**** *ELEC_TRID * - Compute coefficients for the flat operator to get the
-!! electric potential from the Gauss equation
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical time independent
-! coefficients a(k), b(k), c(k) required for the calculation of the "flat"
-! (i.e. neglecting the orography) operator Laplacian. RHOJ is averaged on
-! the whole horizontal domain. The form of the eigenvalues of the flat
-! operator depends on the lateral boundary conditions. Furthermore, this
-! routine initializes TRIGS and IFAX arrays required for the FFT transform
-! used in the routine PRECOND.
-! ELEC_TRID (to invert the Gauss equation) differs from TRID (to solve the
-! pressure equation) by the bottom boundary condition, here Dirichlet
-! instead of Neumann, because the earth surface is conductive so it is a
-! surface with an electrical equipotential referenced to zero.
-!
-!!** METHOD
-!! ------
-!! The forms of the eigenvalues of the horizontal Laplacian are given by:
-!! Cyclic conditions:
-!! -----------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( imax ) <dyy> <dyy> ( jmax )
-!!
-!! Open conditions:
-!! -----------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( 2imax ) <dyy> <dyy> ( 2jmax )
-!!
-!! Cyclic condition along x and open condition along y:
-!! ------------------------------------------------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( imax ) <dyy> <dyy> ( 2jmax )
-!!
-!! Open condition along x and cyclic condition along y:
-!! ------------------------------------------------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( 2imax ) <dyy> <dyy> ( jmax )
-!!
-!! where m = 0,1,2....imax-1, n = 0,1,2....jmax-1
-!! Note that rhoj contains the Jacobian J = Deltax*Deltay*Deltaz = volume of
-!! an elementary mesh.
-
-!!
-!! EXTERNAL
-!! --------
-!! Function FFTFAX: initialization of TRIGSX,IFAXX,TRIGSY,IFAXY for
-!! the FFT transform
-!! GET_DIM_EXT_ll : get extended sub-domain sizes
-!! GET_INDICE_ll : get physical sub-domain bounds
-!! GET_DIM_PHYS_ll : get physical sub-domain sizes
-!! GET_GLOBALDIMS_ll : get physical global domain sizes
-!! GET_OR_ll : get origine coordonates of the physical sub-domain
-!! in global indices
-!! REDUCESUM_ll : sum into a scalar variable
-!! GET_SLICE_ll : get a slice of the global domain
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : define constants
-!! XPI : pi
-!! XCPD
-!! Module MODD_PARAMETERS: declaration of parameter variables
-!! JPHEXT, JPVEXT: define the number of marginal points out of the
-!! physical domain along horizontal and vertical directions respectively
-!! Module MODD_CONF: model configurations
-!! LCARTESIAN: logical for CARTESIAN geometry
-!! .TRUE. = Cartesian geometry used
-!! L2D: logical for 2D model version
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation (routine ELEC_TRID)
-!!
-!! AUTHOR
-!! ------
-!! P. HÃ…reil and J. Stein * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 25/07/94
-!! 14/04/95 (J. Stein) bug in the ZDZM computation
-!! ( stretched case)
-!! 8/07/96 (P. Jabouille) change the FFT initialization
-!! which now works for odd number.
-!! 14/01/97 Durran anelastic equation (Stein,Lafore)
-!! 15/06/98 (D.Lugato, R.Guivarch) Parallelisation
-!! 10/08/98 (N. Asencio) add parallel code
-!! use PDXHAT, PDYHAT and not PXHAT,PYHAT
-!! PBFY is initialized
-!! 20/08/00 (J. Stein, J. Escobar) optimisation of the solver
-!! PBFY transposition
-!! 14/03/02 (P. Jabouille) set values for meaningless spectral coefficients
-!! (to avoid problem in bouissinesq configuration)
-!! 01/07/12 (J-P. Pinty) add a non-homogeneous fair-weather
-!! top boundary condition (Neuman)
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_CST
-USE MODD_CONF
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAMETERS
-!
-USE MODE_ll
-USE MODE_MSG
-!
-!JUAN
-USE MODE_REPRO_SUM
-!JUAN
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! x-direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference * J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
- ! Temperature of the reference state
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! scale factor
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
-!
-REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
-REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
-!
-REAL, INTENT(OUT) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(OUT) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(OUT) :: PRHOM ! mean of XRHODJ on the plane
- ! x y localized at a mass
- ! level
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBFY ! elements (yslice) of the tri-diag.
-! matrix in the pressure eq. which is transposed. PBFY is a y-slices structure
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PEPOTFW_TOP ! top boundary condition of
- ! the tri-diag. system; it
- ! has the dimension of an
- ! electrical potential
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXY ! - along y
-
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IRESP ! FM return code
-INTEGER :: ILUOUT ! Logical unit number for
- ! output-listing
-INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! indice values of the physical subdomain
-INTEGER :: IKU ! size of the arrays along z
-INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll ! indice values of the physical global domain
-INTEGER :: IIMAX,IJMAX ! Number of points of the physical subdomain
-INTEGER :: IIMAX_ll,IJMAX_ll ! Number of points of Global physical domain
-!
-INTEGER :: JI,JJ,JK ! loop indexes
-!
-INTEGER :: INN ! temporary result for the computation of array TRIGS
-!
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZEIGEN_ll ! eigenvalues b(m,n) in global representation
-REAL, DIMENSION (:), ALLOCATABLE :: ZEIGENX_ll ! used for the computation of ZEIGEN_ll
-!
-REAL, DIMENSION( SIZE(PDXHAT)) :: ZWORKX ! work array to compute PDXHATM
-REAL, DIMENSION( SIZE(PDYHAT)) :: ZWORKY ! work array to compute PDYHATM
-!
-REAL :: ZGWNX,ZGWNY ! greater wave numbers allowed by the model
- ! configuration in x and y directions respectively
-!
-REAL, DIMENSION (SIZE(PZZ,3)) :: ZDZM ! mean of deltaz on the plane x y
- ! localized at a w-level
-!
-REAL :: ZANGLE,ZDEL ! needed for the initialization of the arrays used by the FFT
-!
-REAL :: ZINVMEAN ! inverse of inner points number in an horizontal grid
-!
-INTEGER :: IINFO_ll ! return code of parallel routine
-REAL, DIMENSION (SIZE(PMAP,1)) :: ZXMAP ! extraction of PMAP array along x
-REAL, DIMENSION (SIZE(PMAP,2)) :: ZYMAP ! extraction of PMAP array along y
-INTEGER :: IORXY_ll,IORYY_ll ! origin's coordinates of the y-slices subdomain
-INTEGER :: IIUY_ll,IJUY_ll ! dimensions of the y-slices subdomain
-INTEGER :: IXMODE_ll,IYMODE_ll ! number of modes in the x and y direction for global point of view
-INTEGER :: IXMODEY_ll,IYMODEY_ll ! number of modes in the x and y direction for y_slice point of view
-!JUAN16
-!TYPE(DOUBLE_DOUBLE) , DIMENSION (SIZE(PZZ,3)) :: ZRHOM_ll , ZDZM_ll
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZRHOM_2D , ZDZM_2D
-!JUAN16
-!
-!
-!
-!
-!
-!------------------------------------------------------------------------------
-!
-!* 1. INITIALIZATION
-! --------------
-!
-!* 1.1 retrieve a logical unit number
-! ------------------------------
-!
-ILUOUT = TLUOUT%NLU
-!
-!* 1.2 compute loop bounds
-! -------------------
-!
-! extended sub-domain
-CALL GET_DIM_EXT_ll ('Y',IIUY_ll,IJUY_ll)
-IKU=SIZE(PRHODJ,3)
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1 +JPVEXT
-IKE=IKU -JPVEXT
-! physical sub-domain
-CALL GET_DIM_PHYS_ll ( 'B',IIMAX,IJMAX)
-!
-! global physical domain limits
-CALL GET_GLOBALDIMS_ll ( IIMAX_ll, IJMAX_ll)
-IIB_ll = 1 + JPHEXT
-IIE_ll = IIMAX_ll + JPHEXT
-IJB_ll = 1 + JPHEXT
-IJE_ll = IJMAX_ll + JPHEXT
-!
-! the use of local array ZEIGENX and ZEIGEN would require some technical modifications
-!
-ALLOCATE (ZEIGENX_ll(IIMAX_ll + 2*JPHEXT))
-ALLOCATE (ZEIGEN_ll(IIMAX_ll + 2*JPHEXT, IJMAX_ll + 2*JPHEXT))
-ZEIGEN_ll = 0.0
-! Get the origin coordinates of the extended sub-domain in global landmarks
-CALL GET_OR_ll('Y',IORXY_ll,IORYY_ll)
-!
-!* 1.3 allocate x-slice array
-
-!
-!* 1.4 variables for the eigenvalues computation
-!
-ZGWNX = XPI/REAL(IIMAX_ll)
-ZGWNY = XPI/REAL(IJMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 2. COMPUTE THE AVERAGE OF RHOJ*CPD*THETAVREF ALONG XY
-! --------------------------------------------------
-!
-ZINVMEAN = 1./REAL(IIMAX_ll*IJMAX_ll)
-!JUAN16
-ALLOCATE(ZRHOM_2D(IIB:IIE, IJB:IJE))
-!
-DO JK = 1,SIZE(PZZ,3)
- IF ( CEQNSYS == 'DUR' .OR. CEQNSYS == 'MAE' ) THEN
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZRHOM_2D(JI,JJ) = PRHODJ(JI,JJ,JK)*XCPD*PTHVREF(JI,JJ,JK)*ZINVMEAN
- END DO
- END DO
- ELSEIF ( CEQNSYS == 'LHE' ) THEN
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZRHOM_2D(JI,JJ) = PRHODJ(JI,JJ,JK)*ZINVMEAN
- END DO
- END DO
- END IF
- ! global sum
- PRHOM(JK) = SUM_DD_R2_ll(ZRHOM_2D)
-END DO
-
-!
-! global sum
-!CALL REDUCESUM_ll(ZRHOM_ll,IINFO_ll)
-!PRHOM = ZRHOM_ll
-!JUAN16
-!
-!------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE MEAN INCREMENT BETWEEN Z LEVELS
-! -------------------------------------------
-!
-!JUAN16
-!ZDZM_ll = 0.
-ALLOCATE(ZDZM_2D(IIB:IIE, IJB:IJE))
-!
-DO JK = IKB-1,IKE
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZDZM_2D(JI,JJ) = (PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))*ZINVMEAN
- END DO
- END DO
- ZDZM(JK) = SUM_DD_R2_ll(ZDZM_2D)
-END DO
-ZDZM(IKE+1) = ZDZM(IKE)
-!
-! global sum
-!CALL REDUCESUM_ll(ZDZM_ll,IINFO_ll)
-!ZDZM = ZDZM_ll
-!JUAN16
-!
-!
-! vertical average to arrive at a w-level
-DO JK = IKE+1,IKB,-1
- ZDZM(JK) = (ZDZM(JK) + ZDZM(JK-1))*0.5
-END DO
-!
-ZDZM(IKB-1) = -999.
-!
-!------------------------------------------------------------------------------
-!
-!* 4. COMPUTE THE MEAN INCREMENT BETWEEN X LEVELS
-! -------------------------------------------
-!
-PDXHATM =0.
-! . local sum
-IF (LCARTESIAN) THEN
- PDXHATM = SUM_1DFIELD_ll ( PDXHAT,'X',IIB_ll,IIE_ll,IINFO_ll)
-ELSE
- ! Extraction of x-slice PMAP at j=(IJB_ll+IJE_ll)/2
- CALL GET_SLICE_ll (PMAP,'X',(IJB_ll+IJE_ll)/2,ZXMAP(IIB:IIE) &
- ,IIB,IIE,IINFO_ll)
- ! initialize the work array = PDXHAT/ZXMAP
- ZWORKX(IIB:IIE) = PDXHAT(IIB:IIE)/ ZXMAP (IIB:IIE)
- PDXHATM = SUM_1DFIELD_ll ( ZWORKX,'X',IIB_ll,IIE_ll,IINFO_ll)
-END IF
-! . division to complete sum
-PDXHATM = PDXHATM / REAL(IIMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 5. COMPUTE THE MEAN INCREMENT BETWEEN Y LEVELS
-! -------------------------------------------
-!
-PDYHATM = 0.
-IF (LCARTESIAN) THEN
- PDYHATM = SUM_1DFIELD_ll ( PDYHAT,'Y',IJB_ll,IJE_ll,IINFO_ll)
-ELSE
- ! Extraction of y-slice PMAP at i=IIB_ll+IIE_ll/2
- CALL GET_SLICE_ll (PMAP,'Y',(IIB_ll+IIE_ll)/2,ZYMAP(IJB:IJE) &
- ,IJB,IJE,IINFO_ll)
- ! initialize the work array = PDYHAT / ZYMAP
- ZWORKY(IJB:IJE) = PDYHAT(IJB:IJE) / ZYMAP (IJB:IJE)
- PDYHATM = SUM_1DFIELD_ll ( ZWORKY,'Y',IJB_ll,IJE_ll,IINFO_ll)
-END IF
-! . division to complete sum
-PDYHATM= PDYHATM / REAL(IJMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 6. COMPUTE THE OUT-DIAGONAL ELEMENTS A AND C OF THE MATRIX
-! -------------------------------------------------------
-!
-DO JK = IKB,IKE
- PAF(JK) = 0.5 * ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2
- PCF(JK) = 0.5 * ( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1) **2
-END DO
-!
-! at the upper and lower levels PAF and PCF are computed using the Neumann
-! conditions applying on the vertical component of the gradient
-!
-!
-! Neumann boundary condition (top of atmosphere)
-!
-PAF(IKE+1) = -0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / ZDZM(IKE+1) **2
-!
-! Dirichlet boundary condition (earth surface)
-!
-PCF(IKB-1) = 0.0
-!
-PAF(IKB-1) = 999.
-PCF(IKE+1) = 999.
-!------------------------------------------------------------------------------
-!* 7. COMPUTE THE DIAGONAL ELEMENTS B OF THE MATRIX
-! ---------------------------------------------
-!
-!* 7.1 compute the horizontal eigenvalues
-!
-!
-!* 7.1.1 compute the eigenvalues along the x direction
-!
-SELECT CASE (HLBCX(1))
-! in the cyclic case, the eigenvalues are the same for two following JM values:
-! it corresponds to the real and complex parts of the FFT
- CASE('CYCL') ! cyclic case
- IXMODE_ll = IIMAX_ll+2
- IXMODEY_ll = IIUY_ll
-!
- DO JI = 1,IXMODE_ll
- ZEIGENX_ll(JI) = - ( 2. * SIN ( (JI-1)/2*ZGWNX ) / PDXHATM )**2
- END DO
- CASE DEFAULT ! other cases
- IXMODE_ll = IIMAX_ll
-!
-!
- IF (LEAST_ll(HSPLITTING='Y')) THEN
- IXMODEY_ll = IIUY_ll - 2
- ELSE
- IXMODEY_ll = IIUY_ll
- END IF
-!
-!
- DO JI = 1,IXMODE_ll
- ZEIGENX_ll(JI) = - ( 2. *SIN (0.5*REAL(JI-1)*ZGWNX ) / PDXHATM )**2
- END DO
-END SELECT
-!
-!* 7.1.2 compute the eventual eigenvalues along the y direction
-!
-IF (.NOT. L2D) THEN
-!
-! y lateral boundary conditions for three-dimensional cases
-!
- SELECT CASE (HLBCY(1))
-! in the cyclic case, the eigenvalues are the same for two following JN values:
-! it corresponds to the real and complex parts of the FFT result
-!
- CASE('CYCL') ! 3D cyclic case
- IYMODE_ll = IJMAX_ll+2
- IYMODEY_ll = IJUY_ll
-!
- DO JJ = 1,IYMODE_ll
- DO JI = 1,IXMODE_ll
- ZEIGEN_ll(JI,JJ) = ZEIGENX_ll(JI) - &
- ( 2.* SIN ( (JJ-1)/2*ZGWNY ) / PDYHATM )**2
- END DO
- END DO
-!
- CASE DEFAULT ! 3D non-cyclic cases
- IYMODE_ll = IJMAX_ll
- IYMODEY_ll = IJUY_ll - 2
-!
- DO JJ = 1,IYMODE_ll
- DO JI = 1,IXMODE_ll
- ZEIGEN_ll(JI,JJ) = ZEIGENX_ll(JI) - ( 2.* SIN (0.5*REAL(JJ-1)*ZGWNY ) / &
- PDYHATM )**2
- END DO
- END DO
-!
- END SELECT
-ELSE
-!
-! copy the x eigenvalue array in a 2D array for a 2D case
-!
- IYMODE_ll = 1
- IYMODEY_ll = 1
- ZEIGEN_ll(1:IXMODE_ll,1)=ZEIGENX_ll(1:IXMODE_ll)
-!
-END IF
-!
-DEALLOCATE(ZEIGENX_ll)
-!
-!* 7.2 compute the matrix diagonal elements
-!
-!
-PBFY = 1.
-IF (L2D) THEN
- DO JK= IKB,IKE
- DO JJ= 1, IYMODEY_ll
- DO JI= 1, IXMODEY_ll
- PBFY(JI,JJ,JK) = PRHOM(JK)* ZEIGEN_ll(JI+IORXY_ll-1,JJ+IORYY_ll-1) - 0.5 * &
- ( ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2 &
- +( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1)**2 )
- END DO
- END DO
- END DO
-! at the upper and lower levels PBFY is computed using the Neumann
-! condition
-!
- PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKB) = PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKB) - &
- PAF(IKB)
- PAF(IKB) = 0.0
- PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKB-1) = 1.0
- !
- PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKE+1) = 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / &
- ZDZM(IKE+1) **2
- !
- !
-ELSE
- DO JK= IKB,IKE
- DO JJ= 1, IYMODEY_ll
- DO JI= 1, IXMODEY_ll
- PBFY(JJ,JI,JK) = PRHOM(JK)* ZEIGEN_ll(JI+IORXY_ll-1,JJ+IORYY_ll-1) - 0.5 * &
- ( ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2 &
- +( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1)**2 )
- END DO
- END DO
- END DO
-! at the upper and lower levels PBFY is computed using the Neumann
-! condition
-!
- PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKB) = PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKB) - &
- PAF(IKB)
- PAF(IKB) = 0.0
- PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKB-1) = 1.0
- !
- PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKE+1) = 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / &
- ZDZM(IKE+1) **2
- !
-END IF
-!
-DEALLOCATE(ZEIGEN_ll)
-!
-! second coefficent is meaningless in cyclic case
-IF (HLBCX(1) == 'CYCL' .AND. L2D) PBFY(2,:,:)=1.
-IF (HLBCX(1) == 'CYCL' .AND. .NOT.(L2D) .AND. LWEST_ll(HSPLITTING='Y')) PBFY(:,2,:)=1.
-IF (HLBCY(1) == 'CYCL' .AND. .NOT.(L2D)) PBFY(2,:,:)=1.
-!
-!------------------------------------------------------------------------------
-!* 8. INITIALIZATION OF THE TRIGS AND IFAX ARRAYS FOR THE FFT
-! -------------------------------------------------------
-!
-! 8.1 x lateral boundary conditions
-!
-CALL SET99(PTRIGSX,KIFAXX,IIMAX_ll)
-!
-! test on the value of KIMAX: KIMAX must be factorizable as a product
-! of powers of 2,3 and 5. KIFAXX(10) is equal to IIMAX if the decomposition
-! is correct, then KIFAXX(1) contains the number of decomposition factors
-! of KIMAX.
-!
-IF (KIFAXX(10) /= IIMAX_ll) THEN
- WRITE(UNIT=ILUOUT,FMT="(' ERROR',/, &
- &' : THE FORM OF THE FFT USED FOR THE INVERSION OF THE FLAT ',/,&
- &' OPERATOR REQUIRES THAT KIMAX MUST BE FACTORIZABLE' ,/,&
- & ' AS A PRODUCT OF POWERS OF 2, 3 AND 5.')")
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ELEC_TRID','')
-END IF
-!
-IF (HLBCX(1) /= 'CYCL') THEN
-!
-! extra trigs for shifted (co) sine transform (FFT55)
-!
- INN=2*(IIMAX_ll)
- ZDEL=ASIN(1.0)/REAL(IIMAX_ll)
- DO JI=1,IIMAX_ll
- ZANGLE=REAL(JI)*ZDEL
- PTRIGSX(INN+JI)=SIN(ZANGLE)
- END DO
-!
-ENDIF
-!
-! 8.2 y lateral boundary conditions
-!
-IF (.NOT. L2D) THEN
- CALL SET99(PTRIGSY,KIFAXY,IJMAX_ll)
- !
- ! test on the value of KJMAX: KJMAX must be factorizable as a product
- ! of powers of 2,3 and 5. KIFAXY(10) is equal to IJMAX_ll if the decomposition
- ! is correct, then KIFAXX(1) contains the number of decomposition factors
- ! of IIMAX_ll.
- !
- IF (KIFAXY(10) /= IJMAX_ll) THEN
- WRITE(UNIT=ILUOUT,FMT="(' ERROR',/, &
- &' : THE FORM OF THE FFT USED FOR THE INVERSION OF THE FLAT ',/,&
- &' OPERATOR REQUIRES THAT KJMAX MUST BE FACTORIZABLE' ,/,&
- & ' AS A PRODUCT OF POWERS OF 2, 3 AND 5.')")
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','ELEC_TRID','')
- END IF
- !
- ! 8.3 top boundary conditions
- !
- PEPOTFW_TOP(:,:) = PEPOTFW_TOP(:,:) / ZDZM(IKE+1)
-
- !
- ! other cases
- !
- IF (HLBCY(1) /= 'CYCL') THEN
- !
- ! extra trigs for shifted (co) sine transform
- !
- INN=2*(IJMAX_ll)
- ZDEL=ASIN(1.0)/REAL(IJMAX_ll)
- DO JJ=1,IJMAX_ll
- ZANGLE=REAL(JJ)*ZDEL
- PTRIGSY(INN+JJ)=SIN(ZANGLE)
- END DO
- !
- ENDIF
- !
-ENDIF
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE ELEC_TRID
diff --git a/src/MNH/emoist.f90 b/src/MNH/emoist.f90
index 891977a240c86fa02baa388ea8610c1d0ae76d98..8fd26c4d75ed756d0091aae1de2d446e3467c898 100644
--- a/src/MNH/emoist.f90
+++ b/src/MNH/emoist.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -92,15 +92,17 @@ SUBROUTINE EMOIST(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PAMOIST,PSRCM,PEMOIST)
!! J. Stein Spet 15, 1996 Amoist previously computed
!! J.-P. Pinty May 20, 2003 Improve EMOIST expression
!! M.Moge April, 2016 Use openACC directives to port the TURB part of Meso-NH on GPU
+!! 03/2021 (JL Redelsperger) Ocean model case
!!
!! ----------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODD_CST
+USE MODD_DYN_n, ONLY : LOCEAN
use mode_mppdb
-
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
@@ -151,15 +153,22 @@ allocate( zrw ( size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
!
!* 1. COMPUTE EMOIST
! --------------
-!
-!
!$acc kernels
-IF ( KRR == 0 ) THEN ! dry case
- PEMOIST(:,:,:) = 0.
-ELSE IF ( KRR == 1 ) THEN ! only vapor
+IF (LOCEAN) THEN
+ IF ( KRR == 0 ) THEN ! Unsalted
+ PEMOIST(:,:,:) = 0.
+ ELSE
+ PEMOIST(:,:,:) = 1. ! Salted case
+ END IF
+!
+ELSE
+!
+ IF ( KRR == 0 ) THEN ! dry case
+ PEMOIST(:,:,:) = 0.
+ ELSE IF ( KRR == 1 ) THEN ! only vapor
ZDELTA = (XRV/XRD) - 1.
PEMOIST(:,:,:) = ZDELTA*PTHLM(:,:,:)
-ELSE ! liquid water & ice present
+ ELSE ! liquid water & ice present
ZDELTA = (XRV/XRD) - 1.
ZRW(:,:,:) = PRM(:,:,:,1)
!
@@ -207,6 +216,8 @@ ELSE ! liquid water & ice present
/ (1. + ZRW(:,:,:)) &
) * PAMOIST(:,:,:) * 2. * PSRCM(:,:,:)
END IF
+ END IF
+!
END IF
!$acc end kernels
diff --git a/src/MNH/end_mask_compress.f90 b/src/MNH/end_mask_compress.f90
index 448d38e47123e85ce6031f4e6d51fe85611f1b36..cd867dccb817d24f0253393f16fcc55d84a64eaf 100644
--- a/src/MNH/end_mask_compress.f90
+++ b/src/MNH/end_mask_compress.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 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 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 budget 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!#############################
MODULE MODI_END_MASK_COMPRESS
!#############################
@@ -19,7 +14,7 @@ FUNCTION END_MASK_COMPRESS(PVARS) RESULT(PCOMPRESS)
USE MODD_BUDGET
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
-REAL, DIMENSION(NBUKMAX,NBUWRNB,NBUMASK) :: PCOMPRESS ! result
+REAL, DIMENSION(NBUKMAX,nbusubwrite,NBUMASK) :: PCOMPRESS ! result
!
END FUNCTION END_MASK_COMPRESS
!
@@ -57,7 +52,7 @@ END MODULE MODI_END_MASK_COMPRESS
!! LBU_KCP : switch for compression in K direction
!! NBUKMAX : first dimension of the budget array ( number of grid points along
!! K direction)
-!! NBUWRNB : second dimension of the budget array ( number of buffered times)
+!! nbusubwrite: second dimension of the budget array ( number of buffered times)
!! NBUMASK : third dimension of the budget array ( number of mask zones)
!!
!!
@@ -90,7 +85,7 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments and result :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
-REAL, DIMENSION(NBUKMAX,NBUWRNB,NBUMASK) :: PCOMPRESS ! result
+REAL, DIMENSION(NBUKMAX,nbusubwrite,NBUMASK) :: PCOMPRESS ! result
!
!* 0.2 Declarations of local variables :
!
@@ -108,7 +103,7 @@ INTEGER :: IINFO_ll ! return status code of the interface routines
!
IF (LBU_KCP) THEN
IF (CBUTYPE=='MASK' ) THEN
- ALLOCATE(ZVAR2D(NBUWRNB,NBUMASK))
+ ALLOCATE(ZVAR2D(nbusubwrite,NBUMASK))
ZVAR2D(:,:)=PVARS(1,:,:)
ELSE ! the processor has a empty intersection with the MASK region
ZVAR2D(:,:)=0.
@@ -118,7 +113,7 @@ IF (LBU_KCP) THEN
DEALLOCATE(ZVAR2D)
!
ELSE IF (.NOT.LBU_KCP) THEN
- ALLOCATE(ZVAR3D(NBUKMAX,NBUWRNB,NBUMASK))
+ ALLOCATE(ZVAR3D(NBUKMAX,nbusubwrite,NBUMASK))
IF (CBUTYPE=='MASK' ) THEN
ZVAR3D(:,:,:)=PVARS(:,:,:)
ELSE ! the processor has a empty intersection with the MASK region
diff --git a/src/MNH/endstep.f90 b/src/MNH/endstep.f90
index 2906923ac0435622452e3ca2cf5cf1d678e3e619..d082702865c12623d57e9895f020bf120c4bccce 100644
--- a/src/MNH/endstep.f90
+++ b/src/MNH/endstep.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.
@@ -147,7 +147,6 @@ END MODULE MODI_ENDSTEP
!! MODULE MODD_CTURB containing XTKEMIN, XEPSMIN
!! MODULE MODD_BUDGET:
!! NBUMOD : model in which budget is calculated
-!! NBUPROCCTR : process counter used for each budget variable
!! NBUTSHIFT : temporal shift for budgets writing
!!
!! REFERENCE
@@ -192,29 +191,35 @@ END MODULE MODI_ENDSTEP
!! 04/2014 (C.Lac) Check on the positivity of PSVT
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! 02/2019 (S. Bielli) Sea salt : significant sea wave height influences salt emission; 5 salt modes
-!!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_DYN
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, lbu_enable, &
+ 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, &
+ nbustep, tbudgets
+USE MODD_CH_AEROSOL, ONLY: LORILAM
USE MODD_CONF
USE MODD_CTURB
+USE MODD_DUST, ONLY: LDUST
+USE MODD_DYN
USE MODD_GRID_n
-USE MODD_BUDGET
-USE MODD_NSV, ONLY : XSVMIN, NSV_CHEMBEG, NSV_CHEMEND, &
- NSV_AERBEG, NSV_AEREND,&
- NSV_DSTBEG, NSV_DSTEND,&
- NSV_SNWBEG, NSV_SNWEND
-USE MODD_CH_AEROSOL, ONLY : LORILAM
-USE MODD_DUST, ONLY : LDUST
-USE MODD_PARAM_C2R2, ONLY : LACTIT
-USE MODD_PARAM_LIMA, ONLY : LACTIT_LIMA=>LACTIT
-USE MODD_LBC_n, ONLY : CLBCX, CLBCY
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-USE MODI_BUDGET
+USE MODD_LBC_n, ONLY: CLBCX, CLBCY
+USE MODD_NSV, ONLY: XSVMIN, NSV_CHEMBEG, NSV_CHEMEND, &
+ NSV_AERBEG, NSV_AEREND,&
+ NSV_DSTBEG, NSV_DSTEND,&
+ NSV_SNWBEG, NSV_SNWEND
+USE MODD_PARAM_C2R2, ONLY: LACTIT
+USE MODD_PARAM_LIMA, ONLY: LACTIT_LIMA=>LACTIT
+
+use mode_budget, only: Budget_store_end, Budget_store_init
+
USE MODI_SHUMAN
!
USE MODE_ll
@@ -278,6 +283,8 @@ REAL, DIMENSION(:,:), INTENT(INOUT) :: PZWS ! significant w
INTEGER:: JSV ! loop counters
INTEGER :: IIB, IIE ! index of first and last inner mass points along x
INTEGER :: IJB, IJE ! index of first and last inner mass points along y
+real, dimension(:,:,:), allocatable :: zrhodjontime
+real, dimension(:,:,:), allocatable :: zwork
!
!------------------------------------------------------------------------------
!
@@ -512,47 +519,120 @@ END IF
!* 10. STORAGE IN BUDGET ARRAYS
!
IF (LBU_ENABLE) THEN
- NBUPROCCTR(1:12+KSV)=3
- NBUCTR_ACTV(1:12+KSV)=3
-!
- IF (LBUDGET_U) CALL BUDGET (PUT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,1,'AVEF_BU_RU')
- IF (LBUDGET_V) CALL BUDGET (PVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,2,'AVEF_BU_RV')
- IF (LBUDGET_W) CALL BUDGET (PWT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,3,'AVEF_BU_RW')
- IF (LBUDGET_TH) CALL BUDGET (PTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,4,'AVEF_BU_RTH')
- IF (LBUDGET_TKE) CALL BUDGET (PTKET(:,:,:)*PRHODJ(:,:,:)/PTSTEP,5,'AVEF_BU_RTKE')
- IF (LBUDGET_RV) CALL BUDGET (PRT(:,:,:,1)*PRHODJ(:,:,:)/PTSTEP,6,'AVEF_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRT(:,:,:,2)*PRHODJ(:,:,:)/PTSTEP,7,'AVEF_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRT(:,:,:,3)*PRHODJ(:,:,:)/PTSTEP,8,'AVEF_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRT(:,:,:,4)*PRHODJ(:,:,:)/PTSTEP,9,'AVEF_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRT(:,:,:,5)*PRHODJ(:,:,:)/PTSTEP,10,'AVEF_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRT(:,:,:,6)*PRHODJ(:,:,:)/PTSTEP,11,'AVEF_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRT(:,:,:,7)*PRHODJ(:,:,:)/PTSTEP,12,'AVEF_BU_RRH')
- IF (LBUDGET_SV) THEN
- DO JSV=1,KSV
- CALL BUDGET (PSVT(:,:,:,JSV)*PRHODJ(:,:,:)/PTSTEP,12+JSV,'AVEF_BU_RSV')
- END DO
- END IF
-!
- NBUPROCCTR(1:12+KSV)=2
- NBUCTR_ACTV(1:12+KSV)=2
-!
- IF (LBUDGET_U) CALL BUDGET (PUS*MXM(PRHODJ)/PTSTEP,1,'ENDF_BU_RU')
- IF (LBUDGET_V) CALL BUDGET (PVS*MYM(PRHODJ)/PTSTEP,2,'ENDF_BU_RV')
- IF (LBUDGET_W) CALL BUDGET (PWS*MZM(PRHODJ)/PTSTEP,3,'ENDF_BU_RW')
- IF (LBUDGET_TH) CALL BUDGET (PTHS*PRHODJ/PTSTEP,4,'ENDF_BU_RTH')
- IF (LBUDGET_TKE) CALL BUDGET (PTKES*PRHODJ/PTSTEP,5,'ENDF_BU_RTKE')
- IF (LBUDGET_RV) CALL BUDGET (PRS(:,:,:,1)*PRHODJ/PTSTEP,6,'ENDF_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRS(:,:,:,2)*PRHODJ/PTSTEP,7,'ENDF_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRS(:,:,:,3)*PRHODJ/PTSTEP,8,'ENDF_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRS(:,:,:,4)*PRHODJ/PTSTEP,9,'ENDF_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRS(:,:,:,5)*PRHODJ/PTSTEP,10,'ENDF_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRS(:,:,:,6)*PRHODJ/PTSTEP,11,'ENDF_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRS(:,:,:,7)*PRHODJ/PTSTEP,12,'ENDF_BU_RRH')
- IF (LBUDGET_SV) THEN
- DO JSV=1,KSV
- CALL BUDGET (PSVS(:,:,:,JSV)*PRHODJ/PTSTEP,JSV+12,'ENDF_BU_RSV')
- END DO
- END IF
+ !Division by nbustep to compute average on the selected time period
+ if ( lbudget_u .or. lbudget_v .or. lbudget_w .or. lbudget_th &
+ .or. lbudget_tke .or. lbudget_rv .or. lbudget_rc .or. lbudget_rr .or. lbudget_ri &
+ .or. lbudget_rs .or. lbudget_rg .or. lbudget_rh .or. lbudget_sv ) then
+ Allocate( zrhodjontime, mold = prhodj )
+ Allocate( zwork, mold = prhodj )
+ zrhodjontime(:, :, :) = prhodj(:, :, :) / ( ptstep * nbustep )
+ end if
+
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'AVEF', put (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'AVEF', pvt (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'AVEF', pwt (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'AVEF', ptht (:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'AVEF', ptket(:, :, :) * zrhodjontime(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'AVEF', prt (:, :, :, 1) * zrhodjontime(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'AVEF', prt (:, :, :, 2) * zrhodjontime(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'AVEF', prt (:, :, :, 3) * zrhodjontime(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'AVEF', prt (:, :, :, 4) * zrhodjontime(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'AVEF', prt (:, :, :, 5) * zrhodjontime(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'AVEF', prt (:, :, :, 6) * zrhodjontime(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'AVEF', prt (:, :, :, 7) * zrhodjontime(:, :, :) )
+ if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'AVEF', psvt(:, :, :, jsv) * zrhodjontime(:, :, :) )
+ end do
+ end if
+
+ if ( lbudget_u ) then
+ zwork(:, :, :) = pus (:, :, :) * Mxm( prhodj(:, :, :) ) / ptstep
+ call Budget_store_end( tbudgets(NBUDGET_U ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_U ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_v ) then
+ zwork(:, :, :) = pvs (:, :, :) * Mym( prhodj(:, :, :) ) / ptstep
+ call Budget_store_end( tbudgets(NBUDGET_V ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_V ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_w ) then
+ zwork(:, :, :) = pws (:, :, :) * Mzm( prhodj(:, :, :) ) / ptstep
+ call Budget_store_end( tbudgets(NBUDGET_W ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_W ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_th .or. lbudget_tke .or. lbudget_rv .or. lbudget_rc .or. lbudget_rr &
+ .or. lbudget_ri .or. lbudget_rs .or. lbudget_rg .or. lbudget_rh .or. lbudget_sv ) then
+ zrhodjontime(:, :, :) = prhodj(:, :, :) / ptstep
+ end if
+
+ if ( lbudget_th ) then
+ zwork(:, :, :) = pths (:, :, :) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_TH ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_TH ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_tke ) then
+ zwork(:, :, :) = ptkes(:, :, :) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_TKE), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_TKE), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rv ) then
+ zwork(:, :, :) = prs (:, :, :, 1) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RV ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RV ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rc ) then
+ zwork(:, :, :) = prs (:, :, :, 2) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RC ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RC ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rr ) then
+ zwork(:, :, :) = prs (:, :, :, 3) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RR ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RR ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_ri ) then
+ zwork(:, :, :) = prs (:, :, :, 4) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RI ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RI ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rs ) then
+ zwork(:, :, :) = prs (:, :, :, 5) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RS ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RS ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rg ) then
+ zwork(:, :, :) = prs (:, :, :, 6) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RG ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RG ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_rh ) then
+ zwork(:, :, :) = prs (:, :, :, 7) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(NBUDGET_RH ), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(NBUDGET_RH ), 'ASSE', zwork )
+ end if
+
+ if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ zwork(:, :, :) = psvs(:, :, :, jsv) * zrhodjontime(:, :, :)
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'ENDF', zwork )
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'ASSE', zwork )
+ end do
+ end if
+
+ if ( Allocated( zwork ) ) Deallocate( zwork )
+ if ( Allocated( zrhodjontime ) ) Deallocate( zrhodjontime )
END IF
!
!------------------------------------------------------------------------------
diff --git a/src/MNH/endstep_budget.f90 b/src/MNH/endstep_budget.f90
index d6c619db4af46d775e511a1dfed82a7cf4909d42..eef2796be9394b7317e9bd82c6a46ff3d417a344 100644
--- a/src/MNH/endstep_budget.f90
+++ b/src/MNH/endstep_budget.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE ENDSTEP_BUDGET(TPDIAFILE,KTCOUNT, &
- TPDTCUR,TPDTMOD,PTSTEP,KSV)
+ TPDTCUR,PTSTEP,KSV)
!
USE MODD_IO, ONLY: TFILEDATA
USE MODD_TYPE_DATE
@@ -18,7 +18,6 @@ USE MODD_TYPE_DATE
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
INTEGER, INTENT(IN) :: KTCOUNT ! temporal loop counter
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
-TYPE (DATE_TIME), INTENT(IN) :: TPDTMOD ! Creation date and time
REAL, INTENT(IN) :: PTSTEP ! time step
INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
!
@@ -30,7 +29,7 @@ END MODULE MODI_ENDSTEP_BUDGET
!
! ####################################################
SUBROUTINE ENDSTEP_BUDGET(TPDIAFILE,KTCOUNT, &
- TPDTCUR,TPDTMOD,PTSTEP,KSV)
+ TPDTCUR,PTSTEP,KSV)
! ####################################################
!
!!**** *ENDSTEP_BUDGET* - routine to call the routine write_budget
@@ -56,25 +55,6 @@ END MODULE MODI_ENDSTEP_BUDGET
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_BUDGET
-!! CBUTYPE : budget type : CART, MASK or NONE
-!! LBU_BEG : switch for the budget begining
-!! NBUTIME : number of the budget step
-!! NBUWRI : NUMBER of budget steps when the budget
-!! is written on FM-file
-!! XBURU : budget array of the variable RU
-!! XBURV : budget array of the variable RV
-!! XBURW : budget array of the variable RW
-!! XBURTH : budget array of the variable RTH
-!! XBURTKE : budget array of the variable RTKE
-!! XBURRV : budget array of the variable RRV
-!! XBURRC : budget array of the variable RRC
-!! XBURRR : budget array of the variable RRR
-!! XBURRI : budget array of the variable RRI
-!! XBURRS : budget array of the variable RRS
-!! XBURRG : budget array of the variable RRG
-!! XBURRH : budget array of the variable RRH
-!! XBURSVx : budget array of the variable RSVx
-!!
!!
!! REFERENCE
!! ---------
@@ -94,65 +74,69 @@ END MODULE MODI_ENDSTEP_BUDGET
!! N. Asensio 22/06/99 // MASK case : delete KIU,KJU,KKU arguments
!! and change the write_budget call
!! C.Lac 11/09/15 adaptation to FIT temporal scheme
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 01-03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 25/01/2021: bugfix: do not call Write_budget at the beginning of the simulation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_BUDGET
USE MODD_IO, ONLY: TFILEDATA
USE MODD_TIME
-USE MODD_BUDGET
!
-USE MODI_WRITE_BUDGET
+use mode_msg
+use mode_write_budget, only: Write_budget
!
IMPLICIT NONE
!
-!
!* 0.1 Declarations of arguments :
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
INTEGER, INTENT(IN) :: KTCOUNT ! temporal loop counter
TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
-TYPE (DATE_TIME), INTENT(IN) :: TPDTMOD ! Creation date and time
REAL, INTENT(IN) :: PTSTEP ! time step
INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
+
+integer :: jbu, jgrp
+
!-------------------------------------------------------------------------------
!
+call Print_msg( NVERB_DEBUG, 'BUD', 'Endstep_budget', 'called' )
+
+!Do not call Write_budget at the beginning of the simulation (this is necessary in the case were xbulen = xtstep)
+IF ( KTCOUNT == 1 ) RETURN
+
SELECT CASE(CBUTYPE)
!
!
!* 1. 'CART' CASE
! -----------
!
- CASE('CART','SKIP')
+ CASE('CART','SKIP')
!
-!* 1.1 storage of the budget fields
+!* 1.1 storage of the budget fields
!
- IF( MODULO(KTCOUNT,NBUSTEP*NBUWRNB) == 0 ) THEN
- CALL WRITE_BUDGET(TPDIAFILE,TPDTCUR,TPDTMOD,PTSTEP, KSV )
+ IF( MODULO(KTCOUNT,NBUSTEP*nbusubwrite) == 0 ) THEN
+ call Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
!
!* 1.2 resetting the budget arrays to 0.
!
- IF (ALLOCATED(XBURU)) XBURU=0.
- IF (ALLOCATED(XBURV)) XBURV=0.
- IF (ALLOCATED(XBURW)) XBURW=0.
- IF (ALLOCATED(XBURTH)) XBURTH=0.
- IF (ALLOCATED(XBURTKE)) XBURTKE=0.
- IF (ALLOCATED(XBURRV)) XBURRV=0.
- IF (ALLOCATED(XBURRC)) XBURRC=0.
- IF (ALLOCATED(XBURRR)) XBURRR=0.
- IF (ALLOCATED(XBURRI)) XBURRI=0.
- IF (ALLOCATED(XBURRS)) XBURRS=0.
- IF (ALLOCATED(XBURRG)) XBURRG=0.
- IF (ALLOCATED(XBURRH)) XBURRH=0.
- IF (ALLOCATED(XBURSV)) XBURSV=0.
- IF (ALLOCATED(XBURHODJU)) XBURHODJU=0.
- IF (ALLOCATED(XBURHODJV)) XBURHODJV=0.
- IF (ALLOCATED(XBURHODJW)) XBURHODJW=0.
- IF (ALLOCATED(XBURHODJ)) XBURHODJ =0.
+ ! Rhodj arrays
+ if ( tbudgets(NBUDGET_U)%lenabled ) tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = 0.
+ if ( tbudgets(NBUDGET_V)%lenabled ) tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = 0.
+ if ( tbudgets(NBUDGET_W)%lenabled ) tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = 0.
+ ! Rhodj array for other budgets than U, V, W
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, :, :) = 0.
+ ! Budget arrays
+ do jbu = 1, nbudgets
+ if ( tbudgets(jbu)%lenabled ) then
+ do jgrp = 1, tbudgets(jbu)%ngroups
+ tbudgets(jbu)%tgroups(jgrp)%xdata(:, :, : ) = 0.
+ end do
+ end if
+ end do
!
!* 1.3 reset budget beginning flag to TRUE
!
@@ -164,31 +148,28 @@ SELECT CASE(CBUTYPE)
! -----------
!
CASE('MASK')
- IF( MODULO(KTCOUNT,NBUSTEP*NBUWRNB) == 0 ) THEN
+ IF( MODULO(KTCOUNT,NBUSTEP*nbusubwrite) == 0 ) THEN
!
!* 2.1 storage of the budget fields
!
- CALL WRITE_BUDGET(TPDIAFILE,TPDTCUR,TPDTMOD,PTSTEP, KSV)
+ call Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
!
!* 2.2 reset the budget fields to 0.
!
- IF (ALLOCATED(XBURU)) XBURU=0.
- IF (ALLOCATED(XBURV)) XBURV=0.
- IF (ALLOCATED(XBURW)) XBURW=0.
- IF (ALLOCATED(XBURTH)) XBURTH=0.
- IF (ALLOCATED(XBURTKE)) XBURTKE=0.
- IF (ALLOCATED(XBURRV)) XBURRV=0.
- IF (ALLOCATED(XBURRC)) XBURRC=0.
- IF (ALLOCATED(XBURRR)) XBURRR=0.
- IF (ALLOCATED(XBURRI)) XBURRI=0.
- IF (ALLOCATED(XBURRS)) XBURRS=0.
- IF (ALLOCATED(XBURRG)) XBURRG=0.
- IF (ALLOCATED(XBURRH)) XBURRH=0.
- IF (ALLOCATED(XBURSV)) XBURSV=0.
- IF (ALLOCATED(XBURHODJU)) XBURHODJU=0.
- IF (ALLOCATED(XBURHODJV)) XBURHODJV=0.
- IF (ALLOCATED(XBURHODJW)) XBURHODJW=0.
- IF (ALLOCATED(XBURHODJ)) XBURHODJ =0.
+ ! Rhodj arrays
+ if ( tbudgets(NBUDGET_U)%lenabled ) tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = 0.
+ if ( tbudgets(NBUDGET_V)%lenabled ) tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = 0.
+ if ( tbudgets(NBUDGET_W)%lenabled ) tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = 0.
+ ! Rhodj array for other budgets than U, V, W
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, :, :) = 0.
+ ! Budget arrays
+ do jbu = 1, nbudgets
+ if ( tbudgets(jbu)%lenabled ) then
+ do jgrp = 1, tbudgets(jbu)%ngroups
+ tbudgets(jbu)%tgroups(jgrp)%xdata(:, :, : ) = 0.
+ end do
+ end if
+ end do
!
NBUTIME=0
!
diff --git a/src/MNH/eol_adnr.f90 b/src/MNH/eol_adnr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b47d14fa35958b0c86f7a2337f566a928cfae078
--- /dev/null
+++ b/src/MNH/eol_adnr.f90
@@ -0,0 +1,250 @@
+!MNH_LIC Copyright 2017-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_ADNR
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE EOL_ADNR(PDXX, PDYY, PDZZ, &
+ PRHO_M, PUT_M, &
+ PFX_RG )
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! mesh size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO_M ! dry Density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT_M ! Wind speed at mass point
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFX_RG ! Aerodynamic force (cartesian mesh..
+ ! .. x axis, global
+ ! ..frame)
+!
+!
+END SUBROUTINE EOL_ADNR
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_ADNR
+!
+! ###################################################################
+ SUBROUTINE EOL_ADNR(PDXX, PDYY, PDZZ, &
+ PRHO_M, PUT_M, &
+ PFX_RG )
+! ###################################################################
+!
+!!**** *MODI_EOL_ADNR* -
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several methods are available. One of the models is the Non-
+!! Rotating Actuator Disk Non-Rotating model (ADNR). It allows to
+!! compute aerodynamic forces according the wind speed and the
+!! caracteristics of the wind turbine.
+!!
+!!** METHOD
+!! ------
+!! The actuator disc flow model, in this routine, is computed without
+!! rotation. It consists in applying a thrust force over the disc drawn
+!! by the blades. This aerodynamic force acts against the wind to disturb
+!! the flow.
+!!
+!! REFERENCE
+!! ---------
+!! PA. Joulin PhD Thesis. 2020.
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2017
+!! Modification 19/10/20 (PA. Joulin) Updated for a main version
+!!
+!!---------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+! To work with ADNR
+USE MODD_EOL_ADNR
+!
+USE MODD_EOL_SHARED_IO, ONLY: CINTERP
+USE MODD_EOL_SHARED_IO, ONLY: XTHRUT
+USE MODI_EOL_MATHS, ONLY: INTERP_LIN8NB
+! To know the grid
+USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZS,XZZ
+USE MODE_ll, ONLY: GET_INDICE_ll
+USE MODD_PARAMETERS, ONLY: JPVEXT
+! To play with MPI
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD, IP
+use MODD_PRECISION, only: MNHREAL_MPI
+USE MODD_MPIF, ONLY: MPI_SUM
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+! Meso-NH
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! Mesh size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO_M ! Dry Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT_M ! Wind speed at mass point
+! Wind turbine aerodynamic
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFX_RG ! Aerodynamic force (cartesian mesh, x axis, RG frame) [N]
+!
+!* 0.2 Declarations of local variables :
+!
+! Indicies
+INTEGER :: IIB,IJB,IKB ! Begin of a CPU domain
+INTEGER :: IIE,IJE,IKE ! End of a CPU domain
+INTEGER :: IKU ! Vertical size of the domain
+INTEGER :: JI, JJ, JK ! Loop index
+INTEGER :: JROT ! Wind turbine index
+!
+! Wind
+REAL :: ZRHO_I ! Interpolated density [kg/m3]
+REAL :: ZUT_I ! Interpolated wind speed U (RG) [m/s]
+REAL, DIMENSION(SIZE(PUT_M,1),SIZE(PUT_M,2),SIZE(PUT_M,3)) :: ZZH ! True heigth to interpolate 8N
+!
+! Wind turbine
+REAL, DIMENSION(TFARM%NNB_TURBINES) :: ZTHRUT ! Thrust [N]
+! Geometry
+REAL :: ZY_DIST ! Distance Hub - Cell on Y [m]
+REAL :: ZZ_DIST ! Distance Hub - Cell on Z [m]
+REAL :: ZR_DIST ! Radial distance Hub - Cell [m]
+REAL, DIMENSION(3) :: ZPOS ! Element position [m]
+!
+!Numerical
+INTEGER :: IINFO ! code info return
+!
+!* 0.3 Implicit arguments
+!
+! A. From MODD_EOL_ADNR:
+!TYPE(FARM) :: TFARM
+!TYPE(TURBINE) :: TTURBINE
+!REAL, DIMENSION(:), ALLOCATABLE :: XA_INDU ! Induction factor [-]
+!REAL, DIMENSION(:), ALLOCATABLE :: XCT_D ! Adapted thrust coef (for U_d) [-]
+!
+!
+! B. From MODD_EOL_SHARED_IO:
+! for NAM_EOL_ADNR:
+!CHARACTER(LEN=100) :: CFARM_CSVDATA ! File to read, with farm data
+!CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! File to read, turbine data
+!CHARACTER(LEN=3) :: CINTERP ! Interpolation method for wind speed
+! for outputs
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZATIONS
+! ---------------
+!
+!* 1.1 Subdomain (CPU) indices
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) ! Get begin and end domain index (CPU)
+IKU = SIZE(PUT_M,3) ! Top of the domain end index
+IKB=1+JPVEXT ! Vertical begin index
+IKE=IKU-JPVEXT ! Vertical end index
+!
+!* 1.2 Induction factor and adapted thrust coef (that will use U_disc)
+!
+DO JROT=1,TFARM%NNB_TURBINES
+ XA_INDU(JROT) = 0.5*(1-(1-TFARM%XCT_INF(JROT))**0.5)
+ XCT_D(JROT) = 4*XA_INDU(JROT)/(1-XA_INDU(JROT))
+END DO
+!
+CALL PRINTMER_CPU1('ADNR : At ', 1.3)
+!* 1.3 Inits
+!
+ZTHRUT(:) = 0.
+XTHRUT(:) = 0.
+!
+CALL PRINTMER_CPU1('ADNR : At ', 1.4)
+!* 1.4 Vertical coordinate in case of interpolation
+!
+IF (CINTERP=='8NB') THEN
+ DO JK=1,IKU-1
+ ZZH(:,:,JK) = (0.5*(XZZ(:,:,JK)+XZZ(:,:,JK+1))-XZS(:,:))
+ END DO
+ ZZH(:,:,IKU) = 2*ZZH(:,:,IKU-1) - ZZH(:,:,IKU-2)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTES THRUST FORCE THAT ACTS ON THE ROTOR DUE TO THE WIND
+! ------------------------------------------------------------
+!
+!* 2.1 Finding the position of wind turbines
+!
+! Loop over domain
+DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ! Loop over wind turbines
+ DO JROT=1,TFARM%NNB_TURBINES
+ ! X axis position test :
+ IF (TFARM%XPOS_X(JROT) >= XXHAT(JI) .AND. &
+ TFARM%XPOS_X(JROT) < XXHAT(JI) + PDXX(JI,JJ,JK)) THEN
+ ! YZ plane distances calculations
+ ZY_DIST = TFARM%XPOS_Y(JROT)-XYHAT(JJ)
+ ZZ_DIST = TTURBINE%XH_HEIGHT-(XZZ(JI,JJ,JK)-XZS(JI,JJ))
+ ZR_DIST = (ZY_DIST**2 + ZZ_DIST**2 )**(1./2.)
+ !
+ ! Disc position test
+ IF (ZR_DIST <= TTURBINE%XR_MAX) THEN
+!
+!* 2.2 Interpolating the wind
+!
+ ZPOS(1) = XXHAT(JI)
+ ZPOS(2) = XYHAT(JJ)
+ ZPOS(3) = XZZ(JI,JJ,JK)-XZS(JI,JJ)
+ SELECT CASE(CINTERP)
+ CASE('CLS')
+ ZUT_I = PUT_M(JI,JJ,JK)
+ ZRHO_I = PRHO_M(JI,JJ,JK)
+ CASE('8NB')
+ ZUT_I = INTERP_LIN8NB(ZPOS(:),JI,JJ,JK,PUT_M,ZZH)
+ ZRHO_I = INTERP_LIN8NB(ZPOS(:),JI,JJ,JK,PRHO_M,ZZH)
+ END SELECT
+!
+!* 2.3 Calculating the thrust of a cell wind->rotor
+!
+ PFX_RG(JI,JJ,JK) = PFX_RG(JI,JJ,JK) &
+ + 0.5*ZRHO_I*XCT_D(JROT) &
+ *PDYY(JI,JJ,JK)*PDZZ(JI,JJ,JK) &
+ *ZUT_I**2
+!
+!* 2.4 Calculating the thrust of the rotor wind->rotor
+! in a pseudo hub coordinate system (-)
+!
+ ZTHRUT(JROT) = ZTHRUT(JROT) &
+ - 0.5*ZRHO_I*XCT_D(JROT) &
+ *PDYY(JI,JJ,JK)*PDZZ(JI,JJ,JK) &
+ *ZUT_I**2
+!
+ END IF ! Disc position test
+ END IF ! X axis position test
+ END DO ! WT loop
+ END DO ! X domain loop
+ END DO ! Y domain loop
+END DO ! Z domain loop
+!
+!* 2.4 Bottom and top boundaries
+!
+PFX_RG(:,:,IKB-1) = PFX_RG(:,:,IKB)
+PFX_RG(:,:,IKE+1) = PFX_RG(:,:,IKE)
+!
+!* 3. SHARING THE DATAS OVER THE CPUS
+! -------------------------------
+!
+CALL MPI_ALLREDUCE(ZTHRUT, XTHRUT, SIZE(XTHRUT), &
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+!
+!
+!
+END SUBROUTINE EOL_ADNR
diff --git a/src/MNH/eol_alm.f90 b/src/MNH/eol_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ab533254e9d4fb65551a4d269e29cef05f3eae1e
--- /dev/null
+++ b/src/MNH/eol_alm.f90
@@ -0,0 +1,504 @@
+!MNH_LIC Copyright 2017-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_ALM
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE EOL_ALM(KTCOUNT, PTSTEP, &
+ PDXX, PDYY, PDZZ, &
+ PRHO_M, &
+ PUT_M, PVT_M, PWT_M, &
+ PFX_RG, PFY_RG, PFZ_RG )
+
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! timestep except
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! mesh size
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO_M ! dry Density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT_M,PVT_M,PWT_M ! Wind speed at mass point
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFX_RG ! Aerodynamic force ..
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFY_RG ! .. cartesian mesh ..
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFZ_RG ! .. global frame)
+!
+!
+END SUBROUTINE EOL_ALM
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_ALM
+!
+! ###################################################################
+ SUBROUTINE EOL_ALM(KTCOUNT, PTSTEP, &
+ PDXX, PDYY, PDZZ, &
+ PRHO_M, &
+ PUT_M, PVT_M, PWT_M, &
+ PFX_RG, PFY_RG, PFZ_RG )
+! ###################################################################
+!
+!!**** *MODI_EOL_ALM* -
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several methods are available. One of the models is the Actuator
+!! Line Method (ALM). It allows to compute aerodynamic forces according
+!! the wind speed and the caracteristics of the wind turbine.
+!!
+!!** METHOD
+!! ------
+!! The ALM consists in modeling each blade by one line divided into blade
+!! element points (Sørensen and Shen, 2002). These points are applying
+!! aerodynamic forces into the flow.
+!! Each point carries a two-dimensional (2D) airfoil, and its characteris-
+!! tics, as lift and drag coefficients. Knowing these coefficients, and
+!! the angle of attack, the lift and drag forces can be evaluated.
+!!
+!! REFERENCE
+!! ---------
+!! PA. Joulin PhD Thesis. 2020.
+!!
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/01/17
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+! P. Wautelet 23/07/2021: replace non-standard FLOAT function by REAL function
+!!---------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+! To work with wind turbines
+USE MODD_EOL_ALM
+USE MODD_EOL_KINE_ALM
+!
+USE MODD_EOL_SHARED_IO, ONLY: CINTERP
+USE MODD_EOL_SHARED_IO, ONLY: XTHRUT, XTORQT, XPOWT
+!
+USE MODI_EOL_MATHS
+USE MODI_EOL_READER, ONLY: GET_AIRFOIL_ID
+USE MODI_EOL_PRINTER, ONLY: PRINT_TSPLIT
+USE MODI_EOL_ERROR, ONLY: EOL_WTCFL_ERROR
+! Math
+USE MODD_CST, ONLY: XPI
+! To know the grid
+USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZS,XZZ
+USE MODE_ll, ONLY: GET_INDICE_ll
+USE MODD_PARAMETERS, ONLY: JPVEXT
+! MPI stuffs
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
+USE MODD_PRECISION, ONLY: MNHREAL_MPI
+USE MODD_MPIF, ONLY: MPI_SUM
+USE MODE_SUM_ll, ONLY: MIN_ll
+USE MODD_VAR_ll, ONLY: IP
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! timestep except
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! mesh size
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHO_M ! dry Density
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT_M,PVT_M,PWT_M ! Wind speed at mass point
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFX_RG ! Aerodynamic force ..
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFY_RG ! .. cartesian mesh ..
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFZ_RG ! .. global frame)
+!
+!
+!* 0.2 Declarations of local variables :
+!
+! Indicies Compteurs
+INTEGER :: IIB,IJB,IKB ! Begin of a CPU domain
+INTEGER :: IIE,IJE,IKE ! End of a CPU domain
+INTEGER :: IKU ! Vertical size of the domain
+INTEGER :: JI, JJ, JK ! Loop index
+INTEGER :: JROT, JBLA, JBELT ! Rotor, blade, and blade element indicies
+!
+! Averages variables over all sub-timestep (if Time splitting)
+REAL, DIMENSION(TFARM%NNB_TURBINES,TTURBINE%NNB_BLADES,TBLADE%NNB_BLAELT) :: ZAOA_ATS ! Angle of attack of an element, hub frame [rad]
+REAL, DIMENSION(TFARM%NNB_TURBINES,TTURBINE%NNB_BLADES,TBLADE%NNB_BLAELT) :: ZFLIFT_ATS ! Aerodynamic lift force, parallel to Urel [N]
+REAL, DIMENSION(TFARM%NNB_TURBINES,TTURBINE%NNB_BLADES,TBLADE%NNB_BLAELT) :: ZFDRAG_ATS ! Aerodynamic drag force, perpendicular to Urel [N]
+REAL, DIMENSION(TFARM%NNB_TURBINES,TTURBINE%NNB_BLADES,TBLADE%NNB_BLAELT,3) :: ZFAERO_RE_ATS ! Aerodynamic force (lift+drag) in RE [N]
+REAL, DIMENSION(TFARM%NNB_TURBINES,TTURBINE%NNB_BLADES,TBLADE%NNB_BLAELT,3) :: ZFAERO_RG_ATS ! Aerodynamic force (lift+drag) in RG [N]
+
+
+! -- Wind --
+REAL :: ZRHO_I ! Interpolated density [kg/m3]
+REAL :: ZUT_I ! Interpolated wind speed U (RG) [m/s]
+REAL :: ZVT_I ! Interpolated wind speed V (RG) [m/s]
+REAL :: ZWT_I ! Interpolated wind speed W (RG) [m/s]
+REAL, DIMENSION(3) :: ZWIND_VEL_RG ! Wind velocity in RG frame [m/s]
+REAL, DIMENSION(3) :: ZWIND_VEL_RE ! Wind velocity in RE frame [m/s]
+REAL, DIMENSION(3) :: ZWINDREL_VEL_RE ! Relative wind velocity in RE frame [m/s]
+REAL :: ZWINDREL_VEL ! Norm of the relative wind velocity [m/s]
+REAL, DIMENSION(SIZE(PUT_M,1),SIZE(PUT_M,2),SIZE(PUT_M,3)) :: ZZH ! True heigth to interpolate 8NB
+!
+! -- Wind turbine --
+INTEGER :: INB_WT, INB_B, INB_BELT ! Total numbers
+REAL :: ZRAD ! Blade radius [m]
+INTEGER :: IAID ! Airfoil index [-]
+!
+! -- Aero --
+REAL :: ZAOA ! Attack angle of an element [rad]
+REAL :: ZCDRAG ! Drag coefficient of an element []
+REAL :: ZCLIFT ! Lift coefficient of an element []
+REAL :: ZFDRAG ! Drag force of an element, parallel to Urel [N]
+REAL :: ZFLIFT ! Lift force of an element, perpendicular to Urel [N]
+REAL, DIMENSION(3) :: ZFAERO_RE ! Aerodynamic force (lift+drag) in RE [N]
+REAL, DIMENSION(3) :: ZFAERO_RG ! Aerodynamic force (lift+drag) in RG [N]
+! Tip loss
+REAL :: ZFTIPL ! tip loss function
+REAL :: ZPHI ! angle twist+pitch+aa
+!
+! Thrust, Torque and Power
+REAL, DIMENSION(3) :: ZFAERO_RH ! Aerodynamic force (lift+drag) in RH [N] (thrust/torque)
+REAL, DIMENSION(3) :: ZDIST_HBELT_RH ! Distance between blade element and hub, in RH [m]
+REAL, DIMENSION(3) :: ZDIST_HBELT_RG ! Distances between blade element and hub, in RG [m]
+REAL, DIMENSION(3) :: Z3D_TORQT ! Full torque force (3D) of the wind turbine [N]
+!
+! -- Time spliting --
+INTEGER :: KTSUBCOUNT, INBSUBCOUNT ! sub iteration count
+REAL :: ZTSUBSTEP ! sub timestep
+REAL :: ZMAXTSTEP ! Max value for timestep to respect WTCFL criteria
+!
+! -- Numerical --
+INTEGER :: IINFO ! code info return
+!
+!
+!* 0.3 Implicit arguments
+!
+! A. From MODD_EOL_ALM
+!TYPE(FARM) :: TFARM
+!TYPE(TURBINE) :: TTURBINE
+!TYPE(BLADE) :: TBLADE
+!TYPE(AIRFOIL), DIMENSION(:), ALLOCATABLE :: TAIRFOIL
+!
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XELT_RAD ! Blade elements radius [m]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XAOA_GLB ! Angle of attack of an element [rad]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFLIFT_GLB ! Lift force, parallel to Urel [N]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFDRAG_GLB ! Drag force, perpendicular to Urel [N]
+!REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RE_GLB ! Aerodyn. force (lift+drag) in RE [N]
+!REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RG_GLB ! Aerodyn. force (lift+drag) in RG [N]
+!
+!INTEGER :: NNB_BLAELT ! Number of blade elements
+!LOGICAL :: LTIMESPLIT ! Flag to apply Time splitting method
+!LOGICAL :: LTIPLOSSG ! Flag to apply Glauert's tip loss correction
+!LOGICAL :: LTECOUTPTS ! Flag to get Tecplot file output of element points
+!
+! B. From MODD_EOL_SHARED_IO:
+! for namelist NAM_EOL_ALM
+!CHARACTER(LEN=100) :: CFARM_CSVDATA ! Farm file to read
+!CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! Turbine file to read
+!CHARACTER(LEN=100) :: CBLADE_CSVDATA ! Blade file to read
+!CHARACTER(LEN=100) :: CAIRFOIL_CSVDATA ! Airfoil file to read
+!CHARACTER(LEN=3) :: CINTERP ! Interpolation method for wind speed
+! for output
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!REAL, DIMENSION(:), ALLOCATABLE :: XTORQT ! Torque [Nm]
+!REAL, DIMENSION(:), ALLOCATABLE :: XPOWT ! Power [W]
+!
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. INITIALIZATIONS
+! ---------------
+!
+!* 1.1 Subdomain (CPU) indices
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) ! Get begin and end domain index (CPU)
+IKU = SIZE(PUT_M,3) ! Top of the domain end index
+IKB=1+JPVEXT ! Vertical begin index
+IKE=IKU-JPVEXT ! Vertical end index
+!
+!* 1.2 Some usefull integers
+!
+INB_WT = TFARM%NNB_TURBINES
+INB_B = TTURBINE%NNB_BLADES
+INB_BELT = TBLADE%NNB_BLAELT
+!
+!* 1.3 Vertical coordinate in case of interpolation
+!
+IF (CINTERP=='8NB') THEN
+ DO JK=1,IKU-1
+ ZZH(:,:,JK) = (0.5*(XZZ(:,:,JK)+XZZ(:,:,JK+1))-XZS(:,:))
+ END DO
+ ZZH(:,:,IKU) = 2*ZZH(:,:,IKU-1) - ZZH(:,:,IKU-2)
+END IF
+!
+!* 1.4 Set to zeros at each MNH time steps
+!
+! Averaged variables (over time splitting)
+ZAOA_ATS(:,:,:) = 0.
+ZFLIFT_ATS(:,:,:) = 0.
+ZFDRAG_ATS(:,:,:) = 0.
+ZFAERO_RE_ATS(:,:,:,:) = 0.
+ZFAERO_RG_ATS(:,:,:,:) = 0.
+!
+! Global variables (seen by all CPU)
+XAOA_GLB(:,:,:) = 0.
+XFLIFT_GLB(:,:,:) = 0.
+XFDRAG_GLB(:,:,:) = 0.
+XFAERO_RE_GLB(:,:,:,:) = 0.
+XFAERO_RG_GLB(:,:,:,:) = 0.
+!
+XTHRUT(:) = 0.
+XTORQT(:) = 0.
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTES WTCFL CRITERIA
+! -----------------------
+!
+!* 2.1 Computing the highest timestep acceptable
+ZMAXTSTEP = ABS( MIN(MIN_ll(PDXX(:,:,:),IINFO),&
+ MIN_ll(PDYY(:,:,:),IINFO),&
+ MIN_ll(PDZZ(:,:,:),IINFO))&
+ /(MAXVAL(TFARM%XOMEGA(:))*TTURBINE%XR_MAX))
+!
+IF (.NOT.LTIMESPLIT) THEN
+!* 2.2 Checking conditions
+! If time step too high : abort
+ IF (PTSTEP > ZMAXTSTEP) THEN
+ CALL EOL_WTCFL_ERROR(ZMAXTSTEP)
+! If time step ok, continue
+ ELSE
+ INBSUBCOUNT = 1
+ ZTSUBSTEP = PTSTEP/INBSUBCOUNT
+ END IF
+ELSE
+!* 2.3 Timesplitting : new sub-timestep
+ INBSUBCOUNT = INT(PTSTEP/ZMAXTSTEP) + 1
+ ZTSUBSTEP = PTSTEP/INBSUBCOUNT
+ CALL PRINT_TSPLIT(INBSUBCOUNT, ZTSUBSTEP)
+END IF
+!
+!* 2.4 Start looping over sub-timesteps
+DO KTSUBCOUNT=1,INBSUBCOUNT
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. KINEMATICS COMPUTATIONS
+! -----------------------
+!
+ CALL EOL_KINE_ALM(KTCOUNT, KTSUBCOUNT, ZTSUBSTEP, PTSTEP)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. COMPUTES AERODYNAMIC FORCES THAT ACTS ON THE BLADES DUE TO THE WIND
+! --------------------------------------------------------------
+!
+!* 4.1 Finding the position of wind turbines
+!
+! Loop over domain
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ ! Loop over wind turbines
+ DO JROT=1, INB_WT
+ DO JBLA=1, INB_B
+ DO JBELT=1, INB_BELT
+ ! Position test
+ IF (XPOS_ELT_RG(JROT,JBLA,JBELT,1) >= XXHAT(JI) .AND. &
+ XPOS_ELT_RG(JROT,JBLA,JBELT,1) < XXHAT(JI) + PDXX(JI,JJ,JK)) THEN
+!
+ IF (XPOS_ELT_RG(JROT,JBLA,JBELT,2) >= XYHAT(JJ) .AND. &
+ XPOS_ELT_RG(JROT,JBLA,JBELT,2) < XYHAT(JJ) + PDYY(JI,JJ,JK)) THEN
+!
+ IF (XPOS_ELT_RG(JROT,JBLA,JBELT,3) >= XZZ(JI,JJ,JK) .AND. &
+ XPOS_ELT_RG(JROT,JBLA,JBELT,3) < XZZ(JI,JJ,JK) + PDZZ(JI,JJ,JK)) THEN
+!
+!* 4.2 Extracting the wind
+!
+ SELECT CASE(CINTERP)
+ CASE('CLS')
+ ZUT_I = PUT_M(JI,JJ,JK)
+ ZVT_I = PVT_M(JI,JJ,JK)
+ ZWT_I = PWT_M(JI,JJ,JK)
+ ZRHO_I = PRHO_M(JI,JJ,JK)
+ CASE('8NB')
+ ZUT_I = INTERP_LIN8NB(XPOS_ELT_RG(JROT,JBLA,JBELT,:),&
+ JI,JJ,JK,PUT_M,ZZH)
+ ZVT_I = INTERP_LIN8NB(XPOS_ELT_RG(JROT,JBLA,JBELT,:),&
+ JI,JJ,JK,PVT_M,ZZH)
+ ZWT_I = INTERP_LIN8NB(XPOS_ELT_RG(JROT,JBLA,JBELT,:),&
+ JI,JJ,JK,PWT_M,ZZH)
+ ZRHO_I = INTERP_LIN8NB(XPOS_ELT_RG(JROT,JBLA,JBELT,:),&
+ JI,JJ,JK,PRHO_M,ZZH)
+ END SELECT
+ ZWIND_VEL_RG(1) = ZUT_I
+ ZWIND_VEL_RG(2) = ZVT_I
+ ZWIND_VEL_RG(3) = ZWT_I
+!
+!* 4.3 Calculating the wind in RE frame
+!
+ ZWIND_VEL_RE(:) = MATMUL(XMAT_RE_RG(JROT,JBLA,JBELT,:,:), ZWIND_VEL_RG(:))
+!
+!* 4.4 Calculating the relative wind speed in RE frame + norm
+!
+ ZWINDREL_VEL_RE(:) = ZWIND_VEL_RE(:) - XTVEL_ELT_RE(JROT,JBLA,JBELT,:)
+ ZWINDREL_VEL = NORM(ZWINDREL_VEL_RE)
+!
+!* 4.5 Calculating the angle of attack
+!
+ ZAOA = ATAN2(ZWINDREL_VEL_RE(1), ZWINDREL_VEL_RE(2))
+!
+!* 4.6 Getting aerodynamic coefficients from tabulated data
+!
+ ZRAD = XELT_RAD(JROT,JBLA,JBELT) ! Radius of the element
+ IAID = GET_AIRFOIL_ID(TTURBINE,TBLADE,TAIRFOIL,ZRAD) ! ID of the airfoil
+ ZCLIFT = INTERP_SPLCUB(ZAOA*180/XPI, &
+ TAIRFOIL(IAID)%XAA,&
+ TAIRFOIL(IAID)%XCL)
+ ZCDRAG = INTERP_SPLCUB(ZAOA*180/XPI, &
+ TAIRFOIL(IAID)%XAA,&
+ TAIRFOIL(IAID)%XCD)
+!
+!* 4.7 Tip loss correction (Glauert)
+!
+ IF (LTIPLOSSG) THEN
+ ZPHI = + ZAOA &
+ + TFARM%XBLA_PITCH(JROT) &
+ + XTWIST_ELT(JROT,JBLA,JBELT)
+ IF (ZPHI > 0.0) THEN
+ ZFTIPL = (2.0/XPI)*ACOS(MIN( &
+ 1.0, EXP(-(TTURBINE%NNB_BLADES/2.0) &
+ *(TTURBINE%XR_MAX-ZRAD)/(ZRAD*SIN(ZPHI)))))
+ ELSE
+ ZFTIPL = 1.0
+ END IF
+ ZCLIFT = ZFTIPL*ZCLIFT
+ ZCDRAG = ZFTIPL*ZCDRAG
+ END IF
+!
+!* 4.8 Computing aerodynamic forces in relative frame
+! that act on blades (wind->blade)
+ ZFLIFT = 0.5*ZRHO_I*XSURF_ELT(JROT,JBLA,JBELT)*ZCLIFT*ZWINDREL_VEL**2
+ ZFDRAG = 0.5*ZRHO_I*XSURF_ELT(JROT,JBLA,JBELT)*ZCDRAG*ZWINDREL_VEL**2
+!
+!* 4.9 Evaluating the aerodynamiques forces in RE frame
+! that act on blades (wind->blade)
+ ZFAERO_RE(1) = SIN(ZAOA)*ZFDRAG + COS(ZAOA)*ZFLIFT
+ ZFAERO_RE(2) = COS(ZAOA)*ZFDRAG - SIN(ZAOA)*ZFLIFT
+ ZFAERO_RE(3) = .0 ! 2D flow around arifoil assumption
+!
+!* 4.10 Evaluating the aerodynamiques forces in RG frame
+! that act on blades (wind->blade)
+ ZFAERO_RG(:) = MATMUL(XMAT_RG_RE(JROT,JBLA,JBELT,:,:), ZFAERO_RE(:))
+!
+!* 4.11 Adding it to the cell of Meso-NH
+ PFX_RG(JI,JJ,JK) = PFX_RG(JI,JJ,JK) + ZFAERO_RG(1) / REAL(INBSUBCOUNT)
+ PFY_RG(JI,JJ,JK) = PFY_RG(JI,JJ,JK) + ZFAERO_RG(2) / REAL(INBSUBCOUNT)
+ PFZ_RG(JI,JJ,JK) = PFZ_RG(JI,JJ,JK) + ZFAERO_RG(3) / REAL(INBSUBCOUNT)
+!
+!* 4.12 Storing mean values over one full MNH timestep
+! (all the sub-timesteps values are averaged)
+ ZAOA_ATS(JROT,JBLA,JBELT) = ZAOA_ATS(JROT,JBLA,JBELT) &
+ + ZAOA / REAL(INBSUBCOUNT)
+ ZFLIFT_ATS(JROT,JBLA,JBELT) = ZFLIFT_ATS(JROT,JBLA,JBELT) &
+ + ZFLIFT / REAL(INBSUBCOUNT)
+ ZFDRAG_ATS(JROT,JBLA,JBELT) = ZFDRAG_ATS(JROT,JBLA,JBELT) &
+ + ZFDRAG / REAL(INBSUBCOUNT)
+ ZFAERO_RE_ATS(JROT,JBLA,JBELT,:)= ZFAERO_RE_ATS(JROT,JBLA,JBELT,:) &
+ + ZFAERO_RE(:) / REAL(INBSUBCOUNT)
+ ZFAERO_RG_ATS(JROT,JBLA,JBELT,:)= ZFAERO_RG_ATS(JROT,JBLA,JBELT,:) &
+ + ZFAERO_RG(:) / REAL(INBSUBCOUNT)
+!
+ ! End of position tests
+ END IF
+ END IF
+ END IF
+ ! End of wind turbine loops
+ END DO
+ END DO
+ END DO
+ ! End of domain loops
+ END DO
+ END DO
+ END DO
+! End of sub-time loop
+END DO
+!
+!
+!* 4.13 Top and bottom conditions
+PFX_RG(:,:,IKB-1) = PFX_RG(:,:,IKB)
+PFX_RG(:,:,IKE+1) = PFX_RG(:,:,IKE)
+!
+PFY_RG(:,:,IKB-1) = PFY_RG(:,:,IKB)
+PFY_RG(:,:,IKE+1) = PFY_RG(:,:,IKE)
+!
+PFZ_RG(:,:,IKB-1) = PFZ_RG(:,:,IKB)
+PFZ_RG(:,:,IKE+1) = PFZ_RG(:,:,IKE)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. SHARING THE DATAS OVER THE CPUS
+! -------------------------------
+CALL MPI_ALLREDUCE(ZAOA_ATS, XAOA_GLB, SIZE(XAOA_GLB), &
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+CALL MPI_ALLREDUCE(ZFLIFT_ATS, XFLIFT_GLB, SIZE(XFLIFT_GLB), &
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+CALL MPI_ALLREDUCE(ZFDRAG_ATS, XFDRAG_GLB, SIZE(XFDRAG_GLB), &
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+CALL MPI_ALLREDUCE(ZFAERO_RE_ATS, XFAERO_RE_GLB, SIZE(XFAERO_RE_GLB),&
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+CALL MPI_ALLREDUCE(ZFAERO_RG_ATS, XFAERO_RG_GLB, SIZE(XFAERO_RG_GLB),&
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. COMPUTING THRUST, TORQUE AND POWER
+! ---------------------------------
+!
+IF(IP == 1) THEN
+ DO JROT=1,TFARM%NNB_TURBINES
+ DO JBLA=1, TTURBINE%NNB_BLADES
+ DO JBELT=1, TBLADE%NNB_BLAELT
+!
+!* 6.1 Preliminaries
+! Aerodynamic load (wind->blade) in RH
+ ZFAERO_RH(:) = MATMUL(XMAT_RH_RG(JROT,:,:), &
+ XFAERO_RG_GLB(JROT,JBLA,JBELT,:))
+! Distance between element and hub in RG
+ ZDIST_HBELT_RG(:) = XPOS_ELT_RG(JROT,JBLA,JBELT,:) - XPOS_HUB_RG(JROT,:)
+! Distance between element and hub in RH
+ ZDIST_HBELT_RH(:) = MATMUL(XMAT_RH_RG(JROT,:,:),ZDIST_HBELT_RG(:))
+!
+!* 6.2 Thrust (wind->rotor): in RH
+ XTHRUT(JROT) = XTHRUT(JROT) + ZFAERO_RH(3) ! Only Z component
+!* 6.3 Torque (wind->rotor) in RH
+ Z3D_TORQT = CROSS(ZDIST_HBELT_RH(:),ZFAERO_RH(:))
+ XTORQT(JROT) = XTORQT(JROT) + Z3D_TORQT(3) ! Only Z component
+ END DO
+ END DO
+!
+!* 6.4 Power (wind->rotor)
+ XPOWT(JROT) = XTORQT(JROT) * TFARM%XOMEGA(JROT)
+ END DO
+END IF
+!
+!
+END SUBROUTINE EOL_ALM
diff --git a/src/MNH/eol_debugger.f90 b/src/MNH/eol_debugger.f90
new file mode 100644
index 0000000000000000000000000000000000000000..86e38b3e19fca5ad7f6094707ac7d3b1f15531f8
--- /dev/null
+++ b/src/MNH/eol_debugger.f90
@@ -0,0 +1,240 @@
+!MNH_LIC Copyright 2020-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_DEBUGGER
+! #######################
+!
+INTERFACE
+!
+!
+SUBROUTINE PRINTMER_ll(HNAME,PVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ REAL, INTENT(IN) :: PVAR ! Variable,
+END SUBROUTINE PRINTMER_ll
+!
+SUBROUTINE PRINTMEI_ll(HNAME,KVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ INTEGER, INTENT(IN) :: KVAR ! Variable,
+END SUBROUTINE PRINTMEI_ll
+!
+SUBROUTINE PRINTMEC_ll(HNAME,CVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ CHARACTER(LEN=*), INTENT(IN) :: CVAR ! Variable,
+END SUBROUTINE PRINTMEC_ll
+!
+SUBROUTINE PRINTMER_CPU1(HNAME,PVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ REAL, INTENT(IN) :: PVAR ! Variable,
+END SUBROUTINE PRINTMER_CPU1
+!
+SUBROUTINE PRINTMEI_CPU1(HNAME,KVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ INTEGER, INTENT(IN) :: KVAR ! Variable,
+END SUBROUTINE PRINTMEI_CPU1
+!
+SUBROUTINE PRINTMEC_CPU1(HNAME,CVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ CHARACTER(LEN=*), INTENT(IN) :: CVAR ! Variable,
+END SUBROUTINE PRINTMEC_CPU1
+!
+SUBROUTINE PRINTMER_ELT1(KROT,KBLA,KELT,HNAME,PVAR)
+ INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ REAL, INTENT(IN) :: PVAR ! Variable,
+END SUBROUTINE PRINTMER_ELT1
+!
+SUBROUTINE PRINTMER_ELT42(KROT,KBLA,KELT,HNAME,PVAR)
+ INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ REAL, INTENT(IN) :: PVAR ! Variable,
+END SUBROUTINE PRINTMER_ELT42
+!
+SUBROUTINE PRINTMER_3BELT42(KROT,KBLA,KELT,HNAME,PVAR)
+ INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+ REAL, INTENT(IN) :: PVAR ! Variable,
+END SUBROUTINE PRINTMER_3BELT42
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_DEBUGGER
+!-------------------------------------------------------------------
+!
+!!**** *EOL_PRINTER* -
+!!
+!! PURPOSE
+!! -------
+!! Some usefull toold to debbug my code
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/10/2020
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE PRINTMER_ll(HNAME,PVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+REAL, INTENT(IN) :: PVAR ! Variable,
+!
+!
+PRINT*, 'CPU n. ', IP, ' : ', HNAME, ' = ', PVAR
+!
+END SUBROUTINE PRINTMER_ll
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMEI_ll(HNAME,KVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+INTEGER, INTENT(IN) :: KVAR ! Variable,
+!
+!
+PRINT*, 'CPU n. ', IP, ' : ', HNAME, ' = ', KVAR
+!
+END SUBROUTINE PRINTMEI_ll
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMEC_ll(HNAME,CVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+CHARACTER(LEN=*), INTENT(IN) :: CVAR ! Variable,
+!
+!
+PRINT*, 'CPU n. ', IP, ' : ', HNAME, ' = ', CVAR
+!
+END SUBROUTINE PRINTMEC_ll
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMER_CPU1(HNAME, PVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+REAL, INTENT(IN) :: PVAR ! Variable,
+!
+IF (IP==1) THEN
+ PRINT*, HNAME, ' = ', PVAR
+END IF
+!
+END SUBROUTINE PRINTMER_CPU1
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMEI_CPU1(HNAME, KVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+INTEGER, INTENT(IN) :: KVAR ! Variable,
+!
+IF (IP==1) THEN
+ PRINT*, HNAME, ' = ', KVAR
+END IF
+!
+END SUBROUTINE PRINTMEI_CPU1
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMEC_CPU1(HNAME, CVAR)
+!
+USE MODD_VAR_ll, ONLY: IP
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+CHARACTER(LEN=*), INTENT(IN) :: CVAR ! Variable,
+!
+IF (IP==1) THEN
+ PRINT*, HNAME, ' = ', CVAR
+END IF
+!
+END SUBROUTINE PRINTMEC_CPU1
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMER_ELT1(KROT, KBLA, KELT, HNAME, PVAR)
+!
+USE MODD_CST, ONLY: XPI
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+REAL, INTENT(IN) :: PVAR ! Variable,
+!
+IF ((KROT==1).AND.(KBLA==1).AND.(KELT==1)) THEN
+ PRINT*, HNAME, PVAR
+END IF
+!
+END SUBROUTINE PRINTMER_ELT1
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMER_ELT42(KROT, KBLA, KELT, HNAME, PVAR)
+!
+USE MODD_CST, ONLY: XPI
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+REAL, INTENT(IN) :: PVAR ! Variable,
+!
+IF ((KROT==1).AND.(KBLA==1).AND.(KELT==42)) THEN
+ PRINT*, HNAME, PVAR
+END IF
+!
+END SUBROUTINE PRINTMER_ELT42
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINTMER_3BELT42(KROT, KBLA, KELT, HNAME, PVAR)
+!
+USE MODD_CST, ONLY: XPI
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KROT, KBLA, KELT ! Loop index,
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! Name of the variable,
+REAL, INTENT(IN) :: PVAR ! Variable,
+!
+IF ((KROT==1).AND.(KBLA==1).AND.(KELT==42)) THEN
+ PRINT*, HNAME, 'B1 = ', PVAR*180/XPI
+END IF
+IF ((KROT==1).AND.(KBLA==2).AND.(KELT==42)) THEN
+ PRINT*, HNAME, 'B2 = ', PVAR*180/XPI
+END IF
+IF ((KROT==1).AND.(KBLA==3).AND.(KELT==42)) THEN
+ PRINT*, HNAME, 'B3 = ', PVAR*180/XPI
+END IF
+!
+END SUBROUTINE PRINTMER_3BELT42
+!#########################################################
+!
diff --git a/src/MNH/eol_error.f90 b/src/MNH/eol_error.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c6c221f9f4a5ba6818a6a8242084a253b3ba518d
--- /dev/null
+++ b/src/MNH/eol_error.f90
@@ -0,0 +1,166 @@
+!MNH_LIC Copyright 2020-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_ERROR
+! #######################
+!
+INTERFACE
+!
+! **********
+! EOL_READER
+! **********
+!
+SUBROUTINE EOL_CSVNOTFOUND_ERROR(HFILE)
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+END SUBROUTINE EOL_CSVNOTFOUND_ERROR
+!
+SUBROUTINE EOL_CSVEMPTY_ERROR(HFILE,KNBLINE)
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+ INTEGER, INTENT(IN) :: KNBLINE ! number of lines
+END SUBROUTINE EOL_CSVEMPTY_ERROR
+!
+!
+! ***
+! ALM
+! ***
+!
+SUBROUTINE EOL_AIRFOILNOTFOUND_ERROR(HFILE,HVAR)
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+ CHARACTER(LEN=*), INTENT(IN) :: HVAR ! missing data
+END SUBROUTINE EOL_AIRFOILNOTFOUND_ERROR
+!
+SUBROUTINE EOL_WTCFL_ERROR(PMAXTSTEP)
+ REAL, INTENT(IN) :: PMAXTSTEP ! maximum acceptable time-step
+END SUBROUTINE EOL_WTCFL_ERROR
+!
+SUBROUTINE EOL_BLADEDATA_ERROR(PDELTARAD)
+ REAL, INTENT(IN) :: PDELTARAD ! Span lenght of an element
+END SUBROUTINE EOL_BLADEDATA_ERROR
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_ERROR
+!-------------------------------------------------------------------
+!
+!!**** *EOL_ERROR* -
+!!
+!! PURPOSE
+!! -------
+!! Some usefull subs to manage errors linked to wind turbines
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 15/12/2020
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE EOL_CSVNOTFOUND_ERROR(HFILE)
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_MSG
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+!
+CMNHMSG(1) = 'EOL Initialization error: CSV file for wind turbine missing'
+CMNHMSG(2) = 'File: ' // TRIM( HFILE ) // ' not found'
+CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_CSVNOTFOUND_ERROR' )
+!
+END SUBROUTINE EOL_CSVNOTFOUND_ERROR
+!#########################################################
+
+!
+!#########################################################
+SUBROUTINE EOL_CSVEMPTY_ERROR(HFILE,KNBLINE)
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_MSG
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+INTEGER, INTENT(IN) :: KNBLINE ! number of lines
+!
+CHARACTER(LEN=8) :: YLINES
+!
+WRITE( YLINES, '( I8 )' ) KNBLINE
+!
+CMNHMSG(1) = 'EOL Initialization error: missing data in CSV file for wind turbine'
+CMNHMSG(2) = TRIM( YLINES ) // ' line(s) have been read in file ' // TRIM( HFILE )
+CMNHMSG(3) = 'At least 2 should be there: header + data'
+CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_CSVEMPTY_ERROR' )
+!
+END SUBROUTINE EOL_CSVEMPTY_ERROR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE EOL_AIRFOILNOTFOUND_ERROR(HFILE,HVAR)
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_MSG
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file read
+CHARACTER(LEN=*), INTENT(IN) :: HVAR ! missing data
+!
+CMNHMSG(1) = 'EOL Initialization error: missing data for airfoil'
+CMNHMSG(2) = 'Characteristics for ' // TRIM( HVAR )
+CMNHMSG(3) = 'not found in file ' // TRIM( HFILE )
+CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_AIRFOILNOTFOUND_ERROR' )
+!
+END SUBROUTINE EOL_AIRFOILNOTFOUND_ERROR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE EOL_WTCFL_ERROR(PMAXTSTEP)
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_MSG
+!
+REAL, INTENT(IN) :: PMAXTSTEP ! maximum acceptable time-step
+!
+CHARACTER(LEN=10) :: YMAXTSTEP
+!
+WRITE( YMAXTSTEP, '( F10.8 )' ) PMAXTSTEP
+!
+CMNHMSG(1) = 'EOL Initialization error: wrong time-step with wind turbine'
+CMNHMSG(2) = 'Time-step XTSTEP too large: blades can jump over one or several cells'
+CMNHMSG(3) = 'Turn on the time-splitting method (LTIMESPLIT=.TRUE.)'
+CMNHMSG(4) = 'or decrease XTSTEP to a value lower than ' // TRIM(YMAXTSTEP) // ' s'
+CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_WTCFL_ERROR' )
+!
+END SUBROUTINE EOL_WTCFL_ERROR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE EOL_BLADEDATA_ERROR(PDELTARAD)
+!
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODE_IO_FILE, ONLY: IO_File_close
+USE MODE_MSG
+USE MODD_EOL_SHARED_IO, ONLY: CBLADE_CSVDATA
+!
+REAL, INTENT(IN) :: PDELTARAD ! hals section width
+!
+CHARACTER(LEN=4) :: YDELTARAD
+!
+WRITE( YDELTARAD, '( F4.2 )' ) PDELTARAD
+!
+CMNHMSG(1) = 'EOL Initialization error: error in blade data'
+CMNHMSG(2) = 'A blade element center position is set to ' // TRIM( YDELTARAD )
+CMNHMSG(3) = 'As a blade element center, it has to be set in ]0%;100%['
+CMNHMSG(4) = 'Please, check your blade data in ' // TRIM(CBLADE_CSVDATA)
+CMNHMSG(5) = 'and make sure it is element centers (not nodes) along the blade'
+CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'EOL_BLADEDATA_ERROR' )
+!
+END SUBROUTINE EOL_BLADEDATA_ERROR
+!#########################################################
+!
diff --git a/src/MNH/eol_kine_alm.f90 b/src/MNH/eol_kine_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..45b4cf6795942491c1fac17b449af168bf242e6f
--- /dev/null
+++ b/src/MNH/eol_kine_alm.f90
@@ -0,0 +1,337 @@
+!MNH_LIC Copyright 2017-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+!#######################
+MODULE MODI_EOL_KINE_ALM
+!
+INTERFACE !----------------------------------------
+!
+SUBROUTINE EOL_KINE_ALM(KTCOUNT,KTSUBCOUNT,PTSUBSTEP,PTSTEP)
+!
+ INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+ INTEGER, INTENT(IN) :: KTSUBCOUNT ! sub iteration count
+ REAL, INTENT(IN) :: PTSUBSTEP ! sub timestep
+ REAL, INTENT(IN) :: PTSTEP ! timestep
+!
+END SUBROUTINE EOL_KINE_ALM
+!
+END INTERFACE !------------------------------------
+!
+END MODULE MODI_EOL_KINE_ALM
+!#######################
+!
+!
+!
+!
+!###################################################################
+SUBROUTINE EOL_KINE_ALM(KTCOUNT,KTSUBCOUNT,PTSUBSTEP,PTSTEP)
+!
+!!**** *EOL_KINEMATICS * -
+!!
+!! PURPOSE
+!! -------
+!! Compute positions, oritentations and velocities of all the
+!! elements of the wind turbine
+!!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/2017
+!! Modification 10/11/20 (PA. Joulin) Updated for a main version
+! P. Wautelet 19/07/2021: replace double precision by real to allow MNH_REAL=4 compilation
+!!
+!!---------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 Modules
+USE MODD_EOL_KINE_ALM
+USE MODD_EOL_ALM
+USE MODI_EOL_MATHS
+USE MODD_TIME_n, ONLY : TDTCUR
+USE MODD_CST, ONLY : XPI
+!
+IMPLICIT NONE
+!
+!* 0.2 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+INTEGER, INTENT(IN) :: KTSUBCOUNT ! sub iteration count
+REAL, INTENT(IN) :: PTSUBSTEP ! sub timestep
+REAL, INTENT(IN) :: PTSTEP ! timestep
+!
+!* 0.3 Local variables
+REAL, DIMENSION(3,3) :: ZORI_MAT_X, ZORI_MAT_Y, ZORI_MAT_Z
+REAL, DIMENSION(3) :: ZADD_TO_POS
+!
+REAL, DIMENSION(3) :: ZDIST_TOWO_TELT_RG ! Distance between tower elmt and tower base
+REAL, DIMENSION(3) :: ZDIST_TOWO_NELT_RG ! Distance between nacelle and base of tower
+REAL, DIMENSION(3) :: ZDIST_NAC_HUB_RG ! Distance between hub and base of nacelle
+REAL, DIMENSION(3) :: ZDIST_HUB_BLA_RG ! Distance between blade and base of hub
+REAL, DIMENSION(3) :: ZDIST_BLA_ELT_RG ! Distance between blade and elements
+!
+REAL, DIMENSION(3) :: ZPOS_ELTLE_RE ! Leading Edge (LE) position, in RE
+REAL, DIMENSION(3) :: ZPOS_ELTLE_RG ! Leading Edge (LE) position, in RG
+REAL, DIMENSION(3) :: ZPOS_ELTTE_RE ! Trailing Edge (TE) position, in RE
+REAL, DIMENSION(3) :: ZPOS_ELTTE_RG ! Trailing Edge (TE) position, in RG
+!
+REAL :: ZTIME ! TIME
+INTEGER :: JROT, JBLA, JTELT, JNELT, JBELT ! Loop control
+INTEGER :: INB_WT, INB_B, INB_BELT ! Total numbers
+INTEGER :: INB_TELT, INB_NELT ! Total numbers
+INTEGER :: ITECOUT ! Unit number for Tecplot file
+!
+!
+!---------------------------------------------------------------
+!
+!* 1. PRELIMINARIES
+! -------------
+!
+!* 1.1 Some useful integers
+INB_WT = TFARM%NNB_TURBINES
+INB_B = TTURBINE%NNB_BLADES
+INB_TELT = 2
+INB_NELT = 2
+INB_BELT = TBLADE%NNB_BLAELT
+!
+!* 1.2 Sub-time computation
+ZTIME = TDTCUR%xtime+(KTSUBCOUNT)*PTSUBSTEP
+!
+!* 1.3 Tecplotfile : opening + headers
+IF (LTECOUTPTS) THEN
+ CALL OPEN_TECOUT(ITECOUT, KTCOUNT, KTSUBCOUNT)
+END IF
+!
+!
+!---------------------------------------------------------------
+!
+!* 2. COMPUTATIONS
+! ------------
+!
+DO JROT=1, INB_WT
+!
+! ---- TOWER ----
+!
+!* T.0 Update origin positions in RG (Base position + floating)
+ XPOS_TOWO_RG(JROT,:) = XPOS_REF(:) + XPOSINI_TOWO_RG(JROT,:) &
+ + XTVEL_TOWO_RG(JROT,:)*ZTIME
+!
+!* T.1 Update orientation
+ CALL GET_ORI_MAT_X(XANGINI_TOW_RG(JROT,1) + XRVEL_RT_RG(JROT,1)*ZTIME, ZORI_MAT_X)
+ CALL GET_ORI_MAT_Y(XANGINI_TOW_RG(JROT,2) + XRVEL_RT_RG(JROT,2)*ZTIME, ZORI_MAT_Y)
+ CALL GET_ORI_MAT_Z(XANGINI_TOW_RG(JROT,3) + XRVEL_RT_RG(JROT,3)*ZTIME, ZORI_MAT_Z)
+! Compute orientation matrix
+ XMAT_RG_RT(JROT,:,:) = MATMUL(ZORI_MAT_X, MATMUL(ZORI_MAT_Y, ZORI_MAT_Z))
+!
+!* T.2 Update positions in RG
+ DO JTELT=1, INB_TELT
+ XPOS_TELT_RG(JROT,JTELT,:) = XPOS_TOWO_RG(JROT,:) &
+ + MATMUL(XMAT_RG_RT(JROT,:,:),XPOS_TELT_RT(JROT,JTELT,:))
+ END DO
+!
+!* T.3 Update structural velocities
+ DO JTELT=1, INB_TELT
+ ! Rotation of tower already in RG
+ ! Translation of elements
+ ZDIST_TOWO_TELT_RG(:) = XPOS_TELT_RG(JROT,JTELT,:) - XPOS_TOWO_RG(JROT,:)
+ XTVEL_TELT_RG(JROT,JTELT,:) = XTVEL_TOWO_RG(JROT,:) &
+ + CROSS(XRVEL_RT_RG(JROT,:),ZDIST_TOWO_TELT_RG(:))
+ ENDDO
+!
+!* T.4 Print in tecplot file
+ IF (LTECOUTPTS) THEN
+ DO JTELT=1, INB_TELT
+ CALL PRINT_TECOUT(ITECOUT, XPOS_TELT_RG(JROT,JTELT,:))
+ END DO
+ END IF
+!
+!
+! ---- NACELLE ----
+!
+!* N.0 Update origin positions in RG
+ XPOS_NACO_RG(JROT,:) = XPOS_TELT_RG(JROT,INB_TELT,:) &
+ + MATMUL(XMAT_RG_RT(JROT,:,:),XPOSINI_NACO_RT(JROT,:))
+!
+!* N.1 Update orientation
+ CALL GET_ORI_MAT_X(XANGINI_NAC_RT(JROT,1) + XRVEL_RN_RT(JROT,1)*ZTIME, ZORI_MAT_X)
+ CALL GET_ORI_MAT_Y(XANGINI_NAC_RT(JROT,2) + XRVEL_RN_RT(JROT,2)*ZTIME, ZORI_MAT_Y)
+ CALL GET_ORI_MAT_Z(XANGINI_NAC_RT(JROT,3) + XRVEL_RN_RT(JROT,3)*ZTIME, ZORI_MAT_Z)
+!
+! Orientation matrix
+ XMAT_RT_RN(JROT,:,:) = MATMUL(ZORI_MAT_X, MATMUL(ZORI_MAT_Y, ZORI_MAT_Z))
+ XMAT_RG_RN(JROT,:,:) = MATMUL(XMAT_RG_RT(JROT,:,:), XMAT_RT_RN(JROT,:,:))
+!
+!* N.2 Update positions in RG
+ DO JNELT=1, INB_NELT
+ XPOS_NELT_RG(JROT,JNELT,:) = XPOS_NACO_RG(JROT,:) &
+ + MATMUL(XMAT_RG_RN(JROT,:,:),XPOS_NELT_RN(JROT,JNELT,:))
+ END DO
+!
+!* N.3 Update structural velocities
+ ! Rotation of nacelle in RG
+ XRVEL_RN_RG(JROT,:) = MATMUL(XMAT_RG_RT(JROT,:,:),XRVEL_RN_RT(JROT,:)) &
+ + XRVEL_RT_RG(JROT,:)
+ DO JNELT=1, INB_NELT
+ ! Translation of elements in RG
+ ZDIST_TOWO_NELT_RG(:) = XPOS_NELT_RG(JROT,JNELT,:) - XPOS_TOWO_RG(JROT,:)
+ XTVEL_NELT_RG(JROT,JNELT,:) = XTVEL_TOWO_RG(JROT,:) &
+ + CROSS(XRVEL_RN_RG(JROT,:),ZDIST_TOWO_NELT_RG(:))
+ END DO
+!
+!* N.4 Print in tecplot file
+ IF (LTECOUTPTS) THEN
+ DO JNELT=1, INB_NELT
+ CALL PRINT_TECOUT(ITECOUT, XPOS_NELT_RG(JROT,JNELT,:))
+ END DO
+ END IF
+!
+!
+! ---- HUB ----
+!
+!* H.1 Update positions
+ XPOS_HUB_RG(JROT,:) = XPOS_NELT_RG(JROT,INB_NELT,:) &
+ + MATMUL(XMAT_RG_RN(JROT,:,:),XPOSINI_HUB_RN(JROT,:))
+!
+!* H.2 Update orientation
+ CALL GET_ORI_MAT_X(XANGINI_HUB_RN(JROT,1) + XRVEL_RH_RN(JROT,1)*ZTIME, ZORI_MAT_X)
+ CALL GET_ORI_MAT_Y(XANGINI_HUB_RN(JROT,2) + XRVEL_RH_RN(JROT,2)*ZTIME, ZORI_MAT_Y)
+ CALL GET_ORI_MAT_Z(XANGINI_HUB_RN(JROT,3) + XRVEL_RH_RN(JROT,3)*ZTIME, ZORI_MAT_Z)
+! Orientation matrix
+ XMAT_RN_RH(JROT,:,:) = MATMUL(ZORI_MAT_X, MATMUL(ZORI_MAT_Y, ZORI_MAT_Z))
+ XMAT_RG_RH(JROT,:,:) = MATMUL(XMAT_RG_RN(JROT,:,:), XMAT_RN_RH(JROT,:,:))
+ XMAT_RH_RG(JROT,:,:) = TRANSPOSE(XMAT_RG_RH(JROT,:,:))
+!
+!* H.3 Update structural velocities
+! Rotation of hub in RG
+ XRVEL_RH_RG(JROT,:) = MATMUL(XMAT_RG_RH(JROT,:,:),XRVEL_RH_RN(JROT,:)) &
+ + XRVEL_RN_RG(JROT,:)
+! Translation of hub in RG
+ ZDIST_NAC_HUB_RG(:) = XPOS_HUB_RG(JROT,:) - XPOS_NELT_RG(JROT,INB_NELT,:)
+ XTVEL_HUB_RG(JROT,:) = XTVEL_NELT_RG(JROT,INB_NELT,:) + CROSS(XRVEL_RH_RG(JROT,:),ZDIST_NAC_HUB_RG(:))
+!
+!* H.4 Print in tecplot file
+ IF (LTECOUTPTS) THEN
+ CALL PRINT_TECOUT(ITECOUT, XPOS_HUB_RG(JROT,:))
+ END IF
+!
+!
+! ---- BLADES ----
+!
+ DO JBLA=1, INB_B
+!* B.1 Update positions
+ XPOS_BLA_RG(JROT,JBLA,:) = XPOS_HUB_RG(JROT,:) &
+ + MATMUL(XMAT_RG_RH(JROT,:,:),XPOSINI_BLA_RH(JROT,JBLA,:))
+!
+!* B.2 Update orientation
+ CALL GET_ORI_MAT_X(XANGINI_BLA_RH(JROT,JBLA,1) + XRVEL_RB_RH(JROT,JBLA,1)*ZTIME, ZORI_MAT_X)
+ CALL GET_ORI_MAT_Y(XANGINI_BLA_RH(JROT,JBLA,2) + XRVEL_RB_RH(JROT,JBLA,2)*ZTIME, ZORI_MAT_Y)
+ CALL GET_ORI_MAT_Z(XANGINI_BLA_RH(JROT,JBLA,3) + XRVEL_RB_RH(JROT,JBLA,3)*ZTIME, ZORI_MAT_Z)
+! Orientation matrix
+ XMAT_RH_RB(JROT,JBLA,:,:) = MATMUL(ZORI_MAT_X, MATMUL(ZORI_MAT_Y, ZORI_MAT_Z))
+ XMAT_RG_RB(JROT,JBLA,:,:) = MATMUL(XMAT_RG_RH(JROT,:,:), XMAT_RH_RB(JROT,JBLA,:,:))
+!
+!* B.3 Update structural velocities
+! Rotation of blade in RG
+ XRVEL_RB_RG(JROT,JBLA,:) = XRVEL_RH_RG(JROT,:) &
+ + MATMUL(XMAT_RG_RB(JROT,JBLA,:,:),XRVEL_RB_RH(JROT,JBLA,:))
+! Translation of blade in RG
+ ZDIST_HUB_BLA_RG(:) = XPOS_BLA_RG(JROT,JBLA,:) - XPOS_HUB_RG(JROT,:)
+ XTVEL_BLA_RG(JROT,JBLA,:) = XTVEL_HUB_RG(JROT,:) &
+ + CROSS(XRVEL_RB_RG(JROT,JBLA,:),ZDIST_HUB_BLA_RG(:))
+!
+!* B.4 Print in tecplot file
+ IF (LTECOUTPTS) THEN
+ CALL PRINT_TECOUT(ITECOUT, XPOS_BLA_RG(JROT,JBLA,:))
+ END IF
+!
+!
+! ---- ELEMENTS ----
+!* E.0 Positioning sections (cuts) in RG
+ DO JBELT=1, INB_BELT+1
+ XPOS_SEC_RG(JROT,JBLA,JBELT,:) = XPOS_BLA_RG(JROT,JBLA,:) &
+ + MATMUL(XMAT_RG_RB(JROT,JBLA,:,:),XPOS_SEC_RB(JROT,JBLA,JBELT,:))
+ ENDDO
+!
+!
+ DO JBELT=1, INB_BELT
+!* E.1 Positioning sections centers (application points) in RG
+ XPOS_ELT_RG(JROT,JBLA,JBELT,:) = XPOS_BLA_RG(JROT,JBLA,:) &
+ + MATMUL(XMAT_RG_RB(JROT,JBLA,:,:),XPOS_ELT_RB(JROT,JBLA,JBELT,:))
+!* E.2 Update orientation
+ CALL GET_ORI_MAT_X(XANGINI_ELT_RB(JROT,JBLA,JBELT,1) &
+ + XRVEL_RE_RB(JROT,JBLA,JBELT,1)*ZTIME, ZORI_MAT_X)
+ CALL GET_ORI_MAT_Y(XANGINI_ELT_RB(JROT,JBLA,JBELT,2) &
+ + XRVEL_RE_RB(JROT,JBLA,JBELT,2)*ZTIME, ZORI_MAT_Y)
+ CALL GET_ORI_MAT_Z(XANGINI_ELT_RB(JROT,JBLA,JBELT,3) &
+ + XRVEL_RE_RB(JROT,JBLA,JBELT,3)*ZTIME, ZORI_MAT_Z)
+! Orientation matrix
+ XMAT_RB_RE(JROT,JBLA,JBELT,:,:) = MATMUL(ZORI_MAT_X, MATMUL(ZORI_MAT_Y,ZORI_MAT_Z))
+ XMAT_RG_RE(JROT,JBLA,JBELT,:,:) = MATMUL(XMAT_RG_RB(JROT,JBLA,:,:), XMAT_RB_RE(JROT,JBLA,JBELT,:,:))
+ XMAT_RE_RG(JROT,JBLA,JBELT,:,:) = TRANSPOSE(XMAT_RG_RE(JROT,JBLA,JBELT,:,:))
+!
+!* E.3 Update structural velocities
+! Rotation of elements in RG
+ XRVEL_RE_RG(JROT,JBLA,JBELT,:) = XRVEL_RB_RG(JROT,JBLA,:) &
+ + MATMUL(XMAT_RG_RE(JROT,JBLA,JBELT,:,:),&
+ XRVEL_RE_RB(JROT,JBLA,JBELT,:))
+! Translation of elements in RG
+ ZDIST_BLA_ELT_RG(:) = XPOS_ELT_RG(JROT,JBLA,JBELT,:) - XPOS_BLA_RG(JROT,JBLA,:)
+ XTVEL_ELT_RG(JROT,JBLA,JBELT,:) = XTVEL_BLA_RG(JROT,JBLA,:) &
+ + CROSS(XRVEL_RE_RG(JROT,JBLA,JBELT,:),ZDIST_BLA_ELT_RG(:))
+ XTVEL_ELT_RE(JROT,JBLA,JBELT,:) = MATMUL(XMAT_RE_RG(JROT,JBLA,JBELT,:,:),&
+ XTVEL_ELT_RG(JROT,JBLA,JBELT,:))
+!
+!* E.4 Print in tecplot file
+ IF (LTECOUTPTS) THEN
+ CALL PRINT_TECOUT(ITECOUT, XPOS_ELT_RG(JROT,JBLA,JBELT,:))
+ END IF
+!
+! ---- Leading Edge and Trailing Edge ----
+! It is just to have a tecplot more beautiful
+! For the moment, they are useless for computations
+ IF (LTECOUTPTS) THEN
+! LE.1 Update Positions
+ ZPOS_ELTLE_RE(1) = 0d0
+ ZPOS_ELTLE_RE(2) = - 1d0/4d0 * XCHORD_ELT(JROT,JBLA,JBELT)
+ ZPOS_ELTLE_RE(3) = 0d0
+ ZPOS_ELTTE_RE(1) = 0d0
+ ZPOS_ELTTE_RE(2) = + 3d0/4d0 * XCHORD_ELT(JROT,JBLA,JBELT)
+ ZPOS_ELTTE_RE(3) = 0d0
+!
+ ZPOS_ELTLE_RG(:) = XPOS_ELT_RG(JROT,JBLA,JBELT,:) &
+ + MATMUL(XMAT_RG_RE(JROT,JBLA,JBELT,:,:), &
+ ZPOS_ELTLE_RE(:))
+ ZPOS_ELTTE_RG(:) = XPOS_ELT_RG(JROT,JBLA,JBELT,:) &
+ + MATMUL(XMAT_RG_RE(JROT,JBLA,JBELT,:,:), &
+ ZPOS_ELTTE_RE(:))
+
+!* LE.2 Print in tecplot file
+ CALL PRINT_TECOUT(ITECOUT, ZPOS_ELTLE_RG(:))
+ CALL PRINT_TECOUT(ITECOUT, ZPOS_ELTTE_RG(:))
+ END IF
+!
+!
+ END DO ! Blade element loop
+ END DO ! Blade loop
+END DO ! Rotor loop
+!
+! Closing tec file
+IF (LTECOUTPTS) THEN
+ CLOSE(ITECOUT)
+END IF
+!
+END SUBROUTINE EOL_KINE_ALM
diff --git a/src/MNH/eol_main.f90 b/src/MNH/eol_main.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6b0633c1dec3746119312794abaa4b75c4a16fed
--- /dev/null
+++ b/src/MNH/eol_main.f90
@@ -0,0 +1,284 @@
+!MNH_LIC Copyright 2020-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_MAIN
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE EOL_MAIN(KTCOUNT, PTSTEP, &
+ PDXX, PDYY, PDZZ, &
+ PRHODJ, PUT, PVT, PWT, &
+ PRUS, PRVS, PRWS )
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! timestep except
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! mesh size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! wind speed variables
+!
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Sources of Momentum
+!
+END SUBROUTINE EOL_MAIN
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_MAIN
+!
+! ###################################################################
+ SUBROUTINE EOL_MAIN(KTCOUNT, PTSTEP, &
+ PDXX, PDYY, PDZZ, &
+ PRHODJ, PUT, PVT, PWT, &
+ PRUS, PRVS, PRWS )
+! ###################################################################
+!
+!!**** *EOL_MAIN * -
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several models are available. EOL_MAIN is the main subroutine
+!! to compute the aerodynamics of the wind turbine, according to the
+!! model chosen.
+!!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! 21/10/20 Original
+!!
+!!---------------------------------------------------------------
+!
+!
+!* 0. DECLARATIONS
+! ------------
+!
+! To work with wind turbines
+USE MODD_EOL_MAIN
+USE MODI_EOL_ADNR
+USE MODI_EOL_ALM
+USE MODI_EOL_SMEAR
+! To play with MPI
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODE_ll , ONLY: ADD3DFIELD_ll
+USE MODE_ll , ONLY: UPDATE_HALO_ll
+USE MODE_ll , ONLY: CLEANLIST_ll
+! To use some toolkit
+USE MODI_SHUMAN , ONLY: MXF, MYF, MZF
+USE MODI_SHUMAN , ONLY: MXM, MYM, MZM
+!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, NBUDGET_U, NBUDGET_V, NBUDGET_W, tbudgets
+use mode_budget, only: budget_store_init, budget_store_end
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
+REAL, INTENT(IN) :: PTSTEP ! timestep except
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ ! mesh size
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! dry Density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! Wind speed
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS, PRVS, PRWS ! Sources of Momentum
+!
+!
+!* 0.2 Declarations of local variables :
+!
+! Pointeurs and exchanges
+TYPE(LIST_ll), POINTER :: TZFIELDS_W_ll ! Field list of Wind for exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS_F_ll ! Field list of aero Forces for exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS_S_ll ! Field list of Smeared aero forces for exchange
+TYPE(LIST_ll), POINTER :: TZFIELDS_R_ll ! Field list of mnh foRces for exchange
+INTEGER :: IINFO ! Info integer
+INTEGER :: IKU ! Vertical size of the domain
+!
+! ABL
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZUT_M, ZVT_M, ZWT_M ! Wind speed at mass point
+REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHO_M ! Air density at mass point
+!
+!
+!* 0.3 Implicit arguments
+!* From MODD_EOL_MAIN
+! Aerodynamic forces in cartesian mesh
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFX_RG ! Along X in RG frame [F]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFY_RG ! Along Y in RG frame [F]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFZ_RG ! Along Z in RG frame [F]
+! Smeared forces
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFX_SMR_RG ! Along X in RG frame [F]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFY_SMR_RG ! Along Y in RG frame [F]
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFZ_SMR_RG ! ALong Z in RG frame [F]
+!
+!* From NAM_EOL namelist
+!CHARACTER(LEN=4) :: CMETH_EOL ! Aerodynamic method
+!CHARACTER(LEN=4) :: CSMEAR ! Type of smearing
+!
+!
+!--------------------------------------------------------
+!
+!* 1. INITIALIZATIONS
+! ---------------
+!
+!* 1.1 Indices
+!
+IKU = SIZE(PUT,3)
+!
+!* 1.2 Pointers
+!
+NULLIFY(TZFIELDS_W_ll)
+NULLIFY(TZFIELDS_F_ll)
+NULLIFY(TZFIELDS_S_ll)
+NULLIFY(TZFIELDS_R_ll)
+!
+!* 1.3 Forces
+!
+XFX_RG(:,:,:) = 0.
+XFY_RG(:,:,:) = 0.
+XFZ_RG(:,:,:) = 0.
+XFX_SMR_RG(:,:,:) = 0.
+XFY_SMR_RG(:,:,:) = 0.
+XFZ_SMR_RG(:,:,:) = 0.
+!
+!
+!-----------------------------------------------------------------------
+!
+!* 2. COMPUTES VELOCITY COMPONENTS AND DENSITY AT MASS POINT
+! ------------------------------------------------------
+!
+!* 2.1 Sharing the input
+!
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,PUT, 'EOL_MAIN::PUT')
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,PWT, 'EOL_MAIN::PWT')
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,PVT, 'EOL_MAIN::PVT')
+CALL UPDATE_HALO_ll(TZFIELDS_W_ll,IINFO)
+CALL CLEANLIST_ll( TZFIELDS_W_ll)
+!
+!* 2.2 Masss point evaluation
+!
+ZUT_M(:,:,:) = MXF( PUT(:,:,:) )
+ZVT_M(:,:,:) = MYF( PVT(:,:,:) )
+ZWT_M(:,:,:) = MZF( PWT(:,:,:) )
+ZRHO_M(:,:,:) = PRHODJ(:,:,:)/(PDXX(:,:,:)*PDYY(:,:,:)*PDZZ(:,:,:))
+!
+!* 2.3 Sharing the new wind
+!
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,ZUT_M, 'EOL_MAIN::ZUT_M')
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,ZWT_M, 'EOL_MAIN::ZWT_M')
+CALL ADD3DFIELD_ll( TZFIELDS_W_ll,ZVT_M, 'EOL_MAIN::ZVT_M')
+CALL UPDATE_HALO_ll(TZFIELDS_W_ll,IINFO)
+CALL CLEANLIST_ll( TZFIELDS_W_ll)
+!
+!
+!--------------------------------------------------------
+!
+!* 3. COMPUTES AERODYNAMICS FORCES
+! ----------------------------
+!
+!* 3.1 Model selection
+!
+!
+SELECT CASE(CMETH_EOL)
+!
+ CASE('ADNR') ! Actuator Disc Non-Rotating
+ CALL EOL_ADNR(PDXX, PDYY, PDZZ, &
+ ZRHO_M, &
+ ZUT_M, &
+ XFX_RG )
+!
+ CASE('ALM') ! Actuator Line Method
+ CALL EOL_ALM(KTCOUNT, PTSTEP, &
+ PDXX, PDYY, PDZZ, &
+ ZRHO_M, &
+ ZUT_M, ZVT_M, ZWT_M, &
+ XFX_RG, XFY_RG, XFZ_RG )
+!
+END SELECT
+!
+!* 3.2 Sharing 3D field
+!
+CALL ADD3DFIELD_ll( TZFIELDS_F_ll,XFX_RG, 'EOL_MAIN::XFX_RG' )
+CALL ADD3DFIELD_ll( TZFIELDS_F_ll,XFY_RG, 'EOL_MAIN::XFY_RG' )
+CALL ADD3DFIELD_ll( TZFIELDS_F_ll,XFZ_RG, 'EOL_MAIN::XFZ_RG' )
+CALL UPDATE_HALO_ll(TZFIELDS_F_ll,IINFO)
+CALL CLEANLIST_ll( TZFIELDS_F_ll)
+!
+!
+!--------------------------------------------------------
+!
+!* 4. SMEARING THE FORCES
+! -------------------
+!
+!* 4.1 Smearing technique selection
+!
+SELECT CASE (CSMEAR)
+!
+ CASE( 'NULL' ) ! No smearing
+ XFX_SMR_RG(:,:,:) = XFX_RG(:,:,:)
+ XFY_SMR_RG(:,:,:) = XFY_RG(:,:,:)
+ XFZ_SMR_RG(:,:,:) = XFZ_RG(:,:,:)
+!
+ CASE( '1LIN' ) ! Linear smearing
+ CALL SMEAR_1LIN(XFX_RG, &
+ XFX_SMR_RG)
+!
+ CASE( '3LIN' ) ! Linear smearing
+ CALL SMEAR_3LIN(XFX_RG, &
+ XFY_RG, &
+ XFZ_RG, &
+ XFX_SMR_RG,&
+ XFY_SMR_RG,&
+ XFZ_SMR_RG)
+!
+END SELECT
+!
+!* 4.2 Sharing 3D field
+!
+CALL ADD3DFIELD_ll( TZFIELDS_S_ll,XFX_SMR_RG, 'EOL_MAIN::XFX_SMR_RG' )
+CALL ADD3DFIELD_ll( TZFIELDS_S_ll,XFY_SMR_RG, 'EOL_MAIN::XFY_SMR_RG' )
+CALL ADD3DFIELD_ll( TZFIELDS_S_ll,XFZ_SMR_RG, 'EOL_MAIN::XFZ_SMR_RG' )
+CALL UPDATE_HALO_ll(TZFIELDS_S_ll,IINFO)
+CALL CLEANLIST_ll( TZFIELDS_S_ll)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. ADDING THE FORCES TO THE FIELD
+! ------------------------------
+!
+!* 5.1 Adding them to flux points, rotor->wind
+!
+if (lbudget_u) call Budget_store_init( tbudgets(NBUDGET_U), 'DRAGEOL', prus(:,:,:) )
+if (lbudget_v) call Budget_store_init( tbudgets(NBUDGET_V), 'DRAGEOL', prvs(:,:,:) )
+if (lbudget_w) call Budget_store_init( tbudgets(NBUDGET_W), 'DRAGEOL', prws(:,:,:) )
+!
+PRUS(:,:,:)=PRUS(:,:,:)-MXM(XFX_SMR_RG(:,:,:))
+PRVS(:,:,:)=PRVS(:,:,:)-MYM(XFY_SMR_RG(:,:,:))
+PRWS(:,:,:)=PRWS(:,:,:)-MZM(XFZ_SMR_RG(:,:,:))
+!
+if (lbudget_u) call Budget_store_end( tbudgets(NBUDGET_U), 'DRAGEOL', prus(:,:,:) )
+if (lbudget_v) call Budget_store_end( tbudgets(NBUDGET_V), 'DRAGEOL', prvs(:,:,:) )
+if (lbudget_w) call Budget_store_end( tbudgets(NBUDGET_W), 'DRAGEOL', prws(:,:,:) )
+!
+!
+!* 5.2 Sharing the field
+!
+CALL ADD3DFIELD_ll( TZFIELDS_R_ll,PRUS,'EOL_MAIN::PRUS' )
+CALL ADD3DFIELD_ll( TZFIELDS_R_ll,PRVS,'EOL_MAIN::PRVS' )
+CALL ADD3DFIELD_ll( TZFIELDS_R_ll,PRWS,'EOL_MAIN::PRWS' )
+CALL UPDATE_HALO_ll(TZFIELDS_R_ll,IINFO)
+CALL CLEANLIST_ll( TZFIELDS_R_ll)
+!
+END SUBROUTINE EOL_MAIN
diff --git a/src/MNH/eol_maths.f90 b/src/MNH/eol_maths.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bda3aa6949d919d1616eb68b28bef118ab7802fd
--- /dev/null
+++ b/src/MNH/eol_maths.f90
@@ -0,0 +1,379 @@
+!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.
+!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 19/07/2021: replace double precision by real to allow MNH_REAL=4 compilation
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_MATHS
+! #######################
+!
+INTERFACE
+!
+FUNCTION CROSS(PA, PB)
+ REAL, DIMENSION(3) :: CROSS
+ REAL, DIMENSION(3), INTENT(IN) :: PA, PB
+END FUNCTION CROSS
+!
+FUNCTION NORM(PA)
+ REAL :: NORM
+ REAL, DIMENSION(3), INTENT(IN) :: PA
+END FUNCTION NORM
+!
+SUBROUTINE GET_ORI_MAT_X(PTHETA, PORI_MAT_X)
+ REAL, INTENT(IN) :: PTHETA ! Angle
+ REAL, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_X ! Matrix
+END SUBROUTINE GET_ORI_MAT_X
+!
+SUBROUTINE GET_ORI_MAT_Y(PTHETA, PORI_MAT_Y)
+ REAL, INTENT(IN) :: PTHETA ! Angle
+ REAL, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_Y ! Matrix
+END SUBROUTINE GET_ORI_MAT_Y
+!
+SUBROUTINE GET_ORI_MAT_Z(PTHETA, PORI_MAT_Z)
+ REAL, INTENT(IN) :: PTHETA ! Angle
+ REAL, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_Z ! Matrix
+END SUBROUTINE GET_ORI_MAT_Z
+!
+FUNCTION INTERP_SPLCUB(PAV, PX, PY)
+ REAL :: INTERP_SPLCUB ! interface
+ REAL, INTENT(IN) :: PAV ! Abscissa where spline is to be evaluate
+ REAL, DIMENSION(:), INTENT(IN) :: PX, PY
+END FUNCTION INTERP_SPLCUB
+!
+FUNCTION INTERP_LIN8NB(PPOS, KI, KJ, KK, PVAR, PZH)
+ REAL :: INTERP_LIN8NB ! interface
+ REAL, DIMENSION(3), INTENT(IN) :: PPOS ! Position where we want to evaluate
+ INTEGER, INTENT(IN) :: KI, KJ, KK ! Meso-NH cell index
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR,PZH ! Variable to interpolate
+END FUNCTION INTERP_LIN8NB
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_MATHS
+!-------------------------------------------------------------------
+!
+!!**** *EOL_MATHS* -
+!!
+!! PURPOSE
+!! -------
+!! Some usefull tools for wind turbine study
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! 04/2018 Original
+!!
+!!---------------------------------------------------------------
+!#########################################################
+FUNCTION CROSS(PA, PB)
+! Vectorial product 3D : PA * PB
+!
+ 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 CROSS
+!#########################################################
+!
+!#########################################################
+FUNCTION NORM(PA)
+! Eulerian norm of 3D vector :
+!
+ REAL :: NORM
+ REAL, DIMENSION(3), INTENT(IN) :: PA
+!
+ NORM = SQRT( PA(1)**2 + PA(2)**2 + PA(3)**2 )
+!
+END FUNCTION NORM
+!
+!
+!#########################################################
+SUBROUTINE GET_ORI_MAT_X(PTHETA, PORI_MAT_X)
+! Rotation matrix of PTHETA angle around X
+!
+ REAL, INTENT(IN) :: PTHETA ! Angle
+ REAL, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_X ! Matrix
+!
+ PORI_MAT_X (1,1) = 1d0
+ PORI_MAT_X (1,2) = 0d0
+ PORI_MAT_X (1,3) = 0d0
+ PORI_MAT_X (2,1) = 0d0
+ PORI_MAT_X (2,2) = +COS(PTHETA)
+ PORI_MAT_X (2,3) = -SIN(PTHETA)
+ PORI_MAT_X (3,1) = 0d0
+ PORI_MAT_X (3,2) = +SIN(PTHETA)
+ PORI_MAT_X (3,3) = +COS(PTHETA)
+!
+END SUBROUTINE GET_ORI_MAT_X
+!#########################################################
+!
+!#########################################################
+SUBROUTINE GET_ORI_MAT_Y(PTHETA, PORI_MAT_Y)
+! Rotation matrix of PTHETA angle around Y
+!
+ REAL, INTENT(IN) :: PTHETA ! Angle
+ REAL, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_Y ! Matrix
+!
+ PORI_MAT_Y (1,1) = +COS(PTHETA)
+ PORI_MAT_Y (1,2) = 0d0
+ PORI_MAT_Y (1,3) = +SIN(PTHETA)
+ PORI_MAT_Y (2,1) = 0d0
+ PORI_MAT_Y (2,2) = 1d0
+ PORI_MAT_Y (2,3) = 0d0
+ PORI_MAT_Y (3,1) = -SIN(PTHETA)
+ PORI_MAT_Y (3,2) = 0d0
+ PORI_MAT_Y (3,3) = +COS(PTHETA)
+!
+END SUBROUTINE GET_ORI_MAT_Y
+!#########################################################
+!
+!#########################################################
+SUBROUTINE GET_ORI_MAT_Z(PTHETA, PORI_MAT_Z)
+! Rotation matrix of PTHETA angle around Z
+!
+ REAL, INTENT(IN) :: PTHETA ! Angle
+ REAL, DIMENSION(3,3), INTENT(OUT) :: PORI_MAT_Z ! Matrix
+!
+ PORI_MAT_Z (1,1) = +COS(PTHETA)
+ PORI_MAT_Z (1,2) = -SIN(PTHETA)
+ PORI_MAT_Z (1,3) = 0d0
+ PORI_MAT_Z (2,1) = +SIN(PTHETA)
+ PORI_MAT_Z (2,2) = +COS(PTHETA)
+ PORI_MAT_Z (2,3) = 0d0
+ PORI_MAT_Z (3,1) = 0d0
+ PORI_MAT_Z (3,2) = 0d0
+ PORI_MAT_Z (3,3) = 1d0
+!
+END SUBROUTINE GET_ORI_MAT_Z
+!#########################################################
+!
+!#########################################################
+FUNCTION INTERP_SPLCUB(PAV, PX, PY)
+! adapted from https://ww2.odu.edu/~agodunov/computing/programs/book2/Ch01/spline.f90
+!
+IMPLICIT NONE
+REAL, INTENT(IN) :: PAV ! Abscissa where spline is to be evaluate
+REAL, DIMENSION(:), INTENT(IN) :: PX, PY
+!
+INTEGER :: INBVAL ! Nb points of data
+REAL, ALLOCATABLE :: ZCOEF1(:),ZCOEF2(:),ZCOEF3(:) ! Coefficients
+!
+INTEGER :: II, IJ, IBOT, ITOP, IMID
+REAL :: ZH
+REAL :: PDX
+REAL :: INTERP_SPLCUB ! function
+!
+! --------- Intialisations ---------
+INBVAL = SIZE(PX)
+ALLOCATE(ZCOEF1(INBVAL))
+ALLOCATE(ZCOEF2(INBVAL))
+ALLOCATE(ZCOEF3(INBVAL))
+!
+! --------- Calculs des coefficients ---------
+!
+! - Check size of input data
+IF (INBVAL < 2 ) THEN
+ RETURN
+END IF
+IF (INBVAL < 3 ) THEN
+ ZCOEF1(1) = (PY(2)-PY(1))/(PX(2)-PX(1))
+ ZCOEF2(1) = 0.
+ ZCOEF3(1) = 0.
+ ZCOEF1(2) = ZCOEF1(1)
+ ZCOEF2(2) = 0.
+ ZCOEF3(2) = 0.
+ RETURN
+END IF
+!
+! - Preliminaries
+ZCOEF3(1) = PX(2) - PX(1)
+ZCOEF2(2) = (PY(2) - PY(1))/ZCOEF3(1)
+DO II = 2, INBVAL-1
+ ZCOEF3(II) = PX(II+1) - PX(II)
+ ZCOEF1(II) = 2.0 * (ZCOEF3(II-1) + ZCOEF3(II))
+ ZCOEF2(II+1) = (PY(II+1) - PY(II))/ZCOEF3(II)
+ ZCOEF2(II) = ZCOEF2(II+1) - ZCOEF2(II)
+END DO
+!
+! - Boundaries
+ZCOEF1(1) = - ZCOEF3(1)
+ZCOEF1(INBVAL) = - ZCOEF3(INBVAL-1)
+ZCOEF2(1) = 0.0
+ZCOEF2(INBVAL) = 0.0
+IF (INBVAL /= 3) THEN
+ ZCOEF2(1) = ZCOEF2(3)/(PX(4)-PX(2)) - ZCOEF2(2)/(PX(3)-PX(1))
+ ZCOEF2(INBVAL) = ZCOEF2(INBVAL-1)/(PX(INBVAL)-PX(INBVAL-2)) &
+ -ZCOEF2(INBVAL-2)/(PX(INBVAL-1)-PX(INBVAL-3))
+ ZCOEF2(1) = ZCOEF2(1)*ZCOEF3(1)**2 / (PX(4)-PX(1))
+ ZCOEF2(INBVAL) =-ZCOEF2(INBVAL)*ZCOEF3(INBVAL-1)**2/(PX(INBVAL)-PX(INBVAL-3))
+END IF
+!
+! - Forward elemination
+DO II = 2, INBVAL
+ ZH = ZCOEF3(II-1)/ZCOEF1(II-1)
+ ZCOEF1(II) = ZCOEF1(II) - ZH*ZCOEF3(II-1)
+ ZCOEF2(II) = ZCOEF2(II) - ZH*ZCOEF2(II-1)
+END DO
+!
+! - Back substitution
+ZCOEF2(INBVAL) = ZCOEF2(INBVAL)/ZCOEF1(INBVAL)
+DO IJ = 1, INBVAL-1
+ II = INBVAL-IJ
+ ZCOEF2(II) = (ZCOEF2(II) - ZCOEF3(II)*ZCOEF2(II+1))/ZCOEF1(II)
+END DO
+!
+! - Spline coefficient calculations
+ZCOEF1(INBVAL) = (PY(INBVAL) - PY(INBVAL-1))/ZCOEF3(INBVAL-1) &
+ + ZCOEF3(INBVAL-1)*(ZCOEF2(INBVAL-1) + 2.0*ZCOEF2(INBVAL))
+DO II = 1, INBVAL-1
+ ZCOEF1(II) = (PY(II+1) - PY(II))/ZCOEF3(II) &
+ - ZCOEF3(II)*(ZCOEF2(II+1) + 2.0*ZCOEF2(II))
+ ZCOEF3(II) = (ZCOEF2(II+1) - ZCOEF2(II))/ZCOEF3(II)
+ ZCOEF2(II) = 3.0*ZCOEF2(II)
+END DO
+ZCOEF2(INBVAL) = 3.0*ZCOEF2(INBVAL)
+ZCOEF3(INBVAL) = ZCOEF3(INBVAL-1)
+
+! --------- Spline cubic interpolation ---------
+
+! If the absciss PAV is out of range
+! The ordinate will be the limit value (left or right)
+IF (PAV <= PX(1)) THEN
+ INTERP_SPLCUB = PY(1)
+ RETURN
+END IF
+IF (PAV >= PX(INBVAL)) THEN
+ INTERP_SPLCUB = PY(INBVAL)
+ RETURN
+END IF
+
+! Dichotomie research for IBOT, tq : PX(IBOT) <= PAV <= PX(IBOT+1)
+IBOT = 1
+ITOP = INBVAL +1
+DO WHILE (ITOP > IBOT+1)
+ IMID = (IBOT + ITOP)/2
+ IF (PAV < PX(IMID)) THEN
+ ITOP = IMID
+ ELSE
+ IBOT = IMID
+ END IF
+END DO
+
+! Evaluation of spline interpolation
+PDX = PAV - PX(IBOT)
+INTERP_SPLCUB = PY(IBOT)+PDX*(ZCOEF1(IBOT)+PDX*(ZCOEF2(IBOT)+PDX*ZCOEF3(IBOT)))
+
+! Endings
+DEALLOCATE(ZCOEF1)
+DEALLOCATE(ZCOEF2)
+DEALLOCATE(ZCOEF3)
+
+END FUNCTION INTERP_SPLCUB
+!#########################################################
+!
+!#########################################################
+FUNCTION INTERP_LIN8NB(PPOS, KI, KJ, KK, PVAR, PZH)
+!
+USE MODD_GRID_n, ONLY: XXHAT,XYHAT
+!
+REAL :: INTERP_LIN8NB ! Return
+REAL, DIMENSION(3), INTENT(IN) :: PPOS ! Position where we want to evaluate
+INTEGER, INTENT(IN) :: KI, KJ, KK ! Meso-NH cell index
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR ! Variable to interpolate
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PZH ! Vertical height to interpolate
+!
+INTEGER :: IIP, IJP, IKP ! Previous cell index : P = i + 1
+INTEGER :: IIN, IJN, IKN ! Next cell index : N = i - 1
+!
+REAL :: ZUXNN, ZUXNP, ZUXPP, ZUXPN ! Interpolated variables (VAR) in X plane (VAR = A*POS + B)
+!
+REAL :: ZHXNN, ZHXNP, ZHXPP, ZHXPN ! Interpotaled variables (VAR) in X plane (VAR = A*POS + B)
+!
+REAL :: ZUXN, ZUXP ! Interpolated variables (VAR) in Y plance (VAR = A*POS + B)
+!
+!
+REAL :: ZALPHAX, ZALPHAY, ZALPHAZ ! Interpolated variables (VAR) in Z plane (VAR = A*POS + B)
+
+REAL :: ZUX ! Interpolated variable (VAR) in Z plane (VAR = A*POS + B)
+!
+! -----------------------------------------------
+!
+! FINDING 8 NEIGHBOORS
+! -- X axis
+IF (PPOS(1) <= 0.5*(XXHAT(KI)+XXHAT(KI+1))) THEN
+ IIP = KI - 1
+ IIN = KI
+ELSE
+ IIP = KI
+ IIN = KI + 1
+END IF
+! -- Y axis
+IF (PPOS(2) <= 0.5*((XYHAT(KJ)+XYHAT(KJ+1)))) THEN
+ IJP = KJ - 1
+ IJN = KJ
+ELSE
+ IJP = KJ
+ IJN = KJ + 1
+END IF
+! -- Z axis
+IF (PPOS(3) <= PZH(KI,KJ,KK)) THEN
+ IKP = KK - 1
+ IKN = KK
+ELSE
+ IKP = KK
+ IKN = KK + 1
+END IF
+!
+! INTERPOLATION
+! -- Along X
+! -- -- Alpha
+ZALPHAX = (PPOS(1) - 0.5*(XXHAT(IIP)+XXHAT(IIN))) / (XXHAT(IIN) - XXHAT(IIP))
+!!PRINT*, "ZALPHAX = ", ZALPHAX
+! -- -- -- Wind
+! -- -- Interpolated variable in temporary plane X
+ZUXNN = (1-ZALPHAX)*PVAR(IIP,IJN,IKN) + ZALPHAX*PVAR(IIN,IJN,IKN)
+ZUXNP = (1-ZALPHAX)*PVAR(IIP,IJN,IKP) + ZALPHAX*PVAR(IIN,IJN,IKP)
+ZUXPP = (1-ZALPHAX)*PVAR(IIP,IJP,IKP) + ZALPHAX*PVAR(IIN,IJP,IKP)
+ZUXPN = (1-ZALPHAX)*PVAR(IIP,IJP,IKN) + ZALPHAX*PVAR(IIN,IJP,IKN)
+! -- -- -- Height
+ZHXNN = (1-ZALPHAX)*PZH(IIP,IJN,IKN) + ZALPHAX*PZH(IIN,IJN,IKN)
+ZHXNP = (1-ZALPHAX)*PZH(IIP,IJN,IKP) + ZALPHAX*PZH(IIN,IJN,IKP)
+ZHXPP = (1-ZALPHAX)*PZH(IIP,IJP,IKP) + ZALPHAX*PZH(IIN,IJP,IKP)
+ZHXPN = (1-ZALPHAX)*PZH(IIP,IJP,IKN) + ZALPHAX*PZH(IIN,IJP,IKN)
+!
+!
+! -- Along Y
+! -- -- Alpha
+ZALPHAY = (PPOS(2) - 0.5*(XYHAT(IJP)+XYHAT(IJN))) / (XYHAT(IJN) - XYHAT(IJP))
+!PRINT*, "ZALPHAY = ", ZALPHAY
+! -- -- Interpolated variable in temporary plane Y
+! -- -- -- Wind
+ZUXN = (1-ZALPHAY)*ZUXPN + ZALPHAY*ZUXNN
+ZUXP = (1-ZALPHAY)*ZUXPP + ZALPHAY*ZUXNP
+! -- -- -- Height
+ZHXN = (1-ZALPHAY)*ZHXPN + ZALPHAY*ZHXNN
+ZHXP = (1-ZALPHAY)*ZHXPP + ZALPHAY*ZHXNP
+!
+!
+! -- Along Z
+! -- -- Alpha Z
+ZALPHAZ = (PPOS(3) - ZHXP) / (ZHXN - ZHXP)
+!PRINT*, "ZALPHAZ = ", ZALPHAZ
+ZUX = (1 - ZALPHAZ)*ZUXP + ZALPHAZ*ZUXN
+!
+!
+INTERP_LIN8NB = ZUX
+!
+!
+!
+END FUNCTION INTERP_LIN8NB
+!#########################################################
diff --git a/src/MNH/eol_printer.f90 b/src/MNH/eol_printer.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b4fe7281673df7ba6b9000ed4353c7430db48423
--- /dev/null
+++ b/src/MNH/eol_printer.f90
@@ -0,0 +1,357 @@
+!MNH_LIC Copyright 2020-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #########################
+ MODULE MODI_EOL_PRINTER
+! #########################
+!
+INTERFACE
+!
+! ****
+! ADNR
+! ****
+!
+SUBROUTINE PRINT_DATA_FARM_ADNR(KFILE,TPFARM)
+ USE MODD_EOL_ADNR, ONLY: FARM
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(FARM), INTENT(IN) :: TPFARM ! stored farm data
+END SUBROUTINE PRINT_DATA_FARM_ADNR
+!
+SUBROUTINE PRINT_DATA_TURBINE_ADNR(KFILE,TPTURBINE)
+ USE MODD_EOL_ADNR, ONLY : TURBINE
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+END SUBROUTINE PRINT_DATA_TURBINE_ADNR
+!
+! ***
+! ALM
+! ***
+!
+SUBROUTINE PRINT_DATA_FARM_ALM(KFILE,TPFARM)
+ USE MODD_EOL_ALM, ONLY: FARM
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(FARM), INTENT(IN) :: TPFARM ! stored farm data
+END SUBROUTINE PRINT_DATA_FARM_ALM
+!
+SUBROUTINE PRINT_DATA_TURBINE_ALM(KFILE,TPTURBINE)
+ USE MODD_EOL_ALM, ONLY : TURBINE
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+END SUBROUTINE PRINT_DATA_TURBINE_ALM
+!
+SUBROUTINE PRINT_DATA_BLADE_ALM(KFILE,TPBLADE)
+ USE MODD_EOL_ALM, ONLY : BLADE
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(BLADE), INTENT(IN) :: TPBLADE ! stored blade data
+END SUBROUTINE PRINT_DATA_BLADE_ALM
+!
+SUBROUTINE PRINT_DATA_AIRFOIL_ALM(KFILE,TPAIRFOIL)
+ USE MODD_EOL_ALM, ONLY : AIRFOIL
+ INTEGER, INTENT(IN) :: KFILE ! output file
+ TYPE(AIRFOIL), DIMENSION(:), INTENT(IN) :: TPAIRFOIL ! stored airfoil data
+END SUBROUTINE PRINT_DATA_AIRFOIL_ALM
+!
+SUBROUTINE OPEN_TECOUT(KFILE, KTCOUNT, KTSUBCOUNT)
+ INTEGER, INTENT(IN) :: KFILE ! File index
+ INTEGER, INTENT(IN) :: KTCOUNT ! Time step index
+ INTEGER, INTENT(IN) :: KTSUBCOUNT ! Subtime step index
+END SUBROUTINE OPEN_TECOUT
+!
+SUBROUTINE PRINT_TECOUT(KFILE,PVAR)
+ INTEGER, INTENT(IN) :: KFILE ! File index
+ REAL, DIMENSION(3), INTENT(IN) :: PVAR ! Vector to plot
+END SUBROUTINE PRINT_TECOUT
+!
+SUBROUTINE PRINT_TSPLIT(KNBSUBCOUNT,PTSUBSTEP)
+ INTEGER, INTENT(IN) :: KNBSUBCOUNT ! splitting value
+ REAL, INTENT(IN) :: PTSUBSTEP ! sub timestep
+END SUBROUTINE PRINT_TSPLIT
+!
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_PRINTER
+!-------------------------------------------------------------------
+!
+!!**** *EOL_PRINT* -
+!!
+!! PURPOSE
+!! -------
+!! Some usefull subs to print wind turbine's datas
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/10/2020
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_FARM_ADNR(KFILE,TPFARM)
+!
+USE MODD_EOL_ADNR, ONLY : FARM
+USE MODD_EOL_SHARED_IO, ONLY : CFARM_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(FARM), INTENT(IN) :: TPFARM ! dummy stored farm data
+!
+INTEGER :: JROT ! Loop index
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '======================== WIND TURBINE DATA ========================'
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '---- Farm ----'
+ WRITE(KFILE,*) 'Data from file : ', TRIM(CFARM_CSVDATA)
+ WRITE(KFILE,*) 'Number of turbines : ', TPFARM%NNB_TURBINES
+ WRITE(KFILE,*) 'Positions [m] and thrust coef [-] : '
+ DO JROT=1, TPFARM%NNB_TURBINES
+ WRITE(KFILE,'(1X,A,I3,A,F10.1,A,F10.1,A,F10.3)') 'n.', JROT,&
+ ' : X = ', TPFARM%XPOS_X(JROT),&
+ ' ; Y = ', TPFARM%XPOS_Y(JROT),&
+ ' ; CT_inf = ', TPFARM%XCT_INF(JROT)
+ END DO
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_FARM_ADNR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_TURBINE_ADNR(KFILE,TPTURBINE)
+!
+USE MODD_EOL_ADNR, ONLY : TURBINE
+USE MODD_EOL_SHARED_IO, ONLY : CTURBINE_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! dummy stored turbine data
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) '---- Turbine ----'
+ WRITE(KFILE,* ) 'Data from file : ', TRIM(CTURBINE_CSVDATA)
+ WRITE(KFILE,'(1X,A,A10)' ) 'Wind turbine : ', TPTURBINE%CNAME
+ WRITE(KFILE,'(1X,A,F10.1)') 'Hub height [m] : ', TPTURBINE%XH_HEIGHT
+ WRITE(KFILE,'(1X,A,F10.3)') 'Blade radius [m] : ', TPTURBINE%XR_MAX
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '==================================================================='
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_TURBINE_ADNR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_FARM_ALM(KFILE,TPFARM)
+!
+USE MODD_EOL_ALM, ONLY : FARM
+USE MODD_EOL_SHARED_IO, ONLY : CFARM_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(FARM), INTENT(IN) :: TPFARM ! dummy stored farm data
+!
+INTEGER :: JROT ! Loop index
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '======================== WIND TURBINE DATA ========================'
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '---- Farm ----'
+ WRITE(KFILE,*) 'Data from file : ', TRIM(CFARM_CSVDATA)
+ WRITE(KFILE,*) 'Number of turbines : ', TPFARM%NNB_TURBINES
+ WRITE(KFILE,*) 'Tower base positions (X,Y) [m] : '
+ DO JROT=1, TPFARM%NNB_TURBINES
+ WRITE(KFILE, '(1X,A,I3,A,F10.1,A,F10.1,A)') 'n.', JROT,&
+ ': (', TPFARM%XPOS_X(JROT),',',TPFARM%XPOS_Y(JROT),')'
+ END DO
+ WRITE(KFILE,*) 'Working state (rad/s,rad,rad) : '
+ DO JROT=1, TPFARM%NNB_TURBINES
+ WRITE(KFILE, '(1X,A,I3,A,F10.5,A,F10.5,A,F10.5)') 'n.', JROT,&
+ ': Omega = ', TPFARM%XOMEGA(JROT), &
+ ' ; Yaw = ', TPFARM%XNAC_YAW(JROT),&
+ ' ; Pitch = ', TPFARM%XBLA_PITCH(JROT)
+ END DO
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_FARM_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_TURBINE_ALM(KFILE,TPTURBINE)
+!
+USE MODD_EOL_ALM, ONLY : TURBINE
+USE MODD_EOL_SHARED_IO, ONLY : CTURBINE_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! dummy stored turbine data
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) '---- Turbine ----'
+ WRITE(KFILE,* ) 'Data from file : ', TRIM(CTURBINE_CSVDATA)
+ WRITE(KFILE,'(1X,A,A10)' ) 'Wind turbine : ', TPTURBINE%CNAME
+ WRITE(KFILE,'(1X,A,I10)' ) 'Number of blades : ', TPTURBINE%NNB_BLADES
+ WRITE(KFILE,'(1X,A,F10.1)') 'Hub height [m] : ', TPTURBINE%XH_HEIGHT
+ WRITE(KFILE,'(1X,A,F10.3)') 'Blade min radius [m] : ', TPTURBINE%XR_MIN
+ WRITE(KFILE,'(1X,A,F10.3)') 'Blade max radius [m] : ', TPTURBINE%XR_MAX
+ WRITE(KFILE,'(1X,A,F10.3)') 'Nacelle tilt [rad] : ', TPTURBINE%XNAC_TILT
+ WRITE(KFILE,'(1X,A,F10.3)') 'Hub deport [m] : ', TPTURBINE%XH_DEPORT
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_TURBINE_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_BLADE_ALM(KFILE,TPBLADE)
+!
+USE MODD_EOL_ALM, ONLY : BLADE
+USE MODD_EOL_SHARED_IO, ONLY : CBLADE_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(BLADE), INTENT(IN) :: TPBLADE ! dummy stored blade data
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) '---- Blade ----'
+ WRITE(KFILE,* ) 'Data from file : ', TRIM(CBLADE_CSVDATA)
+ WRITE(KFILE,'(1X,A,I10)' ) 'Nb of data (from data file) : ', TPBLADE%NNB_BLADAT
+ WRITE(KFILE,'(1X,A,F10.1)') 'First node radius [m] : ', TPBLADE%XRAD(1)
+ WRITE(KFILE,'(1X,A,F10.1)') 'Last node radius [m] : ', TPBLADE%XRAD(TPBLADE%NNB_BLADAT)
+ WRITE(KFILE,'(1X,A,F10.1)') 'Chord max. [m] : ', MAXVAL(TPBLADE%XCHORD(:))
+ WRITE(KFILE,'(1X,A,I10)' ) 'Nb of blade element (from nam) : ', TPBLADE%NNB_BLAELT
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_BLADE_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_DATA_AIRFOIL_ALM(KFILE,TPAIRFOIL)
+!
+USE MODD_EOL_ALM, ONLY : AIRFOIL
+USE MODD_EOL_SHARED_IO, ONLY : CAIRFOIL_CSVDATA
+USE MODD_VAR_ll, ONLY : IP ! only master cpu
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KFILE ! File index
+TYPE(AIRFOIL), DIMENSION(:), INTENT(IN) :: TPAIRFOIL ! dummy stored airfoil data
+!
+INTEGER :: JA
+!
+IF (IP==1) THEN
+ WRITE(KFILE,*) '---- Airfoils ----'
+ WRITE(KFILE,* ) 'Data from file : ', TRIM(CAIRFOIL_CSVDATA)
+ WRITE(KFILE,'(1X,A,I10)' ) 'Nb of airfoils (from data file) : ', SIZE(TPAIRFOIL)
+ WRITE(KFILE,'(1X,A)' ) 'Different airfoils : '
+ DO JA=1,SIZE(TPAIRFOIL)
+ WRITE(KFILE,'(1X,A,I3,A,A)') 'Airfoil n.', JA,&
+ ': ', TPAIRFOIL(JA)%CNAME
+ END DO
+ WRITE(KFILE,*) ''
+ WRITE(KFILE,*) '==================================================================='
+ WRITE(KFILE,*) ''
+END IF
+!
+END SUBROUTINE PRINT_DATA_AIRFOIL_ALM
+!#########################################################
+!
+!
+!#########################################################
+SUBROUTINE OPEN_TECOUT(KFILE, KTCOUNT, KTSUBCOUNT)
+!
+USE MODD_EOL_ALM, ONLY:TFARM,TTURBINE,TBLADE
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(OUT) :: KFILE ! File index
+INTEGER, INTENT(IN) :: KTCOUNT ! Time step index
+INTEGER, INTENT(IN) :: KTSUBCOUNT ! Subtime step index
+!
+INTEGER :: INB_WT, INB_B, INB_BELT ! Total numbers of wind turbines, blades, and blade elt
+INTEGER :: INB_TELT, INB_NELT ! Total numbers of tower elt, and nacelle elt
+INTEGER :: ITOTELT ! Total number of points
+!
+CHARACTER(LEN=1024) :: HFILE ! File name
+!
+INB_WT = TFARM%NNB_TURBINES
+INB_B = TTURBINE%NNB_BLADES
+INB_BELT = TBLADE%NNB_BLAELT
+! Hard coded variables, but they will be useful in next updates
+INB_TELT = 2
+INB_NELT = 2
+!
+ITOTELT = INB_WT*(INB_TELT+INB_NELT+INB_B*(1+INB_BELT*3))
+!
+! File name and opening
+WRITE(HFILE, "(A18,I4.4,I2.2,A3)") "Tecplot2.0_Output_", KTCOUNT, KTSUBCOUNT,".tp"
+OPEN( NEWUNIT=KFILE, file=HFILE, form="FORMATTED")
+!
+! Tecplot Header
+WRITE(KFILE,*) 'TITLE="Wind Turbines Points"'
+WRITE(KFILE,*) 'VARIABLES="X" "Y" "Z"'
+WRITE(KFILE,*) 'ZONE I=',ITOTELT,' J=3 K=1 DATAPACKING=POINT'
+!
+END SUBROUTINE OPEN_TECOUT
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_TECOUT(KFILE,PVAR)
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KFILE ! File index
+REAL, DIMENSION(3), INTENT(IN) :: PVAR ! Vector to plot
+!
+! It plots two points, slightly different, to get a thickness
+!
+WRITE(KFILE,*) PVAR(1), &
+ PVAR(2), &
+ PVAR(3)
+!
+END SUBROUTINE PRINT_TECOUT
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_TSPLIT(KNBSUBCOUNT,PTSUBSTEP)
+USE MODD_LUNIT_n , ONLY: TLUOUT
+!
+INTEGER, INTENT(IN) :: KNBSUBCOUNT ! splitting value
+REAL, INTENT(IN) :: PTSUBSTEP ! sub-time step
+!
+WRITE(TLUOUT%NLU,'(A)') 'From EOL - Actuator Line Model. Time-splitting is activated:'
+WRITE(TLUOUT%NLU,'(1X,A,I2)') 'Number of splitting: ', KNBSUBCOUNT
+WRITE(TLUOUT%NLU,'(1X,A,F6.4)') 'Sub-time step value: ', PTSUBSTEP
+!
+END SUBROUTINE PRINT_TSPLIT
+!#########################################################
+!
+!#########################################################
+SUBROUTINE PRINT_ERROR_WTCFL(KFILE,PMAXTSTEP)
+INTEGER, INTENT(IN) :: KFILE ! output file
+REAL, INTENT(IN) :: PMAXTSTEP ! maximum acceptable time-step
+WRITE(KFILE,'(A,A,A,A,A,F10.8,A)') &
+ 'Sorry but I had to stop the simulation. ' ,&
+ 'The time step XTSTEP is too high: ' ,&
+ 'the blades can jump over one or several cells. ' ,&
+ 'Please, turn on the time-splitting method (LTIMESPLIT=.TRUE.), ',&
+ 'or decrease XTSTEP to a value lower than ', PMAXTSTEP, ' sec.'
+END SUBROUTINE PRINT_ERROR_WTCFL
+!
diff --git a/src/MNH/eol_reader.f90 b/src/MNH/eol_reader.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8d5ecc6cfea05ea462138d0f8472d23083e0d7ce
--- /dev/null
+++ b/src/MNH/eol_reader.f90
@@ -0,0 +1,670 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_READER
+! #######################
+!
+INTERFACE
+!
+! ADNR
+!
+SUBROUTINE READ_CSVDATA_FARM_ADNR(HFILE,TPFARM)
+ USE MODD_EOL_ADNR, ONLY: FARM
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(FARM), INTENT(OUT) :: TPFARM ! stored farm data
+END SUBROUTINE READ_CSVDATA_FARM_ADNR
+!
+SUBROUTINE READ_CSVDATA_TURBINE_ADNR(HFILE,TPTURBINE)
+ USE MODD_EOL_ADNR, ONLY : TURBINE
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(TURBINE), INTENT(OUT) :: TPTURBINE ! stored turbine data
+END SUBROUTINE READ_CSVDATA_TURBINE_ADNR
+!
+! ALM
+!
+SUBROUTINE READ_CSVDATA_FARM_ALM(HFILE,TPFARM)
+ USE MODD_EOL_ALM, ONLY: FARM
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(FARM), INTENT(OUT) :: TPFARM ! stored farm data
+END SUBROUTINE READ_CSVDATA_FARM_ALM
+!
+SUBROUTINE READ_CSVDATA_TURBINE_ALM(HFILE,TPTURBINE)
+ USE MODD_EOL_ALM, ONLY : TURBINE
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(TURBINE), INTENT(OUT) :: TPTURBINE ! stored turbine data
+END SUBROUTINE READ_CSVDATA_TURBINE_ALM
+
+SUBROUTINE READ_CSVDATA_BLADE_ALM(HFILE,TPTURBINE,TPBLADE)
+ USE MODD_EOL_ALM, ONLY : TURBINE, BLADE
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+ TYPE(BLADE), INTENT(OUT) :: TPBLADE ! stored blade data
+END SUBROUTINE READ_CSVDATA_BLADE_ALM
+!
+SUBROUTINE READ_CSVDATA_AIRFOIL_ALM(HFILE,TPBLADE,TPAIRFOIL)
+ USE MODD_EOL_ALM, ONLY : BLADE, AIRFOIL
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(BLADE), INTENT(IN) :: TPBLADE ! stored blade data (to select airfoils)
+ TYPE(AIRFOIL), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: TPAIRFOIL ! stored airfoil data
+END SUBROUTINE READ_CSVDATA_AIRFOIL_ALM
+!
+SUBROUTINE HOW_MANY_LINES_OF(KLUNAM,HFILE,HNAME,KLINE)
+ INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! turbine's name
+ INTEGER, INTENT(OUT) :: KLINE
+END SUBROUTINE HOW_MANY_LINES_OF
+!
+FUNCTION GET_AIRFOIL_ID(TPTURBINE,TPBLADE,TPAIRFOIL,PRADIUS)
+ USE MODD_EOL_ALM, ONLY : TURBINE, BLADE, AIRFOIL
+ IMPLICIT NONE
+ INTEGER :: GET_AIRFOIL_ID
+ TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+ TYPE(BLADE), INTENT(IN) :: TPBLADE ! stored blade data
+ TYPE(AIRFOIL), DIMENSION(:), INTENT(IN) :: TPAIRFOIL ! stored airfoil data
+ REAL, INTENT(IN) :: PRADIUS ! Radius position studied
+END FUNCTION GET_AIRFOIL_ID
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_READER
+!-------------------------------------------------------------------
+!
+!!**** *EOL_READER* -
+!!
+!! PURPOSE
+!! -------
+!! Some usefull subs to read wind turbine's datas
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 05/2018
+!! Modification 21/10/20 (PA. Joulin) Updated for a main version
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_FARM_ADNR(HFILE,TPFARM)
+!
+USE MODD_EOL_ADNR, ONLY: FARM
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(FARM), INTENT(OUT) :: TPFARM ! dummy stored data blade
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBLINE ! Nb of line in csv file
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+! Read data
+REAL :: ZPOS_X
+REAL :: ZPOS_Y
+REAL :: ZCT_INF
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Opening the file
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+! Counting number of line
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+IF (INBLINE < 2) THEN
+ CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
+ELSE
+ ! Saving number of wind turbine
+ TPFARM%NNB_TURBINES = INBLINE - 1
+ ! Allocations
+ ALLOCATE(TPFARM%XPOS_X(TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XPOS_Y(TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XCT_INF(TPFARM%NNB_TURBINES))
+ !
+ ! New read
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
+ !
+ ! Saving data
+ DO INBLINE=1, TPFARM%NNB_TURBINES
+ READ(ILU,FMT='(A400)') YSTRING
+ READ(YSTRING,*) ZPOS_X, ZPOS_Y, ZCT_INF
+ TPFARM%XPOS_X(INBLINE) = ZPOS_X
+ TPFARM%XPOS_Y(INBLINE) = ZPOS_Y
+ TPFARM%XCT_INF(INBLINE) = ZCT_INF
+ END DO
+ CLOSE(ILU)
+ RETURN
+END IF
+!
+END SUBROUTINE READ_CSVDATA_FARM_ADNR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_TURBINE_ADNR(HFILE,TPTURBINE)
+!
+USE MODD_EOL_ADNR, ONLY: TURBINE
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(TURBINE), INTENT(OUT) :: TPTURBINE ! dummy stored data turbine
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBLINE ! Nb of line in csv file
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+CHARACTER(LEN=80) :: YWT_NAME
+REAL :: ZH_HEIGHT
+REAL :: ZR_MAX
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Opening
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+!
+! Counting number of line
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+IF (INBLINE /= 2) THEN
+ CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
+ELSE
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
+ READ(ILU,FMT='(A400)') YSTRING ! Reading next line
+ ! Read data
+ READ(YSTRING,*) YWT_NAME, ZH_HEIGHT, ZR_MAX ! reading data
+ TPTURBINE%CNAME = YWT_NAME ! Saving them
+ TPTURBINE%XH_HEIGHT = ZH_HEIGHT
+ TPTURBINE%XR_MAX = ZR_MAX
+ REWIND(ILU) ! Rembobinage, plutôt 2 fois qu'1 !
+ RETURN
+ CLOSE(ILU)
+END IF
+!
+END SUBROUTINE READ_CSVDATA_TURBINE_ADNR
+!#########################################################
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_FARM_ALM(HFILE,TPFARM)
+!
+USE MODD_EOL_ALM, ONLY: FARM
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(FARM), INTENT(OUT) :: TPFARM ! dummy stored data blade
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBLINE ! Nb of line in csv file
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+! Read data
+REAL :: ZPOS_X
+REAL :: ZPOS_Y
+REAL :: ZOMEGA
+REAL :: ZYAW
+REAL :: ZPITCH
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Opening the file
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+! Counting number of line
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+IF (INBLINE < 2) THEN
+ CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
+ELSE
+ ! Saving number of wind turbine
+ TPFARM%NNB_TURBINES = INBLINE - 1
+ ! Allocations
+ ALLOCATE(TPFARM%XPOS_X (TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XPOS_Y (TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XOMEGA (TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XNAC_YAW (TPFARM%NNB_TURBINES))
+ ALLOCATE(TPFARM%XBLA_PITCH(TPFARM%NNB_TURBINES))
+ !
+ ! New read
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
+ !
+ ! Saving data
+ DO INBLINE=1, TPFARM%NNB_TURBINES
+ READ(ILU,FMT='(A400)') YSTRING
+ READ(YSTRING,*) ZPOS_X, ZPOS_Y, ZOMEGA, ZYAW, ZPITCH
+ TPFARM%XPOS_X(INBLINE) = ZPOS_X
+ TPFARM%XPOS_Y(INBLINE) = ZPOS_Y
+ TPFARM%XOMEGA(INBLINE) = ZOMEGA
+ TPFARM%XNAC_YAW(INBLINE) = ZYAW
+ TPFARM%XBLA_PITCH(INBLINE) = ZPITCH
+ END DO
+ CLOSE(ILU)
+ RETURN
+END IF
+!
+END SUBROUTINE READ_CSVDATA_FARM_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_TURBINE_ALM(HFILE,TPTURBINE)
+!
+USE MODD_EOL_ALM, ONLY: TURBINE
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+!
+IMPLICIT NONE
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(TURBINE), INTENT(OUT) :: TPTURBINE ! dummy stored data turbine
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBLINE ! Nb of line in csv file
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+CHARACTER(LEN=80) :: YWT_NAME
+INTEGER :: INB_BLADE
+REAL :: ZH_HEIGHT
+REAL :: ZR_MIN
+REAL :: ZR_MAX
+REAL :: ZNAC_TILT
+REAL :: ZHUB_DEPORT
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Opening
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+!
+! Counting number of line
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+IF (INBLINE /= 2) THEN
+ CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
+ELSE
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
+ READ(ILU,FMT='(A400)') YSTRING ! Reading next line
+ ! Read data
+ READ(YSTRING,*) YWT_NAME, INB_BLADE, ZH_HEIGHT,& ! reading data
+ ZR_MIN, ZR_MAX, ZNAC_TILT, &
+ ZHUB_DEPORT
+ TPTURBINE%CNAME = YWT_NAME ! Saving them
+ TPTURBINE%NNB_BLADES = INB_BLADE
+ TPTURBINE%XH_HEIGHT = ZH_HEIGHT
+ TPTURBINE%XR_MIN = ZR_MIN
+ TPTURBINE%XR_MAX = ZR_MAX
+ TPTURBINE%XNAC_TILT = ZNAC_TILT
+ TPTURBINE%XH_DEPORT = ZHUB_DEPORT
+ REWIND(ILU)
+ RETURN
+ CLOSE(ILU)
+END IF
+!
+END SUBROUTINE READ_CSVDATA_TURBINE_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_BLADE_ALM(HFILE,TPTURBINE,TPBLADE)
+!
+USE MODD_EOL_ALM, ONLY: TURBINE, BLADE, NNB_BLAELT
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+USE MODI_EOL_ERROR, ONLY: EOL_BLADEDATA_ERROR
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+TYPE(BLADE), INTENT(OUT) :: TPBLADE ! dummy stored data blade
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBLINE ! Nb of line in csv file
+INTEGER :: INBDATA ! Nb of data (line/section) of blade
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+REAL :: ZCENTER ! Center pos. of elmt [m]
+REAL :: ZCHORD ! Blade chord of elmt [m]
+REAL :: ZTWIST ! Twist of elmt [rad]
+CHARACTER(LEN=20) :: YAIRFOIL ! Airfoil name [-]
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Ouverture
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+! Counting number of line
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+IF (INBLINE < 2) THEN
+ CALL EOL_CSVEMPTY_ERROR(HFILE,INBLINE)
+ELSE
+ TPBLADE%NNB_BLAELT = NNB_BLAELT
+ ! Saving number of data
+ TPBLADE%NNB_BLADAT = INBLINE - 1
+ ALLOCATE(TPBLADE%XRAD(TPBLADE%NNB_BLADAT))
+ ALLOCATE(TPBLADE%XCHORD(TPBLADE%NNB_BLADAT))
+ ALLOCATE(TPBLADE%XTWIST(TPBLADE%NNB_BLADAT))
+ ALLOCATE(TPBLADE%CAIRFOIL(TPBLADE%NNB_BLADAT))
+ !
+ ! New read
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Header reading
+ !
+ ! Saving data
+ DO INBLINE=1, TPBLADE%NNB_BLADAT
+ READ(ILU,FMT='(A400)') YSTRING
+ READ(YSTRING,*) ZCENTER, ZCHORD, ZTWIST, YAIRFOIL ! Reading data
+ IF ((ZCENTER<=0.0) .OR. (ZCENTER>= 1.0)) THEN
+ ! Checking data
+ CALL EOL_BLADEDATA_ERROR(ZCENTER)
+ ELSE
+ ! Storing them
+ TPBLADE%XRAD(INBLINE) = ZCENTER*(TPTURBINE%XR_MAX-TPTURBINE%XR_MIN) & ! Data in %
+ + TPTURBINE%XR_MIN
+ TPBLADE%XCHORD(INBLINE) = ZCHORD
+ TPBLADE%XTWIST(INBLINE) = ZTWIST
+ TPBLADE%CAIRFOIL(INBLINE) = YAIRFOIL
+ END IF
+ END DO
+ CLOSE(ILU)
+ RETURN
+END IF
+!
+END SUBROUTINE READ_CSVDATA_BLADE_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE READ_CSVDATA_AIRFOIL_ALM(HFILE,TPBLADE,TPAIRFOIL)
+!
+USE MODD_EOL_ALM, ONLY: BLADE, AIRFOIL
+USE MODI_EOL_ERROR, ONLY: EOL_CSVNOTFOUND_ERROR, EOL_CSVEMPTY_ERROR
+USE MODI_EOL_ERROR, ONLY: EOL_AIRFOILNOTFOUND_ERROR
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(BLADE), INTENT(IN) :: TPBLADE ! stored blade data (to select airfoils)
+TYPE(AIRFOIL), DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: TPAIRFOIL ! dummy stored data blade
+!
+LOGICAL :: GEXIST ! Existence of file
+!
+INTEGER :: ILU ! logical unit of the file
+INTEGER :: INBDATA ! Nb of data (line/section) per airfoil
+INTEGER :: INBLINE ! Nb of line in csv file
+LOGICAL :: GAIRFLAG ! Flag for airfoil counting
+!
+INTEGER :: JI, JJ, IA ! loop control
+INTEGER :: INBAIRFOIL ! Nb of differents airfoils on one blade
+!
+CHARACTER(LEN=400) :: YSTRING
+!
+CHARACTER(LEN=15), DIMENSION(:), ALLOCATABLE :: YAIRFOIL
+!
+CHARACTER(LEN=15) :: YREAD_NAME
+REAL :: ZAA ! Attack Angle [rad]
+REAL :: ZRE ! Reynolds Number [-]
+REAL :: ZCL ! Lift Coef [-]
+REAL :: ZCD ! Drag Coef [-]
+REAL :: ZCM ! Moment Coef [-]
+!
+! Checking file existence
+INQUIRE(FILE=HFILE, EXIST=GEXIST)
+IF (.NOT.GEXIST) THEN
+ CALL EOL_CSVNOTFOUND_ERROR(HFILE)
+END IF
+!
+! Ouverture
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted', STATUS='OLD')
+!
+! 1. Counting number of differents airfoils along the blade and selection :
+!
+! Allcation of local airfoil array
+ALLOCATE(YAIRFOIL(SIZE(TPBLADE%CAIRFOIL)))
+!
+YAIRFOIL(:) = ''
+INBAIRFOIL = 1
+YAIRFOIL(1) = TRIM(TPBLADE%CAIRFOIL(1))
+!
+DO JI=1, SIZE(TPBLADE%CAIRFOIL)
+ GAIRFLAG = .FALSE.
+ DO JJ=1, INBAIRFOIL
+ IF (TRIM(TPBLADE%CAIRFOIL(JI)) == TRIM(YAIRFOIL(JJ))) THEN
+ GAIRFLAG = .TRUE.
+ END IF
+ END DO
+ IF (GAIRFLAG .EQV. .FALSE.) THEN
+ INBAIRFOIL = INBAIRFOIL + 1
+ YAIRFOIL(INBAIRFOIL) = TRIM(TPBLADE%CAIRFOIL(JI))
+ END IF
+END DO
+ALLOCATE(TPAIRFOIL(INBAIRFOIL))
+!
+! 2. Reading and storing data :
+!
+DO IA = 1, INBAIRFOIL
+ ! Array allocation
+ CALL HOW_MANY_LINES_OF(ILU,HFILE,YAIRFOIL(IA),INBDATA)
+ ALLOCATE(TPAIRFOIL(IA)%XAA(INBDATA))
+ ALLOCATE(TPAIRFOIL(IA)%XRE(INBDATA))
+ ALLOCATE(TPAIRFOIL(IA)%XCL(INBDATA))
+ ALLOCATE(TPAIRFOIL(IA)%XCD(INBDATA))
+ ALLOCATE(TPAIRFOIL(IA)%XCM(INBDATA))
+ !
+ REWIND(ILU)
+ INBLINE = 0
+ DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING ! Header
+ !* reads the string
+ IF (LEN_TRIM(YSTRING)>0) THEN
+ READ(YSTRING,FMT=*) YREAD_NAME
+ IF (TRIM(YREAD_NAME)==TRIM(YAIRFOIL(IA))) THEN ! Read data
+ INBLINE = INBLINE + 1
+ READ(YSTRING,*) YREAD_NAME, ZAA, ZRE, &
+ ZCL, ZCD, ZCM
+ ! Storing data
+ TPAIRFOIL(IA)%CNAME = YREAD_NAME
+ TPAIRFOIL(IA)%XAA(INBLINE) = ZAA
+ TPAIRFOIL(IA)%XRE(INBLINE) = ZRE
+ TPAIRFOIL(IA)%XCL(INBLINE) = ZCL
+ TPAIRFOIL(IA)%XCD(INBLINE) = ZCD
+ TPAIRFOIL(IA)%XCM(INBLINE) = ZCM
+ ELSE ! The name doesnt appear during a new read..
+ IF (INBLINE > 0) THEN ! .. but it has already been found, ..
+ REWIND(ILU) ! .. so it is the end of the data ..
+ EXIT ! .. and we can exit :)
+ END IF
+ END IF
+ END IF
+ END DO
+END DO
+!
+CLOSE(ILU)
+101 CONTINUE
+ IF (INBLINE == 0) THEN
+ CALL EOL_AIRFOILNOTFOUND_ERROR(HFILE,YAIRFOIL(IA))
+ END IF
+END SUBROUTINE READ_CSVDATA_AIRFOIL_ALM
+!#########################################################
+!
+!#########################################################
+SUBROUTINE HOW_MANY_LINES_OF(KLUNAM,HFILE,HNAME,KLINE)
+!
+USE MODI_EOL_ERROR, ONLY: EOL_AIRFOILNOTFOUND_ERROR
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KLUNAM ! logical unit of the file
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+CHARACTER(LEN=*), INTENT(IN) :: HNAME ! turbine's name
+INTEGER, INTENT(OUT) :: KLINE
+!
+!
+CHARACTER(LEN=400) :: YSTRING
+CHARACTER(LEN=80) :: HREAD_NAME
+!
+REWIND(KLUNAM)
+KLINE=0
+DO
+ READ(KLUNAM,END=101,FMT='(A400)') YSTRING
+!* reads the string
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ READ(YSTRING,FMT=*) HREAD_NAME
+ IF (TRIM(HREAD_NAME)==TRIM(HNAME)) THEN
+ KLINE = KLINE + 1
+ ELSE ! The name doesnt appear during a new read..
+ IF (KLINE > 0) THEN ! .. but it has already been found, ..
+ REWIND(KLUNAM) ! .. so it is the end of the data ..
+ RETURN ! .. and we can return :)
+ END IF
+ END IF
+ END IF
+END DO
+101 CONTINUE
+ IF (KLINE == 0) THEN
+ CALL EOL_AIRFOILNOTFOUND_ERROR(HFILE,HNAME)
+ END IF
+END SUBROUTINE HOW_MANY_LINES_OF
+!#########################################################
+!
+!#########################################################
+FUNCTION GET_AIRFOIL_ID(TPTURBINE,TPBLADE,TPAIRFOIL,PRADIUS)
+! Allows to link an airfoil from a TPBLADE, at a specific radius (PRADIUS)
+! to the airfoils characteristics (TPAIRFOIL).
+! The result is an integer (IAID) that should be used like that :
+! IAID = GET_GET_AIRFOIL_ID(TPTURBINE,TPBLADE,TPAIRFOIL,PRADIUS)
+! TPAIRFOIL(IAID)%MEMBER_OF_TPAIRFOIL
+!
+USE MODD_EOL_ALM, ONLY : TURBINE, BLADE, AIRFOIL
+!
+USE MODE_MSG
+!
+IMPLICIT NONE
+!
+TYPE(TURBINE), INTENT(IN) :: TPTURBINE ! stored turbine data
+TYPE(BLADE), INTENT(IN) :: TPBLADE ! stored blade data
+TYPE(AIRFOIL), DIMENSION(:), INTENT(IN) :: TPAIRFOIL ! stored arifoil data
+REAL, INTENT(IN) :: PRADIUS ! Radius position studied
+INTEGER :: GET_AIRFOIL_ID
+!
+CHARACTER(LEN=:), ALLOCATABLE :: YMSG
+CHARACTER(LEN=10) :: YRADIUS, YRMIN, YRMAX
+INTEGER :: INB_BDATA ! Total number of blade data
+INTEGER :: JBDATA ! Index over blade's data
+INTEGER :: JA ! Index over diffetents airfoils
+REAL, DIMENSION(SIZE(TPBLADE%XRAD)) :: ZDELTARAD ! 2*ZDELTARAD = section lenght
+!
+! Checking data
+IF ((PRADIUS < TPTURBINE%XR_MIN) .OR. (PRADIUS > TPTURBINE%XR_MAX)) THEN
+ WRITE( YRADIUS, '( F10.2 )' ) PRADIUS
+ WRITE( YRMIN, '( F10.2 )' ) TPTURBINE%XR_MIN
+ WRITE( YRMAX, '( F10.2 )' ) TPTURBINE%XR_MAX
+ YMSG = 'The studied radius R=' // TRIM( YRADIUS ) // ' is out of blade range : [' // TRIM( YRMIN ) // ';' // TRIM( YRMAX ) // ']'
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'GET_AIRFOIL_ID', YMSG )
+END IF
+!
+! Preliminaires
+INB_BDATA = SIZE(TPBLADE%XRAD)
+!
+! Computes half length of sections
+ZDELTARAD(1) = TPBLADE%XRAD(1) - TPTURBINE%XR_MIN
+DO JBDATA=2,INB_BDATA-1
+ ZDELTARAD(JBDATA) = TPBLADE%XRAD(JBDATA) &
+ - TPBLADE%XRAD(JBDATA-1) &
+ - ZDELTARAD(JBDATA-1)
+END DO
+ZDELTARAD(INB_BDATA) = TPTURBINE%XR_MAX - TPBLADE%XRAD(INB_BDATA)
+!
+! Looking for the section at r=PRADIUS
+DO JBDATA=1,INB_BDATA
+ IF ((PRADIUS >= TPBLADE%XRAD(JBDATA)-ZDELTARAD(JBDATA)) .AND. &
+ (PRADIUS < TPBLADE%XRAD(JBDATA)+ZDELTARAD(JBDATA))) THEN
+! Looking for the ID of the airfoil of this section
+ DO JA=1,SIZE(TPAIRFOIL)
+ IF (TRIM(TPBLADE%CAIRFOIL(JBDATA)) == TRIM(TPAIRFOIL(JA)%CNAME)) THEN
+ GET_AIRFOIL_ID = JA
+ EXIT
+ END IF
+ END DO
+!
+ EXIT
+ END IF
+END DO
+!
+END FUNCTION GET_AIRFOIL_ID
+!#########################################################
diff --git a/src/MNH/eol_smear.f90 b/src/MNH/eol_smear.f90
new file mode 100644
index 0000000000000000000000000000000000000000..95f12caecbf6b51173890922a0ed08f0f1db25a9
--- /dev/null
+++ b/src/MNH/eol_smear.f90
@@ -0,0 +1,121 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_EOL_SMEAR
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE SMEAR_1LIN(PFX, PFX_SMR)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFX ! Force to smear
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX_SMR ! Smeared force
+END SUBROUTINE SMEAR_1LIN
+!
+SUBROUTINE SMEAR_3LIN(PFX, PFY, PFZ, PFX_SMR, PFY_SMR, PFZ_SMR)
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFX, PFY, PFZ ! Force to smear
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX_SMR, PFY_SMR, PFZ_SMR ! Smeared force
+END SUBROUTINE SMEAR_3LIN
+!
+END INTERFACE
+!
+END MODULE MODI_EOL_SMEAR
+!-------------------------------------------------------------------
+!
+!!**** *MODI_EOL_SMEAR* -
+!!
+!! PURPOSE
+!! -------
+!! Smear the forces of wind turbine to avoid numerical instabilities
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/2018
+!! Modification 21/10/20 (PA. Joulin) Updated for a main version
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE SMEAR_1LIN(PFX, PFX_SMR)
+!!
+!! METHOD
+!! ------
+!! A linear smearing is done is this subroutine.
+!!
+!---------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+ USE MODI_SHUMAN, ONLY: MXF, MXM
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFX ! Force to smear
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX_SMR ! Smeared force
+!
+!* 1. SMEARING
+!
+ PFX_SMR(:,:,:) = MXF(MXM(PFX(:,:,:)))
+!
+END SUBROUTINE SMEAR_1LIN
+!#########################################################
+!
+!#########################################################
+SUBROUTINE SMEAR_3LIN(PFX, PFY, PFZ, PFX_SMR, PFY_SMR, PFZ_SMR)
+!!
+!! METHOD
+!! ------
+!! A linear smearing is done is this subroutine.
+!!
+!---------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_PARAMETERS, ONLY: JPVEXT
+USE MODI_SHUMAN, ONLY: MXF, MYF, MZF
+USE MODI_SHUMAN, ONLY: MXM, MYM, MZM
+!
+!* 0.1 declarations of arguments
+!
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PFX, PFY, PFZ ! Force to smear
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PFX_SMR, PFY_SMR, PFZ_SMR ! Smeared force
+!
+!* 0.2 declarations of local variables
+!
+ INTEGER :: IKU,IKB,IKE ! Vertical indices
+!
+!* 1. INITIALIZATIONS
+!
+ IKU = SIZE(PFX,3) ! Top of the domain end index
+ IKB=1+JPVEXT ! Vertical begin index
+ IKE=IKU-JPVEXT ! Vertical end index
+!
+!* 2. SMEARING
+!
+ PFX_SMR(:,:,:) = MXF(MXM(MYF(MYM(PFX(:,:,:)))))
+ PFY_SMR(:,:,:) = MXF(MXM(MYF(MYM(PFY(:,:,:)))))
+ PFZ_SMR(:,:,:) = MXF(MXM(MYF(MYM(PFZ(:,:,:)))))
+!
+ PFX_SMR(:,:,:) = MZF(MZM(PFX_SMR(:,:,:)))
+ PFY_SMR(:,:,:) = MZF(MZM(PFY_SMR(:,:,:)))
+ PFZ_SMR(:,:,:) = MZF(MZM(PFZ_SMR(:,:,:)))
+!
+!* 3. BOUNDARY VALUES
+!
+ PFX_SMR(:,:,IKB-1) = PFX_SMR(:,:,IKB)
+ PFX_SMR(:,:,IKE+1) = PFX_SMR(:,:,IKE)
+!
+ PFY_SMR(:,:,IKB-1) = PFY_SMR(:,:,IKB)
+ PFY_SMR(:,:,IKE+1) = PFY_SMR(:,:,IKE)
+!
+ PFZ_SMR(:,:,IKB-1) = PFZ_SMR(:,:,IKB)
+ PFZ_SMR(:,:,IKE+1) = PFZ_SMR(:,:,IKE)
+!
+END SUBROUTINE SMEAR_3LIN
+!#########################################################
diff --git a/src/MNH/etheta.f90 b/src/MNH/etheta.f90
index 53c6580c5b7846c86f19489d8066854e3efacb8c..34fd3015eb65017b47f80b0e090d9821ae90b18b 100644
--- a/src/MNH/etheta.f90
+++ b/src/MNH/etheta.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -95,14 +95,16 @@ SUBROUTINE ETHETA(KRR,KRRI,PTHLM,PRM,PLOCPEXNM,PATHETA,PSRCM,PETHETA)
!! J.-P. Pinty May 20, 2003 Improve ETHETA expression
!! M.Moge April, 2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!!
+!! J.L Redelsperger 03, 2021 Ocean Model Case
!! ----------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODD_CST
+USE MODD_DYN_n, ONLY : LOCEAN
use mode_mppdb
-
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments and result
@@ -159,12 +161,15 @@ allocate( zrw ( size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
!
!
!$acc kernels
-IF ( KRR == 0 ) THEN ! dry case
+IF (LOCEAN) THEN ! ocean case
+ PETHETA(:,:,:) = 1.
+ELSE
+ IF ( KRR == 0.) THEN ! dry case
PETHETA(:,:,:) = 1.
-ELSE IF ( KRR == 1 ) THEN ! only vapor
+ ELSE IF ( KRR == 1 ) THEN ! only vapor
ZDELTA = (XRV/XRD) - 1.
PETHETA(:,:,:) = 1. + ZDELTA*PRM(:,:,:,1)
-ELSE ! liquid water & ice present
+ ELSE ! liquid water & ice present
ZDELTA = (XRV/XRD) - 1.
ZRW(:,:,:) = PRM(:,:,:,1)
!
@@ -207,6 +212,7 @@ ELSE ! liquid water & ice present
/ (1. + ZRW(:,:,:)) &
) * PATHETA(:,:,:) * 2. * PSRCM(:,:,:)
END IF
+ END IF
END IF
!$acc end kernels
diff --git a/src/MNH/exchange.f90 b/src/MNH/exchange.f90
index 2f606e359c72593604d6fca4d0a4af618391341d..c175d25f3466bb3811307c8d197793e018962f52 100644
--- a/src/MNH/exchange.f90
+++ b/src/MNH/exchange.f90
@@ -86,8 +86,8 @@ END MODULE MODI_EXCHANGE
!! corrections for aq. phase and ice phase (lost mass neglig.)
!! 25/08/16 (M.Leriche) remove negative values for aerosols and conserve
!! total mass for chemical species in aerosols
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -96,20 +96,22 @@ END MODULE MODI_EXCHANGE
! USE MODE_ll
!
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_GRID_n
-USE MODD_NSV
-USE MODD_BUDGET, ONLY : LBUDGET_SV
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
+USE MODD_CH_AEROSOL, ONLY : LORILAM, NM6_AER
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHAQ, LUSECHIC
USE MODD_CST, ONLY : XMNH_TINY
+USE MODD_GRID_n
USE MODD_LUNIT_n, ONLY : TLUOUT
-USE MODI_SHUMAN
+USE MODD_NSV
+
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_exchange_ll, only: UPDATE_HALO_ll
USE MODE_SUM_ll
-USE MODI_BUDGET
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHAQ, LUSECHIC
-USE MODD_CH_AEROSOL, ONLY : LORILAM, NM6_AER
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-!
+
+USE MODI_SHUMAN
+
IMPLICIT NONE
!
!* 0.1 DECLARATIONS OF ARGUMENTS
@@ -160,6 +162,12 @@ IF (SIZE(PRTKES,1) /= 0) PRTKES(:,:,:) = PRTKES(:,:,:)*PTSTEP/PRHODJ
! REMOVE NEGATIVE VALUES OF CHEM SCALAR
!
IF (LUSECHEM) THEN
+ if ( lbudget_sv ) then
+ do jsv = nsv_chembeg, nsv_chemend
+ call Budget_store_init( tbudgets( NBUDGET_SV1 - 1 + jsv), 'NEGA', prsvs(:, :, :, jsv) )
+ end do
+ end if
+
DO JSV=NSV_CHGSBEG,NSV_CHGSEND
IF ( MIN_ll( PRSVS(:,:,:,JSV), IINFO_ll) < 0.0 ) THEN
!
@@ -206,14 +214,20 @@ IF (LUSECHEM) THEN
END DO
ENDIF
!
- IF (LBUDGET_SV) THEN
- DO JSV=NSV_CHEMBEG,NSV_CHEMEND
- CALL BUDGET(PRSVS(:,:,:,JSV),JSV+12,'NEGA_BU_RSV')
- ENDDO
- ENDIF
+ if ( lbudget_sv ) then
+ do jsv = nsv_chembeg, nsv_chemend
+ call Budget_store_end( tbudgets( NBUDGET_SV1 - 1 + jsv), 'NEGA', prsvs(:, :, :, jsv) )
+ end do
+ end if
!
! aerosol sv
IF (LORILAM) THEN
+ if ( lbudget_sv ) then
+ do jsv = nsv_aerbeg, nsv_aerend
+ call Budget_store_init( tbudgets( NBUDGET_SV1 - 1 + jsv), 'NEGA', prsvs(:, :, :, jsv) )
+ end do
+ end if
+
DO JSV=NSV_AERBEG,NSV_AEREND-2-NM6_AER ! keep chem. species only
IF ( MIN_ll( PRSVS(:,:,:,JSV), IINFO_ll) < 0.0 ) THEN
!
@@ -247,11 +261,12 @@ IF (LUSECHEM) THEN
WRITE(ILUOUT,*)'AP MOMENT SOURCES IS SET TO ZERO'
END IF
END DO
- IF (LBUDGET_SV) THEN
- DO JSV=NSV_AERBEG,NSV_AEREND
- CALL BUDGET(PRSVS(:,:,:,JSV),JSV+12,'NEGA_BU_RSV')
- ENDDO
- ENDIF
+
+ if ( lbudget_sv ) then
+ do jsv = nsv_aerbeg, nsv_aerend
+ call Budget_store_end( tbudgets( NBUDGET_SV1 - 1 + jsv), 'NEGA', prsvs(:, :, :, jsv) )
+ end do
+ end if
ENDIF
ENDIF
!
diff --git a/src/MNH/extend_grid_parameter_mnh.f90 b/src/MNH/extend_grid_parameter_mnh.f90
index f83fc564f7c7a88f784331aab62369990f598531..7b54a15d520ff8dcec3079a9ca95b9a9421e837a 100644
--- a/src/MNH/extend_grid_parameter_mnh.f90
+++ b/src/MNH/extend_grid_parameter_mnh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2015-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2015-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -7,7 +7,7 @@
SUBROUTINE EXTEND_GRID_PARAMETERX1_MNH(HGRID,HREC,KDIM,KSIZE,KIMAX,KJMAX,PFIELD,PFIELD_EXTEND)
! #############################################################
!
-!!**** * - routine to extend a real splitted array on SURFEX halo
+!!**** * - routine to extend a real split array on SURFEX halo
!
! Author
! M.Moge 01/03/2015
@@ -37,7 +37,7 @@ INTEGER, INTENT(IN) :: KSIZE ! size of PFIELD_EXTEND
INTEGER, INTENT(IN) :: KIMAX !(local) dimension of the domain - X direction
INTEGER, INTENT(IN) :: KJMAX !(local) dimension of the domain - Y direction
REAL, DIMENSION(KDIM ), INTENT(IN) :: PFIELD ! real field for complete grid
-REAL, DIMENSION(KSIZE), INTENT(OUT):: PFIELD_EXTEND! real field for splitted grid
+REAL, DIMENSION(KSIZE), INTENT(OUT):: PFIELD_EXTEND! real field for split grid
!
!* 0.2 Declarations of local variables
!
@@ -154,7 +154,7 @@ END SUBROUTINE EXTEND_GRID_PARAMETERX1_MNH
SUBROUTINE EXTEND_GRID_PARAMETERN0_MNH(HGRID,HREC,KFIELD,KFIELD_EXTEND)
! #############################################################
!
-!!**** * - routine to "extend" an integer related to splitted grid on SURFEX halo
+!!**** * - routine to "extend" an integer related to split grid on SURFEX halo
!
!
!
@@ -169,7 +169,7 @@ IMPLICIT NONE
CHARACTER(LEN=10), INTENT(IN) :: HGRID ! grid type
CHARACTER(LEN=6), INTENT(IN) :: HREC ! name of the parameter
INTEGER, INTENT(IN) :: KFIELD ! integer scalar for complete grid
-INTEGER, INTENT(OUT):: KFIELD_EXTEND ! integer scalar for splitted grid
+INTEGER, INTENT(OUT):: KFIELD_EXTEND ! integer scalar for split grid
!* 0.2 Declarations of local variables
!
INTEGER :: IIB, IIE, IJB, IJE
diff --git a/src/MNH/fast_terms.f90 b/src/MNH/fast_terms.f90
index d4527d1381289123e9846ec1356a732a9dfe7f2e..58308a5006e1857eac0a5d4a840031ddacacdd72 100644
--- a/src/MNH/fast_terms.f90
+++ b/src/MNH/fast_terms.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -103,7 +103,6 @@ END MODULE MODI_FAST_TERMS
!! Module MODD_BUDGET:
!! NBUMOD
!! CBUTYPE
-!! NBUPROCCTR
!! LBU_RTH
!! LBU_RRV
!! LBU_RRC
@@ -150,24 +149,25 @@ END MODULE MODI_FAST_TERMS
!! J.Escobar 21/03/2013: for HALOK comment all NHALO=1 test
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! June 17, 2016 (P. Wautelet) removed unused variables
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_rc, lbudget_rv, lbudget_th, NBUDGET_RC, NBUDGET_RV, NBUDGET_TH, tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
+use mode_budget, only: Budget_store_end, Budget_store_init
use mode_mppdb
#ifdef MNH_OPENACC
use mode_msg
#endif
-USE MODI_BUDGET
USE MODI_CONDENS
USE MODI_GET_HALO
!
@@ -263,8 +263,11 @@ IF (OSUBG_COND) THEN
ELSE
ITERMAX=1
END IF
-!
-!
+
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+
!-------------------------------------------------------------------------------
!
!* 2. COMPUTE QUANTITIES WITH THE GUESS OF THE FUTURE INSTANT
@@ -472,12 +475,11 @@ ENDIF
!
!* 7. STORE THE BUDGET TERMS
! ----------------------
-!
-!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),6,'COND_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),7,'COND_BU_RRC')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),4,'COND_BU_RTH')
-!
+
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PRVS,"FAST_TERMS end:PRVS")
diff --git a/src/MNH/fct_met.f90 b/src/MNH/fct_met.f90
deleted file mode 100644
index b484dc59300c87cdd2ab214e74ec5fc03daffcef..0000000000000000000000000000000000000000
--- a/src/MNH/fct_met.f90
+++ /dev/null
@@ -1,363 +0,0 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######################
- MODULE MODI_FCT_MET
-! ######################
-!
-INTERFACE
- SUBROUTINE FCT_MET (HLBCX, HLBCY, KRR, &
- PTSTEP, PRHODJ, PTHM, PRM, PTKEM, &
- PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariant component of
- ! momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-!
-END SUBROUTINE FCT_MET
-!
-END INTERFACE
-!
-END MODULE MODI_FCT_MET
-!
-!
-!
-! #####################################################################
- SUBROUTINE FCT_MET (HLBCX, HLBCY, KRR, &
- PTSTEP, PRHODJ, PTHM, PRM, PTKEM, &
- PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-! #####################################################################
-!
-!!**** *FCT_MET * - routine to call the Flux-Corrected Transport for
-!! meteorological scalars
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to call the FLUX-CORRected routine
-!! for meteorological scalars variables.
-!!
-!!** METHOD
-!! ------
-!! The Flux-Corrected Transport method correct the fluxes using a limiting
-!! factor. This method ensures that the advection scheme is definite
-!! positive. A minimum value of the scalar (MIN) equal to 0 is used for
-!! the positiveness of the scheme.
-!!
-!! EXTERNAL
-!! --------
-!! Functions MXM,MYM,MZM : computes the averages along three directins
-!! Functions DXF,DYF,DZF : computes the finite differences
-!! Subroutine FLUX_CORR : corrects the advective fluxes
-!! Subroutine BUDGET : stores the sources for budget purposes
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_BUDGET : LBU_R* ( individual budget switches)
-!! CBUTYPE, NBUMOD
-!! REFERENCE
-!! ---------
-!! Book1 and book2 ( routine ADVECTION )
-!!
-!! AUTHOR
-!! ------
-!! J. Vila & JP. Lafore *Meteo-France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 27/10/94
-!! Stein 27/06/96 add the budgets
-!! Pinty 20/12/96 update the budgets
-!! Lafore 27/03/98 call to DFLUX_CORR
-!! Lafore 01/04/98 FCT only on total water (rv+rc+ri) and
-!! precipitating hydrometeors,
-!! remove 4D flux local arrays
-!! Stein 20/04/99 remove KMI from the list of argument of DFLUX_CORR
-!! Masson 07/11/02 update the budgets
-!! Lac 24/04/06 split meteorological and passive tracer routines
-!! 05/06 Remove KEPS
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET
-USE MODI_SHUMAN
-USE MODI_DFLUX_CORR
-USE MODI_BUDGET
-USE MODD_GRID_n
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariant component of
- ! momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JRR
- ! Loop index
-!
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) &
- :: ZFX ,ZFY ,ZFZ ! Advective flux components for each
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
- ZRTFX,ZRTFY,ZRTFZ ! variables and for total water (rv+rc+ri)
-!
-REAL :: ZMINR,ZMINTKE
- ! Absolute minimum values of
- ! water substances, TKE
-!-------------------------------------------------------------------------------
-!
-!* 1. FLUX-CORRECTED TRANSPORT ADVECTION SCHEME for the HMET group
-!
-!
-!* 1.1 Temperature: ---> advected by a CEN scheme
- ! NB! It is not necessary to make the
- ! flux correction since temperature is
- ! always positive.
-!
-!
- PRTHS(:,:,:) = PRTHS(:,:,:) &
- - DXF(PRUCT(:,:,:)*MXM (PTHT(:,:,:)))
- IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVX_BU_RTH')
-!
- PRTHS(:,:,:) = PRTHS(:,:,:) &
- - DYF(PRVCT(:,:,:)*MYM (PTHT(:,:,:)))
- IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVY_BU_RTH')
-!
- PRTHS(:,:,:) = PRTHS(:,:,:) &
- - DZF(PRWCT(:,:,:)*MZM (PTHT(:,:,:)))
- IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ADVZ_BU_RTH')
-!
-!* 1.2 No condensation case: Vapor ---> advected by a FCT scheme
-!
- ZMINR=0. ! Absolute minimum water substances
-!
- IF (KRR == 1) THEN
- CALL DFLUX_CORR (HLBCX, HLBCY, PTSTEP, ZMINR, PRHODJ, &
- PRM(:,:,:,1), PRT(:,:,:,1), &
- PRUCT, PRVCT, PRWCT, &
- ZFX(:,:,:), ZFY(:,:,:), ZFZ(:,:,:) )
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DXF(ZFX(:,:,:))
- IF (LBUDGET_RV) &
- CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVX_BU_RRV')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DYF(ZFY(:,:,:))
- IF (LBUDGET_RV) &
- CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVY_BU_RRV')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(ZFZ(:,:,:))
- IF (LBUDGET_RV) &
- CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
- END IF
-!
-!* 1.3 No ice case: rv+rc ---> advected by the FCT scheme
-! rc ---> advected by the CEN scheme
-!
- IF (KRR == 2 .OR. KRR == 3 ) THEN
- CALL DFLUX_CORR (HLBCX,HLBCY,PTSTEP,ZMINR,PRHODJ, &
- PRM(:,:,:,1)+PRM(:,:,:,2),PRT(:,:,:,1)+PRT(:,:,:,2), &
- PRUCT, PRVCT, PRWCT, &
- ZRTFX(:,:,:),ZRTFY(:,:,:),ZRTFZ(:,:,:) )
-!
- ZFX(:,:,:) = PRUCT(:,:,:) * MXM (PRT(:,:,:,2)) !
- ZFY(:,:,:) = PRVCT(:,:,:) * MYM (PRT(:,:,:,2)) ! CENtred scheme for rc
- ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (PRT(:,:,:,2)) !
-!
- ZRTFX(:,:,:) = ZRTFX(:,:,:) - ZFX(:,:,:) !
- ZRTFY(:,:,:) = ZRTFY(:,:,:) - ZFY(:,:,:) ! rv fluxes deduction
- ZRTFZ(:,:,:) = ZRTFZ(:,:,:) - ZFZ(:,:,:) !
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DXF(ZRTFX(:,:,:))
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DXF( ZFX(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVX_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVX_BU_RRC')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DYF(ZRTFY(:,:,:))
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DYF( ZFY(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVY_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVY_BU_RRC')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(ZRTFZ(:,:,:))
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DZF( ZFZ(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVZ_BU_RRC')
-!
- END IF
-!
-!* 1.4 Ice case: rv+rc+ri ---> advected by the FCT scheme
-! rc ---> advected by the CEN scheme
-! ri ---> advected by the CEN scheme
-!
- IF ( KRR >= 4 ) THEN
- CALL DFLUX_CORR (HLBCX,HLBCY,PTSTEP,ZMINR,PRHODJ, &
- PRM(:,:,:,1)+PRM(:,:,:,2)+PRM(:,:,:,4), &
- PRT(:,:,:,1)+PRT(:,:,:,2)+PRT(:,:,:,4), &
- PRUCT, PRVCT, PRWCT, &
- ZRTFX(:,:,:),ZRTFY(:,:,:),ZRTFZ(:,:,:) )
-!
- ZFX(:,:,:) = PRUCT(:,:,:) * MXM (PRT(:,:,:,2)) !
- ZFY(:,:,:) = PRVCT(:,:,:) * MYM (PRT(:,:,:,2)) ! CENtred scheme for rc
- ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (PRT(:,:,:,2)) !
-!
- ZRTFX(:,:,:) = ZRTFX(:,:,:) - ZFX(:,:,:) !
- ZRTFY(:,:,:) = ZRTFY(:,:,:) - ZFY(:,:,:) ! rv+ri fluxes deduction
- ZRTFZ(:,:,:) = ZRTFZ(:,:,:) - ZFZ(:,:,:) !
-!
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DXF( ZFX(:,:,:))
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVX_BU_RRC')
-!
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DYF( ZFY(:,:,:))
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVY_BU_RRC')
-!
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - DZF( ZFZ(:,:,:))
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7 ,'ADVZ_BU_RRC')
-!
-!
- ZFX(:,:,:) = PRUCT(:,:,:) * MXM (PRT(:,:,:,4)) !
- ZFY(:,:,:) = PRVCT(:,:,:) * MYM (PRT(:,:,:,4)) ! CENtred scheme for ri
- ZFZ(:,:,:) = PRWCT(:,:,:) * MZM (PRT(:,:,:,4)) !
-!
- ZRTFX(:,:,:) = ZRTFX(:,:,:) - ZFX(:,:,:) !
- ZRTFY(:,:,:) = ZRTFY(:,:,:) - ZFY(:,:,:) ! rv fluxes deduction
- ZRTFZ(:,:,:) = ZRTFZ(:,:,:) - ZFZ(:,:,:) !
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DXF(ZRTFX(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - DXF( ZFX(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVX_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVX_BU_RRI')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DYF(ZRTFY(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - DYF( ZFY(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVY_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVY_BU_RRI')
-!
- PRRS(:,:,:,1) = PRRS(:,:,:,1) - DZF(ZRTFZ(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - DZF( ZFZ(:,:,:))
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6 ,'ADVZ_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9 ,'ADVZ_BU_RRI')
-!
- END IF
-!
-!* 1.5 Rain case: rr ---> advected by the FCT scheme
-!
- IF ( KRR >= 3 ) THEN
- CALL DFLUX_CORR (HLBCX, HLBCY, &
- PTSTEP, ZMINR, PRHODJ, PRM(:,:,:,3), PRT(:,:,:,3), &
- PRUCT, PRVCT, PRWCT, &
- ZFX(:,:,:), ZFY(:,:,:), ZFZ(:,:,:) )
-!
- PRRS(:,:,:,3) = PRRS(:,:,:,3) - DXF( ZFX(:,:,:))
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVX_BU_RRR')
-!
- PRRS(:,:,:,3) = PRRS(:,:,:,3) - DYF( ZFY(:,:,:))
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVY_BU_RRR')
-!
- PRRS(:,:,:,3) = PRRS(:,:,:,3) - DZF( ZFZ(:,:,:))
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8 ,'ADVZ_BU_RRR')
-!
- END IF
-!
-!* 1.6 Other hydrometeors: rs,rg,rh ---> advected by the FCT scheme
-!
- DO JRR = 5, KRR
- CALL DFLUX_CORR (HLBCX, HLBCY, &
- PTSTEP, ZMINR, PRHODJ, PRM(:,:,:,JRR), PRT(:,:,:,JRR), &
- PRUCT, PRVCT, PRWCT, &
- ZFX(:,:,:), ZFY(:,:,:), ZFZ(:,:,:) )
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) - DXF(ZFX(:,:,:))
- IF (JRR==5.AND.LBUDGET_RS) &
- CALL BUDGET (PRRS(:,:,:,5),10,'ADVX_BU_RRS')
- IF (JRR==6.AND.LBUDGET_RG) &
- CALL BUDGET (PRRS(:,:,:,6),11,'ADVX_BU_RRG')
- IF (JRR==7.AND.LBUDGET_RH) &
- CALL BUDGET (PRRS(:,:,:,7),12,'ADVX_BU_RRH')
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) - DYF(ZFY(:,:,:))
- IF (JRR==5.AND.LBUDGET_RS) &
- CALL BUDGET (PRRS(:,:,:,5),10,'ADVY_BU_RRS')
- IF (JRR==6.AND.LBUDGET_RG) &
- CALL BUDGET (PRRS(:,:,:,6),11,'ADVY_BU_RRG')
- IF (JRR==7.AND.LBUDGET_RH) &
- CALL BUDGET (PRRS(:,:,:,7),12,'ADVY_BU_RRH')
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) - DZF(ZFZ(:,:,:))
- IF (JRR==5.AND.LBUDGET_RS) &
- CALL BUDGET (PRRS(:,:,:,5),10,'ADVZ_BU_RRS')
- IF (JRR==6.AND.LBUDGET_RG) &
- CALL BUDGET (PRRS(:,:,:,6),11,'ADVZ_BU_RRG')
- IF (JRR==7.AND.LBUDGET_RH) &
- CALL BUDGET (PRRS(:,:,:,7),12,'ADVZ_BU_RRH')
-!
- END DO
-!
-!* 1.6 TKE ---> advected by the FCT scheme
-!
- IF (SIZE(PTKET,1) /= 0) THEN
-!
- ZMINTKE=0. ! Absolute minimum TKE
-!
- CALL DFLUX_CORR (HLBCX, HLBCY, &
- PTSTEP, ZMINTKE, PRHODJ, PTKEM,PTKET, &
- PRUCT, PRVCT, PRWCT, &
- ZFX(:,:,:), ZFY(:,:,:), ZFZ(:,:,:) )
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) - DXF(ZFX(:,:,:))
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVX_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) - DYF(ZFY(:,:,:))
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVY_BU_RTKE')
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) - DZF(ZFZ(:,:,:))
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADVZ_BU_RTKE')
-!
- END IF
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE FCT_MET
diff --git a/src/MNH/fct_scalar.f90 b/src/MNH/fct_scalar.f90
deleted file mode 100644
index b37661bd07186a752728456cac52f6e92992c3f7..0000000000000000000000000000000000000000
--- a/src/MNH/fct_scalar.f90
+++ /dev/null
@@ -1,166 +0,0 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######################
- MODULE MODI_FCT_SCALAR
-! ######################
-!
-INTERFACE
- SUBROUTINE FCT_SCALAR (HLBCX, HLBCY, KSV, &
- PTSTEP, PRHODJ, PSVM, PSVT, &
- PRUCT, PRVCT, PRWCT, PRSVS )
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Double Time step
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariant component of
- ! momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-!
-END SUBROUTINE FCT_SCALAR
-!
-END INTERFACE
-!
-END MODULE MODI_FCT_SCALAR
-!
-!
-!
-! #####################################################################
- SUBROUTINE FCT_SCALAR (HLBCX, HLBCY, KSV, &
- PTSTEP, PRHODJ, PSVM, PSVT, &
- PRUCT, PRVCT, PRWCT, PRSVS )
-! #####################################################################
-!
-!!**** *FCT_SCALAR * - routine to call the Flux-Corrected Transport Scalar
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to call the FLUX-CORRected routine
-!! for scalar variables (tracers).
-!!
-!!** METHOD
-!! ------
-!! The Flux-Corrected Transport method correct the fluxes using a limiting
-!! factor. This method ensures that the advection scheme is definite
-!! positive. A minimum value of the scalar (MIN) equal to 0 is used for
-!! the positiveness of the scheme.
-!!
-!! EXTERNAL
-!! --------
-!! Functions MXM,MYM,MZM : computes the averages along three directins
-!! Functions DXF,DYF,DZF : computes the finite differences
-!! Subroutine FLUX_CORR : corrects the advective fluxes
-!! Subroutine BUDGET : stores the sources for budget purposes
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! MODD_BUDGET : LBU_R* ( individual budget switches)
-!! CBUTYPE, NBUMOD
-!! REFERENCE
-!! ---------
-!! Book1 and book2 ( routine ADVECTION )
-!!
-!! AUTHOR
-!! ------
-!! J. Vila & JP. Lafore *Meteo-France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 27/10/94
-!! Stein 27/06/96 add the budgets
-!! Pinty 20/12/96 update the budgets
-!! Lafore 27/03/98 call to DFLUX_CORR
-!! Lafore 01/04/98 FCT only on total water (rv+rc+ri) and
-!! precipitating hydrometeors,
-!! remove 4D flux local arrays
-!! Stein 20/04/99 remove KMI from the list of argument of DFLUX_CORR
-!! Jabouille 22/06/01 use XSVMIN
-!! Masson 07/11/02 update the budgets
-!! Lac 24/04/06 Split scalar and passive tracer routines
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET
-USE MODD_NSV, ONLY : XSVMIN
-USE MODD_GRID_n
-USE MODI_SHUMAN
-USE MODI_DFLUX_CORR
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariant component of
- ! momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: JSV
- ! Loop index
-!
-REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) &
- :: ZFX ,ZFY ,ZFZ ! Advective flux components for each
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. FLUX-CORRECTED TRANSPORT ADVECTION SCHEME for the HSV group
-!
-!
-!
-!
- DO JSV = 1, KSV
- CALL DFLUX_CORR (HLBCX,HLBCY,PTSTEP,XSVMIN(JSV),PRHODJ, &
- PSVM(:,:,:,JSV),PSVT(:,:,:,JSV),PRUCT,PRVCT,PRWCT, &
- ZFX(:,:,:),ZFY(:,:,:),ZFZ(:,:,:) )
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - DXF(ZFX(:,:,:))
- IF (LBUDGET_SV) &
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVX_BU_RSV')
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - DYF(ZFY(:,:,:))
- IF (LBUDGET_SV) &
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVY_BU_RSV')
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) - DZF(ZFZ(:,:,:))
- IF (LBUDGET_SV) &
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADVZ_BU_RSV')
- END DO
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE FCT_SCALAR
diff --git a/src/MNH/finalize_mnh.f90 b/src/MNH/finalize_mnh.f90
new file mode 100644
index 0000000000000000000000000000000000000000..faabb9972201b09d35d1020b56ef477597ee9150
--- /dev/null
+++ b/src/MNH/finalize_mnh.f90
@@ -0,0 +1,73 @@
+!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.
+!-----------------------------------------------------------------
+! Author:
+! P. Wautelet 06/07/2021
+! Modifications:
+!
+!-----------------------------------------------------------------
+MODULE MODE_FINALIZE_MNH
+
+IMPLICIT NONE
+
+CONTAINS
+
+SUBROUTINE FINALIZE_MNH
+ USE MODD_CONF, only: LCHECK, NMODEL
+ USE MODD_IO, only: NIO_VERB, NVERB_DEBUG
+ USE MODD_LUNIT, only: TLUOUT0
+ USE MODD_LUNIT_n, only: LUNIT_MODEL
+ USE MODD_MNH_SURFEX_n, only: SURFEX_DEALLO_LIST
+#ifdef CPLOASIS
+ USE MODD_SFX_OASIS, only: LOASIS
+#endif
+
+ USE MODE_INIT_ll, only: END_PARA_ll
+ USE MODE_IO_FILE, only: IO_File_close
+ USE MODE_IO_MANAGE_STRUCT, only: IO_Filelist_print
+ USE MODE_MPPDB, only: MPPDB_BARRIER
+ USE MODE_MSG, only: MSG_STATS
+
+#ifdef CPLOASIS
+ USE MODI_SFX_OASIS_END
+#endif
+
+ IMPLICIT NONE
+
+ INTEGER :: IRESP
+ INTEGER :: JMODEL
+
+ !Print the list of all files and some statistics on them
+ IF ( NIO_VERB >= NVERB_DEBUG ) CALL IO_Filelist_print()
+
+ !Print the number of printed messages via Print_msg
+ CALL MSG_STATS()
+
+ !Close all the opened 'output listing' files
+ IF ( TLUOUT0%LOPENED ) CALL IO_File_close(TLUOUT0)
+ DO JMODEL = 1, NMODEL
+ IF ( ASSOCIATED( LUNIT_MODEL(JMODEL)%TLUOUT ) ) THEN
+ IF ( LUNIT_MODEL(JMODEL)%TLUOUT%LOPENED ) CALL IO_File_close( LUNIT_MODEL(JMODEL)%TLUOUT)
+ END IF
+ END DO
+
+ !Finalize the parallel libraries
+ IF ( LCHECK ) THEN
+ CALL MPPDB_BARRIER()
+ ELSE
+ CALL END_PARA_ll( IRESP )
+#ifdef CPLOASIS
+ IF ( LOASIS ) THEN
+ CALL SFX_OASIS_END()
+ END IF
+#endif
+ END IF
+
+ !Free SURFEX structures if necessary
+ CALL SURFEX_DEALLO_LIST()
+
+END SUBROUTINE FINALIZE_MNH
+
+END MODULE MODE_FINALIZE_MNH
diff --git a/src/MNH/flash_geom_elec.f90 b/src/MNH/flash_geom_elec.f90
index 3cd873895ccd911ef791e4700cda3fde6ded209a..8ae281d266727272811789065a02bce9cad1ec3c 100644
--- a/src/MNH/flash_geom_elec.f90
+++ b/src/MNH/flash_geom_elec.f90
@@ -1525,7 +1525,7 @@ END IF ! (inb_cell .ge. 1)
! --------------------------------------------------
!
IF (LLMA) THEN
- IF( IPROC .EQ. 0 .AND. TDTCUR%TIME >= TDTLMA%TIME - PTSTEP ) THEN
+ IF( IPROC .EQ. 0 .AND. TDTCUR%xtime >= TDTLMA%xtime - PTSTEP ) THEN
CALL WRITE_OUT_ASCII
CALL WRITE_OUT_LMA
ISFLASH_NUMBER(0) = ISFLASH_NUMBER(NNBLIGHT)
diff --git a/src/MNH/forc_squall_line.f90 b/src/MNH/forc_squall_line.f90
index 87ac9643848aa61edaec46d037aabca9461bbab3..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.
@@ -37,7 +37,7 @@ END MODULE MODI_FORC_SQUALL_LINE
!!
!! IMPLICIT ARGUMENTS
!! ------------------
-!! Module MODD_BLANK
+!! Module MODD_BLANKn
!!
!! REFERENCE
!! ---------
@@ -55,11 +55,11 @@ END MODULE MODI_FORC_SQUALL_LINE
! ------------
!
USE MODD_PARAMETERS
-USE MODD_BLANK, 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 3163cb1ae95584c7e7a318bf245560f5d3229ab1..14a65ad60ebc6668b4a38851dc32ab1b06259041 100644
--- a/src/MNH/forcing.f90
+++ b/src/MNH/forcing.f90
@@ -11,7 +11,7 @@ INTERFACE
!
SUBROUTINE FORCING ( PTSTEP, OUSERV, PRHODJ, PCORIOZ, &
PZHAT, PZZ, TPDTCUR, &
- PUFRC_PAST, PVFRC_PAST, &
+ PUFRC_PAST, PVFRC_PAST, PWTFRC, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
KMI,PJ)
@@ -29,6 +29,8 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUFRC_PAST, PVFRC_PAST
! ! forcing at previous time-step
!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTFRC ! large scale vertical wind
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT,PTHT,PTKET
! wind, potential temperature and
! TKE at time t
@@ -53,7 +55,7 @@ END MODULE MODI_FORCING
! ######################################################################
SUBROUTINE FORCING ( PTSTEP, OUSERV, PRHODJ, PCORIOZ, &
PZHAT, PZZ, TPDTCUR, &
- PUFRC_PAST, PVFRC_PAST, &
+ PUFRC_PAST, PVFRC_PAST, PWTFRC, &
PUT, PVT, PWT, PTHT, PTKET, PRT, PSVT, &
PRUS, PRVS, PRWS, PRTHS, PRTKES, PRRS, PRSVS, &
KMI,PJ)
@@ -143,15 +145,21 @@ END MODULE MODI_FORCING
!! 06/2012 V. Masson Adds tendency of geostrophic wind itself to wind tendency
!! 01/2014 J. escobar correction for // initialisation geostrophic ZUF,ZVF,ZWF
!! 09/2017 Q.Rodier add LTEND_UV_FRC
-!! 28/03/2018 P. Wautelet Replace TEMPORAL_DIST by DATETIME_DISTANCE
-!! use overloaded comparison operator for date_time
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/03/2018: replace TEMPORAL_DIST by DATETIME_DISTANCE
+! 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
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ 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, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_DYN
@@ -160,11 +168,15 @@ USE MODD_LUNIT
USE MODD_PARAMETERS
USE MODD_TIME
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_DATETIME
+USE MODE_GATHER_ll
+USE MODE_ll
USE MODE_MSG
+USE MODE_REPRO_SUM
!
-USE MODI_BUDGET
USE MODI_GET_HALO
+USE MODI_LES_MEAN_ll
USE MODI_SHUMAN
USE MODI_UPSTREAM_Z
!
@@ -183,6 +195,8 @@ TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! current date and time
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUFRC_PAST, PVFRC_PAST
! ! forcing at previous time-step
!
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PWTFRC ! large scale vertical wind
+!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT,PWT,PTHT,PTKET
! wind, potential temperature and
! TKE at time t
@@ -200,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
!
@@ -239,13 +256,38 @@ 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
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'FRC', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'FRC', prvs (:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'FRC', prws (:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'FRC', prths (:, :, :) )
+if ( lbudget_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'FRC', prtkes(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'FRC', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC ), 'FRC', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR ), 'FRC', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI ), 'FRC', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS ), 'FRC', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG ), 'FRC', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH ), 'FRC', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jl = 1, size( prsvs, 4 )
+ call Budget_store_init( tbudgets(jl + NBUDGET_SV1 - 1), 'FRC', prsvs(:, :, :, jl) )
+ end do
+end if
!
!* 1. PREPARATION OF FORCING
! ----------------------
@@ -259,10 +301,10 @@ IF (GSFIRSTCALL) THEN
WRITE(UNIT=ILUOUT0,FMT='(" THERE ARE ",I2," FORCING SOUNDINGS AT:")') NFRC
DO JSX = 1 , NFRC
WRITE(UNIT=ILUOUT0,FMT='(F9.0, "s, date:", I3, "/", I3, "/", I5)') &
- TDTFRC(JSX)%TIME, &
- TDTFRC(JSX)%TDATE%DAY, &
- TDTFRC(JSX)%TDATE%MONTH, &
- TDTFRC(JSX)%TDATE%YEAR
+ TDTFRC(JSX)%xtime, &
+ TDTFRC(JSX)%nday, &
+ TDTFRC(JSX)%nmonth, &
+ TDTFRC(JSX)%nyear
END DO
!
!* 1.2 find first sounding to be used
@@ -452,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
!
@@ -607,7 +651,7 @@ END DO
!
! store large scale w in module to be used later
! in convection scheme
-XWTFRC(:,:,:) = ZWF(:,:,:)
+PWTFRC(:,:,:) = ZWF(:,:,:)
!
!* computes evolution of forcing wind
WHERE(PUFRC_PAST==XUNDEF) PUFRC_PAST = ZUF(:,:,:)
@@ -755,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)
@@ -810,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
!
@@ -827,24 +890,24 @@ END IF
! ------------
!
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'FRC_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'FRC_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'FRC_BU_RW')
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'FRC_BU_RTH')
-IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'FRC_BU_RTKE')
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'FRC_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'FRC_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8,'FRC_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'FRC_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'FRC_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'FRC_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'FRC_BU_RRH')
-IF (LBUDGET_SV) THEN
- DO JL = 1 , SIZE(PRSVS,4)
- CALL BUDGET (PRSVS(:,:,:,JL),JL+12,'FRC_BU_RSV')
- END DO
-END IF
-!
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'FRC', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'FRC', prvs (:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'FRC', prws (:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'FRC', prths (:, :, :) )
+if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'FRC', prtkes(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'FRC', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'FRC', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'FRC', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'FRC', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'FRC', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'FRC', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'FRC', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jl = 1, size( prsvs, 4 )
+ call Budget_store_end( tbudgets(jl + NBUDGET_SV1 - 1), 'FRC', prsvs(:, :, :, jl) )
+ end do
+end if
+
!----------------------------------------------------------------------------
!
! deallocate work arrays
@@ -864,6 +927,8 @@ DEALLOCATE(ZDZZ)
DEALLOCATE(ZRWCF)
DEALLOCATE(ZDUF)
DEALLOCATE(ZDVF)
+DEALLOCATE(ZUMEAN)
+DEALLOCATE(ZVMEAN)
!
!----------------------------------------------------------------------------
!
diff --git a/src/MNH/free_atm_profile.f90 b/src/MNH/free_atm_profile.f90
index 631577f0f97398c35903ce6ca4b07a7c6645e944..50496da72b87d003764faf82a65a856daf128c84 100644
--- a/src/MNH/free_atm_profile.f90
+++ b/src/MNH/free_atm_profile.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1997-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -93,13 +93,13 @@ END MODULE MODI_FREE_ATM_PROFILE
! ------------
!
USE MODD_CONF
+use modd_field, only: tfielddata, TYPEINT, TYPEREAL
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT, ONLY: TLUOUT0
USE MODD_PARAMETERS
USE MODD_VER_INTERP_LIN
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEINT, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MPPDB
!
diff --git a/src/MNH/goto_model_wrapper.f90 b/src/MNH/goto_model_wrapper.f90
index 8774b548f230f23bd8ac2e48bfed340df491a843..831cb2028c3c0ea54da0090bb1329b014437bb4c 100644
--- a/src/MNH/goto_model_wrapper.f90
+++ b/src/MNH/goto_model_wrapper.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.
!-----------------------------------------------------------------
!! MODIFICATIONS
@@ -15,6 +15,9 @@
! 02/2018 Q.Libois ECRAD
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! 2017 V.Vionnet blow snow
+! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+! F. Auguste 02/21: add IBM
+! T. Nagel 02/21: add turbulence recycling
!-----------------------------------------------------------------
MODULE MODI_GOTO_MODEL_WRAPPER
@@ -29,34 +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
@@ -73,53 +86,37 @@ USE MODD_PARAM_n
USE MODD_PARAM_RAD_n
USE MODD_PARAM_ECRAD_n
USE MODD_PASPOL_n
-#ifdef MNH_FOREFIRE
-USE MODD_FOREFIRE_n
-#endif
+USE MODD_PAST_FIELD_n
USE MODD_PRECIP_n
USE MODD_ELEC_n
USE MODD_PROFILER_n
USE MODD_RADIATIONS_n
-USE MODD_SHADOWS_n
+USE MODD_RBK90_Global_n
+USE MODD_RBK90_JacobianSP_n
+USE MODD_RBK90_Parameters_n
+USE MODD_RECYCL_PARAM_n
USE MODD_REF_n
-USE MODD_FRC_n
+USE MODD_RELFRC_n
USE MODD_SECPGD_FIELD_n
USE MODD_SERIES_n
+USE MODD_SHADOWS_n
USE MODD_STATION_n
-!USE MODD_TIME_n
-USE MODD_TURB_n
-USE MODD_DRAG_n
-USE MODD_BLOWSNOW_n
-!
USE MODD_SUB_CH_FIELD_VALUE_n
USE MODD_SUB_CH_MONITOR_n
+USE MODD_SUB_ELEC_n
USE MODD_SUB_MODEL_n
-USE MODD_SUB_PHYS_PARAM_n
+USE MODD_SUB_PASPOL_n
+USE MODD_SUB_PHYS_PARAM_n
USE MODD_SUB_PROFILER_n
USE MODD_SUB_STATION_n
USE MODD_TIMEZ
-USE MODD_SUB_PASPOL_n
-USE MODD_SUB_ELEC_n
-USE MODD_CH_PH_n
-USE MODD_CH_ICE_n
-USE MODD_CH_M9_n
-USE MODD_CH_ROSENBROCK_n
-USE MODD_RBK90_Global_n
-USE MODD_RBK90_JacobianSP_n
-USE MODD_RBK90_Parameters_n
-!
-!USE MODD_LIMA_PRECIP_SCAVENGING_n
+USE MODD_TURB_n
!
-!USE MODD_DEF_EDDY_FLUX_n
-!USE MODD_DEF_EDDYUV_FLUX_n
-USE MODD_RELFRC_n
-USE MODD_ADVFRC_n
!
-USE MODD_CH_PRODLOSSTOT_n
-USE MODD_CH_BUDGET_n
-USE MODE_FIELD
+use mode_field, only: Fieldlist_goto_model
use mode_msg
!
+!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KFROM, KTO
@@ -141,6 +138,7 @@ END IF
!
CALL ADV_GOTO_MODEL(KFROM, KTO)
CALL BIKHARDT_GOTO_MODEL(KFROM, KTO)
+CALL BLANK_GOTO_MODEL(KFROM,KTO)
CALL CH_AERO_GOTO_MODEL(KFROM,KTO)
CALL CH_FLX_GOTO_MODEL(KFROM, KTO)
CALL CH_JVALUES_GOTO_MODEL(KFROM, KTO)
@@ -152,6 +150,8 @@ CALL CONF_GOTO_MODEL(KFROM, KTO)
CALL CURVCOR_GOTO_MODEL(KFROM, KTO)
!CALL DEEP_CONVECTION_GOTO_MODEL(KFROM, KTO)
CALL DIM_GOTO_MODEL(KFROM, KTO)
+CALL DRAGTREE_GOTO_MODEL(KFROM, KTO)
+CALL DRAGBLDG_GOTO_MODEL(KFROM, KTO)
CALL DUMMY_GR_FIELD_GOTO_MODEL(KFROM, KTO)
CALL DYN_GOTO_MODEL(KFROM, KTO)
CALL DYNZD_GOTO_MODEL(KFROM,KTO)
@@ -198,6 +198,7 @@ CALL FRC_GOTO_MODEL(KFROM, KTO)
CALL SECPGD_FIELD_GOTO_MODEL(KFROM, KTO)
CALL SERIES_GOTO_MODEL(KFROM, KTO)
CALL STATION_GOTO_MODEL(KFROM, KTO)
+CALL ALLSTATION_GOTO_MODEL(KFROM, KTO)
CALL SUB_CH_FIELD_VALUE_GOTO_MODEL(KFROM, KTO)
CALL SUB_CH_MONITOR_GOTO_MODEL(KFROM, KTO)
CALL SUB_MODEL_GOTO_MODEL(KFROM, KTO)
@@ -227,6 +228,9 @@ CALL RELFRC_GOTO_MODEL(KFROM, KTO)
CALL CH_PRODLOSSTOT_GOTO_MODEL(KFROM,KTO)
CALL CH_BUDGET_GOTO_MODEL(KFROM,KTO)
CALL BLOWSNOW_GOTO_MODEL(KFROM, KTO)
+CALL IBM_GOTO_MODEL(KFROM, KTO)
+CALL RECYCL_GOTO_MODEL(KFROM, KTO)
+CALL LSF_GOTO_MODEL(KFROM, KTO)
!
IF (.NOT.GNOFIELDLIST) CALL FIELDLIST_GOTO_MODEL(KFROM, KTO)
!
diff --git a/src/MNH/gravity.f90 b/src/MNH/gravity.f90
index d89641e9fa862d42df09ce812e6277430952df7e..6f7986bff8a365658104744fd059b6050b626cb2 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.
@@ -73,7 +73,6 @@ END MODULE MODI_GRAVITY
!! 'CART' for cartesian box configuration
!! 'MASK' for budget zone defined by a mask
!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
!! LBU_RTH : logical for budget of RTH (potential temperature)
!! .TRUE. = budget of RTH
!! .FALSE. = no budget of RTH
@@ -100,7 +99,7 @@ END MODULE MODI_GRAVITY
!! C.Lac - March 2011 - Splitted from dyn_sources
!! Q.Rodier 06/15 correction on budget
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
+!! J.L. Redelsperger 03/2021 : Ocean model case
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -108,10 +107,10 @@ END MODULE MODI_GRAVITY
!
USE MODD_CONF
USE MODD_CST
+USE MODD_DYN_n, ONLY : LOCEAN
use mode_mppdb
-USE MODI_BUDGET
USE MODI_GET_HALO
#ifndef MNH_OPENACC
USE MODI_SHUMAN
@@ -169,56 +168,70 @@ IF( L1D ) THEN ! no buoyancy for 1D case
!$acc end kernels
ELSE
!
- IF( KRR > 0) THEN
+ IF (LOCEAN) THEN !ocean case
+ CALL GET_HALO(PTHT)
+ IF(KRR > 0) THEN
+#ifndef MNH_OPENACC
+ CALL GET_HALO(PRT(:,:,:,1))
+#else
+ CALL GET_HALO_D(PRT(:,:,:,1))
+#endif
+ PRWS(:,:,:) = PRWS + XG * (XALPHAOC*MZM((PTHT - PTHVREF )*PRHODJ) &
+ - XBETAOC*MZM((PRT(:,:,:,1) - XSA00OCEAN)*PRHODJ) )
+ ELSE ! unsalted case
+ PRWS(:,:,:) = PRWS + XG * XALPHAOC*MZM((PTHT - PTHVREF )*PRHODJ )
+ END IF
+ ELSE ! Atmospheric case
+ IF( KRR > 0) THEN
!
! compute the ratio : 1 + total water mass / dry air mass
!
!$acc kernels
- ZRV_OV_RD = XRV / XRD
- ZWORK1(:,:,:) = 1.
+ ZRV_OV_RD = XRV / XRD
+ ZWORK1(:,:,:) = 1.
!$acc end kernels
- DO JWATER = 1, 1 + KRRL + KRRI
+ DO JWATER = 1, 1 + KRRL + KRRI
#ifndef MNH_OPENACC
- CALL GET_HALO(PRT(:,:,:,JWATER))
+ CALL GET_HALO(PRT(:,:,:,JWATER))
#else
- CALL GET_HALO_D(PRT(:,:,:,JWATER))
+ CALL GET_HALO_D(PRT(:,:,:,JWATER))
#endif
!$acc kernels
- ZWORK1(:,:,:) = ZWORK1(:,:,:) + PRT(:,:,:,JWATER)
+ ZWORK1(:,:,:) = ZWORK1(:,:,:) + PRT(:,:,:,JWATER)
!$acc end kernels
- END DO
+ END DO
!
! compute the virtual potential temperature when water is present in any form
!
#ifndef MNH_OPENACC
- CALL GET_HALO(PTHT)
+ CALL GET_HALO(PTHT)
#else
- CALL GET_HALO_D(PTHT)
+ CALL GET_HALO_D(PTHT)
#endif
!
!$acc kernels
- ZWORK2(:,:,:) = PTHT(:,:,:) * (1. + PRT(:,:,:,1)*ZRV_OV_RD) / ZWORK1(:,:,:)
+ ZWORK2(:,:,:) = PTHT(:,:,:) * (1. + PRT(:,:,:,1)*ZRV_OV_RD) / ZWORK1(:,:,:)
!$acc end kernels
- ELSE
+ ELSE
!
! compute the virtual potential temperature when water is absent
!
!$acc kernels
- ZWORK2(:,:,:) = PTHT(:,:,:)
+ ZWORK2(:,:,:) = PTHT(:,:,:)
!$acc end kernels
- END IF
+ END IF
!
! compute the gravity term
!
#ifndef MNH_OPENACC
- PRWS(:,:,:) = XG * MZM( ( (ZWORK2/PTHVREF) - 1. ) * PRHODJ )
+ PRWS(:,:,:) = XG * MZM( ( (ZWORK2/PTHVREF) - 1. ) * PRHODJ )
#else
!$acc kernels
- ZWORK1(:,:,:) = ( ( ZWORK2(:,:,:) / PTHVREF(:,:,:) ) - 1. ) * PRHODJ(:,:,:)
+ ZWORK1(:,:,:) = ( ( ZWORK2(:,:,:) / PTHVREF(:,:,:) ) - 1. ) * PRHODJ(:,:,:)
!$acc end kernels
- CALL MZM_DEVICE(ZWORK1,ZWORK2)
+ CALL MZM_DEVICE(ZWORK1,ZWORK2)
!$acc kernels
- PRWS(:,:,:) = XG * ZWORK2(:,:,:)
+ PRWS(:,:,:) = XG * ZWORK2(:,:,:)
!$acc end kernels
#endif
!
@@ -226,6 +239,7 @@ ELSE
! ground
!
!
+ END IF
END IF
!
IF (MPPDB_INITIALIZED) THEN
diff --git a/src/MNH/gravity_impl.f90 b/src/MNH/gravity_impl.f90
index 2667b4733d7064abc13e445497f9079da23cdc90..600520cf575b0d5009a6c73815914a30dc6bfc1e 100644
--- a/src/MNH/gravity_impl.f90
+++ b/src/MNH/gravity_impl.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2011-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -71,20 +71,21 @@ END MODULE MODI_GRAVITY_IMPL
!! -------------
!! Original 04/2011
!! Q.Rodier 06/15 correction on budget
-!!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_w, NBUDGET_W, tbudgets
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_mppdb
-USE MODI_ADV_BOUNDARIES
-USE MODI_BUDGET
-USE MODI_GRAVITY
-!
+use modi_adv_boundaries
+use modi_gravity
+
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
@@ -150,7 +151,8 @@ allocate( zr ( size( prt, 1 ), size( prt, 2 ), size( prt, 3 ), size( pr
!$acc data create( zrws_grav, zth, zr )
-!
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'GRAV', prws(:, :, :) )
+
! guess of Theta at future time-step
!$acc kernels
ZTH(:,:,:) = (PRTHS(:,:,:) + PRTHS_CLD(:,:,:)) / PRHODJ(:,:,:) * PTSTEP
@@ -181,10 +183,10 @@ CALL GRAVITY ( KRR,KRRL, KRRI, ZTH, ZR, PRHODJ, PTHVREF, ZRWS_GRAV(:,:,:) )
PRWS(:,:,:) = PRWS(:,:,:) + ZRWS_GRAV(:,:,:)
!$acc end kernels
!
-IF (LBUDGET_W) THEN
+if ( lbudget_w ) then
!$acc update self(PRWS)
- CALL BUDGET (PRWS,3,'GRAV_BU_RW')
-END IF
+ call Budget_store_end( tbudgets(NBUDGET_W), 'GRAV', prws(:, :, :) )
+end if
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/ground_paramn.f90 b/src/MNH/ground_paramn.f90
index 484a29f90a440f058468f9768ee8b497c5ca7458..f4f9fcbea68094ed101f1613c7f0ce0a119881cf 100644
--- a/src/MNH/ground_paramn.f90
+++ b/src/MNH/ground_paramn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -549,9 +549,9 @@ IF( NRR >= 7 .AND. SIZE(XINPRH)>0 ) ZSNOW = ZSNOW + XINPRH * XRHOLW
! ----------
!
IF (.NOT. LCARTESIAN) THEN
- ZTSUN(:,:) = MOD(TDTCUR%TIME -XTSIDER*3600. +XLON(:,:)*240., XDAY)
+ ZTSUN(:,:) = MOD(TDTCUR%xtime -XTSIDER*3600. +XLON(:,:)*240., XDAY)
ELSE
- ZTSUN(:,:) = MOD(TDTCUR%TIME -XTSIDER*3600. +XLON0 *240., XDAY)
+ ZTSUN(:,:) = MOD(TDTCUR%xtime -XTSIDER*3600. +XLON0 *240., XDAY)
END IF
!
! 1.12 Forcing level
@@ -633,18 +633,18 @@ END IF
#endif
!
! Call to surface schemes
-!
-CALL COUPLING_SURF_ATM_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, &
- XTSTEP, TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, TDTCUR%TDATE%DAY, TDTCUR%TIME, &
- IDIM1D,KSV_SURF,SIZE(XSW_BANDS), &
- ZP_TSUN, ZP_ZENITH,ZP_ZENITH, ZP_AZIM, &
- ZP_ZREF, ZP_ZREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, YSV_SURF,&
- ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, XSW_BANDS, ZP_PS, ZP_PA, &
- ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
- ZP_TSRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, &
- ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
- ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF,ZP_ZWS, &
- 'OK' )
+!
+CALL COUPLING_SURF_ATM_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, &
+ XTSTEP, TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
+ IDIM1D,KSV_SURF,SIZE(XSW_BANDS), &
+ ZP_TSUN, ZP_ZENITH, ZP_ZENITH, ZP_AZIM, &
+ ZP_ZREF, ZP_ZREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, YSV_SURF, &
+ ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, XSW_BANDS, ZP_PS, ZP_PA, &
+ ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
+ ZP_TSRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, &
+ ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
+ ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF,ZP_ZWS, &
+ 'OK' )
!
#ifdef CPLOASIS
IF (LOASIS) THEN
diff --git a/src/MNH/hypgeo.f90 b/src/MNH/hypgeo.f90
index fa64d778da5ee68c7483f3a2ce969f7dda5269fe..0d3697f71e6843ee6e0ea044a9965de7762cd36b 100644
--- a/src/MNH/hypgeo.f90
+++ b/src/MNH/hypgeo.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 operators 2006/05/18 13:07:25
-!-----------------------------------------------------------------
!####################
MODULE MODI_HYPGEO
!####################
@@ -97,7 +92,7 @@ REAL :: ZX0,ZX1,ZZA,ZZB,ZZC,ZZD,Y(2)
!------------------------------------------------------------------------------
!
!
-ZEPS = 2.E-2
+ZEPS = 4.E-2
ZXH = PF * PX**2.0
IF (ZXH.LT.(1-ZEPS)) THEN
CALL HYPSER(PA,PB,PC,-ZXH,PHYPGEO)
diff --git a/src/MNH/ibm_0Dint.f90 b/src/MNH/ibm_0Dint.f90
new file mode 100644
index 0000000000000000000000000000000000000000..67fa85cf88f7c1861cdcc33b10ff35f7766bbe11
--- /dev/null
+++ b/src/MNH/ibm_0Dint.f90
@@ -0,0 +1,219 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #####################
+MODULE MODI_IBM_0DINT
+ ! #####################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_0DINT(PDELTAI,PVALUEI,HBOUND1,HBOUND2,PBOUNDI,PIBM_VISC,PIBM_DIVK) RESULT(PVALUEB)
+ !
+ REAL , INTENT(IN) :: PDELTAI
+ REAL , INTENT(IN) :: PBOUNDI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND1
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND2
+ REAL , INTENT(IN) :: PIBM_VISC
+ REAL , INTENT(IN) :: PIBM_DIVK
+ REAL :: PVALUEB
+ !
+ END FUNCTION IBM_0DINT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_0DINT
+!
+! ###########################################################################
+FUNCTION IBM_0DINT(PDELTAI,PVALUEI,HBOUND1,HBOUND2,PBOUNDI,PIBM_VISC,PIBM_DIVK) RESULT(PVALUEB)
+ ! ###########################################################################
+ !
+ !**** *IBM_INTER_0DINT* - Computation of the variable value at the interface
+ !
+ ! PURPOSE
+ ! -------
+ ! Depending on the boundary condition type (Dirichlet, Neumann, Robin)
+ ! the variable value PVALUEB is affected using the values at images point
+ ! PVALUEI.
+ !
+ !
+ ! METHOD
+ ! ------
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_CST
+ USE MODD_CTURB
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL , INTENT(IN) :: PDELTAI
+ REAL , INTENT(IN) :: PBOUNDI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND1
+ CHARACTER(LEN=3) , INTENT(IN) :: HBOUND2
+ REAL , INTENT(IN) :: PIBM_VISC
+ REAL , INTENT(IN) :: PIBM_DIVK
+ REAL :: PVALUEB
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ REAL :: Z_ROB, Z_PVAL0, Z_DVAL0
+ REAL :: Z_VD, Z_RD, Z_RE, Z_RD1, Z_RD2
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ ! Switch for Neuman,Dirichlet or Robin conditions
+ !
+ Z_ROB = 0.
+ !
+ IF (HBOUND1=='DIR') THEN
+ Z_ROB = 1.0
+ ENDIF
+ IF (HBOUND1=='NEU') THEN
+ Z_ROB = 0.0
+ ENDIF
+ IF (HBOUND1=='ROB') THEN
+ Z_ROB = 0.5
+ ENDIF
+ !
+ ! Computation of value at the interface
+ !
+ Z_PVAL0 = 0.
+ Z_DVAL0 = 0.
+ !
+ IF (HBOUND2=='CST') THEN
+ Z_PVAL0 = PBOUNDI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CN3'.OR.HBOUND2=='CK3') THEN
+ Z_PVAL0 = PVALUEI(3)
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CN1'.OR.HBOUND2=='CK1') THEN
+ Z_PVAL0 = PVALUEI(1)
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CN2'.OR.HBOUND2=='CK2') THEN
+ Z_PVAL0 = PVALUEI(2)
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='LN3'.OR.HBOUND2=='LK3') THEN
+ Z_PVAL0 = (2.*PVALUEI(3)-1.*PVALUEI(1))
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='LN1'.OR.HBOUND2=='LK1') THEN
+ Z_PVAL0 = (2.*PVALUEI(1)-1.*PVALUEI(2))
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='LN2'.OR.HBOUND2=='LK2') THEN
+ Z_PVAL0 = (1./4.)*(9.*PVALUEI(3)-6.*PVALUEI(1)+1.*PVALUEI(2))
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='WN3'.OR.HBOUND2=='WK3') THEN
+ Z_VD = PVALUEI(3)
+ Z_RE = XIBM_EPSI
+ IF (ABS(Z_VD).GT.XIBM_EPSI) Z_RE = Z_VD/ABS(Z_VD)
+ Z_RD1 = 1./XIBM_RUG/9.8
+ Z_RD2 = PIBM_VISC/XIBM_VISC
+ Z_RD = MIN(Z_RD1,Z_RD2)
+ Z_RD = MAX(XIBM_EPSI,Z_RD)
+ Z_PVAL0 = Z_RE/XKARMAN*PIBM_VISC*log(1.+9.8*PDELTAI*XKARMAN*Z_RD*(1.-exp(-PDELTAI*XKARMAN*Z_RD/20.)))
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ IF (Z_PVAL0*Z_VD.LT.XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='WN1'.OR.HBOUND2=='WK1') THEN
+ Z_VD = PVALUEI(1)
+ Z_RE = XIBM_EPSI
+ IF (ABS(Z_VD).GT.XIBM_EPSI) Z_RE = Z_VD/ABS(Z_VD)
+ Z_RD1 = 1./XIBM_RUG/9.8
+ Z_RD2 = PIBM_VISC/XIBM_VISC
+ Z_RD = MIN(Z_RD1,Z_RD2)
+ Z_RD = MAX(XIBM_EPSI,Z_RD)
+ Z_PVAL0 = Z_RE/XKARMAN*PIBM_VISC*log(1.+9.8*PDELTAI*XKARMAN*Z_RD*(1.-exp(-PDELTAI*XKARMAN*Z_RD/20.)))
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ IF (Z_PVAL0*Z_VD.LT.XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='WN2'.OR.HBOUND2=='WK2') THEN
+ Z_VD = PVALUEI(2)
+ Z_RE = XIBM_EPSI
+ IF (ABS(Z_VD).GT.XIBM_EPSI) Z_RE = Z_VD/ABS(Z_VD)
+ Z_RD1 = 1./XIBM_RUG/9.8
+ Z_RD2 = PIBM_VISC/XIBM_VISC
+ Z_RD = MIN(Z_RD1,Z_RD2)
+ Z_RD = MAX(XIBM_EPSI,Z_RD)
+ Z_PVAL0 = Z_RE/XKARMAN*PIBM_VISC*log(1.+9.8*PDELTAI*XKARMAN*Z_RD*(1.-exp(-PDELTAI*XKARMAN*Z_RD/20.)))
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ IF (Z_PVAL0*Z_VD.LT.XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ Z_DVAL0 = 0.
+ ENDIF
+ !
+ IF (HBOUND2=='CK3'.OR.HBOUND2=='CK1'.OR.HBOUND2=='CK2'.OR.&
+ HBOUND2=='LK3'.OR.HBOUND2=='LK1'.OR.HBOUND2=='LK2'.OR.&
+ HBOUND2=='WK3'.OR.HBOUND2=='WK1'.OR.HBOUND2=='WK2') THEN
+ Z_VD = Z_PVAL0
+ Z_PVAL0 = Z_PVAL0*(1.-PIBM_DIVK)
+ IF (Z_PVAL0*Z_VD.LT.-XIBM_EPSI**2.) Z_PVAL0=XIBM_EPSI
+ IF (Z_PVAL0*Z_VD.GT.Z_VD**2.) Z_PVAL0=Z_VD
+ ENDIF
+ !
+ PVALUEB = Z_ROB*Z_PVAL0+(1.-Z_ROB)*(-PDELTAI*Z_DVAL0/2.+PVALUEI(3))
+ !
+ RETURN
+ !
+END FUNCTION IBM_0DINT
diff --git a/src/MNH/ibm_1Dint.f90 b/src/MNH/ibm_1Dint.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7c986e9ef375612292014cc9c3083b91f314972a
--- /dev/null
+++ b/src/MNH/ibm_1Dint.f90
@@ -0,0 +1,193 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #####################
+MODULE MODI_IBM_1DINT
+ ! #####################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_1DINT(PLOCATI,PVALUEI,HINTERP) RESULT(PVALUEG)
+ !
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL :: PVALUEG
+ !
+ END FUNCTION IBM_1DINT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_1DINT
+!
+! ###########################################################
+FUNCTION IBM_1DINT(PLOCATI,PVALUEI,HINTERP) RESULT(PVALUEG)
+ ! ###########################################################
+ !
+ !!**** *IBM_INTER_1DINT* - Classical Lagrange interpolation 1D
+ !!
+ !! PURPOSE
+ !! -------
+ ! This function interpolates the 1D fields from the image(s) point
+ ! to the mirror point associated to each ghost nodes. The interpolation
+ ! weighting is based on the Lagrange polynomials between the image point
+ ! F(X,Y,Z) and each N selected nearest nodes F(Xi,Yi,Zi). The number of
+ ! nodes is depending on the interpolation order. The direction of the
+ ! interpolation is normal to the interface.
+ !
+ !!
+ !! METHOD
+ !! ------
+ !!
+ ! F(X,Y,Z)= sum(i=1toN)sum(j=1toN)sum(k=1toN)[[[Li(x)Lj(y)Lz(k)F(Xi,Yi,Zi)]]]
+ ! where La(B)=prod(l=1toN,l/=a) (B-Bl)/(Bb-Bl)
+ !
+ ! Three interpolations type is implemented. Each type uses respectively
+ ! MIRROR : computation of the mirror of the ghost
+ ! IMAGE1 : one image point with an imposed distance to the interface (1.V_cell**1/3)
+ ! IMAGE2 : a secund image with an imposed distance to the interface (2.V_cell**1/3)
+ !
+ !! INDEX
+ !! -----
+ !!
+ ! PLOCATI(1) (resp. PVALUEI(1)) is the image 1 location (resp. value) === CL0 ===
+ ! PLOCATI(2) (resp. PVALUEI(2)) is the image 2 location (resp. value) === CL1 ===
+ ! PLOCATI(3) (resp. PVALUEI(3)) is the mirror location (resp. value) === CL2 ===
+ ! PVALUEI(4) is the bound value
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !!
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL :: PVALUEG
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ REAL :: Z_PLAG_G0,Z_PLAG_I1,Z_PLAG_I2
+ REAL :: Z_CINT_G0,Z_CINT_I1,Z_CINT_I2
+ REAL :: Z_CINT_GG,Z_CINT_II
+ REAL :: Z_PLAG_GG,Z_PLAG_II
+ REAL :: ZVALUEMIN,ZVALUEMAX
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ IF (HINTERP=='CL3') THEN
+ !
+ ! Lagrange polynomials
+ Z_PLAG_G0 = (-PLOCATI(3)-PLOCATI(1))/(0. -PLOCATI(1))*&
+ (-PLOCATI(3)-PLOCATI(2))/(0. -PLOCATI(2))
+ Z_PLAG_I1 = (-PLOCATI(3)-0. )/(+PLOCATI(1)- 0.)*&
+ (-PLOCATI(3)-PLOCATI(2))/(+PLOCATI(1)-PLOCATI(2))
+ Z_PLAG_I2 = (-PLOCATI(3)-0. )/(+PLOCATI(2)- 0.)*&
+ (-PLOCATI(3)-PLOCATI(1))/(+PLOCATI(2)-PLOCATI(1))
+ !
+ ! Interpolation coeffs
+ Z_CINT_G0 = Z_PLAG_G0
+ Z_CINT_I1 = Z_PLAG_I1
+ Z_CINT_I2 = Z_PLAG_I2
+ !
+ ! Mirror value computation
+ PVALUEG = Z_CINT_G0*PVALUEI(4)+Z_CINT_I1*PVALUEI(1)+Z_CINT_I2*PVALUEI(2)
+ !
+ ENDIF
+ !
+ IF (HINTERP=='CL2') THEN
+ !
+ ! Lagrange polynomials
+ Z_PLAG_G0 = (PLOCATI(3)-PLOCATI(1))/(-PLOCATI(3)-PLOCATI(1))*&
+ (PLOCATI(3)-PLOCATI(2))/(-PLOCATI(3)-PLOCATI(2))
+ Z_PLAG_I1 = (PLOCATI(3)+PLOCATI(3))/(+PLOCATI(1)+PLOCATI(3))*&
+ (PLOCATI(3)-PLOCATI(2))/(+PLOCATI(1)-PLOCATI(2))
+ Z_PLAG_I2 = (PLOCATI(3)+PLOCATI(3))/(+PLOCATI(2)+PLOCATI(3))*&
+ (PLOCATI(3)-PLOCATI(1))/(+PLOCATI(2)-PLOCATI(1))
+ !
+ ! Interpolation coeffs
+ Z_CINT_G0 = 1./(1.+Z_PLAG_G0)*(2.*Z_PLAG_G0)
+ Z_CINT_I1 = 1./(1.+Z_PLAG_G0)*(1.*Z_PLAG_I1)
+ Z_CINT_I2 = 1./(1.+Z_PLAG_G0)*(1.*Z_PLAG_I2)
+ !
+ ! Mirror value computation
+ PVALUEG = Z_CINT_G0*PVALUEI(4)+Z_CINT_I1*PVALUEI(1)+Z_CINT_I2*PVALUEI(2)
+ !
+ ! Value limitation
+ ZVALUEMIN = +XIBM_IEPS
+ ZVALUEMAX = -XIBM_IEPS
+ ZVALUEMIN = MIN(ZVALUEMIN,PVALUEI(1))
+ ZVALUEMIN = MIN(ZVALUEMIN,PVALUEI(2))
+ ZVALUEMIN = MIN(ZVALUEMIN,PVALUEI(4))
+ ZVALUEMAX = MAX(ZVALUEMAX,PVALUEI(1))
+ ZVALUEMAX = MAX(ZVALUEMAX,PVALUEI(2))
+ ZVALUEMAX = MAX(ZVALUEMAX,PVALUEI(4))
+ PVALUEG = MAX(PVALUEG,ZVALUEMIN)
+ PVALUEG = MIN(PVALUEG,ZVALUEMAX)
+ !
+ ENDIF
+ !
+ IF (HINTERP=='CL1') THEN
+ !
+ ! Lagrange polynomials
+ Z_PLAG_GG = (PLOCATI(3)-PLOCATI(1))/(-PLOCATI(3)-PLOCATI(1))
+ Z_PLAG_II = (PLOCATI(3)+PLOCATI(3))/(+PLOCATI(3)+PLOCATI(1))
+ !
+ ! Interpolation coeffs
+ Z_CINT_GG = 1./(1.+Z_PLAG_GG)*(2.*Z_PLAG_GG)
+ Z_CINT_II = 1./(1.+Z_PLAG_GG)*(1.*Z_PLAG_II)
+ !
+ ! Mirror value computation
+ PVALUEG = Z_CINT_GG*PVALUEI(4)+Z_CINT_II*PVALUEI(1)
+ !
+ ENDIF
+ !
+ IF (HINTERP=='CL0') THEN
+ !
+ PVALUEG = PVALUEI(3)
+ !
+ ENDIF
+ !
+ RETURN
+ !
+END FUNCTION IBM_1DINT
diff --git a/src/MNH/ibm_3Dint.f90 b/src/MNH/ibm_3Dint.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f055a64bae3cccff938f8ea009867a4f058b4ba2
--- /dev/null
+++ b/src/MNH/ibm_3Dint.f90
@@ -0,0 +1,322 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #####################
+MODULE MODI_IBM_3DINT
+ ! #####################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_3DINT(KTYPUVW,PVALUEI,PLOCATI,PTESTG0,PLOCAT1,PVALUE1,PLOCAT2,HINTERP,PRADIUS,PPOWERS) RESULT(PVALUE2)
+ !
+ INTEGER :: KTYPUVW
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PTESTG0
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PLOCAT1
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUE1
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCAT2
+ REAL :: PVALUE2
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL , INTENT(IN) :: PRADIUS
+ REAL , INTENT(IN) :: PPOWERS
+ !
+ END FUNCTION IBM_3DINT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_3DINT
+!
+! ###################################################################################################################
+FUNCTION IBM_3DINT(KTYPUVW,PVALUEI,PLOCATI,PTESTG0,PLOCAT1,PVALUE1,PLOCAT2,HINTERP,PRADIUS,PPOWERS) RESULT(PVALUE2)
+ ! ###################################################################################################################
+ !
+ !**** ===IBM_INTER_IDW=== inverse distance weighting interpolation
+ !
+ ! PURPOSE
+ ! -------
+ ! This function interpolates the 3D fields from the initial grid
+ ! to the image point associated to each ghost nodes. The interpolation
+ ! weighting is based on the inverse of the (square of) the interpolation distance
+ ! between the image point F(X,Y,Z) and each N selected nearest nodes F(Xi,Yi,Zi).
+ !
+ ! METHOD
+ ! ------
+ !
+ ! F(X,Y,Z)= sum(i=1toN)[|1/Di|F(Xi,Yi,Zi)] / sum(i=1toN)[|1/Di|]
+ ! Di as a power of the distance interpolation
+ !
+ !**** ===IBM_INTER_MDW=== modified inverse distance weighting interpolation
+ !
+ ! PURPOSE
+ ! -------
+ ! This function interpolates the 3D fields from the initial grid
+ ! to the image point associated to each ghost nodes. The interpolation
+ ! weighting is based on the Franke formulation (2004) between the image point
+ ! F(X,Y,Z) and each N selected nearest nodes F(Xi,Yi,Zi). The number of
+ ! nodes is depending on the interpolation order.
+ !
+ ! METHOD
+ ! ------
+ !
+ ! F(X,Y,Z)= sum(i=1toN)[|1/Di|F(Xi,Yi,Zi)] / sum(i=1toN)[|1/Di|]
+ ! Di according to :
+ ! "Scattered Data: tests of some methods."
+ ! Franke R., Mathematics of computation, 2004
+ !
+ !**** ===IBM_INTER_CLI=== classical Lagrange interpolation
+ !
+ ! PURPOSE
+ ! -------
+ ! This function interpolates the 3D fields from the initial grid
+ ! to the image point associated to each ghost nodes. The interpolation
+ ! weighting is based on the trilinear interpolation via Lagrange polynomials
+ !
+ ! METHOD
+ ! ------
+ !
+ ! F(X,Y,Z)= sum(i=1toN)[|Li|F(Xi,Yi,Zi)]
+ ! Li = prod[(x-xj)(xi-xj)] (xi/=xj)
+ !
+ ! INDEX DEFINITION
+ ! ----------------
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ INTEGER :: KTYPUVW
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUEI
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:) , INTENT(IN) :: PTESTG0
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PLOCAT1
+ REAL, DIMENSION(:) , INTENT(IN) :: PVALUE1
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCAT2
+ REAL :: PVALUE2
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL , INTENT(IN) :: PRADIUS
+ REAL , INTENT(IN) :: PPOWERS
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ INTEGER :: JM,JN,JMM ! loop index
+ REAL, DIMENSION(:), ALLOCATABLE :: Z_WEIGHT0 ! interpolation weighting array
+ REAL :: Z_WEIGHT1,Z_WEIGHT2,Z_WEIGHT3 ! interpolation weighting scalar
+ REAL :: Z_LENGHTX,Z_LENGHTY,Z_LENGHTZ ! interpolation distance
+ REAL :: Z_LENGHTM,Z_VOLUME,Z_VALUE3 ! interpolation module
+ REAL :: Z_ORDINT, Z_TESTSB,Z_VALUE2 ! interpolation radius
+ CHARACTER(LEN=3) :: Y_INTERP,Y_INTERP2
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ALLOCATE(Z_WEIGHT0(10))
+ Z_WEIGHT0(:) = 0.
+ Z_WEIGHT1 = 0.
+ Z_WEIGHT2 = 0.
+ Z_WEIGHT3 = 0.
+ Z_VOLUME = 0.
+ Z_VALUE2 = 0.
+ Z_VALUE3 = 0.
+ JN = 0
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ ! Switch interface distance dependence
+ !
+ Z_TESTSB = 1.
+ DO JN=1,8
+ Z_TESTSB = min(Z_TESTSB,PTESTG0(JN))
+ ENDDO
+ !
+ Y_INTERP = HINTERP
+ Y_INTERP2 = 'CLI'
+ IF (HINTERP=='LAI') THEN
+ IF (Z_TESTSB.lt.+XIBM_EPSI) THEN
+ Y_INTERP = 'IDW'
+ ELSE
+ Y_INTERP = 'CLI'
+ ENDIF
+ ENDIF
+ IF (HINTERP=='LAM') THEN
+ IF (Z_TESTSB.lt.+XIBM_EPSI) THEN
+ Y_INTERP = 'MDW'
+ ELSE
+ Y_INTERP = 'CLI'
+ ENDIF
+ ENDIF
+ !
+ ! === Trilinear Lagrange interpolation ===
+ !
+ IF (Y_INTERP=='CLI') THEN
+ !
+ DO JM=1,8
+ JN=8-JM+1
+ IF ((ABS((PLOCAT1(JM,1)-PLOCAT1(JN,1))).GT.XIBM_EPSI).AND.&
+ (ABS((PLOCAT1(JM,2)-PLOCAT1(JN,2))).GT.XIBM_EPSI).AND.&
+ (ABS((PLOCAT1(JM,3)-PLOCAT1(JN,3))).GT.XIBM_EPSI)) THEN
+ !
+ Z_WEIGHT0(JM)=(PLOCAT2(1)-PLOCAT1(JN,1))/(PLOCAT1(JM,1)-PLOCAT1(JN,1))*&
+ (PLOCAT2(2)-PLOCAT1(JN,2))/(PLOCAT1(JM,2)-PLOCAT1(JN,2))*&
+ (PLOCAT2(3)-PLOCAT1(JN,3))/(PLOCAT1(JM,3)-PLOCAT1(JN,3))
+ !
+ ELSE
+ !
+ Z_VALUE3 = 1.
+ Z_WEIGHT0(JM) = +XIBM_EPSI
+ !
+ ENDIF
+ ENDDO
+ !
+ IF (Z_VALUE3<XIBM_EPSI) THEN
+ !
+ DO JM=1,8
+ Z_VALUE2 = Z_VALUE2 + Z_WEIGHT0(JM)
+ ENDDO
+ IF (ABS(Z_VALUE2-1.)>0.1) THEN
+ Z_WEIGHT0(:) = 1./8.
+ ENDIF
+ !
+ PVALUE2 = 0.
+ DO JM=1,8
+ PVALUE2 = PVALUE2 + PVALUE1(JM)*Z_WEIGHT0(JM)
+ ENDDO
+ !
+ ELSE
+ !
+ Y_INTERP2 = 'IDW'
+ PVALUE2 = 0.
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ IF (Y_INTERP2 == 'IDW') Y_INTERP = 'IDW'
+ !
+ ! === Inverse distance weighting interpolation (Modified or classical) ===
+ !
+ IF (Y_INTERP=='IDW'.or.Y_INTERP=='MDW') THEN
+ !
+ Z_VOLUME = ABS(PLOCAT1(1,1)-PLOCAT1(8,1))*&
+ ABS(PLOCAT1(1,2)-PLOCAT1(8,2))*&
+ ABS(PLOCAT1(1,3)-PLOCAT1(8,3))
+ !
+ JMM = 8
+ DO JM=1,JMM
+ !
+ IF (JM<=8) THEN
+ Z_LENGHTX = (PLOCAT2(1)-PLOCAT1(JM,1))
+ Z_LENGHTY = (PLOCAT2(2)-PLOCAT1(JM,2))
+ Z_LENGHTZ = (PLOCAT2(3)-PLOCAT1(JM,3))
+ ELSE
+ Z_LENGHTX = (PLOCAT2(1)-PLOCATI(1))
+ Z_LENGHTY = (PLOCAT2(2)-PLOCATI(2))
+ Z_LENGHTZ = (PLOCAT2(3)-PLOCATI(3))
+ ENDIF
+ Z_LENGHTM = (Z_LENGHTX**2.+Z_LENGHTY**2.+Z_LENGHTZ**2.)**0.5
+ !
+ Z_LENGHTM = MAX(Z_LENGHTM,0.0001*Z_VOLUME**(1./3.))
+ IF ((Z_LENGHTM.lt.(0.01*Z_VOLUME**(1./3.))).AND.(PTESTG0(JM).GT.0.5)) THEN
+ Z_WEIGHT1 = 2.*XIBM_IEPS
+ Z_WEIGHT3 = 1.
+ JN=JM
+ ELSE
+ Z_WEIGHT1 = 0.
+ IF (Z_LENGHTM.lt.PRADIUS*Z_VOLUME**(1./3.)) THEN
+ !
+ IF (JM<=8.and.Y_INTERP=='IDW') Z_WEIGHT1 = PTESTG0(JM)*(1./Z_LENGHTM)**PPOWERS
+ IF (JM==9.and.Y_INTERP=='IDW') Z_WEIGHT1 = (1./Z_LENGHTM)**PPOWERS
+ IF (JM<=8.and.Y_INTERP=='MDW') Z_WEIGHT1 = PTESTG0(JM)*((PRADIUS*Z_VOLUME**(1./3.)-Z_LENGHTM)/&
+ (PRADIUS*Z_VOLUME**(1./3.)*Z_LENGHTM))**PPOWERS
+ IF (JM==9.and.Y_INTERP=='MDW') Z_WEIGHT1 = ((PRADIUS*Z_VOLUME**(1./3.)-Z_LENGHTM)/&
+ (PRADIUS*Z_VOLUME**(1./3.)*Z_LENGHTM))**PPOWERS
+ ENDIF
+ ENDIF
+ !
+ Z_WEIGHT2 = Z_WEIGHT2+Z_WEIGHT1
+ Z_WEIGHT0(JM)=Z_WEIGHT1
+ !
+ ENDDO
+ !
+ Z_WEIGHT0(10)=Z_WEIGHT2
+ !
+ IF (Z_WEIGHT3.gt.XIBM_EPSI) THEN
+ Z_WEIGHT0(:)=0.
+ Z_WEIGHT0(JN)=1.
+ Z_WEIGHT0(10)=1.
+ ENDIF
+ !
+ IF (ABS(Z_WEIGHT0(10)).GT.XIBM_EPSI) THEN
+ !
+ PVALUE2 = 0.
+ DO JM=1,8
+ PVALUE2 = PVALUE2 + PVALUE1(JM)*Z_WEIGHT0(JM)/Z_WEIGHT0(10)
+ ENDDO
+ !
+ ELSE
+ !
+ PVALUE2 = 0.
+ DO JM=1,8
+ PVALUE2 = PVALUE2 + PVALUE1(JM)*(1./8.)
+ ENDDO
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ DEALLOCATE(Z_WEIGHT0)
+ !
+ RETURN
+ !
+END FUNCTION IBM_3DINT
diff --git a/src/MNH/ibm_affectp.f90 b/src/MNH/ibm_affectp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b0c998744f7971f296e01b421b8f959ed890136d
--- /dev/null
+++ b/src/MNH/ibm_affectp.f90
@@ -0,0 +1,354 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_AFFECTP
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_AFFECTP(PVAR,KIBM_LAYER,PRADIUS,PPOWERS,&
+ HIBM_MODE_INTE1,HIBM_MODE_INTE3,&
+ HIBM_TYPE_BOUND,HIBM_MODE_BOUND,&
+ HIBM_FORC_BOUND,PIBM_FORC_BOUND,PXMU,PDIV)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PVAR
+ INTEGER , INTENT(IN) :: KIBM_LAYER
+ REAL , INTENT(IN) :: PRADIUS
+ REAL , INTENT(IN) :: PPOWERS
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE1
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE3
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_TYPE_BOUND
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_BOUND
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_FORC_BOUND
+ REAL , INTENT(IN) :: PIBM_FORC_BOUND
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PDIV
+ !
+ END SUBROUTINE IBM_AFFECTP
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_AFFECTP
+!
+! ########################################################
+SUBROUTINE IBM_AFFECTP(PVAR,KIBM_LAYER,PRADIUS,PPOWERS,&
+ HIBM_MODE_INTE1,HIBM_MODE_INTE3,&
+ HIBM_TYPE_BOUND,HIBM_MODE_BOUND,&
+ HIBM_FORC_BOUND,PIBM_FORC_BOUND,PXMU,PDIV)
+ ! ########################################################
+ !
+ !
+ !**** IBM_AFFECTP computes the variable PVAR on desired ghost points :
+ ! - the P type of the ghost/image
+ ! - the 3D interpolation mode (HIBM_MODE_INTE3)
+ ! - the 1D interpolation mode (HIBM_MODE_INTE1)
+ ! - the boundary condition (HIBM_TYPE_BOUND)
+ ! - the symmetry character (HIBM_MODE_BOUND)
+ !
+ !
+ ! PURPOSE
+ ! -------
+ !**** Ghosts (resp. Images) locations are stored in KIBM_STOR_GHOST (resp. KIBM_STOR_IMAGE).
+ ! Solutions are computed in regard of the symmetry character of the solution:
+ ! HIBM_MODE_BOUND='SYME' (Symmetrical)
+ ! HIBM_MODE_BOUND='ASYM' (Anti-symmetrical)
+ ! The ghost value is depending on the variable value at the interface:
+ ! HIBM_TYPE_BOUND="NULL" (00 value)
+ ! HIBM_TYPE_BOUND="FREE" (I1 value)
+ ! HIBM_TYPE_BOUND="LINE" (linear evolution, only IMAGE2 type)
+ ! HIBM_TYPE_BOUND="LOGA" (logarithmic evol, only IMAGE2 type)
+ ! Three 3D interpolations exists HIBM_MODE_INTE3 = "IDW" (Inverse Distance Weighting)
+ ! HIBM_MODE_INTE3 = "MDW" (Modified Distance Weighting)
+ ! HIBM_MODE_INTE3 = "CLI" (Trilinear Lagrange interp. )
+ ! Three 1D interpolations exists HIBM_MODE_INTE1 = "CL1" (Lagrange Polynomials - 1 points - MIRROR)
+ ! HIBM_MODE_INTE1 = "CL2" (Lagrange Polynomials - 2 points - IMAGE1)
+ ! HIBM_MODE_INTE1 = "CL3" (Lagrange Polynomials - 3 points - IMAGE2)
+
+ ! METHOD
+ ! ------
+ ! - loop on ghosts
+ ! - functions storage
+ ! - computations of the location of the corners cell containing MIRROR/IMAGE1/IMAGE2
+ ! - 3D interpolation (IDW, MDW, CLI) to obtain the MIRROR/IMAGE1/IMAGE2 values
+ ! - computation of the value at the interface
+ ! - 1D interpolation (CLI1,CLI2,CLI3) to obtain the GHOSTS values
+ ! - Affectation
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XEXNREF
+ USE MODI_IBM_VALUECORN
+ USE MODI_IBM_LOCATCORN
+ USE MODI_IBM_3DINT
+ USE MODI_IBM_1DINT
+ USE MODI_IBM_0DINT
+ USE MODD_CST
+ USE MODD_CTURB
+ USE MODD_RADIATIONS_n
+ USE MODD_DYN_n
+ USE MODD_FIELD_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PVAR ! interpolated variable
+ INTEGER , INTENT(IN) :: KIBM_LAYER ! layer number
+ REAL , INTENT(IN) :: PRADIUS ! Radius for MDW
+ REAL , INTENT(IN) :: PPOWERS ! Power for IDW/MDW
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE1 ! interpolation 1D (normal)
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_INTE3 ! interpolation 3D (isotropic)
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_TYPE_BOUND ! imposed variable at the interface
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_MODE_BOUND ! symm.-antisymm. solution
+ CHARACTER(LEN=3) , INTENT(IN) :: HIBM_FORC_BOUND ! Neu,Dir,Rob CL
+ REAL , INTENT(IN) :: PIBM_FORC_BOUND
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PDIV
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL,JM,JMM,JN,JNN,JI2,JJ2,JK2 ! loop index
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: I_INDEX_CORN ! reference corner index
+ INTEGER :: I_GHOST_NUMB ! ghost number per layer
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_LOCAT_CORN,Z_LOCAT_IMAG ! corners coordinates
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_TESTS_CORN ! interface distance dependence
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_VALUE_CORN ! value variables at corners
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_VALUE_IMAG ! value at mirror/image1/image2
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_LOCAT_BOUN,Z_LOCAT_GHOS ! location of bound and ghost
+ CHARACTER(LEN=3) :: Y_TYPE_BOUND ! imposed variable at the interface
+ CHARACTER(LEN=3) :: Y_MODE_BOUND ! symm.-antisymm. solution
+ REAL :: Z_VALUE_GHOS,Z_DELTA_IMAG
+ REAL :: Z_FORC_BOUND,ZIBM_VISC,ZIBM_DIVK,ZSURF
+ REAL :: ZIBM_HALO
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ ALLOCATE(I_INDEX_CORN(3))
+ ALLOCATE(Z_LOCAT_CORN(8,3))
+ ALLOCATE(Z_VALUE_CORN(8))
+ ALLOCATE(Z_TESTS_CORN(8))
+ ALLOCATE(Z_LOCAT_IMAG(3,3))
+ ALLOCATE(Z_VALUE_IMAG(4))
+ ALLOCATE(Z_LOCAT_BOUN(3))
+ ALLOCATE(Z_LOCAT_GHOS(3))
+ !
+ !----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ I_INDEX_CORN(:) = 0
+ Z_LOCAT_CORN(:,:)= 0.
+ Z_VALUE_CORN(:) = 0.
+ Z_TESTS_CORN(:) = 0.
+ Z_LOCAT_IMAG(:,:)= 0.
+ Z_VALUE_IMAG(:) = 0.
+ Z_LOCAT_GHOS(:) = 0.
+ Z_LOCAT_BOUN(:) = 0.
+ Y_TYPE_BOUND = HIBM_TYPE_BOUND
+ Y_MODE_BOUND = HIBM_MODE_BOUND
+ Z_FORC_BOUND = PIBM_FORC_BOUND
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ DO JMM=1,KIBM_LAYER
+ !
+ ! searching number of ghosts
+ JM = size(NIBM_GHOST_P,1)
+ JI = 0
+ JJ = 0
+ JK = 0
+ DO WHILE ((JI==0.and.JJ==0.and.JK==0).and.JM>0)
+ JI = NIBM_GHOST_P(JM,JMM,1,1)
+ JJ = NIBM_GHOST_P(JM,JMM,1,2)
+ JK = NIBM_GHOST_P(JM,JMM,1,3)
+ IF (JI==0.and.JJ==0.and.JK==0) JM = JM - 1
+ ENDDO
+ I_GHOST_NUMB = JM
+ !
+ ! Loop on each P Ghosts
+ IF (I_GHOST_NUMB<=0) GO TO 666
+ DO JM = 1,I_GHOST_NUMB
+ !
+ ! ghost index/ls
+ JI = NIBM_GHOST_P(JM,JMM,1,1)
+ JJ = NIBM_GHOST_P(JM,JMM,1,2)
+ JK = NIBM_GHOST_P(JM,JMM,1,3)
+ IF (JI==0.or.JJ==0.or.JK==0) GO TO 777
+ Z_LOCAT_GHOS(:) = XIBM_GHOST_P(JM,JMM,1,:)
+ Z_LOCAT_BOUN(:) = 2.0*XIBM_IMAGE_P(JM,JMM,1,1,:)-1.0*XIBM_IMAGE_P(JM,JMM,1,2,:)
+ ZIBM_HALO=1.
+ !
+ ! === IMAGE1/IMAGE2 computation ===
+ !
+ DO JN = 1,3
+ !
+ Z_LOCAT_IMAG(JN,:)= XIBM_IMAGE_P(JM,JMM,1 ,JN,:)
+ Z_DELTA_IMAG = ((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))**0.5
+ I_INDEX_CORN(:) = NIBM_IMAGE_P(JM,JMM,1,1,JN,:)
+ IF (I_INDEX_CORN(1)==0.AND.JN==2) ZIBM_HALO=0.
+ IF (I_INDEX_CORN(2)==0.AND.JN==2) ZIBM_HALO=0.
+ Z_LOCAT_CORN(:,:) = IBM_LOCATCORN(I_INDEX_CORN,1)
+ Z_TESTS_CORN(:) = XIBM_TESTI_P(JM,JMM,1,1,JN,:)
+ Z_VALUE_CORN(:) = IBM_VALUECORN(PVAR,I_INDEX_CORN)
+ Z_VALUE_IMAG(JN) = IBM_3DINT(JN,Z_VALUE_IMAG,Z_LOCAT_BOUN,Z_TESTS_CORN,&
+ Z_LOCAT_CORN,Z_VALUE_CORN,Z_LOCAT_IMAG(JN,:),&
+ HIBM_MODE_INTE3,PRADIUS,PPOWERS)
+ !
+ ENDDO
+ !
+ ZIBM_VISC = PXMU(JI,JJ,JK)
+ ZIBM_DIVK = PDIV(JI,JJ,JK)
+ !
+ JN = 4
+ Z_VALUE_IMAG(JN) = IBM_0DINT(Z_DELTA_IMAG,Z_VALUE_IMAG,HIBM_TYPE_BOUND,HIBM_FORC_BOUND,Z_FORC_BOUND,ZIBM_VISC,ZIBM_DIVK)
+ !
+ ! === GHOST computation ===
+ !
+ ! functions storage
+ Z_LOCAT_IMAG(1,3) = ((XIBM_GHOST_P(JM,JMM,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_GHOST_P(JM,JMM,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_GHOST_P(JM,JMM,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+
+ IF ((Z_LOCAT_IMAG(1,3)>Z_DELTA_IMAG).AND.ZIBM_HALO>0.5) THEN
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_P(JM,JMM,1,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_P(JM,JMM,1,2,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,2,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,2,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ ELSE
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_P(JM,JMM,1,3,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,3,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,3,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_P(JM,JMM,1,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_P(JM,JMM,1,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_VALUE_IMAG(2) = Z_VALUE_IMAG(1)
+ Z_VALUE_IMAG(1) = Z_VALUE_IMAG(3)
+ ENDIF
+ !
+ Z_VALUE_GHOS = IBM_1DINT(Z_LOCAT_IMAG(1,:),Z_VALUE_IMAG,HIBM_MODE_INTE1)
+ !
+ JN = 3
+ I_INDEX_CORN(:) = NIBM_IMAGE_P(JM,JMM,1,1,JN,:)
+ Z_VALUE_CORN(:) = IBM_VALUECORN(XIBM_LS(:,:,:,1),I_INDEX_CORN)
+ Z_LOCAT_CORN(:,:) = IBM_LOCATCORN(I_INDEX_CORN,1)
+ DO JL=1,8
+ IF (JL==1) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==2) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==3) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==4) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)
+ ENDIF
+ IF (JL==5) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ IF (JL==6) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ IF (JL==7) THEN
+ JI2 = I_INDEX_CORN(1)
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ IF (JL==8) THEN
+ JI2 = I_INDEX_CORN(1)+1
+ JJ2 = I_INDEX_CORN(2)+1
+ JK2 = I_INDEX_CORN(3)+1
+ ENDIF
+ ZSURF = ((Z_LOCAT_CORN(JL,1)-Z_LOCAT_BOUN(1))**2.+ &
+ (Z_LOCAT_CORN(JL,2)-Z_LOCAT_BOUN(2))**2.+ &
+ (Z_LOCAT_CORN(JL,3)-Z_LOCAT_BOUN(3))**2.)**0.5/(Z_DELTA_IMAG/2.)
+ IF ((ZSURF<1.).AND.(Z_VALUE_CORN(JL).LT.(XIBM_EPSI)).AND.((PVAR(JI2,JJ2,JK2)-Z_VALUE_IMAG(3))*(PVAR(JI2,JJ2,JK2)- &
+ Z_VALUE_IMAG(4)).GT.XIBM_EPSI)) THEN
+ PVAR(JI2,JJ2,JK2) = 0.5*PVAR(JI2,JJ2,JK2)+0.5*(Z_VALUE_IMAG(4)-(Z_VALUE_IMAG(3)-Z_VALUE_IMAG(4))* &
+ Z_VALUE_CORN(JL)/(Z_DELTA_IMAG/2.))
+ ENDIF
+ ENDDO
+ !
+ IF (Y_MODE_BOUND=='SYM') PVAR(JI,JJ,JK) = +Z_VALUE_GHOS
+ IF (Y_MODE_BOUND=='ASY') PVAR(JI,JJ,JK) = -Z_VALUE_GHOS + 2.*Z_VALUE_IMAG(4)
+ IF (Y_MODE_BOUND=='CST') PVAR(JI,JJ,JK) = Z_VALUE_IMAG(4)
+ !
+777 CONTINUE
+ ENDDO
+
+ ENDDO
+ !
+666 CONTINUE
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(I_INDEX_CORN)
+ DEALLOCATE(Z_LOCAT_CORN)
+ DEALLOCATE(Z_VALUE_CORN)
+ DEALLOCATE(Z_LOCAT_IMAG)
+ DEALLOCATE(Z_VALUE_IMAG)
+ DEALLOCATE(Z_LOCAT_BOUN)
+ DEALLOCATE(Z_LOCAT_GHOS)
+ DEALLOCATE(Z_TESTS_CORN)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_AFFECTP
diff --git a/src/MNH/ibm_affectv.f90 b/src/MNH/ibm_affectv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1a5711e10bf7388cb89e7c965f4b657e51f52a1e
--- /dev/null
+++ b/src/MNH/ibm_affectv.f90
@@ -0,0 +1,403 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_AFFECTV
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_AFFECTV(PVAR,PVAR2,PVAR3,HVAR,KIBM_LAYER,HIBM_MODE_INTE3,&
+ HIBM_FORC_BOUNR,PRADIUS,PPOWERS,&
+ HIBM_MODE_INT1N,HIBM_TYPE_BOUNN,HIBM_MODE_BOUNN,HIBM_FORC_BOUNN,PIBM_FORC_BOUNN,&
+ HIBM_MODE_INT1T,HIBM_TYPE_BOUNT,HIBM_MODE_BOUNT,HIBM_FORC_BOUNT,PIBM_FORC_BOUNT,&
+ HIBM_MODE_INT1C,HIBM_TYPE_BOUNC,HIBM_MODE_BOUNC,HIBM_FORC_BOUNC,PIBM_FORC_BOUNC,PXMU,PDIV)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PVAR
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVAR2,PVAR3
+ CHARACTER(LEN=1) ,INTENT(IN) :: HVAR
+ INTEGER ,INTENT(IN) :: KIBM_LAYER
+ REAL ,INTENT(IN) :: PRADIUS
+ REAL ,INTENT(IN) :: PPOWERS
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNR
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INTE3
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1N
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNN
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1T
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNT
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1C
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNC
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNC
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PDIV
+ !
+ END SUBROUTINE IBM_AFFECTV
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_AFFECTV
+!
+! ########################################################
+SUBROUTINE IBM_AFFECTV(PVAR,PVAR2,PVAR3,HVAR,KIBM_LAYER,HIBM_MODE_INTE3,&
+ HIBM_FORC_BOUNR,PRADIUS,PPOWERS,&
+ HIBM_MODE_INT1N,HIBM_TYPE_BOUNN,HIBM_MODE_BOUNN,HIBM_FORC_BOUNN,PIBM_FORC_BOUNN,&
+ HIBM_MODE_INT1T,HIBM_TYPE_BOUNT,HIBM_MODE_BOUNT,HIBM_FORC_BOUNT,PIBM_FORC_BOUNT,&
+ HIBM_MODE_INT1C,HIBM_TYPE_BOUNC,HIBM_MODE_BOUNC,HIBM_FORC_BOUNC,PIBM_FORC_BOUNC,PXMU,PDIV)
+ ! ########################################################
+ !
+ !
+ !**** IBM_AFFECTV computes the variable PVAR on desired ghost points :
+ ! - the V type of the ghost/image
+ ! - the 3D interpolation mode (HIBM_MODE_INTE3)
+ ! - the 1D interpolation mode (HIBM_MODE_INTE1)
+ ! - the boundary condition (HIBM_TYPE_BOUND)
+ ! - the symmetry character (HIBM_MODE_BOUND)
+ ! - the forcing type (HIBM_FORC_BOUND)
+ ! - the forcing term (HIBM_FORC_BOUND)
+ ! Choice of forcing type is depending on
+ ! the normal, binormal, tangent vectors (N,C,T)
+ !
+ !
+ ! PURPOSE
+ ! -------
+ !**** Ghosts (resp. Images) locations are stored in KIBM_STOR_GHOST (resp. KIBM_STOR_IMAGE).
+ ! Solutions are computed in regard of the symmetry character of the solution:
+ ! HIBM_MODE_BOUND = 'SYM' (Symmetrical)
+ ! HIBM_MODE_BOUND = 'ASY' (Anti-symmetrical)
+ ! The ghost value is depending on the variable value at the interface:
+ ! HIBM_TYPE_BOUND = "CST" (constant value)
+ ! HIBM_TYPE_BOUND = "LAW" (wall models)
+ ! HIBM_TYPE_BOUND = "LIN" (linear evolution, only IMAGE2 type)
+ ! HIBM_TYPE_BOUND = "LOG" (logarithmic evol, only IMAGE2 type)
+ ! Three 3D interpolations exists HIBM_MODE_INTE3 = "IDW" (Inverse Distance Weighting)
+ ! HIBM_MODE_INTE3 = "MDW" (Modified Distance Weighting)
+ ! HIBM_MODE_INTE3 = "LAG" (Trilinear Lagrange interp. )
+ ! Three 1D interpolations exists HIBM_MODE_INTE1 = "CL0" (Lagrange Polynomials - 1 points - MIRROR)
+ ! HIBM_MODE_INTE1 = "CL1" (Lagrange Polynomials - 2 points - IMAGE1)
+ ! HIBM_MODE_INTE1 = "CL2" (Lagrange Polynomials - 3 points - IMAGE2)
+ ! METHOD
+ ! ------
+ ! - loop on ghosts
+ ! - functions storage
+ ! - computations of the location of the corners cell containing MIRROR/IMAGE1/IMAGE2
+ ! - 3D interpolation (IDW, MDW, CLI) to obtain the MIRROR/IMAGE1/IMAGE2 values
+ ! - computation of the value at the interface
+ ! - 1D interpolation (CLI1,CLI2,CLI3) to obtain the GHOSTS values
+ ! - Affectation
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_FIELD_n
+ USE MODD_PARAM_n, ONLY: CTURB
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_LBC_n
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+ !
+ ! interface
+ USE MODI_IBM_MIXINGLENGTH
+ USE MODI_IBM_VALUECORN
+ USE MODI_IBM_LOCATCORN
+ USE MODI_IBM_3DINT
+ USE MODI_IBM_1DINT
+ USE MODI_IBM_0DINT
+ USE MODI_IBM_VALUEMAT1
+ USE MODI_IBM_VALUEMAT2
+ USE MODI_SHUMAN
+ USE MODD_DYN_n
+ USE MODD_FIELD_n
+ USE MODD_CST
+ USE MODD_CTURB
+ USE MODD_RADIATIONS_n
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PVAR
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVAR2,PVAR3
+ CHARACTER(LEN=1) ,INTENT(IN) :: HVAR
+ INTEGER ,INTENT(IN) :: KIBM_LAYER
+ REAL ,INTENT(IN) :: PRADIUS
+ REAL ,INTENT(IN) :: PPOWERS
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNR
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INTE3
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1N
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNN
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNN
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1T
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNT
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNT
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_INT1C
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_TYPE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_MODE_BOUNC
+ CHARACTER(LEN=3) ,INTENT(IN) :: HIBM_FORC_BOUNC
+ REAL ,INTENT(IN) :: PIBM_FORC_BOUNC
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PXMU
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PDIV
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL,JM,JMM,JN,JNN,JH,JLL ! loop index
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: I_INDEX_CORN ! reference corner index
+ INTEGER :: I_GHOST_NUMB ! ghost number per layer
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_LOCAT_CORN,Z_LOCAT_IMAG ! corners coordinates
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_TESTS_CORN ! interface distance dependence
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_VALUE_CORN ! value variables at corners
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_VALUE_IMAG,Z_VALUE_TEMP,Z_VALUE_ZLKE ! value at mirror/image1/image2
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_LOCAT_BOUN,Z_LOCAT_GHOS,Z_TEMP_ZLKE ! location of bound and ghost
+ REAL :: Z_DELTA_IMAG,ZIBM_VISC,ZIBM_DIVK
+ CHARACTER(LEN=3),DIMENSION(:), ALLOCATABLE :: Y_TYPE_BOUND,Y_FORC_BOUND,Y_MODE_BOUND,Y_MODE_INTE1
+ REAL , DIMENSION(:) , ALLOCATABLE :: Z_FORC_BOUND,Z_VALUE_GHOS
+ REAL , DIMENSION(:,:), ALLOCATABLE :: Z_VALUE_MAT1,Z_VALUE_MAT2
+ REAL :: ZIBM_HALO
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ ALLOCATE(I_INDEX_CORN(3))
+ ALLOCATE(Z_LOCAT_CORN(8,3))
+ ALLOCATE(Z_VALUE_CORN(8))
+ ALLOCATE(Z_TESTS_CORN(8))
+ ALLOCATE(Z_LOCAT_IMAG(3,3))
+ ALLOCATE(Z_VALUE_IMAG(4,3))
+ ALLOCATE(Z_VALUE_TEMP(4,3))
+ ALLOCATE(Z_LOCAT_BOUN(3))
+ ALLOCATE(Z_LOCAT_GHOS(3))
+ ALLOCATE(Z_VALUE_GHOS(3))
+ ALLOCATE(Y_TYPE_BOUND(3),Y_FORC_BOUND(3))
+ ALLOCATE(Y_MODE_BOUND(3),Y_MODE_INTE1(3))
+ ALLOCATE(Z_FORC_BOUND(3))
+ ALLOCATE(Z_VALUE_MAT1(3,3))
+ ALLOCATE(Z_VALUE_MAT2(3,3))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ I_INDEX_CORN(:) = 0
+ Z_LOCAT_CORN(:,:) = 0.
+ Z_VALUE_CORN(:) = 0.
+ Z_TESTS_CORN(:) = 0.
+ Z_LOCAT_IMAG(:,:) = 0.
+ Z_VALUE_IMAG(:,:) = 0.
+ Z_VALUE_TEMP(:,:) = 0.
+ Z_LOCAT_GHOS(:) = 0.
+ Z_LOCAT_BOUN(:) = 0.
+ Z_VALUE_GHOS(:) = 0.
+ Z_VALUE_MAT1(:,:) = 0.
+ Z_VALUE_MAT2(:,:) = 0.
+ IF (HVAR=='U') JH = 1
+ IF (HVAR=='V') JH = 2
+ IF (HVAR=='W') JH = 3
+ Y_TYPE_BOUND(1) = HIBM_TYPE_BOUNN
+ Y_TYPE_BOUND(2) = HIBM_TYPE_BOUNT
+ Y_TYPE_BOUND(3) = HIBM_TYPE_BOUNC
+ Y_FORC_BOUND(1) = HIBM_FORC_BOUNN
+ Y_FORC_BOUND(2) = HIBM_FORC_BOUNT
+ Y_FORC_BOUND(3) = HIBM_FORC_BOUNC
+ Y_MODE_BOUND(1) = HIBM_MODE_BOUNN
+ Y_MODE_BOUND(2) = HIBM_MODE_BOUNT
+ Y_MODE_BOUND(3) = HIBM_MODE_BOUNC
+ Y_MODE_INTE1(1) = HIBM_MODE_INT1N
+ Y_MODE_INTE1(2) = HIBM_MODE_INT1T
+ Y_MODE_INTE1(3) = HIBM_MODE_INT1C
+ Z_FORC_BOUND(1) = PIBM_FORC_BOUNN
+ Z_FORC_BOUND(2) = PIBM_FORC_BOUNT
+ Z_FORC_BOUND(3) = PIBM_FORC_BOUNC
+ !
+ ALLOCATE(Z_VALUE_ZLKE(4,3))
+ ALLOCATE(Z_TEMP_ZLKE(3))
+ Z_VALUE_ZLKE(:,:) = 0.
+ Z_TEMP_ZLKE(:) = 0.
+ !
+ DO JMM=1,KIBM_LAYER
+ !
+ ! searching number of ghosts
+ JM = size(NIBM_GHOST_V,1)
+ JI = 0
+ JJ = 0
+ JK = 0
+ DO WHILE ((JI==0.and.JJ==0.and.JK==0).and.JM>0)
+ JI = NIBM_GHOST_V(JM,JMM,JH,1)
+ JJ = NIBM_GHOST_V(JM,JMM,JH,2)
+ JK = NIBM_GHOST_V(JM,JMM,JH,3)
+ IF (JI==0.and.JJ==0.and.JK==0) JM = JM - 1
+ ENDDO
+ I_GHOST_NUMB = JM
+ !
+ ! Loop on each P Ghosts
+ IF (I_GHOST_NUMB<=0) GO TO 666
+ DO JM = 1,I_GHOST_NUMB
+ !
+ ! ghost index/ls
+ JI = NIBM_GHOST_V(JM,JMM,JH,1)
+ JJ = NIBM_GHOST_V(JM,JMM,JH,2)
+ JK = NIBM_GHOST_V(JM,JMM,JH,3)
+ IF (JI==0.or.JJ==0.or.JK==0) GO TO 777
+ Z_LOCAT_GHOS(:) = XIBM_GHOST_V(JM,JMM,JH,:)
+ Z_LOCAT_BOUN(:) = 2.0*XIBM_IMAGE_V(JM,JMM,JH,1,:)-1.0*XIBM_IMAGE_V(JM,JMM,JH,2,:)
+ ZIBM_HALO = 1.
+ !
+ DO JN = 1,3
+ !
+ Z_LOCAT_IMAG(JN,:)= XIBM_IMAGE_V(JM,JMM,JH ,JN,:)
+ Z_DELTA_IMAG = ((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))**0.5
+ !
+ DO JLL=1,3
+ I_INDEX_CORN(:) = NIBM_IMAGE_V(JM,JMM,JH,JLL,JN,:)
+ IF (I_INDEX_CORN(1)==0.AND.JN==2) ZIBM_HALO=0.
+ IF (I_INDEX_CORN(2)==0.AND.JN==2) ZIBM_HALO=0.
+ Z_LOCAT_CORN(:,:) = IBM_LOCATCORN(I_INDEX_CORN,JLL+1)
+ Z_TESTS_CORN(:) = XIBM_TESTI_V(JM,JMM,JH,JLL,JN,:)
+ Z_VALUE_CORN(:) = IBM_VALUECORN(PVAR2(:,:,:,JLL),I_INDEX_CORN)
+ Z_VALUE_IMAG(JN,JLL) = IBM_3DINT(JN,Z_VALUE_IMAG(:,JLL),Z_LOCAT_BOUN,Z_TESTS_CORN,&
+ Z_LOCAT_CORN,Z_VALUE_CORN,Z_LOCAT_IMAG(JN,:),&
+ HIBM_MODE_INTE3,PRADIUS,PPOWERS)
+ ENDDO
+ !
+ ENDDO
+ ZIBM_VISC = PXMU(JI,JJ,JK)
+ ZIBM_DIVK = PDIV(JI,JJ,JK)
+ !
+ ! projection step
+ Z_VALUE_MAT1(:,:) = IBM_VALUEMAT1(Z_LOCAT_IMAG(1,:),Z_LOCAT_BOUN,Z_VALUE_IMAG,HIBM_FORC_BOUNR)
+ DO JN=1,3
+ Z_VALUE_TEMP(JN,:)= Z_VALUE_MAT1(:,1)*Z_VALUE_IMAG(JN,1) +&
+ Z_VALUE_MAT1(:,2)*Z_VALUE_IMAG(JN,2) +&
+ Z_VALUE_MAT1(:,3)*Z_VALUE_IMAG(JN,3)
+ ENDDO
+ !
+ ! === BOUND computation ===
+ !
+ JN=4
+ DO JLL=1,3
+ Z_VALUE_TEMP(JN,JLL) = IBM_0DINT(Z_DELTA_IMAG,Z_VALUE_TEMP(:,JLL),Y_TYPE_BOUND(JLL),Y_FORC_BOUND(JLL), &
+ Z_FORC_BOUND(JLL),ZIBM_VISC,ZIBM_DIVK)
+ ENDDO
+ !
+ ! inverse projection step
+ Z_VALUE_MAT2(:,:) = IBM_VALUEMAT2(Z_VALUE_MAT1)
+ Z_VALUE_IMAG(JN,:)= Z_VALUE_MAT2(:,1)*Z_VALUE_TEMP(JN,1) +&
+ Z_VALUE_MAT2(:,2)*Z_VALUE_TEMP(JN,2) +&
+ Z_VALUE_MAT2(:,3)*Z_VALUE_TEMP(JN,3)
+ !
+ ! === GHOST computation ===
+ !
+ ! functions storage
+ Z_LOCAT_IMAG(1,3) = ((XIBM_GHOST_V(JM,JMM,JH,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_GHOST_V(JM,JMM,JH,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_GHOST_V(JM,JMM,JH,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ IF (Z_LOCAT_IMAG(1,3)>Z_DELTA_IMAG.AND.ZIBM_HALO>0.5) THEN
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_V(JM,JMM,JH,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_V(JM,JMM,JH,2,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,2,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,2,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ ELSE
+ Z_LOCAT_IMAG(1,1) = ((XIBM_IMAGE_V(JM,JMM,JH,3,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,3,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,3,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_LOCAT_IMAG(1,2) = ((XIBM_IMAGE_V(JM,JMM,JH,1,1)-Z_LOCAT_BOUN(1))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,2)-Z_LOCAT_BOUN(2))**2.+&
+ (XIBM_IMAGE_V(JM,JMM,JH,1,3)-Z_LOCAT_BOUN(3))**2.)**0.5
+ Z_VALUE_TEMP(2,:) = Z_VALUE_TEMP(1,:)
+ Z_VALUE_TEMP(1,:) = Z_VALUE_TEMP(3,:)
+ ENDIF
+ !
+ DO JLL=1,3
+ Z_VALUE_GHOS(JLL) = IBM_1DINT(Z_LOCAT_IMAG(1,:),Z_VALUE_TEMP(:,JLL),Y_MODE_INTE1(JLL))
+ IF (Y_MODE_BOUND(JLL)=='SYM') Z_VALUE_GHOS(JLL) = +Z_VALUE_GHOS(JLL)
+ IF (Y_MODE_BOUND(JLL)=='ASY') Z_VALUE_GHOS(JLL) = -Z_VALUE_GHOS(JLL) + 2.*Z_VALUE_TEMP(4,JLL)
+ IF (Y_MODE_BOUND(JLL)=='CST') Z_VALUE_GHOS(JLL) = Z_VALUE_TEMP(4,JLL)
+ ENDDO
+ !
+ PVAR(JI,JJ,JK) = Z_VALUE_MAT2(JH,1)*Z_VALUE_GHOS(1) +&
+ Z_VALUE_MAT2(JH,2)*Z_VALUE_GHOS(2) +&
+ Z_VALUE_MAT2(JH,3)*Z_VALUE_GHOS(3)
+ !
+ IF ((JH==3).AND.(JK==2)) THEN
+ PVAR(JI,JJ,JK) = 0.
+ ENDIF
+ !
+777 CONTINUE
+ !
+ ENDDO
+ ENDDO
+ !
+666 CONTINUE
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(I_INDEX_CORN)
+ DEALLOCATE(Z_LOCAT_CORN)
+ DEALLOCATE(Z_VALUE_CORN)
+ DEALLOCATE(Z_LOCAT_IMAG)
+ DEALLOCATE(Z_VALUE_IMAG)
+ DEALLOCATE(Z_VALUE_TEMP)
+ DEALLOCATE(Z_LOCAT_BOUN)
+ DEALLOCATE(Z_LOCAT_GHOS)
+ DEALLOCATE(Z_VALUE_GHOS)
+ DEALLOCATE(Z_TESTS_CORN)
+ DEALLOCATE(Y_TYPE_BOUND,Y_FORC_BOUND)
+ DEALLOCATE(Y_MODE_BOUND,Y_MODE_INTE1)
+ DEALLOCATE(Z_FORC_BOUND)
+ DEALLOCATE(Z_VALUE_MAT1)
+ DEALLOCATE(Z_VALUE_MAT2)
+ DEALLOCATE(Z_VALUE_ZLKE)
+ DEALLOCATE(Z_TEMP_ZLKE)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_AFFECTV
diff --git a/src/MNH/ibm_balance.f90 b/src/MNH/ibm_balance.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2256cd097bc547fd789da11f5fc85507a808242d
--- /dev/null
+++ b/src/MNH/ibm_balance.f90
@@ -0,0 +1,553 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_BALANCE
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_BALANCE(PPHI,PVOL,PRUS,PRVS,PRWS,PBAL)
+ !
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PPHI
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVOL
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PBAL
+ !
+ END SUBROUTINE IBM_BALANCE
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_BALANCE
+!
+! #####################################################
+SUBROUTINE IBM_BALANCE(PPHI,PVOL,PRUS,PRVS,PRWS,PBAL)
+ ! #####################################################
+ !
+ !
+ !**** IBM_BALANCE computes the velocity divergence using a volumic approach
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to compute div(U)=1/V*int_S(u.n)dS
+ ! S is the modified surface and is estimated before MNH
+ ! U is approximated using adjacents points
+
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_CST, ONLY: XPI
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_LBC_n
+ USE MODD_REF_n
+ !
+ ! interface
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PPHI
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PVOL
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PBAL
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIU,IJU,IKU
+ INTEGER :: IIE,IIB,IJE,IJB,IKE,IKB
+ INTEGER :: JI,JJ,JK,JL,JI2,JJ2,JK2,JM
+ REAL :: ZPH0,ZPH1,ZPH2,ZDEL,ZBAR,ZRAY,ZCOE,ZCO2
+ REAL :: ZVIT1,ZVIT2,ZVIT0,ZSIG0,ZSIG1,ZSIG2
+ REAL, DIMENSION(:,:,:,:) ,ALLOCATABLE :: ZIBM_FLUX
+ REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZFLU
+ REAL :: ZTOTO
+ REAL :: ZINVROOTPI
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ IKU = SIZE(PPHI,3)
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ ALLOCATE(ZIBM_FLUX(IIU,IJU,IKU,3))
+ ALLOCATE(ZFLU(IIU,IJU,IKU))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ZIBM_FLUX = 0.
+ ZFLU = 0.
+ ZTOTO = 1.0
+ ZINVROOTPI = 1.0/SQRT(XPI)
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ !
+ IF (PVOL(JI,JJ,JK,3).gt.XIBM_EPSI) THEN
+ !
+ ! Flux, west
+ JL = 2
+ JI2 = JI
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = 0.
+ ZDEL = SQRT((XYHAT(JJ+1)-XYHAT(JJ))*0.5*(XZZ(JI2,JJ,JK+1)-XZZ(JI2,JJ,JK)+XZZ(JI2-1,JJ,JK+1)-XZZ(JI2-1,JJ,JK)))
+ ZPH1 = PPHI(JI2 ,JJ ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRUS(JI2,JJ ,JK )
+ !
+ DO JM=1,8
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRUS(JI2,JJ2,JK2)
+ ZRAY = ZDEL*ZINVROOTPI*ZTOTO
+ ZBAR = 0.
+ !
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR=-ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ !
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = ZIBM_FLUX(JI2,JJ,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ ENDDO
+ !
+ ! Flux, East
+ JL = 2
+ JI2 = JI+1
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = 0.
+ ZDEL = SQRT((XYHAT(JJ+1)-XYHAT(JJ))*0.5*(XZZ(JI2,JJ,JK+1)-XZZ(JI2,JJ,JK)+XZZ(JI2-1,JJ,JK+1)-XZZ(JI2-1,JJ,JK)))
+ ZPH1 = PPHI(JI2 ,JJ ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRUS(JI2,JJ ,JK )
+ DO JM=1,8
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRUS(JI2,JJ2,JK2)
+ ZRAY = ZDEL*ZINVROOTPI*ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR=-ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI2,JJ,JK,JL-1) = ZIBM_FLUX(JI2,JJ,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ! Flux, south
+ JL = 3
+ JJ2 = JJ
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*0.5*(XZZ(JI,JJ2,JK+1)-XZZ(JI,JJ2,JK)+XZZ(JI,JJ2-1,JK+1)-XZZ(JI,JJ2-1,JK)))
+ ZPH1 = PPHI(JI ,JJ2 ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRVS(JI ,JJ2,JK )
+ !
+ DO JM=1,8
+ !
+ IF (JM==1) THEN
+ JI2 = JI-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JI2 = JI-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JI2 = JI-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JI2 = JI+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JI2 = JI+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JI2 = JI+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JI2 = JI
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JI2 = JI
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRVS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = ZIBM_FLUX(JI,JJ2,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ ENDDO
+ !
+ ! Flux, north
+ JL = 3
+ JJ2 = JJ+1
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*0.5*(XZZ(JI,JJ2,JK+1)-XZZ(JI,JJ2,JK)+XZZ(JI,JJ2-1,JK+1)-XZZ(JI,JJ2-1,JK)))
+ ZPH1 = PPHI(JI ,JJ2 ,JK ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRVS(JI ,JJ2,JK )
+ !
+ DO JM=1,8
+ !
+ IF (JM==1) THEN
+ JI2 = JI-1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JI2 = JI-1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JI2 = JI-1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JI2 = JI+1
+ JK2 = JK-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JI2 = JI+1
+ JK2 = JK
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JI2 = JI+1
+ JK2 = JK+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JI2 = JI
+ JK2 = JK-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JI2 = JI
+ JK2 = JK+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRVS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ2,JK,JL-1) = ZIBM_FLUX(JI,JJ2,JK,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ! Flux, bottom
+ JL = 4
+ JK2 = JK
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))
+ ZPH1 = PPHI(JI ,JJ ,JK2 ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRWS(JI ,JJ ,JK2)
+ !
+ DO JM=1,8
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JI2 = JI-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JI2 = JI+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRWS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ !
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = ZIBM_FLUX(JI,JJ,JK2,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ! Flux, top
+ JL = 4
+ JK2 = JK+1
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = 0.
+ ZDEL = SQRT((XXHAT(JI+1)-XXHAT(JI))*(XYHAT(JJ+1)-XYHAT(JJ)))
+ ZPH1 = PPHI(JI ,JJ ,JK2 ,JL)
+ ZSIG1 = max(0.,-ZPH1/abs(ZPH1))
+ ZVIT1 = ZSIG1*PRWS(JI ,JJ ,JK2)
+ !
+ DO JM=1,8
+ !
+ IF (JM==1) THEN
+ JJ2 = JJ-1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==2) THEN
+ JJ2 = JJ-1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==3) THEN
+ JJ2 = JJ-1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==4) THEN
+ JJ2 = JJ+1
+ JI2 = JI-1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==5) THEN
+ JJ2 = JJ+1
+ JI2 = JI
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==6) THEN
+ JJ2 = JJ+1
+ JI2 = JI+1
+ ZCOE = sqrt(2.)
+ ENDIF
+ IF (JM==7) THEN
+ JJ2 = JJ
+ JI2 = JI-1
+ ZCOE = sqrt(1.)
+ ENDIF
+ IF (JM==8) THEN
+ JJ2 = JJ
+ JI2 = JI+1
+ ZCOE = sqrt(1.)
+ ENDIF
+ !
+ ZPH2 = PPHI(JI2,JJ2,JK2,JL)
+ ZSIG2 = max(0.,-ZPH2/abs(ZPH2))
+ ZSIG0 = max(0.,-ZPH1*ZPH2/abs(ZPH1*ZPH2))
+ ZVIT2 = ZSIG2*PRWS(JI2,JJ2,JK2)
+ ZRAY = ZDEL * ZINVROOTPI * ZTOTO
+ ZBAR = 0.
+ IF (ABS(ZPH2-ZPH1).GT.XIBM_EPSI) ZBAR = -ZPH1/(ZPH2-ZPH1)*ZDEL*ZCOE
+ ZBAR = MIN(ZBAR,ZRAY)
+ ZBAR = MAX(ZBAR, 0.)
+ ZIBM_FLUX(JI,JJ,JK2,JL-1) = ZIBM_FLUX(JI,JJ,JK2,JL-1) + &
+ (ZSIG1*ZSIG2*ZVIT1+ZSIG0*(ZVIT1+ZVIT2)*abs(ZSIG2-(ZBAR/ZRAY)**2.))/8.*ZDEL**2.*ZTOTO**(-2.)
+ !
+ ENDDO
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ZFLU(IIB:IIE,IJB:IJE,IKB:IKE) = (ZIBM_FLUX(IIB+1:IIE+1,IJB :IJE ,IKB :IKE ,1)-ZIBM_FLUX(IIB:IIE,IJB:IJE,IKB:IKE,1) +&
+ ZIBM_FLUX(IIB :IIE ,IJB+1:IJE+1,IKB :IKE ,2)-ZIBM_FLUX(IIB:IIE,IJB:IJE,IKB:IKE,2) +&
+ ZIBM_FLUX(IIB :IIE ,IJB :IJE ,IKB+1:IKE+1,3)-ZIBM_FLUX(IIB:IIE,IJB:IJE,IKB:IKE,3))*&
+ XRHODREF(IIB:IIE,IJB:IJE,IKB:IKE)/XRHODJ(IIB:IIE,IJB:IJE,IKB:IKE)
+ !
+ PBAL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1) = PBAL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1)* &
+ PVOL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1,2)+ZFLU(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1)* &
+ PVOL(IIB-1:IIE+1,IJB-1:IJE+1,IKB-1:IKE+1,3)
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ DEALLOCATE(ZIBM_FLUX,ZFLU)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_BALANCE
diff --git a/src/MNH/ibm_detect.f90 b/src/MNH/ibm_detect.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ca4530964ff6f617309a5df187c9c689cbf73d53
--- /dev/null
+++ b/src/MNH/ibm_detect.f90
@@ -0,0 +1,968 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! ######################
+MODULE MODI_IBM_DETECT
+ ! ######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_DETECT(PPHI)
+ !
+ REAL, DIMENSION(:,:,:,:) ,INTENT(IN) :: PPHI
+ !
+ END SUBROUTINE IBM_DETECT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_DETECT
+!
+! ###########################
+SUBROUTINE IBM_DETECT(PPHI)
+ ! ###########################
+ !
+ !
+ !**** IBM_DETECT is dedicated to the characterization of the ghost point and
+ ! associated image points
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to affect an specific index to cells where
+ ! ghost points are localized. Depending on order of numerical scheme the
+ ! thickness of ghost points layer varies as the index value. For each cell
+ ! marked as ghost the corresponding image point location is stored.
+
+ ! METHOD
+ ! ------
+ !**** Iterative procedure to characterize ghost point locations
+ ! - local test on the sign change of the levelset function (first layer)
+ ! - local detection of the first layer to define the neighboring second layer
+ ! - repeat of the previous step for high order numerical scheme
+ !
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_LBC_n
+ USE MODD_CONF, ONLY: NHALO
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_GRADIENT_M
+ USE MODI_GRADIENT_U
+ USE MODI_GRADIENT_V
+ USE MODI_GRADIENT_W
+ USE MODI_IBM_LOCATCORN
+ USE MODI_IBM_VALUECORN
+ USE MODI_IBM_INTERPOS
+ USE MODI_GRADIENT_UV
+ USE MODI_GRADIENT_VW
+ USE MODI_GRADIENT_UW
+ USE MODI_GDIV
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPHI ! LevelSet functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIB,IJB,IKB,IIE,IJE,IKE ! physical domain size
+ INTEGER :: IIU,IJU,IKU,IIUM,IJUM,IKUM,JN1,JN2 ! numerical domain size
+ INTEGER :: JI,JJ,JK,JI2,JJ2,JK2,JL,JM,JN,JMM,JNN,JP ! loop index
+ INTEGER :: JIM1,JIP1,JJM1,JJP1,JKM1,JKP1,JI3,JJ3,JK3 ! loop boundaries
+ INTEGER :: JIM2,JIP2,JJM2,JJP2,JKM2,JKP2
+ INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: I_INDE_GHOST ! ghosts index storage
+ INTEGER :: I_DIME_GHOST,I_INDE_LOCAT
+ INTEGER, DIMENSION(:,:) , ALLOCATABLE :: I_NUMB_GHOST
+ INTEGER, DIMENSION(:) , ALLOCATABLE :: I_INDE_TEMPO,I_INDE_TEMPO2
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll,I_NUMB_LAYER
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: ZXPOS,ZYPOS,ZZPOS,Z_NORM_TEMP1 ! staggered grid arrays
+ REAL, DIMENSION(:,:,:) , ALLOCATABLE :: Z_NORM_TEMP2,Z_NORM_TEMP3
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: Z_NORM_GHOST ! vec(n)
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: Z_NORM_TEMPO,ZIBM_TESTING,ZPHI
+ REAL :: ZLGHO
+ REAL, DIMENSION(:) , ALLOCATABLE :: ZVECT,ZPROD,Z_PHI
+ REAL, DIMENSION(:,:) , ALLOCATABLE :: Z_IMG,Z_GHO
+ INTEGER :: I_NUMB_LAYERV,I_NUMB_LAYERP,I_DIME_GHOSTV,I_DIME_GHOSTP
+ REAL :: ZSEAR,ZISI,ZJSI,ZKSI,ZLIMG
+ REAL :: ZIBM_TESTI,PPHI_CORR,PPHI_TEST
+ INTEGER :: JHALO,IKM,JLL
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ IIU=SIZE(PPHI,1)
+ IJU=SIZE(PPHI,2)
+ IKU=SIZE(PPHI,3)
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ IKB=1 +JPVEXT
+ IKE=IKU-JPVEXT
+ IKM=INT(IKU/2.)
+ !
+ ALLOCATE(I_INDE_GHOST(IIB:IIE,IJB:IJE,IKB:IKE,4))
+ ALLOCATE(ZIBM_TESTING(IIU,IJU,IKU,4))
+ ALLOCATE(Z_PHI(8),ZPROD(6),ZVECT(3),Z_IMG(8,3),Z_GHO(8,3),I_INDE_TEMPO(3),I_INDE_TEMPO2(3))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ JHALO = 0
+ ZVECT(:) = 0.
+ ZPROD(:) = 0.
+ Z_PHI(:) = 0.
+ Z_IMG(:,:) = 0.
+ Z_GHO(:,:) = 0.
+ I_INDE_TEMPO(:) = 0
+ I_INDE_GHOST(:,:,:,:) = 0
+ Z_NORM_GHOST(:,:,:,:) = 0.
+ Z_NORM_TEMPO(:,:,:,:) = 0.
+ ZIBM_TESTING(:,:,:,:) = 0.
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !I_IBM_NUMB_GHOST stores the ghost number per layer and node type
+ I_NUMB_LAYERV = NIBM_LAYER_V
+ I_NUMB_LAYERP = max(NIBM_LAYER_P,NIBM_LAYER_T,NIBM_LAYER_E, &
+ NIBM_LAYER_R,NIBM_LAYER_Q,NIBM_LAYER_S)
+ I_NUMB_LAYER = max(I_NUMB_LAYERV,I_NUMB_LAYERP)
+ !
+ ALLOCATE(I_NUMB_GHOST(4,I_NUMB_LAYER))
+ I_NUMB_GHOST(:,:)=0
+ !
+ ! Ghost cells detection
+ DO JL = 1,4
+ !
+ ! Number of ghost layers per PUVW nodes
+ IF (JL==1) THEN
+ I_NUMB_LAYER = I_NUMB_LAYERP
+ ELSE
+ I_NUMB_LAYER = I_NUMB_LAYERV
+ ENDIF
+ !
+ ! arrays computation
+ IF (JL==1) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ IF (JL==2) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ IF (JL==3) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ IF (JL==4) THEN
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ ENDIF
+ !
+ DO JK = IKB,IKUM
+ !
+ JKM1 = JK-I_NUMB_LAYER
+ JKP1 = JK+I_NUMB_LAYER
+ !
+ IF (JK==IKB ) JKM1 = JK
+ IF (JK==IKUM) JKP1 = JK
+ IF (I_NUMB_LAYER>=2) THEN
+ IF (JK==IKB+1 ) JKM1 = JK-1
+ IF (JK==IKUM-1) JKP1 = JK+1
+ ENDIF
+ IF (I_NUMB_LAYER>=3) THEN
+ IF (JK==IKB+2 ) JKM1 = JK-2
+ IF (JK==IKUM-2) JKP1 = JK+2
+ ENDIF
+ JKM1 = max(2 ,JKM1)
+ JKP1 = min(IKU-1,JKP1)
+ !
+ DO JJ = IJB,IJUM
+ !
+ JJM1 = JJ-I_NUMB_LAYER
+ JJP1 = JJ+I_NUMB_LAYER
+ !
+ IF (LSOUTH_ll().and.JJ==IJB) JJM1=JJ
+ IF (LNORTH_ll().and.JJ==IJUM) JJP1=JJ
+ IF (I_NUMB_LAYER>=2) THEN
+ IF (LSOUTH_ll().and.JJ==IJB+1) JJM1=JJ-1
+ IF (LNORTH_ll().and.JJ==IJUM-1) JJP1=JJ+1
+ ENDIF
+ IF (I_NUMB_LAYER>=3) THEN
+ IF (LSOUTH_ll().and.JJ==IJB+2) JJM1=JJ-2
+ IF (LNORTH_ll().and.JJ==IJUM-2) JJP1=JJ+2
+ ENDIF
+ JJM1 = max(1 ,JJM1)
+ JJP1 = min(IJU,JJP1)
+ !
+ DO JI = IIB,IIUM
+ !
+ JIM1 = JI-I_NUMB_LAYER
+ JIP1 = JI+I_NUMB_LAYER
+ !
+ IF (LWEST_ll().and.JI==IIB) JIM1=JI
+ IF (LEAST_ll().and.JI==IIUM) JIP1=JI
+ IF (I_NUMB_LAYER>=2) THEN
+ IF (LWEST_ll().and.JI==IIB+1) JIM1=JI-1
+ IF (LEAST_ll().and.JI==IIUM-1) JIP1=JI+1
+ ENDIF
+ IF (I_NUMB_LAYER>=3) THEN
+ IF (LWEST_ll().and.JI==IIB+2) JIM1=JI-2
+ IF (LEAST_ll().and.JI==IIUM-2) JIP1=JI+2
+ ENDIF
+ JIM1 = max(1 ,JIM1)
+ JIP1 = min(IIU,JIP1)
+ !
+ ! test for embedded solid region
+ IF (PPHI(JI,JJ,JK,JL).gt.-XIBM_EPSI) THEN
+ !
+ DO JM=1,3
+
+ IF (JM==1) THEN
+ JIM2 = JI
+ JIP2 = JI
+ JJM2 = JJ
+ JJP2 = JJ
+ JKM2 = JKM1
+ JKP2 = JKP1
+ ENDIF
+ IF (JM==2) THEN
+ JIM2 = JIM1
+ JIP2 = JIP1
+ JJM2 = JJ
+ JJP2 = JJ
+ JKM2 = JK
+ JKP2 = JK
+ ENDIF
+ IF (JM==3) THEN
+ JIM2 = JI
+ JIP2 = JI
+ JJM2 = JJM1
+ JJP2 = JJP1
+ JKM2 = JK
+ JKP2 = JK
+ ENDIF
+ !
+ DO JK2= JKM2,JKP2
+ DO JJ2= JJM2,JJP2
+ DO JI2= JIM2,JIP2
+ !
+ ! interface presence test (multi layer)
+ IF ((PPHI(JI,JJ,JK,JL)*PPHI(JI2,JJ2,JK2,JL)).lt.-XIBM_EPSI) THEN
+ I_INDE_LOCAT = max(abs(JI-JI2),abs(JJ-JJ2),abs(JK-JK2))
+ IF (I_INDE_GHOST(JI,JJ,JK,JL)/=0) THEN
+ I_INDE_GHOST(JI,JJ,JK,JL) = min(I_INDE_GHOST(JI,JJ,JK,JL),I_INDE_LOCAT)
+ ZIBM_TESTING(JI,JJ,JK,JL)=I_INDE_GHOST(JI,JJ,JK,JL)*1.
+ ELSE
+ I_INDE_GHOST(JI,JJ,JK,JL) = I_INDE_LOCAT
+ ZIBM_TESTING(JI,JJ,JK,JL)=I_INDE_GHOST(JI,JJ,JK,JL)*1.
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ENDDO
+ !
+ ! ghosts counter
+ IF (I_INDE_GHOST(JI,JJ,JK,JL)>0) THEN
+ I_NUMB_GHOST(JL,I_INDE_GHOST(JI,JJ,JK,JL))=I_NUMB_GHOST(JL,I_INDE_GHOST(JI,JJ,JK,JL))+1
+ ENDIF
+ !
+ ENDIF
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ENDDO
+ !
+ I_DIME_GHOSTV = 0
+ DO JL=1,I_NUMB_LAYERV
+ I_DIME_GHOSTV = max(I_DIME_GHOSTV,I_NUMB_GHOST(2,JL),I_NUMB_GHOST(3,JL),I_NUMB_GHOST(4,JL))
+ ENDDO
+ I_DIME_GHOSTP = 0
+ DO JL=1,I_NUMB_LAYERP
+ I_DIME_GHOSTP = max(I_DIME_GHOSTP,I_NUMB_GHOST(1,JL))
+ ENDDO
+ !
+ ! === GHOSTS storage ===
+ ! NIBM_STOR_GHOSV(A,B,C)
+ ! A : number of ghosts for each type of nodes
+ ! B : type of ghosts layer
+ ! C : type of ghosts PUVW
+ ! D : index location IJK
+ ALLOCATE(NIBM_GHOST_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3))
+ NIBM_GHOST_V(:,:,:,:) = 0
+ !
+ ! NIBM_STOR_GHOSP(A,B,C)
+ ! A : number of ghosts for each type of nodes P
+ ! B : type of ghosts layer
+ ! C : ---
+ ! D : index location IJK
+ ALLOCATE(NIBM_GHOST_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,3))
+ NIBM_GHOST_P(:,:,:,:) = 0
+ !
+ ! XIBM_STOR_GHOSV(A,B,C,D)
+ ! A : number of ghosts in each type of nodes PUVW
+ ! B : layer number
+ ! C : type of nodes UVW for the image(s)
+ ! D : location of the ghost
+ ALLOCATE(XIBM_GHOST_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3))
+ XIBM_GHOST_V(:,:,:,:) = 0.
+ !
+ ! XIBM_STOR_GHOSP(A,B,C,D,E)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : location of the ghost
+ ALLOCATE(XIBM_GHOST_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,3))
+ XIBM_GHOST_P(:,:,:,:) = 0.
+ !
+ ! Reset ghost research
+ I_NUMB_GHOST(:,:) = 0
+ DO JL = 1,4
+ !
+ ! Number of ghost layers per PUVW nodes
+ IF (JL==1) THEN
+ I_NUMB_LAYER = I_NUMB_LAYERP
+ ELSE
+ I_NUMB_LAYER = I_NUMB_LAYERV
+ ENDIF
+ !
+ IIUM=IIE
+ IJUM=IJE
+ IKUM=IKE
+ !
+ DO JM = 1,I_NUMB_LAYER
+ DO JK = IKB,IKUM
+ DO JJ = IJB,IJUM
+ DO JI = IIB,IIUM
+ IF (I_INDE_GHOST(JI,JJ,JK,JL)==JM) THEN
+ I_NUMB_GHOST(JL,JM) = I_NUMB_GHOST(JL,JM) + 1
+ IF (JL==1) THEN
+ NIBM_GHOST_P(I_NUMB_GHOST(JL,JM),JM,JL ,1) = JI
+ NIBM_GHOST_P(I_NUMB_GHOST(JL,JM),JM,JL ,2) = JJ
+ NIBM_GHOST_P(I_NUMB_GHOST(JL,JM),JM,JL ,3) = JK
+ ELSE
+ NIBM_GHOST_V(I_NUMB_GHOST(JL,JM),JM,JL-1,1) = JI
+ NIBM_GHOST_V(I_NUMB_GHOST(JL,JM),JM,JL-1,2) = JJ
+ NIBM_GHOST_V(I_NUMB_GHOST(JL,JM),JM,JL-1,3) = JK
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ ENDDO
+ !
+ !=== IMAGES cells detection ===
+ !
+ ! NIBM_TEST_IMAGV(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes UVW
+ ! B : layer number
+ ! C : UVW node type for ghost
+ ! D : UVW node type for image
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : corner index
+ ALLOCATE(XIBM_TESTI_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3,3,8))
+ XIBM_TESTI_V = 1.
+ !
+ ! NIBM_TEST_IMAGP(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : ---
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : corner index
+ ALLOCATE(XIBM_TESTI_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,1,3,8))
+ XIBM_TESTI_P = 1.
+ !
+ ! NIBM_STOR_IMAGV(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes UVW
+ ! B : layer number
+ ! C : UVW node type for ghost
+ ! D : UVW node type for image
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : index of the image(s)
+ ALLOCATE(NIBM_IMAGE_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3,3,3))
+ NIBM_IMAGE_V(:,:,:,:,:,:) = 0
+ !
+ ! NIBM_STOR_IMAGP(A,B,C,D,E,F)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : ---
+ ! E : 1 for MIRROR or IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! F : index of the image(s)
+ ALLOCATE(NIBM_IMAGE_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,1,3,3))
+ NIBM_IMAGE_P(:,:,:,:,:,:) = 0
+ !
+ ! XIBM_STOR_IMAGV(A,B,C,D,E)
+ ! A : number of ghosts in each type of nodes PUVW
+ ! B : layer number
+ ! C : type of nodes UVW for the image(s)
+ ! D : 1 for IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! E : location of the image(s)
+ ALLOCATE(XIBM_IMAGE_V(I_DIME_GHOSTV,I_NUMB_LAYERV,3,3,3))
+ XIBM_IMAGE_V(:,:,:,:,:) = 0.
+ !
+ ! XIBM_STOR_IMAGP(A,B,C,D,E)
+ ! A : number of ghosts in each type of nodes P
+ ! B : layer number
+ ! C : ---
+ ! D : 1 for IMAGE1 - 2 for IMAGE2 - 3 for MIRROR
+ ! E : location of the image(s)
+ ALLOCATE(XIBM_IMAGE_P(I_DIME_GHOSTP,I_NUMB_LAYERP,1,3,3))
+ XIBM_IMAGE_P(:,:,:,:,:) = 0.
+ !
+ ALLOCATE(Z_NORM_GHOST(IIU,IJU,IKU,3),Z_NORM_TEMPO(IIU,IJU,IKU,3),Z_NORM_TEMP1(IIU,IJU,IKU,4),Z_NORM_TEMP2(IIU,IJU,IKU), &
+ Z_NORM_TEMP3(IIU,IJU,IKU))
+ ALLOCATE(ZPHI(IIU,IJU,IKU,4))
+ ZPHI = 0.
+ !
+ DO JL = 1,4
+ !
+ ! Number of ghost layers per PUVW nodes
+ IF (JL==1) THEN
+ I_NUMB_LAYER = I_NUMB_LAYERP
+ ELSE
+ I_NUMB_LAYER = I_NUMB_LAYERV
+ ENDIF
+ IF (I_NUMB_LAYER==0) GO TO 667
+ !
+ ! div(n) computation
+ IF (JL==1) THEN
+ Z_NORM_TEMPO(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMPO(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMPO(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMP1(:,:,:,1) = - GX_M_U(1,IKU,1,PPHI(:,:,:,1),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_M_V(1,IKU,1,PPHI(:,:,:,1),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_M_W(1,IKU,1,PPHI(:,:,:,1),XDZZ)
+ CALL GDIV(CLBCX,CLBCY,XDXX,XDYY,XDZX,XDZY,XDZZ,Z_NORM_TEMP1(:,:,:,1),Z_NORM_TEMP1(:,:,:,2),Z_NORM_TEMP1(:,:,:,3), &
+ XIBM_CURV(:,:,:))
+ XIBM_CURV(:,:,:)=-XIBM_CURV(:,:,:)*(XRHODJ(:,:,:)/XRHODREF(:,:,:))**(2./3.)
+ IF (LWEST_ll ()) XIBM_CURV(1,:,:) = XIBM_CURV(2 ,:,:)
+ IF (LEAST_ll ()) XIBM_CURV(IIU,:,:) = XIBM_CURV(IIU-1,:,:)
+ IF (LSOUTH_ll()) XIBM_CURV(:,1,:) = XIBM_CURV(:,2 ,:)
+ IF (LNORTH_ll()) XIBM_CURV(:,IJU,:) = XIBM_CURV(:,IJU-1,:)
+ XIBM_CURV(:,:,1 ) = XIBM_CURV(:,:, 2)
+ XIBM_CURV(:,:,IKU) = XIBM_CURV(:,:,IKU-1)
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_CURV(:,:,:),'IBM_DETECT::XIBM_CURV')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ XIBM_SU(:,:,:,1)=MXM(XIBM_CURV(:,:,:))
+ XIBM_SU(:,:,:,2)=MYM(XIBM_CURV(:,:,:))
+ XIBM_SU(:,:,:,3)=MZM(XIBM_CURV(:,:,:))
+ IF (LWEST_ll ()) XIBM_SU(1,:,:,1) = XIBM_SU(2 ,:,:,1)
+ IF (LEAST_ll ()) XIBM_SU(IIU,:,:,1) = XIBM_SU(IIU-1,:,:,1)
+ IF (LSOUTH_ll()) XIBM_SU(:,1,:,1) = XIBM_SU(:,2 ,:,1)
+ IF (LNORTH_ll()) XIBM_SU(:,IJU,:,1) = XIBM_SU(:,IJU-1,:,1)
+ XIBM_SU(:,:,1 ,1) = XIBM_SU(:,:, 2,1)
+ XIBM_SU(:,:,IKU,1) = XIBM_SU(:,:,IKU-1,1)
+ IF (LWEST_ll ()) XIBM_SU(1,:,:,2) = XIBM_SU(2 ,:,:,2)
+ IF (LEAST_ll ()) XIBM_SU(IIU,:,:,2) = XIBM_SU(IIU-1,:,:,2)
+ IF (LSOUTH_ll()) XIBM_SU(:,1,:,2) = XIBM_SU(:,2 ,:,2)
+ IF (LNORTH_ll()) XIBM_SU(:,IJU,:,2) = XIBM_SU(:,IJU-1,:,2)
+ XIBM_SU(:,:,1 ,2) = XIBM_SU(:,:, 2,2)
+ XIBM_SU(:,:,IKU,2) = XIBM_SU(:,:,IKU-1,2)
+ IF (LWEST_ll ()) XIBM_SU(1,:,:,3) = XIBM_SU(2 ,:,:,3)
+ IF (LEAST_ll ()) XIBM_SU(IIU,:,:,3) = XIBM_SU(IIU-1,:,:,3)
+ IF (LSOUTH_ll()) XIBM_SU(:,1,:,3) = XIBM_SU(:,2 ,:,3)
+ IF (LNORTH_ll()) XIBM_SU(:,IJU,:,3) = XIBM_SU(:,IJU-1,:,3)
+ XIBM_SU(:,:,1 ,3) = XIBM_SU(:,:, 2,3)
+ XIBM_SU(:,:,IKU,3) = XIBM_SU(:,:,IKU-1,3)
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,1),'IBM_DETECT::XIBM_SU')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,2),'IBM_DETECT::XIBM_SU')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,3),'IBM_DETECT::XIBM_SU')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ XIBM_CURV(:,:,:)=0.5*XIBM_CURV(:,:,:)+0.5/3.*(MXF(XIBM_SU(:,:,:,1))+ &
+ MYF(XIBM_SU(:,:,:,2))+ &
+ MZF(XIBM_SU(:,:,:,3)))
+ !
+ IF (LWEST_ll ()) XIBM_CURV(1,:,:) = XIBM_CURV(2 ,:,:)
+ IF (LEAST_ll ()) XIBM_CURV(IIU,:,:) = XIBM_CURV(IIU-1,:,:)
+ IF (LSOUTH_ll()) XIBM_CURV(:,1,:) = XIBM_CURV(:,2 ,:)
+ IF (LNORTH_ll()) XIBM_CURV(:,IJU,:) = XIBM_CURV(:,IJU-1,:)
+ XIBM_CURV(:,:,1 ) = XIBM_CURV(:,:, 2)
+ XIBM_CURV(:,:,IKU) = XIBM_CURV(:,:,IKU-1)
+ !
+ XIBM_CURV(:,:,:)=1./(ABS(XIBM_CURV(:,:,:))+XIBM_EPSI)
+ XIBM_CURV(:,:,:)=MIN(1., XIBM_CURV(:,:,:))
+ XIBM_CURV(:,:,:)=MAX(0., XIBM_CURV(:,:,:))
+ XIBM_CURV(:,:,:)=1.-XIBM_CURV(:,:,:)
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_CURV(:,:,:),'IBM_DETECT::XIBM_CURV')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ ENDIF
+ !
+ IF (JL==2) THEN
+ Z_NORM_TEMP1(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMPO(:,:,:,1) = MXM(Z_NORM_TEMP1(:,:,:,1))
+ Z_NORM_TEMPO(:,:,:,2) = MXM(Z_NORM_TEMP1(:,:,:,2))
+ Z_NORM_TEMPO(:,:,:,3) = MXM(Z_NORM_TEMP1(:,:,:,3))
+ ENDIF
+ IF (JL==3) THEN
+ Z_NORM_TEMP1(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMPO(:,:,:,1) = MYM(Z_NORM_TEMP1(:,:,:,1))
+ Z_NORM_TEMPO(:,:,:,2) = MYM(Z_NORM_TEMP1(:,:,:,2))
+ Z_NORM_TEMPO(:,:,:,3) = MYM(Z_NORM_TEMP1(:,:,:,3))
+ ENDIF
+ IF (JL==4) THEN
+ Z_NORM_TEMP1(:,:,:,1) = - GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP1(:,:,:,2) = - GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP1(:,:,:,3) = - GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ Z_NORM_TEMPO(:,:,:,1) = MZM(Z_NORM_TEMP1(:,:,:,1))
+ Z_NORM_TEMPO(:,:,:,2) = MZM(Z_NORM_TEMP1(:,:,:,2))
+ Z_NORM_TEMPO(:,:,:,3) = MZM(Z_NORM_TEMP1(:,:,:,3))
+ ENDIF
+ !
+ Z_NORM_TEMPO(:,:,1 ,1) = +Z_NORM_TEMPO(:,:, 2,1)
+ Z_NORM_TEMPO(:,:,IKU,1) = +Z_NORM_TEMPO(:,:,IKU-1,1)
+ Z_NORM_TEMPO(:,:,1 ,2) = +Z_NORM_TEMPO(:,:, 2,2)
+ Z_NORM_TEMPO(:,:,IKU,2) = +Z_NORM_TEMPO(:,:,IKU-1,2)
+ Z_NORM_TEMPO(:,:,1 ,3) = 2*Z_NORM_TEMPO(:,:, 2,3)-Z_NORM_TEMPO(:,:, 3,3)
+ Z_NORM_TEMPO(:,:,IKU,3) = 2*Z_NORM_TEMPO(:,:,IKU-1,3)-Z_NORM_TEMPO(:,:,IKU-2,3)
+ Z_NORM_TEMPO(:,:,1 ,3) = MAX(0.,Z_NORM_TEMPO(:,:,1 ,3))
+ Z_NORM_TEMPO(:,:,2 ,3) = MAX(0.,Z_NORM_TEMPO(:,:,2 ,3))
+ Z_NORM_TEMPO(:,:,3 ,3) = MAX(0.,Z_NORM_TEMPO(:,:,3 ,3))
+ Z_NORM_TEMPO(:,:,IKU ,3) = MIN(0.,Z_NORM_TEMPO(:,:,IKU ,3))
+ Z_NORM_TEMPO(:,:,IKU-1,3) = MIN(0.,Z_NORM_TEMPO(:,:,IKU-1,3))
+ Z_NORM_TEMPO(:,:,IKU-2,3) = MIN(0.,Z_NORM_TEMPO(:,:,IKU-2,3))
+ !
+ IF (LWEST_ll ()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(JLL ,:,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(JLL ,:,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(JLL ,:,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(JLL ,:,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(JLL ,:,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(JLL ,:,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ IF (LEAST_ll ()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(IIU-JLL+1,:,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(IIU-JLL+1,:,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(IIU-JLL+1,:,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(:,JLL,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(:,JLL,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(:,JLL,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(:,JLL,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(:,JLL,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(:,JLL,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ DO JLL=1,3
+ Z_NORM_TEMPO(:,IJU-JLL+1,1:IKM-1,1) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,1:IKM-1,2) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,1:IKM-1,3) =+1.
+ Z_NORM_TEMPO(:,IJU-JLL+1,IKM:IKU,1) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,IKM:IKU,2) = 0.
+ Z_NORM_TEMPO(:,IJU-JLL+1,IKM:IKU,3) =-1.
+ ENDDO
+ ENDIF
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMPO(:,:,:,1),'IBM_DETECT::Z_NORM_TEMPO')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMPO(:,:,:,2),'IBM_DETECT::Z_NORM_TEMPO')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMPO(:,:,:,3),'IBM_DETECT::Z_NORM_TEMPO')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ Z_NORM_TEMP2(:,:,:) = sqrt(Z_NORM_TEMPO(:,:,:,1)**2.+Z_NORM_TEMPO(:,:,:,2)**2.+Z_NORM_TEMPO(:,:,:,3)**2.)
+ !
+ WHERE (abs(Z_NORM_TEMP2(:,:,:)) .gt. XIBM_EPSI)
+ Z_NORM_GHOST(:,:,:,1) = Z_NORM_TEMPO(:,:,:,1)/Z_NORM_TEMP2(:,:,:)
+ Z_NORM_GHOST(:,:,:,2) = Z_NORM_TEMPO(:,:,:,2)/Z_NORM_TEMP2(:,:,:)
+ Z_NORM_GHOST(:,:,:,3) = Z_NORM_TEMPO(:,:,:,3)/Z_NORM_TEMP2(:,:,:)
+ ELSEWHERE
+ Z_NORM_GHOST(:,:,:,1) = 0.
+ Z_NORM_GHOST(:,:,:,2) = 0.
+ Z_NORM_GHOST(:,:,:,3) = 1.
+ ENDWHERE
+ !
+ WHERE (abs(Z_NORM_TEMP2(:,:,:)) .gt. XIBM_EPSI)
+ Z_NORM_TEMPO(:,:,:,1) = 1./Z_NORM_TEMP2(:,:,:)
+ Z_NORM_TEMPO(:,:,:,2) = 1./Z_NORM_TEMP2(:,:,:)
+ Z_NORM_TEMPO(:,:,:,3) = 1./Z_NORM_TEMP2(:,:,:)
+ ELSEWHERE
+ Z_NORM_TEMPO(:,:,:,1) = 1.
+ Z_NORM_TEMPO(:,:,:,2) = 1.
+ Z_NORM_TEMPO(:,:,:,3) = 1.
+ ENDWHERE
+ !
+ DO JMM = 1, I_NUMB_LAYER
+ !
+ DO JM = 1, I_NUMB_GHOST(JL,JMM)
+ !
+ ! ghost index
+ IF (JL==1) THEN
+ I_INDE_TEMPO(:) = NIBM_GHOST_P(JM,JMM,JL ,:)
+ ELSE
+ I_INDE_TEMPO(:) = NIBM_GHOST_V(JM,JMM,JL-1,:)
+ ENDIF
+ JI2 = I_INDE_TEMPO(1)
+ JJ2 = I_INDE_TEMPO(2)
+ JK2 = I_INDE_TEMPO(3)
+ !
+ ! ghost location
+ Z_GHO(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JL)
+ ZLGHO = (abs(Z_GHO(1,1)-Z_GHO(8,1))* &
+ abs(Z_GHO(1,2)-Z_GHO(8,2))* &
+ abs(Z_GHO(1,3)-Z_GHO(8,3)))**(1./3.)
+ ZVECT(1) = Z_GHO(1,1)
+ ZVECT(2) = Z_GHO(1,2)
+ ZVECT(3) = Z_GHO(1,3)
+ !
+ PPHI_TEST = ABS(Z_NORM_GHOST(JI2,JJ2,JK2,1))+ABS(Z_NORM_GHOST(JI2,JJ2,JK2,2))+ABS(Z_NORM_GHOST(JI2,JJ2,JK2,3))
+ PPHI_CORR = MAX(PPHI(JI2,JJ2,JK2,JL),(JMM*1.-1.)*ZLGHO*PPHI_TEST)
+ PPHI_CORR = MIN(PPHI_CORR ,(JMM*1.+0.)*ZLGHO*PPHI_TEST)
+ !
+ ! Storage of mirror/image1/image2/mirror locations
+ IF (JL==1) THEN
+ XIBM_IMAGE_P(JM,JMM,JL ,1,:) = (1.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_P(JM,JMM,JL ,2,:) = (2.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_P(JM,JMM,JL ,3,:) = (0.5*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_GHOST_P(JM,JMM,JL ,:) = ZVECT(:)
+ XIBM_IMAGE_P(JM,JMM,JL ,1,3) = MAX(XIBM_EPSI,XIBM_IMAGE_P(JM,JMM,JL ,1,3))
+ XIBM_IMAGE_P(JM,JMM,JL ,2,3) = MAX(XIBM_EPSI,XIBM_IMAGE_P(JM,JMM,JL ,2,3))
+ XIBM_IMAGE_P(JM,JMM,JL ,3,3) = MAX(XIBM_EPSI,XIBM_IMAGE_P(JM,JMM,JL ,3,3))
+ XIBM_GHOST_P(JM,JMM,JL ,3) = MAX(XIBM_EPSI,XIBM_GHOST_P(JM,JMM,JL ,3))
+ ELSE
+ XIBM_IMAGE_V(JM,JMM,JL-1,1,:) = (1.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_V(JM,JMM,JL-1,2,:) = (2.0*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_IMAGE_V(JM,JMM,JL-1,3,:) = (0.5*ZLGHO+PPHI_CORR)*Z_NORM_GHOST(JI2,JJ2,JK2,:) + ZVECT(:)
+ XIBM_GHOST_V(JM,JMM,JL-1 ,:) = ZVECT(:)
+ XIBM_IMAGE_V(JM,JMM,JL-1,1,3) = MAX(XIBM_EPSI,XIBM_IMAGE_V(JM,JMM,JL-1,1,3))
+ XIBM_IMAGE_V(JM,JMM,JL-1,2,3) = MAX(XIBM_EPSI,XIBM_IMAGE_V(JM,JMM,JL-1,2,3))
+ XIBM_IMAGE_V(JM,JMM,JL-1,3,3) = MAX(XIBM_EPSI,XIBM_IMAGE_V(JM,JMM,JL-1,3,3))
+ XIBM_GHOST_V(JM,JMM,JL-1 ,3) = MAX(XIBM_EPSI,XIBM_GHOST_V(JM,JMM,JL-1 ,3))
+ ENDIF
+ !
+ ! iterative procedure to find image cell
+ ZISI = 0.
+ ZJSI = 0.
+ ZKSI = 0.
+ IF (abs(Z_NORM_GHOST(JI2,JJ2,JK2,1)).gt.XIBM_EPSI) THEN
+ ZISI =Z_NORM_GHOST(JI2,JJ2,JK2,1)/abs(Z_NORM_GHOST(JI2,JJ2,JK2,1))
+ ENDIF
+ IF (abs(Z_NORM_GHOST(JI2,JJ2,JK2,2)).gt.XIBM_EPSI) THEN
+ ZJSI =Z_NORM_GHOST(JI2,JJ2,JK2,2)/abs(Z_NORM_GHOST(JI2,JJ2,JK2,2))
+ ENDIF
+ IF (abs(Z_NORM_GHOST(JI2,JJ2,JK2,3)).gt.XIBM_EPSI) THEN
+ ZKSI =Z_NORM_GHOST(JI2,JJ2,JK2,3)/abs(Z_NORM_GHOST(JI2,JJ2,JK2,3))
+ ENDIF
+ JIM1 = 3-2*JMM*int(min(0.,ZISI))
+ JIP1 = 3+2*JMM*int(max(0.,ZISI))
+ JJM1 = 3-2*JMM*int(min(0.,ZJSI))
+ JJP1 = 3+2*JMM*int(max(0.,ZJSI))
+ JKM1 = 3-2*JMM*int(min(0.,ZKSI))
+ JKP1 = 3+2*JMM*int(max(0.,ZKSI))
+ JIM2=max(1 ,JI2-JIM1)
+ JIP2=min(IIU-1,JI2+JIP1)
+ JJM2=max(1 ,JJ2-JJM1)
+ JJP2=min(IJU-1,JJ2+JJP1)
+ JKM2=max(1 ,JK2-JKM1)
+ JKP2=min(IKU-1,JK2+JKP1)
+ !
+ JN1 = 1
+ JN2 = 1
+ IF (JL/=1) THEN
+ JN1 = 2
+ JN2 = 4
+ ENDIF
+ !
+ DO JNN=1,3
+ !
+ ! image1/image2/mirror location
+ IF (JL==1) THEN
+ ZVECT(:) = XIBM_IMAGE_P(JM,JMM,JL ,JNN,:)
+ ELSE
+ ZVECT(:) = XIBM_IMAGE_V(JM,JMM,JL-1,JNN,:)
+ ENDIF
+ !
+ DO JN =JN1,JN2
+ !
+ ! search image depending on location type
+ ZSEAR = 0.
+ DO JK= JKM2,JKP2
+ DO JJ= JJM2,JJP2
+ DO JI= JIM2,JIP2
+ !
+ ! nodes of the potential image cell
+ I_INDE_TEMPO(1) = JI
+ I_INDE_TEMPO(2) = JJ
+ I_INDE_TEMPO(3) = JK
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ !
+ ! location of the potential cell
+ ZPROD(1) = min(Z_IMG(1,1),Z_IMG(2,1),Z_IMG(3,1),Z_IMG(4,1),&
+ Z_IMG(5,1),Z_IMG(6,1),Z_IMG(7,1),Z_IMG(8,1))
+ ZPROD(2) = max(Z_IMG(1,1),Z_IMG(2,1),Z_IMG(3,1),Z_IMG(4,1),&
+ Z_IMG(5,1),Z_IMG(6,1),Z_IMG(7,1),Z_IMG(8,1))
+ ZPROD(3) = min(Z_IMG(1,2),Z_IMG(2,2),Z_IMG(3,2),Z_IMG(4,2),&
+ Z_IMG(5,2),Z_IMG(6,2),Z_IMG(7,2),Z_IMG(8,2))
+ ZPROD(4) = max(Z_IMG(1,2),Z_IMG(2,2),Z_IMG(3,2),Z_IMG(4,2),&
+ Z_IMG(5,2),Z_IMG(6,2),Z_IMG(7,2),Z_IMG(8,2))
+ ZPROD(5) = min(Z_IMG(1,3),Z_IMG(2,3),Z_IMG(3,3),Z_IMG(4,3),&
+ Z_IMG(5,3),Z_IMG(6,3),Z_IMG(7,3),Z_IMG(8,3))
+ ZPROD(6) = max(Z_IMG(1,3),Z_IMG(2,3),Z_IMG(3,3),Z_IMG(4,3),&
+ Z_IMG(5,3),Z_IMG(6,3),Z_IMG(7,3),Z_IMG(8,3))
+ !
+ IF (((ZVECT(1).gt.(ZPROD(1)-XIBM_EPSI)).and.(ZVECT(1).lt.(ZPROD(2)+XIBM_EPSI))).and.&
+ ((ZVECT(2).gt.(ZPROD(3)-XIBM_EPSI)).and.(ZVECT(2).lt.(ZPROD(4)+XIBM_EPSI))).and.&
+ ((ZVECT(3).gt.(ZPROD(5)-XIBM_EPSI)).and.(ZVECT(3).lt.(ZPROD(6)+XIBM_EPSI)))) THEN
+ !
+ JI3=JI
+ JJ3=JJ
+ JK3=JK
+ !
+ IF (JL==1) THEN
+ ZSEAR = 0.5
+ NIBM_IMAGE_P(JM,JMM,JL ,JN ,JNN,1) = JI3
+ NIBM_IMAGE_P(JM,JMM,JL ,JN ,JNN,2) = JJ3
+ NIBM_IMAGE_P(JM,JMM,JL ,JN ,JNN,3) = MAX(JK3,IKB)
+ I_INDE_TEMPO2(1)= JI3
+ I_INDE_TEMPO2(2)= JJ3
+ I_INDE_TEMPO2(3)= JK3
+ Z_PHI(:) = IBM_VALUECORN(PPHI(:,:,:,JN),I_INDE_TEMPO2)
+ IF (JMM==1) ZIBM_TESTI = 0.
+ IF (JMM/=1) ZIBM_TESTI = 1.
+ DO JP=1,8
+ IF (Z_PHI(JP).gt.-XIBM_EPSI) THEN
+ XIBM_TESTI_P(JM,JMM,JL ,JN ,JNN,JP)=0.
+ ELSE
+ XIBM_TESTI_P(JM,JMM,JL ,JN ,JNN,JP)=1.
+ ENDIF
+ ZIBM_TESTI = ZIBM_TESTI+XIBM_TESTI_P(JM,JMM,JL ,JN,JNN,JP)
+ ENDDO
+ IF (ZIBM_TESTI.gt.+XIBM_EPSI) THEN
+ IF (LIBM_TROUBLE) XIBM_SUTR(JI2,JJ2,JK2,JL)=0.
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3<=IIB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIB))
+ ENDIF
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3>=IIE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIE))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3<=IJB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJB))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3>=IJE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJE))
+ ENDIF
+ ZSEAR = 1.
+ ENDIF
+ GO TO 666
+ ELSE
+ ZSEAR = 0.5
+ NIBM_IMAGE_V(JM,JMM,JL-1,JN-1,JNN,1) = JI3
+ NIBM_IMAGE_V(JM,JMM,JL-1,JN-1,JNN,2) = JJ3
+ NIBM_IMAGE_V(JM,JMM,JL-1,JN-1,JNN,3) = MAX(JK3,IKB)
+ I_INDE_TEMPO2(1)= JI3
+ I_INDE_TEMPO2(2)= JJ3
+ I_INDE_TEMPO2(3)= JK3
+ Z_PHI(:) = IBM_VALUECORN(PPHI(:,:,:,JN),I_INDE_TEMPO2)
+ IF (JMM==1) ZIBM_TESTI = 0.
+ IF (JMM/=1) ZIBM_TESTI = 1.
+ DO JP=1,8
+ IF (Z_PHI(JP).gt.-XIBM_EPSI) THEN
+ XIBM_TESTI_V(JM,JMM,JL-1,JN-1,JNN,JP)=0.
+ ELSE
+ XIBM_TESTI_V(JM,JMM,JL-1,JN-1,JNN,JP)=1.
+ ENDIF
+ ZIBM_TESTI = ZIBM_TESTI+XIBM_TESTI_V(JM,JMM,JL-1,JN-1,JNN,JP)
+ ENDDO
+ IF (ZIBM_TESTI.gt.+XIBM_EPSI) THEN
+ IF (LIBM_TROUBLE) XIBM_SUTR(JI2,JJ2,JK2,JL)=0.
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3<=IIB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIB))
+ ENDIF
+ IF ((JI2>=IIB.AND.JI2<=IIE).AND.(JI3>=IIE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JI3-IIE))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3<=IJB).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJB))
+ ENDIF
+ IF ((JJ2>=IJB.AND.JJ2<=IJE).AND.(JJ3>=IJE).AND.(JMM==1)) THEN
+ JHALO = MAX(JHALO,ABS(JJ3-IJE))
+ ENDIF
+ ZSEAR = 1.
+ ENDIF
+ GO TO 666
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+666 CONTINUE
+ !
+ IF ((ZSEAR.gt.0.25).AND.(ZSEAR.lt.0.75).AND.(JMM==1)) THEN
+ ZPHI(JI2,JJ2,JK2,JL)=1.
+ IF (JL==1) THEN
+ WRITE(*,*)'===== IBM WARNING NEW ======'
+ WRITE(*,*)'Non detected PPP images cell'
+ WRITE(*,*)'ghost',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_P(JM,JMM,JL,1),XIBM_GHOST_P(JM,JMM,JL,2),XIBM_GHOST_P(JM,JMM,JL,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_P(JM,JMM,JL,JNN,1),XIBM_IMAGE_P(JM,JMM,JL,JNN,2),XIBM_IMAGE_P(JM,JMM,JL,JNN,3)
+ ELSE
+ WRITE(*,*)'===== IBM WARNING NEW ======'
+ WRITE(*,*)'Non detected UVW images cell'
+ WRITE(*,*)'ghost:',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_V(JM,JMM,JL-1,1),XIBM_GHOST_V(JM,JMM,JL-1,2),XIBM_GHOST_V(JM,JMM,JL-1,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_V(JM,JMM,JL-1,JNN,1),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,2),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,3)
+ ENDIF
+ I_INDE_TEMPO(1) = JIM2
+ I_INDE_TEMPO(2) = JJM2
+ I_INDE_TEMPO(3) = JKM2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MIN',Z_IMG(1,1),Z_IMG(1,2),Z_IMG(1,3)
+ I_INDE_TEMPO(1) = JIP2
+ I_INDE_TEMPO(2) = JJP2
+ I_INDE_TEMPO(3) = JKP2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MAX',Z_IMG(8,1),Z_IMG(8,2),Z_IMG(8,3)
+ ENDIF
+ !
+ IF ((ZSEAR.lt.0.25).AND.(JMM==1)) THEN
+ ZPHI(JI2,JJ2,JK2,JL)=1.
+ IF (JL==1) THEN
+ WRITE(*,*)'===== IBM WARNING ======'
+ WRITE(*,*)'Non detected PPP images cell'
+ WRITE(*,*)'ghost',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_P(JM,JMM,JL,1),XIBM_GHOST_P(JM,JMM,JL,2),XIBM_GHOST_P(JM,JMM,JL,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_P(JM,JMM,JL,JNN,1),XIBM_IMAGE_P(JM,JMM,JL,JNN,2),XIBM_IMAGE_P(JM,JMM,JL,JNN,3)
+ ELSE
+ WRITE(*,*)'===== IBM WARNING ======'
+ WRITE(*,*)'Non detected UVW images cell'
+ WRITE(*,*)'ghost:',JI2,JJ2,JK2
+ WRITE(*,*)'ghost typ',JL,JMM
+ WRITE(*,*)'levelset',PPHI(JI2,JJ2,JK2,JL)
+ WRITE(*,*)XIBM_GHOST_V(JM,JMM,JL-1,1),XIBM_GHOST_V(JM,JMM,JL-1,2),XIBM_GHOST_V(JM,JMM,JL-1,3)
+ WRITE(*,*)Z_NORM_GHOST(JI2,JJ2,JK2,1),Z_NORM_GHOST(JI2,JJ2,JK2,2),Z_NORM_GHOST(JI2,JJ2,JK2,3)
+ WRITE(*,*)Z_NORM_TEMPO(JI2,JJ2,JK2,1),Z_NORM_TEMPO(JI2,JJ2,JK2,2),Z_NORM_TEMPO(JI2,JJ2,JK2,3)
+ WRITE(*,*)'image loc:',JN
+ WRITE(*,*)'image typ:',JNN
+ WRITE(*,*)XIBM_IMAGE_V(JM,JMM,JL-1,JNN,1),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,2),XIBM_IMAGE_V(JM,JMM,JL-1,JNN,3)
+ ENDIF
+ I_INDE_TEMPO(1) = JIM2
+ I_INDE_TEMPO(2) = JJM2
+ I_INDE_TEMPO(3) = JKM2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MIN',Z_IMG(1,1),Z_IMG(1,2),Z_IMG(1,3)
+ I_INDE_TEMPO(1) = JIP2
+ I_INDE_TEMPO(2) = JJP2
+ I_INDE_TEMPO(3) = JKP2
+ Z_IMG(:,:) = IBM_LOCATCORN(I_INDE_TEMPO,JN)
+ WRITE(*,*)'LOC MAX',Z_IMG(8,1),Z_IMG(8,2),Z_IMG(8,3)
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+667 CONTINUE
+ !
+ IF ((NHALO<=JHALO).AND.(JMM==1)) WRITE(*,*)'### WARNING HALO ###',JHALO,IP
+ !
+ ENDDO
+ WRITE(*,*)'### HALO ###',NHALO,JHALO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(I_INDE_TEMPO,I_INDE_TEMPO2,I_NUMB_GHOST)
+ DEALLOCATE(Z_NORM_GHOST,Z_NORM_TEMPO,Z_NORM_TEMP1,Z_NORM_TEMP2,Z_NORM_TEMP3)
+ DEALLOCATE(ZVECT,ZPROD,ZPHI)
+ DEALLOCATE(Z_PHI,Z_IMG,Z_GHO)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_DETECT
diff --git a/src/MNH/ibm_forcing.f90 b/src/MNH/ibm_forcing.f90
new file mode 100644
index 0000000000000000000000000000000000000000..435df5ecf40d34496d93db727f57046ff656bd77
--- /dev/null
+++ b/src/MNH/ibm_forcing.f90
@@ -0,0 +1,314 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_FORCING
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_FORCING(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT), OPTIONAL :: PTKS
+ !
+ END SUBROUTINE IBM_FORCING
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_FORCING
+!
+! ##########################################################
+SUBROUTINE IBM_FORCING(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ ! ##########################################################
+ !
+ !!**** *IBM_FORCING* - routine to force all desired fields
+ !!
+ !! PURPOSE
+ !! -------
+ ! The purpose of this routine is to compute variables in the virtual
+ ! embedded solid region in regard of variables computed in the real
+ ! fluid region
+ !
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !! NONE
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_CST
+ USE MODD_FIELD_n
+ USE MODD_REF
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XEXNREF,XRVREF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_IBM_PARAM_n
+ USE MODD_LBC_n
+ USE MODD_CONF
+ USE MODD_CONF_n
+ USE MODD_NSV
+ USE MODD_CTURB
+ USE MODD_PARAM_n
+ USE MODD_DYN_n, ONLY: XTSTEP
+ !
+ ! interface
+ USE MODI_IBM_AFFECTV
+ USE MODI_IBM_AFFECTP
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT), OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT), OPTIONAL :: PTKS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ REAL, DIMENSION(:,:,:) , ALLOCATABLE :: ZTMP,ZXMU,ZDIV,ZTKE
+ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTMU,ZTRY
+ INTEGER :: IIU,IJU,IKU,IKB,IKE
+ INTEGER :: JRR,JSV
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ !
+ IIU = SIZE(PRUS,1)
+ IJU = SIZE(PRVS,2)
+ IKU = SIZE(PRWS,3)
+ !
+ ALLOCATE(ZTMU(IIU,IJU,IKU,3),ZTMP(IIU,IJU,IKU),ZTRY(IIU,IJU,IKU,3), &
+ ZXMU(IIU,IJU,IKU),ZDIV(IIU,IJU,IKU),ZTKE(IIU,IJU,IKU))
+ !
+ ZTMU=0.
+ ZXMU=0.
+ ZDIV=0.
+ ZTMP=0.
+ ZTRY=0.
+ !
+ IKB = 1 + JPVEXT
+ IKE = IKU - JPVEXT
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ IF (NSV>=1) THEN
+ !
+ DO JSV=1,NSV
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PSVS(:,:,:,JSV) = XIBM_EPSI**1.5
+ ENDDO
+ !
+ ENDIF
+ !
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PTHS(:,:,:) = XTHVREF(:,:,:)
+ !
+ IF (NRR>=1) THEN
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI)
+ PRRS(:,:,:,1) = XRVREF(:,:,:)
+ PTHS(:,:,:) = XTHVREF(:,:,:)/(1.+XRD/XRV*XRVREF(:,:,:))
+ ENDWHERE
+ ENDIF
+ IF (NRR>=2) THEN
+ DO JRR=2,NRR
+ WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PRRS(:,:,:,JRR) = XIBM_EPSI
+ ENDDO
+ ENDIF
+ !
+ WHERE (XIBM_LS(:,:,:,2).GT.XIBM_EPSI) PRUS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,3).GT.XIBM_EPSI) PRVS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,4).GT.XIBM_EPSI) PRWS(:,:,:) = XIBM_EPSI
+ IF (CTURB/='NONE') WHERE (XIBM_LS(:,:,:,1).GT.XIBM_EPSI) PTKS(:,:,:) = XTKEMIN
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! ======================
+ ! === SCALAR FORCING ===
+ ! ======================
+ !
+ IF (CTURB/='NONE') THEN
+ ZTMP(:,:,:) = PTKS(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ ZXMU(:,:,:) = XIBM_XMUT(:,:,:)
+ ZDIV(:,:,:) = XIBM_CURV(:,:,:)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_E,XIBM_RADIUS_E,XIBM_POWERS_E,&
+ CIBM_MODE_INTE1_E,CIBM_MODE_INTE3_E,&
+ CIBM_TYPE_BOUND_E,CIBM_MODE_BOUND_E,&
+ CIBM_FORC_BOUND_E,XIBM_FORC_BOUND_E,ZXMU,ZDIV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=XTKEMIN
+ PTKS(:,:,:)=MAX(XTKEMIN,ZTMP(:,:,:))
+ ENDIF
+ !
+ ZTMP(:,:,:) = PTHS(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_T,XIBM_RADIUS_T,XIBM_POWERS_T,&
+ CIBM_MODE_INTE1_T,CIBM_MODE_INTE3_T,&
+ CIBM_TYPE_BOUND_T,CIBM_MODE_BOUND_T,&
+ CIBM_FORC_BOUND_T,XIBM_FORC_BOUND_T,ZXMU,ZDIV)
+ ZTMP(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PTHS(:,:,:) = MAX(ZTMP(:,:,:),250.)
+ !
+ IF (NRR>=1) THEN
+ DO JRR=1,NRR
+ ZTMP(:,:,:) = PRRS(:,:,:,JRR)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_R,XIBM_RADIUS_R,XIBM_POWERS_R,&
+ CIBM_MODE_INTE1_R,CIBM_MODE_INTE3_R,&
+ CIBM_TYPE_BOUND_R,CIBM_MODE_BOUND_R,&
+ CIBM_FORC_BOUND_R,XIBM_FORC_BOUND_R,ZXMU,ZDIV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PRRS(:,:,:,JRR) = ZTMP(:,:,:)
+ ENDDO
+ ENDIF
+ !
+ IF (NSV>=1) THEN
+ DO JSV=1,NSV
+ ZTMP(:,:,:) = PSVS(:,:,:,JSV)
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ CALL IBM_AFFECTP(ZTMP,NIBM_LAYER_S,XIBM_RADIUS_S,XIBM_POWERS_S,&
+ CIBM_MODE_INTE1_S,CIBM_MODE_INTE3_S,&
+ CIBM_TYPE_BOUND_S,CIBM_MODE_BOUND_S,&
+ CIBM_FORC_BOUND_S,XIBM_FORC_BOUND_S,ZXMU,ZDIV)
+ ZTMP(:,:,:) = MAX(XIBM_EPSI**1.5,ZTMP(:,:,:))
+ ZTMP(:,:,IKB-1)=ZTMP(:,:,IKB)
+ ZTMP(:,:,IKE+1)=ZTMP(:,:,IKE)
+ PSVS(:,:,:,JSV) = ZTMP(:,:,:)
+ ENDDO
+ ENDIF
+ !
+ !=======================
+ ! === VECTOR FORCING ===
+ ! ======================
+ !
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ ZTMU(:,:,:,1) = PRUS(:,:,:)
+ ZTMU(:,:,:,2) = PRVS(:,:,:)
+ ZTMU(:,:,:,3) = PRWS(:,:,:)
+ !
+ ZTMP(:,:,:) = PRUS(:,:,:)
+ ZXMU(:,:,:) = MXM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MXM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'U',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRUS(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,:) = PRVS(:,:,:)
+ ZXMU(:,:,:) = MYM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MYM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'V',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRVS(:,:,:) = ZTMP(:,:,:)
+ ZTMP(:,:,:) = PRWS(:,:,:)
+ ZXMU(:,:,:) = MZM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MZM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'W',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRWS(:,:,:) = ZTMP(:,:,:)
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ !**** 3. COMMUNICATIONS
+ ! -----------------
+ !
+ IF (.NOT. LIBM_TROUBLE) THEN
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PTHS(:,:,:),'IBM_FORCING::PTHS')
+ IF (CTURB/='NONE') CALL ADD3DFIELD_ll(TZFIELDS_ll,PTKS(:,:,:),'IBM_FORCING::PTKS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING::PRWS')
+ IF (NRR>=1) THEN
+ DO JRR=1,NRR
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRRS(:,:,:,JRR),'IBM_FORCING::PRRS')
+ ENDDO
+ ENDIF
+ IF (NSV>=1) THEN
+ DO JSV=1,NSV
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PSVS(:,:,:,JSV),'IBM_FORCING::PSVS')
+ ENDDO
+ ENDIF
+ !
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ ENDIF
+ !
+ !**** 4. DEALLOCATIONS
+ ! ----------------
+ !
+ DEALLOCATE(ZTMP,ZTMU,ZTRY,ZXMU,ZDIV,ZTKE)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_FORCING
diff --git a/src/MNH/ibm_forcing_adv.f90 b/src/MNH/ibm_forcing_adv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b7692031e773aa1fd7441264c9af62e8934fcffe
--- /dev/null
+++ b/src/MNH/ibm_forcing_adv.f90
@@ -0,0 +1,185 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! ###########################
+MODULE MODI_IBM_FORCING_ADV
+ ! ###########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_FORCING_ADV(PRUS,PRVS,PRWS)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PRUS,PRVS,PRWS
+ !
+ END SUBROUTINE IBM_FORCING_ADV
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_FORCING_ADV
+!
+!
+! ##########################################
+SUBROUTINE IBM_FORCING_ADV(PRUS,PRVS,PRWS)
+ ! ##########################################
+ !
+ !!**** *IBM_FORCING_ADV* - routine to force all desired fields in the RK
+ !!
+ !! PURPOSE
+ !! -------
+ ! The purpose of this routine is to compute variables in the virtual
+ ! embedded solid region in regard of variables computed in the real
+ ! fluid region
+ !
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !! NONE
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_CST
+ USE MODD_FIELD_n
+ USE MODD_REF
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XEXNREF,XRVREF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_IBM_PARAM_n
+ USE MODD_LBC_n
+ USE MODD_CONF
+ USE MODD_CONF_n
+ USE MODD_NSV
+ USE MODD_CTURB
+ USE MODD_PARAM_n
+ USE MODD_DYN_n, ONLY: XTSTEP
+ !
+ ! interface
+ USE MODI_IBM_AFFECTV
+ USE MODI_IBM_AFFECTP
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PRUS,PRVS,PRWS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ REAL, DIMENSION(:,:,:) , ALLOCATABLE :: ZTMP,ZXMU,ZDIV,ZTKE
+ REAL, DIMENSION(:,:,:,:) , ALLOCATABLE :: ZTMU,ZTRY
+ INTEGER :: IIU,IJU,IKU,IKB,IKE
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ !
+ IIU = SIZE(PRUS,1)
+ IJU = SIZE(PRVS,2)
+ IKU = SIZE(PRWS,3)
+ ALLOCATE(ZTMU(IIU,IJU,IKU,3),ZTMP(IIU,IJU,IKU),ZTRY(IIU,IJU,IKU,3), &
+ ZXMU(IIU,IJU,IKU),ZDIV(IIU,IJU,IKU),ZTKE(IIU,IJU,IKU))
+ !
+ ZTMU=0.
+ ZXMU=0.
+ ZDIV=0.
+ ZTMP=0.
+ ZTRY=0.
+ !
+ IKB = 1 + JPVEXT
+ IKE = IKU - JPVEXT
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ WHERE (XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) PRUS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) PRVS(:,:,:) = XIBM_EPSI
+ WHERE (XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) PRWS(:,:,:) = XIBM_EPSI
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ ZTMU(:,:,:,1) = PRUS(:,:,:)/MXM(XRHODREF)
+ ZTMU(:,:,:,2) = PRVS(:,:,:)/MYM(XRHODREF)
+ ZTMU(:,:,:,3) = PRWS(:,:,:)/MZM(XRHODREF)
+ !
+ ZTMP(:,:,:) = PRUS(:,:,:)/MXM(XRHODREF)
+ ZXMU(:,:,:) = MXM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MXM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'U',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRUS(:,:,:) = ZTMP(:,:,:)*MXM(XRHODREF)
+ !
+ ZTMP(:,:,:) = PRVS(:,:,:)/MYM(XRHODREF)
+ ZXMU(:,:,:) = MYM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MYM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'V',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRVS(:,:,:) = ZTMP(:,:,:)*MYM(XRHODREF)
+ !
+ ZTMP(:,:,:) = PRWS(:,:,:)/MZM(XRHODREF)
+ ZXMU(:,:,:) = MZM(XIBM_XMUT(:,:,:))
+ ZDIV(:,:,:) = MZM(XIBM_CURV(:,:,:))
+ CALL IBM_AFFECTV(ZTMP,ZTMU,ZTRY,'W',NIBM_LAYER_V,CIBM_MODE_INTE3_V,&
+ CIBM_FORC_BOUNR_V,XIBM_RADIUS_V,XIBM_POWERS_V,&
+ CIBM_MODE_INTE1NV,CIBM_TYPE_BOUNN_V,CIBM_MODE_BOUNN_V,CIBM_FORC_BOUNN_V ,XIBM_FORC_BOUNN_V,&
+ CIBM_MODE_INTE1TV,CIBM_TYPE_BOUNT_V,CIBM_MODE_BOUNT_V,CIBM_FORC_BOUNT_V ,XIBM_FORC_BOUNT_V,&
+ CIBM_MODE_INTE1CV,CIBM_TYPE_BOUNC_V,CIBM_MODE_BOUNC_V,CIBM_FORC_BOUNC_V ,XIBM_FORC_BOUNC_V,ZXMU,ZDIV)
+ PRWS(:,:,:) = ZTMP(:,:,:)*MZM(XRHODREF)
+ !
+ !**** 3. COMMUNICATIONS
+ ! -----------------
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_ADV::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_ADV::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_ADV::PRWS')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !**** 4. DEALLOCATIONS
+ ! ----------------
+ !
+ DEALLOCATE(ZTMP,ZTMU,ZTRY,ZXMU,ZDIV,ZTKE)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_FORCING_ADV
diff --git a/src/MNH/ibm_forcing_tr.f90 b/src/MNH/ibm_forcing_tr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..832217ea17adedd6c605b76ae372074927ad365e
--- /dev/null
+++ b/src/MNH/ibm_forcing_tr.f90
@@ -0,0 +1,410 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! ##########################
+MODULE MODI_IBM_FORCING_TR
+ ! ##########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_FORCING_TR(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT),OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT),OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT),OPTIONAL :: PTKS
+ !
+ END SUBROUTINE IBM_FORCING_TR
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_FORCING_TR
+!
+!
+! #############################################################
+SUBROUTINE IBM_FORCING_TR(PRUS,PRVS,PRWS,PTHS,PRRS,PSVS,PTKS)
+ ! #############################################################
+ !
+ !!**** *IBM_FORCING_TR* - routine to force all desired fields
+ !!
+ !! PURPOSE
+ !! -------
+ ! The purpose of this routine is to compute variables in the virtual
+ ! embedded solid region in regard of variables computed in the real
+ ! fluid region
+ !
+ !! METHOD
+ !! ------
+ !!
+ !! EXTERNAL
+ !! --------
+ !! NONE
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste * CERFACS(AE) *
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !!
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+ !
+ ! declaration
+ USE MODD_CST, ONLY: XRD,XRV
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF,XTHVREF,XRVREF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_IBM_PARAM_n
+ USE MODD_LBC_n
+ USE MODD_CONF
+ USE MODD_CONF_n
+ USE MODD_NSV
+ USE MODD_CTURB
+ USE MODD_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PRUS,PRVS,PRWS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT) :: PTHS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT),OPTIONAL :: PRRS
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT),OPTIONAL :: PSVS
+ REAL, DIMENSION(:,:,:) ,INTENT(INOUT),OPTIONAL :: PTKS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: JI,JJ,JK,JI2,JJ2,JK2,IIU,IJU,IKU,JL
+ INTEGER :: JIM1,JJM1,JKM1,JIP1,JJP1,JKP1
+ INTEGER :: IIE,IIB,IJE,IJB,IKB,IKE
+ REAL :: ZSUM1,ZSUM2,ZSUM4
+ REAL, DIMENSION(:), ALLOCATABLE :: ZSUM3,ZSUM5
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ IIU = SIZE(PRUS,1)
+ IJU = SIZE(PRUS,2)
+ IKU = SIZE(PRUS,3)
+ IKB = 1 + JPVEXT
+ IKE = SIZE(PRUS,3) - JPVEXT
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! Problems in GCT ? => imposition of the adjacent value
+ DO JI=IIB,IIE
+ DO JJ=IJB,IJE
+ DO JK=IKB,IKE
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,1).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ IF (NSV>=1) ALLOCATE(ZSUM3(NSV))
+ ZSUM3 = 0.
+ ZSUM4 = 0.
+ IF (NRR>=1) ALLOCATE(ZSUM5(NRR))
+ ZSUM5 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ !
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,1))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,1))*PTHS(JI2,JJ2,JK2)
+ IF (NRR>=1) THEN
+ DO JL = 1,NRR
+ ZSUM5(JL) = ZSUM5(JL) + (XIBM_SUTR(JI2,JJ2,JK2,1))*PRRS(JI2,JJ2,JK2,JL)
+ ENDDO
+ ENDIF
+ IF (NSV>=1) THEN
+ DO JL = 1,NSV
+ ZSUM3(JL) = ZSUM3(JL) + (XIBM_SUTR(JI2,JJ2,JK2,1))*PSVS(JI2,JJ2,JK2,JL)
+ ENDDO
+ ENDIF
+ IF (CTURB/='NONE') ZSUM4 = ZSUM4 + (XIBM_SUTR(JI2,JJ2,JK2,1))*PTKS(JI2,JJ2,JK2)
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PTHS(JI,JJ,JK) = XTHVREF(JI,JJ,JK)
+ IF (NRR>=1) PTHS(JI,JJ,JK) = XTHVREF(JI,JJ,JK)/(1.+XRD/XRV*XRVREF(JI,JJ,JK))
+ IF (ZSUM1.GT.XIBM_EPSI) PTHS(JI,JJ,JK) = ZSUM2/ZSUM1
+ IF (NRR>=1) THEN
+ PRRS(JI,JJ,JK,1) = XRVREF(JI,JJ,JK)
+ IF (ZSUM1.GT.XIBM_EPSI) PRRS(JI,JJ,JK,1) = ZSUM5(1)/ZSUM1
+ IF (NRR>=2) THEN
+ DO JL = 2,NRR
+ PRRS(JI,JJ,JK,JL) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRRS(JI,JJ,JK,JL) = ZSUM5(JL)/ZSUM1
+ ENDDO
+ ENDIF
+ ENDIF
+ !
+ IF (NSV>=1) THEN
+ DO JL = 1,NSV
+ PSVS(JI,JJ,JK,JL) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PSVS(JI,JJ,JK,JL) = ZSUM3(JL)/ZSUM1
+ ENDDO
+ ENDIF
+ !
+ IF (CTURB/='NONE') PTKS(JI,JJ,JK) = XTKEMIN
+ IF (ZSUM1.GT.XIBM_EPSI.AND.(CTURB/='NONE')) PTKS(JI,JJ,JK) = ZSUM4/ZSUM1
+ IF (NSV>=1) DEALLOCATE(ZSUM3)
+ IF (NRR>=1) DEALLOCATE(ZSUM5)
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,2).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,2))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,2))*PRUS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRUS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,3).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,3))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,3))*PRVS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRVS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRVS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ !
+ IF (XIBM_SUTR(JI,JJ,JK,4).LT.0.5) THEN
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM1 = 0.
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM1 = ZSUM1 + (XIBM_SUTR(JI2,JJ2,JK2,4))
+ ZSUM2 = ZSUM2 + (XIBM_SUTR(JI2,JJ2,JK2,4))*PRWS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRWS(JI,JJ,JK) = 0.
+ IF (ZSUM1.GT.XIBM_EPSI) PRWS(JI,JJ,JK) = ZSUM2/ZSUM1
+ !
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PTHS(:,:,IKB-1)=PTHS(:,:,IKB)
+ PTHS(:,:,IKE+1)=PTHS(:,:,IKE)
+ IF (CTURB/='NONE') PTKS(:,:,IKB-1)=PTKS(:,:,IKB)
+ IF (CTURB/='NONE') PTKS(:,:,IKE+1)=PTKS(:,:,IKE)
+ IF (NSV>=1) PSVS(:,:,IKB-1,:)=PSVS(:,:,IKB,:)
+ IF (NSV>=1) PSVS(:,:,IKE+1,:)=PSVS(:,:,IKE,:)
+ IF (NRR>=1) PRRS(:,:,IKB-1,:)=PRRS(:,:,IKB,:)
+ IF (NRR>=1) PRRS(:,:,IKE+1,:)=PRRS(:,:,IKE,:)
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PTHS(:,:,:),'IBM_FORCING_TR::PTHS')
+ IF (CTURB/='NONE') CALL ADD3DFIELD_ll(TZFIELDS_ll,PTKS(:,:,:),'IBM_FORCING_TR::PTKS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_TR::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_TR::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_TR::PRWS')
+ IF (NSV>=1) THEN
+ DO JL=1,NSV
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PSVS(:,:,:,JL),'IBM_FORCING_TR::PSVS')
+ ENDDO
+ ENDIF
+ IF (NRR>=1) THEN
+ DO JL=1,NRR
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRRS(:,:,:,JL),'IBM_FORCING_TR::PRRS')
+ ENDDO
+ ENDIF
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ ! Problems on corners ? => imposition of the adjacent value
+ !
+ DO JI=IIB,IIE
+ DO JJ=IJB,IJE
+ DO JK=IKB,IKE
+ !
+ IF (XIBM_LS(JI,JJ,JK,2).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI-1,JJ,JK))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRUS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(JI,JJ,JK) = (1.-ZSUM1)*PRUS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ !
+ IF (XIBM_LS(JI,JJ,JK,3).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI,JJ-1,JK))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRVS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRVS(JI,JJ,JK) = (1.-ZSUM1)*PRVS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ !
+ IF (XIBM_LS(JI,JJ,JK,4).GT.XIBM_EPSI) THEN
+ !
+ ZSUM1 = (XIBM_CURV(JI,JJ,JK)+XIBM_CURV(JI,JJ,JK-1))/2.
+ ZSUM1 = ABS(ZSUM1)
+ ZSUM1 = MIN(1.,ZSUM1)
+ !
+ JIM1 = JI-1
+ JJM1 = JJ-1
+ JKM1 = JK-1
+ JIP1 = JI+1
+ JJP1 = JJ+1
+ JKP1 = JK+1
+ ZSUM2 = 0.
+ !
+ DO JI2=JIM1,JIP1
+ DO JJ2=JJM1,JJP1
+ DO JK2=JKM1,JKP1
+ ZSUM2 = ZSUM2 + PRWS(JI2,JJ2,JK2)
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRWS(JI,JJ,JK) = (1.-ZSUM1)*PRWS(JI,JJ,JK)+ZSUM1*ZSUM2/27.
+ !
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ PRUS(:,:,IKB-1)=PRUS(:,:,IKB)
+ PRUS(:,:,IKE+1)=PRUS(:,:,IKE)
+ PRVS(:,:,IKB-1)=PRVS(:,:,IKB)
+ PRVS(:,:,IKE+1)=PRVS(:,:,IKE)
+ PRWS(:,:,IKB-1)=0.
+ PRWS(:,:,IKB) =0.
+ PRWS(:,:,IKE+1)=0.
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRUS(:,:,:),'IBM_FORCING_TR::PRUS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRVS(:,:,:),'IBM_FORCING_TR::PRVS')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PRWS(:,:,:),'IBM_FORCING_TR::PRWS')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_FORCING_TR
diff --git a/src/MNH/ibm_generls.f90 b/src/MNH/ibm_generls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a129d210930de85d7ade5ed783ce6c57c7714ad7
--- /dev/null
+++ b/src/MNH/ibm_generls.f90
@@ -0,0 +1,543 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_GENERLS
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_GENERLS(PIBM_FACES,PNORM_FACES,PV1,PV2,PV3,PX_MIN,PY_MIN,PX_MAX,PY_MAX,PPHI)
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PIBM_FACES
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PNORM_FACES,PV1,PV2,PV3
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ REAL ,INTENT(IN) :: PX_MIN,PY_MIN,PX_MAX,PY_MAX
+ !
+ END SUBROUTINE IBM_GENERLS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_GENERLS
+!
+! #####################################
+SUBROUTINE IBM_GENERLS(PIBM_FACES,PNORM_FACES,PV1,PV2,PV3,PX_MIN,PY_MIN,PX_MAX,PY_MAX,PPHI)
+ ! #####################################
+ !
+ !
+ !**** IBM_GENERLS computes the Level Set function for any surface
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to estimate the level set
+ ! containing XYZ minimalisation interface locations
+
+ ! METHOD
+ ! ------
+ !**** Iterative system and minimization of the interface distance
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ ! The method is based on '3D Distance from a Point to a Triangle'
+ ! a technical report from Mark W. Jones, University of Wales Swansea
+ !
+ ! AUTHORS
+ ! ------
+ ! Tim Nagel, Valéry Masson & Robert Schoetter
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/06/2021
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_IBM_LSF
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT,XUNDEF
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_CST, ONLY: XMNH_EPSILON
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_IBM_INTERPOS
+ USE MODI_IBM_DETECT
+ USE MODI_INI_CST
+ !
+ IMPLICIT NONE
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PIBM_FACES !faces coordinates
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PNORM_FACES !normal
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PV1,PV2,PV3
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions
+ REAL ,INTENT(IN) :: PX_MIN,PY_MIN,PX_MAX,PY_MAX
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JN,JM,JI2,JJ2,JK2 ! loop index
+ INTEGER :: JI_MIN,JI_MAX,JJ_MIN,JJ_MAX,JK_MIN,JK_MAX,IIU,IJU,IKU ! loop boundaries
+ REAL :: Z_DIST_TEST1,Z_DIST_TEST2 ! saving distances
+ REAL :: Z_DIST_TEST3,Z_DIST_TEST4,ZDIST_REF0
+ INTEGER :: INUMB_FACES ! number of faces
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATM,ZYHATM,ZZHATM,ZDP0PP0PAST
+ CHARACTER(LEN=1) :: YPOS
+ REAL, DIMENSION(3) :: ZP1P0,ZP1P2,ZP0PP0,ZP1PP0,ZP2PP0,ZP3PP0,ZPP0P1,ZPP0P2,ZPP0P3
+ REAL, DIMENSION(3) :: ZPP0PPP0,ZPPP0P1,ZPPP0P2,ZP2P1,ZP2P0,ZP2P3,ZP3P2,ZP3P1
+ REAL, DIMENSION(3) :: ZPP0,ZFT1,ZFT2,ZFT3,ZFT1B,ZFT2B,ZFT3B,ZR,ZPPP0,ZP3P0,ZP0P1
+ REAL, DIMENSION(3) :: ZPPP0P3,ZP1P3,ZPCP0,ZR0
+ REAL, DIMENSION(:), ALLOCATABLE :: ZSTEMP,ZRDIR,ZVECTDISTPLUS,ZVECTDISTMOINS,ZVECTDIST!,ZFACE
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZC
+ REAL :: ZF1,ZF2,ZF3,ZF1B,ZF2B,ZF3B,ZDPP0PPP0
+ REAL :: ZT,ZSIGN,ZS,ZDIST,ZDP0PP0,ZNNORM,ZRN,ZPHI_OLD
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll,IMI ! return code of parallel routine
+ INTEGER :: IIE,IIB,IJB,IJE,IKE,IKB,ZBPLUS
+ LOGICAL :: GABOVE_ROOF,LFACE,LDZ
+ LOGICAL, DIMENSION(:), ALLOCATABLE :: ZFACE
+ INTEGER :: ZCOUNT,ZIDX,ZII,ZCHANGE,ZCHANGE1
+ REAL :: ZDIFF,ZMIN_DIFF,ZDX
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 allocation
+ !
+ NULLIFY(TZFIELDS_ll)
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ IIB=1+JPHEXT
+ IIE=IIU-JPHEXT
+ IJB=1+JPHEXT
+ IJE=IJU-JPHEXT
+ IKB=1+JPVEXT
+ IKE=IKU-JPVEXT
+ !
+ JK_MIN = 1 + JPVEXT
+ JK_MAX = IKU - JPVEXT
+ !
+ CALL GET_INDICE_ll (JI_MIN,JJ_MIN,JI_MAX,JJ_MAX)
+ !
+ ALLOCATE(ZXHATM(IIU,IJU,IKU))
+ ALLOCATE(ZYHATM(IIU,IJU,IKU))
+ ALLOCATE(ZZHATM(IIU,IJU,IKU))
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ INUMB_FACES = SIZE(PIBM_FACES,1)
+ ALLOCATE(ZC(INUMB_FACES,3))
+ ALLOCATE(ZSTEMP(1))
+ ALLOCATE(ZRDIR(1))
+ PPHI = -XUNDEF
+ ALLOCATE(ZDP0PP0PAST(IIU,IJU,IKU))
+ ZDP0PP0PAST = 0.
+ ALLOCATE(ZVECTDIST(10000))
+ ALLOCATE(ZVECTDISTPLUS(10000))
+ ALLOCATE(ZVECTDISTMOINS(10000))
+ ALLOCATE(ZFACE(10000))
+ ZFACE=.FALSE.
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ JM=1
+ YPOS = 'P'
+ !
+ CALL IBM_INTERPOS(ZXHATM,ZYHATM,ZZHATM,YPOS)
+ ZDX = ZXHATM(JI_MIN+1,JJ_MIN,JK_MIN)-ZXHATM(JI_MIN,JJ_MIN,JK_MIN)
+ !
+ DO JK = JK_MIN,JK_MAX
+ DO JJ = JJ_MIN,JJ_MAX
+ DO JI = JI_MIN,JI_MAX
+ ZCOUNT = 1
+ ZVECTDIST = -999.
+ DO JN = 1,INUMB_FACES
+ LFACE=.FALSE.
+ !***Calcul of the face center
+ ZC(JN,1)=(PIBM_FACES(JN,1,1)+PIBM_FACES(JN,2,1)+PIBM_FACES(JN,3,1))/3.
+ ZC(JN,2)=(PIBM_FACES(JN,1,2)+PIBM_FACES(JN,2,2)+PIBM_FACES(JN,3,2))/3.
+ ZC(JN,3)=(PIBM_FACES(JN,1,3)+PIBM_FACES(JN,2,3)+PIBM_FACES(JN,3,3))/3.
+ !***Norm normalization
+ ZNNORM = SQRT(PNORM_FACES(JN,1)**2+PNORM_FACES(JN,2)**2+PNORM_FACES(JN,3)**2)
+ !***Vector between the face center and the current grid point
+ ZPCP0(1) = ZXHATM(JI,JJ,JK)-ZC(JN,1)
+ ZPCP0(2) = ZYHATM(JI,JJ,JK)-ZC(JN,2)
+ ZPCP0(3) = ZZHATM(JI,JJ,JK)-ZC(JN,3)
+ ZSIGN = ZPCP0(1)*PNORM_FACES(JN,1)+ &
+ ZPCP0(2)*PNORM_FACES(JN,2)+ &
+ ZPCP0(3)*PNORM_FACES(JN,3)
+ !***Various vectors
+ ZP1P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,1,1)
+ ZP1P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,1,2)
+ ZP1P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,1,3)
+ ZP3P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,3,1)
+ ZP3P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,3,2)
+ ZP3P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,3,3)
+ ZP0P1(1) = PIBM_FACES(JN,1,1)-ZXHATM(JI,JJ,JK)
+ ZP0P1(2) = PIBM_FACES(JN,1,2)-ZYHATM(JI,JJ,JK)
+ ZP0P1(3) = PIBM_FACES(JN,1,3)-ZZHATM(JI,JJ,JK)
+ ZP2P0(1) = ZXHATM(JI,JJ,JK)-PIBM_FACES(JN,2,1)
+ ZP2P0(2) = ZYHATM(JI,JJ,JK)-PIBM_FACES(JN,2,2)
+ ZP2P0(3) = ZZHATM(JI,JJ,JK)-PIBM_FACES(JN,2,3)
+ !***Equation (3) of Jones (1995)
+ IF(ZP1P0(1)==0.AND.ZP1P0(2)==0.AND.ZP1P0(3)==0) THEN
+ WRITE(*,*) 'ZP1P0(1,2,3)',ZP1P0(1),ZP1P0(2),ZP1P0(3)
+ ZDP0PP0 = 0.
+ ELSE
+ ZDP0PP0 = SQRT(ZP0P1(1)**2+ZP0P1(2)**2+ZP0P1(3)**2)* &
+ ((ZP1P0(1)*PNORM_FACES(JN,1)+ZP1P0(2)*PNORM_FACES(JN,2)+&
+ ZP1P0(3)*PNORM_FACES(JN,3))/( &
+ SQRT((ZP1P0(1))**2+(ZP1P0(2))**2+(ZP1P0(3))**2)*ZNNORM))
+ END IF
+ !***Equation (4) of Jones (1995)
+ ZP0PP0(1) = -ZDP0PP0*(PNORM_FACES(JN,1)/ZNNORM)
+ ZP0PP0(2) = -ZDP0PP0*(PNORM_FACES(JN,2)/ZNNORM)
+ ZP0PP0(3) = -ZDP0PP0*(PNORM_FACES(JN,3)/ZNNORM)
+ !***Equation (5) of Jones (1995)
+ ZPP0(1) = ZXHATM(JI,JJ,JK)+ZP0PP0(1)
+ ZPP0(2) = ZYHATM(JI,JJ,JK)+ZP0PP0(2)
+ ZPP0(3) = ZZHATM(JI,JJ,JK)+ZP0PP0(3)
+ !
+ ZP1PP0(1)=ZPP0(1)-PIBM_FACES(JN,1,1)
+ ZP1PP0(2)=ZPP0(2)-PIBM_FACES(JN,1,2)
+ ZP1PP0(3)=ZPP0(3)-PIBM_FACES(JN,1,3)
+ !
+ ZP2PP0(1)=ZPP0(1)-PIBM_FACES(JN,2,1)
+ ZP2PP0(2)=ZPP0(2)-PIBM_FACES(JN,2,2)
+ ZP2PP0(3)=ZPP0(3)-PIBM_FACES(JN,2,3)
+ !
+ ZP3PP0(1)=ZPP0(1)-PIBM_FACES(JN,3,1)
+ ZP3PP0(2)=ZPP0(2)-PIBM_FACES(JN,3,2)
+ ZP3PP0(3)=ZPP0(3)-PIBM_FACES(JN,3,3)
+ !
+ ZPP0P1(1)=PIBM_FACES(JN,1,1)-ZPP0(1)
+ ZPP0P1(2)=PIBM_FACES(JN,1,2)-ZPP0(2)
+ ZPP0P1(3)=PIBM_FACES(JN,1,3)-ZPP0(3)
+ !
+ ZPP0P2(1)=PIBM_FACES(JN,2,1)-ZPP0(1)
+ ZPP0P2(2)=PIBM_FACES(JN,2,2)-ZPP0(2)
+ ZPP0P2(3)=PIBM_FACES(JN,2,3)-ZPP0(3)
+ !
+ ZPP0P3(1)=PIBM_FACES(JN,3,1)-ZPP0(1)
+ ZPP0P3(2)=PIBM_FACES(JN,3,2)-ZPP0(2)
+ ZPP0P3(3)=PIBM_FACES(JN,3,3)-ZPP0(3)
+ !
+ !***Calculation of f1,f2,f3 (Jones (1995))
+ ZFT1= CROSSPRODUCT(PV1(JN,:),ZP1PP0)
+ ZFT2= CROSSPRODUCT(PV2(JN,:),ZP2PP0)
+ ZFT3= CROSSPRODUCT(PV3(JN,:),ZP3PP0)
+
+ ZF1 =ZFT1(1)*PNORM_FACES(JN,1)+ &
+ ZFT1(2)*PNORM_FACES(JN,2)+ &
+ ZFT1(3)*PNORM_FACES(JN,3)
+
+ ZF2 =ZFT2(1)*PNORM_FACES(JN,1)+ &
+ ZFT2(2)*PNORM_FACES(JN,2)+ &
+ ZFT2(3)*PNORM_FACES(JN,3)
+
+ ZF3 =ZFT3(1)*PNORM_FACES(JN,1)+ &
+ ZFT3(2)*PNORM_FACES(JN,2)+ &
+ ZFT3(3)*PNORM_FACES(JN,3)
+ !***Point anticlockwise of V1 and clockwise of V2
+ IF (ZF1.GE.0.AND.ZF2.LE.0) THEN
+ ZFT1B = CROSSPRODUCT(ZPP0P1,ZPP0P2)
+ ZF1B = ZFT1B(1)*PNORM_FACES(JN,1)+ &
+ ZFT1B(2)*PNORM_FACES(JN,2)+ &
+ ZFT1B(3)*PNORM_FACES(JN,3)
+ IF (ZF1B<0) THEN
+ ZP1P2(:) = PIBM_FACES(JN,2,:)-PIBM_FACES(JN,1,:)
+ ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P2,ZPP0P1),ZP1P2)
+ ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
+ !***Eq. (10) of Jones(1995)
+ ZDPP0PPP0 = SQRT(ZPP0P1(1)**2+ZPP0P1(2)**2+ZPP0P1(3)**2)* &
+ ((ZPP0P1(1)*ZR(1)+ZPP0P1(2)*ZR(2)+ZPP0P1(3)*ZR(3))/( &
+ SQRT(ZPP0P1(1)**2+ZPP0P1(2)**2+ZPP0P1(3)**2)*ZRN))! &
+ ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
+ ZPPP0 = ZPP0+ZPP0PPP0
+ ZPPP0P1 = PIBM_FACES(JN,1,:)-ZPPP0
+ ZP2P1 = PIBM_FACES(JN,1,:)-PIBM_FACES(JN,2,:)
+ ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P1,ZP2P1))
+ ZT = SQRT(ZPPP0P1(1)**2+ZPPP0P1(2)**2+ZPPP0P1(3)**2)/ &
+ SQRT(ZP2P1(1)**2+ZP2P1(2)**2+ZP2P1(3)**2)*ZRDIR(1)
+ IF (ZT.GE.0.AND.ZT.LE.1) THEN
+ ZDIST =SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
+ ELSEIF (ZT<0.) THEN
+ ZDIST = SQRT(ZP1P0(1)**2+ZP1P0(2)**2+ZP1P0(3)**2)
+ ELSEIF (ZT>1.) THEN
+ ZDIST = SQRT(ZP2P0(1)**2+ZP2P0(2)**2+ZP2P0(3)**2)
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
+ ENDIF
+ ELSE
+ ZDIST = ZDP0PP0
+ LFACE = .TRUE.
+ ENDIF
+ !***Point anticlockwise of V2 and clockwise of V3
+ ELSEIF (ZF2.GE.0.AND.ZF3.LE.0) THEN
+ ZFT2B = CROSSPRODUCT(ZPP0P2,ZPP0P3)
+ ZF2B = ZFT2B(1)*PNORM_FACES(JN,1)+ &
+ ZFT2B(2)*PNORM_FACES(JN,2)+ &
+ ZFT2B(3)*PNORM_FACES(JN,3)
+ IF (ZF2B<0) THEN
+ ZP2P3(:) = PIBM_FACES(JN,3,:)-PIBM_FACES(JN,2,:)
+ ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P3,ZPP0P2),ZP2P3)
+ ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
+ ZDPP0PPP0 = SQRT(ZPP0P2(1)**2+ZPP0P2(2)**2+ZPP0P2(3)**2)* &
+ ((ZPP0P2(1)*ZR(1)+ZPP0P2(2)*ZR(2)+ZPP0P2(3)*ZR(3))/( &
+ SQRT(ZPP0P2(1)**2+ZPP0P2(2)**2+ZPP0P2(3)**2)*ZRN))! &
+ ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
+ ZPPP0 = ZPP0+ZPP0PPP0
+ ZPPP0P2 = PIBM_FACES(JN,2,:)-ZPPP0
+ ZP3P2 = PIBM_FACES(JN,2,:)-PIBM_FACES(JN,3,:)
+ ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P2,ZP3P2))
+ ZT = SQRT(ZPPP0P2(1)**2+ZPPP0P2(2)**2+ZPPP0P2(3)**2)/ &
+ SQRT(ZP3P2(1)**2+ZP3P2(2)**2+ZP3P2(3)**2)*ZRDIR(1)
+ IF (ZT.GE.0.AND.ZT.LE.1) THEN
+ ZDIST = SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
+ ELSEIF (ZT<0.) THEN
+ ZDIST = SQRT(ZP2P0(1)**2+ZP2P0(2)**2+ZP2P0(3)**2)
+ ELSEIF (ZT>1.) THEN
+ ZDIST = SQRT(ZP3P0(1)**2+ZP3P0(2)**2+ZP3P0(3)**2)
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
+ ENDIF
+ ELSE
+ ZDIST = ZDP0PP0
+ LFACE = .TRUE.
+ ENDIF
+ !***Point anticlockwise of V3 and clockwise of V1
+ ELSEIF (ZF3.GE.0.AND.ZF1.LE.0) THEN
+ ZFT3B = CROSSPRODUCT(ZPP0P3,ZPP0P1)
+ ZF3B = ZFT3B(1)*PNORM_FACES(JN,1)+ &
+ ZFT3B(2)*PNORM_FACES(JN,2)+ &
+ ZFT3B(3)*PNORM_FACES(JN,3)
+ IF (ZF3B<0) THEN
+ ZP3P1(:) = PIBM_FACES(JN,1,:)-PIBM_FACES(JN,3,:)
+ ZR = CROSSPRODUCT(CROSSPRODUCT(ZPP0P1,ZPP0P3),ZP3P1)
+ ZRN = SQRT(ZR(1)**2+ZR(2)**2+ZR(3)**2)
+ ZDPP0PPP0 = SQRT(ZPP0P3(1)**2+ZPP0P3(2)**2+ZPP0P3(3)**2)* &
+ ((ZPP0P3(1)*ZR(1)+ZPP0P3(2)*ZR(2)+ZPP0P3(3)*ZR(3))/( &
+ SQRT((ZPP0P3(1))**2+(ZPP0P3(2))**2+(ZPP0P3(3))**2)*ZRN))! &
+ ZPP0PPP0 = ZDPP0PPP0*(ZR/ZRN)
+ ZPPP0 = ZPP0+ZPP0PPP0
+ ZPPP0P3 = PIBM_FACES(JN,3,:)-ZPPP0
+ ZP1P3 = PIBM_FACES(JN,3,:)-PIBM_FACES(JN,1,:)
+ ZRDIR = SIGN(1.,SCALPRODUCT(ZPPP0P3,ZP1P3))
+ ZT = SQRT(ZPPP0P3(1)**2+ZPPP0P3(2)**2+ZPPP0P3(3)**2)/ &
+ SQRT(ZP1P3(1)**2+ZP1P3(2)**2+ZP1P3(3)**2)*ZRDIR(1)
+ IF (ZT.GE.0.AND.ZT.LE.1) THEN
+ ZDIST = SQRT(ZDPP0PPP0**2+ZDP0PP0**2)
+ ELSEIF (ZT<0.) THEN
+ ZDIST = SQRT(ZP3P0(1)**2+ZP3P0(2)**2+ZP3P0(3)**2)
+ ELSEIF (ZT>1.) THEN
+ ZDIST = SQRT(ZP1P0(1)**2+ZP1P0(2)**2+ZP1P0(3)**2)
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZT calculation' )
+ ENDIF
+ ELSE
+ ZDIST = ZDP0PP0
+ LFACE = .TRUE.
+ ENDIF
+ ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Error in ZF instruction' )
+ ENDIF
+ ZDIST = SIGN(ZDIST,-ZSIGN)
+ ZDIST = ANINT(ZDIST*10.E5) / 10.E5
+ PPHI(JI,JJ,JK,JM) = ANINT(PPHI(JI,JJ,JK,JM)*10.E5) / 10.E5
+ IF (ABS(ZDIST).LE.ABS(PPHI(JI,JJ,JK,JM))) THEN
+ ZPHI_OLD = PPHI(JI,JJ,JK,JM)
+ IF (ABS(ZDIST)==ABS(PPHI(JI,JJ,JK,JM))) THEN
+ IF (ABS(ZDP0PP0).GT.ABS(ZDP0PP0PAST(JI,JJ,JK))) THEN
+ PPHI(JI,JJ,JK,JM) = ZDIST
+ ZDP0PP0PAST(JI,JJ,JK) = ZDP0PP0
+ ENDIF
+ ELSE
+ PPHI(JI,JJ,JK,JM) = ZDIST
+ ENDIF
+ IF (ABS(ZDIST).LT.ABS(ZPHI_OLD)) THEN
+ ZDP0PP0PAST(JI,JJ,JK) = ZDP0PP0
+ ENDIF
+ ENDIF
+ IF (ABS(PPHI(JI,JJ,JK,JM)).GT.(SQRT(3.)*4.)) THEN
+ PPHI(JI,JJ,JK,JM) = -999.
+ ENDIF
+ IF (ABS(ZDIST).LT.(SQRT(3.)*4.)) THEN
+ ZVECTDIST(ZCOUNT)=ZDIST
+ ZFACE(ZCOUNT)=LFACE
+ ZCOUNT = ZCOUNT +1
+ ENDIF
+ ENDDO
+ ZVECTDISTPLUS=ZVECTDIST
+ ZVECTDISTMOINS=ZVECTDIST
+ WHERE (ZVECTDIST.GT.0)
+ ZVECTDISTMOINS=-999.
+ ENDWHERE
+ WHERE (ZVECTDIST.LT.0)
+ ZVECTDISTPLUS=999.
+ ENDWHERE
+ IF (ANY(ZVECTDIST.GT.0.).AND.(ABS(ABS(MINVAL(ZVECTDISTPLUS))-ABS(MAXVAL(ZVECTDISTMOINS))).LT.10.E-6)) THEN
+ ZMIN_DIFF = 1.
+ ZIDX = 0
+ DO ZII = 1, SIZE(ZVECTDIST)
+ ZDIFF = ABS(ZVECTDIST(ZII)-MINVAL(ZVECTDISTPLUS))
+ IF ( ZDIFF < ZMIN_DIFF) THEN
+ ZIDX = ZII
+ ZMIN_DIFF = ZDIFF
+ ENDIF
+ ENDDO
+ IF (ZFACE(ZIDX)) THEN
+ PPHI(JI,JJ,JK,JM) = MINVAL(ZVECTDISTPLUS)
+ ENDIF
+ ENDIF
+ ENDDO
+ ENDDO
+ ENDDO
+
+DO JJ=JJ_MIN,JJ_MAX
+DO JI=JI_MIN,JI_MAX
+GABOVE_ROOF=.FALSE.
+DO JK=IKB, IKE
+ ! check if point is flagged as not calculated
+ IF (PPHI(JI,JJ,JK,JM)==-999.) THEN
+ ! check if point is already above a point that encountered a point near the
+ ! surface (that can be outside or inside a building)
+ ! check if that point was inside (if outside, the value of the levelset
+ ! stays at -999.)
+ IF (GABOVE_ROOF .AND. PPHI(JI,JJ,JK-1,JM) > XIBM_EPSI) THEN
+ PPHI(JI,JJ,JK,JM) = 999.
+ CYCLE
+ END IF
+ ! check if the point of the column have not encoutered a near-building
+ ! surface point with a physical value of the level set
+ IF (.NOT. GABOVE_ROOF) THEN
+ ! if the point above has a physical value for the level set, then the
+ ! status inside (999) or outside (-999) is given to all points below,
+ ! depending if this point above (that needs not to be the point at the top
+ ! of the model!) is inside or outside
+ ! checks if the point above has a physical value for the levelset
+ IF (JK<IKE .AND. ABS (PPHI(JI,JJ,JK+1,JM)) < 900.) THEN
+ ! if the point above is inside, all points below are set inside
+ IF (PPHI(JI,JJ,JK+1,JM)>XIBM_EPSI) PPHI(JI,JJ,IKB:JK,JM) = 999.
+ ! indicate for further processing of points above the current point
+ ! that we have encountered a physical value of the level set, near the
+ ! surface building
+ GABOVE_ROOF = .TRUE.
+ END IF
+ CYCLE
+ ENDIF
+ END IF
+ ! if we have never encoutered a roof or point near a building form above,
+ ! then, we are outside, and nothing is changed (value -999 kept)
+ END DO
+ PPHI(JI,JJ,IKB-1,JM) = PPHI(JI,JJ,IKB,JM)
+ PPHI(JI,JJ,IKE+1,JM) = PPHI(JI,JJ,IKE,JM)
+END DO
+END DO
+
+
+JN=1
+PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
+PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
+PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
+PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
+PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
+PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
+
+PPHI(:,:,:,2)=MXM(PPHI(:,:,:,1))
+PPHI(:,:,:,3)=MYM(PPHI(:,:,:,1))
+PPHI(:,:,:,4)=MZM(PPHI(:,:,:,1))
+
+NULLIFY(TZFIELDS_ll)
+DO JN=2,4
+ PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
+ PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
+ PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
+ PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
+ PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
+ PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
+ENDDO
+
+PPHI(:,:,:,5)=MYM(PPHI(:,:,:,2))
+PPHI(:,:,:,6)=MXM(PPHI(:,:,:,4))
+PPHI(:,:,:,7)=MYM(PPHI(:,:,:,4))
+NULLIFY(TZFIELDS_ll)
+DO JN=5,7
+ PPHI(:,:,IKB-1,JN)=2*PPHI(:,:,IKB,JN)-PPHI(:,:,IKB+1,JN)
+ PPHI(:,:,IKE+1,JN)=2*PPHI(:,:,IKE,JN)-PPHI(:,:,IKE-1,JN)
+ PPHI(IIB-1,:,:,JN) = PPHI( IIB ,:,:,JN)
+ PPHI(IIE+1,:,:,JN) = PPHI( IIE ,:,:,JN)
+ PPHI(:,IJB-1,:,JN) = PPHI(:, IJB ,:,JN)
+ PPHI(:,IJE+1,:,JN) = PPHI(:, IJE ,:,JN)
+ENDDO
+WHERE (ABS(PPHI(:,:,:,:)).LT.XIBM_EPSI) PPHI(:,:,:,:)=2.*XIBM_EPSI
+
+
+ !COMPLETE PPHI ON THE HALO OF EACH SUBDOMAINS
+ DO JN=1,7
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,JN),'IBM_GENERLS::PPHI')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ !DEALLOCATE(ZDP0PP0,ZDIST,ZC,ZSTEMP)
+ DEALLOCATE(ZC,ZSTEMP)
+ DEALLOCATE(ZXHATM,ZYHATM,ZZHATM)
+ !
+ RETURN
+ !
+CONTAINS
+ !
+ FUNCTION CROSSPRODUCT(PA,PB) RESULT(CROSS)
+ !
+ REAL, DIMENSION(3) :: CROSS
+ REAL, DIMENSION(3), INTENT(IN) :: PA, PB
+ CROSS(1) = PA(2) * PB(3) - PA(3) * PB(2)
+ CROSS(2) = PA(3) * PB(1) - PA(1) * PB(3)
+ CROSS(3) = PA(1) * PB(2) - PA(2) * PB(1)
+ END FUNCTION CROSSPRODUCT
+
+ FUNCTION SCALPRODUCT(PA,PB) RESULT(SCAL)
+ !
+ REAL :: SCAL
+ REAL, DIMENSION(3), INTENT(IN) :: PA, PB
+ SCAL = PA(1)*PB(1)+PA(2)*PB(2)+PA(3)*PB(3)
+ END FUNCTION SCALPRODUCT
+
+END SUBROUTINE IBM_GENERLS
diff --git a/src/MNH/ibm_idealee.f90 b/src/MNH/ibm_idealee.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e08be780d96d538d079536dc127c04074e860dd8
--- /dev/null
+++ b/src/MNH/ibm_idealee.f90
@@ -0,0 +1,261 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_IDEALEE
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_IDEALEE(KNUMB_OBS,PIBM_XYZ,PPHI)
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_IDEALEE
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_IDEALEE
+!
+! ###############################################
+SUBROUTINE IBM_IDEALEE(KNUMB_OBS,PIBM_XYZ,PPHI)
+ ! ###############################################
+ !
+ !
+ !**** IBM_IDEALEE computes LS function for ellipsoidal objects
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to estimate the
+ ! levetset function for many ellipsoidal objects.
+
+ ! METHOD
+ ! ------
+ !**** Use of a analytic solution and approximation in truncated cell
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_IBM_INTERPOS
+ USE MODI_IBM_INTERPOS2
+ !
+ IMPLICIT NONE
+ !
+ ! 0.1 declarations of arguments
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS ! obstacle number
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ ! interface location
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS function
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JN,JM ! loop index
+ INTEGER :: JI_MIN,JI_MAX,JJ_MIN,JJ_MAX,JK_MIN,JK_MAX,IIU,IJU,IKU ! loop boundaries
+ REAL, ALLOCATABLE :: ZPOSI_AXEX,ZPOSI_AXEY,ZPOSI_AXEZ ! saving positions/distances
+ REAL, ALLOCATABLE :: ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ
+ REAL, ALLOCATABLE :: ZCOEFA,ZCOEFB,ZDIST_REF0 ! solid volume and cell volume
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATM,ZYHATM,ZZHATM ! mesh location (mass nodes)
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATC,ZYHATC,ZZHATC ! mesh location (cell nodes)
+ CHARACTER(LEN=1) :: YPOS
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! 0.3 allocation
+ !
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ !
+ ALLOCATE(ZPOSI_AXEX,ZPOSI_AXEY,ZPOSI_AXEZ, &
+ ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ, &
+ ZCOEFA,ZCOEFB,ZDIST_REF0)
+ !
+ ALLOCATE(ZXHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZXHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZYHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZYHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZZHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZZHATM(IIU ,IJU ,IKU ))
+ !
+ JI_MIN = 1 + JPHEXT
+ JI_MAX = IIU - JPHEXT
+ JJ_MIN = 1 + JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MIN = 1 + JPVEXT
+ JK_MAX = IKU - JPVEXT
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ZDIST_AXEX = PIBM_XYZ(KNUMB_OBS,2)
+ ZDIST_AXEY = PIBM_XYZ(KNUMB_OBS,4)
+ ZDIST_AXEZ = PIBM_XYZ(KNUMB_OBS,6)
+ ZPOSI_AXEX = PIBM_XYZ(KNUMB_OBS,1)
+ ZPOSI_AXEY = PIBM_XYZ(KNUMB_OBS,3)
+ ZPOSI_AXEZ = PIBM_XYZ(KNUMB_OBS,5)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ DO JM=1,7
+ !
+ IF (JM==1) THEN
+ YPOS = 'P'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==2) THEN
+ YPOS = 'U'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==3) THEN
+ YPOS = 'V'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==4) THEN
+ YPOS = 'W'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==5) THEN
+ YPOS = 'A'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==6) THEN
+ YPOS = 'B'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==7) THEN
+ YPOS = 'C'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ !
+ CALL IBM_INTERPOS(ZXHATM,ZYHATM,ZZHATM,YPOS)
+ CALL IBM_INTERPOS2(ZXHATM,ZYHATM,ZZHATM,ZXHATC,ZYHATC,ZZHATC)
+ !
+ DO JK = JK_MIN,JK_MAX
+ DO JJ = JJ_MIN,JJ_MAX
+ DO JI = JI_MIN,JI_MAX
+ !
+ ! LS function
+ !
+ IF ((ZDIST_AXEX.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.gt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ)
+ ZCOEFB = sqrt(((ZXHATM(JI,JJ,JK)-ZPOSI_AXEX)*ZCOEFA/ZDIST_AXEX)**2.+&
+ ((ZYHATM(JI,JJ,JK)-ZPOSI_AXEY)*ZCOEFA/ZDIST_AXEY)**2.+&
+ ((ZZHATM(JI,JJ,JK)-ZPOSI_AXEZ)*ZCOEFA/ZDIST_AXEZ)**2.)
+ !
+ ENDIF
+ !
+ IF ((ZDIST_AXEX.lt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.gt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEY,ZDIST_AXEZ)
+ ZCOEFB = sqrt(((ZYHATM(JI,JJ,JK)-ZPOSI_AXEY)*ZCOEFA/ZDIST_AXEY)**2.+&
+ ((ZZHATM(JI,JJ,JK)-ZPOSI_AXEZ)*ZCOEFA/ZDIST_AXEZ)**2.)
+ !
+ ENDIF
+ !
+ IF ((ZDIST_AXEX.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.lt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.gt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEX,ZDIST_AXEZ)
+ ZCOEFB =sqrt(((ZXHATM(JI,JJ,JK)-ZPOSI_AXEX)*ZCOEFA/ZDIST_AXEX)**2.+&
+ ((ZZHATM(JI,JJ,JK)-ZPOSI_AXEZ)*ZCOEFA/ZDIST_AXEZ)**2.)
+ !
+ ENDIF
+ !
+ IF ((ZDIST_AXEX.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEY.gt.XIBM_EPSI).and.&
+ (ZDIST_AXEZ.lt.XIBM_EPSI)) THEN
+ !
+ ZCOEFA = max(ZDIST_AXEX,ZDIST_AXEY)
+ ZCOEFB = sqrt(((ZXHATM(JI,JJ,JK)-ZPOSI_AXEX)*ZCOEFA/ZDIST_AXEX)**2.+&
+ ((ZYHATM(JI,JJ,JK)-ZPOSI_AXEY)*ZCOEFA/ZDIST_AXEY)**2.)
+ !
+ ENDIF
+ !
+ ZDIST_REF0 = ZCOEFA-ZCOEFB
+ !
+ IF (PPHI(JI,JJ,JK,JM) .lt. ZDIST_REF0) PPHI(JI,JJ,JK,JM) = ZDIST_REF0
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(ZXHATM,ZYHATM,ZZHATM)
+ DEALLOCATE(ZXHATC,ZYHATC,ZZHATC)
+ DEALLOCATE(ZPOSI_AXEX,ZPOSI_AXEY,ZPOSI_AXEZ,ZDIST_AXEX,ZDIST_AXEY,ZDIST_AXEZ,ZCOEFA,ZCOEFB,ZDIST_REF0)
+ !
+ RETURN
+ !
+ !------------------------------------------------------------------------------
+END SUBROUTINE IBM_IDEALEE
diff --git a/src/MNH/ibm_idealrp.f90 b/src/MNH/ibm_idealrp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a67bb5fd2a5095ed294c0ec9a67bc547dc0e0273
--- /dev/null
+++ b/src/MNH/ibm_idealrp.f90
@@ -0,0 +1,311 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_IDEALRP
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_IDEALRP(KNUMB_OBS,PIBM_XYZ,PPHI)
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_IDEALRP
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_IDEALRP
+!
+! ###############################################
+SUBROUTINE IBM_IDEALRP(KNUMB_OBS,PIBM_XYZ,PPHI)
+ ! ###############################################
+ !
+ !
+ !**** IBM_IDEALRP compute LS function for parallelepipedic objects
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to estimate the
+ ! levetset function for many parallelepipedic objects.
+ ! I_NUMB_ITER is a parameter controlling the fine resolution of
+ ! each surface
+ !
+ ! METHOD
+ ! ------
+ !**** Use of a smooth Heaviside function and a characteristic numerical interface thickness
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODE_GATHER_ll
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_IBM_INTERPOS
+ USE MODI_IBM_INTERPOS2
+ !
+ IMPLICIT NONE
+ !
+ ! 0.1 declarations of arguments
+ !
+ INTEGER ,INTENT(IN) :: KNUMB_OBS ! obstacle number
+ REAL, DIMENSION(:,:) ,INTENT(IN) :: PIBM_XYZ ! array for interface initialization
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JN,JM,IIU,IJU,IKU,IIU_ll,IJU_ll ! loop index
+ INTEGER :: JI_MIN,JI_MAX,JJ_MIN,JJ_MAX,JK_MIN,JK_MAX
+ REAL :: ZDELTX,ZDELTY,ZDELTZ
+ REAL, ALLOCATABLE :: ZTEST_XMIN,ZTEST_XMAX ! saving positions
+ REAL, ALLOCATABLE :: ZTEST_YMIN,ZTEST_YMAX
+ REAL, ALLOCATABLE :: ZTEST_ZMIN,ZTEST_ZMAX
+ REAL, ALLOCATABLE :: ZPOSI_XYZ0,ZPOSI_XYZ1,ZPOSI_XYZ2
+ REAL, ALLOCATABLE :: ZDIST_SUR0,ZDIST_SUR1,ZDIST_SUR2 ! saving distances
+ REAL, ALLOCATABLE :: ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5
+ REAL, ALLOCATABLE :: ZDIST_SUR6,ZDIST_REF0
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATM,ZYHATM,ZZHATM ! mesh location (mass nodes)
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHATC,ZYHATC,ZZHATC ! mesh location (cell nodes)
+ REAL, DIMENSION(:) , ALLOCATABLE :: ZXHAT_ll,ZYHAT_ll
+ CHARACTER(LEN=1) :: YPOS
+ INTEGER :: NRESP
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 allocation
+ !
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ !
+ JI_MIN = 1 + JPHEXT
+ JI_MAX = IIU - JPHEXT
+ JJ_MIN = 1 + JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MIN = 1 + JPVEXT
+ JK_MAX = IKU - JPVEXT
+ !
+ ALLOCATE(ZXHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZYHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZZHATM(IIU ,IJU ,IKU ))
+ ALLOCATE(ZXHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZYHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZZHATC(IIU+1,IJU+1,IKU+1))
+ ALLOCATE(ZTEST_XMIN,ZTEST_XMAX,ZTEST_YMIN,ZTEST_YMAX,ZTEST_ZMIN,ZTEST_ZMAX)
+ ALLOCATE(ZPOSI_XYZ0,ZPOSI_XYZ1,ZPOSI_XYZ2)
+ ALLOCATE(ZDIST_SUR0,ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6,ZDIST_REF0)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ CALL GET_GLOBALDIMS_ll(IIU_ll,IJU_ll)
+ ALLOCATE(ZXHAT_ll(IIU_ll+ 2 * JPHEXT))
+ ALLOCATE(ZYHAT_ll(IJU_ll+ 2 * JPHEXT))
+ CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,NRESP)
+ CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,NRESP)
+ ZDELTX = abs((PIBM_XYZ(KNUMB_OBS,1)-PIBM_XYZ(KNUMB_OBS,2))/ &
+ ((ZXHAT_ll(IIU_ll+2)-ZXHAT_ll(2))/(IIU_ll*1.)))
+ ZDELTY = abs((PIBM_XYZ(KNUMB_OBS,3)-PIBM_XYZ(KNUMB_OBS,4))/ &
+ ((ZYHAT_ll(IJU_ll+2)-ZYHAT_ll(2))/(IJU_ll*1.)))
+ ZDELTZ = abs((PIBM_XYZ(KNUMB_OBS,5)-PIBM_XYZ(KNUMB_OBS,6))/ &
+ ((XZHAT(IKU)-XZHAT(2))/(IKU*1.-2.)))
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ DO JM=1,7
+ !
+ IF (JM==1) THEN
+ YPOS = 'P'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==2) THEN
+ YPOS = 'U'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==3) THEN
+ YPOS = 'V'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==4) THEN
+ YPOS = 'W'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==5) THEN
+ YPOS = 'A'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT
+ ENDIF
+ IF (JM==6) THEN
+ YPOS = 'B'
+ JI_MAX = IIU - JPHEXT + 1
+ JJ_MAX = IJU - JPHEXT
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ IF (JM==7) THEN
+ YPOS = 'C'
+ JI_MAX = IIU - JPHEXT
+ JJ_MAX = IJU - JPHEXT + 1
+ JK_MAX = IKU - JPVEXT + 1
+ ENDIF
+ CALL IBM_INTERPOS(ZXHATM,ZYHATM,ZZHATM,YPOS)
+ CALL IBM_INTERPOS2(ZXHATM,ZYHATM,ZZHATM,ZXHATC,ZYHATC,ZZHATC)
+ DO JK = JK_MIN,JK_MAX
+ DO JJ = JJ_MIN,JJ_MAX
+ DO JI = JI_MIN,JI_MAX
+ !
+ ! LS function
+ ZTEST_XMIN = PIBM_XYZ(KNUMB_OBS,1)
+ ZTEST_XMAX = PIBM_XYZ(KNUMB_OBS,2)
+ ZTEST_YMIN = PIBM_XYZ(KNUMB_OBS,3)
+ ZTEST_YMAX = PIBM_XYZ(KNUMB_OBS,4)
+ ZTEST_ZMIN = PIBM_XYZ(KNUMB_OBS,5)
+ ZTEST_ZMAX = PIBM_XYZ(KNUMB_OBS,6)
+ !
+ ZPOSI_XYZ0 = ZTEST_XMIN
+ ZDIST_SUR1 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_YMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ0-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ1-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR1 = min(ZDIST_SUR0,ZDIST_SUR1)
+ !
+ ZPOSI_XYZ0 = ZTEST_XMAX
+ ZDIST_SUR2 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_YMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ0-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ1-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR2 = min(ZDIST_SUR0,ZDIST_SUR2)
+ !
+ ZPOSI_XYZ0 = ZTEST_YMIN
+ ZDIST_SUR3 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR3 = min(ZDIST_SUR0,ZDIST_SUR3)
+ !
+ ZPOSI_XYZ0 = ZTEST_YMAX
+ ZDIST_SUR4 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_ZMIN,ZZHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_ZMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR4 = min(ZDIST_SUR0,ZDIST_SUR4)
+ !
+ ZPOSI_XYZ0 = ZTEST_ZMIN
+ ZDIST_SUR5 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_YMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR5 = min(ZDIST_SUR0,ZDIST_SUR5)
+ !
+ ZPOSI_XYZ0 = ZTEST_ZMAX
+ ZDIST_SUR6 = XIBM_IEPS
+ ZPOSI_XYZ1 = max(ZTEST_XMIN,ZXHATM(JI,JJ,JK))
+ ZPOSI_XYZ1 = min(ZTEST_XMAX,ZPOSI_XYZ1)
+ ZPOSI_XYZ2 = max(ZTEST_YMIN,ZYHATM(JI,JJ,JK))
+ ZPOSI_XYZ2 = min(ZTEST_YMAX,ZPOSI_XYZ2)
+ ZDIST_SUR0 = ((ZPOSI_XYZ1-ZXHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ2-ZYHATM(JI,JJ,JK))**2. + &
+ (ZPOSI_XYZ0-ZZHATM(JI,JJ,JK))**2.)**0.5
+ ZDIST_SUR6 = min(ZDIST_SUR0,ZDIST_SUR6)
+ !
+ IF ((ZXHATM(JI,JJ,JK) .gt. ZTEST_XMIN.and.ZXHATM(JI,JJ,JK) .lt. ZTEST_XMAX).and. &
+ (ZYHATM(JI,JJ,JK) .gt. ZTEST_YMIN.and.ZYHATM(JI,JJ,JK) .lt. ZTEST_YMAX).and. &
+ (ZZHATM(JI,JJ,JK) .gt. ZTEST_ZMIN.and.ZZHATM(JI,JJ,JK) .lt. ZTEST_ZMAX)) then
+ ZDIST_REF0 = +min(ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6)
+ ELSE
+ ZDIST_REF0 = -min(ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6)
+ ENDIF
+ !
+ IF (PPHI(JI,JJ,JK,JM) .lt. ZDIST_REF0) PPHI(JI,JJ,JK,JM) = ZDIST_REF0
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(ZXHATC,ZYHATC,ZZHATC)
+ DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
+ DEALLOCATE(ZTEST_XMIN,ZTEST_XMAX,ZTEST_YMIN,ZTEST_YMAX,ZTEST_ZMIN,ZTEST_ZMAX)
+ DEALLOCATE(ZPOSI_XYZ0,ZPOSI_XYZ1,ZPOSI_XYZ2)
+ DEALLOCATE(ZDIST_SUR0,ZDIST_SUR1,ZDIST_SUR2,ZDIST_SUR3,ZDIST_SUR4,ZDIST_SUR5,ZDIST_SUR6,ZDIST_REF0)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_IDEALRP
diff --git a/src/MNH/ibm_init.f90 b/src/MNH/ibm_init.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3918438ba423b0037191fb61a1c303ce35ffc324
--- /dev/null
+++ b/src/MNH/ibm_init.f90
@@ -0,0 +1,222 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! ####################
+MODULE MODI_IBM_INIT
+ ! ####################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INIT(PIBM_LS)
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIBM_LS
+ !
+ END SUBROUTINE IBM_INIT
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INIT
+!
+! ############################
+SUBROUTINE IBM_INIT(PIBM_LS)
+ ! ############################
+ !
+ !**** *IBM_INIT* - routine to initialize the immersed boundary method
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to initialize the IBM variables
+ ! that are stored in module MODD_IBM_PARAM_n
+ !
+ ! METHOD
+ ! ------
+ ! The constants are set to their numerical values
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_SUB_MODEL_n, ONLY: XT_IBM_DETE
+ USE MODD_IBM_PARAM_n
+ USE MODD_FIELD_n
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID
+ USE MODD_GRID_n
+ USE MODD_CST
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_CONF
+ USE MODD_REF_n
+ USE MODN_PARAM_n
+ !
+ ! interface
+ USE MODI_IBM_DETECT
+ USE MODI_SECOND_MNH
+ USE MODI_SHUMAN
+ USE MODI_IBM_VOLUME
+ USE MODI_GRADIENT_M
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIBM_LS
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ REAL :: ZTIME1,ZTIME2
+ INTEGER :: IINFO_ll
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IIE,IIB,IJB,IJE,IKE,IKB,JN,IIU,IJU,IKU
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATION
+ ! ---------------
+ !
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ IKU=SIZE(XZZ,3)
+ IIB=1+JPHEXT
+ IIE=IIU-JPHEXT
+ IJB=1+JPHEXT
+ IJE=IJU-JPHEXT
+ IKB=1+JPVEXT
+ IKE=IKU-JPVEXT
+ !
+ ALLOCATE(XIBM_CURV(SIZE(PIBM_LS,1),SIZE(PIBM_LS,2),SIZE(PIBM_LS,3) )) ; XIBM_CURV = 0.
+ ALLOCATE(XIBM_SU (SIZE(PIBM_LS,1),SIZE(PIBM_LS,2),SIZE(PIBM_LS,3),3)) ; XIBM_SU = 0.
+ IF (LIBM_TROUBLE) THEN
+ ALLOCATE(XIBM_SUTR(SIZE(PIBM_LS,1),SIZE(PIBM_LS,2),SIZE(PIBM_LS,3),4)) ; XIBM_SUTR = 1.
+ ENDIF
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ZTIME1=0.
+ ZTIME2=0.
+ XT_IBM_DETE = 0.
+ CALL SECOND_MNH(ZTIME1)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !=== Level Set function
+ JN=1
+ PIBM_LS(:,:,IKB-1,JN)=2*PIBM_LS(:,:,IKB,JN)-PIBM_LS(:,:,IKB+1,JN)
+ PIBM_LS(:,:,IKE+1,JN)=2*PIBM_LS(:,:,IKE,JN)-PIBM_LS(:,:,IKE-1,JN)
+ IF (LWEST_ll ()) THEN
+ PIBM_LS(IIB ,:,:,JN) = PIBM_LS( IIB+1,:,:,JN)
+ PIBM_LS(IIB-1,:,:,JN) = PIBM_LS( IIB ,:,:,JN)
+ ENDIF
+ IF (LEAST_ll ()) THEN
+ PIBM_LS(IIE ,:,:,JN) = PIBM_LS( IIE-1,:,:,JN)
+ PIBM_LS(IIE+1,:,:,JN) = PIBM_LS( IIE ,:,:,JN)
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ PIBM_LS(:,IJB ,:,JN) = PIBM_LS(:, IJB+1,:,JN)
+ PIBM_LS(:,IJB-1,:,JN) = PIBM_LS(:, IJB ,:,JN)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PIBM_LS(:,IJE ,:,JN) = PIBM_LS(:, IJE-1,:,JN)
+ PIBM_LS(:,IJE+1,:,JN) = PIBM_LS(:, IJE ,:,JN)
+ ENDIF
+ !
+ PIBM_LS(:,:,:,2)=MXM(PIBM_LS(:,:,:,1))
+ PIBM_LS(:,:,:,3)=MYM(PIBM_LS(:,:,:,1))
+ PIBM_LS(:,:,:,4)=MZM(PIBM_LS(:,:,:,1))
+ !
+ NULLIFY(TZFIELDS_ll)
+ DO JN=2,4
+ PIBM_LS(:,:,IKB-1,JN)=2*PIBM_LS(:,:,IKB,JN)-PIBM_LS(:,:,IKB+1,JN)
+ PIBM_LS(:,:,IKE+1,JN)=2*PIBM_LS(:,:,IKE,JN)-PIBM_LS(:,:,IKE-1,JN)
+ IF (LWEST_ll ()) THEN
+ PIBM_LS(IIB ,:,:,JN) = PIBM_LS( IIB+1,:,:,JN)
+ PIBM_LS(IIB-1,:,:,JN) = PIBM_LS( IIB ,:,:,JN)
+ ENDIF
+ IF (LEAST_ll ()) THEN
+ PIBM_LS(IIE ,:,:,JN) = PIBM_LS( IIE-1,:,:,JN)
+ PIBM_LS(IIE+1,:,:,JN) = PIBM_LS( IIE ,:,:,JN)
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ PIBM_LS(:,IJB ,:,JN) = PIBM_LS(:, IJB+1,:,JN)
+ PIBM_LS(:,IJB-1,:,JN) = PIBM_LS(:, IJB ,:,JN)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PIBM_LS(:,IJE ,:,JN) = PIBM_LS(:, IJE-1,:,JN)
+ PIBM_LS(:,IJE+1,:,JN) = PIBM_LS(:, IJE ,:,JN)
+ ENDIF
+ ENDDO
+ WHERE (ABS(PIBM_LS(:,:,:,:)).LT.XIBM_EPSI) PIBM_LS(:,:,:,:)=2.*XIBM_EPSI
+ DO JN=1,4
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PIBM_LS(:,:,:,JN),'IBM_INIT::PIBM_LS')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !=== detection ghost/images
+ IF (IP==1) WRITE(*,*)'*IBM* detection ghost/images detection'
+ CALL IBM_DETECT(PIBM_LS)
+ IF (LIBM_TROUBLE) THEN
+ NULLIFY(TZFIELDS_ll)
+ DO JN=1,4
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SUTR(:,:,:,JN),'IBM_INIT::XIBM_SUTR')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ ENDIF
+ !
+ !=== detection surface/volumes
+ IF (IP==1) WRITE(*,*)'*IBM* surface/volumes detection'
+ CALL IBM_VOLUME(PIBM_LS,XIBM_SU)
+ NULLIFY(TZFIELDS_ll)
+ DO JN=1,3
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,XIBM_SU(:,:,:,JN),'IBM_INIT::XIBM_SU')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !===
+ CALL SECOND_MNH(ZTIME2)
+ XT_IBM_DETE=ZTIME2-ZTIME1
+ IF (IP==1) WRITE(*,*)'*IBM* End initialization in ',XT_IBM_DETE,' s'
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INIT
diff --git a/src/MNH/ibm_init_ls.f90 b/src/MNH/ibm_init_ls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2d881e1fd564803d1d7f786993fa5efc2fe14042
--- /dev/null
+++ b/src/MNH/ibm_init_ls.f90
@@ -0,0 +1,187 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_INIT_LS
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INIT_LS(PPHI)
+ !
+ REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_INIT_LS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INIT_LS
+!
+! ############################
+SUBROUTINE IBM_INIT_LS(PPHI)
+ ! ############################
+ !
+ !**** *IBM_INIT_LS* - routine to initialize the Level-Set function for IBM
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose is to compute the LSF at mass/velocity/vorticity nodes
+ ! to store only its value at the mass node
+ !
+ ! METHOD
+ ! ------
+ ! A preparation is done by IBM_PREP depending on the type of topography
+ ! A smoothing technique done by IBM_SMOOTH is applied if necessary
+ !
+ ! EXTERNAL
+ ! --------
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_MSG
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration,
+ USE MODD_SUB_MODEL_n, ONLY: XT_IBM_PREP
+ USE MODD_IBM_PARAM_n, ONLY: XIBM_EPSI,XIBM_IEPS
+ USE MODD_IBM_LSF, ONLY: LIBM_LSF,CIBM_TYPE,NIBM_SMOOTH,XIBM_SMOOTH
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: XUNDEF,JPHEXT,JPVEXT
+ !
+ ! interface
+ USE MODI_IBM_PREP_LS
+ USE MODI_IBM_SMOOTH_LS
+ USE MODI_SECOND_MNH
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PPHI
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZPHI ! temporary LSF
+ INTEGER :: JJ,JI,JK,IIE,IIB,IJB,IJE,IKE,IKB,IIU,IJU,IKU ! loop index
+ REAL :: ZTIME1,ZTIME2 ! computation times
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. ALLOCATIONS
+ ! --------------
+ !
+ ALLOCATE(ZPHI(SIZE(PPHI,1),SIZE(PPHI,2),SIZE(PPHI,3),7))
+ ZPHI = -XIBM_IEPS
+ !
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ IKU=SIZE(XZZ,3)
+ IIB=1+JPHEXT
+ IIE=IIU-JPHEXT
+ IJB=1+JPHEXT
+ IJE=IJU-JPHEXT
+ IKB=1+JPVEXT
+ IKE=IKU-JPVEXT
+ ZTIME1=0.
+ ZTIME2=0.
+ XT_IBM_PREP = 0.
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ IF (IP==1) THEN
+ !
+ IF (CIBM_TYPE == 'GENE'.OR.CIBM_TYPE == 'IDEA'.OR.CIBM_TYPE =='REAL' &
+ .OR.CIBM_TYPE == 'GEID'.OR.CIBM_TYPE == 'IDRE') THEN
+ !
+ WRITE(*,*) '****************************'
+ WRITE(*,*) '**** BEGIN LSF BUILDING ****'
+ WRITE(*,*) '****************************'
+ !
+ ELSE
+ !
+ WRITE(*,*) '*****************************'
+ WRITE(*,*) '******** LIBM = TRUE ********'
+ WRITE(*,*) '*** CIBM_TYPE IS REQUIRED ***'
+ WRITE(*,*) '******** = GENE/IDEA ********'
+ WRITE(*,*) '**** (stopped execution) ****'
+ WRITE(*,*) '*****************************'
+ !
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','IBM_INIT_LS','with IBM, CIBM_TYPE is REQUIRED')
+ !
+ ENDIF
+ ENDIF
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ CALL SECOND_MNH(ZTIME1)
+ !
+ ! LSF initialization
+ CALL IBM_PREP_LS(LIBM_LSF,CIBM_TYPE,ZPHI)
+ !
+ ! LSF smoothing
+ IF (XIBM_SMOOTH/=0.) THEN
+ IF (XIBM_SMOOTH==XUNDEF) THEN
+ XIBM_SMOOTH=XIBM_EPSI
+ NIBM_SMOOTH=1
+ ENDIF
+ IF (IP==1) WRITE(*,*)'*IBM* Smoothing is applied on LSF'
+ CALL IBM_SMOOTH_LS(NIBM_SMOOTH,XIBM_SMOOTH,ZPHI)
+ ELSE
+ IF (IP==1) WRITE(*,*)'*IBM* No smoothing is applied on LSF'
+ ENDIF
+ !
+ ! LSF storage
+ PPHI(:,:,:,1:4)=ZPHI(:,:,:,1:4)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** X. DEALLOCATIONS
+ ! ----------------
+ !
+ DEALLOCATE(ZPHI)
+ CALL SECOND_MNH(ZTIME2)
+ XT_IBM_PREP=ZTIME2-ZTIME1
+ !
+ IF (IP==1) THEN
+ WRITE(*,*) '*IBM* Time to build LSF (s):', XT_IBM_PREP
+ WRITE(*,*) '**************************'
+ WRITE(*,*) '**** END LSF BUILDING ****'
+ WRITE(*,*) '**************************'
+ ENDIF
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INIT_LS
diff --git a/src/MNH/ibm_interpos.f90 b/src/MNH/ibm_interpos.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b124e08ef30cc57b09a7fa080d58ce9f43bf84a4
--- /dev/null
+++ b/src/MNH/ibm_interpos.f90
@@ -0,0 +1,181 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! ########################
+MODULE MODI_IBM_INTERPOS
+ ! ########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INTERPOS(PXREF,PYREF,PZREF,HPOS)
+ !
+ CHARACTER(LEN=1) , INTENT(IN) :: HPOS
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXREF,PYREF,PZREF
+ !
+ END SUBROUTINE IBM_INTERPOS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INTERPOS
+!
+! ###############################################
+SUBROUTINE IBM_INTERPOS(PXREF,PYREF,PZREF,HPOS)
+ ! ###############################################
+ !
+ !**** *IBM_INTERPOS* - routine to search location of each type of nodes
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute (X,Y,Z) for (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! interface
+ USE MODI_SHUMAN
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ CHARACTER(LEN=1) , INTENT(IN) :: HPOS ! location UVWP
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXREF,PYREF,PZREF ! variable
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: IIU,IJU,IKU ! domain size
+ INTEGER :: JI,JJ,JK ! loop index
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ IIU = SIZE(PXREF,1)
+ IJU = SIZE(PYREF,2)
+ IKU = SIZE(PZREF,3)
+ !
+ !-----------------------------------------------------------------------------
+ !
+ IF (HPOS=='P') THEN
+ PXREF = MXF(spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = MYF(spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = MZF(XZZ)
+ ENDIF
+ IF (HPOS=='U') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = MXM(MYF(spread(spread(XYHAT(1:IJU),1,IIU),3,IKU)))
+ PZREF = MXM(MZF(XZZ))
+ ENDIF
+ IF (HPOS=='V') THEN
+ PXREF = MYM(MXF(spread(spread(XXHAT(1:IIU),2,IJU),3,IKU)))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = MYM(MZF(XZZ))
+ ENDIF
+ IF (HPOS=='W') THEN
+ PXREF = MZM(MXF((spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))))
+ PYREF = MZM(MYF((spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))))
+ PZREF = XZZ
+ ENDIF
+ IF (HPOS=='A') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = MZF(XZZ)
+ ENDIF
+ IF (HPOS=='B') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = MYF(spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = XZZ
+ ENDIF
+ IF (HPOS=='C') THEN
+ PXREF = MXF(spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = XZZ
+ ENDIF
+ IF (HPOS=='X') THEN
+ PXREF = (spread(spread(XXHAT(1:IIU),2,IJU),3,IKU))
+ PYREF = (spread(spread(XYHAT(1:IJU),1,IIU),3,IKU))
+ PZREF = XZZ
+ ENDIF
+ !
+ IF (LWEST_ll( )) THEN
+ PXREF(1, :, :) = (2.*PXREF(2, :, :)-PXREF(3, :, :))
+ PYREF(1, :, :) = (2.*PYREF(2, :, :)-PYREF(3, :, :))
+ PZREF(1, :, :) = (2.*PZREF(2, :, :)-PZREF(3, :, :))
+ ENDIF
+ IF (LEAST_ll( )) THEN
+ PXREF(IIU, :, :) = (2.*PXREF(IIU-1, :, :)-PXREF(IIU-2, :, :))
+ PYREF(IIU, :, :) = (2.*PYREF(IIU-1, :, :)-PYREF(IIU-2, :, :))
+ PZREF(IIU, :, :) = (2.*PZREF(IIU-1, :, :)-PZREF(IIU-2, :, :))
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ PXREF(: ,1, :) = (2.*PXREF(: ,2, :)-PXREF(: ,3, :))
+ PYREF(: ,1, :) = (2.*PYREF(: ,2, :)-PYREF(: ,3, :))
+ PZREF(: ,1, :) = (2.*PZREF(: ,2, :)-PZREF(: ,3, :))
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PXREF(: ,IJU, :) = (2.*PXREF(: ,IJU-1, :)-PXREF(: ,IJU-2, :))
+ PYREF(: ,IJU, :) = (2.*PYREF(: ,IJU-1, :)-PYREF(: ,IJU-2, :))
+ PZREF(: ,IJU, :) = (2.*PZREF(: ,IJU-1, :)-PZREF(: ,IJU-2, :))
+ ENDIF
+ !
+ PXREF(: , :, 1) = (2.*PXREF(: , :, 2)-PXREF(: , :, 3))
+ PXREF(: , :,IKU) = (2.*PXREF(: , :,IKU-1)-PXREF(: , :,IKU-2))
+ PYREF(: , :, 1) = (2.*PYREF(: , :, 2)-PYREF(: , :, 3))
+ PYREF(: , :,IKU) = (2.*PYREF(: , :,IKU-1)-PYREF(: , :,IKU-2))
+ PZREF(: , :, 1) = (2.*PZREF(: , :, 2)-PZREF(: , :, 3))
+ PZREF(: , :,IKU) = (2.*PZREF(: , :,IKU-1)-PZREF(: , :,IKU-2))
+ !
+ NULLIFY(TZFIELDS_ll)
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PXREF,'IBM_INTERPOS::PXREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PYREF,'IBM_INTERPOS::PYREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PZREF,'IBM_INTERPOS::PZREF')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INTERPOS
diff --git a/src/MNH/ibm_interpos2.f90 b/src/MNH/ibm_interpos2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fb2b003b6e976411ac0e0578bcdf4e354625e964
--- /dev/null
+++ b/src/MNH/ibm_interpos2.f90
@@ -0,0 +1,183 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_INTERPOS2
+ ! #########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_INTERPOS2(PXREF,PYREF,PZREF,PXNEW,PYNEW,PZNEW)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXREF,PYREF,PZREF
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXNEW,PYNEW,PZNEW
+ !
+ END SUBROUTINE IBM_INTERPOS2
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_INTERPOS2
+!
+! #############################################################
+SUBROUTINE IBM_INTERPOS2(PXREF,PYREF,PZREF,PXNEW,PYNEW,PZNEW)
+ ! #############################################################
+ !
+ !**** *IBM_INTERPOS2* - routine to search location of cell corners
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute cell corners for (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PXREF,PYREF,PZREF ! node location
+ REAL, DIMENSION(:,:,:) , INTENT(INOUT) :: PXNEW,PYNEW,PZNEW ! cell location
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: IIU,IJU,IKU ! domain size
+ INTEGER :: JI,JJ,JK ! loop index
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ NULLIFY(TZFIELDS_ll)
+ IIU = SIZE(PXREF,1)
+ IJU = SIZE(PYREF,2)
+ IKU = SIZE(PZREF,3)
+ !
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PXREF,'IBM_INTERPOS2::PXREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PYREF,'IBM_INTERPOS2::PYREF')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PZREF,'IBM_INTERPOS2::PZREF')
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! along X
+ PXNEW(2:IIU,2:IJU,2:IKU) = PXREF(2:IIU-0,2:IJU-0,2:IKU-0) + PXREF(1:IIU-1,2:IJU-0,2:IKU-0) + &
+ PXREF(1:IIU-1,1:IJU-1,2:IKU-0) + PXREF(2:IIU-0,1:IJU-1,2:IKU-0) + &
+ PXREF(2:IIU-0,2:IJU-0,1:IKU-1) + PXREF(1:IIU-1,2:IJU-0,1:IKU-1) + &
+ PXREF(1:IIU-1,1:IJU-1,1:IKU-1) + PXREF(2:IIU-0,1:IJU-1,1:IKU-1)
+ PXNEW(2:IIU,2:IJU,2:IKU) = PXNEW(2:IIU,2:IJU,2:IKU) * (1./8.)
+ !
+ IF (LWEST_ll()) THEN
+ PXNEW(1,:,:) = (2.*PXNEW(2,:,:)-PXNEW(3,:,:))
+ PXNEW(:,1,:) = (2.*PXNEW(:,2,:)-PXNEW(:,3,:))
+ PXNEW(:,:,1) = (2.*PXNEW(:,:,2)-PXNEW(:,:,3))
+ PXNEW(1,1,:) = (2.*PXNEW(2,2,:)-PXNEW(3,3,:))
+ PXNEW(:,1,1) = (2.*PXNEW(:,2,2)-PXNEW(:,3,3))
+ PXNEW(1,:,1) = (2.*PXNEW(2,:,2)-PXNEW(3,:,3))
+ PXNEW(1,1,1) = (2.*PXNEW(2,2,2)-PXNEW(3,3,3))
+ ENDIF
+ !
+ IF (LEAST_ll()) THEN
+ PXNEW(IIU+1, :, :) = (2.*PXNEW(IIU-0, :, :)-PXNEW(IIU-1, :, :))
+ PXNEW(: ,IJU+1, :) = (2.*PXNEW(: ,IJU-0, :)-PXNEW(: ,IJU-1, :))
+ PXNEW(: , :,IKU+1) = (2.*PXNEW(: , :,IKU-0)-PXNEW(: , :,IKU-1))
+ PXNEW(IIU+1,IJU+1, :) = (2.*PXNEW(IIU-0,IJU-0, :)-PXNEW(IIU-1,IJU-1, :))
+ PXNEW(: ,IJU+1,IKU+1) = (2.*PXNEW(: ,IJU-0,IKU-0)-PXNEW(: ,IJU-1,IKU-1))
+ PXNEW(IIU+1, :,IKU+1) = (2.*PXNEW(IIU-0, :,IKU-0)-PXNEW(IIU-1, :,IKU-1))
+ PXNEW(IIU+1,IJU+1,IKU+1) = (2.*PXNEW(IIU-0,IJU-0,IKU-0)-PXNEW(IIU-1,IJU-1,IKU-1))
+ ENDIF
+ !
+ ! along Y
+ PYNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PYREF(2:IIU-0,2:IJU-0,2:IKU-0) + PYREF(1:IIU-1,2:IJU-0,2:IKU-0) + &
+ PYREF(1:IIU-1,1:IJU-1,2:IKU-0) + PYREF(2:IIU-0,1:IJU-1,2:IKU-0) + &
+ PYREF(2:IIU-0,2:IJU-0,1:IKU-1) + PYREF(1:IIU-1,2:IJU-0,1:IKU-1) + &
+ PYREF(1:IIU-1,1:IJU-1,1:IKU-1) + PYREF(2:IIU-0,1:IJU-1,1:IKU-1)
+ PYNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PYNEW(2:IIU,2:IJU,2:IKU) * (1./8.)
+ !
+ IF (LSOUTH_ll()) THEN
+ PYNEW(1,:,:) = (2.*PYNEW(2,:,:)-PYNEW(3,:,:))
+ PYNEW(:,1,:) = (2.*PYNEW(:,2,:)-PYNEW(:,3,:))
+ PYNEW(:,:,1) = (2.*PYNEW(:,:,2)-PYNEW(:,:,3))
+ PYNEW(1,1,:) = (2.*PYNEW(2,2,:)-PYNEW(3,3,:))
+ PYNEW(:,1,1) = (2.*PYNEW(:,2,2)-PYNEW(:,3,3))
+ PYNEW(1,:,1) = (2.*PYNEW(2,:,2)-PYNEW(3,:,3))
+ PYNEW(1,1,1) = (2.*PYNEW(2,2,2)-PYNEW(3,3,3))
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ PYNEW(IIU+1, :, :) = (2.*PYNEW(IIU-0, :, :)-PYNEW(IIU-1, :, :))
+ PYNEW(: ,IJU+1, :) = (2.*PYNEW(: ,IJU-0, :)-PYNEW(: ,IJU-1, :))
+ PYNEW(: , :,IKU+1) = (2.*PYNEW(: , :,IKU-0)-PYNEW(: , :,IKU-1))
+ PYNEW(IIU+1,IJU+1, :) = (2.*PYNEW(IIU-0,IJU-0, :)-PYNEW(IIU-1,IJU-1, :))
+ PYNEW(: ,IJU+1,IKU+1) = (2.*PYNEW(: ,IJU-0,IKU-0)-PYNEW(: ,IJU-1,IKU-1))
+ PYNEW(IIU+1, :,IKU+1) = (2.*PYNEW(IIU-0, :,IKU-0)-PYNEW(IIU-1, :,IKU-1))
+ PYNEW(IIU+1,IJU+1,IKU+1) = (2.*PYNEW(IIU-0,IJU-0,IKU-0)-PYNEW(IIU-1,IJU-1,IKU-1))
+ ENDIF
+ !
+ ! along Z
+ PZNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PZREF(2:IIU-0,2:IJU-0,2:IKU-0) + PZREF(1:IIU-1,2:IJU-0,2:IKU-0) + &
+ PZREF(1:IIU-1,1:IJU-1,2:IKU-0) + PZREF(2:IIU-0,1:IJU-1,2:IKU-0) + &
+ PZREF(2:IIU-0,2:IJU-0,1:IKU-1) + PZREF(1:IIU-1,2:IJU-0,1:IKU-1) + &
+ PZREF(1:IIU-1,1:IJU-1,1:IKU-1) + PZREF(2:IIU-0,1:IJU-1,1:IKU-1)
+ PZNEW(2:IIU-0,2:IJU-0,2:IKU-0) = PZNEW(2:IIU-0,2:IJU-0,2:IKU-0) * (1./8.)
+ PZNEW(1,:,:) = (2.*PZNEW(2,:,:)-PZNEW(3,:,:))
+ PZNEW(:,1,:) = (2.*PZNEW(:,2,:)-PZNEW(:,3,:))
+ PZNEW(:,:,1) = (2.*PZNEW(:,:,2)-PZNEW(:,:,3))
+ PZNEW(1,1,:) = (2.*PZNEW(2,2,:)-PZNEW(3,3,:))
+ PZNEW(:,1,1) = (2.*PZNEW(:,2,2)-PZNEW(:,3,3))
+ PZNEW(1,:,1) = (2.*PZNEW(2,:,2)-PZNEW(3,:,3))
+ PZNEW(1,1,1) = (2.*PZNEW(2,2,2)-PZNEW(3,3,3))
+ PZNEW(IIU+1, :, :) = (2.*PZNEW(IIU-0, :, :)-PZNEW(IIU-1, :, :))
+ PZNEW(: ,IJU+1, :) = (2.*PZNEW(: ,IJU-0, :)-PZNEW(: ,IJU-1, :))
+ PZNEW(: , :,IKU+1) = (2.*PZNEW(: , :,IKU-0)-PZNEW(: , :,IKU-1))
+ PZNEW(IIU+1,IJU+1, :) = (2.*PZNEW(IIU-0,IJU-0, :)-PZNEW(IIU-1,IJU-1, :))
+ PZNEW(: ,IJU+1,IKU+1) = (2.*PZNEW(: ,IJU-0,IKU-0)-PZNEW(: ,IJU-1,IKU-1))
+ PZNEW(IIU+1, :,IKU+1) = (2.*PZNEW(IIU-0, :,IKU-0)-PZNEW(IIU-1, :,IKU-1))
+ PZNEW(IIU+1,IJU+1,IKU+1) = (2.*PZNEW(IIU-0,IJU-0,IKU-0)-PZNEW(IIU-1,IJU-1,IKU-1))
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_INTERPOS2
diff --git a/src/MNH/ibm_locatcorn.f90 b/src/MNH/ibm_locatcorn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..95eeb7acc1ac48bc738ba5b8bcb1ff267fe85b90
--- /dev/null
+++ b/src/MNH/ibm_locatcorn.f90
@@ -0,0 +1,206 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_LOCATCORN
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_LOCATCORN(IINDEX,KPOS) RESULT(PLOCAT)
+ !
+ INTEGER,DIMENSION(:) , INTENT(IN) :: IINDEX
+ INTEGER , INTENT(IN) :: KPOS
+ REAL, DIMENSION(8,3) :: PLOCAT
+ !
+ END FUNCTION IBM_LOCATCORN
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_LOCATCORN
+!
+! ##################################################
+FUNCTION IBM_LOCATCORN(IINDEX,KPOS) RESULT(PLOCAT)
+ ! ##################################################
+ !
+ !**** *IBM_LOCATCORN* - routine to search location of each type of nodes
+ ! for one cell
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute (X,Y,Z) for corners of cell (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_VAR_ll, ONLY: IP
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ INTEGER, DIMENSION(:) , INTENT(IN) :: IINDEX ! IJK reference
+ INTEGER , INTENT(IN) :: KPOS ! cell type UVWP
+ REAL, DIMENSION(8,3) :: PLOCAT ! location corner
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: JI,JJ,JK,JL ! loop index
+ INTEGER :: IIU,IJU,IKU
+ INTEGER :: JIM1,JIP1,JJM1,JJP1,JKM1,JKP1
+ REAL :: ZIP1,ZJP1,ZKP1,ZIM1,ZJM1,ZKM1
+ REAL :: ZXXP,ZYYP,ZZZP,ZDXP,ZDYP,ZDZP
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ IIU = size(XZZ,1)
+ IJU = size(XZZ,2)
+ IKU = size(XZZ,3)
+ !
+ DO JL = 1,8
+ !
+ ! corners index
+ IF (JL==1) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==2) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==3) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==4) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==5) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==6) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==7) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==8) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ !
+ JIM1=max(1 ,JI-1)
+ JJM1=max(1 ,JJ-1)
+ JKM1=max(1 ,JK-1)
+ JIP1=min(IIU,JI+1)
+ JJP1=min(IJU,JJ+1)
+ JKP1=min(IKU,JK+1)
+ !
+ IF(IINDEX(1)==0.or.IINDEX(2)==0.or.IINDEX(3)==0) WRITE(*,*) 'IINDEX(1,2,3): ', IINDEX(1),IINDEX(2),IINDEX(3)
+ ZXXP = XXHAT(IINDEX(1))
+ ZYYP = XYHAT(IINDEX(2))
+ ZZZP = XZZ(IINDEX(1),IINDEX(2),IINDEX(3))
+ ZDXP = XXHAT(IINDEX(1)+1)-XXHAT(IINDEX(1))
+ ZDYP = XYHAT(IINDEX(2)+1)-XYHAT(IINDEX(2))
+ ZDZP = XZZ(IINDEX(1),IINDEX(2),IINDEX(3)+1)-XZZ(IINDEX(1),IINDEX(2),IINDEX(3))
+ !
+ IF (KPOS==1) THEN
+ PLOCAT(JL,1) = ZXXP+ZDXP/2.+(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP+ZDYP/2.+(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP+ZDZP/2.+(JK-IINDEX(3))*ZDZP
+ ENDIF
+ IF (KPOS==2) THEN
+ PLOCAT(JL,1) = ZXXP +(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP+ZDYP/2.+(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP+ZDZP/2.+(JK-IINDEX(3))*ZDZP
+ ENDIF
+ IF (KPOS==3) THEN
+ PLOCAT(JL,1) = ZXXP+ZDXP/2.+(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP +(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP+ZDZP/2.+(JK-IINDEX(3))*ZDZP
+ ENDIF
+ IF (KPOS==4) THEN
+ PLOCAT(JL,1) = ZXXP+ZDXP/2.+(JI-IINDEX(1))*ZDXP
+ PLOCAT(JL,2) = ZYYP+ZDYP/2.+(JJ-IINDEX(2))*ZDYP
+ PLOCAT(JL,3) = ZZZP +(JK-IINDEX(3))*ZDZP
+ ENDIF
+ !
+ ENDDO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END FUNCTION IBM_LOCATCORN
diff --git a/src/MNH/ibm_mixinglength.f90 b/src/MNH/ibm_mixinglength.f90
new file mode 100644
index 0000000000000000000000000000000000000000..14bb0dd89b6effcd7d00516aea80b62a9b222b78
--- /dev/null
+++ b/src/MNH/ibm_mixinglength.f90
@@ -0,0 +1,164 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! ############################
+MODULE MODI_IBM_MIXINGLENGTH
+ ! ############################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
+ !
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMU
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PHI
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ !
+ END SUBROUTINE IBM_MIXINGLENGTH
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_MIXINGLENGTH
+!
+! ###################################################
+SUBROUTINE IBM_MIXINGLENGTH(PLM,PLEPS,PMU,PHI,PTKE)
+ ! ###################################################
+ !
+ !**** *IBM_MIXINGLENGTH* - Alteration of the mixing lenght (IBM)
+ !
+ ! PURPOSE
+ ! -------
+ ! The limitation is corrected for the immersed bonudary method:
+ ! => using the level set phi
+ ! => LM < k(-phi)
+ !
+ ! METHOD
+ ! ------
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! declaration
+ USE MODD_FIELD_n
+ USE MODD_PARAMETERS
+ USE MODD_IBM_PARAM_n
+ USE MODD_REF_n, ONLY: XRHODJ,XRHODREF
+ USE MODD_CTURB
+ USE MODD_CST
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLM
+ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PLEPS
+ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PMU
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PHI
+ REAL, DIMENSION(:,:,:), INTENT(IN) :: PTKE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ REAL, DIMENSION(size(PLM,1),size(PLM,2),size(PLM,3)) :: ZALPHA,ZBETA
+ REAL, DIMENSION(size(PLM,1),size(PLM,2),size(PLM,3)) :: ZLM,ZMU,ZLN
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll,IKU,IKB,IKE,IIB,IIE,IJB,IJE
+ REAL :: ZKARMAN
+ !
+ !-------------------------------------------------------------------------------
+ !
+ IKU=SIZE(PLM,3)
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
+ !
+ ! Turbulent velocity
+ !
+ ZMU(:,:,:)= 2.*XIBM_CNU**0.25*(PTKE(:,:,:))**(1./2.) !2 correspond to KTKE
+ ZKARMAN = XKARMAN*XCED/XIBM_CNU**0.75
+ !
+ ! Mesh scale
+ !
+ ZLN(:,:,:) = (XRHODJ(:,:,:)/XRHODREF(:,:,:))**(1./3.)
+ ZLM(:,:,:) = PLM(:,:,:)
+ !
+ ! limit domain
+ !
+ ZBETA(:,:,:)= XZZ (:,:,:)
+ ZBETA(:,:,IKB:IKE) = 0.5*(XZZ(:,:,IKB+1:IKE+1)+XZZ(:,:,IKB:IKE))
+ ZBETA(:,:,IKB-1) = -0.5*(XZZ(:,:,IKB+1)+XZZ(:,:,IKB))
+ ZBETA(:,:,IKE+1) = ZBETA(:,:,IKE)
+ ZLM(:,:,:) = MIN(ZLM(:,:,:),+ZKARMAN*ZBETA(:,:,:))
+ !
+ ! limit immersed wall
+ !
+ ZLM(:,:,:) = MIN(ZLM(:,:,:),-ZKARMAN*PHI(:,:,:))
+ !
+ ! limit physical scale
+ ZALPHA(:,:,:) = MIN(9.8*XIBM_RUG,0.5*ZKARMAN*ZLN(:,:,:))
+ ZLM(:,:,:) = MAX(ZALPHA(:,:,:),ZLM(:,:,:))
+ !
+ ! Boundary condition
+ ZMU(:,:,IKB-1)= ZMU(:,:,IKB)
+ ZLM(:,:,IKB-1)= ZLM(:,:,IKB)
+ ZMU(:,:,IKE+1)= ZMU(:,:,IKE)
+ ZLM(:,:,IKE+1)= ZLM(:,:,IKE)
+ IF (LEAST_ll()) THEN
+ ZMU(IIE+1,:,:)= ZMU(IIE,:,:)
+ ZLM(IIE+1,:,:)= ZLM(IIE,:,:)
+ ENDIF
+ IF (LWEST_ll()) THEN
+ ZMU(IIB-1,:,:)= ZMU(IIB,:,:)
+ ZLM(IIB-1,:,:)= ZLM(IIB,:,:)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ ZMU(:,IJE+1,:)= ZMU(:,IJE,:)
+ ZLM(:,IJE+1,:)= ZLM(:,IJE,:)
+ ENDIF
+ IF (LSOUTH_ll()) THEN
+ ZMU(:,IJB-1,:)= ZMU(:,IJB,:)
+ ZLM(:,IJB-1,:)= ZLM(:,IJB,:)
+ ENDIF
+ !
+ !Communication
+ PLM(:,:,:) = ZLM(:,:,:)
+ PLEPS(:,:,:) = PLM(:,:,:)
+ PMU(:,:,:) = ZMU(:,:,:)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_MIXINGLENGTH
diff --git a/src/MNH/ibm_prep_ls.f90 b/src/MNH/ibm_prep_ls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f4929d7c343c647a33c965e837459e7cf3cbb72b
--- /dev/null
+++ b/src/MNH/ibm_prep_ls.f90
@@ -0,0 +1,431 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODI_IBM_PREP_LS
+ ! #######################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
+ !
+ LOGICAL , INTENT(IN) :: OIBM
+ CHARACTER(LEN=4) , INTENT(IN) :: HIBM_TYPE
+ REAL, DIMENSION(:,:,:,:) , INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_PREP_LS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_PREP_LS
+!
+! ###########################################
+SUBROUTINE IBM_PREP_LS(OIBM,HIBM_TYPE,PPHI)
+ ! ###########################################
+ !
+ !
+ !**** IBM_PREP_LS computes the LS level set function
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to localize fluid-solid interface
+ ! for the immersed boundary method in the help of LS function.
+ ! This functions allow the access to interface characteristics
+ ! (normal vector, curvature,...)
+ !
+ ! METHOD
+ ! ------
+ !**** Types of topography:
+ ! 1)GENE : generalized obstacles (x,y coordinates)
+ ! => read the informations (triangles constituting the
+ ! faces of obstacles) from an .obj file.
+ ! The .obj file must have a particular organization:
+ ! a) A line with 'usemtl' indicates the 2 materials
+ ! of each side of the interface. Only the faces with
+ ! their external face in contact with the outside air
+ ! are read (mat2=air)
+ ! b) A line starting with 'v' indicates the location
+ ! (x,y,z coordinates) of a face vortex.
+ ! c) A line starting with 'f' indicates the vortices
+ ! constituting the face.
+ ! usemtl mat1:mat2
+ ! v xv1 yv1 zv1
+ ! v xv2 yv2 zv2
+ ! v xv3 yv3 zv3
+ ! v xv4 yv4 zv4
+ ! f 1 2 3
+ ! f 1 3 4
+ ! 2)IDEA : idealized obstacles (x,y coordinates)
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ ! For the generalized case, the method is based on '3D Distance from a
+ ! Point to a Triangle' a technical report from Mark W. Jones, University
+ ! of Wales Swansea [Jones (1995)].
+ !
+ ! AUTHORS
+ ! ------
+ ! Franck Auguste (CERFACS-AE), Tim Nagel (Météo-France)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/06/2021
+ ! P. Wautelet 23/07/2021: replace non-standard FLOAT function by REAL function
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ USE MODD_VAR_ll, ONLY: IP
+ USE MODD_CONF, ONLY: NHALO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_IBM_LSF
+ USE MODD_DIM_n, ONLY: NIMAX,NJMAX,NKMAX
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_LBC_n
+ USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_GDIV
+ USE MODI_IBM_GENERLS
+ USE MODI_IBM_IDEALRP
+ USE MODI_IBM_IDEALEE
+ !
+ USE MODD_GRID
+ USE MODD_CST
+ USE MODD_GRID_n
+ USE MODE_GRIDPROJ
+ USE MODE_MSG
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ LOGICAL ,INTENT(IN) :: OIBM ! flag for immersed boundary method
+ CHARACTER(LEN=4) ,INTENT(IN) :: HIBM_TYPE ! switch generalized/idealized object
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI ! LS functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: JN,JM,JNM,JL,JMM,JI,JJ,JK,JF,JV ! loop index
+ INTEGER :: IIU,IJU
+ REAL :: ZX_MIN,ZX_MAX,ZY_MIN,ZY_MAX,DX_LOW,DY_LOW,DX_HIGH,DY_HIGH
+ INTEGER :: ILUIBMIDEA,IRESPIBMGENE,ILUIBMGENE,IRESPIBMIDEA ! integers for open/read files
+ INTEGER :: IIBM_NUMB_NODE_SURF ! number of surface points (generalized case)
+ INTEGER :: IIBM_NUMB_TYPE_SURF ! number of surface type (idealized case)
+ INTEGER :: IIBM_TYPE_SURF ! type of surfaces
+ INTEGER :: IIBM_NUMB_SURF ! number of surfaces in each type
+ REAL :: ZIBM_X1,ZIBM_X2,ZIBM_Y1,ZIBM_Y2,ZIBM_Z1,ZIBM_Z2 ! location of surface points for one object
+ REAL :: ZIBM_TYPE_SURF
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZIBM_XYZ1,ZIBM_XYZ2 ! location of surface points for all object
+ REAL, DIMENSION(:,:), ALLOCATABLE :: ZV1,ZV1_2,ZV2,ZV2_2,ZV3,ZV3_2 ! face vectors
+ REAL, DIMENSION(:,:), ALLOCATABLE :: NORM_FACES,NORM_FACES2 ! norm of the faces
+ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZIBM_FACES,ZIBM_FACES2,ZIBM_FACES2b ! extremities of triangle faces for all object
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll
+ INTEGER :: IINFO_ll
+ CHARACTER(LEN=12) :: HFILEGENE, HFILEIDEA
+ CHARACTER(LEN=100) :: YSTRING,YSTRING2
+ INTEGER :: NS1,NS2,NS3,NS4,NS5,NS6
+ INTEGER :: ZN1,ZN2,ZN3,JCOUNT
+ REAL, DIMENSION(3) :: ZNA,ZNB
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ HFILEGENE = "ibm_gene.obj"
+ HFILEIDEA = "ibm_idea.nam"
+ !
+ IIU = SIZE(XXHAT)
+ IJU = SIZE(XYHAT)
+ !
+ DX_LOW = XXHAT(2)-XXHAT(1)
+ DX_HIGH = XXHAT(IIU)-XXHAT(IIU-1)
+ DY_LOW = XYHAT(2)-XYHAT(1)
+ DY_HIGH = XYHAT(IJU)-XYHAT(IJU-1)
+ !
+ !Collect the face up to 10 gridsize out of the current processor
+ ZX_MIN = XXHAT(1)-10.*DX_LOW
+ ZX_MAX = XXHAT(IIU)+(11.)*DX_HIGH
+ ZY_MIN = XYHAT(1)-10.*DY_LOW
+ ZY_MAX = XYHAT(IJU)+(11.)*DY_HIGH
+ !
+ !------------------------------------------------------------------------------
+ !
+ !* *** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ! Read input files in order to compute interface location
+ ! - 'ibm_gene.obj' for generalized case
+ ! => read the informations (triangles constituting the
+ ! faces of obstacles) from an .obj file
+ ! - 'm_ideal.nam' for idealized case
+ ! (NUMB_NODE_SURF is the number of objects)
+ ! (NUMB_TYPE_SURF is the number of surface types:
+ ! ( TYPE_SURF = 1 for parallelepipedic shape
+ ! TYPE_SURF = 2 for ellipsoidal shape)
+ ! ( NUMB_SURF is the objects number in each type)
+ !
+ !
+ !--------------------------------
+ !--------Generalized case--------
+ !--------------------------------
+ IF (HIBM_TYPE=='GENE') THEN
+ !
+ !Allocate the tables containing the vortices, the faces locations,
+ !the norms, which are needed to calculate the LSF
+ ALLOCATE(ZIBM_XYZ1(5400000,3))
+ ALLOCATE(ZIBM_FACES(3150000,3,3))
+ ALLOCATE(ZIBM_FACES2b(3150000,3,3))
+ ALLOCATE(NORM_FACES(3150000,3))
+ ALLOCATE(ZV1(3150000,3))
+ ALLOCATE(ZV2(3150000,3))
+ ALLOCATE(ZV3(3150000,3))
+ !
+ OPEN(NEWUNIT=ILUIBMGENE , FILE=HFILEGENE , IOSTAT=IRESPIBMGENE , STATUS='OLD')
+ !
+ JV=1
+ JF=0
+ JCOUNT=0
+ !
+ !Only the faces that are in contact with the air (external faces of
+ !the obstacles) are read.
+ DO
+ IF (IRESPIBMGENE/=0) EXIT
+ READ(UNIT=ILUIBMGENE,FMT='(A100)',IOSTAT=IRESPIBMGENE) YSTRING
+ NS1=LEN(TRIM(YSTRING))
+ IF (TRIM(YSTRING(1:7))=='usemtl') THEN
+ IF (TRIM(YSTRING(NS1-3:NS1))==':air') THEN
+ JN=1
+ ELSE
+ JN=0
+ ENDIF
+ ENDIF
+ IF (TRIM(YSTRING(1:2))=='v') THEN
+ NS2=INDEX(TRIM(YSTRING)," ",back=.true.)
+ NS3=LEN(TRIM(YSTRING(:NS2)))
+ NS4=INDEX(TRIM(YSTRING(:NS3))," ",back=.true.)
+ NS5=LEN(TRIM(YSTRING(:NS4)))
+ NS6=INDEX(TRIM(YSTRING(:NS5))," ",back=.true.)
+ READ(YSTRING(NS6:NS5) , *) ZIBM_XYZ1(JV,1)
+ READ(YSTRING(NS4:NS3) , *) ZIBM_XYZ1(JV,2)
+ READ(YSTRING(NS2:NS1) , *) ZIBM_XYZ1(JV,3)
+ !FIXME temporary spatial modification
+ ZIBM_XYZ1(JV,1) = ZIBM_XYZ1(JV,1) +200.
+ ZIBM_XYZ1(JV,2) = ZIBM_XYZ1(JV,2) +200.
+ JV=JV+1
+ ENDIF
+ IF (JN==1.AND.TRIM(YSTRING(1:2))=='f') THEN
+ NS2=INDEX(TRIM(YSTRING)," ",back=.true.)
+ NS3=LEN(TRIM(YSTRING(:NS2)))
+ NS4=INDEX(TRIM(YSTRING(:NS3))," ",back=.true.)
+ NS5=LEN(TRIM(YSTRING(:NS4)))
+ NS6=INDEX(TRIM(YSTRING(:NS5))," ",back=.true.)
+ READ(YSTRING(NS6:NS5) , *) ZN1
+ READ(YSTRING(NS4:NS3) , *) ZN2
+ READ(YSTRING(NS2:NS1) , *) ZN3
+ ! If the face extremities are far outside of the processor they are not read
+ IF (ZIBM_XYZ1(ZN1,1)<ZX_MIN.AND.ZIBM_XYZ1(ZN2,1)<ZX_MIN.AND.ZIBM_XYZ1(ZN3,1)<ZX_MIN) CYCLE
+ IF (ZIBM_XYZ1(ZN1,1)>ZX_MAX.AND.ZIBM_XYZ1(ZN2,1)>ZX_MAX.AND.ZIBM_XYZ1(ZN3,1)>ZX_MAX) CYCLE
+ IF (ZIBM_XYZ1(ZN1,2)<ZY_MIN.AND.ZIBM_XYZ1(ZN2,2)<ZY_MIN.AND.ZIBM_XYZ1(ZN3,2)<ZY_MIN) CYCLE
+ IF (ZIBM_XYZ1(ZN1,2)>ZY_MAX.AND.ZIBM_XYZ1(ZN2,2)>ZY_MAX.AND.ZIBM_XYZ1(ZN3,2)>ZY_MAX) CYCLE
+ JF=JF+1
+ !
+ ZIBM_FACES(JF,1,1) = ZIBM_XYZ1(ZN1,1)
+ ZIBM_FACES(JF,1,2) = ZIBM_XYZ1(ZN1,2)
+ ZIBM_FACES(JF,1,3) = ZIBM_XYZ1(ZN1,3)
+ ZIBM_FACES(JF,2,1) = ZIBM_XYZ1(ZN2,1)
+ ZIBM_FACES(JF,2,2) = ZIBM_XYZ1(ZN2,2)
+ ZIBM_FACES(JF,2,3) = ZIBM_XYZ1(ZN2,3)
+ ZIBM_FACES(JF,3,1) = ZIBM_XYZ1(ZN3,1)
+ ZIBM_FACES(JF,3,2) = ZIBM_XYZ1(ZN3,2)
+ ZIBM_FACES(JF,3,3) = ZIBM_XYZ1(ZN3,3)
+ !
+ ZNA(1) = ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,2,1)
+ ZNA(2) = ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,2,2)
+ ZNA(3) = ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,2,3)
+ ZNB(1) = ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,3,1)
+ ZNB(2) = ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,3,2)
+ ZNB(3) = ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,3,3)
+ !Elimination of '1D' faces
+ IF (ZNA(1)==0..AND.ZNA(2)==0..AND.ZNA(3)==0.) CYCLE
+ IF (ZNB(1)==0..AND.ZNB(2)==0..AND.ZNB(3)==0.) CYCLE
+ IF (ZNA(2)==0..AND.ZNA(3)==0..AND.ZNB(2)==0..AND.ZNB(3)==0.) CYCLE
+ IF (ZNA(1)==ZNB(1).AND.ZNA(2)==ZNB(2).AND.ZNA(3)==ZNB(3)) CYCLE
+ JCOUNT=JCOUNT+1
+ NORM_FACES(JCOUNT,:)= CROSSPRODUCT(ZNA,ZNB)
+ ZIBM_FACES2b(JCOUNT,:,:)=ZIBM_FACES(JF,:,:)
+ !
+ !Equation (6) of Jones (1995)
+ ZV1(JCOUNT,1) = (ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,2,1))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,2,3))**2)+ &
+ (ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,3,1))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,3,3))**2)
+ !
+ ZV1(JCOUNT,2) = (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,2,2))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,2,3))**2)+ &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,3,2))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,3,3))**2)
+ !
+ ZV1(JCOUNT,3) = (ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,2,3))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,2,3))**2)+ &
+ (ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,3,3))/ SQRT((ZIBM_FACES(JF,1,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,1,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,1,3)-ZIBM_FACES(JF,3,3))**2)
+ !
+ ZV2(JCOUNT,1) = (ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,3,1))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,3,3))**2)+ &
+ (ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,1,1))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,1,3))**2)
+ !
+ ZV2(JCOUNT,2) = (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,3,2))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,3,3))**2)+ &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,1,2))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,1,3))**2)
+ !
+ ZV2(JCOUNT,3) = (ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,3,3))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,3,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,3,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,3,3))**2)+ &
+ (ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,1,3))/ SQRT((ZIBM_FACES(JF,2,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,2,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,2,3)-ZIBM_FACES(JF,1,3))**2)
+ !
+ ZV3(JCOUNT,1) = (ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,1,1))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,1,3))**2)+ &
+ (ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,2,1))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,2,3))**2)
+ !
+ ZV3(JCOUNT,2) = (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,1,2))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,1,3))**2)+ &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,2,2))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,2,3))**2)
+ !
+ ZV3(JCOUNT,3) = (ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,1,3))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,1,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,1,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,1,3))**2)+ &
+ (ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,2,3))/ SQRT((ZIBM_FACES(JF,3,1)-ZIBM_FACES(JF,2,1))**2 + &
+ (ZIBM_FACES(JF,3,2)-ZIBM_FACES(JF,2,2))**2 +(ZIBM_FACES(JF,3,3)-ZIBM_FACES(JF,2,3))**2)
+ !
+ ENDIF
+ !
+ IF (JN==1.AND.TRIM(YSTRING(1:2))=='vn') THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Unable to read vn found in .obj' )
+ ENDIF
+ !
+ IF (JN==1.AND.TRIM(YSTRING(1:2))=='vt') THEN
+ call Print_msg( NVERB_FATAL, 'GEN', 'IBM_PREP_LS', 'Unable to read vt found in .obj' )
+ ENDIF
+ !
+ END DO
+ !
+ ALLOCATE(ZIBM_FACES2(JCOUNT,3,3))
+ ALLOCATE(NORM_FACES2(JCOUNT,3))
+ ALLOCATE(ZV1_2(JCOUNT,3))
+ ALLOCATE(ZV2_2(JCOUNT,3))
+ ALLOCATE(ZV3_2(JCOUNT,3))
+ !
+ NORM_FACES2 = NORM_FACES(:JCOUNT,:)
+ ZV1_2 = ZV1(:JCOUNT,:)
+ ZV2_2 = ZV2(:JCOUNT,:)
+ ZV3_2 = ZV3(:JCOUNT,:)
+ ZIBM_FACES2 = ZIBM_FACES2b(:JCOUNT,:,:)
+ !
+ ENDIF
+ !
+ !----------------------------
+ !---------Idealized case-----
+ !----------------------------
+ IF (HIBM_TYPE=='IDEA') THEN
+ !
+ OPEN(NEWUNIT=ILUIBMIDEA , FILE= HFILEIDEA , IOSTAT=IRESPIBMIDEA , FORM='FORMATTED' , &
+ STATUS='OLD', ACCESS='SEQUENTIAL', ACTION='READ')
+ !
+ READ(UNIT=ILUIBMIDEA,FMT=*) IIBM_NUMB_NODE_SURF, IIBM_NUMB_TYPE_SURF
+ ALLOCATE(ZIBM_XYZ2(IIBM_NUMB_NODE_SURF,7))
+ !
+ ZIBM_XYZ2(:,:) = 0.
+ JNM = 0
+ DO JN=1,IIBM_NUMB_TYPE_SURF
+ !
+ READ(UNIT=ILUIBMIDEA,FMT=*) IIBM_TYPE_SURF, IIBM_NUMB_SURF
+ ZIBM_TYPE_SURF= REAL(IIBM_TYPE_SURF)
+ !
+ DO JM=1,IIBM_NUMB_SURF
+ !
+ READ(UNIT=ILUIBMIDEA,FMT=*) ZIBM_X1,ZIBM_X2,ZIBM_Y1,ZIBM_Y2,ZIBM_Z1,ZIBM_Z2
+ !
+ JNM = JNM + 1
+ ZIBM_XYZ2(JNM,1) = ZIBM_X1 !x_mini(pp) or x_cent(ee)
+ ZIBM_XYZ2(JNM,2) = ZIBM_X2 !x_maxi(pp) or x_delt(ee)
+ ZIBM_XYZ2(JNM,3) = ZIBM_Y1 !y_mini(pp) or y_cent(ee)
+ ZIBM_XYZ2(JNM,4) = ZIBM_Y2 !y_maxi(pp) or y_delt(ee)
+ ZIBM_XYZ2(JNM,5) = ZIBM_Z1 !z_mini(pp) or z_cent(ee)
+ ZIBM_XYZ2(JNM,6) = ZIBM_Z2 !z_maxi(pp) or z_delt(ee)
+ ZIBM_XYZ2(JNM,7) = ZIBM_TYPE_SURF !surface type (1=pp/2=ee)
+ !
+ ENDDO
+ !
+ ENDDO
+ ENDIF
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! Computations of volumic fraction (VF) and Level Set function (LS) for all kinds of initialization
+ ! generalized shape => construction of LS function (z<z_interface <=> phi>0)
+ ! the method is based on '3D Distance from a Point to a Triangle' [Jones (1995)].
+ ! => conversion of LS function to VF function (Sussman, JCP (1994)
+ ! idealized shape => construction of VF/LS function using analytical
+ ! locations of interface (ellipsoidal/parallelepipedic shapes)
+ !
+ IF (HIBM_TYPE=='GENE') THEN
+ CALL IBM_GENERLS(ZIBM_FACES2,NORM_FACES2,ZV1_2,ZV2_2,ZV3_2,ZX_MIN,ZY_MIN,ZX_MAX,ZY_MAX,PPHI)
+ ENDIF
+ !
+ IF (HIBM_TYPE=='IDEA') then
+ DO JN=1,JNM
+ IF (abs(ZIBM_XYZ2(JN,7)-1.).lt.XIBM_EPSI) CALL IBM_IDEALRP(JN,ZIBM_XYZ2,PPHI)
+ IF (abs(ZIBM_XYZ2(JN,7)-2.).lt.XIBM_EPSI) CALL IBM_IDEALEE(JN,ZIBM_XYZ2,PPHI)
+ ENDDO
+ ENDIF
+ !
+CONTAINS
+ !
+ FUNCTION CROSSPRODUCT(PA,PB) RESULT(CROSS)
+ !
+ REAL, DIMENSION(3) :: CROSS
+ REAL :: VAL
+ REAL, DIMENSION(3), INTENT(IN) :: PA, PB
+ !
+ CROSS(1) = PA(2) * PB(3) - PA(3) * PB(2)
+ CROSS(2) = PA(3) * PB(1) - PA(1) * PB(3)
+ CROSS(3) = PA(1) * PB(2) - PA(2) * PB(1)
+ !
+ VAL = (CROSS(1)**2+CROSS(2)**2+CROSS(3)**2)**(0.5)
+ !
+ CROSS(1) = CROSS(1)/VAL
+ CROSS(2) = CROSS(2)/VAL
+ CROSS(3) = CROSS(3)/VAL
+ !
+ END FUNCTION CROSSPRODUCT
+ !
+END SUBROUTINE IBM_PREP_LS
diff --git a/src/MNH/ibm_smooth_ls.f90 b/src/MNH/ibm_smooth_ls.f90
new file mode 100644
index 0000000000000000000000000000000000000000..96144123454422ed14e94f1ae592098171937ca9
--- /dev/null
+++ b/src/MNH/ibm_smooth_ls.f90
@@ -0,0 +1,653 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_SMOOTH_LS
+ ! #########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_SMOOTH_LS(KIBM_SMOOTH,PIBM_SMOOTH,PPHI)
+ !
+ INTEGER ,INTENT(IN) :: KIBM_SMOOTH
+ REAL ,INTENT(IN) :: PIBM_SMOOTH
+ REAL, DIMENSION(:,:,:,:) ,INTENT(INOUT) :: PPHI
+ !
+ END SUBROUTINE IBM_SMOOTH_LS
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_SMOOTH_LS
+!
+! ######################################################
+SUBROUTINE IBM_SMOOTH_LS(KIBM_SMOOTH,PIBM_SMOOTH,PPHI)
+ ! ######################################################
+ !
+ !
+ !**** IBM_SMOOTH_LS is a smoothing method for LS function
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to smooth VF/LS functions
+ ! in order to improve computations of characteristics surface
+ ! (be careful with singularities and corners)
+ !
+ ! METHOD
+ ! ------
+ !**** Iterative systems
+ ! - value at mass node weighted by values at neighboring flux nodes
+ ! - value at flux node weighted by values at neighboring mass nodes
+ !
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_POS
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_IBM_LSF
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZZ
+ USE MODD_METRICS_n, ONLY: XDXX,XDYY,XDZZ,XDZX,XDZY
+ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+ USE MODD_VAR_ll, ONLY: IP
+ !
+ ! interface
+ USE MODI_SHUMAN
+ USE MODI_GRADIENT_M
+ USE MODI_GRADIENT_U
+ USE MODI_GRADIENT_V
+ USE MODI_GRADIENT_W
+ USE MODI_GRADIENT_UV
+ USE MODI_GRADIENT_VW
+ USE MODI_GRADIENT_UW
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ INTEGER , INTENT(IN) :: KIBM_SMOOTH ! Smooth levels
+ REAL , INTENT(IN) :: PIBM_SMOOTH ! Smooth weighting
+ REAL, DIMENSION(:,:,:,:) , INTENT(INOUT) :: PPHI ! LS functions
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIB,IJB,IKB,IIE,IJE,IKE
+ INTEGER :: IIU,IJU,IKU ! domain size
+ INTEGER :: JI,JJ,JK,JL,JM ! loop index
+ INTEGER :: ILISPT_NUMB ! number of smooth iteration
+ REAL :: ILISPT_FACT ! smooth factor
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ REAL :: ILISPT_FACTU,ILISPT_FACTV
+ REAL :: ILISPT_FACTW,ILISPT_FACTP
+ REAL :: ZPE,ZPW,ZPB,ZPT,ZPN,ZPS
+ REAL :: ZREF,ZREF3
+ REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZTEMP
+ REAL,DIMENSION(:,:,:,:,:), ALLOCATABLE :: Z_NORM_TEMP0
+ REAL,DIMENSION(:,:,:) , ALLOCATABLE :: Z_NORM_TEMP1
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ !
+ IIU=SIZE(PPHI,1)
+ IJU=SIZE(PPHI,2)
+ IKU=SIZE(PPHI,3)
+ !
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ !
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ ZREF =(1.e-2)*((XXHAT(IIB+1)-XXHAT(IIB))*(XYHAT(IJB+1)-XYHAT(IJB)))**0.5
+ ZREF3=((XXHAT(IIB+1)-XXHAT(IIB))*(XYHAT(IJB+1)-XYHAT(IJB)))**0.5
+ !
+ ! Boundary symmetry
+ !
+ PPHI(:,:,1,5) = 2.*PPHI(:,:,2,5)-PPHI(:,:,3,5)
+ PPHI(:,:,1,3) = 2.*PPHI(:,:,2,3)-PPHI(:,:,3,3)
+ PPHI(:,:,1,2) = 2.*PPHI(:,:,2,2)-PPHI(:,:,3,2)
+ PPHI(:,:,1,1) = 2.*PPHI(:,:,2,1)-PPHI(:,:,3,1)
+ WHERE (PPHI(:,:,2,5).GT.XIBM_EPSI) PPHI(:,:,1,5) = PPHI(:,:,2,5)
+ WHERE (PPHI(:,:,2,3).GT.XIBM_EPSI) PPHI(:,:,1,3) = PPHI(:,:,2,3)
+ WHERE (PPHI(:,:,2,2).GT.XIBM_EPSI) PPHI(:,:,1,2) = PPHI(:,:,2,2)
+ WHERE (PPHI(:,:,2,1).GT.XIBM_EPSI) PPHI(:,:,1,1) = PPHI(:,:,2,1)
+ PPHI(:,:,2,6) = (PPHI(:,:,2,2)+PPHI(:,:,1,2))/2.
+ PPHI(:,:,2,7) = (PPHI(:,:,2,3)+PPHI(:,:,1,3))/2.
+ PPHI(:,:,2,4) = (PPHI(:,:,2,1)+PPHI(:,:,1,1))/2.
+ PPHI(:,:,1,6) = 2.*PPHI(:,:,2,6)-PPHI(:,:,3,6)
+ PPHI(:,:,1,7) = 2.*PPHI(:,:,2,7)-PPHI(:,:,3,7)
+ PPHI(:,:,1,4) = 2.*PPHI(:,:,2,4)-PPHI(:,:,3,4)
+ WHERE (PPHI(:,:,2,6).GT.XIBM_EPSI) PPHI(:,:,1,6) = PPHI(:,:,2,6)
+ WHERE (PPHI(:,:,2,7).GT.XIBM_EPSI) PPHI(:,:,1,7) = PPHI(:,:,2,7)
+ WHERE (PPHI(:,:,2,4).GT.XIBM_EPSI) PPHI(:,:,1,4) = PPHI(:,:,2,4)
+ !
+ PPHI(:,:,IKU,5) = 2.*PPHI(:,:,IKU-1,5)-PPHI(:,:,IKU-2,5)
+ PPHI(:,:,IKU,3) = 2.*PPHI(:,:,IKU-1,3)-PPHI(:,:,IKU-2,3)
+ PPHI(:,:,IKU,2) = 2.*PPHI(:,:,IKU-1,2)-PPHI(:,:,IKU-2,2)
+ PPHI(:,:,IKU,1) = 2.*PPHI(:,:,IKU-1,1)-PPHI(:,:,IKU-2,1)
+ WHERE (PPHI(:,:,IKU-1,5).GT.XIBM_EPSI) PPHI(:,:,IKU,5) = PPHI(:,:,IKU-1,5)
+ WHERE (PPHI(:,:,IKU-1,3).GT.XIBM_EPSI) PPHI(:,:,IKU,3) = PPHI(:,:,IKU-1,3)
+ WHERE (PPHI(:,:,IKU-1,2).GT.XIBM_EPSI) PPHI(:,:,IKU,2) = PPHI(:,:,IKU-1,2)
+ WHERE (PPHI(:,:,IKU-1,1).GT.XIBM_EPSI) PPHI(:,:,IKU,1) = PPHI(:,:,IKU-1,1)
+ PPHI(:,:,IKU,6) = (PPHI(:,:,IKU-1,2)+PPHI(:,:,IKU,2))/2.
+ PPHI(:,:,IKU,7) = (PPHI(:,:,IKU-1,3)+PPHI(:,:,IKU,3))/2.
+ PPHI(:,:,IKU,4) = (PPHI(:,:,IKU-1,1)+PPHI(:,:,IKU,1))/2.
+ WHERE (PPHI(:,:,IKU-1,6).GT.XIBM_EPSI) PPHI(:,:,IKU,6) = PPHI(:,:,IKU-1,6)
+ WHERE (PPHI(:,:,IKU-1,7).GT.XIBM_EPSI) PPHI(:,:,IKU,7) = PPHI(:,:,IKU-1,7)
+ WHERE (PPHI(:,:,IKU-1,4).GT.XIBM_EPSI) PPHI(:,:,IKU,4) = PPHI(:,:,IKU-1,4)
+ !
+ DO JL=1,7
+ !
+ IF (LWEST_ll ()) PPHI(2 ,:,:,JL) = PPHI( 3,:,:,JL)
+ IF (LEAST_ll ()) PPHI(IIU-1,:,:,JL) = PPHI(IIU-2,:,:,JL)
+ IF (LSOUTH_ll()) PPHI(:,2 ,:,JL) = PPHI(:, 3,:,JL)
+ IF (LNORTH_ll()) PPHI(:,IJU-1,:,JL) = PPHI(:,IJU-2,:,JL)
+ IF (LWEST_ll ()) PPHI(1 ,:,:,JL) = PPHI( 2,:,:,JL)
+ IF (LEAST_ll ()) PPHI(IIU,:,:,JL) = PPHI(IIU-1,:,:,JL)
+ IF (LSOUTH_ll()) PPHI(:,1 ,:,JL) = PPHI(:, 2,:,JL)
+ IF (LNORTH_ll()) PPHI(:,IJU,:,JL) = PPHI(:,IJU-1,:,JL)
+ !
+ IF(LWEST_ll()) THEN
+ PPHI(IIB-1,IJB:IJE,IKB-1,JL)=PPHI(IIB-1,IJB:IJE,IKB,JL)
+ PPHI(IIB-1,IJB:IJE,IKE+1,JL)=PPHI(IIB-1,IJB:IJE,IKE,JL)
+ END IF
+ !
+ IF (LEAST_ll()) THEN
+ PPHI(IIE+1,IJB:IJE,IKB-1,JL)=PPHI(IIE+1,IJB:IJE,IKB,JL)
+ PPHI(IIE+1,IJB:IJE,IKE+1,JL)=PPHI(IIE+1,IJB:IJE,IKE,JL)
+ END IF
+ !
+ IF (LSOUTH_ll()) THEN
+ PPHI(IIB:IIE,IJB-1,IKB-1,JL)=PPHI(IIB:IIE,IJB-1,IKB,JL)
+ PPHI(IIB:IIE,IJB-1,IKE+1,JL)=PPHI(IIB:IIE,IJB-1,IKE,JL)
+ END IF
+ !
+ IF (LNORTH_ll()) THEN
+ PPHI(IIB:IIE,IJE+1,IKB-1,JL)=PPHI(IIB:IIE,IJE+1,IKB,JL)
+ PPHI(IIB:IIE,IJE+1,IKE+1,JL)=PPHI(IIB:IIE,IJE+1,IKE,JL)
+ END IF
+ !
+ WHERE (ABS(PPHI(:,:,:,JL)).LT.(ZREF-2.*XIBM_EPSI)) PPHI(:,:,:,JL) = ZREF-XIBM_EPSI
+ !
+ ENDDO
+ !
+ NULLIFY(TZFIELDS_ll)
+ !
+ DO JL=1,7
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,PPHI(:,:,:,JL),'IBM_SMOOTH_LS::PPHI')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ IF (KIBM_SMOOTH==0) RETURN
+ !
+ ALLOCATE(ZTEMP(IIU,IJU,IKU,7))
+ ALLOCATE(Z_NORM_TEMP0(IIU,IJU,IKU,3,7),Z_NORM_TEMP1(IIU,IJU,IKU))
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ! LISPT_NUMB correspond to the number of iteration
+ ! LISPT_FACT correspond to correspond to the weight between mass/flux nodes
+ !
+ ILISPT_NUMB=KIBM_SMOOTH
+ ILISPT_FACT=PIBM_SMOOTH
+ !
+ IF (IP==1) WRITE(*,*) 'NIBM_SMOOTH,XIBM_SMOOTH' , ILISPT_NUMB,ILISPT_FACT
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! Techniques to compute with an accurate precision
+ ! the normal vector to the interface, the local curvature
+ !
+ DO JL = 1,ILISPT_NUMB
+ !
+ Z_NORM_TEMP0(:,:,:,:,:)=1.
+ !
+ IF (MOD(JL,2)==0.AND.JL>3) THEN
+ NULLIFY(TZFIELDS_ll)
+ DO JM=1,4
+ IF (JM==1) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_U_M(PPHI(:,:,:,2),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = -GY_V_M(PPHI(:,:,:,3),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = -GZ_W_M(PPHI(:,:,:,4),XDZZ)
+ ENDIF
+ IF (JM==2) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_M_U(1,IKU,1,PPHI(:,:,:,1),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = -GY_UV_U(PPHI(:,:,:,5),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = -GZ_UW_U(PPHI(:,:,:,6),XDZZ)
+ ENDIF
+ IF (JM==3) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_UV_V(PPHI(:,:,:,5),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = - GY_M_V(1,IKU,1,PPHI(:,:,:,1),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = -GZ_VW_V(PPHI(:,:,:,7),XDZZ)
+ ENDIF
+ IF (JM==4) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = -GX_UW_W(PPHI(:,:,:,6),XDXX,XDZZ,XDZX)
+ Z_NORM_TEMP0(:,:,:,2,JM) = -GY_VW_W(PPHI(:,:,:,7),XDYY,XDZZ,XDZY)
+ Z_NORM_TEMP0(:,:,:,3,JM) = - GZ_M_W(1,IKU,1,PPHI(:,:,:,1),XDZZ)
+ ENDIF
+ Z_NORM_TEMP1(:,:,:)=(ABS(Z_NORM_TEMP0(:,:,:,1,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,2,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,3,JM)))
+ WHERE (Z_NORM_TEMP1(:,:,:).GT.XIBM_EPSI)
+ Z_NORM_TEMP0(:,:,:,1,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,1,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,2,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,3,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ ELSEWHERE
+ Z_NORM_TEMP0(:,:,:,1,JM)=1.
+ Z_NORM_TEMP0(:,:,:,2,JM)=1.
+ Z_NORM_TEMP0(:,:,:,3,JM)=1.
+ ENDWHERE
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,1,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,2,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,3,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ IF (JM==4) THEN
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ ENDIF
+ ENDDO
+ NULLIFY(TZFIELDS_ll)
+ DO JM=5,7
+ IF (JM==5) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = (MXM(Z_NORM_TEMP0(:,:,:,1,3))+MYM(Z_NORM_TEMP0(:,:,:,1,2)))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM) = (MXM(Z_NORM_TEMP0(:,:,:,2,3))+MYM(Z_NORM_TEMP0(:,:,:,2,2)))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM) = (MXM(Z_NORM_TEMP0(:,:,:,3,3))+MYM(Z_NORM_TEMP0(:,:,:,3,2)))/2.
+ ENDIF
+ IF (JM==6) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = (MXM(Z_NORM_TEMP0(:,:,:,1,4))+MZM(Z_NORM_TEMP0(:,:,:,1,2)))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM) = (MXM(Z_NORM_TEMP0(:,:,:,2,4))+MZM(Z_NORM_TEMP0(:,:,:,2,2)))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM) = (MXM(Z_NORM_TEMP0(:,:,:,3,4))+MZM(Z_NORM_TEMP0(:,:,:,3,2)))/2.
+ ENDIF
+ IF (JM==7) THEN
+ Z_NORM_TEMP0(:,:,:,1,JM) = (MYM(Z_NORM_TEMP0(:,:,:,1,4))+MZM(Z_NORM_TEMP0(:,:,:,1,3)))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM) = (MYM(Z_NORM_TEMP0(:,:,:,2,4))+MZM(Z_NORM_TEMP0(:,:,:,2,3)))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM) = (MYM(Z_NORM_TEMP0(:,:,:,3,4))+MZM(Z_NORM_TEMP0(:,:,:,3,3)))/2.
+ ENDIF
+ Z_NORM_TEMP1(:,:,:)=(ABS(Z_NORM_TEMP0(:,:,:,1,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,2,JM))+&
+ ABS(Z_NORM_TEMP0(:,:,:,3,JM)))
+ WHERE (Z_NORM_TEMP1(:,:,:).GT.XIBM_EPSI)
+ Z_NORM_TEMP0(:,:,:,1,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,1,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,2,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,2,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ Z_NORM_TEMP0(:,:,:,3,JM)=3.*(1.-ABS(Z_NORM_TEMP0(:,:,:,3,JM))/Z_NORM_TEMP1(:,:,:))/2.
+ ELSEWHERE
+ Z_NORM_TEMP0(:,:,:,1,JM)=1.
+ Z_NORM_TEMP0(:,:,:,2,JM)=1.
+ Z_NORM_TEMP0(:,:,:,3,JM)=1.
+ ENDWHERE
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,1,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,2,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,Z_NORM_TEMP0(:,:,:,3,JM),'IBM_SMOOTH_LS::Z_NORM_TEMP0')
+ IF (JM==7) THEN
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ ENDIF
+ ENDDO
+ !
+ ENDIF
+ !
+ ZTEMP=PPHI
+ !
+ DO JK=1,IKU-1
+ DO JJ=1,IJU-1
+ DO JI=2,IIU
+ !
+ ILISPT_FACTU = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,2))/ILISPT_FACT)
+ !
+ ZPW = PPHI(JI-1,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,1,2)
+ ZPE = PPHI(JI ,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,1,2)
+ ZPB = PPHI(JI ,JJ ,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,2,2)
+ ZPT = PPHI(JI ,JJ+1,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,2,2)
+ ZPS = PPHI(JI ,JJ ,JK ,6)*Z_NORM_TEMP0(JI,JJ,JK,3,2)
+ ZPN = PPHI(JI ,JJ ,JK+1,6)*Z_NORM_TEMP0(JI,JJ,JK,3,2)
+ !
+ ZTEMP(JI,JJ,JK,2) = (0.+ILISPT_FACTU)*PPHI(JI,JJ,JK,2)+ &
+ (1.-ILISPT_FACTU)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=1,IKU-1
+ DO JJ=2,IJU
+ DO JI=1,IIU-1
+ !
+ ILISPT_FACTV = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,3))/ILISPT_FACT)
+ !
+ ZPS = PPHI(JI ,JJ ,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,1,3)
+ ZPN = PPHI(JI+1,JJ ,JK ,5)*Z_NORM_TEMP0(JI,JJ,JK,1,3)
+ ZPW = PPHI(JI ,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,2,3)
+ ZPE = PPHI(JI ,JJ-1,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,2,3)
+ ZPB = PPHI(JI ,JJ ,JK ,7)*Z_NORM_TEMP0(JI,JJ,JK,3,3)
+ ZPT = PPHI(JI ,JJ ,JK+1,7)*Z_NORM_TEMP0(JI,JJ,JK,3,3)
+ !
+ ZTEMP(JI,JJ,JK,3) = (0.+ILISPT_FACTV)*PPHI(JI,JJ,JK,3)+ &
+ (1.-ILISPT_FACTV)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU
+ DO JJ=1,IJU-1
+ DO JI=1,IIU-1
+ !
+ ILISPT_FACTW = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,4))/ILISPT_FACT)
+ !
+ ZPB = PPHI(JI ,JJ ,JK ,6)*Z_NORM_TEMP0(JI,JJ,JK,1,4)
+ ZPT = PPHI(JI+1,JJ ,JK ,6)*Z_NORM_TEMP0(JI,JJ,JK,1,4)
+ ZPW = PPHI(JI ,JJ ,JK ,7)*Z_NORM_TEMP0(JI,JJ,JK,2,4)
+ ZPE = PPHI(JI ,JJ+1,JK ,7)*Z_NORM_TEMP0(JI,JJ,JK,2,4)
+ ZPS = PPHI(JI ,JJ ,JK ,1)*Z_NORM_TEMP0(JI,JJ,JK,3,4)
+ ZPN = PPHI(JI ,JJ ,JK-1,1)*Z_NORM_TEMP0(JI,JJ,JK,3,4)
+ !
+ ZTEMP(JI,JJ,JK,4) = (0.+ILISPT_FACTW)*PPHI(JI,JJ,JK,4)+ &
+ (1.-ILISPT_FACTW)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU-1
+ DO JJ=2,IJU-1
+ DO JI=2,IIU-1
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,1))/ILISPT_FACT)
+ !
+ ZPB = PPHI(JI ,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,1,1)
+ ZPT = PPHI(JI+1,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,1,1)
+ ZPW = PPHI(JI ,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,2,1)
+ ZPE = PPHI(JI ,JJ+1,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,2,1)
+ ZPS = PPHI(JI ,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,3,1)
+ ZPN = PPHI(JI ,JJ ,JK+1,4)*Z_NORM_TEMP0(JI,JJ,JK,3,1)
+ !
+ ZTEMP(JI,JJ,JK,1) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,1)+ &
+ (1.-ILISPT_FACTP)*(ZPE+ZPW+ZPB+ZPT+ZPN+ZPS)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=1,IKU-1
+ DO JJ=2,IJU
+ DO JI=2,IIU
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,5))/ILISPT_FACT)
+ !
+ ZPW = PPHI(JI ,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,1,5)
+ ZPE = PPHI(JI-1,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,1,5)
+ ZPB = PPHI(JI ,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,2,5)
+ ZPT = PPHI(JI ,JJ-1,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,2,5)
+ ZPS = (PPHI(JI ,JJ ,JK ,4)+PPHI(JI-1,JJ-1,JK ,4)+PPHI(JI-1,JJ ,JK ,4)+PPHI(JI ,JJ-1,JK ,4))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,3,5)
+ ZPN = (PPHI(JI ,JJ ,JK+1,4)+PPHI(JI-1,JJ-1,JK+1,4)+PPHI(JI-1,JJ ,JK+1,4)+PPHI(JI ,JJ-1,JK+1,4))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,3,5)
+ !
+ ZTEMP(JI,JJ,JK,5) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,5)+ &
+ (1.-ILISPT_FACTP)*(ZPE+ZPW+ZPB+ZPT+ZPS+ZPN)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU
+ DO JJ=1,IJU-1
+ DO JI=2,IIU
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,6))/ILISPT_FACT)
+ !
+ ZPW = PPHI(JI-1,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,1,6)
+ ZPE = PPHI(JI ,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,1,6)
+ ZPS = (PPHI(JI ,JJ ,JK ,3)+PPHI(JI-1,JJ ,JK-1,3)+PPHI(JI-1,JJ ,JK ,3)+PPHI(JI ,JJ ,JK-1,3))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,2,6)
+ ZPN = (PPHI(JI ,JJ+1,JK ,3)+PPHI(JI-1,JJ+1,JK-1,3)+PPHI(JI-1,JJ+1,JK ,3)+PPHI(JI ,JJ+1,JK-1,3))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,2,6)
+ ZPB = PPHI(JI ,JJ ,JK ,2)*Z_NORM_TEMP0(JI,JJ,JK,3,6)
+ ZPT = PPHI(JI ,JJ ,JK-1,2)*Z_NORM_TEMP0(JI,JJ,JK,3,6)
+ !
+ ZTEMP(JI,JJ,JK,6) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,6)+ &
+ (1.-ILISPT_FACTP)*(ZPE+ZPW+ZPB+ZPT+ZPS+ZPN)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ DO JK=2,IKU
+ DO JJ=2,IJU
+ DO JI=1,IIU-1
+ !
+ ILISPT_FACTP = 1.-0.5*exp(-abs(PPHI(JI,JJ,JK,7))/ILISPT_FACT)
+ !
+ ZPW = (PPHI(JI ,JJ ,JK ,2)+PPHI(JI ,JJ-1,JK-1,2)+PPHI(JI ,JJ-1,JK ,2)+PPHI(JI ,JJ ,JK-1,2))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,1,7)
+ ZPE = (PPHI(JI+1,JJ ,JK ,2)+PPHI(JI+1,JJ-1,JK-1,2)+PPHI(JI+1,JJ-1,JK ,2)+PPHI(JI+1,JJ ,JK-1,2))* &
+ 0.25*Z_NORM_TEMP0(JI,JJ,JK,1,7)
+ ZPB = PPHI(JI ,JJ ,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,2,7)
+ ZPT = PPHI(JI ,JJ-1,JK ,4)*Z_NORM_TEMP0(JI,JJ,JK,2,7)
+ ZPS = PPHI(JI ,JJ ,JK ,3)*Z_NORM_TEMP0(JI,JJ,JK,3,7)
+ ZPN = PPHI(JI ,JJ ,JK-1,3)*Z_NORM_TEMP0(JI,JJ,JK,3,7)
+ !
+ ZTEMP(JI,JJ,JK,7) = (0.+ILISPT_FACTP)*PPHI(JI,JJ,JK,7)+ &
+ (1.-ILISPT_FACTP)*(ZPB+ZPT+ZPN+ZPS+ZPW+ZPE)/6.
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ IF (JL>4) THEN
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,4)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,4)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,1) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB-1:IIE-1,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,6)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,2) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB-1:IJE-1,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,7)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,3) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.PPHI(IIB:IIE,IJB:IJE,IKB-1:IKE-1,1)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).LT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,4) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,4)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,4)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,1) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,1)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB-1:IIE-1,IJB:IJE,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,6)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,2) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,2)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB-1:IJE-1,IKB:IKE,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.PPHI(IIB:IIE,IJB:IJE,IKB+1:IKE+1,7)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,3) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,3)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB :IIE ,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB+1:IIE+1,IJB:IJE,IKB:IKE,6)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB :IJE ,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB+1:IJE+1,IKB:IKE,7)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB:IJE,IKB :IKE ,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.PPHI(IIB:IIE,IJB:IJE,IKB-1:IKE-1,1)).AND.&
+ PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,IKB:IKE,4) =PPHI(IIB:IIE,IJB:IJE,IKB:IKE,4)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB :IIE ,IJB:IJE,2,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB-1:IIE-1,IJB:IJE,2,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB:IIE,IJB :IJE ,2,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,5).GT.PPHI(IIB:IIE,IJB-1:IJE-1,2,2)).AND.PPHI(IIB:IIE,IJB:IJE,2,5).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,5) =PPHI(IIB:IIE,IJB:IJE,2,5)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB :IIE ,IJB:IJE,2,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB-1:IIE-1,IJB:IJE,2,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB:IIE,IJB :IJE ,2,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,2).GT.PPHI(IIB:IIE,IJB+1:IJE+1,2,5)).AND.PPHI(IIB:IIE,IJB:IJE,2,2).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,2) =PPHI(IIB:IIE,IJB:IJE,2,2)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB :IIE ,IJB:IJE,2,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB+1:IIE+1,IJB:IJE,2,5)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB:IIE,IJB :IJE ,2,1)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,3).GT.PPHI(IIB:IIE,IJB-1:IJE-1,2,1)).AND.PPHI(IIB:IIE,IJB:IJE,2,3).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,3) =PPHI(IIB:IIE,IJB:IJE,2,3)
+ ENDWHERE
+ WHERE ((PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB :IIE ,IJB:IJE,2,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB+1:IIE+1,IJB:IJE,2,2)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB:IIE,IJB :IJE ,2,3)).AND.&
+ (PPHI(IIB:IIE,IJB:IJE,2,1).GT.PPHI(IIB:IIE,IJB+1:IJE+1,2,3)).AND.PPHI(IIB:IIE,IJB:IJE,2,1).GT.XIBM_EPSI)
+ ZTEMP(IIB:IIE,IJB:IJE,2,1) =PPHI(IIB:IIE,IJB:IJE,2,1)
+ ENDWHERE
+ ENDIF
+ !
+ ZTEMP(:,:,1,5) = 2.*ZTEMP(:,:,2,5)-ZTEMP(:,:,3,5)
+ ZTEMP(:,:,1,3) = 2.*ZTEMP(:,:,2,3)-ZTEMP(:,:,3,3)
+ ZTEMP(:,:,1,2) = 2.*ZTEMP(:,:,2,2)-ZTEMP(:,:,3,2)
+ ZTEMP(:,:,1,1) = 2.*ZTEMP(:,:,2,1)-ZTEMP(:,:,3,1)
+ WHERE (ZTEMP(:,:,2,5).GT.XIBM_EPSI) ZTEMP(:,:,1,5) = ZTEMP(:,:,2,5)
+ WHERE (ZTEMP(:,:,2,3).GT.XIBM_EPSI) ZTEMP(:,:,1,3) = ZTEMP(:,:,2,3)
+ WHERE (ZTEMP(:,:,2,2).GT.XIBM_EPSI) ZTEMP(:,:,1,2) = ZTEMP(:,:,2,2)
+ WHERE (ZTEMP(:,:,2,1).GT.XIBM_EPSI) ZTEMP(:,:,1,1) = ZTEMP(:,:,2,1)
+ ZTEMP(:,:,2,6) = (ZTEMP(:,:,2,2)+ZTEMP(:,:,1,2))/2.
+ ZTEMP(:,:,2,7) = (ZTEMP(:,:,2,3)+ZTEMP(:,:,1,3))/2.
+ ZTEMP(:,:,2,4) = (ZTEMP(:,:,2,1)+ZTEMP(:,:,1,1))/2.
+ ZTEMP(:,:,1,6) = 2.*ZTEMP(:,:,2,6)-ZTEMP(:,:,3,6)
+ ZTEMP(:,:,1,7) = 2.*ZTEMP(:,:,2,7)-ZTEMP(:,:,3,7)
+ ZTEMP(:,:,1,4) = 2.*ZTEMP(:,:,2,4)-ZTEMP(:,:,3,4)
+ WHERE (ZTEMP(:,:,2,6).GT.XIBM_EPSI) ZTEMP(:,:,1,6) = ZTEMP(:,:,2,6)
+ WHERE (ZTEMP(:,:,2,7).GT.XIBM_EPSI) ZTEMP(:,:,1,7) = ZTEMP(:,:,2,7)
+ WHERE (ZTEMP(:,:,2,4).GT.XIBM_EPSI) ZTEMP(:,:,1,4) = ZTEMP(:,:,2,4)
+ ZTEMP(:,:,IKU,5) = 2.*ZTEMP(:,:,IKU-1,5)-ZTEMP(:,:,IKU-2,5)
+ ZTEMP(:,:,IKU,3) = 2.*ZTEMP(:,:,IKU-1,3)-ZTEMP(:,:,IKU-2,3)
+ ZTEMP(:,:,IKU,2) = 2.*ZTEMP(:,:,IKU-1,2)-ZTEMP(:,:,IKU-2,2)
+ ZTEMP(:,:,IKU,1) = 2.*ZTEMP(:,:,IKU-1,1)-ZTEMP(:,:,IKU-2,1)
+ WHERE (ZTEMP(:,:,IKU-1,5).GT.XIBM_EPSI) ZTEMP(:,:,IKU,5) = ZTEMP(:,:,IKU-1,5)
+ WHERE (ZTEMP(:,:,IKU-1,3).GT.XIBM_EPSI) ZTEMP(:,:,IKU,3) = ZTEMP(:,:,IKU-1,3)
+ WHERE (ZTEMP(:,:,IKU-1,2).GT.XIBM_EPSI) ZTEMP(:,:,IKU,2) = ZTEMP(:,:,IKU-1,2)
+ WHERE (ZTEMP(:,:,IKU-1,1).GT.XIBM_EPSI) ZTEMP(:,:,IKU,1) = ZTEMP(:,:,IKU-1,1)
+ ZTEMP(:,:,IKU,6) = (ZTEMP(:,:,IKU-1,2)+ZTEMP(:,:,IKU,2))/2.
+ ZTEMP(:,:,IKU,7) = (ZTEMP(:,:,IKU-1,3)+ZTEMP(:,:,IKU,3))/2.
+ ZTEMP(:,:,IKU,4) = (ZTEMP(:,:,IKU-1,1)+ZTEMP(:,:,IKU,1))/2.
+ WHERE (ZTEMP(:,:,IKU-1,6).GT.XIBM_EPSI) ZTEMP(:,:,IKU,6) = ZTEMP(:,:,IKU-1,6)
+ WHERE (ZTEMP(:,:,IKU-1,7).GT.XIBM_EPSI) ZTEMP(:,:,IKU,7) = ZTEMP(:,:,IKU-1,7)
+ WHERE (ZTEMP(:,:,IKU-1,4).GT.XIBM_EPSI) ZTEMP(:,:,IKU,4) = ZTEMP(:,:,IKU-1,4)
+ !
+ WHERE (ABS(ZTEMP(:,:,:,:)).LT.(ZREF-2.*XIBM_EPSI)) ZTEMP(:,:,:,:) = ZREF-XIBM_EPSI
+ !
+ NULLIFY(TZFIELDS_ll)
+ DO JM=1,7
+ ! Boundary symmetry
+ IF (LWEST_ll ()) ZTEMP(2 ,:,:,JM) = ZTEMP( 3,:,:,JM)
+ IF (LEAST_ll ()) ZTEMP(IIU-1,:,:,JM) = ZTEMP(IIU-2,:,:,JM)
+ IF (LSOUTH_ll()) ZTEMP(:,2 ,:,JM) = ZTEMP(:, 3,:,JM)
+ IF (LNORTH_ll()) ZTEMP(:,IJU-1,:,JM) = ZTEMP(:,IJU-2,:,JM)
+ IF (LWEST_ll ()) ZTEMP(1 ,:,:,JM) = ZTEMP( 2,:,:,JM)
+ IF (LEAST_ll ()) ZTEMP(IIU,:,:,JM) = ZTEMP(IIU-1,:,:,JM)
+ IF (LSOUTH_ll()) ZTEMP(:,1 ,:,JM) = ZTEMP(:, 2,:,JM)
+ IF (LNORTH_ll()) ZTEMP(:,IJU,:,JM) = ZTEMP(:,IJU-1,:,JM)
+ !
+ IF(LWEST_ll()) THEN
+ ZTEMP(IIB-1,IJB:IJE,IKB-1,JM)=ZTEMP(IIB-1,IJB:IJE,IKB,JM)
+ ZTEMP(IIB-1,IJB:IJE,IKE+1,JM)=ZTEMP(IIB-1,IJB:IJE,IKE,JM)
+ END IF
+ !
+ IF (LEAST_ll()) THEN
+ ZTEMP(IIE+1,IJB:IJE,IKB-1,JM)=ZTEMP(IIE+1,IJB:IJE,IKB,JM)
+ ZTEMP(IIE+1,IJB:IJE,IKE+1,JM)=ZTEMP(IIE+1,IJB:IJE,IKE,JM)
+ END IF
+ !
+ IF (LSOUTH_ll()) THEN
+ ZTEMP(IIB:IIE,IJB-1,IKB-1,JM)=ZTEMP(IIB:IIE,IJB-1,IKB,JM)
+ ZTEMP(IIB:IIE,IJB-1,IKE+1,JM)=ZTEMP(IIB:IIE,IJB-1,IKE,JM)
+ END IF
+ !
+ IF (LNORTH_ll()) THEN
+ ZTEMP(IIB:IIE,IJE+1,IKB-1,JM)=ZTEMP(IIB:IIE,IJE+1,IKB,JM)
+ ZTEMP(IIB:IIE,IJE+1,IKE+1,JM)=ZTEMP(IIB:IIE,IJE+1,IKE,JM)
+ END IF
+ CALL ADD3DFIELD_ll(TZFIELDS_ll,ZTEMP(:,:,:,JM),'IBM_SMOOTH_LS::ZTEMP')
+ ENDDO
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !
+ PPHI = ZTEMP
+ !
+ ENDDO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ DEALLOCATE(ZTEMP,Z_NORM_TEMP0,Z_NORM_TEMP1)
+ RETURN
+ !
+END SUBROUTINE IBM_SMOOTH_LS
diff --git a/src/MNH/ibm_valuecorn.f90 b/src/MNH/ibm_valuecorn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9c201a0d50be93337def827b15108f4e7e7f6dbb
--- /dev/null
+++ b/src/MNH/ibm_valuecorn.f90
@@ -0,0 +1,161 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_VALUECORN
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_VALUECORN(PVAR,IINDEX) RESULT(PVALUE)
+ !
+ REAL, DIMENSION(:,:,:) , INTENT(IN) :: PVAR
+ INTEGER,DIMENSION(:) , INTENT(IN) :: IINDEX
+ REAL, DIMENSION(8) :: PVALUE
+ !
+ END FUNCTION IBM_VALUECORN
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VALUECORN
+!
+! ##################################################
+FUNCTION IBM_VALUECORN(PVAR,IINDEX) RESULT(PVALUE)
+ ! ##################################################
+ !
+ !**** *IBM_VALUECORN* - routine to affect values at cornes cell
+ !
+ ! PURPOSE
+ ! -------
+ ! The purpose of this routine is to compute (VAR) at corners of cell (U,V,W,P)
+ !
+ ! METHOD
+ ! ------
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ ! EXTERNAL
+ ! --------
+ ! NONE
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PVAR ! variable array
+ INTEGER, DIMENSION(:) ,INTENT(IN) :: IINDEX ! IJK reference
+ REAL, DIMENSION(8) :: PVALUE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ INTEGER :: JI,JJ,JK,JL ! loop index
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! Index initial value
+ ! 1 <-> i ,j ,k
+ ! 2 <-> i+1,j ,k
+ ! 3 <-> i ,j+1,k
+ ! 4 <-> i+1,j+1,k
+ ! 5 <-> i ,j ,k+1
+ ! 6 <-> i+1,j ,k+1
+ ! 7 <-> i ,j+1,k+1
+ ! 8 <-> i+1,j+1,k+1
+ !
+ DO JL = 1,8
+ !
+ ! corners index
+ IF (JL==1) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==2) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==3) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==4) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)
+ ENDIF
+ IF (JL==5) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==6) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==7) THEN
+ JI = IINDEX(1)
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ IF (JL==8) THEN
+ JI = IINDEX(1)+1
+ JJ = IINDEX(2)+1
+ JK = IINDEX(3)+1
+ ENDIF
+ !
+ PVALUE(JL) = PVAR(JI,JJ,JK)
+ !
+ ENDDO
+ !
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ !
+ RETURN
+ !
+END FUNCTION IBM_VALUECORN
diff --git a/src/MNH/ibm_valuemat1.f90 b/src/MNH/ibm_valuemat1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8082f12c8db0e2907fd7f581f15aeec321ac6ac7
--- /dev/null
+++ b/src/MNH/ibm_valuemat1.f90
@@ -0,0 +1,209 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_VALUEMAT1
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_VALUEMAT1(PLOCATG,PLOCATI,PVELOCI,HINTERP) RESULT(PMATRIX)
+ !
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATG
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PVELOCI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL, DIMENSION(3,3) :: PMATRIX
+ !
+ END FUNCTION IBM_VALUEMAT1
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VALUEMAT1
+!
+! #######################################################################
+FUNCTION IBM_VALUEMAT1(PLOCATG,PLOCATI,PVELOCI,HINTERP) RESULT(PMATRIX)
+ ! #######################################################################
+ !
+ !**** *IBM_INTER_VALUEMAT1* - Change of basis (u,v,w) to (n,t,c)
+ !
+ ! PURPOSE
+ ! -------
+ ! This function calculates the vector normal to the interface, the
+ ! tangent and binormal vectors in order to project the basis
+ ! (u,v,w) to (n,t,c). The projection is stored in the PMATRIX matrix.
+ !
+ !
+ ! METHOD
+ ! ------
+ !
+ ! HINTERP can be defined as HIBM_TYPE_BOUND in regard of the tangent vector:
+ ! HIBM_TYPE_BOUND="CST" (Image 1 direction)
+ ! HIBM_TYPE_BOUND="LIN" (linear evolution)
+ ! HIBM_TYPE_BOUND="LOG" (logarithmic evol)
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ !
+ ! interface
+ USE MODD_IBM_PARAM_n
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATG
+ REAL, DIMENSION(:) , INTENT(IN) :: PLOCATI
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PVELOCI
+ CHARACTER(LEN=3) , INTENT(IN) :: HINTERP
+ REAL, DIMENSION(3,3) :: PMATRIX
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL,JH,JLL,JL1,JL2
+ REAL, DIMENSION(:,:) , ALLOCATABLE :: Z_IMAGE_VECT
+ REAL, DIMENSION(:,:) , ALLOCATABLE :: Z_IMAGE_TEMP
+ REAL, DIMENSION(:) , ALLOCATABLE :: Z_NORMA_VECT
+ REAL, DIMENSION(:) , ALLOCATABLE :: Z_TANGE_VECT
+ REAL, DIMENSION(:) , ALLOCATABLE :: Z_BINOR_VECT
+ REAL :: Z_NORMA_TEMP,Z_PRODV_TEMP
+ REAL :: Z_COEFI1,Z_COEFI2
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ALLOCATE(Z_IMAGE_VECT(4,3),Z_IMAGE_TEMP(4,3))
+ ALLOCATE(Z_NORMA_VECT(3),Z_TANGE_VECT(3),Z_BINOR_VECT(3))
+ !
+ Z_IMAGE_VECT(:,:) = 0.
+ Z_IMAGE_TEMP(:,:) = 0.
+ Z_NORMA_VECT(:) = 0.
+ Z_TANGE_VECT(:) = 0.
+ Z_BINOR_VECT(:) = 0.
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! vec(n)
+ Z_NORMA_VECT(:) = PLOCATI(:)-PLOCATG(:)
+ Z_NORMA_TEMP = sqrt(Z_NORMA_VECT(1)**2.+Z_NORMA_VECT(2)**2.+Z_NORMA_VECT(3)**2.)+XIBM_EPSI
+ Z_NORMA_VECT(:) = Z_NORMA_VECT(:) / Z_NORMA_TEMP
+ !
+ ! vec(v)
+ DO JL=1,2
+ IF (JL==1) JL1=0
+ IF (JL==2) JL2=0
+ Z_IMAGE_TEMP(JL,1) = sqrt(PVELOCI(JL,1)**2.+PVELOCI(JL,2)**2.+PVELOCI(JL,3)**2.)
+ Z_PRODV_TEMP = ABS((PVELOCI(JL,2)*Z_NORMA_VECT(3)-PVELOCI(JL,3)*Z_NORMA_VECT(2))+ &
+ (PVELOCI(JL,3)*Z_NORMA_VECT(1)-PVELOCI(JL,1)*Z_NORMA_VECT(3))+ &
+ (PVELOCI(JL,1)*Z_NORMA_VECT(2)-PVELOCI(JL,2)*Z_NORMA_VECT(1))+XIBM_EPSI)
+ IF (Z_IMAGE_TEMP(JL,1).gt.XIBM_EPSI.and.Z_PRODV_TEMP.gt.XIBM_EPSI) THEN
+ Z_IMAGE_VECT(JL,:) = PVELOCI(JL,:)/Z_IMAGE_TEMP(JL,1)
+ ELSE
+ IF (JL==1) JL1=1
+ IF (JL==2) JL2=1
+ Z_NORMA_TEMP = XIBM_IEPS
+ DO JLL=1,3
+ IF (abs(Z_NORMA_VECT(JLL)).lt.Z_NORMA_TEMP) THEN
+ Z_NORMA_TEMP = abs(Z_NORMA_VECT(JLL))
+ JH = JLL
+ ENDIF
+ ENDDO
+ Z_IMAGE_VECT(JL,:) = 0.
+ Z_IMAGE_VECT(JL,JH) = 1.
+ ENDIF
+ ENDDO
+ !
+ IF (JL1==1.AND.JL2==0) Z_IMAGE_VECT(1,:)=Z_IMAGE_VECT(2,:)
+ IF (JL2==1.AND.JL1==0) Z_IMAGE_VECT(2,:)=Z_IMAGE_VECT(1,:)
+ !
+ ! vec(c)
+ DO JL=1,2
+ !
+ ! vec(c)
+ Z_IMAGE_TEMP(JL,1) = -(Z_IMAGE_VECT(JL,2)*Z_NORMA_VECT(3)-Z_IMAGE_VECT(JL,3)*Z_NORMA_VECT(2))
+ Z_IMAGE_TEMP(JL,2) = +(Z_IMAGE_VECT(JL,1)*Z_NORMA_VECT(3)-Z_IMAGE_VECT(JL,3)*Z_NORMA_VECT(1))
+ Z_IMAGE_TEMP(JL,3) = -(Z_IMAGE_VECT(JL,1)*Z_NORMA_VECT(2)-Z_IMAGE_VECT(JL,2)*Z_NORMA_VECT(1))
+ Z_NORMA_TEMP = sqrt(Z_IMAGE_TEMP(JL,1)**2.+Z_IMAGE_TEMP(JL,2)**2.+Z_IMAGE_TEMP(JL,3)**2.)
+ Z_IMAGE_TEMP(JL,:) = Z_IMAGE_TEMP(JL,:) / Z_NORMA_TEMP
+ !
+ ! vec(t)
+ Z_IMAGE_VECT(JL,1) = +(Z_IMAGE_TEMP(JL,2)*Z_NORMA_VECT(3)-Z_IMAGE_TEMP(JL,3)*Z_NORMA_VECT(2))
+ Z_IMAGE_VECT(JL,2) = -(Z_IMAGE_TEMP(JL,1)*Z_NORMA_VECT(3)-Z_IMAGE_TEMP(JL,3)*Z_NORMA_VECT(1))
+ Z_IMAGE_VECT(JL,3) = +(Z_IMAGE_TEMP(JL,1)*Z_NORMA_VECT(2)-Z_IMAGE_TEMP(JL,2)*Z_NORMA_VECT(1))
+ Z_NORMA_TEMP = sqrt(Z_IMAGE_VECT(JL,1)**2.+Z_IMAGE_VECT(JL,2)**2.+Z_IMAGE_VECT(JL,3)**2.)
+ Z_IMAGE_VECT(JL,:) = Z_IMAGE_VECT(JL,:) / Z_NORMA_TEMP
+ !
+ ENDDO
+ !
+ IF (HINTERP=='CST') THEN
+ Z_COEFI1 = 1.
+ Z_COEFI2 = 0.
+ ENDIF
+ !
+ IF (HINTERP=='LIN') THEN
+ Z_COEFI1 = 2.
+ Z_COEFI2 =-1.
+ ENDIF
+ !
+ ! (n/t/c) at the interface
+ Z_TANGE_VECT(:) = Z_COEFI1*Z_IMAGE_VECT(1,:)+Z_COEFI2*Z_IMAGE_VECT(2,:)
+ Z_NORMA_TEMP = sqrt(Z_TANGE_VECT(1)**2.+Z_TANGE_VECT(2)**2.+Z_TANGE_VECT(3)**2.)
+ Z_TANGE_VECT(:) = Z_TANGE_VECT(:) / Z_NORMA_TEMP
+ !
+ Z_BINOR_VECT(1) = -(Z_TANGE_VECT(2)*Z_NORMA_VECT(3)-Z_TANGE_VECT(3)*Z_NORMA_VECT(2))
+ Z_BINOR_VECT(2) = +(Z_TANGE_VECT(1)*Z_NORMA_VECT(3)-Z_TANGE_VECT(3)*Z_NORMA_VECT(1))
+ Z_BINOR_VECT(3) = -(Z_TANGE_VECT(1)*Z_NORMA_VECT(2)-Z_TANGE_VECT(2)*Z_NORMA_VECT(1))
+ Z_NORMA_TEMP = sqrt(Z_BINOR_VECT(1)**2.+Z_BINOR_VECT(2)**2.+Z_BINOR_VECT(3)**2.)
+ Z_BINOR_VECT(:) = Z_BINOR_VECT(:) / Z_NORMA_TEMP
+ !
+ ! matrix
+ PMATRIX(1,1) = Z_NORMA_VECT(1)
+ PMATRIX(1,2) = Z_NORMA_VECT(2)
+ PMATRIX(1,3) = Z_NORMA_VECT(3)
+ PMATRIX(2,1) = Z_TANGE_VECT(1)
+ PMATRIX(2,2) = Z_TANGE_VECT(2)
+ PMATRIX(2,3) = Z_TANGE_VECT(3)
+ PMATRIX(3,1) = Z_BINOR_VECT(1)
+ PMATRIX(3,2) = Z_BINOR_VECT(2)
+ PMATRIX(3,3) = Z_BINOR_VECT(3)
+ !
+ DEALLOCATE(Z_IMAGE_VECT,Z_IMAGE_TEMP)
+ DEALLOCATE(Z_NORMA_VECT,Z_TANGE_VECT,Z_BINOR_VECT)
+ !
+ RETURN
+ !
+END FUNCTION IBM_VALUEMAT1
diff --git a/src/MNH/ibm_valuemat2.f90 b/src/MNH/ibm_valuemat2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1120cfc0d543818a0310ae6c28b95ab0d563a347
--- /dev/null
+++ b/src/MNH/ibm_valuemat2.f90
@@ -0,0 +1,115 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #########################
+MODULE MODI_IBM_VALUEMAT2
+ ! #########################
+ !
+ INTERFACE
+ !
+ FUNCTION IBM_VALUEMAT2(PMATRI1) RESULT(PMATRI2)
+ !
+ REAL, DIMENSION(:,:) , INTENT(IN) :: PMATRI1
+ REAL, DIMENSION(3,3) :: PMATRI2
+ !
+ END FUNCTION IBM_VALUEMAT2
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VALUEMAT2
+!
+! ###############################################
+FUNCTION IBM_VALUEMAT2(PMATRI1) RESULT(PMATRI2)
+ ! ###############################################
+ !
+ !**** *IBM_INTER_VALUEMAT2* - Change of basis (n,t,c) to (u,v,w)
+ !
+ ! PURPOSE
+ ! -------
+ ! Matrix inversion
+ !
+ !
+ ! METHOD
+ ! ------
+ !
+ ! INDEX
+ ! -----
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ !
+ ! Franck Auguste * CERFACS(AE) *
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ------------------
+ !
+ ! module
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ !
+ ! interface
+ !
+ IMPLICIT NONE
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.1 Declaration of arguments
+ REAL, DIMENSION(:,:), INTENT(IN) :: PMATRI1
+ REAL, DIMENSION(3,3) :: PMATRI2
+ !
+ !-----------------------------------------------------------------------------
+ !
+ ! 0.2 Declaration of local variables
+ !
+ INTEGER :: JI,JJ,JK,JL
+ REAL :: Z_DETER
+ !-----------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ !-----------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ ! det(M)
+ Z_DETER = PMATRI1(1,1)*PMATRI1(2,2)*PMATRI1(3,3) + &
+ PMATRI1(1,2)*PMATRI1(2,3)*PMATRI1(3,1) + &
+ PMATRI1(1,3)*PMATRI1(2,1)*PMATRI1(3,2) - &
+ PMATRI1(1,3)*PMATRI1(2,2)*PMATRI1(3,1) - &
+ PMATRI1(2,3)*PMATRI1(3,2)*PMATRI1(1,1) - &
+ PMATRI1(3,3)*PMATRI1(1,2)*PMATRI1(2,1)
+ !
+ ! M^(-1)
+ PMATRI2(1,1) = PMATRI1(2,2)*PMATRI1(3,3)-PMATRI1(2,3)*PMATRI1(3,2)
+ PMATRI2(1,2) = PMATRI1(1,3)*PMATRI1(3,2)-PMATRI1(1,2)*PMATRI1(3,3)
+ PMATRI2(1,3) = PMATRI1(1,2)*PMATRI1(2,3)-PMATRI1(1,3)*PMATRI1(2,2)
+ PMATRI2(2,1) = PMATRI1(2,3)*PMATRI1(3,1)-PMATRI1(2,1)*PMATRI1(3,3)
+ PMATRI2(2,2) = PMATRI1(1,1)*PMATRI1(3,3)-PMATRI1(1,3)*PMATRI1(3,1)
+ PMATRI2(2,3) = PMATRI1(1,3)*PMATRI1(2,1)-PMATRI1(1,1)*PMATRI1(2,3)
+ PMATRI2(3,1) = PMATRI1(2,1)*PMATRI1(3,2)-PMATRI1(2,2)*PMATRI1(3,1)
+ PMATRI2(3,2) = PMATRI1(1,2)*PMATRI1(3,1)-PMATRI1(1,1)*PMATRI1(3,2)
+ PMATRI2(3,3) = PMATRI1(1,1)*PMATRI1(2,2)-PMATRI1(1,2)*PMATRI1(2,1)
+ !
+ PMATRI2(:,:) = PMATRI2(:,:)/Z_DETER
+ !
+ RETURN
+ !
+END FUNCTION IBM_VALUEMAT2
diff --git a/src/MNH/ibm_volume.f90 b/src/MNH/ibm_volume.f90
new file mode 100644
index 0000000000000000000000000000000000000000..af4012a42b9cba352d527c22179f6de698ff59dc
--- /dev/null
+++ b/src/MNH/ibm_volume.f90
@@ -0,0 +1,220 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! ########################
+MODULE MODI_IBM_VOLUME
+ ! ########################
+ !
+ INTERFACE
+ !
+ SUBROUTINE IBM_VOLUME(PPHI,PVOL)
+ !
+ REAL, DIMENSION(:,:,:,:) , INTENT(IN) :: PPHI
+ REAL, DIMENSION(:,:,:,:) , INTENT(INOUT) :: PVOL
+ !
+ END SUBROUTINE IBM_VOLUME
+ !
+ END INTERFACE
+ !
+END MODULE MODI_IBM_VOLUME
+!
+! ##################################
+SUBROUTINE IBM_VOLUME(PPHI,PVOL)
+ ! ##################################
+ !
+ !
+ !**** IBM_VOLUME computes surface and volume used in the alteration of the pseudo-equation
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this routine is to compute :
+ ! - the surface used in the balance of momentum curvature
+ ! - a volumic fraction deducted from the LS function
+ !
+ ! METHOD
+ ! ------
+ !
+ ! EXTERNAL
+ ! --------
+ ! SUBROUTINE ?
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! MODD_?
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ ! module
+ USE MODE_ll
+ USE MODE_IO
+ !
+ ! declaration
+ USE MODD_IBM_PARAM_n
+ USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZHAT,XZZ
+ USE MODD_PARAMETERS, ONLY: JPVEXT,JPHEXT
+ USE MODD_LBC_n
+ USE MODD_LUNIT_n, ONLY: TLUOUT
+ !
+ ! interface
+ !
+ USE MODI_IBM_INTERPOS
+ !
+ IMPLICIT NONE
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.1 declarations of arguments
+ !
+ REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PPHI ! LS functions
+ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PVOL
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.2 declaration of local variables
+ !
+ INTEGER :: IIU,IJU,IKU
+ INTEGER :: IIE,IIB,IJE,IJB,IKE,IKB
+ INTEGER :: JI,JJ,JK,JL,JM
+ REAL :: ZPH1,ZPH2,ZPH3,ZPH4,ZPH5,ZCOE,ZRAY
+ REAL :: ZPH6,ZPH7,ZPH8,ZDEL,ZPH0,ZBAR,ZVOL
+ REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZXREF,ZYREF,ZZREF
+ TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
+ INTEGER :: IINFO_ll
+ !
+ !------------------------------------------------------------------------------
+ !
+ ! 0.3 Allocation
+ !
+ IIU = SIZE(PPHI,1)
+ IJU = SIZE(PPHI,2)
+ IKU = SIZE(PPHI,3)
+ !
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ !
+ IKE = IKU - JPVEXT
+ IKB = 1 + JPVEXT
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 1. PRELIMINARIES
+ ! ----------------
+ !
+ ALLOCATE(ZXREF(IIU,IJU,IKU))
+ ALLOCATE(ZYREF(IIU,IJU,IKU))
+ ALLOCATE(ZZREF(IIU,IJU,IKU))
+ !
+ ZXREF = 0.
+ ZYREF = 0.
+ ZZREF = 0.
+ !
+ PVOL(:,:,:,:)=0.0
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 2. EXECUTIONS
+ ! -------------
+ !
+ !
+ ! Volume computations
+ JL = 1
+ PVOL(IIB:IIE,IJB:IJE,IKB:IKE,1:2)=1.
+ !
+ CALL IBM_INTERPOS(ZXREF,ZYREF,ZZREF,'P')
+ !
+ DO JK=IKB,IKE
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ !
+ ZDEL = ((ZXREF(JI+1,JJ,JK)-ZXREF(JI,JJ,JK))*&
+ (ZYREF(JI,JJ+1,JK)-ZYREF(JI,JJ,JK))*&
+ (ZZREF(JI,JJ,JK+1)-ZZREF(JI,JJ,JK)))**(1./3.)
+ !
+ ZRAY = ZDEL/2.
+ ZCOE = 1./2.
+ ZPH1 = PPHI(JI ,JJ ,JK ,1)
+ !
+ DO JM=1,6
+ !
+ IF (JM==1) ZPH2 = PPHI(JI ,JJ ,JK ,2)
+ IF (JM==2) ZPH2 = PPHI(JI+1,JJ ,JK ,2)
+ IF (JM==3) ZPH2 = PPHI(JI ,JJ ,JK ,3)
+ IF (JM==4) ZPH2 = PPHI(JI ,JJ+1,JK ,3)
+ IF (JM==5) ZPH2 = PPHI(JI ,JJ ,JK ,4)
+ IF (JM==6) ZPH2 = PPHI(JI ,JJ ,JK+1,4)
+ !
+ ZBAR=0.
+ !
+ IF (ABS(ZPH2-ZPH1).GT.(XIBM_EPSI)) ZBAR = - ZPH1 / ( ZPH2 - ZPH1 ) * ZDEL * ZCOE
+ !
+ ZBAR=min(ZRAY,ZBAR)
+ ZBAR=max(0.,ZBAR)
+ !
+ PVOL(JI,JJ,JK,1) = -max(0.,+ZPH2/abs(ZPH2))*max(0.,+ZPH1/abs(ZPH1))/6. + PVOL(JI,JJ,JK,1) &
+ -max(0.,-ZPH2*ZPH1/abs(ZPH2*ZPH1))*ABS(max(0.,+ZPH2/abs(ZPH2))-(ZBAR/ZRAY)**3.)/6.
+ !
+ PVOL(JI,JJ,JK,1) = min(1.,PVOL(JI,JJ,JK,1))
+ !
+ ENDDO
+ !
+ ENDDO
+ ENDDO
+ ENDDO
+ !
+ IF (LWEST_ll ()) PVOL(IIB-1,:,:,1)=PVOL(IIB,:,:,1)
+ IF (LEAST_ll ()) PVOL(IIE+1,:,:,1)=PVOL(IIE,:,:,1)
+ IF (LSOUTH_ll()) PVOL(:,IJB-1,:,1)=PVOL(:,IJB,:,1)
+ IF (LNORTH_ll()) PVOL(:,IJE+1,:,1)=PVOL(:,IJE,:,1)
+ !
+ PVOL(:,:,IKB-1,1)=PVOL(:,:,IKB,1)
+ PVOL(:,:,IKE+1,1)=PVOL(:,:,IKE,1)
+ !
+ IF(LWEST_ll()) THEN
+ PVOL(IIB-1,IJB:IJE,IKB-1,1)=PVOL(IIB-1,IJB:IJE,IKB,1)
+ PVOL(IIB-1,IJB:IJE,IKE+1,1)=PVOL(IIB-1,IJB:IJE,IKE,1)
+ END IF
+ !
+ IF (LEAST_ll()) THEN
+ PVOL(IIE+1,IJB:IJE,IKB-1,1)=PVOL(IIE+1,IJB:IJE,IKB,1)
+ PVOL(IIE+1,IJB:IJE,IKE+1,1)=PVOL(IIE+1,IJB:IJE,IKE,1)
+ END IF
+ !
+ IF (LSOUTH_ll()) THEN
+ PVOL(IIB:IIE,IJB-1,IKB-1,1)=PVOL(IIB:IIE,IJB-1,IKB,1)
+ PVOL(IIB:IIE,IJB-1,IKE+1,1)=PVOL(IIB:IIE,IJB-1,IKE,1)
+ END IF
+ !
+ IF (LNORTH_ll()) THEN
+ PVOL(IIB:IIE,IJE+1,IKB-1,1)=PVOL(IIB:IIE,IJE+1,IKB,1)
+ PVOL(IIB:IIE,IJE+1,IKE+1,1)=PVOL(IIB:IIE,IJE+1,IKE,1)
+ END IF
+ !
+ !**************************************************
+ !
+ WHERE ( PVOL(:,:,:,1).lt.(XIBM_EPSI) ) PVOL(:,:,:,1)=0.
+ WHERE ( PVOL(:,:,:,1).lt.(1.) ) PVOL(:,:,:,2)=0.
+ WHERE ( (PVOL(:,:,:,1)-PVOL(:,:,:,2) ) .GT. 0.0 ) PVOL(:,:,:,3)=1.0
+ !
+ !------------------------------------------------------------------------------
+ !**** X. DEALLOCATIONS/CLOSES
+ ! -----------------------
+ DEALLOCATE(ZXREF,ZYREF,ZZREF)
+ !
+ RETURN
+ !
+END SUBROUTINE IBM_VOLUME
diff --git a/src/MNH/ice4_compute_pdf.f90 b/src/MNH/ice4_compute_pdf.f90
index 457ec47d7b32bfbebb299390583761198b098ae7..2f999e9d2603aa002b8f3525a44b7defe8a6d566 100644
--- a/src/MNH/ice4_compute_pdf.f90
+++ b/src/MNH/ice4_compute_pdf.f90
@@ -1,19 +1,23 @@
-!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_COMPUTE_PDF
INTERFACE
-SUBROUTINE ICE4_COMPUTE_PDF(HSUBG_AUCV, HSUBG_PR_PDF, &
- PRHODREF, PRCT, PCF, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRF)
+SUBROUTINE ICE4_COMPUTE_PDF(HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
+ PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
IMPLICIT NONE
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
REAL, DIMENSION(:), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(:), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
@@ -21,13 +25,18 @@ REAL, DIMENSION(:), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Clou
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
! note that PRC = PHLC_HRC + PHLC_LRC
+REAL, DIMENSION(:), INTENT(INOUT) :: PHLI_HCF !
+REAL, DIMENSION(:), INTENT(INOUT) :: PHLI_LCF
+REAL, DIMENSION(:), INTENT(INOUT) :: PHLI_HRI !
+REAL, DIMENSION(:), INTENT(INOUT) :: PHLI_LRI !
REAL, DIMENSION(:), INTENT(OUT) :: PRF ! Rain fraction
END SUBROUTINE ICE4_COMPUTE_PDF
END INTERFACE
END MODULE MODI_ICE4_COMPUTE_PDF
-SUBROUTINE ICE4_COMPUTE_PDF(HSUBG_AUCV, HSUBG_PR_PDF, &
- PRHODREF, PRCT, PCF, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRF)
+SUBROUTINE ICE4_COMPUTE_PDF(HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
+ PRHODREF, PRCT, PRIT, PCF, PT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRF)
!!
!!** PURPOSE
!! -------
@@ -47,7 +56,8 @@ SUBROUTINE ICE4_COMPUTE_PDF(HSUBG_AUCV, HSUBG_PR_PDF, &
!
!
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
-USE MODD_RAIN_ICE_PARAM, ONLY: XCRIAUTC
+USE MODD_RAIN_ICE_PARAM, ONLY: XCRIAUTC,XBCRIAUTI,XACRIAUTI,XCRIAUTI
+USE MODD_CST, ONLY : XTT
!
USE MODE_MSG
!
@@ -61,11 +71,14 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
CHARACTER(LEN=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:), INTENT(IN) :: PRIT ! Ice Crystal m.r. at t
REAL, DIMENSION(:), INTENT(IN) :: PCF ! Cloud fraction
+REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(:), INTENT(IN) :: PSIGMA_RC ! Standard deviation of rc at time t
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_HCF ! HLCLOUDS : fraction of High Cloud Fraction in grid
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Cloud Fraction in grid
@@ -73,34 +86,47 @@ REAL, DIMENSION(:), INTENT(OUT) :: PHLC_LCF ! HLCLOUDS : fraction of Low Clou
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_HRC ! HLCLOUDS : LWC that is High LWC in grid
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
! note that PRC = PHLC_HRC + PHLC_LRC
+REAL, DIMENSION(:), INTENT(INOUT) :: PHLI_HCF !
+REAL, DIMENSION(:), INTENT(INOUT) :: PHLI_LCF
+REAL, DIMENSION(:), INTENT(INOUT) :: PHLI_HRI !
+REAL, DIMENSION(:), INTENT(INOUT) :: PHLI_LRI !
REAL, DIMENSION(:), INTENT(OUT) :: PRF ! Rain fraction
!
!* 0.2 declaration of local variables
!
-integer :: isize
+INTEGER :: ISIZE
INTEGER :: JI
LOGICAL, DIMENSION(:), allocatable :: GWORK, GWORK2, GWORK3
REAL :: ZCOEFFRCM
REAL, DIMENSION(:), allocatable :: ZRCRAUTC, & !RC value to begin rain formation =XCRIAUTC/RHODREF
+ ZCRIAUTI, & !RI value to begin snow formation
ZHLC_RCMAX, & !HLCLOUDS : maximum value for RC in distribution
ZHLC_LRCLOCAL, & !HLCLOUDS : LWC that is Low LWC local in LCF
- ZHLC_HRCLOCAL !HLCLOUDS : LWC that is High LWC local in HCF
+ ZHLC_HRCLOCAL, & !HLCLOUDS : LWC that is High LWC local in HCF
! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL
! = PHLC_HRC/HCF+ PHLC_LRC/LCF
+ ZSUMRC, ZSUMRI
!
!-------------------------------------------------------------------------------
! !$acc data copyin( XRTMIN )
-!$acc data present(PRHODREF,PRCT,PCF,PSIGMA_RC, &
-!$acc& PHLC_HCF,PHLC_LCF,PHLC_HRC,PHLC_LRC,PRF)
+!$acc data present(PRHODREF,PRCT,PRIT,PCF,PT,PSIGMA_RC, &
+!$acc& PHLC_HCF,PHLC_LCF,PHLC_HRC,PHLC_LRC,PHLI_HCF,PHLI_LCF,PHLI_HRI,PHLI_LRI,PRF)
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK1D(PRHODREF,"ICE4_COMPUTE_PDF beg:PRHODREF",PRECISION)
CALL MPPDB_CHECK1D(PRCT,"ICE4_COMPUTE_PDF beg:PRCT",PRECISION)
+ CALL MPPDB_CHECK1D(PRIT,"ICE4_COMPUTE_PDF beg:PRIT",PRECISION)
CALL MPPDB_CHECK1D(PCF,"ICE4_COMPUTE_PDF beg:PCF",PRECISION)
+ CALL MPPDB_CHECK1D(PT,"ICE4_COMPUTE_PDF beg:PT",PRECISION)
CALL MPPDB_CHECK1D(PSIGMA_RC,"ICE4_COMPUTE_PDF beg:PSIGMA_RC",PRECISION)
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK1D(PHLI_HCF,"ICE4_COMPUTE_PDF beg:PHLI_HCF",PRECISION)
+ CALL MPPDB_CHECK1D(PHLI_LCF,"ICE4_COMPUTE_PDF beg:PHLI_LCF",PRECISION)
+ CALL MPPDB_CHECK1D(PHLI_HRI,"ICE4_COMPUTE_PDF beg:PHLI_HRI",PRECISION)
+ CALL MPPDB_CHECK1D(PHLI_LRI,"ICE4_COMPUTE_PDF beg:PHLI_LRI",PRECISION)
END IF
isize = size( prhodref )
@@ -110,17 +136,20 @@ allocate( gwork2(isize ) )
allocate( gwork3(isize ) )
allocate( zrcrautc (isize ) )
+allocate( zcriauti (isize ) )
allocate( zhlc_rcmax (isize ) )
allocate( zhlc_lrclocal(isize ) )
allocate( zhlc_hrclocal(isize ) )
+allocate( ZSUMRC (isize ) )
+allocate( ZSUMRI (isize ) )
-!$acc data create(GWORK,GWORK2,GWORK3,ZRCRAUTC,ZHLC_RCMAX,ZHLC_LRCLOCAL,ZHLC_HRCLOCAL)
+!$acc data create(GWORK,GWORK2,GWORK3,ZRCRAUTC,ZCRIAUTI,ZHLC_RCMAX,ZHLC_LRCLOCAL,ZHLC_HRCLOCAL, ZSUMRC, ZSUMRI)
!Cloud water split between high and low content part is done according to autoconversion option
!$acc kernels
ZRCRAUTC(:)=XCRIAUTC/PRHODREF(:) ! Autoconversion rc threshold
!$acc end kernels
-IF(HSUBG_AUCV=='NONE') THEN
+IF(HSUBG_AUCV_RC=='NONE') THEN
#if 0
!PW: bug: crash at execution with PGI 18.10
!$acc kernels
@@ -132,19 +161,16 @@ IF(HSUBG_AUCV=='NONE') THEN
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- PRF(:) =1.
ELSEWHERE(GWORK2(:))
PHLC_HCF(:)=0.
PHLC_LCF(:)=1.
PHLC_HRC(:)=0.
PHLC_LRC(:)=PRCT(:)
- PRF(:) =0.
ELSEWHERE
PHLC_HCF(:)=0.
PHLC_LCF(:)=0.
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
- PRF(:) =0.
END WHERE
!$acc end kernels
#else
@@ -155,24 +181,22 @@ IF(HSUBG_AUCV=='NONE') THEN
PHLC_LCF(JI)=0.
PHLC_HRC(JI)=PRCT(JI)
PHLC_LRC(JI)=0.
- PRF(JI) =1.
ELSE IF (PRCT(JI)>XRTMIN(2)) THEN
PHLC_HCF(JI)=0.
PHLC_LCF(JI)=1.
PHLC_HRC(JI)=0.
PHLC_LRC(JI)=PRCT(JI)
- PRF(JI) =0.
ELSE
PHLC_HCF(JI)=0.
PHLC_LCF(JI)=0.
PHLC_HRC(JI)=0.
PHLC_LRC(JI)=0.
- PRF(JI) =0.
END IF
END DO
!$acc end kernels
#endif
-ELSEIF(HSUBG_AUCV=='CLFR') THEN
+
+ELSEIF(HSUBG_AUCV_RC=='CLFR') THEN
!$acc kernels
!Cloud water is only in the cloudy part and entirely in low or high part
GWORK3(:) = PCF(:) > 0.
@@ -183,29 +207,31 @@ ELSEIF(HSUBG_AUCV=='CLFR') THEN
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- PRF(:) =PCF(:)
ELSEWHERE(GWORK2(:))
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.0
PHLC_LRC(:)=PRCT(:)
- PRF(:) =0.
- ELSEWHERE (GWORK3(:))
- PHLC_HCF(:)=0.
- PHLC_LCF(:)=0.
- PHLC_HRC(:)=0.
- PHLC_LRC(:)=0.
- PRF(:) =0.
ELSEWHERE
PHLC_HCF(:)=0.
PHLC_LCF(:)=0.
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
- PRF(:) =0.
END WHERE
!$acc end kernels
-
-ELSEIF(HSUBG_AUCV=='PDF ') THEN
+ELSEIF(HSUBG_AUCV_RC=='ADJU') THEN
+!$acc kernels
+ ZSUMRC(:)=PHLC_LRC(:)+PHLC_HRC(:)
+ GWORK(:) = ZSUMRC(:) > 0.
+ WHERE(GWORK(:))
+ PHLC_LRC(:)=PHLC_LRC(:)*PRCT(:)/ZSUMRC(:)
+ PHLC_HRC(:)=PHLC_HRC(:)*PRCT(:)/ZSUMRC(:)
+ ELSEWHERE
+ PHLC_LRC(:)=0.
+ PHLC_HRC(:)=0.
+ ENDWHERE
+!$acc end kernels
+ELSEIF(HSUBG_AUCV_RC=='PDF ') THEN
!Cloud water is split between high and low part according to a PDF
! 'HLCRECTPDF' : rectangular PDF form
! 'HLCTRIANGPDF' : triangular PDF form
@@ -224,7 +250,6 @@ ELSEIF(HSUBG_AUCV=='PDF ') THEN
PHLC_LCF(:)=0.
PHLC_HRC(:)=PRCT(:)
PHLC_LRC(:)=0.
- PRF(:) =1.
ELSEWHERE(GWORK2(:))
PHLC_HCF(:)=(PRCT(:)+PSIGMA_RC(:)-ZRCRAUTC(:))/ &
&(2.*PSIGMA_RC(:))
@@ -233,19 +258,16 @@ ELSEIF(HSUBG_AUCV=='PDF ') THEN
&(PRCT(:)+PSIGMA_RC(:)+ZRCRAUTC(:))/ &
&(4.*PSIGMA_RC(:))
PHLC_LRC(:)=MAX(0., PRCT(:)-PHLC_HRC(:))
- PRF(:) =PHLC_HCF(:)
ELSEWHERE(GWORK3(:))
PHLC_HCF(:)=0.
PHLC_LCF(:)=PCF(:)
PHLC_HRC(:)=0.
PHLC_LRC(:)=PRCT(:)
- PRF(:) =0.
ELSEWHERE
PHLC_HCF(:)=0.
PHLC_LCF(:)=0.
PHLC_HRC(:)=0.
PHLC_LRC(:)=0.
- PRF(:) =0.
END WHERE
! Turner (2011, 2012)
!$acc end kernels
@@ -353,7 +375,6 @@ ELSEIF(HSUBG_AUCV=='PDF ') THEN
PHLC_LRC(:)=0.
PHLC_HRC(:)=0.
END WHERE
- PRF(:)=PHLC_HCF(:) !Precipitation fraction
!$acc end kernels
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_PR_PDF case')
@@ -362,7 +383,73 @@ ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_COMPUTE_PDF','wrong HSUBG_AUCV case')
ENDIF
!
+!Ice water split between high and low content part is done according to autoconversion option
+!$acc kernels
+ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI)) ! Autoconversion ri threshold
+IF(HSUBG_AUCV_RI=='NONE') THEN
+!$acc kernels
+ !Cloud water is entirely in low or high part
+ WHERE(PRIT(:)>ZCRIAUTI(:))
+ PHLI_HCF(:)=1.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=PRIT(:)
+ PHLI_LRI(:)=0.
+ ELSEWHERE(PRIT(:)>XRTMIN(2))
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=1.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=PRIT(:)
+ ELSEWHERE
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=0.
+ END WHERE
+!$acc end kernels
+ELSEIF(HSUBG_AUCV_RI=='CLFR') THEN
+!$acc kernels
+ !Cloud water is only in the cloudy part and entirely in low or high part
+ WHERE(PCF(:)>0. .AND. PRIT(:)>ZCRIAUTI(:)*PCF(:))
+ PHLI_HCF(:)=PCF(:)
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=PRIT(:)
+ PHLI_LRI(:)=0.
+ ELSEWHERE(PCF(:)>0. .AND. PRIT(:)>XRTMIN(2))
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=PCF(:)
+ PHLI_HRI(:)=0.0
+ PHLI_LRI(:)=PRIT(:)
+ ELSEWHERE
+ PHLI_HCF(:)=0.
+ PHLI_LCF(:)=0.
+ PHLI_HRI(:)=0.
+ PHLI_LRI(:)=0.
+ END WHERE
+!$acc end kernels
+ELSEIF(HSUBG_AUCV_RI=='ADJU') THEN
+!$acc kernels
+ ZSUMRI(:)=PHLI_LRI(:)+PHLI_HRI(:)
+ WHERE(ZSUMRI .GT. 0.)
+ PHLI_LRI(:)=PHLI_LRI(:)*PRIT(:)/ZSUMRI(:)
+ PHLI_HRI(:)=PHLI_HRI(:)*PRIT(:)/ZSUMRI(:)
+ ELSEWHERE
+ PHLI_LRI(:)=0.
+ PHLI_HRI(:)=0.
+ ENDWHERE
+!$acc end kernels
+ELSE
+ !wrong HSUBG_AUCV_RI case
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'ICE4_COMPUTE_PDF', 'wrong HSUBG_AUCV_RI case' )
+ENDIF
+!
+PRF=MAX(PHLC_HCF,PHLI_HCF)
+!
IF (MPPDB_INITIALIZED) THEN
+ !Check all INOUT arrays
+ CALL MPPDB_CHECK1D(PHLI_HCF,"ICE4_COMPUTE_PDF beg:PHLI_HCF",PRECISION)
+ CALL MPPDB_CHECK1D(PHLI_LCF,"ICE4_COMPUTE_PDF beg:PHLI_LCF",PRECISION)
+ CALL MPPDB_CHECK1D(PHLI_HRI,"ICE4_COMPUTE_PDF beg:PHLI_HRI",PRECISION)
+ CALL MPPDB_CHECK1D(PHLI_LRI,"ICE4_COMPUTE_PDF beg:PHLI_LRI",PRECISION)
!Check all OUT arrays
CALL MPPDB_CHECK1D(PHLC_HCF,"ICE4_COMPUTE_PDF end:PHLC_HCF",PRECISION)
CALL MPPDB_CHECK1D(PHLC_LCF,"ICE4_COMPUTE_PDF end:PHLC_LCF",PRECISION)
diff --git a/src/MNH/ice4_fast_rg.f90 b/src/MNH/ice4_fast_rg.f90
index 37d79f5945eb26694e5c5931978f5bf4b373f0ab..80807e30f865c7f8601b60b9b411679bedcf7f45 100644
--- a/src/MNH/ice4_fast_rg.f90
+++ b/src/MNH/ice4_fast_rg.f90
@@ -1,24 +1,24 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
MODULE MODI_ICE4_FAST_RG
INTERFACE
-SUBROUTINE ICE4_FAST_RG(LDSOFT, LDCOMPUTE, KRR, &
+SUBROUTINE ICE4_FAST_RG(LDSOFT, PCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, PCIT, &
&PLBDAR, PLBDAS, PLBDAG, &
&PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
&PRGSI, PRGSI_MR, &
- &LDWETG, &
+ &PWETG, &
&PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
&PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
&PRG_TEND, &
&PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, PB_RG, PB_RH)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT
@@ -40,7 +40,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Graupel m.r. at t
REAL, DIMENSION(:), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
REAL, DIMENSION(:), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
-LOGICAL, DIMENSION(:), INTENT(OUT) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(:), INTENT(OUT) :: PWETG ! True where graupel grows in wet mode
REAL, DIMENSION(:), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
REAL, DIMENSION(:), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
REAL, DIMENSION(:), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
@@ -68,13 +68,13 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PB_RH
END SUBROUTINE ICE4_FAST_RG
END INTERFACE
END MODULE MODI_ICE4_FAST_RG
-SUBROUTINE ICE4_FAST_RG(LDSOFT, LDCOMPUTE, KRR, &
+SUBROUTINE ICE4_FAST_RG(LDSOFT, PCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, PCIT, &
&PLBDAR, PLBDAS, PLBDAG, &
&PT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
&PRGSI, PRGSI_MR, &
- &LDWETG, &
+ &PWETG, &
&PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
&PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
&PRG_TEND, &
@@ -98,7 +98,8 @@ SUBROUTINE ICE4_FAST_RG(LDSOFT, LDCOMPUTE, KRR, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT, &
+ XEPSILO
USE MODD_PARAM_ICE, ONLY: LCRFLIMIT,LEVLIMIT,LNULLWETG,LWETGPOST
USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXG,XCXS,XDG,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: NDRYLBDAG,NDRYLBDAR,NDRYLBDAS,X0DEPG,X1DEPG,XCOLEXIG,XCOLEXSG,XCOLIG,XCOLSG,XDRYINTP1G, &
@@ -117,7 +118,7 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
INTEGER, INTENT(IN) :: KRR ! Number of moist variable
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT
@@ -139,7 +140,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(:), INTENT(IN) :: PRGT ! Graupel m.r. at t
REAL, DIMENSION(:), INTENT(IN) :: PRGSI ! Graupel tendency by other processes
REAL, DIMENSION(:), INTENT(IN) :: PRGSI_MR ! Graupel mr change by other processes
-LOGICAL, DIMENSION(:), INTENT(OUT) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(:), INTENT(OUT) :: PWETG ! True where graupel grows in wet mode
REAL, DIMENSION(:), INTENT(INOUT) :: PRICFRRG ! Rain contact freezing
REAL, DIMENSION(:), INTENT(INOUT) :: PRRCFRIG ! Rain contact freezing
REAL, DIMENSION(:), INTENT(INOUT) :: PRICFRR ! Rain contact freezing
@@ -167,13 +168,16 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PB_RH
!
!* 0.2 declaration of local variables
!
-INTEGER, PARAMETER :: IRCDRYG=1, IRIDRYG=2, IRIWETG=3, IRSDRYG=4, IRSWETG=5, IRRDRYG=6
+INTEGER, PARAMETER :: IRCDRYG=1, IRIDRYG=2, IRIWETG=3, IRSDRYG=4, IRSWETG=5, IRRDRYG=6, &
+ & IFREEZ1=7, IFREEZ2=8
!
INTEGER :: IGDRY
-INTEGER :: IDX, JJ
+INTEGER :: ISIZE
+INTEGER :: IDX, JJ, JL
INTEGER, DIMENSION(:), allocatable :: I1
INTEGER, DIMENSION(:), allocatable :: IVEC1, IVEC2
-LOGICAL, DIMENSION(:), allocatable :: GDRY, GLDRYG, GMASK
+LOGICAL, DIMENSION(:), allocatable :: GDRY
+REAL, DIMENSION(:), allocatable :: ZDRY, ZDRYG, ZMASK
REAL, DIMENSION(:), allocatable :: ZVEC1, ZVEC2, ZVEC3
REAL, DIMENSION(:), allocatable :: ZZW, &
ZRDRYG_INIT, & !Initial dry growth rate of the graupeln
@@ -181,14 +185,14 @@ REAL, DIMENSION(:), allocatable :: ZZW, &
!
!-------------------------------------------------------------------------------
!
-!$acc data present(LDCOMPUTE,PRHODREF,PLVFACT,PLSFACT,PPRES,PDV,PKA,PCJ,PCIT,PLBDAR,PLBDAS,PLBDAG, &
-!$acc& PT,PRVT,PRCT,PRRT,PRIT,PRST,PRGT,PRGSI,PRGSI_MR,LDWETG,PRICFRRG,PRRCFRIG,PRICFRR,PRCWETG,PRIWETG, &
+!$acc data present(PCOMPUTE,PRHODREF,PLVFACT,PLSFACT,PPRES,PDV,PKA,PCJ,PCIT,PLBDAR,PLBDAS,PLBDAG, &
+!$acc& PT,PRVT,PRCT,PRRT,PRIT,PRST,PRGT,PRGSI,PRGSI_MR,PWETG,PRICFRRG,PRRCFRIG,PRICFRR,PRCWETG,PRIWETG, &
!$acc& PRRWETG,PRSWETG,PRCDRYG,PRIDRYG,PRRDRYG,PRSDRYG,PRWETGH,PRWETGH_MR,PRGMLTR,PRG_TEND, &
!$acc& PA_TH,PA_RC,PA_RR,PA_RI,PA_RS,PA_RG,PA_RH,PB_RG,PB_RH)
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK1D_LOG(LDCOMPUTE,"ICE4_FAST_RG beg:LDCOMPUTE")
+ CALL MPPDB_CHECK1D(PCOMPUTE,"ICE4_FAST_RG beg:PCOMPUTE")
CALL MPPDB_CHECK1D(PRHODREF,"ICE4_FAST_RG beg:PRHODREF",PRECISION)
CALL MPPDB_CHECK1D(PLVFACT,"ICE4_FAST_RG beg:PLVFACT",PRECISION)
CALL MPPDB_CHECK1D(PLSFACT,"ICE4_FAST_RG beg:PLSFACT",PRECISION)
@@ -226,12 +230,15 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK1D(PB_RH,"ICE4_FAST_RG beg:PB_RH",PRECISION)
END IF
+ISIZE = Size( PRHODREF )
+
allocate( i1 ( size( prhodref ) ) )
allocate( ivec1 ( size( prhodref ) ) )
allocate( ivec2 ( size( prhodref ) ) )
allocate( gdry ( size( prhodref ) ) )
-allocate( gldryg ( size( prhodref ) ) )
-allocate( gmask ( size( prhodref ) ) )
+allocate( zdry ( size( prhodref ) ) )
+allocate( zdryg ( size( prhodref ) ) )
+allocate( zmask ( size( prhodref ) ) )
allocate( zvec1 ( size( prhodref ) ) )
allocate( zvec2 ( size( prhodref ) ) )
allocate( zvec3 ( size( prhodref ) ) )
@@ -239,24 +246,27 @@ allocate( zzw ( size( prhodref ) ) )
allocate( zrdryg_init( size( prhodref ) ) )
allocate( zrwetg_init( size( prhodref ) ) )
-!$acc data create(I1,IVEC1,IVEC2,GDRY,GLDRYG,GMASK,ZVEC1,ZVEC2,ZVEC3,ZZW,ZRDRYG_INIT,ZRWETG_INIT)
+!$acc data create(I1,IVEC1,IVEC2,GDRY, ZDRY, ZDRYG, ZMASK, ZVEC1,ZVEC2,ZVEC3,ZZW,ZRDRYG_INIT,ZRWETG_INIT)
!
!* 6.1 rain contact freezing
!
!$acc kernels
-GMASK(:)=PRIT(:)>XRTMIN(4) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRICFRRG(:)=0.
- PRRCFRIG(:)=0.
- PRICFRR(:)=0.
- ENDWHERE
+ DO JL=1, ISIZE
+ PRICFRRG(JL)=ZMASK(JL) * PRICFRRG(JL)
+ PRRCFRIG(JL)=ZMASK(JL) * PRRCFRIG(JL)
+ PRICFRR(JL)=ZMASK(JL) * PRICFRR(JL)
+ ENDDO
ELSE
PRICFRRG(:)=0.
PRRCFRIG(:)=0.
- PRICFRR(:)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
PRICFRRG(:) = XICFRR*PRIT(:) & ! RICFRRG
*PLBDAR(:)**XEXICFRR &
@@ -273,54 +283,72 @@ ELSE
* BR_POW(PRHODREF(:),-XCEXVT-1.)
#endif
END WHERE
- ZZW(:)=1.
+
IF(LCRFLIMIT) THEN
- WHERE(GMASK(:))
+ DO JL=1, ISIZE
!Comparison between heat to be released (to freeze rain) and heat sink (rain and ice temperature change)
!ZZW is the proportion of process that can take place
- ZZW(:) = MAX(0., MIN(1., (PRICFRRG(:)*XCI+PRRCFRIG(:)*XCL)*(XTT-PT(:)) / &
- MAX(1.E-20, XLVTT*PRRCFRIG(:))))
- ENDWHERE
+ ZZW(JL)=(1.-ZMASK(JL)) + & ! 1. outside of mask
+ ZMASK(JL) * MAX(0., MIN(1., (PRICFRRG(JL)*XCI+PRRCFRIG(JL)*XCL)*(XTT-PT(JL)) / &
+ MAX(1.E-20, XLVTT*PRRCFRIG(JL))))
+ ENDDO
+ ELSE
+ ZZW(:)=1.
ENDIF
- PRRCFRIG(:) = ZZW(:) * PRRCFRIG(:) !Part of rain that can be freezed
- PRICFRR(:) = (1-ZZW(:)) * PRICFRRG(:) !Part of collected pristine ice converted to rain
- PRICFRRG(:) = ZZW(:) * PRICFRRG(:) !Part of collected pristine ice that lead to graupel
+ DO JL=1, ISIZE
+ PRRCFRIG(JL) = ZZW(JL) * PRRCFRIG(JL) !Part of rain that can be freezed
+ PRICFRR(JL) = (1.-ZZW(JL)) * PRICFRRG(JL) !Part of collected pristine ice converted to rain
+ PRICFRRG(JL) = ZZW(JL) * PRICFRRG(JL) !Part of collected pristine ice that lead to graupel
+ ENDDO
ENDIF
-PA_RI(:) = PA_RI(:) - PRICFRRG(:) - PRICFRR(:)
-PA_RR(:) = PA_RR(:) - PRRCFRIG(:) + PRICFRR(:)
-PA_RG(:) = PA_RG(:) + PRICFRRG(:) + PRRCFRIG(:)
-PA_TH(:) = PA_TH(:) + (PRRCFRIG(:) - PRICFRR(:))*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, ISIZE
+ PA_RI(JL) = PA_RI(JL) - PRICFRRG(JL) - PRICFRR(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRCFRIG(JL) + PRICFRR(JL)
+ PA_RG(JL) = PA_RG(JL) + PRICFRRG(JL) + PRRCFRIG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRRCFRIG(JL) - PRICFRR(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
!* 6.3 compute the graupel growth
!
! Wet and dry collection of rc and ri on graupel
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRG_TEND(:, IRCDRYG)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*PRG_TEND(JL, IRCDRYG)
+ ENDDO
ELSE
- PRG_TEND(:, IRCDRYG)=0.
- WHERE(GMASK(:))
+ ZZW(:)=0.
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
#else
ZZW(:)=BR_POW(PLBDAG(:),XCXG-XDG-2.) * BR_POW(PRHODREF(:),-XCEXVT)
#endif
- PRG_TEND(:, IRCDRYG)=XFCDRYG * PRCT(:) * ZZW(:)
END WHERE
+ DO JL=1, ISIZE
+ PRG_TEND(JL, IRCDRYG)=ZMASK(JL)*XFCDRYG * PRCT(JL) * ZZW(JL)
+ ENDDO
ENDIF
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:)
+
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRG_TEND(:, IRIDRYG)=0.
- PRG_TEND(:, IRIWETG)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRG_TEND(JL, IRIDRYG)=ZMASK(JL) * PRG_TEND(JL, IRIDRYG)
+ PRG_TEND(JL, IRIWETG)=ZMASK(JL) * PRG_TEND(JL, IRIWETG)
+ ENDDO
ELSE
PRG_TEND(:, IRIDRYG)=0.
PRG_TEND(:, IRIWETG)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
ZZW(:)=PLBDAG(:)**(XCXG-XDG-2.) * PRHODREF(:)**(-XCEXVT)
PRG_TEND(:, IRIDRYG)=XFIDRYG*EXP(XCOLEXIG*(PT(:)-XTT))*PRIT(:)*ZZW(:)
@@ -337,7 +365,10 @@ ENDIF
IGDRY = 0
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GDRY)
- IF (PRST(JJ)>XRTMIN(5) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
+ ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZDRY(JJ)>0) THEN
!$acc atomic capture
IGDRY = IGDRY + 1
IDX = IGDRY
@@ -356,10 +387,10 @@ IF(JJ==-999) print *,jj
! !$acc kernels
IF(LDSOFT) THEN
!$acc kernels
- WHERE(.NOT. GDRY(:))
- PRG_TEND(:, IRSDRYG)=0.
- PRG_TEND(:, IRSWETG)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRG_TEND(JL, IRSDRYG)=ZDRY(JL) * PRG_TEND(JL, IRSDRYG)
+ PRG_TEND(JL, IRSWETG)=ZDRY(JL) * PRG_TEND(JL, IRSWETG)
+ ENDDO
!$acc end kernels
ELSE
!$acc kernels
@@ -445,7 +476,10 @@ ENDIF
IGDRY = 0
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GDRY)
- IF (PRRT(JJ)>XRTMIN(3) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
+ ZDRY(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZDRY(JJ)>0) THEN
!$acc atomic capture
IGDRY = IGDRY + 1
IDX = IGDRY
@@ -464,9 +498,9 @@ END DO
! !$acc kernels
IF(LDSOFT) THEN
!$acc kernels
- WHERE(.NOT. GDRY(:))
- PRG_TEND(:, IRRDRYG)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRG_TEND(JL, IRRDRYG)=ZDRY(JL) * PRG_TEND(JL, IRRDRYG)
+ ENDDO
!$acc end kernels
ELSE
!$acc kernels
@@ -543,56 +577,86 @@ ELSE
ENDIF
!$acc kernels
-ZRDRYG_INIT(:)=PRG_TEND(:, IRCDRYG)+PRG_TEND(:, IRIDRYG)+PRG_TEND(:, IRSDRYG)+PRG_TEND(:, IRRDRYG)
+DO JL=1, ISIZE
+ ZRDRYG_INIT(JL)=PRG_TEND(JL, IRCDRYG)+PRG_TEND(JL, IRIDRYG)+ &
+ &PRG_TEND(JL, IRSDRYG)+PRG_TEND(JL, IRRDRYG)
+ENDDO
!Freezing rate
-ZRWETG_INIT(:)=0.
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:)
-WHERE(GMASK(:))
- ZRWETG_INIT(:)=PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
-END WHERE
-IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, ISIZE
+ PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRG_TEND(JL, IFREEZ1)
+ PRG_TEND(JL, IFREEZ2)=ZMASK(JL) * PRG_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, ISIZE
+ PRG_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
- ZRWETG_INIT(:)=MIN(ZRWETG_INIT(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ PRG_TEND(:, IFREEZ1)=MIN(PRG_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
#else
- ZRWETG_INIT(:)=MIN(ZRWETG_INIT(:), BR_EXP(XALPI-XBETAI/PT(:)-XGAMI*BR_LOG(PT(:)))) ! min(ev, es_i(T))
+ PRG_TEND(:, IFREEZ1)=MIN(PRG_TEND(:, IFREEZ1), BR_EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
#endif
- END WHERE
-ENDIF
-WHERE(GMASK(:))
- ZRWETG_INIT(:)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-ZRWETG_INIT(:))/(XRV*PT(:)) )
- ZRWETG_INIT(:)=MAX(0., &
+ END WHERE
+ ENDIF
+ PRG_TEND(:, IFREEZ2)=0.
+ WHERE(ZMASK(:)==1.)
+ PRG_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRG_TEND(:, IFREEZ1))/(XRV*PT(:)) )
#ifndef MNH_BITREP
- (ZRWETG_INIT(:) * ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
- X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG ) + &
+ PRG_TEND(:, IFREEZ1)=PRG_TEND(:, IFREEZ1)* ( X0DEPG* PLBDAG(:)**XEX0DEPG + &
+ X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )/ &
#else
- (ZRWETG_INIT(:) * ( X0DEPG* BR_POW(PLBDAG(:),XEX0DEPG) + &
- X1DEPG*PCJ(:)*BR_POW(PLBDAG(:),XEX1DEPG) ) + &
+ PRG_TEND(:, IFREEZ1)=PRG_TEND(:, IFREEZ1)* ( X0DEPG* BR_POW(PLBDAG(:),XEX0DEPG) + &
+ X1DEPG*PCJ(:)*BR_POW(PLBDAG(:),XEX1DEPG) )/ &
#endif
- (PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG) ) * &
- (PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) )
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRG_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ END WHERE
+ENDIF
+DO JL=1, ISIZE
!We must agregate, at least, the cold species
- ZRWETG_INIT(:)=MAX(ZRWETG_INIT(:), PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG))
-END WHERE
+ ZRWETG_INIT(JL)=ZMASK(JL) * MAX(PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG), &
+ &MAX(0., PRG_TEND(JL, IFREEZ1) + &
+ &PRG_TEND(JL, IFREEZ2) * ( &
+ &PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG) )))
+ENDDO
!Growth mode
-LDWETG(:)=GMASK(:) .AND. &
- &MAX(0., ZRDRYG_INIT(:)-PRG_TEND(:, IRIDRYG)-PRG_TEND(:, IRSDRYG))>= &
- &MAX(0., ZRWETG_INIT(:)-PRG_TEND(:, IRIWETG)-PRG_TEND(:, IRSWETG))
+DO JL=1, ISIZE
+ PWETG(JL) = ZMASK(JL) * & !
+ & MAX(0., SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
+ &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
+ENDDO
IF(LNULLWETG) THEN
- LDWETG(:)=LDWETG(:) .AND. ZRDRYG_INIT(:)>0.
+ DO JL=1, ISIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRDRYG_INIT(JL)))
+ ENDDO
ELSE
- LDWETG(:)=LDWETG(:) .AND. ZRWETG_INIT(:)>0.
+ DO JL=1, ISIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., -ZRWETG_INIT(JL)))
+ ENDDO
ENDIF
-IF(.NOT. LWETGPOST) LDWETG(:)=LDWETG(:) .AND. PT(:)<XTT
-
-GLDRYG(:)=GMASK(:) .AND. PT(:)<XTT .AND. ZRDRYG_INIT(:)>0. .AND. &
- &MAX(0., ZRDRYG_INIT(:)-PRG_TEND(:, IRIDRYG)-PRG_TEND(:, IRSDRYG))<&
- &MAX(0., ZRWETG_INIT(:)-PRG_TEND(:, IRIWETG)-PRG_TEND(:, IRSWETG))
+IF(.NOT. LWETGPOST) THEN
+ DO JL=1, ISIZE
+ PWETG(JL) = PWETG(JL) * MAX(0., -SIGN(1., PT(JL)-XTT))
+ ENDDO
+ENDIF
+DO JL=1, ISIZE
+ ZDRYG(JL) = ZMASK(JL) * & !
+ & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
+ & MAX(0., -SIGN(1., 1.E-20-ZRDRYG_INIT(JL))) * & ! WHERE(ZRDRYG_INIT(:)>0.)
+ & MAX(0., -SIGN(1., MAX(0., ZRDRYG_INIT(JL)-PRG_TEND(JL, IRIDRYG)-PRG_TEND(JL, IRSDRYG)) - &
+ &MAX(0., ZRWETG_INIT(JL)-PRG_TEND(JL, IRIWETG)-PRG_TEND(JL, IRSWETG))))
+ENDDO
! Part of ZRWETG to be converted into hail
! Graupel can be produced by other processes instantaneously (inducing a mixing ratio change, PRGSI_MR) or
@@ -600,66 +664,61 @@ GLDRYG(:)=GMASK(:) .AND. PT(:)<XTT .AND. ZRDRYG_INIT(:)>0. .AND. &
PRWETGH(:)=0.
PRWETGH_MR(:)=0.
IF(KRR==7) THEN
- WHERE(LDWETG(:))
+ WHERE(PWETG(:)==1.)
!assume a linear percent of conversion of produced graupel into hail
PRWETGH(:)=(MAX(0., PRGSI(:)+PRICFRRG(:)+PRRCFRIG(:))+ZRWETG_INIT(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
PRWETGH_MR(:)=MAX(0., PRGSI_MR(:))*ZRDRYG_INIT(:)/(ZRWETG_INIT(:)+ZRDRYG_INIT(:))
END WHERE
ENDIF
-PRCWETG(:)=0.
-PRIWETG(:)=0.
-PRSWETG(:)=0.
-PRRWETG(:)=0.
-WHERE(LDWETG(:))
+DO JL=1, ISIZE
!Aggregated minus collected
- PRRWETG(:)=-(PRG_TEND(:, IRIWETG)+PRG_TEND(:, IRSWETG)+PRG_TEND(:, IRCDRYG)-ZRWETG_INIT(:))
- PRCWETG(:)=PRG_TEND(:, IRCDRYG)
- PRIWETG(:)=PRG_TEND(:, IRIWETG)
- PRSWETG(:)=PRG_TEND(:, IRSWETG)
-END WHERE
-PRCDRYG(:)=0.
-PRIDRYG(:)=0.
-PRRDRYG(:)=0.
-PRSDRYG(:)=0.
-WHERE(GLDRYG(:))
- PRCDRYG(:)=PRG_TEND(:, IRCDRYG)
- PRRDRYG(:)=PRG_TEND(:, IRRDRYG)
- PRIDRYG(:)=PRG_TEND(:, IRIDRYG)
- PRSDRYG(:)=PRG_TEND(:, IRSDRYG)
-END WHERE
-PA_RC(:) = PA_RC(:) - PRCWETG(:)
-PA_RI(:) = PA_RI(:) - PRIWETG(:)
-PA_RS(:) = PA_RS(:) - PRSWETG(:)
-PA_RG(:) = PA_RG(:) + PRCWETG(:) + PRIWETG(:) + PRSWETG(:) + PRRWETG(:)
-PA_RR(:) = PA_RR(:) - PRRWETG(:)
-PA_TH(:) = PA_TH(:) + (PRCWETG(:) + PRRWETG(:))*(PLSFACT(:)-PLVFACT(:))
-PA_RG(:) = PA_RG(:) - PRWETGH(:)
-PA_RH(:) = PA_RH(:) + PRWETGH(:)
-PB_RG(:) = PB_RG(:) - PRWETGH_MR(:)
-PB_RH(:) = PB_RH(:) + PRWETGH_MR(:)
-PA_RC(:) = PA_RC(:) - PRCDRYG(:)
-PA_RI(:) = PA_RI(:) - PRIDRYG(:)
-PA_RS(:) = PA_RS(:) - PRSDRYG(:)
-PA_RR(:) = PA_RR(:) - PRRDRYG(:)
-PA_RG(:) = PA_RG(:) + PRCDRYG(:) + PRIDRYG(:) + PRSDRYG(:) + PRRDRYG(:)
-PA_TH(:) = PA_TH(:) + (PRCDRYG(:)+PRRDRYG(:))*(PLSFACT(:)-PLVFACT(:))
+ PRRWETG(JL)=-PWETG(JL) * (PRG_TEND(JL, IRIWETG)+PRG_TEND(JL, IRSWETG)+&
+ &PRG_TEND(JL, IRCDRYG)-ZRWETG_INIT(JL))
+ PRCWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRCDRYG)
+ PRIWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRIWETG)
+ PRSWETG(JL)=PWETG(JL) * PRG_TEND(JL, IRSWETG)
+
+ PRCDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRCDRYG)
+ PRRDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRRDRYG)
+ PRIDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRIDRYG)
+ PRSDRYG(JL)=ZDRYG(JL) * PRG_TEND(JL, IRSDRYG)
+ PA_RC(JL) = PA_RC(JL) - PRCWETG(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIWETG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSWETG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCWETG(JL) + PRIWETG(JL) + PRSWETG(JL) + PRRWETG(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRWETG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCWETG(JL) + PRRWETG(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RG(JL) = PA_RG(JL) - PRWETGH(JL)
+ PA_RH(JL) = PA_RH(JL) + PRWETGH(JL)
+ PB_RG(JL) = PB_RG(JL) - PRWETGH_MR(JL)
+ PB_RH(JL) = PB_RH(JL) + PRWETGH_MR(JL)
+ PA_RC(JL) = PA_RC(JL) - PRCDRYG(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIDRYG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSDRYG(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRDRYG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCDRYG(JL) + PRIDRYG(JL) + PRSDRYG(JL) + PRRDRYG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCDRYG(JL)+PRRDRYG(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 6.5 Melting of the graupeln
!
-GMASK(:)=PRGT(:)>XRTMIN(6) .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRGMLTR(:) = 0.
- END WHERE
+ DO JL=1, ISIZE
+ PRGMLTR(JL)=ZMASK(JL) * PRGMLTR(JL)
+ ENDDO
ELSE
- PRGMLTR(:) = 0.
- WHERE(GMASK(:))
- PRGMLTR(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- END WHERE
+ DO JL=1, ISIZE
+ PRGMLTR(JL)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
PRGMLTR(:)=MIN(PRGMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
#else
@@ -667,12 +726,12 @@ ELSE
#endif
END WHERE
ENDIF
- WHERE(GMASK(:))
- PRGMLTR(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-PRGMLTR(:))/(XRV*PT(:)) )
- END WHERE
- WHERE(GMASK(:))
+ DO JL=1, ISIZE
+ PRGMLTR(JL)=ZMASK(JL) * (PKA(JL)*(XTT-PT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ *(XESTT-PRGMLTR(JL))/(XRV*PT(JL)) ))
+ ENDDO
+ WHERE(ZMASK(:)==1.)
!
! compute RGMLTR
!
@@ -689,9 +748,11 @@ ELSE
( PRHODREF(:)*XLMTT ) )
END WHERE
ENDIF
-PA_RR(:) = PA_RR(:) + PRGMLTR(:)
-PA_RG(:) = PA_RG(:) - PRGMLTR(:)
-PA_TH(:) = PA_TH(:) - PRGMLTR(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, ISIZE
+ PA_RR(JL) = PA_RR(JL) + PRGMLTR(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGMLTR(JL)
+ PA_TH(JL) = PA_TH(JL) - PRGMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!$acc end kernels
!
IF (MPPDB_INITIALIZED) THEN
@@ -711,7 +772,7 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK1D(PB_RG,"ICE4_FAST_RG end:PB_RG",PRECISION)
CALL MPPDB_CHECK1D(PB_RH,"ICE4_FAST_RG end:PB_RH",PRECISION)
!Check all OUT arrays
- CALL MPPDB_CHECK1D_LOG(LDWETG,"ICE4_FAST_RG end:LDWETG")
+ CALL MPPDB_CHECK1D(PWETG,"ICE4_FAST_RG end:PWETG")
CALL MPPDB_CHECK1D(PRCWETG,"ICE4_FAST_RG end:PRCWETG",PRECISION)
CALL MPPDB_CHECK1D(PRIWETG,"ICE4_FAST_RG end:PRIWETG",PRECISION)
CALL MPPDB_CHECK1D(PRRWETG,"ICE4_FAST_RG end:PRRWETG",PRECISION)
diff --git a/src/MNH/ice4_fast_rh.f90 b/src/MNH/ice4_fast_rh.f90
index 70eafb7aa4dd6959a079643fc2366aa6ce16467a..826ace2506e40e07d4d76492363333f1e66b4cc1 100644
--- a/src/MNH/ice4_fast_rh.f90
+++ b/src/MNH/ice4_fast_rh.f90
@@ -1,11 +1,11 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
MODULE MODI_ICE4_FAST_RH
INTERFACE
-SUBROUTINE ICE4_FAST_RH(LDSOFT, LDCOMPUTE, LDWETG, &
+SUBROUTINE ICE4_FAST_RH(LDSOFT, PCOMPUTE, PWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
@@ -16,8 +16,8 @@ SUBROUTINE ICE4_FAST_RH(LDSOFT, LDCOMPUTE, LDWETG, &
&PA_TH, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT
@@ -60,7 +60,7 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
END SUBROUTINE ICE4_FAST_RH
END INTERFACE
END MODULE MODI_ICE4_FAST_RH
-SUBROUTINE ICE4_FAST_RH(LDSOFT, LDCOMPUTE, LDWETG, &
+SUBROUTINE ICE4_FAST_RH(LDSOFT, PCOMPUTE, PWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAS, PLBDAG, PLBDAR, PLBDAH, &
@@ -88,7 +88,7 @@ SUBROUTINE ICE4_FAST_RH(LDSOFT, LDCOMPUTE, LDWETG, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMW,XCI,XCL,XCPV,XESTT,XGAMI,XLMTT,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
USE MODD_PARAM_ICE, ONLY: LCONVHG,LEVLIMIT,LNULLWETH,LWETHPOST
USE MODD_RAIN_ICE_DESCR, ONLY: XBG,XBS,XCEXVT,XCXG,XCXH,XCXS,XDH,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: NWETLBDAG,NWETLBDAH,NWETLBDAR,NWETLBDAS,X0DEPH,X1DEPH,XCOLEXGH,XCOLEXIH,XCOLGH,XCOLIH,XCOLEXSH, &
@@ -107,8 +107,8 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDWETG ! True where graupel grows in wet mode
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PWETG ! 1. where graupel grows in wet mode, 0. elsewhere
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT
@@ -151,13 +151,16 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RH
!
!* 0.2 declaration of local variables
!
-INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8
+INTEGER, PARAMETER :: IRCWETH=1, IRRWETH=2, IRIDRYH=3, IRIWETH=4, IRSDRYH=5, IRSWETH=6, IRGDRYH=7, IRGWETH=8, &
+ & IFREEZ1=9, IFREEZ2=10
!
INTEGER :: IGWET
-INTEGER :: IDX, JJ
+INTEGER :: ISIZE
+INTEGER :: IDX, JJ, JL
INTEGER, DIMENSION(:), allocatable :: I1
INTEGER, DIMENSION(:), allocatable :: IVEC1, IVEC2
-LOGICAL, DIMENSION(:), allocatable :: GHAIL, GWET, GMASK, LLWETH, LLDRYH
+LOGICAL, DIMENSION(:), allocatable :: GWET
+REAL, DIMENSION(:), allocatable :: ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH
REAL, DIMENSION(:), allocatable :: ZVEC1, ZVEC2, ZVEC3
REAL, DIMENSION(:), allocatable :: ZZW, &
ZRDRYH_INIT, ZRWETH_INIT, &
@@ -167,7 +170,7 @@ REAL, DIMENSION(:), allocatable :: ZZW, &
!
CALL PRINT_MSG(NVERB_ERROR,'GEN','ICE4_FAST_RH','OPENACC: implemented but never tested')
-!$acc data present(LDCOMPUTE,LDWETG,PRHODREF,PLVFACT,PLSFACT,PPRES,PDV,PKA,PCJ, &
+!$acc data present(PCOMPUTE,PWETG,PRHODREF,PLVFACT,PLSFACT,PPRES,PDV,PKA,PCJ, &
!$acc& PLBDAS,PLBDAG,PLBDAR,PLBDAH,PT,PRVT,PRCT,PRRT,PRIT,PRST,PRGT,PRHT, &
!$acc& PRCWETH,PRIWETH,PRSWETH,PRGWETH,PRRWETH, &
!$acc& PRCDRYH,PRIDRYH,PRSDRYH,PRRDRYH,PRGDRYH,PRDRYHG,PRHMLTR, &
@@ -175,8 +178,8 @@ CALL PRINT_MSG(NVERB_ERROR,'GEN','ICE4_FAST_RH','OPENACC: implemented but never
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK1D_LOG(LDCOMPUTE,"ICE4_FAST_RH beg:LDCOMPUTE")
- CALL MPPDB_CHECK1D_LOG(LDWETG,"ICE4_FAST_RH beg:LDWETG")
+ CALL MPPDB_CHECK1D(PCOMPUTE,"ICE4_FAST_RH beg:PCOMPUTE")
+ CALL MPPDB_CHECK1D(PWETG,"ICE4_FAST_RH beg:PWETG")
CALL MPPDB_CHECK1D(PRHODREF,"ICE4_FAST_RH beg:PRHODREF",PRECISION)
CALL MPPDB_CHECK1D(PLVFACT,"ICE4_FAST_RH beg:PLVFACT",PRECISION)
CALL MPPDB_CHECK1D(PLSFACT,"ICE4_FAST_RH beg:PLSFACT",PRECISION)
@@ -208,14 +211,17 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK1D(PA_RH,"ICE4_FAST_RH beg:PA_RH",PRECISION)
END IF
+ISIZE = Size( PRHODREF )
+
allocate( i1 ( size( prhodref ) ) )
allocate( ivec1 ( size( prhodref ) ) )
allocate( ivec2 ( size( prhodref ) ) )
-allocate( ghail ( size( prhodref ) ) )
allocate( gwet ( size( prhodref ) ) )
-allocate( gmask ( size( prhodref ) ) )
-allocate( llweth ( size( prhodref ) ) )
-allocate( lldryh ( size( prhodref ) ) )
+allocate( zhail ( size( prhodref ) ) )
+allocate( zwet ( size( prhodref ) ) )
+allocate( zmask ( size( prhodref ) ) )
+allocate( zweth ( size( prhodref ) ) )
+allocate( zdryh ( size( prhodref ) ) )
allocate( zvec1 ( size( prhodref ) ) )
allocate( zvec2 ( size( prhodref ) ) )
allocate( zvec3 ( size( prhodref ) ) )
@@ -224,21 +230,25 @@ allocate( zrdryh_init( size( prhodref ) ) )
allocate( zrweth_init( size( prhodref ) ) )
allocate( zrdryhg ( size( prhodref ) ) )
-!$acc data create(I1,IVEC1,IVEC2,GHAIL,GWET,GMASK,LLWETH,LLDRYH, &
+!$acc data create(I1,IVEC1,IVEC2,GWET, ZHAIL, ZWET, ZMASK, ZWETH, ZDRYH, &
!$acc& ZVEC1,ZVEC2,ZVEC3,ZZW,ZRDRYH_INIT,ZRWETH_INIT,ZRDRYHG)
!
!* 7.2 compute the Wet and Dry growth of hail
!
!$acc kernels
-GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! WHERE(PRCT(:)>XRTMIN(2))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRH_TEND(:, IRCWETH)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRH_TEND(JL, IRCWETH)=ZMASK(JL) * PRH_TEND(JL, IRCWETH)
+ ENDDO
ELSE
PRH_TEND(:, IRCWETH)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
#else
@@ -247,16 +257,20 @@ ELSE
PRH_TEND(:, IRCWETH)=XFWETH * PRCT(:) * ZZW(:) ! RCWETH
END WHERE
ENDIF
-GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! WHERE(PRIT(:)>XRTMIN(4))
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRH_TEND(:, IRIWETH)=0.
- PRH_TEND(:, IRIDRYH)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRH_TEND(JL, IRIWETH)=ZMASK(JL) * PRH_TEND(JL, IRIWETH)
+ PRH_TEND(JL, IRIDRYH)=ZMASK(JL) * PRH_TEND(JL, IRIDRYH)
+ ENDDO
ELSE
PRH_TEND(:, IRIWETH)=0.
PRH_TEND(:, IRIDRYH)=0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
ZZW(:) = PLBDAH(:)**(XCXH-XDH-2.0) * PRHODREF(:)**(-XCEXVT)
PRH_TEND(:, IRIWETH)=XFWETH * PRIT(:) * ZZW(:) ! RIWETH
@@ -274,7 +288,10 @@ ENDIF
IGWET = 0
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GWET)
- IF (PRHT(JJ)>XRTMIN(7) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
+ ZWET(JJ) = MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
!$acc atomic capture
IGWET = IGWET + 1
IDX = IGWET
@@ -293,10 +310,10 @@ END DO
! !$acc kernels
IF(LDSOFT) THEN
!$acc kernels
- WHERE(.NOT. GWET(:))
- PRH_TEND(:, IRSWETH)=0.
- PRH_TEND(:, IRSDRYH)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRH_TEND(JL, IRSWETH)=ZWET(JL) * PRH_TEND(JL, IRSWETH)
+ PRH_TEND(JL, IRSDRYH)=ZWET(JL) * PRH_TEND(JL, IRSDRYH)
+ ENDDO
!$acc end kernels
ELSE
!$acc kernels
@@ -380,7 +397,10 @@ ENDIF
IGWET = 0
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GWET)
- IF (PRHT(JJ)>XRTMIN(7) .AND. PRGT(JJ)>XRTMIN(6) .AND. LDCOMPUTE(JJ)) THEN
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JJ))) * & ! WHERE(PRGT(:)>XRTMIN(6))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
!$acc atomic capture
IGWET = IGWET + 1
IDX = IGWET
@@ -399,10 +419,10 @@ END DO
! !$acc kernels
IF(LDSOFT) THEN
!$acc kernels
- WHERE(.NOT. GWET(:))
- PRH_TEND(:, IRGWETH)=0.
- PRH_TEND(:, IRGDRYH)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRH_TEND(JL, IRGWETH)=ZWET(JL) * PRH_TEND(JL, IRGWETH)
+ PRH_TEND(JL, IRGDRYH)=ZWET(JL) * PRH_TEND(JL, IRGDRYH)
+ ENDDO
!$acc end kernels
ELSE
!$acc kernels
@@ -476,7 +496,7 @@ ELSE
PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGWETH)
END WHERE
!When graupel grows in wet mode, graupel is wet (!) and collection efficiency must remain the same
- WHERE(GWET(:) .AND. .NOT. LDWETG(:))
+ WHERE(GWET(:) .AND. .NOT. PWETG(:)==1.)
#ifndef MNH_BITREP
PRH_TEND(:, IRGDRYH)=PRH_TEND(:, IRGDRYH)*(XCOLGH*EXP(XCOLEXGH*(PT(:)-XTT)))
#else
@@ -493,7 +513,10 @@ ENDIF
IGWET = 0
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GWET)
- IF (PRHT(JJ)>XRTMIN(7) .AND. PRRT(JJ)>XRTMIN(3) .AND. LDCOMPUTE(JJ)) THEN
+ ZWET(JJ)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JJ))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & ! WHERE(PRRT(:)>XRTMIN(3))
+ &PCOMPUTE(JJ)
+ IF (ZWET(JJ)>0) THEN
!$acc atomic capture
IGWET = IGWET + 1
IDX = IGWET
@@ -512,9 +535,9 @@ END DO
! !$acc kernels
IF(LDSOFT) THEN
!$acc kernels
- WHERE(.NOT. GWET(:))
- PRH_TEND(:, IRRWETH)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRH_TEND(JL, IRRWETH)=ZWET(JL) * PRH_TEND(JL, IRRWETH)
+ ENDDO
!$acc end kernels
ELSE
!$acc kernels
@@ -590,122 +613,147 @@ ELSE
ENDIF
!$acc kernels
!
-ZRDRYH_INIT(:)=PRH_TEND(:, IRCWETH)+PRH_TEND(:, IRIDRYH)+PRH_TEND(:, IRSDRYH)+PRH_TEND(:, IRRWETH)+PRH_TEND(:, IRGDRYH)
+DO JL=1, ISIZE
+ ZRDRYH_INIT(JL)=PRH_TEND(JL, IRCWETH)+PRH_TEND(JL, IRIDRYH)+ &
+ &PRH_TEND(JL, IRSDRYH)+PRH_TEND(JL, IRRWETH)+PRH_TEND(JL, IRGDRYH)
+ENDDO
!
!* 7.3 compute the Wet growth of hail
!
-GHAIL(:) = PRHT(:)>XRTMIN(7) .AND. LDCOMPUTE(:)
-ZRWETH_INIT(:)=0.
-WHERE(GHAIL(:))
- ZRWETH_INIT(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
-END WHERE
-IF(LEVLIMIT) THEN
- WHERE(GHAIL(:))
+DO JL=1, ISIZE
+ ZHAIL(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, ISIZE
+ PRH_TEND(JL, IFREEZ1)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ1)
+ PRH_TEND(JL, IFREEZ2)=ZHAIL(JL) * PRH_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, ISIZE
+ PRH_TEND(JL, IFREEZ1)=PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZHAIL(:)==1.)
#ifndef MNH_BITREP
- ZRWETH_INIT(:) = MIN(ZRWETH_INIT(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ PRH_TEND(:, IFREEZ1)=MIN(PRH_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
#else
- ZRWETH_INIT(:) = MIN(ZRWETH_INIT(:), BR_EXP(XALPI-XBETAI/PT(:)-XGAMI*BR_LOG(PT(:)))) ! min(ev, es_i(T))
+ PRH_TEND(:, IFREEZ1)=MIN(PRH_TEND(:, IFREEZ1), BR_EXP(XALPI-XBETAI/PT(:)-XGAMI*BR_LOG(PT(:)))) ! min(ev, es_i(T))
#endif
- END WHERE
-ENDIF
-WHERE(GHAIL(:))
- ZRWETH_INIT(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-ZRWETH_INIT(:))/(XRV*PT(:)) )
- !
- ! compute RWETH
- !
+ END WHERE
+ ENDIF
+ PRH_TEND(:, IFREEZ2)=0.
+ WHERE(ZHAIL(:)==1.)
+ PRH_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRH_TEND(:, IFREEZ1))/(XRV*PT(:)) )
#ifndef MNH_BITREP
- ZRWETH_INIT(:) = MAX(0., ( ZRWETH_INIT(:) * ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
- X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH ) + &
+ PRH_TEND(:, IFREEZ1)=PRH_TEND(:, IFREEZ1)* ( X0DEPH* PLBDAH(:)**XEX0DEPH + &
+ X1DEPH*PCJ(:)*PLBDAH(:)**XEX1DEPH )/ &
#else
- ZRWETH_INIT(:) = MAX(0., ( ZRWETH_INIT(:) * ( X0DEPH* BR_POW(PLBDAH(:),XEX0DEPH) + &
- X1DEPH*PCJ(:)*BR_POW(PLBDAH(:),XEX1DEPH) ) + &
+ PRH_TEND(:, IFREEZ1)=PRH_TEND(:, IFREEZ1)* ( X0DEPH* BR_POW(PLBDAH(:),XEX0DEPH) + &
+ X1DEPH*PCJ(:)*BR_POW(PLBDAH(:),XEX1DEPH) )/ &
#endif
- ( PRH_TEND(:, IRIWETH)+PRH_TEND(:, IRSWETH)+PRH_TEND(:, IRGWETH) ) * &
- ( PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) )
- ZRWETH_INIT(:)=MAX(ZRWETH_INIT(:), PRH_TEND(:, IRIWETH)+PRH_TEND(:, IRSWETH)+PRH_TEND(:, IRGWETH))
-END WHERE
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRH_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ END WHERE
+ENDIF
+DO JL=1, ISIZE
+ !We must agregate, at least, the cold species
+ ZRWETH_INIT(JL)=ZHAIL(JL) * MAX(PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH), &
+ &MAX(0., PRH_TEND(JL, IFREEZ1) + &
+ &PRH_TEND(JL, IFREEZ2) * ( &
+ &PRH_TEND(JL, IRIWETH)+PRH_TEND(JL, IRSWETH)+PRH_TEND(JL, IRGWETH) )))
+ENDDO
!
!* 7.4 Select Wet or Dry case
!
!Wet case
-LLWETH(:)=GHAIL(:) .AND. MAX(0., ZRDRYH_INIT(:)-PRH_TEND(:, IRIDRYH)-PRH_TEND(:, IRSDRYH)-PRH_TEND(:, IRGDRYH))>= &
- & MAX(0., ZRWETH_INIT(:)-PRH_TEND(:, IRIWETH)-PRH_TEND(:, IRSWETH)-PRH_TEND(:, IRGWETH))
+DO JL=1, ISIZE
+ ZWETH(JL) = ZHAIL(JL) * &
+ & MAX(0., SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)-PRH_TEND(JL, IRGDRYH)) - &
+ &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH)-PRH_TEND(JL, IRGWETH))))
+ENDDO
IF(LNULLWETH) THEN
- LLWETH(:)=LLWETH(:) .AND. ZRDRYH_INIT(:)>0.
+ DO JL=1, ISIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRDRYH_INIT(JL))) ! WHERE(ZRDRYH_INIT(:)>0.)
+ ENDDO
ELSE
- LLWETH(:)=LLWETH(:) .AND. ZRWETH_INIT(:)>0.
+ DO JL=1, ISIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., -ZRWETH_INIT(JL))) ! WHERE(ZRWETH_INIT(:)>0.)
+ ENDDO
ENDIF
-IF(.NOT. LWETHPOST) LLWETH(:)=LLWETH(:) .AND. PT(:)<XTT
-LLDRYH(:)=GHAIL(:) .AND. PT(:)<XTT .AND. ZRDRYH_INIT(:)>0. .AND. &
- & MAX(0., ZRDRYH_INIT(:)-PRH_TEND(:, IRIDRYH)-PRH_TEND(:, IRSDRYH))< &
- & MAX(0., ZRWETH_INIT(:)-PRH_TEND(:, IRIWETH)-PRH_TEND(:, IRSWETH))
+IF(.NOT. LWETHPOST) THEN
+ DO JL=1, ISIZE
+ ZWETH(JL) = ZWETH(JL) * MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ ENDDO
+ENDIF
+DO JL=1, ISIZE
+ ZDRYH(JL) = ZHAIL(JL) * &
+ & MAX(0., -SIGN(1., PT(JL)-XTT)) * & ! WHERE(PT(:)<XTT)
+ & MAX(0., -SIGN(1., 1.E-20-ZRDRYH_INIT(JL))) * & !WHERE(ZRDRYH_INIT(:)>0.)
+ & MAX(0., -SIGN(1., MAX(0., ZRDRYH_INIT(JL)-PRH_TEND(JL, IRIDRYH)-PRH_TEND(JL, IRSDRYH)) - &
+ &MAX(0., ZRWETH_INIT(JL)-PRH_TEND(JL, IRIWETH)-PRH_TEND(JL, IRSWETH))))
+ENDDO
!
-PRCWETH(:)=0.
-PRIWETH(:)=0.
-PRSWETH(:)=0.
-PRGWETH(:)=0.
-PRRWETH(:)=0.
-WHERE (LLWETH(:))
- PRCWETH(:) = PRH_TEND(:, IRCWETH)
- PRIWETH(:) = PRH_TEND(:, IRIWETH)
- PRSWETH(:) = PRH_TEND(:, IRSWETH)
- PRGWETH(:) = PRH_TEND(:, IRGWETH)
- !Collected minus aggregated
- PRRWETH(:) = ZRWETH_INIT(:) - PRH_TEND(:, IRIWETH) - PRH_TEND(:, IRSWETH) - PRH_TEND(:, IRGWETH) - PRH_TEND(:, IRCWETH)
-END WHERE
-
-PRCDRYH(:) = 0.
-PRIDRYH(:) = 0.
-PRSDRYH(:) = 0.
-PRRDRYH(:) = 0.
-PRGDRYH(:) = 0.
-PRDRYHG(:) = 0.
ZRDRYHG(:)=0.
IF(LCONVHG)THEN
- WHERE(LLDRYH(:))
+ WHERE(ZDRYH(:)==1.)
ZRDRYHG(:)=ZRDRYH_INIT(:)*ZRWETH_INIT(:)/(ZRDRYH_INIT(:)+ZRWETH_INIT(:))
END WHERE
ENDIF
-WHERE(LLDRYH(:)) ! Dry
- PRCDRYH(:) = PRH_TEND(:, IRCWETH)
- PRIDRYH(:) = PRH_TEND(:, IRIDRYH)
- PRSDRYH(:) = PRH_TEND(:, IRSDRYH)
- PRRDRYH(:) = PRH_TEND(:, IRRWETH)
- PRGDRYH(:) = PRH_TEND(:, IRGDRYH)
- PRDRYHG(:) = ZRDRYHG(:)
-END WHERE
-PA_RC(:) = PA_RC(:) - PRCWETH(:)
-PA_RI(:) = PA_RI(:) - PRIWETH(:)
-PA_RS(:) = PA_RS(:) - PRSWETH(:)
-PA_RG(:) = PA_RG(:) - PRGWETH(:)
-PA_RH(:) = PA_RH(:) + PRCWETH(:)+PRIWETH(:)+PRSWETH(:)+PRGWETH(:)+PRRWETH
-PA_RR(:) = PA_RR(:) - PRRWETH(:)
-PA_TH(:) = PA_TH(:) + (PRRWETH(:)+PRCWETH(:))*(PLSFACT(:)-PLVFACT(:))
-PA_RC(:) = PA_RC(:) - PRCDRYH(:)
-PA_RI(:) = PA_RI(:) - PRIDRYH(:)
-PA_RS(:) = PA_RS(:) - PRSDRYH(:)
-PA_RR(:) = PA_RR(:) - PRRDRYH(:)
-PA_RG(:) = PA_RG(:) - PRGDRYH(:) + PRDRYHG(:)
-PA_RH(:) = PA_RH(:) + PRCDRYH(:)+PRIDRYH(:)+PRSDRYH(:)+PRRDRYH(:)+PRGDRYH(:) - PRDRYHG(:)
-PA_TH(:) = PA_TH(:) + (PRCDRYH(:)+PRRDRYH(:))*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, ISIZE
+ PRCWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRCWETH)
+ PRIWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRIWETH)
+ PRSWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRSWETH)
+ PRGWETH(JL) = ZWETH(JL) * PRH_TEND(JL, IRGWETH)
+ !Collected minus aggregated
+ PRRWETH(JL) = ZWETH(JL) * (ZRWETH_INIT(JL) - PRH_TEND(JL, IRIWETH) - &
+ PRH_TEND(JL, IRSWETH) - PRH_TEND(JL, IRGWETH) - &
+ PRH_TEND(JL, IRCWETH))
+
+ PRCDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRCWETH)
+ PRIDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRIDRYH)
+ PRSDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRSDRYH)
+ PRRDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRRWETH)
+ PRGDRYH(JL) = ZDRYH(JL) * PRH_TEND(JL, IRGDRYH)
+ PRDRYHG(JL) = ZDRYH(JL) * ZRDRYHG(JL)
+
+ PA_RC(JL) = PA_RC(JL) - PRCWETH(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIWETH(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSWETH(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGWETH(JL)
+ PA_RH(JL) = PA_RH(JL) + PRCWETH(JL)+PRIWETH(JL)+PRSWETH(JL)+PRGWETH(JL)+PRRWETH(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRWETH(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRRWETH(JL)+PRCWETH(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RC(JL) = PA_RC(JL) - PRCDRYH(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIDRYH(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSDRYH(JL)
+ PA_RR(JL) = PA_RR(JL) - PRRDRYH(JL)
+ PA_RG(JL) = PA_RG(JL) - PRGDRYH(JL) + PRDRYHG(JL)
+ PA_RH(JL) = PA_RH(JL) + PRCDRYH(JL)+PRIDRYH(JL)+PRSDRYH(JL)+&
+ &PRRDRYH(JL)+PRGDRYH(JL) - PRDRYHG(JL)
+ PA_TH(JL) = PA_TH(JL) + (PRCDRYH(JL)+PRRDRYH(JL))*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 7.5 Melting of the hailstones
!
-GMASK(:)=PRHT(:)>XRTMIN(7) .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(7)-PRHT(JL))) * & ! WHERE(PRHT(:)>XRTMIN(7))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRHMLTR(:) = 0.
- END WHERE
+ DO JL=1, ISIZE
+ PRHMLTR(JL)=ZMASK(JL)*PRHMLTR(JL)
+ ENDDO
ELSE
- PRHMLTR(:) = 0.0
- WHERE(GMASK(:))
- PRHMLTR(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- END WHERE
+ DO JL=1, ISIZE
+ PRHMLTR(JL) = ZMASK(JL)* PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
PRHMLTR(:)=MIN(PRHMLTR(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
#else
@@ -713,12 +761,12 @@ ELSE
#endif
END WHERE
ENDIF
- WHERE(GMASK(:))
- PRHMLTR(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-PRHMLTR(:))/(XRV*PT(:)) )
- END WHERE
- WHERE(GMASK(:))
+ DO JL=1, ISIZE
+ PRHMLTR(JL) = ZMASK(JL)* (PKA(JL)*(XTT-PT(JL)) + &
+ ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ *(XESTT-PRHMLTR(JL))/(XRV*PT(JL)) ))
+ ENDDO
+ WHERE(ZMASK(:)==1.)
!
! compute RHMLTR
!
@@ -735,9 +783,11 @@ ELSE
( PRHODREF(:)*XLMTT ) )
END WHERE
END IF
-PA_RR(:) = PA_RR(:) + PRHMLTR(:)
-PA_RH(:) = PA_RH(:) - PRHMLTR(:)
-PA_TH(:) = PA_TH(:) - PRHMLTR(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, ISIZE
+ PA_RR(JL) = PA_RR(JL) + PRHMLTR(JL)
+ PA_RH(JL) = PA_RH(JL) - PRHMLTR(JL)
+ PA_TH(JL) = PA_TH(JL) - PRHMLTR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!$acc end kernels
!
IF (MPPDB_INITIALIZED) THEN
diff --git a/src/MNH/ice4_fast_ri.f90 b/src/MNH/ice4_fast_ri.f90
index 8cf210904c938d28a407eb6b16628ecb9062c076..d542b63134791edeaf75c3e5bab8835d103e9fa6 100644
--- a/src/MNH/ice4_fast_ri.f90
+++ b/src/MNH/ice4_fast_ri.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_FAST_RI
INTERFACE
-SUBROUTINE ICE4_FAST_RI(LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RI(LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&PAI, PCJ, PCIT, &
&PSSI, &
@@ -17,15 +18,13 @@ SUBROUTINE ICE4_FAST_RI(LDSOFT, LDCOMPUTE, &
USE MODD_CST
USE MODD_RAIN_ICE_PARAM
USE MODD_RAIN_ICE_DESCR
-USE MODI_BUDGET
-USE MODD_BUDGET
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT
@@ -42,7 +41,7 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
END SUBROUTINE ICE4_FAST_RI
END INTERFACE
END MODULE MODI_ICE4_FAST_RI
-SUBROUTINE ICE4_FAST_RI(LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RI(LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&PAI, PCJ, PCIT, &
&PSSI, &
@@ -79,7 +78,7 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT
@@ -96,17 +95,18 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RI
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(:), allocatable :: GMASK
-REAL, DIMENSION(:), allocatable :: ZZW
+INTEGER :: ISIZE
+INTEGER :: JL
+REAL, DIMENSION(:), allocatable :: ZMASK
!
!-------------------------------------------------------------------------------
!
-!$acc data present(LDCOMPUTE,PRHODREF,PLVFACT,PLSFACT,PAI,PCJ,PCIT, &
+!$acc data present(PCOMPUTE,PRHODREF,PLVFACT,PLSFACT,PAI,PCJ,PCIT, &
!$acc& PSSI,PRCT,PRIT,PRCBERI,PA_TH,PA_RC,PA_RI)
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK1D_LOG(LDCOMPUTE,"ICE4_FAST_RI beg:LDCOMPUTE")
+ CALL MPPDB_CHECK1D(PCOMPUTE,"ICE4_FAST_RI beg:PCOMPUTE")
CALL MPPDB_CHECK1D(PRHODREF,"ICE4_FAST_RI beg:PRHODREF",PRECISION)
CALL MPPDB_CHECK1D(PLVFACT,"ICE4_FAST_RI beg:PLVFACT",PRECISION)
CALL MPPDB_CHECK1D(PLSFACT,"ICE4_FAST_RI beg:PLSFACT",PRECISION)
@@ -123,24 +123,30 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK1D(PA_RI,"ICE4_FAST_RI beg:PA_RI",PRECISION)
END IF
-allocate( gmask( size( prhodref ) ) )
-allocate( zzw ( size( prhodref ) ) )
+ISIZE = Size( PRHODREF )
+
+allocate( zmask( size( prhodref ) ) )
-!$acc data create(GMASK,ZZW)
+!$acc data create(ZMASK)
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
!$acc kernels
-GMASK(:)=PSSI(:)>0. .AND. PRCT(:)>XRTMIN(2) .AND. PRIT(:)>XRTMIN(4) .AND. &
- &PCIT(:)>0. .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., -PSSI(JL))) * & ! PSSI(:)>0.
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., 1.E-20-PCIT(JL))) * & ! PCIT(:)>0.
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCBERI(:) = 0.
- END WHERE
+ DO JL=1, ISIZE
+ PRCBERI(JL) = PRCBERI(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRCBERI(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
PRCBERI(:) = MIN(1.E8, XLBI*(PRHODREF(:)*PRIT(:)/PCIT(:))**XLBEXI) ! Lbda_i
PRCBERI(:) = ( PSSI(:) / (PRHODREF(:)*PAI(:)) ) * PCIT(:) * &
@@ -152,9 +158,12 @@ ELSE
#endif
END WHERE
ENDIF
-PA_RC(:) = PA_RC(:) - PRCBERI(:)
-PA_RI(:) = PA_RI(:) + PRCBERI(:)
-PA_TH(:) = PA_TH(:) + PRCBERI(:)*(PLSFACT(:)-PLVFACT(:))
+
+DO JL=1, ISIZE
+ PA_RC(JL) = PA_RC(JL) - PRCBERI(JL)
+ PA_RI(JL) = PA_RI(JL) + PRCBERI(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCBERI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!$acc end kernels
!
IF (MPPDB_INITIALIZED) THEN
diff --git a/src/MNH/ice4_fast_rs.f90 b/src/MNH/ice4_fast_rs.f90
index 4e505659e5bea067f276502b77f4f6bea59f8386..34b81adff11ed5f1df41404640fc30c0691bdf52 100644
--- a/src/MNH/ice4_fast_rs.f90
+++ b/src/MNH/ice4_fast_rs.f90
@@ -1,11 +1,11 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
MODULE MODI_ICE4_FAST_RS
INTERFACE
-SUBROUTINE ICE4_FAST_RS(LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RS(LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAR, PLBDAS, &
@@ -18,7 +18,7 @@ SUBROUTINE ICE4_FAST_RS(LDSOFT, LDCOMPUTE, &
&PA_TH, PA_RC, PA_RR, PA_RS, PA_RG)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT
@@ -51,7 +51,7 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
END SUBROUTINE ICE4_FAST_RS
END INTERFACE
END MODULE MODI_ICE4_FAST_RS
-SUBROUTINE ICE4_FAST_RS(LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_FAST_RS(LDSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&PDV, PKA, PCJ, &
&PLBDAR, PLBDAS, &
@@ -81,7 +81,8 @@ SUBROUTINE ICE4_FAST_RS(LDSOFT, LDCOMPUTE, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XCI,XCL,XCPV,XESTT,XGAMI,XGAMW,XLMTT,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XCI,XCL,XCPV,XESTT,XGAMI,XGAMW,XLMTT,XLVTT,XMD,XMV,XRV,XTT, &
+ XEPSILO
USE MODD_PARAM_ICE, ONLY: LEVLIMIT, CSNOWRIMING
USE MODD_RAIN_ICE_DESCR, ONLY: XBS,XCEXVT,XCXS,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: NACCLBDAR,NACCLBDAS,NGAMINC,X0DEPS,X1DEPS,XACCINTP1R,XACCINTP1S,XACCINTP2R,XACCINTP2S, &
@@ -100,8 +101,8 @@ IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
-LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+LOGICAL, INTENT(IN) :: LDSOFT
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT
@@ -134,27 +135,30 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
!
!* 0.2 declaration of local variables
!
-INTEGER, PARAMETER :: IRCRIMS=1, IRCRIMSS=2, IRSRIMCG=3, IRRACCS=4, IRRACCSS=5, IRSACCRG=6
+INTEGER, PARAMETER :: IRCRIMS=1, IRCRIMSS=2, IRSRIMCG=3, IRRACCS=4, IRRACCSS=5, IRSACCRG=6, &
+ & IFREEZ1=7, IFREEZ2=8
!
INTEGER :: IGRIM, IGACC
-INTEGER :: IDX, JJ
+INTEGER :: ISIZE
+INTEGER :: IDX, JJ, JL
INTEGER, DIMENSION(:), allocatable :: I1
INTEGER, DIMENSION(:), allocatable :: IVEC1, IVEC2
-LOGICAL, DIMENSION(:), allocatable :: GRIM, GACC, GMASK
+LOGICAL, DIMENSION(:), allocatable :: GRIM, GACC
+REAL, DIMENSION(:), allocatable :: ZRIM, ZACC, ZMASK
REAL, DIMENSION(:), allocatable :: ZVEC1, ZVEC2, ZVEC3
REAL, DIMENSION(:), allocatable :: ZZW, ZZW2, ZZW6, ZFREEZ_RATE
! real, DIMENSION(:), allocatable :: xprov
-!$acc data present( LDCOMPUTE, PRHODREF, PLVFACT, PLSFACT, PPRES, PDV, PKA, PCJ, &
-!$acc& PLBDAR, PLBDAS, PT, PRVT, PRCT, PRRT, PRST, PRIAGGS, PRCRIMSS, PRCRIMSG, PRSRIMCG, &
-!$acc& PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, PRCMLTSR, PRS_TEND, PA_TH, &
+!$acc data present( PCOMPUTE, PRHODREF, PLVFACT, PLSFACT, PPRES, PDV, PKA, PCJ, &
+!$acc& PLBDAR, PLBDAS, PT, PRVT, PRCT, PRRT, PRST, PRIAGGS, PRCRIMSS, PRCRIMSG, PRSRIMCG, &
+!$acc& PRRACCSS, PRRACCSG, PRSACCRG, PRSMLTG, PRCMLTSR, PRS_TEND, PA_TH, &
!$acc& PA_RC, PA_RR, PA_RS, PA_RG )
!
!-------------------------------------------------------------------------------
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK1D_LOG(LDCOMPUTE,"ICE4_FAST_RS beg:LDCOMPUTE")
+ CALL MPPDB_CHECK1D(PCOMPUTE,"ICE4_FAST_RS beg:PCOMPUTE")
CALL MPPDB_CHECK1D(PRHODREF,"ICE4_FAST_RS beg:PRHODREF",PRECISION)
CALL MPPDB_CHECK1D(PLVFACT,"ICE4_FAST_RS beg:PLVFACT",PRECISION)
CALL MPPDB_CHECK1D(PLSFACT,"ICE4_FAST_RS beg:PLSFACT",PRECISION)
@@ -181,12 +185,16 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK1D(PA_RG,"ICE4_FAST_RS beg:PA_RG",PRECISION)
END IF
+ISIZE = Size( PRHODREF )
+
allocate( i1 ( size( prhodref ) ) )
allocate( ivec1 ( size( prhodref ) ) )
allocate( ivec2 ( size( prhodref ) ) )
allocate( grim ( size( prhodref ) ) )
allocate( gacc ( size( prhodref ) ) )
-allocate( gmask ( size( prhodref ) ) )
+allocate( zrim ( size( prhodref ) ) )
+allocate( zacc ( size( prhodref ) ) )
+allocate( zmask ( size( prhodref ) ) )
allocate( zvec1 ( size( prhodref ) ) )
allocate( zvec2 ( size( prhodref ) ) )
allocate( zvec3 ( size( prhodref ) ) )
@@ -196,52 +204,68 @@ allocate( zzw6 ( size( prhodref ) ) )
allocate( zfreez_rate ( size( prhodref ) ) )
!
-!$acc data create( I1, IVEC1, IVEC2, GRIM, GACC, GMASK, ZVEC1, ZVEC2, ZVEC3, ZZW, ZZW2, ZZW6, ZFREEZ_RATE )
+!$acc data create( I1, IVEC1, IVEC2, GRIM, GACC, ZRIM, ZACC, ZMASK, ZVEC1, ZVEC2, ZVEC3, ZZW, ZZW2, ZZW6, ZFREEZ_RATE )
!
!* 5.0 maximum freezing rate
!
!$acc kernels
-ZFREEZ_RATE(:)=0.
-GMASK(:)=PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:)
-WHERE(GMASK(:))
- ZFREEZ_RATE(:)=PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
-END WHERE
-IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JL)
+ENDDO
+IF(LDSOFT) THEN
+ DO JL=1, ISIZE
+ PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRS_TEND(JL, IFREEZ1)
+ PRS_TEND(JL, IFREEZ2)=ZMASK(JL) * PRS_TEND(JL, IFREEZ2)
+ ENDDO
+ELSE
+ DO JL=1, ISIZE
+ PRS_TEND(JL, IFREEZ1)=ZMASK(JL) * PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
+ IF(LEVLIMIT) THEN
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
- ZFREEZ_RATE(:)=MIN(ZFREEZ_RATE(:), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
+ PRS_TEND(:, IFREEZ1)=MIN(PRS_TEND(:, IFREEZ1), EXP(XALPI-XBETAI/PT(:)-XGAMI*ALOG(PT(:)))) ! min(ev, es_i(T))
#else
- ZFREEZ_RATE(:)=MIN(ZFREEZ_RATE(:), BR_EXP(XALPI-XBETAI/PT(:)-XGAMI*BR_LOG(PT(:)))) ! min(ev, es_i(T))
+ PRS_TEND(:, IFREEZ1)=MIN(PRS_TEND(:, IFREEZ1), BR_EXP(XALPI-XBETAI/PT(:)-XGAMI*BR_LOG(PT(:)))) ! min(ev, es_i(T))
#endif
- END WHERE
-ENDIF
-WHERE(GMASK(:))
- ZFREEZ_RATE(:)=PKA(:)*(XTT-PT(:)) + &
- (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
- *(XESTT-ZFREEZ_RATE(:))/(XRV*PT(:)) )
- ZFREEZ_RATE(:)=MAX(0., &
+ END WHERE
+ ENDIF
+ PRS_TEND(:, IFREEZ2)=0.
+ WHERE(ZMASK(:)==1.)
+ PRS_TEND(:, IFREEZ1)=PKA(:)*(XTT-PT(:)) + &
+ (PDV(:)*(XLVTT+(XCPV-XCL)*(PT(:)-XTT)) &
+ *(XESTT-PRS_TEND(:, IFREEZ1))/(XRV*PT(:)) )
#ifndef MNH_BITREP
- (ZFREEZ_RATE(:) * ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
- X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS ) + &
+ PRS_TEND(:, IFREEZ1)=PRS_TEND(:, IFREEZ1)* ( X0DEPS* PLBDAS(:)**XEX0DEPS + &
+ X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )/ &
#else
- (ZFREEZ_RATE(:) * ( X0DEPS* BR_POW(PLBDAS(:),XEX0DEPS) + &
- X1DEPS*PCJ(:)*BR_POW(PLBDAS(:),XEX1DEPS) ) + &
+ PRS_TEND(:, IFREEZ1)=PRS_TEND(:, IFREEZ1)* ( X0DEPS* BR_POW(PLBDAS(:),XEX0DEPS) + &
+ X1DEPS*PCJ(:)*BR_POW(PLBDAS(:),XEX1DEPS) )/ &
#endif
- PRIAGGS(:) * &
- (PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) ) / &
- ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) ) )
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ PRS_TEND(:, IFREEZ2)=(PRHODREF(:)*(XLMTT+(XCI-XCL)*(XTT-PT(:))) ) / &
+ ( PRHODREF(:)*(XLMTT-XCL*(XTT-PT(:))) )
+ END WHERE
+ENDIF
+DO JL=1, ISIZE
!We must agregate, at least, the cold species
!And we are only interested by the freezing rate of liquid species
- ZFREEZ_RATE(:)=MAX(ZFREEZ_RATE(:)-PRIAGGS(:), 0.)
-END WHERE
+ ZFREEZ_RATE(JL)=ZMASK(JL) * MAX(0., MAX(0., PRS_TEND(JL, IFREEZ1) + &
+ &PRS_TEND(JL, IFREEZ2) * PRIAGGS(JL)) - &
+ PRIAGGS(JL))
+ENDDO
!
!* 5.1 cloud droplet riming of the aggregates
!
IGRIM = 0
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GRIM)
- IF (PRCT(JJ)>XRTMIN(2) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
+ ZRIM(JJ)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JJ))) * & !WHERE(PRCT(:)>XRTMIN(2))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (ZRIM(JJ)>0) THEN
!$acc atomic capture
IGRIM = IGRIM + 1
IDX = IGRIM
@@ -261,11 +285,11 @@ IF(JJ==-999) print *,'PW: IGRIM=',IGRIM,COUNT(GRIM)
! Collection of cloud droplets by snow: this rate is used for riming (T<0) and for conversion/melting (T>0)
IF(LDSOFT) THEN
!$acc kernels
- WHERE(.NOT. GRIM(:))
- PRS_TEND(:, IRCRIMS)=0.
- PRS_TEND(:, IRCRIMSS)=0.
- PRS_TEND(:, IRSRIMCG)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRS_TEND(JL, IRCRIMS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMS)
+ PRS_TEND(JL, IRCRIMSS)=ZRIM(JL) * PRS_TEND(JL, IRCRIMSS)
+ PRS_TEND(JL, IRSRIMCG)=ZRIM(JL) * PRS_TEND(JL, IRSRIMCG)
+ ENDDO
!$acc end kernels
ELSE
!$acc kernels
@@ -377,37 +401,38 @@ ELSE
ENDIF
!
!$acc kernels
-GRIM(:) = GRIM(:) .AND. PT(:)<XTT ! More restrictive GRIM mask to be used for riming by negative temperature only
-PRCRIMSS(:)=0.
-PRCRIMSG(:)=0.
-PRSRIMCG(:)=0.
-WHERE(GRIM(:))
- PRCRIMSS(:) = MIN(ZFREEZ_RATE(:), PRS_TEND(:, IRCRIMSS))
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRCRIMSS(:))
- ZZW(:) = MIN(1., ZFREEZ_RATE(:) / MAX(1.E-20, PRS_TEND(:, IRCRIMS) - PRCRIMSS(:))) ! proportion we are able to freeze
- PRCRIMSG(:) = ZZW(:) * MAX(0., PRS_TEND(:, IRCRIMS) - PRCRIMSS(:)) ! RCRIMSG
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRCRIMSG(:))
- PRSRIMCG(:) = ZZW(:) * PRS_TEND(:, IRSRIMCG)
-END WHERE
-GMASK(:) = PRCRIMSG(:)<=0.
-WHERE(GMASK(:))
- PRCRIMSG(:)=0.
- PRSRIMCG(:)=0.
-END WHERE
-PA_RC(:) = PA_RC(:) - PRCRIMSS(:)
-PA_RS(:) = PA_RS(:) + PRCRIMSS(:)
-PA_TH(:) = PA_TH(:) + PRCRIMSS(:)*(PLSFACT(:)-PLVFACT(:))
-PA_RC(:) = PA_RC(:) - PRCRIMSG(:)
-PA_RS(:) = PA_RS(:) - PRSRIMCG(:)
-PA_RG(:) = PA_RG(:) + PRCRIMSG(:)+PRSRIMCG(:)
-PA_TH(:) = PA_TH(:) + PRCRIMSG(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, ISIZE
+ ! More restrictive RIM mask to be used for riming by negative temperature only
+ ZRIM(JL)=ZRIM(JL) * &
+ &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ PRCRIMSS(JL)=ZRIM(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRCRIMSS))
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSS(JL))
+ ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL))) ! proportion we are able to freeze
+ PRCRIMSG(JL) = ZRIM(JL) * ZZW(JL) * MAX(0., PRS_TEND(JL, IRCRIMS) - PRCRIMSS(JL)) ! RCRIMSG
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRCRIMSG(JL))
+ PRSRIMCG(JL) = ZRIM(JL) * ZZW(JL) * PRS_TEND(JL, IRSRIMCG)
+
+ PRSRIMCG(JL) = PRSRIMCG(JL) * MAX(0., -SIGN(1., -PRCRIMSG(JL)))
+ PRCRIMSG(JL)=MAX(0., PRCRIMSG(JL))
+
+ PA_RC(JL) = PA_RC(JL) - PRCRIMSS(JL)
+ PA_RS(JL) = PA_RS(JL) + PRCRIMSS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCRIMSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RC(JL) = PA_RC(JL) - PRCRIMSG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSRIMCG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRCRIMSG(JL)+PRSRIMCG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCRIMSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 5.2 rain accretion onto the aggregates
!
IGACC = 0
!$acc loop private(IDX) independent
DO JJ = 1, SIZE(GACC)
- IF (PRRT(JJ)>XRTMIN(3) .AND. PRST(JJ)>XRTMIN(5) .AND. LDCOMPUTE(JJ)) THEN
+ ZACC(JJ)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JJ))) * & !WHERE(PRRT(:)>XRTMIN(3))
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JJ))) * & !WHERE(PRST(:)>XRTMIN(5))
+ &PCOMPUTE(JJ)
+ IF (ZACC(JJ)>0) THEN
!$acc atomic capture
IGACC = IGACC + 1
IDX = IGACC
@@ -425,12 +450,11 @@ IF(JJ==-999) print *,'PW: IGACC=',IGACC,COUNT(GACC)
! !$acc kernels
IF(LDSOFT) THEN
!$acc kernels
- GMASK(:) = .NOT. GACC(:)
- WHERE(GMASK(:))
- PRS_TEND(:, IRRACCS)=0.
- PRS_TEND(:, IRRACCSS)=0.
- PRS_TEND(:, IRSACCRG)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRS_TEND(JL, IRRACCS)=ZACC(JL) * PRS_TEND(JL, IRRACCS)
+ PRS_TEND(JL, IRRACCSS)=ZACC(JL) * PRS_TEND(JL, IRRACCSS)
+ PRS_TEND(JL, IRSACCRG)=ZACC(JL) * PRS_TEND(JL, IRSACCRG)
+ ENDDO
!$acc end kernels
ELSE
!$acc kernels
@@ -563,48 +587,48 @@ ELSE
ENDIF
!$acc kernels
!
-GACC(:) = GACC(:) .AND. PT(:)<XTT ! More restrictive GACC mask to be used for accretion by negative temperature only
-PRRACCSS(:)=0.
-PRRACCSG(:)=0.
-PRSACCRG(:)=0.
-WHERE(GACC(:))
- PRRACCSS(:) = MIN(ZFREEZ_RATE(:), PRS_TEND(:, IRRACCSS))
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRRACCSS(:))
- ZZW(:) = MIN(1., ZFREEZ_RATE(:) / MAX(1.E-20, PRS_TEND(:, IRRACCS)-PRRACCSS(:))) ! proportion we are able to freeze
- PRRACCSG(:)=ZZW(:) * MAX(0., PRS_TEND(:, IRRACCS)-PRRACCSS(:))
- ZFREEZ_RATE(:) = MAX(0., ZFREEZ_RATE(:)-PRRACCSG(:))
- PRSACCRG(:)=ZZW(:) * PRS_TEND(:, IRSACCRG)
-END WHERE
-GMASK(:) = PRRACCSG(:)<=0.
-WHERE(GMASK(:))
- PRRACCSG(:)=0.
- PRSACCRG(:)=0.
-END WHERE
-PA_RR(:) = PA_RR(:) - PRRACCSS(:)
-PA_RS(:) = PA_RS(:) + PRRACCSS(:)
-PA_TH(:) = PA_TH(:) + PRRACCSS(:)*(PLSFACT(:)-PLVFACT(:))
-PA_RR(:) = PA_RR(:) - PRRACCSG(:)
-PA_RS(:) = PA_RS(:) - PRSACCRG(:)
-PA_RG(:) = PA_RG(:) + PRRACCSG(:)+PRSACCRG(:)
-PA_TH(:) = PA_TH(:) + PRRACCSG(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, ISIZE
+ ! More restrictive ACC mask to be used for accretion by negative temperature only
+ ZACC(JL) = ZACC(JL) * &
+ &MAX(0., -SIGN(1., PT(JL)-XTT)) ! WHERE(PT(:)<XTT)
+ PRRACCSS(JL)=ZACC(JL)*MIN(ZFREEZ_RATE(JL), PRS_TEND(JL, IRRACCSS))
+ ZFREEZ_RATE(JL)=MAX(0., ZFREEZ_RATE(JL)-PRRACCSS(JL))
+ ZZW(JL) = MIN(1., ZFREEZ_RATE(JL) / MAX(1.E-20, PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))) ! proportion we are able to freeze
+ PRRACCSG(JL)=ZACC(JL)*ZZW(JL) * MAX(0., PRS_TEND(JL, IRRACCS)-PRRACCSS(JL))
+ ZFREEZ_RATE(JL) = MAX(0., ZFREEZ_RATE(JL)-PRRACCSG(JL))
+ PRSACCRG(JL)=ZACC(JL)*ZZW(JL) * PRS_TEND(JL, IRSACCRG)
+
+ PRSACCRG(JL) = PRSACCRG(JL) * MAX(0., -SIGN(1., -PRRACCSG(JL)))
+ PRRACCSG(JL)=MAX(0., PRRACCSG(JL))
+
+ PA_RR(JL) = PA_RR(JL) - PRRACCSS(JL)
+ PA_RS(JL) = PA_RS(JL) + PRRACCSS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRRACCSS(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ PA_RR(JL) = PA_RR(JL) - PRRACCSG(JL)
+ PA_RS(JL) = PA_RS(JL) - PRSACCRG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRRACCSG(JL)+PRSACCRG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRRACCSG(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!
!* 5.3 Conversion-Melting of the aggregates
!
-GMASK(:)=PRST(:)>XRTMIN(5) .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! WHERE(PRST(:)>XRTMIN(5))
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! WHERE(PT(:)>XTT)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRSMLTG(:) = 0.
- PRCMLTSR(:) = 0.
- END WHERE
+ DO JL=1, ISIZE
+ PRSMLTG(JL)=ZMASK(JL)*PRSMLTG(JL)
+ PRCMLTSR(JL)=ZMASK(JL)*PRCMLTSR(JL)
+ ENDDO
ELSE
- PRSMLTG(:) = 0.
- PRCMLTSR(:) = 0.
- WHERE(GMASK(:))
- PRSMLTG(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
- END WHERE
+ DO JL=1, ISIZE
+ PRSMLTG(JL)=ZMASK(JL)*PRVT(JL)*PPRES(JL)/(XEPSILO+PRVT(JL)) ! Vapor pressure
+ ENDDO
IF(LEVLIMIT) THEN
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
PRSMLTG(:)=MIN(PRSMLTG(:), EXP(XALPW-XBETAW/PT(:)-XGAMW*ALOG(PT(:)))) ! min(ev, es_w(T))
#else
@@ -612,10 +636,15 @@ ELSE
#endif
END WHERE
ENDIF
- WHERE(GMASK(:))
- PRSMLTG(:) = PKA(:)*(XTT-PT(:)) + &
- ( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT )) &
- *(XESTT-PRSMLTG(:))/(XRV*PT(:)) )
+ DO JL=1, ISIZE
+ PRSMLTG(JL)=ZMASK(JL)*( &
+ & PKA(JL)*(XTT-PT(JL)) + &
+ & ( PDV(JL)*(XLVTT + ( XCPV - XCL ) * ( PT(JL) - XTT )) &
+ & *(XESTT-PRSMLTG(JL))/(XRV*PT(JL)) ) &
+ &)
+ ENDDO
+ PRCMLTSR(:) = 0.
+ WHERE(ZMASK(:)==1.)
!
! compute RSMLT
!
@@ -630,21 +659,22 @@ ELSE
( PRS_TEND(:, IRCRIMS) + PRS_TEND(:, IRRACCS) ) * &
( PRHODREF(:)*XCL*(XTT-PT(:))) ) / &
( PRHODREF(:)*XLMTT ) )
- !
- ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
- ! because the graupeln produced by this process are still icy!!!
- !
! When T < XTT, rc is collected by snow (riming) to produce snow and graupel
! When T > XTT, if riming was still enabled, rc would produce snow and graupel with snow becomming graupel (conversion/melting) and graupel becomming rain (melting)
- ! To insure consistency when crossint T=XTT, rc collected with T>XTT must be transformed in rain.
+ ! To insure consistency when crossing T=XTT, rc collected with T>XTT must be transformed in rain.
! rc cannot produce iced species with a positive temperature but is still collected with a good efficiency by snow
PRCMLTSR(:) = PRS_TEND(:, IRCRIMS) ! both species are liquid, no heat is exchanged
END WHERE
ENDIF
-PA_RS(:) = PA_RS(:) - PRSMLTG(:)
-PA_RG(:) = PA_RG(:) + PRSMLTG(:)
-PA_RC(:) = PA_RC(:) - PRCMLTSR(:)
-PA_RR(:) = PA_RR(:) + PRCMLTSR(:)
+
+DO JL=1, ISIZE
+ ! note that RSCVMG = RSMLT*XFSCVMG but no heat is exchanged (at the rate RSMLT)
+ ! because the graupeln produced by this process are still icy!!!
+ PA_RS(JL) = PA_RS(JL) - PRSMLTG(JL)
+ PA_RG(JL) = PA_RG(JL) + PRSMLTG(JL)
+ PA_RC(JL) = PA_RC(JL) - PRCMLTSR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCMLTSR(JL)
+ENDDO
!$acc end kernels
IF (MPPDB_INITIALIZED) THEN
diff --git a/src/MNH/ice4_nucleation.f90 b/src/MNH/ice4_nucleation.f90
index 8bb722565ce4bf8eec33a937b825515144f5b7fd..91e8a9a49320da158e176e301e5dd0db87d1b844 100644
--- a/src/MNH/ice4_nucleation.f90
+++ b/src/MNH/ice4_nucleation.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.
@@ -48,7 +48,7 @@ SUBROUTINE ICE4_NUCLEATION(ODSOFT, ODCOMPUTE, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMI,XGAMW,XMD,XMV,XTT
+USE MODD_CST, ONLY: XALPI,XALPW,XBETAI,XBETAW,XGAMI,XGAMW,XMD,XMV,XTT,XEPSILO
USE MODD_PARAM_ICE, ONLY: LFEEDBACKT
USE MODD_RAIN_ICE_PARAM, ONLY: XALPHA1,XALPHA2,XBETA1,XBETA2,XMNU0,XNU10,XNU20
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
@@ -139,7 +139,7 @@ IF(.NOT. ODSOFT) THEN
END WHERE
WHERE(GNEGT(:))
ZZW(:)=MIN(PPABST(:)/2., ZZW(:)) ! safety limitation
- ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / ((XMV/XMD)*ZZW(:)) - 1.0
+ ZSSI(:)=PRVT(:)*(PPABST(:)-ZZW(:)) / (XEPSILO*ZZW(:)) - 1.0
! Supersaturation over ice
ZUSW(:)=MIN(PPABST(:)/2., ZUSW(:)) ! safety limitation
ZUSW(:)=(ZUSW(:)/ZZW(:))*((PPABST(:)-ZZW(:))/(PPABST(:)-ZUSW(:))) - 1.0
diff --git a/src/MNH/ice4_nucleation_wrapper.f90 b/src/MNH/ice4_nucleation_wrapper.f90
index 3851d5b77dcdc98a101b3e889ad3459fe1cd62b9..c19bc25290320383c06ed618144e22c24351d62f 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.
@@ -142,11 +142,6 @@ ALLOCATE(ZB_RI(INEGT))
!$acc data create(GLDCOMPUTE,I1,I2,I3,ZZT,ZPRES,ZRVT,ZCIT,ZTHT, &
!$acc& ZRHODREF,ZEXN,ZLSFACT,ZRVHENI_MR,ZB_TH,ZB_RV,ZB_RI)
-!$acc kernels
-ZB_TH(:) = 0.
-ZB_RV(:) = 0.
-ZB_RI(:) = 0.
-!$acc end kernels
!
#ifndef MNH_OPENACC
IF(INEGT>0) INEGT_TMP=COUNTJV(GNEGT(:,:,:), I1(:), I2(:), I3(:))
@@ -172,6 +167,9 @@ IF(INEGT>0) THEN
ENDDO
GDSOFT = .FALSE.
GLDCOMPUTE(:) = ZZT(:)<XTT
+ ZB_TH(:) = 0.
+ ZB_RV(:) = 0.
+ ZB_RI(:) = 0.
!$acc end kernels
CALL ICE4_NUCLEATION(GDSOFT, GLDCOMPUTE, &
ZTHT, ZPRES, ZRHODREF, ZEXN, ZLSFACT, ZZT, &
diff --git a/src/MNH/ice4_rainfr_vert.f90 b/src/MNH/ice4_rainfr_vert.f90
index f05ebd3d5b18dfe6791997b6d96069e6b6203db8..a851b3ef86bb0189e3c4d6674e7ffc6b52365b0b 100644
--- a/src/MNH/ice4_rainfr_vert.f90
+++ b/src/MNH/ice4_rainfr_vert.f90
@@ -1,19 +1,22 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
MODULE MODI_ICE4_RAINFR_VERT
INTERFACE
-SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR)
+SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR, PRS, PRG, PRH)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRFR !Precipitation fraction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRR !Rain field
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRS !Snow field
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRG !Graupel field
+REAL, DIMENSION(:,:,:), OPTIONAL,INTENT(IN) :: PRH !Hail field
END SUBROUTINE ICE4_RAINFR_VERT
END INTERFACE
END MODULE MODI_ICE4_RAINFR_VERT
-SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR)
+SUBROUTINE ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PPRFR, PRR, PRS, PRG, PRH)
!!
!!** PURPOSE
!! -------
@@ -43,32 +46,46 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPRFR !Precipitation fraction
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRR !Rain field
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRS !Snow field
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRG !Graupel field
+REAL, DIMENSION(:,:,:), OPTIONAL,INTENT(IN) :: PRH !Hail field
!
!* 0.2 declaration of local variables
!
INTEGER :: JI, JJ, JK
+LOGICAL :: MASK
!
! !$acc data copyin( XRTMIN )
!
!-------------------------------------------------------------------------------
!
-!$acc data present(PPRFR, PRR)
+!$acc data present(PPRFR, PRR, PRS, PRG, PRH)
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
CALL MPPDB_CHECK3D(PRR,"ICE4_RAINFR_VERT beg:PRR",PRECISION)
+ CALL MPPDB_CHECK3D(PRS,"ICE4_RAINFR_VERT beg:PRS",PRECISION)
+ CALL MPPDB_CHECK3D(PRG,"ICE4_RAINFR_VERT beg:PRG",PRECISION)
+ IF ( PRESENT(PRH) ) CALL MPPDB_CHECK3D(PRH,"ICE4_RAINFR_VERT beg:PRH",PRECISION)
!Check all INOUT arrays
CALL MPPDB_CHECK3D(PPRFR,"ICE4_RAINFR_VERT beg:PPRFR",PRECISION)
END IF
!
!$acc kernels
PPRFR(KIB:KIE,KJB:KJE,KKE)=0.
-DO JK=KKE-1, KKB, -1
+DO JK=KKE-KKL, KKB, -KKL
!$acc loop collapse(2) independent
DO JJ = KJB, KJE
DO JI = KIB,KIE
- IF (PRR(JI,JJ,JK) .GT. XRTMIN(3)) THEN
- PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+1))
+ IF(PRESENT(PRH)) THEN
+ MASK=PRR(JI,JJ,JK) .GT. XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. XRTMIN(5) &
+ .OR. PRG(JI,JJ,JK) .GT. XRTMIN(6) .OR. PRH(JI,JJ,JK) .GT. XRTMIN(7)
+ ELSE
+ MASK=PRR(JI,JJ,JK) .GT. XRTMIN(3) .OR. PRS(JI,JJ,JK) .GT. XRTMIN(5) &
+ .OR. PRG(JI,JJ,JK) .GT. XRTMIN(6)
+ END IF
+ IF (MASK) THEN
+ PPRFR(JI,JJ,JK)=MAX(PPRFR(JI,JJ,JK),PPRFR(JI,JJ,JK+KKL))
IF (PPRFR(JI,JJ,JK)==0) THEN
PPRFR(JI,JJ,JK)=1.
END IF
diff --git a/src/MNH/ice4_rimltc.f90 b/src/MNH/ice4_rimltc.f90
index 89e00d7554eb99c9ce76ab6ab86e9f94f79105ac..971a2ac6ae74af0ce7cf7a2f2671356c1833a60f 100644
--- a/src/MNH/ice4_rimltc.f90
+++ b/src/MNH/ice4_rimltc.f90
@@ -1,18 +1,18 @@
-!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(LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RIMLTC(LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, &
&PTHT, PRIT, &
&PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -26,7 +26,7 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PB_RI
END SUBROUTINE ICE4_RIMLTC
END INTERFACE
END MODULE MODI_ICE4_RIMLTC
-SUBROUTINE ICE4_RIMLTC(LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RIMLTC(LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, &
&PTHT, PRIT, &
@@ -58,7 +58,7 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -72,13 +72,17 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PB_RI
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(:), allocatable :: GMASK
+INTEGER :: ISIZE
+INTEGER :: JL
+REAL, DIMENSION(:), allocatable :: ZMASK
-!$acc data present(LDCOMPUTE,PEXN,PLVFACT,PLSFACT,PT, &
+!$acc data present(PCOMPUTE,PEXN,PLVFACT,PLSFACT,PT, &
!$acc& PTHT,PRIT,PRIMLTC_MR,PB_TH,PB_RC,PB_RI)
+!
!-------------------------------------------------------------------------------
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
+ CALL MPPDB_CHECK(PCOMPUTE,"ICE4_RIMLTC beg:PCOMPUTE")
CALL MPPDB_CHECK(PEXN,"ICE4_RIMLTC beg:PEXN")
CALL MPPDB_CHECK(PLVFACT,"ICE4_RIMLTC beg:PLVFACT")
CALL MPPDB_CHECK(PLSFACT,"ICE4_RIMLTC beg:PLSFACT")
@@ -91,30 +95,36 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PB_RI,"ICE4_RIMLTC beg:PB_RI")
END IF
-allocate( gmask(size( ldcompute ) ) )
+isize = Size( pcompute )
+
+allocate( zmask(isize) )
-!$acc data create(GMASK)
+!$acc data create(ZMASK)
!
!* 7.1 cloud ice melting
!
!$acc kernels
PRIMLTC_MR(:)=0.
IF(.NOT. LDSOFT) THEN
- GMASK(:)=PRIT(:)>0. .AND. PT(:)>XTT .AND. LDCOMPUTE(:)
- WHERE(GMASK(:))
- PRIMLTC_MR(:)=PRIT(:)
- END WHERE
+ DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., -PRIT(JL))) * & ! PRIT(:)>0.
+ &MAX(0., -SIGN(1., XTT-PT(JL))) * & ! PT(:)>XTT
+ &PCOMPUTE(JL)
+ PRIMLTC_MR(JL)=PRIT(JL) * ZMASK(JL)
+ ENDDO
IF(LFEEDBACKT) THEN
!Limitation due to 0 crossing of temperature
- WHERE(GMASK(:))
- PRIMLTC_MR(:)=MIN(PRIMLTC_MR(:), MAX(0., (PTHT(:)-XTT/PEXN(:)) / (PLSFACT(:)-PLVFACT(:))))
- END WHERE
+ DO JL=1, ISIZE
+ PRIMLTC_MR(JL)=MIN(PRIMLTC_MR(JL), MAX(0., (PTHT(JL)-XTT/PEXN(JL)) / (PLSFACT(JL)-PLVFACT(JL))))
+ ENDDO
ENDIF
ENDIF
-PB_RC(:) = PB_RC(:) + PRIMLTC_MR(:)
-PB_RI(:) = PB_RI(:) - PRIMLTC_MR(:)
-PB_TH(:) = PB_TH(:) - PRIMLTC_MR(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, ISIZE
+ PB_RC(JL) = PB_RC(JL) + PRIMLTC_MR(JL)
+ PB_RI(JL) = PB_RI(JL) - PRIMLTC_MR(JL)
+ PB_TH(JL) = PB_TH(JL) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!$acc end kernels
!
IF (MPPDB_INITIALIZED) THEN
diff --git a/src/MNH/ice4_rrhong.f90 b/src/MNH/ice4_rrhong.f90
index 2d3eb71c8876d419990c45469b610dd8bc833e96..7e4857821edf579d8a3eb627b167275c9bd1af09 100644
--- a/src/MNH/ice4_rrhong.f90
+++ b/src/MNH/ice4_rrhong.f90
@@ -1,18 +1,18 @@
-!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(LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RRHONG(LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, PRRT, &
&PTHT, &
&PRRHONG_MR, PB_TH, PB_RR, PB_RG)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -26,7 +26,7 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PB_RG
END SUBROUTINE ICE4_RRHONG
END INTERFACE
END MODULE MODI_ICE4_RRHONG
-SUBROUTINE ICE4_RRHONG(LDSOFT, LDCOMPUTE, &
+SUBROUTINE ICE4_RRHONG(LDSOFT, PCOMPUTE, &
&PEXN, PLVFACT, PLSFACT, &
&PT, PRRT, &
&PTHT, &
@@ -59,7 +59,7 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PEXN ! Exner function
REAL, DIMENSION(:), INTENT(IN) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(:), INTENT(IN) :: PLSFACT ! L_s/(Pi_ref*C_ph)
@@ -73,13 +73,16 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PB_RG
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(:), allocatable :: GMASK
+INTEGER :: ISIZE
+INTEGER :: JL
+REAL, DIMENSION(:), allocatable :: ZMASK
!
-!$acc data present(LDCOMPUTE,PEXN,PLVFACT,PLSFACT,PT,PRRT,PTHT, &
+!$acc data present(PCOMPUTE,PEXN,PLVFACT,PLSFACT,PT,PRRT,PTHT, &
!$acc& PRRHONG_MR,PB_TH,PB_RR,PB_RG)
!-------------------------------------------------------------------------------
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
+ CALL MPPDB_CHECK(PCOMPUTE,"ICE4_RRHONG beg:PCOMPUTE")
CALL MPPDB_CHECK(PEXN,"ICE4_RRHONG beg:PEXN")
CALL MPPDB_CHECK(PLVFACT,"ICE4_RRHONG beg:PLVFACT")
CALL MPPDB_CHECK(PLSFACT,"ICE4_RRHONG beg:PLSFACT")
@@ -92,29 +95,35 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PB_RG,"ICE4_RRHONG beg:PB_RG")
END IF
-allocate( gmask(size( prrt ) ) )
+isize = Size( prrt )
-!$acc data create(GMASK)
+allocate( zmask(isize) )
+
+!$acc data create(ZMASK)
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
!$acc kernels
PRRHONG_MR(:) = 0.
-IF(LDSOFT) THEN
- GMASK(:)=PT(:)<XTT-35.0 .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
- WHERE(GMASK(:))
- PRRHONG_MR(:) = PRRT(:)
- ENDWHERE
+IF(.NOT. LDSOFT) THEN
+ DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ PRRHONG_MR(JL)=PRRT(JL) * ZMASK(JL)
+ ENDDO
IF(LFEEDBACKT) THEN
!Limitation due to -35 crossing of temperature
- WHERE(GMASK(:))
- PRRHONG_MR(:)=MIN(PRRHONG_MR(:), MAX(0., ((XTT-35.)/PEXN(:)-PTHT)/(PLSFACT(:)-PLVFACT(:))))
- ENDWHERE
+ DO JL=1, ISIZE
+ PRRHONG_MR(JL)=MIN(PRRHONG_MR(JL), MAX(0., ((XTT-35.)/PEXN(JL)-PTHT(JL))/(PLSFACT(JL)-PLVFACT(JL))))
+ ENDDO
ENDIF
ENDIF
-PB_RG(:) = PB_RG(:) + PRRHONG_MR(:)
-PB_RR(:) = PB_RR(:) - PRRHONG_MR(:)
-PB_TH(:) = PB_TH(:) + PRRHONG_MR(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, ISIZE
+ PB_RG(JL) = PB_RG(JL) + PRRHONG_MR(JL)
+ PB_RR(JL) = PB_RR(JL) - PRRHONG_MR(JL)
+ PB_TH(JL) = PB_TH(JL) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!$acc end kernels
!
IF (MPPDB_INITIALIZED) THEN
diff --git a/src/MNH/ice4_rsrimcg_old.f90 b/src/MNH/ice4_rsrimcg_old.f90
index e25119dbc7996071095613ff7505029fd455428a..8bd8a116133ea101d425cfb2f2a0e618c541e4b6 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.
@@ -131,7 +131,7 @@ IF(.NOT. ODSOFT) THEN
END IF
END DO
!
- IF(IGRIM>0 .AND. CSNOWRIMING=='OLD ') THEN
+ IF(IGRIM>0) THEN
!
! 5.1.1 select the PLBDAS
!
@@ -173,8 +173,8 @@ IF(.NOT. ODSOFT) THEN
PRSRIMCG_MR(:) = XSRIMCG * BR_POW(PLBDAS(:),XEXSRIMCG) & ! RSRIMCG
#endif
* (1.0 - ZZW(:) )/PRHODREF(:)
+ PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:))
END WHERE
- PRSRIMCG_MR(:)=MIN(PRST(:), PRSRIMCG_MR(:))
END IF
ENDIF
PB_RS(:) = PB_RS(:) - PRSRIMCG_MR(:)
diff --git a/src/MNH/ice4_sedimentation_split_old.f90 b/src/MNH/ice4_sedimentation_split_old.f90
deleted file mode 100644
index 47095b89e40dd5e36d700b22d0c611e22130bade..0000000000000000000000000000000000000000
--- a/src/MNH/ice4_sedimentation_split_old.f90
+++ /dev/null
@@ -1,463 +0,0 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-MODULE MODI_ICE4_SEDIMENTATION_SPLIT_OLD
-INTERFACE
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, KSPLITR, &
- &PSEA, PTOWN, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PINPRH, PRHT, PRHS, PFPR)
-IMPLICIT NONE
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step integration for rain sedimendation
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-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) :: 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
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD
-END INTERFACE
-END MODULE MODI_ICE4_SEDIMENTATION_SPLIT_OLD
-SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT, KKL, &
- &PTSTEP, KRR, OSEDIC, KSPLITR, &
- &PSEA, PTOWN, PDZZ, &
- &PRHODREF, PPABST, PTHT, PRHODJ, &
- &PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
- &PINPRC, PINPRR, PINPRI, PINPRS, PINPRG, &
- &PINPRH, PRHT, PRHS, PFPR)
-!!
-!!** PURPOSE
-!! -------
-!! Computes the sedimentation
-!!
-!! AUTHOR
-!! ------
-!! S. Riette from the plitting of rain_ice source code (nov. 2014)
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BUDGET
-USE MODD_CST
-USE MODD_RAIN_ICE_DESCR
-USE MODD_RAIN_ICE_PARAM
-
-USE MODE_MSG
-use mode_tools, only: Countjv
-
-USE MODI_BUDGET
-USE MODI_GAMMA
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB, KKTE, KKT
-INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-REAL, INTENT(IN) :: PTSTEP ! Double Time step (single if cold start)
-INTEGER, INTENT(IN) :: KRR ! Number of moist variable
-LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step integration for rain sedimendation
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
-REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PDZZ ! Layer thikness (m)
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST ! absolute pressure at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-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) :: 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
-REAL, DIMENSION(KIT,KJT), INTENT(OUT) :: PINPRG ! Graupel instant precip
-REAL, DIMENSION(KIT,KJT), OPTIONAL, INTENT(OUT) :: PINPRH ! Hail instant precip
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
-REAL, DIMENSION(KIT,KJT,KKT), OPTIONAL, INTENT(INOUT) :: PRHS ! Hail m.r. source
-REAL, DIMENSION(KIT,KJT,KKT,KRR), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitation fluxes
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: GSEDIM ! Test where to compute the SED processes
-INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
-
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D, & ! droplet condensation
- & ZRAY, & ! Cloud Mean radius
- & ZLBC, & ! XLBC weighted by sea fraction
- & ZFSEDC, &
- & ZPRCS,ZPRRS,ZPRIS,ZPRSS,ZPRGS,ZPRHS, & ! Mixing ratios created during the time step
- & ZW, & ! work array
- & ZRCT, &
- & ZRRT, &
- & ZRIT, &
- & ZRST, &
- & ZRGT, &
- & ZRHT
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) :: ZWSED ! sedimentation fluxes
-REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: ZCONC_TMP ! Weighted concentration
-REAL :: ZINVTSTEP
-INTEGER :: ISEDIM ! ! Case number of sedimentation
-REAL :: ZTSPLITR ! Small time step for rain sedimentation
-INTEGER :: JJ, JK, JN, JL
-!-------------------------------------------------------------------------------
-!
-!-------------------------------------------------------------------------------
-!
-!
-! O. Initialization of for sedimentation
-!
-ZINVTSTEP=1./PTSTEP
-ZTSPLITR=PTSTEP/REAL(KSPLITR)
-IF (OSEDIC) PINPRC (:,:) = 0.
-PINPRR (:,:) = 0.
-PINPRI (:,:) = 0.
-PINPRS (:,:) = 0.
-PINPRG (:,:) = 0.
-IF ( KRR == 7 ) PINPRH (:,:) = 0.
-!
-!* 1. Parameters for cloud sedimentation
-!
-IF (OSEDIC) THEN
- ZRAY(:,:,:) = 0.
- ZCONC_TMP(:,:)=PSEA(:,:)*XCONC_SEA+(1.-PSEA(:,:))*XCONC_LAND
-
- DO JK=KKTB, KKTE
- ZLBC(:,:,JK) = PSEA(:,:)*XLBC(2)+(1.-PSEA(:,:))*XLBC(1)
- ZFSEDC(:,:,JK) = (PSEA(:,:)*XFSEDC(2)+(1.-PSEA(:,:))*XFSEDC(1))
- ZFSEDC(:,:,JK) = MAX(MIN(XFSEDC(1),XFSEDC(2)),ZFSEDC(:,:,JK))
- ZCONC3D(:,:,JK)= (1.-PTOWN(:,:))*ZCONC_TMP(:,:)+PTOWN(:,:)*XCONC_URBAN
- ZRAY(:,:,JK) = 0.5*((1.-PSEA(:,:))*GAMMA(XNUC+1.0/XALPHAC)/(GAMMA(XNUC)) + &
- PSEA(:,:)*GAMMA(XNUC2+1.0/XALPHAC2)/(GAMMA(XNUC2)))
- END DO
- ZRAY(:,:,:) = MAX(1.,ZRAY(:,:,:))
- ZLBC(:,:,:) = MAX(MIN(XLBC(1),XLBC(2)),ZLBC(:,:,:))
-ENDIF
-!
-!* 2. compute the fluxes
-!
-! optimization by looking for locations where
-! the precipitating fields are larger than a minimal value only !!!
-! For optimization we consider each variable separately
-!
-! External tendecies
-IF (OSEDIC) ZPRCS(:,:,:) = PRCS(:,:,:)-PRCT(:,:,:)* ZINVTSTEP
-ZPRRS(:,:,:) = PRRS(:,:,:)-PRRT(:,:,:)* ZINVTSTEP
-ZPRIS(:,:,:) = PRIS(:,:,:)-PRIT(:,:,:)* ZINVTSTEP
-ZPRSS(:,:,:) = PRSS(:,:,:)-PRST(:,:,:)* ZINVTSTEP
-ZPRGS(:,:,:) = PRGS(:,:,:)-PRGT(:,:,:)* ZINVTSTEP
-IF ( KRR == 7 ) ZPRHS(:,:,:) = PRHS(:,:,:)-PRHT(:,:,:)* ZINVTSTEP
-!
-! mr values inside the time-splitting loop
-ZRCT(:,:,:) = PRCT(:,:,:)
-ZRRT(:,:,:) = PRRT(:,:,:)
-ZRIT(:,:,:) = PRIT(:,:,:)
-ZRST(:,:,:) = PRST(:,:,:)
-ZRGT(:,:,:) = PRGT(:,:,:)
-IF (KRR==7) ZRHT(:,:,:) = PRHT(:,:,:)
-!
-DO JK = KKTB , KKTE
- ZW(:,:,JK) =ZTSPLITR/(PRHODREF(:,:,JK)* PDZZ(:,:,JK))
-END DO
-!
-DO JN = 1 , KSPLITR
- !We add part of the external tendencies
- IF (OSEDIC) ZRCT(:,:,:) = ZRCT(:,:,:) + ZPRCS(:,:,:)*ZTSPLITR
- ZRRT(:,:,:) = ZRRT(:,:,:) + ZPRRS(:,:,:)*ZTSPLITR
- ZRIT(:,:,:) = ZRIT(:,:,:) + ZPRIS(:,:,:)*ZTSPLITR
- ZRST(:,:,:) = ZRST(:,:,:) + ZPRSS(:,:,:)*ZTSPLITR
- ZRGT(:,:,:) = ZRGT(:,:,:) + ZPRGS(:,:,:)*ZTSPLITR
- IF (KRR==7) ZRHT(:,:,:) = ZRHT(:,:,:) + ZPRHS(:,:,:)*ZTSPLITR
- !
- !
- !* 2.1 for cloud
- !
- IF (OSEDIC) THEN
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRCT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(2)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &2, &
- &ZRCT, PRCS, ZWSED, &
- &ZRAY, ZLBC, ZFSEDC, ZCONC3D)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,2)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRC(:,:) = PINPRC(:,:) + ZWSED(:,:,KKB) / XRHOLW / KSPLITR
- END IF
- !
- !* 2.2 for rain
- !
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRRT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(3)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &3, &
- &ZRRT, PRRS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,3)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRR(:,:) = PINPRR(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
- !
- !* 2.3 for pristine ice
- !
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRIT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(4)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &4, &
- &ZRIT, PRIS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,4)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRI(:,:) = PINPRI(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
- !
- !* 2.4 for aggregates/snow
- !
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRST(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(5)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &5, &
- &ZRST, PRSS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,5)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRS(:,:) = PINPRS(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
- !
- !* 2.5 for graupeln
- !
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRGT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(6)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &6, &
- &ZRGT, PRGS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,6)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRG(:,:) = PINPRG(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
- !
- !* 2.6 for hail
- !
- IF ( KRR == 7 ) THEN
- GSEDIM(:,:,:)=.FALSE.
- GSEDIM(KIB:KIE,KJB:KJE,KKTB:KKTE) = &
- ZRHT(KIB:KIE,KJB:KJE,KKTB:KKTE)>XRTMIN(7)
- ISEDIM = COUNTJV(GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- CALL INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &ISEDIM, GSEDIM, I1, I2, I3, &
- &PRHODREF, ZW, PPABST, PTHT, PSEA, PTOWN, ZTSPLITR, PTSTEP, &
- &7, &
- &ZRHT, PRHS, ZWSED)
- IF (PRESENT(PFPR)) THEN
- DO JK = KKTB , KKTE
- PFPR(:,:,JK,7)=ZWSED(:,:,JK)
- ENDDO
- ENDIF
- PINPRH(:,:) = PINPRH(:,:) + ZWSED(:,:,KKB)/XRHOLW/KSPLITR
- END IF
- !
-END DO
-!
-!
-CONTAINS
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
- SUBROUTINE INTERNAL_SEDIM_SPLI(KIT, KJT, KKT, KKL, &
- &KSEDIM, LDSEDIM, I1, I2, I3, &
- &PRHODREF, PTSORHODZ, PPABST, PTHT, PSEA, PTOWN, PTSTEP, PTOTAL_TSTEP, &
- &KSPE, &
- &PRXT, PRXS, PWSED, &
- &PRAY, PLBC, PFSEDC, PCONC3D)
- !
- !* 0. DECLARATIONS
- ! ------------
- !
- USE MODD_RAIN_ICE_DESCR
- USE MODD_RAIN_ICE_PARAM
- !
- IMPLICIT NONE
- !
- !* 0.1 Declarations of dummy arguments :
- !
- INTEGER, INTENT(IN) :: KIT, KJT, KKT, KKL
- INTEGER, INTENT(IN) :: KSEDIM
- LOGICAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: LDSEDIM
- INTEGER, DIMENSION(KSEDIM), INTENT(IN) :: I1, I2, I3
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PRHODREF ! Reference density
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTSORHODZ ! TimeStep Over (Rhodref time delta Z)
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PPABST
- REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PSEA ! Sea Mask
- REAL, DIMENSION(KIT,KJT), INTENT(IN) :: PTOWN ! Fraction that is town
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN) :: PTHT
- REAL, INTENT(IN) :: PTSTEP ! small timestep
- REAL, INTENT(IN) :: PTOTAL_TSTEP ! total timestep
- INTEGER, INTENT(IN) :: KSPE ! 1 for rc, 2 for rr...
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXT ! mr of specy X
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(INOUT) :: PRXS !Tendency of the specy KSPE
- REAL, DIMENSION(KIT,KJT,0:KKT+1), INTENT(OUT) :: PWSED ! sedimentation flux
- REAL, DIMENSION(KIT,KJT,KKT), INTENT(IN), OPTIONAL :: PRAY, PLBC, PFSEDC, PCONC3D
- !
- !* 0.2 declaration of local variables
- !
- !
- character(len=10) :: yspe ! String for error message
- INTEGER :: JK, JL, JI, JJ
- REAL :: ZINVTOTAL_TSTEP
- REAL :: ZZWLBDC, ZRAY, ZZT, ZZWLBDA, ZZCC
- REAL :: ZFSED, ZEXSED
- REAL, DIMENSION(KIT, KJT) :: ZMRCHANGE
- !
- !-------------------------------------------------------------------------------
- !
- !
- !* 1. Parameters for cloud sedimentation
- !
- !
- !* 2. compute the fluxes
- !
- !
- ZINVTOTAL_TSTEP = 1./PTOTAL_TSTEP
- PWSED(:,:,:) = 0.
- IF(KSPE==2) THEN
- !******* for cloud
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- ZZWLBDC = PLBC(JI,JJ,JK) * PCONC3D(JI,JJ,JK) / &
- (PRHODREF(JI,JJ,JK) * PRXT(JI,JJ,JK))
- ZZWLBDC = ZZWLBDC**XLBEXC
- ZRAY = PRAY(JI,JJ,JK) / ZZWLBDC
- ZZT = PTHT(JI,JJ,JK) * (PPABST(JI,JJ,JK)/XP00)**(XRD/XCPD)
- ZZWLBDA = 6.6E-8*(101325./PPABST(JI,JJ,JK))*(ZZT/293.15)
- ZZCC = XCC*(1.+1.26*ZZWLBDA/ZRAY)
- PWSED(JI, JJ, JK) = PRHODREF(JI,JJ,JK)**(-XCEXVT +1 ) * &
- ZZWLBDC**(-XDC)*ZZCC*PFSEDC(JI,JJ,JK) * PRXT(JI,JJ,JK)
- ENDDO
- ELSEIF(KSPE==4) THEN
- ! ******* for pristine ice
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- IF(PRXT(JI, JJ, JK) .GT. MAX(XRTMIN(4), 1.0E-7)) THEN
- PWSED(JI, JJ, JK) = XFSEDI * PRXT(JI, JJ, JK) * &
- & PRHODREF(JI,JJ,JK)**(1.-XCEXVT) * & ! McF&H
- & MAX( 0.05E6,-0.15319E6-0.021454E6* &
- & ALOG(PRHODREF(JI,JJ,JK)*PRXT(JI,JJ,JK)) )**XEXCSEDI
- ENDIF
- ENDDO
- ELSE
- ! ******* for other species
- IF(KSPE==3) THEN
- ZFSED=XFSEDR
- ZEXSED=XEXSEDR
- ELSEIF(KSPE==5) THEN
- ZFSED=XFSEDS
- ZEXSED=XEXSEDS
- ELSEIF(KSPE==6) THEN
- ZFSED=XFSEDG
- ZEXSED=XEXSEDG
- ELSEIF(KSPE==7) THEN
- ZFSED=XFSEDH
- ZEXSED=XEXSEDH
- ELSE
- write( yspe, '( I10 )' ) kspe
- call Print_msg( NVERB_FATAL, 'GEN', 'ICE4_SEDIMENTATION_SPLIT_OLD', &
- 'no sedimentation parameter for KSPE='//trim(yspe) )
- ENDIF
- DO JL=1, KSEDIM
- JI=I1(JL)
- JJ=I2(JL)
- JK=I3(JL)
- PWSED(JI, JJ, JK) = ZFSED * PRXT(JI, JJ, JK)**ZEXSED * &
- PRHODREF(JI, JJ, JK)**(ZEXSED-XCEXVT)
- ENDDO
- ENDIF
- ZMRCHANGE(:,:) = 0.
- DO JK = KKTB , KKTE
- ZMRCHANGE(:,:) = PTSORHODZ(:,:,JK)*(PWSED(:,:,JK+KKL)-PWSED(:,:,JK))
- PRXT(:,:,JK) = PRXT(:,:,JK) + ZMRCHANGE(:,:)
- PRXS(:,:,JK) = PRXS(:,:,JK) + ZMRCHANGE(:,:) * ZINVTOTAL_TSTEP
- ENDDO
- END SUBROUTINE INTERNAL_SEDIM_SPLI
- !
-END SUBROUTINE ICE4_SEDIMENTATION_SPLIT_OLD
diff --git a/src/MNH/ice4_sedimentation_stat.f90 b/src/MNH/ice4_sedimentation_stat.f90
index 4194c36771a7ffb1141be74f0eb81b2f7a684921..3cbb31493eac8295e718f2e1438e4e3a269520e7 100644
--- a/src/MNH/ice4_sedimentation_stat.f90
+++ b/src/MNH/ice4_sedimentation_stat.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.
@@ -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
@@ -74,18 +74,16 @@ SUBROUTINE ICE4_SEDIMENTATION_STAT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKTB,
!!
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 21/01/2021: initialize untouched part of PFPR
!
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
USE MODD_CST
USE MODE_MSG
-USE MODI_BUDGET
-
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -112,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
@@ -141,6 +139,12 @@ LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)):: GDEP
!-------------------------------------------------------------------------------
!
ZINVTSTEP=1./PTSTEP
+
+IF ( PRESENT( PFPR ) ) THEN
+ !Set to 0. to avoid undefined values (in files)
+ PFPR(:, :, : KKTB - 1, :) = 0.
+ PFPR(:, :, KKTE + 1 :, :) = 0.
+END IF
!-------------------------------------------------------------------------------
!
!* 1. compute the fluxes
diff --git a/src/MNH/ice4_slow.f90 b/src/MNH/ice4_slow.f90
index af1f43627c9a07fa46a40413452da6ef798ad610..575fdfdb001052b7b67be97d6f871287f0543cfd 100644
--- a/src/MNH/ice4_slow.f90
+++ b/src/MNH/ice4_slow.f90
@@ -1,20 +1,20 @@
-!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(LDSOFT, LDCOMPUTE, PRHODREF, PT,&
+SUBROUTINE ICE4_SLOW(LDSOFT, PCOMPUTE, PRHODREF, PT,&
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT,&
&PLBDAS, PLBDAG,&
- &PAI, PCJ,&
+ &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(:), INTENT(IN) :: PSSI ! Supersaturation over ice
@@ -29,6 +29,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDAS ! Slope parameter of the agg
REAL, DIMENSION(:), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
REAL, DIMENSION(:), INTENT(IN) :: PAI ! Thermodynamical function
REAL, DIMENSION(:), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(:), INTENT(IN) :: PHLI_HCF !
+REAL, DIMENSION(:), INTENT(IN) :: PHLI_HRI !
REAL, DIMENSION(:), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
REAL, DIMENSION(:), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
REAL, DIMENSION(:), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
@@ -43,11 +45,11 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
END SUBROUTINE ICE4_SLOW
END INTERFACE
END MODULE MODI_ICE4_SLOW
-SUBROUTINE ICE4_SLOW(LDSOFT, LDCOMPUTE, PRHODREF, PT, &
+SUBROUTINE ICE4_SLOW(LDSOFT, PCOMPUTE, PRHODREF, PT, &
&PSSI, PLVFACT, PLSFACT, &
&PRVT, PRCT, PRIT, PRST, PRGT, &
&PLBDAS, PLBDAG, &
- &PAI, PCJ, &
+ &PAI, PCJ, PHLI_HCF, PHLI_HRI,&
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
!!
@@ -83,7 +85,7 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:), INTENT(IN) :: PT ! Temperature
REAL, DIMENSION(:), INTENT(IN) :: PSSI ! Supersaturation over ice
@@ -98,6 +100,8 @@ REAL, DIMENSION(:), INTENT(IN) :: PLBDAS ! Slope parameter of the agg
REAL, DIMENSION(:), INTENT(IN) :: PLBDAG ! Slope parameter of the graupel distribution
REAL, DIMENSION(:), INTENT(IN) :: PAI ! Thermodynamical function
REAL, DIMENSION(:), INTENT(IN) :: PCJ ! Function to compute the ventilation coefficient
+REAL, DIMENSION(:), INTENT(IN) :: PHLI_HCF !
+REAL, DIMENSION(:), INTENT(IN) :: PHLI_HRI !
REAL, DIMENSION(:), INTENT(INOUT) :: PRCHONI ! Homogeneous nucleation
REAL, DIMENSION(:), INTENT(INOUT) :: PRVDEPS ! Deposition on r_s
REAL, DIMENSION(:), INTENT(INOUT) :: PRIAGGS ! Aggregation on r_s
@@ -112,19 +116,21 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RG
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(:), allocatable :: GMASK
-REAL, DIMENSION(:), allocatable :: ZCRIAUTI
-REAL :: ZTIMAUTIC
+INTEGER :: ISIZE
+INTEGER :: JL
+REAL, DIMENSION(:), allocatable :: ZMASK
+REAL, DIMENSION(:), allocatable :: ZCRIAUTI
+REAL :: ZTIMAUTIC
!
-!$acc data present(LDCOMPUTE,PRHODREF,PT,PSSI,PLVFACT,PLSFACT, &
+!$acc data present(PCOMPUTE,PRHODREF,PT,PSSI,PLVFACT,PLSFACT, &
!$acc& PRVT,PRCT,PRIT,PRST,PRGT,PLBDAS,PLBDAG,PAI,PCJ, &
-!$acc& PRCHONI,PRVDEPS,PRIAGGS,PRIAUTS,PRVDEPG, &
+!$acc& PHLI_HCF, PHLI_HRI, PRCHONI,PRVDEPS,PRIAGGS,PRIAUTS,PRVDEPG, &
!$acc& PA_TH,PA_RV,PA_RC,PA_RI,PA_RS,PA_RG )
!-------------------------------------------------------------------------------
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK(LDCOMPUTE,"ICE4_SLOW beg:LDCOMPUTE")
+ CALL MPPDB_CHECK(PCOMPUTE,"ICE4_SLOW beg:PCOMPUTE")
CALL MPPDB_CHECK(PRHODREF,"ICE4_SLOW beg:PRHODREF")
CALL MPPDB_CHECK(PT,"ICE4_SLOW beg:PT")
CALL MPPDB_CHECK(PSSI,"ICE4_SLOW beg:PSSI")
@@ -139,6 +145,8 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PLBDAG,"ICE4_SLOW beg:PLBDAG")
CALL MPPDB_CHECK(PAI,"ICE4_SLOW beg:PAI")
CALL MPPDB_CHECK(PCJ,"ICE4_SLOW beg:PCJ")
+ CALL MPPDB_CHECK(PHLI_HCF,"ICE4_SLOW beg:PHLI_HCF")
+ CALL MPPDB_CHECK(PHLI_HRI,"ICE4_SLOW beg:PHLI_HRI")
!Check all INOUT arrays
CALL MPPDB_CHECK(PRCHONI,"ICE4_SLOW beg:PRCHONI")
CALL MPPDB_CHECK(PRVDEPS,"ICE4_SLOW beg:PRVDEPS")
@@ -153,35 +161,42 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PA_RG,"ICE4_SLOW beg:PA_RG")
END IF
-allocate( gmask (size( prhodref ) ) )
+ISIZE = Size( PRHODREF )
+
+allocate( zmask (size( prhodref ) ) )
allocate( zcriauti(size( prhodref ) ) )
-!$acc data create(ZCRIAUTI,GMASK)
+!$acc data create(ZCRIAUTI,ZMASK)
!
!* 3.2 compute the homogeneous nucleation source: RCHONI
!
!$acc kernels
-GMASK(:)=PT(:)<XTT-35.0 .AND. PRCT(:)>XRTMIN(2) .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., PT(JL)-(XTT-35.0))) * & ! PT(:)<XTT-35.0
+ &MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCHONI(:) = 0.
- END WHERE
+ DO JL=1, ISIZE
+ PRCHONI(JL) = PRCHONI(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRCHONI(:) = 0.
- WHERE(GMASK(:))
- PRCHONI(:) = XHON*PRHODREF(:)*PRCT(:) &
+ WHERE(ZMASK(:)==1.)
+ PRCHONI(:) = MIN(1000.,XHON*PRHODREF(:)*PRCT(:) &
#ifndef MNH_BITREP
- *EXP( XALPHA3*(PT(:)-XTT)-XBETA3 )
+ *EXP( XALPHA3*(PT(:)-XTT)-XBETA3 ) )
#else
- *BR_EXP( XALPHA3*(PT(:)-XTT)-XBETA3 )
+ *BR_EXP( XALPHA3*(PT(:)-XTT)-XBETA3 ) )
#endif
ENDWHERE
ENDIF
-!
-PA_RI(:) = PA_RI(:) + PRCHONI(:)
-PA_RC(:) = PA_RC(:) - PRCHONI(:)
-PA_TH(:) = PA_TH(:) + PRCHONI(:)*(PLSFACT(:)-PLVFACT(:))
+DO JL=1, ISIZE
+ PA_RI(JL) = PA_RI(JL) + PRCHONI(JL)
+ PA_RC(JL) = PA_RC(JL) - PRCHONI(JL)
+ PA_TH(JL) = PA_TH(JL) + PRCHONI(JL)*(PLSFACT(JL)-PLVFACT(JL))
+ENDDO
!
!* 3.4 compute the deposition, aggregation and autoconversion sources
!
@@ -199,14 +214,18 @@ PA_TH(:) = PA_TH(:) + PRCHONI(:)*(PLSFACT(:)-PLVFACT(:))
!
!* 3.4.3 compute the deposition on r_s: RVDEPS
!
-GMASK(:)=PRVT(:)>XRTMIN(1) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & !PRVT(:)>XRTMIN(1)
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & !PRST(:)>XRTMIN(5)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRVDEPS(:) = 0.
- END WHERE
+ DO JL=1, ISIZE
+ PRVDEPS(JL)=PRVDEPS(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRVDEPS(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRVDEPS(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
#ifndef MNH_BITREP
( X0DEPS*PLBDAS(:)**XEX0DEPS + X1DEPS*PCJ(:)*PLBDAS(:)**XEX1DEPS )
@@ -215,20 +234,26 @@ ELSE
#endif
END WHERE
ENDIF
-PA_RS(:) = PA_RS(:) + PRVDEPS(:)
-PA_RV(:) = PA_RV(:) - PRVDEPS(:)
-PA_TH(:) = PA_TH(:) + PRVDEPS(:)*PLSFACT(:)
+DO JL=1, ISIZE
+ PA_RS(JL) = PA_RS(JL) + PRVDEPS(JL)
+ PA_RV(JL) = PA_RV(JL) - PRVDEPS(JL)
+ PA_TH(JL) = PA_TH(JL) + PRVDEPS(JL)*PLSFACT(JL)
+ENDDO
!
!* 3.4.4 compute the aggregation on r_s: RIAGGS
!
-GMASK(:)=PRIT(:)>XRTMIN(4) .AND. PRST(:)>XRTMIN(5) .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PRIT(JL))) * & ! PRIT(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., XRTMIN(5)-PRST(JL))) * & ! PRST(:)>XRTMIN(5)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRIAGGS(:) = 0.
- END WHERE
+ DO JL=1, ISIZE
+ PRIAGGS(JL)=PRIAGGS(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRIAGGS(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1)
#ifndef MNH_BITREP
PRIAGGS(:) = XFIAGGS * EXP( XCOLEXIS*(PT(:)-XTT) ) &
* PRIT(:) &
@@ -242,24 +267,31 @@ ELSE
#endif
END WHERE
ENDIF
-PA_RS(:) = PA_RS(:) + PRIAGGS(:)
-PA_RI(:) = PA_RI(:) - PRIAGGS(:)
+DO JL=1, ISIZE
+ PA_RS(JL) = PA_RS(JL) + PRIAGGS(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIAGGS(JL)
+ENDDO
!
!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
!
-GMASK(:)=PRIT(:)>XRTMIN(4) .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(4)-PHLI_HRI(JL))) * & ! PHLI_HRI(:)>XRTMIN(4)
+ &MAX(0., -SIGN(1., 1.E-20-PHLI_HCF(JL))) * & ! PHLI_HCF(:) .GT. 0.
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRIAUTS(:) = 0.
- END WHERE
+ DO JL=1, ISIZE
+ PRIAUTS(JL) = PRIAUTS(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRIAUTS(:) = 0.
!ZCRIAUTI(:)=MIN(XCRIAUTI,10**(0.06*(PT(:)-XTT)-3.5))
#ifndef MNH_BITREP
ZCRIAUTI(:)=MIN(XCRIAUTI,10**(XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI))
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRIAUTS(:) = XTIMAUTI * EXP( XTEXAUTI*(PT(:)-XTT) ) &
- * MAX( PRIT(:)-ZCRIAUTI(:),0.0 )
+ * MAX( PHLI_HRI(:)/PHLI_HCF(:)-ZCRIAUTI(:),0.0 )
+ PRIAUTS(:) = PHLI_HCF(:)*PRIAUTS(:)
END WHERE
#else
ZCRIAUTI(:)=MIN(XCRIAUTI,BR_POW(10.,XACRIAUTI*(PT(:)-XTT)+XBCRIAUTI))
@@ -269,20 +301,26 @@ ELSE
END WHERE
#endif
ENDIF
-PA_RS(:) = PA_RS(:) + PRIAUTS(:)
-PA_RI(:) = PA_RI(:) - PRIAUTS(:)
+DO JL=1, ISIZE
+ PA_RS(JL) = PA_RS(JL) + PRIAUTS(JL)
+ PA_RI(JL) = PA_RI(JL) - PRIAUTS(JL)
+ENDDO
!
!* 3.4.6 compute the deposition on r_g: RVDEPG
!
!
-GMASK(:)=PRVT(:)>XRTMIN(1) .AND. PRGT(:)>XRTMIN(6) .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(1)-PRVT(JL))) * & ! PRVT(:)>XRTMIN(1)
+ &MAX(0., -SIGN(1., XRTMIN(6)-PRGT(JL))) * & ! PRGT(:)>XRTMIN(6)
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRVDEPG(:) = 0.
- END WHERE
+ DO JL=1, ISIZE
+ PRVDEPG(JL) = PRVDEPG(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRVDEPG(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRVDEPG(:) = ( PSSI(:)/(PRHODREF(:)*PAI(:)) ) * &
#ifndef MNH_BITREP
( X0DEPG*PLBDAG(:)**XEX0DEPG + X1DEPG*PCJ(:)*PLBDAG(:)**XEX1DEPG )
@@ -291,9 +329,11 @@ ELSE
#endif
END WHERE
ENDIF
-PA_RG(:) = PA_RG(:) + PRVDEPG(:)
-PA_RV(:) = PA_RV(:) - PRVDEPG(:)
-PA_TH(:) = PA_TH(:) + PRVDEPG(:)*PLSFACT(:)
+DO JL=1, ISIZE
+ PA_RG(JL) = PA_RG(JL) + PRVDEPG(JL)
+ PA_RV(JL) = PA_RV(JL) - PRVDEPG(JL)
+ PA_TH(JL) = PA_TH(JL) + PRVDEPG(JL)*PLSFACT(JL)
+ENDDO
!$acc end kernels
!
IF (MPPDB_INITIALIZED) THEN
diff --git a/src/MNH/ice4_tendencies.f90 b/src/MNH/ice4_tendencies.f90
index 21f087303d9c60f3a5b80742cc6a63b870e8b4b6..6a1f086874ba354311616ff810cc469d920f90e3 100644
--- a/src/MNH/ice4_tendencies.f90
+++ b/src/MNH/ice4_tendencies.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -6,13 +6,14 @@
MODULE MODI_ICE4_TENDENCIES
INTERFACE
SUBROUTINE ICE4_TENDENCIES(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
- &KRR, ODSOFT, ODCOMPUTE, &
- &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, &
+ &KRR, ODSOFT, PCOMPUTE, &
+ &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PT, PTHT, &
- &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, PRRT3D, &
+ &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
&PRVHENI_MR, PRRHONG_MR, PRIMLTC_MR, PRSRIMCG_MR, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PRCAUTR, PRCACCR, PRREVAV, &
@@ -22,19 +23,21 @@ SUBROUTINE ICE4_TENDENCIES(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
&PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
&PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
&PRCBERI, &
- &PRS_TEND, PRG_TEND, PRH_TEND, &
+ &PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
&PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, &
&PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, &
- &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRAINFR)
+ &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ &PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRAINFR)
IMPLICIT NONE
INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
INTEGER, INTENT(IN) :: KRR
LOGICAL, INTENT(IN) :: ODSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: ODCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
LOGICAL, INTENT(IN) :: OWARM
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP
CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC
+CHARACTER(len=80), INTENT(IN) :: HSUBG_AUCV_RI
CHARACTER(len=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(:), INTENT(IN) :: PEXN
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
@@ -55,7 +58,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PRIT
REAL, DIMENSION(:), INTENT(IN) :: PRST
REAL, DIMENSION(:), INTENT(IN) :: PRGT
REAL, DIMENSION(:), INTENT(IN) :: PRHT
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT3D
REAL, DIMENSION(:), INTENT(IN) :: PSIGMA_RC
REAL, DIMENSION(:), INTENT(OUT) :: PRVHENI_MR
REAL, DIMENSION(:), INTENT(OUT) :: PRRHONG_MR
@@ -107,6 +109,7 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PRCBERI
REAL, DIMENSION(:, :), INTENT(INOUT) :: PRS_TEND
REAL, DIMENSION(:, :), INTENT(INOUT) :: PRG_TEND
REAL, DIMENSION(:, :), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(:), INTENT(OUT) :: PSSI
REAL, DIMENSION(:), INTENT(OUT) :: PA_TH
REAL, DIMENSION(:), INTENT(OUT) :: PA_RV
REAL, DIMENSION(:), INTENT(OUT) :: PA_RC
@@ -127,18 +130,23 @@ REAL, DIMENSION(:), INTENT(OUT) :: PHLC_HCF
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_LCF
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_HRC
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_LRC
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(:), INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(:), INTENT(OUT) :: PHLI_LCF
+REAL, DIMENSION(:), INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(:), INTENT(OUT) :: PHLI_LRI
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
END SUBROUTINE ICE4_TENDENCIES
END INTERFACE
END MODULE MODI_ICE4_TENDENCIES
SUBROUTINE ICE4_TENDENCIES(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
- &KRR, ODSOFT, ODCOMPUTE, &
- &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, HSUBG_AUCV_RC, HSUBG_PR_PDF, &
+ &KRR, ODSOFT, PCOMPUTE, &
+ &OWARM, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF, &
&PEXN, PRHODREF, PLVFACT, PLSFACT, K1, K2, K3, &
&PPRES, PCF, PSIGMA_RC, &
&PCIT, &
&PT, PTHT, &
- &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, PRRT3D, &
+ &PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PRHT, &
&PRVHENI_MR, PRRHONG_MR, PRIMLTC_MR, PRSRIMCG_MR, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PRCAUTR, PRCACCR, PRREVAV, &
@@ -148,10 +156,11 @@ SUBROUTINE ICE4_TENDENCIES(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
&PRCWETH, PRIWETH, PRSWETH, PRGWETH, PRRWETH, &
&PRCDRYH, PRIDRYH, PRSDRYH, PRRDRYH, PRGDRYH, PRDRYHG, PRHMLTR, &
&PRCBERI, &
- &PRS_TEND, PRG_TEND, PRH_TEND, &
+ &PRS_TEND, PRG_TEND, PRH_TEND, PSSI, &
&PA_TH, PA_RV, PA_RC, PA_RR, PA_RI, PA_RS, PA_RG, PA_RH, &
&PB_TH, PB_RV, PB_RC, PB_RR, PB_RI, PB_RS, PB_RG, PB_RH, &
- &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, PRAINFR)
+ &PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
+ &PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, PRAINFR)
!!
!!** PURPOSE
!! -------
@@ -170,7 +179,8 @@ SUBROUTINE ICE4_TENDENCIES(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPI,XBETAI,XCI,XCPV,XGAMI,XLSTT,XMD,XMV,XP00,XRV,XTT
+USE MODD_CST, ONLY: XALPI,XBETAI,XCI,XCPV,XEPSILO,XGAMI,XLSTT,XMD,XMV,XP00,XRV,XTT
+USE MODD_PARAM_ICE, ONLY: CSNOWRIMING
USE MODD_RAIN_ICE_DESCR, ONLY: XLBDAS_MAX,XLBEXG,XLBEXH,XLBEXR,XLBEXS,XLBG,XLBH,XLBR,XLBS,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: XSCFAC
!
@@ -200,11 +210,12 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL
INTEGER, INTENT(IN) :: KRR
LOGICAL, INTENT(IN) :: ODSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: ODCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
LOGICAL, INTENT(IN) :: OWARM
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP
CHARACTER(len=4), INTENT(IN) :: HSUBG_AUCV_RC
+CHARACTER(len=80), INTENT(IN) :: HSUBG_AUCV_RI
CHARACTER(len=80), INTENT(IN) :: HSUBG_PR_PDF ! pdf for subgrid precipitation
REAL, DIMENSION(:), INTENT(IN) :: PEXN
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF
@@ -225,7 +236,6 @@ REAL, DIMENSION(:), INTENT(IN) :: PRIT
REAL, DIMENSION(:), INTENT(IN) :: PRST
REAL, DIMENSION(:), INTENT(IN) :: PRGT
REAL, DIMENSION(:), INTENT(IN) :: PRHT
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT3D
REAL, DIMENSION(:), INTENT(IN) :: PSIGMA_RC
REAL, DIMENSION(:), INTENT(OUT) :: PRVHENI_MR
REAL, DIMENSION(:), INTENT(OUT) :: PRRHONG_MR
@@ -277,6 +287,7 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PRCBERI
REAL, DIMENSION(:, :), INTENT(INOUT) :: PRS_TEND
REAL, DIMENSION(:, :), INTENT(INOUT) :: PRG_TEND
REAL, DIMENSION(:, :), INTENT(INOUT) :: PRH_TEND
+REAL, DIMENSION(:), INTENT(OUT) :: PSSI
REAL, DIMENSION(:), INTENT(OUT) :: PA_TH
REAL, DIMENSION(:), INTENT(OUT) :: PA_RV
REAL, DIMENSION(:), INTENT(OUT) :: PA_RC
@@ -297,34 +308,39 @@ REAL, DIMENSION(:), INTENT(OUT) :: PHLC_HCF
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_LCF
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_HRC
REAL, DIMENSION(:), INTENT(OUT) :: PHLC_LRC
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
+REAL, DIMENSION(:), INTENT(OUT) :: PHLI_HCF
+REAL, DIMENSION(:), INTENT(OUT) :: PHLI_LCF
+REAL, DIMENSION(:), INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(:), INTENT(OUT) :: PHLI_LRI
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
!
!* 0.2 declaration of local variables
!
INTEGER :: IDX,JI,JJ,JK,JL
INTEGER :: ISIZE
-LOGICAL, DIMENSION(:), allocatable :: LLWETG
+REAL, DIMENSION(:), allocatable :: ZWETG ! 1. if graupel growths in wet mode, 0. otherwise
REAL, DIMENSION(:), allocatable :: ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- & ZT, ZTHT, &
+ & ZT, ZTHT, ZRHT, &
& ZZW, &
- & ZSSI, ZKA, ZDV, ZAI, ZCJ, &
+ & ZKA, ZDV, ZAI, ZCJ, &
& ZRF, &
& ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, ZLBDAR_RF, &
& ZRGSI, ZRGSI_MR
-REAL, DIMENSION(:,:,:), allocatable :: ZRRT3D
+REAL, DIMENSION(:,:,:), allocatable :: ZRRT3D, ZRST3D, ZRGT3D, ZRHT3D
!
-!$acc data present(ODCOMPUTE,PEXN,PRHODREF,PLVFACT,PLSFACT,K1,K2,K3,PPRES,PCF,PCIT,PT,PTHT, &
-!$acc& PRVT,PRCT,PRRT,PRIT,PRST,PRGT,PRHT,PRRT3D,PSIGMA_RC,PRVHENI_MR,PRRHONG_MR,PRIMLTC_MR, &
+!$acc data present(PCOMPUTE,PEXN,PRHODREF,PLVFACT,PLSFACT,K1,K2,K3,PPRES,PCF,PCIT,PT,PTHT, &
+!$acc& PRVT,PRCT,PRRT,PRIT,PRST,PRGT,PRHT,PSIGMA_RC,PRVHENI_MR,PRRHONG_MR,PRIMLTC_MR, &
!$acc& PRSRIMCG_MR,PRCHONI,PRVDEPS,PRIAGGS,PRIAUTS,PRVDEPG,PRCAUTR,PRCACCR,PRREVAV, &
!$acc& PRCRIMSS,PRCRIMSG,PRSRIMCG,PRRACCSS,PRRACCSG,PRSACCRG,PRSMLTG,PRCMLTSR,PRICFRRG,PRRCFRIG, &
!$acc& PRICFRR,PRCWETG,PRIWETG,PRRWETG,PRSWETG,PRCDRYG,PRIDRYG,PRRDRYG,PRSDRYG, &
!$acc& PRWETGH,PRWETGH_MR,PRGMLTR,PRCWETH,PRIWETH,PRSWETH,PRGWETH,PRRWETH, &
!$acc& PRCDRYH,PRIDRYH,PRSDRYH,PRRDRYH,PRGDRYH,PRDRYHG,PRHMLTR,PRCBERI,PRS_TEND,PRG_TEND,PRH_TEND, &
!$acc& PA_TH,PA_RV,PA_RC,PA_RR,PA_RI,PA_RS,PA_RG,PA_RH,PB_TH,PB_RV,PB_RC,PB_RR,PB_RI,PB_RS,PB_RG,PB_RH, &
-!$acc& PHLC_HCF,PHLC_LCF,PHLC_HRC,PHLC_LRC,PRAINFR)
+!$acc& PHLC_HCF,PHLC_LCF,PHLC_HRC,PHLC_LRC,,PHLI_HCF,PHLI_LCF,PHLI_HRI,PHLI_LRI,PRAINFR)
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
+ CALL MPPDB_CHECK(PCOMPUTE,"ICE4_TENDENCIES beg:PCOMPUTE")
CALL MPPDB_CHECK(PEXN,"ICE4_TENDENCIES beg:PEXN")
CALL MPPDB_CHECK(PRHODREF,"ICE4_TENDENCIES beg: PRHODREF:")
CALL MPPDB_CHECK(PLVFACT,"ICE4_TENDENCIES beg:PLVFACT")
@@ -343,7 +359,6 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRST,"ICE4_TENDENCIES beg:PRST")
CALL MPPDB_CHECK(PRGT,"ICE4_TENDENCIES beg:PRGT")
CALL MPPDB_CHECK(PRHT,"ICE4_TENDENCIES beg:PRHT")
- CALL MPPDB_CHECK(PRRT3D,"ICE4_TENDENCIES beg:PRRT3D")
CALL MPPDB_CHECK(PSIGMA_RC,"ICE4_TENDENCIES beg:PSIGMA_RC")
!Check all INOUT arrays
CALL MPPDB_CHECK(PCIT,"ICE4_TENDENCIES beg:PCIT")
@@ -368,9 +383,9 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRH_TEND,"ICE4_TENDENCIES beg:PRH_TEND")
END IF
-isize = size( odcompute )
+isize = size( pcompute )
-allocate( llwetg (isize ) )
+allocate( zwetg (isize ) )
allocate( zrvt (isize ) )
allocate( zrct (isize ) )
allocate( zrrt (isize ) )
@@ -379,8 +394,8 @@ allocate( zrst (isize ) )
allocate( zrgt (isize ) )
allocate( zt (isize ) )
allocate( ztht (isize ) )
+allocate( zrht (isize ) )
allocate( zzw (isize ) )
-allocate( zssi (isize ) )
allocate( zka (isize ) )
allocate( zdv (isize ) )
allocate( zai (isize ) )
@@ -395,9 +410,12 @@ allocate( zrgsi (isize ) )
allocate( zrgsi_mr (isize ) )
allocate( zrrt3d(kit, kjt, kkt ) )
+allocate( zrst3d(kit, kjt, kkt ) )
+allocate( zrgt3d(kit, kjt, kkt ) )
+allocate( zrht3d(kit, kjt, kkt ) )
-!$acc data create(LLWETG,ZRVT,ZRCT,ZRRT,ZRIT,ZRST,ZRGT,ZT,ZTHT,ZZW,ZSSI,ZKA,ZDV,ZAI,ZCJ,ZRF, &
-!$acc& ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH,ZLBDAR_RF,ZRGSI,ZRGSI_MR,ZRRT3D)
+!$acc data create(ZWETG,ZRVT,ZRCT,ZRRT,ZRIT,ZRST,ZRGT,ZT,ZTHT,ZRHT,ZZW,ZKA,ZDV,ZAI,ZCJ,ZRF, &
+!$acc& ZLBDAR,ZLBDAS,ZLBDAG,ZLBDAH,ZLBDAR_RF,ZRGSI,ZRGSI_MR,ZRRT3D,ZRST3D,ZRGT3D,ZRHT3D)
!$acc kernels
PA_TH(:)=0.
@@ -417,89 +435,118 @@ PB_RS(:)=0.
PB_RG(:)=0.
PB_RH(:)=0.
!
-ZRVT(:)=PRVT(:)
-ZRCT(:)=PRCT(:)
-ZRRT(:)=PRRT(:)
-ZRIT(:)=PRIT(:)
-ZRST(:)=PRST(:)
-ZRGT(:)=PRGT(:)
-ZTHT(:)=PTHT(:)
-ZT(:)=PT(:)
+DO JL=1, ISIZE
+ ZRVT(JL)=PRVT(JL)
+ ZRCT(JL)=PRCT(JL)
+ ZRRT(JL)=PRRT(JL)
+ ZRIT(JL)=PRIT(JL)
+ ZRST(JL)=PRST(JL)
+ ZRGT(JL)=PRGT(JL)
+ ZTHT(JL)=PTHT(JL)
+ ZRHT(JL)=PRHT(JL)
+ ZT(JL)=PT(JL)
+ENDDO
!$acc end kernels
-!
-!* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
-! --------------------------------------
-CALL ICE4_NUCLEATION(ODSOFT, ODCOMPUTE, &
- ZTHT, PPRES, PRHODREF, PEXN, PLSFACT, ZT, &
- ZRVT, &
- PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
+IF(ODSOFT) THEN
!$acc kernels
-ZRIT(:)=ZRIT(:) + PRVHENI_MR(:)
-ZRVT(:)=ZRVT(:) - PRVHENI_MR(:)
-ZTHT(:)=ZTHT(:) + PRVHENI_MR(:)*PLSFACT(:)
-ZT(:) = ZTHT(:) * PEXN(:)
+ PRVHENI_MR(:)=0.
+ PRRHONG_MR(:)=0.
+ PRIMLTC_MR(:)=0.
+ PRSRIMCG_MR(:)=0.
!$acc end kernels
-!
-!* 3.3 compute the spontaneous freezing source: RRHONG
-!
-CALL ICE4_RRHONG(ODSOFT, ODCOMPUTE, &
- &PEXN, PLVFACT, PLSFACT, &
- &ZT, ZRRT, &
- &ZTHT, &
- &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
+ELSE
+ !
+ !* 2. COMPUTES THE SLOW COLD PROCESS SOURCES
+ ! --------------------------------------
+ CALL ICE4_NUCLEATION(ODSOFT, PCOMPUTE==1., &
+ ZTHT, PPRES, PRHODREF, PEXN, PLSFACT, ZT, &
+ ZRVT, &
+ PCIT, PRVHENI_MR, PB_TH, PB_RV, PB_RI)
!$acc kernels
-ZRGT(:) = ZRGT(:) + PRRHONG_MR(:)
-ZRRT(:) = ZRRT(:) - PRRHONG_MR(:)
-ZTHT(:) = ZTHT(:) + PRRHONG_MR(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RRHONG))
-ZT(:) = ZTHT(:) * PEXN(:)
+ DO JL=1, ISIZE
+ ZRIT(JL)=ZRIT(JL) + PRVHENI_MR(JL)
+ ZRVT(JL)=ZRVT(JL) - PRVHENI_MR(JL)
+ ZTHT(JL)=ZTHT(JL) + PRVHENI_MR(JL)*PLSFACT(JL)
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
!$acc end kernels
-!
-!* 7.1 cloud ice melting
-!
-CALL ICE4_RIMLTC(ODSOFT, ODCOMPUTE, &
- &PEXN, PLVFACT, PLSFACT, &
- &ZT, &
- &ZTHT, ZRIT, &
- &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
+ !
+ !* 3.3 compute the spontaneous freezing source: RRHONG
+ !
+ CALL ICE4_RRHONG(ODSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &ZT, ZRRT, &
+ &ZTHT, &
+ &PRRHONG_MR, PB_TH, PB_RR, PB_RG)
!$acc kernels
-ZRCT(:) = ZRCT(:) + PRIMLTC_MR(:)
-ZRIT(:) = ZRIT(:) - PRIMLTC_MR(:)
-ZTHT(:) = ZTHT(:) - PRIMLTC_MR(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RIMLTC))
-ZT(:) = ZTHT(:) * PEXN(:)
-!
-! 5.1.6 riming-conversion of the large sized aggregates into graupel (old parametrisation)
-!
-ZLBDAS(:)=0.
-WHERE(ZRST(:)>0.)
+ DO JL=1, ISIZE
+ ZRGT(JL) = ZRGT(JL) + PRRHONG_MR(JL)
+ ZRRT(JL) = ZRRT(JL) - PRRHONG_MR(JL)
+ ZTHT(JL) = ZTHT(JL) + PRRHONG_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(RRHONG))
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
+!$acc end kernels
+ !
+ !* 7.1 cloud ice melting
+ !
+ CALL ICE4_RIMLTC(ODSOFT, PCOMPUTE, &
+ &PEXN, PLVFACT, PLSFACT, &
+ &ZT, &
+ &ZTHT, ZRIT, &
+ &PRIMLTC_MR, PB_TH, PB_RC, PB_RI)
+!$acc kernels
+ DO JL=1, ISIZE
+ ZRCT(JL) = ZRCT(JL) + PRIMLTC_MR(JL)
+ ZRIT(JL) = ZRIT(JL) - PRIMLTC_MR(JL)
+ ZTHT(JL) = ZTHT(JL) - PRIMLTC_MR(JL)*(PLSFACT(JL)-PLVFACT(JL)) ! f(L_f*(-RIMLTC))
+ ZT(JL) = ZTHT(JL) * PEXN(JL)
+ ENDDO
+!$acc end kernels
+ !
+ ! 5.1.6 riming-conversion of the large sized aggregates into graupel (old parametrisation)
+ !
+ IF(CSNOWRIMING=='OLD ') THEN
+!$acc kernels
+ ZLBDAS(:)=0.
+ WHERE(ZRST(:)>0.)
#ifndef MNH_BITREP
- ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS)
+ ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)))**XLBEXS)
#else
- ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*BR_POW(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)),XLBEXS))
+ ZLBDAS(:) = MIN(XLBDAS_MAX, XLBS*BR_POW(PRHODREF(:)*MAX(ZRST(:), XRTMIN(5)),XLBEXS))
#endif
-END WHERE
+ END WHERE
+!$acc end kernels
+ CALL ICE4_RSRIMCG_OLD(ODSOFT, PCOMPUTE==1., &
+ &PRHODREF, &
+ &ZLBDAS, &
+ &ZT, ZRCT, ZRST, &
+ &PRSRIMCG_MR, PB_RS, PB_RG)
+!$acc kernels
+ DO JL=1, ISIZE
+ ZRST(JL) = ZRST(JL) - PRSRIMCG_MR(JL)
+ ZRGT(JL) = ZRGT(JL) + PRSRIMCG_MR(JL)
+ ENDDO
!$acc end kernels
-CALL ICE4_RSRIMCG_OLD(ODSOFT, ODCOMPUTE, &
- &PRHODREF, &
- &ZLBDAS, &
- &ZT, ZRCT, ZRST, &
- &PRSRIMCG_MR, PB_RS, PB_RG)
+ ELSE
!$acc kernels
-ZRST(:) = ZRST(:) - PRSRIMCG_MR(:)
-ZRGT(:) = ZRGT(:) + PRSRIMCG_MR(:)
+ PRSRIMCG_MR(:) = 0.
!$acc end kernels
+ ENDIF
+ENDIF
!
!* Derived fields
!
-IF( ISIZE > 0 ) THEN
+IF(ISIZE>0) THEN
+ IF(.NOT. ODSOFT) THEN
!$acc kernels
#ifndef MNH_BITREP
- ZZW(:) = EXP(XALPI-XBETAI/ZT(:)-XGAMI*ALOG(ZT(:)))
+ ZZW(:) = EXP(XALPI-XBETAI/ZT(:)-XGAMI*ALOG(ZT(:)))
#else
- ZZW(:) = BR_EXP(XALPI-XBETAI/ZT(:)-XGAMI*BR_LOG(ZT(:)))
+ ZZW(:) = BR_EXP(XALPI-XBETAI/ZT(:)-XGAMI*BR_LOG(ZT(:)))
#endif
!$acc loop independent
DO JL = 1, ISIZE
- ZSSI(JL) = ZRVT(JL)*( PPRES(JL)-ZZW(JL) ) / ( (XMV/XMD) * ZZW(JL) ) - 1.0
+ PSSI(JL) = ZRVT(JL)*( PPRES(JL)-ZZW(JL) ) / ( XEPSILO * ZZW(JL) ) - 1.0
! Supersaturation over ice
ZKA(JL) = 2.38E-2 + 0.0071E-2*(ZT(JL)-XTT) ! k_a
#ifndef MNH_BITREP
@@ -515,27 +562,49 @@ IF( ISIZE > 0 ) THEN
#endif
ENDDO
!$acc end kernels
+ ENDIF
!
!Cloud water split between high and low content part is done here
- CALL ICE4_COMPUTE_PDF(HSUBG_AUCV_RC, HSUBG_PR_PDF,&
- PRHODREF, ZRCT, PCF, PSIGMA_RC,&
- PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, ZRF)
- !Diagnostic of precipitation fraction
+ CALL ICE4_COMPUTE_PDF(HSUBG_AUCV_RC, HSUBG_AUCV_RI, HSUBG_PR_PDF,&
+ PRHODREF, ZRCT, ZRIT, PCF, ZT, PSIGMA_RC,&
+ PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC,&
+ PHLI_HCF, PHLI_LCF, PHLI_HRI, PHLI_LRI, ZRF)
+ IF(HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
+ !Diagnostic of precipitation fraction
!$acc kernels
- PRAINFR(:,:,:) = 0.
- ZRRT3D (:,:,:) = PRRT3D(:,:,:)
+ PRAINFR(:,:,:) = 0.
+ ZRRT3D (:,:,:) = 0.
+ ZRST3D (:,:,:) = 0.
+ ZRGT3D (:,:,:) = 0.
+ ZRHT3D (:,:,:) = 0.
!$acc loop independent
- DO JL = 1, ISIZE
- PRAINFR(K1(JL), K2(JL), K3(JL)) = ZRF(JL)
- ZRRT3D (K1(JL), K2(JL), K3(JL)) = ZRRT3D(K1(JL), K2(JL), K3(JL)) - PRRHONG_MR(JL)
- END DO
+ DO JL=1,ISIZE
+ PRAINFR(K1(JL), K2(JL), K3(JL)) = ZRF(JL)
+ ZRRT3D (K1(JL), K2(JL), K3(JL)) = ZRRT(JL)
+ ZRST3D (K1(JL), K2(JL), K3(JL)) = ZRST(JL)
+ ZRGT3D (K1(JL), K2(JL), K3(JL)) = ZRGT(JL)
+ END DO
+ IF (KRR==7) THEN
+!$acc loop independent
+ DO JL=1,ISIZE
+ ZRHT3D (K1(JL), K2(JL), K3(JL)) = ZRHT(JL)
+ ENDDO
+ ENDIF
!$acc end kernels
- CALL ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PRAINFR(:,:,:), ZRRT3D(:,:,:))
+ CALL ICE4_RAINFR_VERT(KIB, KIE, KIT, KJB, KJE, KJT, KKB, KKE, KKT, KKL, PRAINFR(:,:,:), ZRRT3D(:,:,:), &
+ &ZRST3D(:,:,:), ZRGT3D(:,:,:), ZRHT3D(:,:,:))
!$acc kernels
!$acc loop independent
- DO JL = 1, ISIZE
- ZRF(JL)=PRAINFR(K1(JL), K2(JL), K3(JL))
- END DO
+ DO JL=1,ISIZE
+ ZRF(JL)=PRAINFR(K1(JL), K2(JL), K3(JL))
+ END DO
+!$acc end kernels
+ ELSE
+!$acc kernels
+ PRAINFR(:,:,:)=1.
+ ZRF(:)=1.
+!$acc end kernels
+ ENDIF
!
!* compute the slope parameters
!
@@ -565,14 +634,18 @@ IF( ISIZE > 0 ) THEN
#endif
END WHERE
!ZLBDAR_RF is used when we consider rain concentrated in its fraction
- ZLBDAR_RF(:)=0.
- WHERE(ZRRT(:)>0. .AND. ZRF(:)>0.)
+ IF (HSUBG_RC_RR_ACCR=='PRFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
+ ZLBDAR_RF(:)=0.
+ WHERE(ZRRT(:)>0. .AND. ZRF(:)>0.)
#ifndef MNH_BITREP
- ZLBDAR_RF(:) = XLBR*( PRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3)))**XLBEXR
+ ZLBDAR_RF(:) = XLBR*( PRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3)))**XLBEXR
#else
- ZLBDAR_RF(:) = XLBR*BR_POW(PRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3)),XLBEXR)
+ ZLBDAR_RF(:) = XLBR*BR_POW(PRHODREF(:) *MAX( ZRRT(:)/ZRF(:) , XRTMIN(3)),XLBEXR)
#endif
- END WHERE
+ END WHERE
+ ELSE
+ ZLBDAR_RF(:) = ZLBDAR(:)
+ ENDIF
IF(KRR==7) THEN
ZLBDAH(:)=0.
WHERE(PRHT(:)>0.)
@@ -589,11 +662,11 @@ ENDIF
!
!PW:BUG: the following line is necessary for correct computation (at least for PGI 18.10)
! if(KRR==-1) print *,'PW: ICE4_TENDENCIES: ODSOFT (cpu)=',ODSOFT
-CALL ICE4_SLOW(ODSOFT, ODCOMPUTE, PRHODREF, ZT, &
- &ZSSI, PLVFACT, PLSFACT, &
+CALL ICE4_SLOW(ODSOFT, PCOMPUTE, PRHODREF, ZT, &
+ &PSSI, PLVFACT, PLSFACT, &
&ZRVT, ZRCT, ZRIT, ZRST, ZRGT, &
&ZLBDAS, ZLBDAG, &
- &ZAI, ZCJ, &
+ &ZAI, ZCJ, PHLI_HCF, PHLI_HRI, &
&PRCHONI, PRVDEPS, PRIAGGS, PRIAUTS, PRVDEPG, &
&PA_TH, PA_RV, PA_RC, PA_RI, PA_RS, PA_RG)
!
@@ -606,7 +679,7 @@ CALL ICE4_SLOW(ODSOFT, ODCOMPUTE, PRHODREF, ZT, &
!
IF(OWARM) THEN ! Check if the formation of the raindrops by the slow
! warm processes is allowed
- CALL ICE4_WARM(ODSOFT, ODCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+ CALL ICE4_WARM(ODSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
&PRHODREF, PLVFACT, ZT, PPRES, ZTHT,&
&ZLBDAR, ZLBDAR_RF, ZKA, ZDV, ZCJ, &
&PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
@@ -628,7 +701,7 @@ END IF
!* 4. COMPUTES THE FAST COLD PROCESS SOURCES FOR r_s
! ----------------------------------------------
!
-CALL ICE4_FAST_RS(ODSOFT, ODCOMPUTE, &
+CALL ICE4_FAST_RS(ODSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAR, ZLBDAS, &
@@ -647,16 +720,19 @@ CALL ICE4_FAST_RS(ODSOFT, ODCOMPUTE, &
! ------------------------------------------------------
!
!$acc kernels
-ZRGSI(:) = PRVDEPG(:) + PRSMLTG(:) + PRRACCSG(:) + PRSACCRG(:) + PRCRIMSG(:) + PRSRIMCG(:)
-ZRGSI_MR(:) = PRRHONG_MR(:) + PRSRIMCG_MR(:)
+DO JL=1, ISIZE
+ ZRGSI(JL) = PRVDEPG(JL) + PRSMLTG(JL) + PRRACCSG(JL) + &
+ & PRSACCRG(JL) + PRCRIMSG(JL) + PRSRIMCG(JL)
+ ZRGSI_MR(JL) = PRRHONG_MR(JL) + PRSRIMCG_MR(JL)
+ENDDO
!$acc end kernels
-CALL ICE4_FAST_RG(ODSOFT, ODCOMPUTE, KRR, &
+CALL ICE4_FAST_RG(ODSOFT, PCOMPUTE, KRR, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, PCIT, &
&ZLBDAR, ZLBDAS, ZLBDAG, &
&ZT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
&ZRGSI, ZRGSI_MR(:), &
- &LLWETG, &
+ &ZWETG, &
&PRICFRRG, PRRCFRIG, PRICFRR, PRCWETG, PRIWETG, PRRWETG, PRSWETG, &
&PRCDRYG, PRIDRYG, PRRDRYG, PRSDRYG, PRWETGH, PRWETGH_MR, PRGMLTR, &
&PRG_TEND, &
@@ -669,7 +745,7 @@ CALL ICE4_FAST_RG(ODSOFT, ODCOMPUTE, KRR, &
! ----------------------------------------------
!
IF (KRR==7) THEN
- CALL ICE4_FAST_RH(ODSOFT, ODCOMPUTE, LLWETG, &
+ CALL ICE4_FAST_RH(ODSOFT, PCOMPUTE, ZWETG, &
&PRHODREF, PLVFACT, PLSFACT, PPRES, &
&ZDV, ZKA, ZCJ, &
&ZLBDAS, ZLBDAG, ZLBDAR, ZLBDAH, &
@@ -701,10 +777,10 @@ END IF
!* 7. COMPUTES SPECIFIC SOURCES OF THE WARM AND COLD CLOUDY SPECIES
! -------------------------------------------------------------
!
-CALL ICE4_FAST_RI(ODSOFT, ODCOMPUTE, &
+CALL ICE4_FAST_RI(ODSOFT, PCOMPUTE, &
&PRHODREF, PLVFACT, PLSFACT, &
&ZAI, ZCJ, PCIT, &
- &ZSSI, &
+ &PSSI, &
&ZRCT, ZRIT, &
&PRCBERI, PA_TH, PA_RC, PA_RI)
!
@@ -763,6 +839,7 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PRRDRYH,"ICE4_TENDENCIES end:PRRDRYH")
CALL MPPDB_CHECK(PRGDRYH,"ICE4_TENDENCIES end:PRGDRYH")
CALL MPPDB_CHECK(PRDRYHG,"ICE4_TENDENCIES end:PRDRYHG")
+ CALL MPPDB_CHECK(PSSI,"ICE4_TENDENCIES end:PSSI")
CALL MPPDB_CHECK(PA_TH,"ICE4_TENDENCIES end:PA_TH")
CALL MPPDB_CHECK(PA_RV,"ICE4_TENDENCIES end:PA_RV")
CALL MPPDB_CHECK(PA_RC,"ICE4_TENDENCIES end:PA_RC")
@@ -783,6 +860,10 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PHLC_LCF,"ICE4_TENDENCIES end:PHLC_LCF")
CALL MPPDB_CHECK(PHLC_HRC,"ICE4_TENDENCIES end:PHLC_HRC")
CALL MPPDB_CHECK(PHLC_LRC,"ICE4_TENDENCIES end:PHLC_LRC")
+ CALL MPPDB_CHECK(PHLI_HCF,"ICE4_TENDENCIES end:PHLI_HCF")
+ CALL MPPDB_CHECK(PHLI_LCF,"ICE4_TENDENCIES end:PHLI_LCF")
+ CALL MPPDB_CHECK(PHLI_HRI,"ICE4_TENDENCIES end:PHLI_HRI")
+ CALL MPPDB_CHECK(PHLI_LRI,"ICE4_TENDENCIES end:PHLI_LRI")
CALL MPPDB_CHECK(PRAINFR,"ICE4_TENDENCIES end:PRAINFR")
END IF
diff --git a/src/MNH/ice4_warm.f90 b/src/MNH/ice4_warm.f90
index ddc80a3777b6765a109671bbe257ba227b59a19b..b2ed2b7a561ce9666f4ff893ca9b5ba1d6e0e6ba 100644
--- a/src/MNH/ice4_warm.f90
+++ b/src/MNH/ice4_warm.f90
@@ -1,11 +1,11 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
MODULE MODI_ICE4_WARM
INTERFACE
-SUBROUTINE ICE4_WARM(LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+SUBROUTINE ICE4_WARM(LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
PRHODREF, PLVFACT, PT, PPRES, PTHT, &
PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
@@ -15,7 +15,7 @@ SUBROUTINE ICE4_WARM(LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
PA_TH, PA_RV, PA_RC, PA_RR)
IMPLICIT NONE
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
@@ -47,7 +47,7 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
END SUBROUTINE ICE4_WARM
END INTERFACE
END MODULE MODI_ICE4_WARM
-SUBROUTINE ICE4_WARM(LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
+SUBROUTINE ICE4_WARM(LDSOFT, PCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
PRHODREF, PLVFACT, PT, PPRES, PTHT, &
PLBDAR, PLBDAR_RF, PKA, PDV, PCJ, &
PHLC_LCF, PHLC_HCF, PHLC_LRC, PHLC_HRC, &
@@ -72,7 +72,7 @@ SUBROUTINE ICE4_WARM(LDSOFT, LDCOMPUTE, HSUBG_RC_RR_ACCR, HSUBG_RR_EVAP, &
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST, ONLY: XALPW,XBETAW,XCL,XCPD,XCPV,XGAMW,XLVTT,XMD,XMV,XRV,XTT
+USE MODD_CST, ONLY: XALPW,XBETAW,XCL,XCPD,XCPV,XGAMW,XLVTT,XMD,XMV,XRV,XTT,XEPSILO
USE MODD_RAIN_ICE_DESCR, ONLY: XCEXVT,XRTMIN
USE MODD_RAIN_ICE_PARAM, ONLY: X0EVAR,X1EVAR,XCRIAUTC,XEX0EVAR,XEX1EVAR,XEXCACCR,XFCACCR,XTIMAUTC
!
@@ -89,7 +89,7 @@ IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
!
LOGICAL, INTENT(IN) :: LDSOFT
-LOGICAL, DIMENSION(:), INTENT(IN) :: LDCOMPUTE
+REAL, DIMENSION(:), INTENT(IN) :: PCOMPUTE
CHARACTER(len=80), INTENT(IN) :: HSUBG_RC_RR_ACCR ! subgrid rc-rr accretion
CHARACTER(len=80), INTENT(IN) :: HSUBG_RR_EVAP ! subgrid rr evaporation
REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! Reference density
@@ -121,19 +121,21 @@ REAL, DIMENSION(:), INTENT(INOUT) :: PA_RR
!
!* 0.2 declaration of local variables
!
-LOGICAL, DIMENSION(:), allocatable :: GMASK, GMASK1, GMASK2
+INTEGER :: ISIZE
+INTEGER :: JL
REAL, DIMENSION(:), allocatable :: ZZW2, ZZW3, ZZW4
REAL, DIMENSION(:), allocatable :: ZUSW ! Undersaturation over water
REAL, DIMENSION(:), allocatable :: ZTHLT ! Liquid potential temperature
+REAL, DIMENSION(:), allocatable :: ZMASK, ZMASK1, ZMASK2
-!$acc data present(LDCOMPUTE,PRHODREF,PLVFACT,PT,PPRES,PTHT, &
+!$acc data present(PCOMPUTE,PRHODREF,PLVFACT,PT,PPRES,PTHT, &
!$acc& PLBDAR,PLBDAR_RF,PKA,PDV,PCJ,PHLC_LCF,PHLC_HCF,PHLC_LRC,PHLC_HRC,PCF,PRF, &
!$acc& PRVT,PRCT,PRRT,PRCAUTR,PRCACCR,PRREVAV,PA_TH,PA_RV,PA_RC,PA_RR )
!-------------------------------------------------------------------------------
!
IF (MPPDB_INITIALIZED) THEN
!Check all IN arrays
- CALL MPPDB_CHECK1D_LOG(LDCOMPUTE,"ICE4_WARM beg:LDCOMPUTE")
+ CALL MPPDB_CHECK1D(PCOMPUTE,"ICE4_WARM beg:PCOMPUTE")
CALL MPPDB_CHECK1D(PRHODREF,"ICE4_WARM beg:PRHODREF",PRECISION)
CALL MPPDB_CHECK1D(PLVFACT,"ICE4_WARM beg:PLVFACT",PRECISION)
CALL MPPDB_CHECK1D(PT,"ICE4_WARM beg:PT",PRECISION)
@@ -163,48 +165,61 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK1D(PA_RR,"ICE4_WARM beg:PA_RR",PRECISION)
END IF
-allocate( gmask (size( prhodref ) ) )
-allocate( gmask1(size( prhodref ) ) )
-allocate( gmask2(size( prhodref ) ) )
-allocate( zzw2 (size( prhodref ) ) )
-allocate( zzw3 (size( prhodref ) ) )
-allocate( zzw4 (size( prhodref ) ) )
-allocate( zusw (size( prhodref ) ) )
-allocate( zthlt (size( prhodref ) ) )
+ISIZE = Size( PRHODREF )
-!$acc data create(GMASK,GMASK1,GMASK2,ZZW2,ZZW3,ZZW4,ZUSW,ZTHLT)
+allocate( zzw2 (ISIZE) )
+allocate( zzw3 (ISIZE) )
+allocate( zzw4 (ISIZE) )
+allocate( zusw (ISIZE) )
+allocate( zthlt (ISIZE) )
+allocate( zmask (ISIZE) )
+allocate( zmask1(ISIZE) )
+allocate( zmask2(ISIZE) )
+
+!$acc data create(ZZW2,ZZW3,ZZW4,ZUSW,ZTHLT,ZMASK,ZMASK1,ZMASK2)
!
!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
!
!$acc kernels
-GMASK(:)=PHLC_HRC(:)>XRTMIN(2) .AND. PHLC_HCF(:) .GT. 0. .AND. LDCOMPUTE(:)
+DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) * & ! PHLC_HCF(:) .GT. 0.
+ &PCOMPUTE(JL)
+ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCAUTR(:) = 0.
- END WHERE
+ DO JL=1, ISIZE
+ PRCAUTR(JL)=PRCAUTR(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRCAUTR(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
PRCAUTR(:) = XTIMAUTC*MAX(PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:), 0.0)
PRCAUTR(:) = PHLC_HCF(:)*PRCAUTR(:)
END WHERE
ENDIF
-PA_RC(:) = PA_RC(:) - PRCAUTR(:)
-PA_RR(:) = PA_RR(:) + PRCAUTR(:)
+DO JL=1, ISIZE
+ PA_RC(JL) = PA_RC(JL) - PRCAUTR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCAUTR(JL)
+ENDDO
+!
!
!* 4.3 compute the accretion of r_c for r_r production: RCACCR
!
IF (HSUBG_RC_RR_ACCR=='NONE') THEN
!CLoud water and rain are diluted over the grid box
- GMASK(:)=PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
+ DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRCACCR(:)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRCACCR(JL)=PRCACCR(JL) * ZMASK(JL)
+ ENDDO
ELSE
PRCACCR(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
PRCACCR(:) = XFCACCR * PRCT(:) &
* PLBDAR(:)**XEXCACCR &
@@ -225,16 +240,24 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
! if PRF<PCF (rain is entirely falling in cloud): PRF-PHLC_HCF
! if PRF>PCF (rain is falling in cloud and in clear sky): PCF-PHLC_HCF
! => min(PCF, PRF)-PHLC_HCF
- GMASK(:)=PRCT(:)>XRTMIN(2) .AND. PRRT(:)>XRTMIN(3) .AND. LDCOMPUTE(:)
- GMASK1(:)=GMASK(:) .AND. PHLC_HRC(:)>XRTMIN(2) .AND. PHLC_HCF(:)>0.
- GMASK2(:)=GMASK(:) .AND. PHLC_LRC(:)>XRTMIN(2) .AND. PHLC_LCF(:)>0.
+ DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &PCOMPUTE(JL)
+ ZMASK1(JL)=ZMASK(JL) * &
+ &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_HRC(JL))) * & ! PHLC_HRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_HCF(JL))) ! PHLC_HCF(:)>0.
+ ZMASK2(JL)=ZMASK(JL) * &
+ &MAX(0., -SIGN(1., XRTMIN(2)-PHLC_LRC(JL))) * & ! PHLC_LRC(:)>XRTMIN(2)
+ &MAX(0., -SIGN(1., 1.E-20-PHLC_LCF(JL))) ! PHLC_LCF(:)>0.
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. (GMASK1(:) .OR. GMASK2(:)))
- PRCACCR(:)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRCACCR(JL)=PRCACCR(JL) * MIN(1., ZMASK1(JL)+ZMASK2(JL))
+ ENDDO
ELSE
PRCACCR(:)=0.
- WHERE(GMASK1(:))
+ WHERE(ZMASK1(:)==1.)
!Accretion due to rain falling in high cloud content
#ifndef MNH_BITREP
PRCACCR(:) = XFCACCR * ( PHLC_HRC(:)/PHLC_HCF(:) ) &
@@ -248,7 +271,7 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
* PHLC_HCF
#endif
END WHERE
- WHERE(GMASK2(:))
+ WHERE(ZMASK2(:)==1.)
!We add acrretion due to rain falling in low cloud content
#ifndef MNH_BITREP
PRCACCR(:) = PRCACCR(:) + XFCACCR * ( PHLC_LRC(:)/PHLC_LCF(:) ) &
@@ -266,25 +289,30 @@ ELSEIF (HSUBG_RC_RR_ACCR=='PRFR') THEN
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RC_RR_ACCR case')
ENDIF
-!
-PA_RC(:) = PA_RC(:) - PRCACCR(:)
-PA_RR(:) = PA_RR(:) + PRCACCR(:)
+DO JL=1, ISIZE
+ PA_RC(JL) = PA_RC(JL) - PRCACCR(JL)
+ PA_RR(JL) = PA_RR(JL) + PRCACCR(JL)
+ENDDO
!
!* 4.4 compute the evaporation of r_r: RREVAV
!
IF (HSUBG_RR_EVAP=='NONE') THEN
- GMASK(:)=PRRT(:)>XRTMIN(3) .AND. PRCT(:)<=XRTMIN(2) .AND. LDCOMPUTE(:)
+ DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &MAX(0., SIGN(1., XRTMIN(2)-PRCT(JL))) * & ! PRCT(:)<=XRTMIN(2)
+ &PCOMPUTE(JL)
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRREVAV(:)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRREVAV(:) = 0.
!Evaporation only when there's no cloud (RC must be 0)
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1.)
#ifndef MNH_BITREP
PRREVAV(:) = EXP( XALPW - XBETAW/PT(:) - XGAMW*ALOG(PT(:) ) ) ! es_w
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( (XMV/XMD) * PRREVAV(:) )
+ ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
! Undersaturation over water
PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(PT(:)-XTT) )**2 / ( PKA(:)*XRV*PT(:)**2 ) &
+ ( XRV*PT(:) ) / ( PDV(:)*PRREVAV(:) )
@@ -320,14 +348,18 @@ ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
!Ces variables devraient être sorties de rain_ice_slow et on mettrait le calcul de T^u, T^s
!et plusieurs versions (comme actuellement, en ciel clair, en ciel nuageux) de PKA, PDV, PCJ dans rain_ice
!On utiliserait la bonne version suivant l'option NONE, CLFR... dans l'évaporation et ailleurs
- GMASK(:)=PRRT(:)>XRTMIN(3) .AND. ZZW4(:) > PCF(:) .AND. LDCOMPUTE(:)
+ DO JL=1, ISIZE
+ ZMASK(JL)=MAX(0., -SIGN(1., XRTMIN(3)-PRRT(JL))) * & ! PRRT(:)>XRTMIN(3)
+ &MAX(0., -SIGN(1., PCF(JL)-ZZW4(JL))) * & ! ZZW4(:) > PCF(:)
+ &PCOMPUTE(JL)
+ ENDDO
IF(LDSOFT) THEN
- WHERE(.NOT. GMASK(:))
- PRREVAV(:)=0.
- END WHERE
+ DO JL=1, ISIZE
+ PRREVAV(JL)=PRREVAV(JL)*ZMASK(JL)
+ ENDDO
ELSE
PRREVAV(:) = 0.
- WHERE(GMASK(:))
+ WHERE(ZMASK(:)==1)
! outside the cloud (environment) the use of T^u (unsaturated) instead of T
! Bechtold et al. 1993
!
@@ -345,7 +377,7 @@ ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
#endif
!
! S, Undersaturation over water (with new theta^u)
- ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( (XMV/XMD) * PRREVAV(:) )
+ ZUSW(:) = 1.0 - PRVT(:)*( PPRES(:)-PRREVAV(:) ) / ( XEPSILO * PRREVAV(:) )
!
#ifndef MNH_BITREP
PRREVAV(:) = ( XLVTT+(XCPV-XCL)*(ZZW2(:)-XTT) )**2 / ( PKA(:)*XRV*ZZW2(:)**2 ) &
@@ -368,9 +400,11 @@ ELSEIF (HSUBG_RR_EVAP=='CLFR' .OR. HSUBG_RR_EVAP=='PRFR') THEN
ELSE
CALL PRINT_MSG(NVERB_FATAL,'GEN','ICE4_WARM','wrong HSUBG_RR_EVAP case')
END IF
-PA_RR(:) = PA_RR(:) - PRREVAV(:)
-PA_RV(:) = PA_RV(:) + PRREVAV(:)
-PA_TH(:) = PA_TH(:) - PRREVAV(:)*PLVFACT(:)
+DO JL=1, ISIZE
+ PA_RR(JL) = PA_RR(JL) - PRREVAV(JL)
+ PA_RV(JL) = PA_RV(JL) + PRREVAV(JL)
+ PA_TH(JL) = PA_TH(JL) - PRREVAV(JL)*PLVFACT(JL)
+ENDDO
!$acc end kernels
!
IF (MPPDB_INITIALIZED) THEN
diff --git a/src/MNH/ice_adjust.f90 b/src/MNH/ice_adjust.f90
index 627390ce618b452d6b90e7fb7d8068ae76b620a5..d2c62b57ed10f59fe88ffa94d1452d7904be3f5d 100644
--- a/src/MNH/ice_adjust.f90
+++ b/src/MNH/ice_adjust.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.
@@ -9,32 +9,38 @@
!
INTERFACE
!
- SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, &
- HBUNAME, OSUBG_COND, OSIGMAS, &
+ SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
+ HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF, &
PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PZZ, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, &
+ PPABST, PZZ, &
PEXN, PCF_MF, PRC_MF, PRI_MF, &
- PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR , &
- PRR, PRI, PRIS, PRS, PRG, &
- PRH, POUT_RV, POUT_RC, POUT_RI, POUT_TH )
+ PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
+ PRR, PRI, PRIS, PRS, PRG, PRH, &
+ POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-CHARACTER(len=4), INTENT(IN) :: HBUNAME ! Name of the budget
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
LOGICAL :: OSIGMAS ! Switch for Sigma_s:
! use values computed in CONDENSATION
! or that from turbulence scheme
+CHARACTER(len=*), INTENT(IN) :: HSUBG_MF_PDF
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
@@ -66,6 +72,10 @@ REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HCF
!
!
END SUBROUTINE ICE_ADJUST
@@ -75,14 +85,16 @@ END INTERFACE
END MODULE MODI_ICE_ADJUST
! ##########################################################################
- SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, &
- HBUNAME, OSUBG_COND, OSIGMAS, &
+ SUBROUTINE ICE_ADJUST (KKA, KKU, KKL, KRR, HFRAC_ICE, HCONDENS, HLAMBDA3,&
+ HBUNAME, OSUBG_COND, OSIGMAS, HSUBG_MF_PDF, &
PTSTEP, PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, PZZ, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, &
+ PPABST, PZZ, &
PEXN, PCF_MF, PRC_MF, PRI_MF, &
- PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR , &
+ PRV, PRC, PRVS, PRCS, PTH, PTHS, PSRCS, PCLDFR, &
PRR, PRI, PRIS, PRS, PRG, PRH, &
- POUT_RV, POUT_RC, POUT_RI, POUT_TH )
+ POUT_RV, POUT_RC, POUT_RI, POUT_TH, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF )
! #########################################################################
!
!!**** *ICE_ADJUST* - compute the ajustment of water vapor in mixed-phase
@@ -128,7 +140,6 @@ END MODULE MODI_ICE_ADJUST
!! Module MODD_BUDGET:
!! NBUMOD
!! CBUTYPE
-!! NBUPROCCTR
!! LBU_RTH
!! LBU_RRV
!! LBU_RRC
@@ -163,18 +174,22 @@ END MODULE MODI_ICE_ADJUST
!! This modification allows to call ice_adjust on T variable
!! or to call it on S variables
!! 2016-11 S. Riette: all-or-nothing adjustment now uses condensation
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_PARAMETERS
+USE MODD_RAIN_ICE_PARAM, ONLY : XCRIAUTC, XCRIAUTI, XACRIAUTI, XBCRIAUTI
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_MPPDB
#ifdef MNH_OPENACC
use mode_msg
@@ -184,10 +199,9 @@ use mode_tools_ll, only: GET_INDICE_ll
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
-USE MODI_BUDGET
USE MODI_CONDENSATION
USE MODI_GET_HALO
-!
+
IMPLICIT NONE
!
!
@@ -199,18 +213,22 @@ INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
CHARACTER(len=1), INTENT(IN) :: HFRAC_ICE
-CHARACTER(len=4), INTENT(IN) :: HBUNAME ! Name of the budget
-LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
+CHARACTER(len=80), INTENT(IN) :: HCONDENS
+CHARACTER(len=4), INTENT(IN) :: HLAMBDA3 ! formulation for lambda3 coeff
+CHARACTER(len=*), INTENT(IN) :: HBUNAME ! Name of the budget
+LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
LOGICAL :: OSIGMAS ! Switch for Sigma_s:
! use values computed in CONDENSATION
! or that from turbulence scheme
+CHARACTER(len=*), INTENT(IN) :: HSUBG_MF_PDF
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
REAL, INTENT(IN) :: PSIGQSAT ! coeff applied to qsat variance contribution
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PMFCONV ! convective mass flux
@@ -243,6 +261,10 @@ REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RV ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RC ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_RI ! Adjusted value
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: POUT_TH ! Adjusted value
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HRC
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLC_HCF
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HRI
+REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(OUT) :: PHLI_HCF
!
!* 0.2 Declarations of local variables :
!
@@ -264,7 +286,9 @@ REAL, DIMENSION(:,:,:), allocatable &
ZCPH, & ! guess of the CPh for the mixing
ZLV, & ! guess of the Lv at t+1
ZLS, & ! guess of the Ls at t+1
- ZW1,ZW2 ! Work arrays for intermediate fields
+ ZW1,ZW2, & ! Work arrays for intermediate fields
+ ZCRIAUT, & ! Autoconversion thresholds
+ ZHCF, ZHR
!
!-------------------------------------------------------------------------------
!
@@ -289,6 +313,7 @@ REAL, DIMENSION(:,:,:), allocatable &
!Check all IN arrays
CALL MPPDB_CHECK3D(PRHODJ,"ICE_ADJUST beg:PRHODJ",PRECISION)
CALL MPPDB_CHECK3D(PEXNREF,"ICE_ADJUST beg:PEXNREF",PRECISION)
+CALL MPPDB_CHECK3D(PRHODREF,"ICE_ADJUST beg:PRHODREF")
CALL MPPDB_CHECK3D(PSIGS,"ICE_ADJUST beg:PSIGS",PRECISION)
CALL MPPDB_CHECK3D(PMFCONV,"ICE_ADJUST beg:PMFCONV",PRECISION)
CALL MPPDB_CHECK3D(PPABST,"ICE_ADJUST beg:PPABST",PRECISION)
@@ -304,26 +329,35 @@ CALL MPPDB_CHECK3D(PRR,"ICE_ADJUST beg:PRR",PRECISION)
CALL MPPDB_CHECK3D(PRI,"ICE_ADJUST beg:PRI",PRECISION)
CALL MPPDB_CHECK3D(PRS,"ICE_ADJUST beg:PRS",PRECISION)
CALL MPPDB_CHECK3D(PRG,"ICE_ADJUST beg:PRG",PRECISION)
+IF (PRESENT(PRH)) CALL MPPDB_CHECK3D(PRH,"ICE_ADJUST beg:PRH",PRECISION)
!Check all INOUT arrays
CALL MPPDB_CHECK3D(PRVS,"ICE_ADJUST beg:PRVS",PRECISION)
CALL MPPDB_CHECK3D(PRCS,"ICE_ADJUST beg:PRCS",PRECISION)
CALL MPPDB_CHECK3D(PTHS,"ICE_ADJUST beg:PTHS",PRECISION)
CALL MPPDB_CHECK3D(PRIS,"ICE_ADJUST beg:PRIS",PRECISION)
-allocate( gtemp(size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zsigs(size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zsrcs(size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zt (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zrv (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zrc (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zri (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zcph (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zlv (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zls (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zw1 (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
-allocate( zw2 (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( gtemp (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zsigs (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zsrcs (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zt (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zrv (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zrc (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zri (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zcph (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zlv (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zls (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zw1 (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zw2 (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zcriaut(size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zhcf (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+allocate( zhr (size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+
+!$acc data create( gtemp, zsigs, zsrcs, zt, zrv, zrc, zri, zcph, zlv, zls, zw1, zw2, zcriaut, zhcf, zhr )
-!$acc data create( gtemp, zsigs, zsrcs, zt, zrv, zrc, zri, zcph, zlv, zls, zw1, zw2 )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), trim( hbuname ), pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), trim( hbuname ), prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), trim( hbuname ), prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), trim( hbuname ), pris(:, :, :) * prhodj(:, :, :) )
IIU = SIZE(PEXNREF,1)
IJU = SIZE(PEXNREF,2)
@@ -387,10 +421,11 @@ DO JITER =1,ITERMAX
!
! PSRC= s'rci'/Sigma_s^2
! ZT, ZRV, ZRC and ZRI are INOUT
- CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
- HFRAC_ICE, &
- PPABST, PZZ, ZT, ZRV, ZRC, ZRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, PSRCS, .TRUE., OSIGMAS, &
- PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
+ CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRS, PRG, PSIGS, PMFCONV, PCLDFR, &
+ PSRCS, .TRUE., OSIGMAS, &
+ PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH, PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF)
ELSE
!
!* 4. ALL OR NOTHING CONDENSATION SCHEME
@@ -407,11 +442,11 @@ DO JITER =1,ITERMAX
!$acc kernels
ZSIGS=0.
!$acc end kernels
- CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
- HFRAC_ICE, &
- PPABST, PZZ, ZT, ZRV, ZRC, ZRI, PRS, PRG, ZSIGS, PMFCONV, PCLDFR, &
- ZSRCS, .TRUE., OSIGMAS=.TRUE., &
- PSIGQSAT=0., PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
+ CALL CONDENSATION(IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, KKL, &
+ HFRAC_ICE, HCONDENS, HLAMBDA3, &
+ PPABST, PZZ, PRHODREF, ZT, ZRV, ZRC, ZRI, PRS, PRG, ZSIGS, PMFCONV, PCLDFR, &
+ ZSRCS, .TRUE., OSIGMAS=.TRUE., &
+ PSIGQSAT=0., PLV=ZLV, PLS=ZLS, PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
END IF
ENDDO ! end of the iterative loop
!
@@ -479,6 +514,59 @@ ELSE
ZW1(:,:,:)=ZW1(:,:,:)*PRVS(:,:,:)/(ZW1(:,:,:)+ZW2(:,:,:))
ZW2(:,:,:)=PRVS(:,:,:)-ZW1(:,:,:)
ENDWHERE
+ IF(PRESENT(PHLC_HRC) .AND. PRESENT(PHLC_HCF)) THEN
+ ZCRIAUT(:,:,:)=XCRIAUTC/PRHODREF
+ IF(HSUBG_MF_PDF=='NONE')THEN
+ WHERE(ZW1(:,:,:)*PTSTEP>PCF_MF * ZCRIAUT)
+ PHLC_HRC(:,:,:)=PHLC_HRC(:,:,:)+ZW1(:,:,:)*PTSTEP
+ PHLC_HCF(:,:,:)=MIN(1.,PHLC_HCF(:,:,:)+PCF_MF(:,:,:))
+ ENDWHERE
+ ELSEIF(HSUBG_MF_PDF=='TRIANGLE')THEN
+ !ZHCF is the precipitating part of the *cloud* and not of the grid cell
+ WHERE(ZW1(:,:,:)*PTSTEP>PCF_MF*ZCRIAUT(:,:,:))
+ ZHCF(:,:,:)=1.-.5*(ZCRIAUT(:,:,:)*PCF_MF(:,:,:) / MAX(1.E-20, ZW1(:,:,:)*PTSTEP))**2
+ ZHR(:,:,:)=ZW1(:,:,:)*PTSTEP-(ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**3 / &
+ &(3*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ELSEWHERE(2.*ZW1(:,:,:)*PTSTEP<=PCF_MF * ZCRIAUT(:,:,:))
+ ZHCF(:,:,:)=0.
+ ZHR(:,:,:)=0.
+ ELSEWHERE
+ ZHCF(:,:,:)=(2.*ZW1(:,:,:)*PTSTEP-ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**2 / &
+ &(2.*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ZHR(:,:,:)=(4.*(ZW1(:,:,:)*PTSTEP)**3-3.*ZW1(:,:,:)*PTSTEP*(ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**2+&
+ (ZCRIAUT(:,:,:)*PCF_MF(:,:,:))**3) / &
+ &(3*MAX(1.E-20, ZW1(:,:,:)*PTSTEP)**2)
+ ENDWHERE
+ ZHCF(:,:,:)=ZHCF(:,:,:)*PCF_MF(:,:,:) !to retrieve the part of the grid cell
+ PHLC_HCF(:,:,:)=MIN(1.,PHLC_HCF(:,:,:)+ZHCF(:,:,:)) !total part of the grid cell that is precipitating
+ PHLC_HRC(:,:,:)=PHLC_HRC(:,:,:)+ZHR(:,:,:)
+ ENDIF
+ ENDIF
+ IF(PRESENT(PHLI_HRI) .AND. PRESENT(PHLI_HCF)) THEN
+ ZCRIAUT(:,:,:)=MIN(XCRIAUTI,10**(XACRIAUTI*(ZT(:,:,:)-XTT)+XBCRIAUTI))
+ IF(HSUBG_MF_PDF=='NONE')THEN
+ WHERE(ZW2(:,:,:)*PTSTEP>PCF_MF * ZCRIAUT(:,:,:))
+ PHLI_HRI(:,:,:)=PHLI_HRI(:,:,:)+ZW2(:,:,:)*PTSTEP
+ PHLI_HCF(:,:,:)=MIN(1.,PHLI_HCF(:,:,:)+PCF_MF(:,:,:))
+ ENDWHERE
+ ELSEIF(HSUBG_MF_PDF=='TRIANGLE')THEN
+ !ZHCF is the precipitating part of the *cloud* and not of the grid cell
+ WHERE(ZW2(:,:,:)*PTSTEP>PCF_MF*ZCRIAUT)
+ ZHCF(:,:,:)=1.-.5*(ZCRIAUT*PCF_MF(:,:,:) / (ZW2(:,:,:)*PTSTEP))**2
+ ZHR(:,:,:)=ZW2(:,:,:)*PTSTEP-(ZCRIAUT*PCF_MF(:,:,:))**3/(3*(ZW2(:,:,:)*PTSTEP)**2)
+ ELSEWHERE(2.*ZW2(:,:,:)*PTSTEP<=PCF_MF * ZCRIAUT)
+ ZHCF(:,:,:)=0.
+ ZHR(:,:,:)=0.
+ ELSEWHERE
+ ZHCF(:,:,:)=(2.*ZW2(:,:,:)*PTSTEP-ZCRIAUT*PCF_MF(:,:,:))**2 / (2.*(ZW2(:,:,:)*PTSTEP)**2)
+ ZHR(:,:,:)=(4.*(ZW2(:,:,:)*PTSTEP)**3-3.*ZW2(:,:,:)*PTSTEP*(ZCRIAUT*PCF_MF(:,:,:))**2+&
+ (ZCRIAUT*PCF_MF(:,:,:))**3)/(3*(ZW2(:,:,:)*PTSTEP)**2)
+ ENDWHERE
+ ZHCF(:,:,:)=ZHCF(:,:,:)*PCF_MF(:,:,:) !to retrieve the part of the grid cell
+ PHLI_HCF(:,:,:)=MIN(1.,PHLI_HCF(:,:,:)+ZHCF(:,:,:)) !total part of the grid cell that is precipitating
+ PHLI_HRI(:,:,:)=PHLI_HRI(:,:,:)+ZHR(:,:,:)
+ ENDIF
+ ENDIF
PCLDFR(:,:,:)=MIN(1.,PCLDFR(:,:,:)+PCF_MF(:,:,:))
PRCS(:,:,:)=PRCS(:,:,:)+ZW1(:,:,:)
PRIS(:,:,:)=PRIS(:,:,:)+ZW2(:,:,:)
@@ -500,36 +588,36 @@ ELSE
ZRV(:,:,:)=ZRV(:,:,:)-(ZW1(:,:,:)+ZW2(:,:,:))
ZT(:,:,:) = ZT(:,:,:) + &
(ZW1 * ZLV(:,:,:) + ZW2 * ZLS(:,:,:)) / ZCPH(:,:,:)
- IF(PRESENT(POUT_RV)) POUT_RV=ZRV
- IF(PRESENT(POUT_RC)) POUT_RC=ZRC
- IF(PRESENT(POUT_RI)) POUT_RI=ZRI
- IF(PRESENT(POUT_TH)) POUT_TH=ZT / PEXN(:,:,:)
ENDIF
ENDIF
!$acc end kernels
!
+IF(PRESENT(POUT_RV)) POUT_RV=ZRV
+IF(PRESENT(POUT_RC)) POUT_RC=ZRC
+IF(PRESENT(POUT_RI)) POUT_RI=ZRI
+IF(PRESENT(POUT_TH)) POUT_TH=ZT / PEXN(:,:,:)
!
!
!* 6. STORE THE BUDGET TERMS
! ----------------------
!
-IF (LBUDGET_RV) THEN
-!$acc update self(PRVS)
- CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),6,HBUNAME//'_BU_RRV')
-END IF
-IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),7,HBUNAME//'_BU_RRC')
-END IF
-IF (LBUDGET_RI) THEN
-!$acc update self(PRIS)
- CALL BUDGET (PRIS(:,:,:) * PRHODJ(:,:,:),9,HBUNAME//'_BU_RRI')
-END IF
-IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),4,HBUNAME//'_BU_RTH')
-END IF
-!
+if ( lbudget_th ) then
+!$acc update self(pths)
+ call Budget_store_end( tbudgets(NBUDGET_TH), trim( hbuname ), pths(:, :, :) * prhodj(:, :, :) )
+end if
+if ( lbudget_rv ) then
+!$acc update self(prvs)
+ call Budget_store_end( tbudgets(NBUDGET_RV), trim( hbuname ), prvs(:, :, :) * prhodj(:, :, :) )
+end if
+if ( lbudget_rc ) then
+!$acc update self(prcs)
+ call Budget_store_end( tbudgets(NBUDGET_RC), trim( hbuname ), prcs(:, :, :) * prhodj(:, :, :) )
+end if
+if ( lbudget_ri ) then
+!$acc update self(pris)
+ call Budget_store_end( tbudgets(NBUDGET_RI), trim( hbuname ), pris(:, :, :) * prhodj(:, :, :) )
+end if
+
!------------------------------------------------------------------------------
!
!Check all INOUT arrays
@@ -540,7 +628,14 @@ CALL MPPDB_CHECK3D(PRIS,"ICE_ADJUST end:PRIS",PRECISION)
!Check all OUT arrays
CALL MPPDB_CHECK3D(PSRCS,"ICE_ADJUST end:PSRCS",PRECISION)
CALL MPPDB_CHECK3D(PCLDFR,"ICE_ADJUST end:PCLDFR",PRECISION)
-
+IF (PRESENT(POUT_RV)) CALL MPPDB_CHECK3D(POUT_RV,"ICE_ADJUST end:POUT_RV")
+IF (PRESENT(POUT_RC)) CALL MPPDB_CHECK3D(POUT_RC,"ICE_ADJUST end:POUT_RC")
+IF (PRESENT(POUT_RI)) CALL MPPDB_CHECK3D(POUT_RI,"ICE_ADJUST end:POUT_RI")
+IF (PRESENT(POUT_TH)) CALL MPPDB_CHECK3D(POUT_TH,"ICE_ADJUST end:POUT_TH")
+IF (PRESENT(PHLC_HRC)) CALL MPPDB_CHECK3D(PHLC_HRC,"ICE_ADJUST end:PHLC_HRC")
+IF (PRESENT(PHLC_HCF)) CALL MPPDB_CHECK3D(PHLC_HCF,"ICE_ADJUST end:PHLC_HCF")
+IF (PRESENT(PHLI_HRI)) CALL MPPDB_CHECK3D(PHLI_HRI,"ICE_ADJUST end:PHLI_HRI")
+IF (PRESENT(PHLI_HCF)) CALL MPPDB_CHECK3D(PHLI_HCF,"ICE_ADJUST end:PHLI_HCF")
!$acc end data
!$acc end data
diff --git a/src/MNH/ice_adjust_elec.f90 b/src/MNH/ice_adjust_elec.f90
index 8d802babf157138a461aeff09c479f519d42149b..2aa614e7c1c9fa35ba8f9abf82bcef8fec468f94 100644
--- a/src/MNH/ice_adjust_elec.f90
+++ b/src/MNH/ice_adjust_elec.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.
@@ -139,14 +139,6 @@ END MODULE MODI_ICE_ADJUST_ELEC
!! ! pressure function
!! Module MODD_CONF
!! CCONF
-!! Module MODD_BUDGET:
-!! NBUMOD
-!! CBUTYPE
-!! NBUPROCCTR
-!! LBU_RTH
-!! LBU_RRV
-!! LBU_RRC
-!! LBU_RRI
!!
!!
!! REFERENCE
@@ -165,25 +157,27 @@ END MODULE MODI_ICE_ADJUST_ELEC
!! C. Barthe 19/11/09 update to version 4.8.1
!! M. Chong Mar. 2010 Add small ions
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
-USE MODD_CST
+use modd_budget, only: 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_BUDGET
-USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND
+USE MODD_CST
USE MODD_ELEC_DESCR, ONLY : XRTMIN_ELEC, XQTMIN, XFC, XFI, XECHARGE
+USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND
+USE MODD_PARAMETERS
USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN, XBI
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools_ll, only: GET_INDICE_ll
USE MODI_CONDENSATION
-USE MODI_BUDGET
USE MODI_GET_HALO
!
IMPLICIT NONE
@@ -311,6 +305,16 @@ 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), '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 ), '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
! -------------------------------------------------------
@@ -366,9 +370,10 @@ DO JITER = 1, ITERMAX
!
! ZW3=water vapor ZW1=rc (INOUT) ZW2=ri (INOUT) PSRC= s'rci'/Sigma_s^2
ZW3 = PRVS * PTSTEP; ZW1 = PRCS * PTSTEP; ZW2 = PRIS * PTSTEP
+ ZW4 = 1. ! PRODREF is not used if HL variables are not present
!
- CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE,1, 'T', &
- PPABST, PZZ, ZT, ZW3, ZW1, ZW2, PRSS*PTSTEP, PRGS*PTSTEP, &
+ CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE,1, 'T', 'CB02', 'CB', &
+ PPABST, PZZ, ZW4, ZT, ZW3, ZW1, ZW2, PRSS*PTSTEP, PRGS*PTSTEP, &
PSIGS, PMFCONV, PCLDFR, PSRCS, .TRUE., &
OSIGMAS, PSIGQSAT, PLV=ZLV, PLS=ZLS, PCPH=ZCPH )
!
@@ -625,17 +630,16 @@ ENDIF
!* 6. STORE THE BUDGET TERMS
! ----------------------
!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),6,'DEPI_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),7,'DEPI_BU_RRC')
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:) * PRHODJ(:,:,:),9,'DEPI_BU_RRI')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),4,'DEPI_BU_RTH')
-IF (LBUDGET_SV) THEN
- CALL BUDGET(PQPIS(:,:,:) * PRHODJ(:,:,:), 12+NSV_ELECBEG, 'DEPI_BU_RSV')
- CALL BUDGET(PQNIS(:,:,:) * PRHODJ(:,:,:), 12+NSV_ELECEND, 'DEPI_BU_RSV')
- CALL BUDGET(PQCS(:,:,:) * PRHODJ(:,:,:), 12+NSV_ELECBEG+1, 'DEPI_BU_RSV')
- CALL BUDGET(PQIS(:,:,:) * PRHODJ(:,:,:), 12+NSV_ELECBEG+3, 'DEPI_BU_RSV')
-END IF
-!
+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 ), '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
!------------------------------------------------------------------------------
!
END SUBROUTINE ICE_ADJUST_ELEC
diff --git a/src/MNH/ice_c1r3.f90 b/src/MNH/ice_c1r3.f90
deleted file mode 100644
index 9d169e9e1692305abd8ba16e567e72aef6ed39eb..0000000000000000000000000000000000000000
--- a/src/MNH/ice_c1r3.f90
+++ /dev/null
@@ -1,190 +0,0 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ######################
- MODULE MODI_ICE_C1R3
-! ######################
-!
-INTERFACE
- SUBROUTINE ICE_C1R3 (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PCCT, PCRT, PCIT, PCNS, PCCS, PCRS, PINS, PCIS, &
- PINPRS, PINPRG )
-!
-!
-!
-LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
- ! cloud ice sedimentation
-LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
-INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
- ! integration for ice sedimendation
-REAL, INTENT(IN) :: PTSTEP ! Time step
-INTEGER, INTENT(IN) :: KMI ! Model index
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
- ! the nucleation param.
-!
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Cloud ice m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel m.r. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCT ! Cloud water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRT ! Rain water C. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIT ! Ice crystal C. at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRGS ! Graupel/hail m.r. source
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCNS ! Cloud C. nuclei C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCS ! Cloud water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PINS ! Ice nuclei C. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
-!
-END SUBROUTINE ICE_C1R3
-END INTERFACE
-END MODULE MODI_ICE_C1R3
-! ######################################################################
- SUBROUTINE ICE_C1R3 (OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- PZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PW_NU, &
- PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
- PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
- PCCT, PCRT, PCIT, PCNS, PCCS, PCRS, PINS, PCIS, &
- PINPRS, PINPRG )
-! ######################################################################
-!
-!!**** * - compute the explicit microphysical sources of cloud water and
-!! rain water concentrations and mixing ratios
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the microphysical sources:
-!! nucleation, sedimentation, autoconversion, accretion, self-collection
-!! and vaporisation which are parameterized according to Cohard and Pinty
-!! QJRMS, 2000
-!!
-!!
-!!** METHOD
-!! ------
-!! The activation of CCN is checked for quasi-saturated air parcels
-!! to update the cloud droplet number concentration. Then assuming a
-!! generalized gamma distribution law for the cloud droplets and the
-!! raindrops, the zeroth and third order moments tendencies are evaluated
-!! for all the coalescence terms by integrating the Stochastic Collection
-!! Equation. As autoconversion is a process that cannot be resolved
-!! analytically, the Berry-Reinhardt parameterisation is employed with
-!! modifications to initiate the raindrop spectrum mode. The integration
-!! of the raindrop evaporation of the raindrops below clouds is
-!! straightformward.
-!!
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process).
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!! Module MODD_CONF :
-!! CCONF configuration of the model for the first time step
-!!
-!! Module MODD_CST
-!! XP00 ! Reference pressure
-!! XRD,XRV ! Gaz constant for dry air, vapor
-!! XMD,XMV ! Molecular weight for dry air, vapor
-!! XCPD ! Cpd (dry air)
-!! XCL ! Cl (liquid)
-!! XTT ! Triple point temperature
-!! XLVTT ! Vaporization heat constant
-!! XALPW,XBETAW,XGAMW ! Constants for saturation vapor pressure
-!! function over liquid water
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RTH : logical for budget of RTH (potential temperature)
-!! .TRUE. = budget of RTH
-!! .FALSE. = no budget of RTH
-!! LBU_RRV : logical for budget of RRV (water vapor)
-!! .TRUE. = budget of RRV
-!! .FALSE. = no budget of RRV
-!! LBU_RRC : logical for budget of RRC (cloud water)
-!! .TRUE. = budget of RRC
-!! .FALSE. = no budget of RRC
-!! LBU_RRR : logical for budget of RRR (rain water)
-!! .TRUE. = budget of RRR
-!! .FALSE. = no budget of RRR
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Cohard, J.-M. and J.-P. Pinty, 2000: A comprehensive two-moment warm
-!! microphysical bulk scheme.
-!! Part I: Description and tests
-!! Part II: 2D experiments with a non-hydrostatic model
-!! Accepted for publication in Quart. J. Roy. Meteor. Soc.
-!!
-!! AUTHOR
-!! ------
-!! J.-M. Cohard * Laboratoire d'Aerologie*
-!! J.-P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 31/12/96
-!! Jean-Pierre PINTY 7/ 4/01 Code cleaning
-!! Jean-Pierre PINTY 7/ 5/01 Bug correction in BERFI
-!! Jean-Pierre PINTY 17/ 5/01 Reset PINS=0 in case of IMLT
-!! Jean-Pierre PINTY 17/ 5/01 Bug in RRCFRIG and RICFRRG
-!! Jean-Pierre PINTY 29/ 5/01 Bug in RCHONI and graupel shedding
-!! Jean-Pierre PINTY 29/ 6/01 Bug in RCHONI and RVHNCI
-!! Jean-Pierre PINTY 29/ 6/01 Add RHHONI process (freezing haze part.)
-!! Jean-Pierre PINTY 13/ 9/01 Recode the RCHONI and RVHNCI processes
-!! Jean-Pierre PINTY 23/ 9/01 Recode the HM processes according to
-!! Beheng(1986) and Ovtchin. et al. (2000)
-!! and add the S to I conversion rate
-!! Jean-Pierre PINTY 1/10/01 Bug in RVHNCI
-!! Jean-Pierre PINTY 8/10/01 Revise limits in sedim. and review S->I
-!! Jean-Pierre PINTY 18/10/01 Revise Snow to Ice conversion
-!! Jean-Pierre PINTY 18/12/01 Revise Graupel wet growth (limitation)
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!!
-!-------------------------------------------------------------------------------
-!
-use mode_msg
-!
-call Print_msg(NVERB_FATAL,'GEN','ICE_C1R3','not yet developed')
-!
-END SUBROUTINE ICE_C1R3
diff --git a/src/MNH/ini_aircraft.f90 b/src/MNH/ini_aircraft.f90
index afd5a75e12db813cd087e0064d9420a41dfed798..2df9363014ca83596f600d3a8d27b7bf60d4f77d 100644
--- a/src/MNH/ini_aircraft.f90
+++ b/src/MNH/ini_aircraft.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
! #######################
SUBROUTINE INI_AIRCRAFT
! #######################
@@ -135,10 +131,10 @@ TAIRCRAFT1%STEP = 60.
!
!* take-off date and time
!
-TAIRCRAFT1%LAUNCH%TDATE%YEAR = 2007
-TAIRCRAFT1%LAUNCH%TDATE%MONTH = 04
-TAIRCRAFT1%LAUNCH%TDATE%DAY = 19
-TAIRCRAFT1%LAUNCH%TIME = 32280.
+TAIRCRAFT1%LAUNCH%nyear = 2007
+TAIRCRAFT1%LAUNCH%nmonth = 04
+TAIRCRAFT1%LAUNCH%nday = 19
+TAIRCRAFT1%LAUNCH%xtime = 32280.
!
!* number of flight segments
!
@@ -365,10 +361,10 @@ TAIRCRAFT2%STEP = 60.
!
!* take-off date and time
!
-TAIRCRAFT2%LAUNCH%TDATE%YEAR = 2007
-TAIRCRAFT2%LAUNCH%TDATE%MONTH = 04
-TAIRCRAFT2%LAUNCH%TDATE%DAY = 19
-TAIRCRAFT2%LAUNCH%TIME = 48060.
+TAIRCRAFT2%LAUNCH%nyear = 2007
+TAIRCRAFT2%LAUNCH%nmonth = 04
+TAIRCRAFT2%LAUNCH%nday = 19
+TAIRCRAFT2%LAUNCH%xtime = 48060.
!
!* number of flight segments
!
@@ -624,10 +620,10 @@ TAIRCRAFT3%STEP = 30.
!
!* take-off date and time
!
-TAIRCRAFT3%LAUNCH%TDATE%YEAR = 2007
-TAIRCRAFT3%LAUNCH%TDATE%MONTH = 04
-TAIRCRAFT3%LAUNCH%TDATE%DAY = 19
-TAIRCRAFT3%LAUNCH%TIME = 45369
+TAIRCRAFT3%LAUNCH%nyear = 2007
+TAIRCRAFT3%LAUNCH%nmonth = 04
+TAIRCRAFT3%LAUNCH%nday = 19
+TAIRCRAFT3%LAUNCH%xtime = 45369
!
!* number of flight segments
!
@@ -731,10 +727,10 @@ TAIRCRAFT4%STEP = 30.
!
!* take-off date and time
!
-TAIRCRAFT4%LAUNCH%TDATE%YEAR = 2007
-TAIRCRAFT4%LAUNCH%TDATE%MONTH = 04
-TAIRCRAFT4%LAUNCH%TDATE%DAY = 19
-TAIRCRAFT4%LAUNCH%TIME = 60392.
+TAIRCRAFT4%LAUNCH%nyear = 2007
+TAIRCRAFT4%LAUNCH%nmonth = 04
+TAIRCRAFT4%LAUNCH%nday = 19
+TAIRCRAFT4%LAUNCH%xtime = 60392.
!
!* number of flight segments
!
@@ -837,10 +833,10 @@ TAIRCRAFT5%STEP = 30.
!
!* take-off date and time
!
-TAIRCRAFT5%LAUNCH%TDATE%YEAR = 2007
-TAIRCRAFT5%LAUNCH%TDATE%MONTH = 04
-TAIRCRAFT5%LAUNCH%TDATE%DAY = 19
-TAIRCRAFT5%LAUNCH%TIME = 43380.
+TAIRCRAFT5%LAUNCH%nyear = 2007
+TAIRCRAFT5%LAUNCH%nmonth = 04
+TAIRCRAFT5%LAUNCH%nday = 19
+TAIRCRAFT5%LAUNCH%xtime = 43380.
!
!* number of flight segments
!
@@ -1081,10 +1077,10 @@ TAIRCRAFT6%STEP = 30.
!
!* take-off date and time
!
-TAIRCRAFT6%LAUNCH%TDATE%YEAR = 2007
-TAIRCRAFT6%LAUNCH%TDATE%MONTH = 04
-TAIRCRAFT6%LAUNCH%TDATE%DAY = 19
-TAIRCRAFT6%LAUNCH%TIME = 55992.
+TAIRCRAFT6%LAUNCH%nyear = 2007
+TAIRCRAFT6%LAUNCH%nmonth = 04
+TAIRCRAFT6%LAUNCH%nday = 19
+TAIRCRAFT6%LAUNCH%xtime = 55992.
!
!* number of flight segments
!
@@ -1322,10 +1318,10 @@ TAIRCRAFT7%STEP = 60.
!
!* take-off date and time
!
-TAIRCRAFT7%LAUNCH%TDATE%YEAR = 2007
-TAIRCRAFT7%LAUNCH%TDATE%MONTH = 04
-TAIRCRAFT7%LAUNCH%TDATE%DAY = 19
-TAIRCRAFT7%LAUNCH%TIME = 43500.
+TAIRCRAFT7%LAUNCH%nyear = 2007
+TAIRCRAFT7%LAUNCH%nmonth = 04
+TAIRCRAFT7%LAUNCH%nday = 19
+TAIRCRAFT7%LAUNCH%xtime = 43500.
!
!* number of flight segments
!
@@ -1593,10 +1589,10 @@ TAIRCRAFT8%STEP = 60.
!
!* take-off date and time
!
-TAIRCRAFT8%LAUNCH%TDATE%YEAR = 2007
-TAIRCRAFT8%LAUNCH%TDATE%MONTH = 04
-TAIRCRAFT8%LAUNCH%TDATE%DAY = 22
-TAIRCRAFT8%LAUNCH%TIME = 45720.
+TAIRCRAFT8%LAUNCH%nyear = 2007
+TAIRCRAFT8%LAUNCH%nmonth = 04
+TAIRCRAFT8%LAUNCH%nday = 22
+TAIRCRAFT8%LAUNCH%xtime = 45720.
!
!* number of flight segments
!
@@ -1867,10 +1863,10 @@ TAIRCRAFT9%STEP = 60.
!
!* take-off date and time
!
-TAIRCRAFT9%LAUNCH%TDATE%YEAR = 2007
-TAIRCRAFT9%LAUNCH%TDATE%MONTH = 04
-TAIRCRAFT9%LAUNCH%TDATE%DAY = 23
-TAIRCRAFT9%LAUNCH%TIME = 28080.
+TAIRCRAFT9%LAUNCH%nyear = 2007
+TAIRCRAFT9%LAUNCH%nmonth = 04
+TAIRCRAFT9%LAUNCH%nday = 23
+TAIRCRAFT9%LAUNCH%xtime = 28080.
!
!* number of flight segments
!
diff --git a/src/MNH/ini_aircraft_balloon.f90 b/src/MNH/ini_aircraft_balloon.f90
index 2d5cc4fb336ba31365415304c56fe39c3001fc81..0b22d34031958913fa591c450709ede432d98301 100644
--- a/src/MNH/ini_aircraft_balloon.f90
+++ b/src/MNH/ini_aircraft_balloon.f90
@@ -1,8 +1,12 @@
-!MNH_LIC Copyright 2000-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 01/10/2020: bugfix: DEFAULT_FLYER: add missing default values
+!-----------------------------------------------------------------
+
! #########################
MODULE MODI_INI_AIRCRAFT_BALLOON
! #########################
@@ -74,6 +78,7 @@ END MODULE MODI_INI_AIRCRAFT_BALLOON
!! March, 2013 : O.Caumont, C.Lac : add vertical profiles
!! OCT,2016 : G.Delautier LIMA
!! 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
!!
!! --------------------------------------------------------------------------
!
@@ -84,13 +89,13 @@ USE MODD_AIRCRAFT_BALLOON
USE MODD_CONF
USE MODD_DIAG_FLAG
USE MODD_DYN_n
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_GRID
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAM_n, ONLY: CCLOUD
USE MODD_PARAMETERS
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_GRIDPROJ
USE MODE_ll
USE MODE_MODELN_HANDLER
@@ -318,15 +323,24 @@ TPFLYER%STEP = 60. ! s
!
TPFLYER%LAT = XUNDEF
TPFLYER%LON = XUNDEF
+TPFLYER%XLAUNCH = XUNDEF! X coordinate of launch
+TPFLYER%YLAUNCH = XUNDEF! Y coordinate of launch
TPFLYER%ALT = XUNDEF
TPFLYER%WASCENT = 5. ! m/s
TPFLYER%RHO = XUNDEF
TPFLYER%PRES = XUNDEF
+TPFLYER%DIAMETER= XUNDEF
+TPFLYER%AERODRAG= XUNDEF
+TPFLYER%INDDRAG = XUNDEF
+TPFLYER%VOLUME = XUNDEF
+TPFLYER%MASS = XUNDEF
!
TPFLYER%SEG = 0
TPFLYER%SEGCURN = 1
TPFLYER%SEGCURT = 0.
!
+TPFLYER%ALTDEF = .FALSE.
+!
TPFLYER%X_CUR = XUNDEF
TPFLYER%Y_CUR = XUNDEF
TPFLYER%Z_CUR = XUNDEF
@@ -355,7 +369,7 @@ IF (TPFLYER%NMODEL > 0) THEN
ENDIF
!
!
-ALLOCATE(TPFLYER%TIME(ISTORE))
+allocate( tpflyer%tpdates(istore) )
ALLOCATE(TPFLYER%X (ISTORE))
ALLOCATE(TPFLYER%Y (ISTORE))
ALLOCATE(TPFLYER%Z (ISTORE))
@@ -390,13 +404,11 @@ END IF
ALLOCATE(TPFLYER%TKE_DISS(ISTORE))
ALLOCATE(TPFLYER%TSRAD (ISTORE))
ALLOCATE(TPFLYER%ZS (ISTORE))
-ALLOCATE(TPFLYER%DATIME(16,ISTORE))
!
ALLOCATE(TPFLYER%THW_FLUX (ISTORE))
ALLOCATE(TPFLYER%RCW_FLUX (ISTORE))
ALLOCATE(TPFLYER%SVW_FLUX (ISTORE,KSV))
!
-TPFLYER%TIME = XUNDEF
TPFLYER%X = XUNDEF
TPFLYER%Y = XUNDEF
TPFLYER%Z = XUNDEF
@@ -428,23 +440,6 @@ TPFLYER%TKE = XUNDEF
TPFLYER%TSRAD = XUNDEF
TPFLYER%ZS = XUNDEF
TPFLYER%TKE_DISS = XUNDEF
-TPFLYER%DATIME( 1,1:ISTORE) = TPDTSEG%TDATE%YEAR
-TPFLYER%DATIME( 2,1:ISTORE) = TPDTSEG%TDATE%MONTH
-TPFLYER%DATIME( 3,1:ISTORE) = TPDTSEG%TDATE%DAY
-TPFLYER%DATIME( 4,1:ISTORE) = TPDTSEG%TIME
-TPFLYER%DATIME( 5,1:ISTORE) = TPDTSEG%TDATE%YEAR
-TPFLYER%DATIME( 6,1:ISTORE) = TPDTSEG%TDATE%MONTH
-TPFLYER%DATIME( 7,1:ISTORE) = TPDTSEG%TDATE%DAY
-TPFLYER%DATIME( 8,1:ISTORE) = TPDTSEG%TIME
-TPFLYER%DATIME( 9,1:ISTORE) = TPDTSEG%TDATE%YEAR
-TPFLYER%DATIME(10,1:ISTORE) = TPDTSEG%TDATE%MONTH
-TPFLYER%DATIME(11,1:ISTORE) = TPDTSEG%TDATE%DAY
-TPFLYER%DATIME(12,1:ISTORE) = TPDTSEG%TIME
-TPFLYER%DATIME(13,1:ISTORE) = TPDTSEG%TDATE%YEAR
-TPFLYER%DATIME(14,1:ISTORE) = TPDTSEG%TDATE%MONTH
-TPFLYER%DATIME(15,1:ISTORE) = TPDTSEG%TDATE%DAY
-TPFLYER%DATIME(16,1:ISTORE) = XUNDEF
-
!
TPFLYER%THW_FLUX = XUNDEF
TPFLYER%RCW_FLUX = XUNDEF
diff --git a/src/MNH/ini_balloon.f90 b/src/MNH/ini_balloon.f90
index 47a98ccc5d56146b09ce149cee76bb19c18cfff1..71e935021ef69f07716cc6491b7613de82328b4f 100644
--- a/src/MNH/ini_balloon.f90
+++ b/src/MNH/ini_balloon.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 balloon 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ######################
SUBROUTINE INI_BALLOON
! ######################
@@ -139,10 +134,10 @@ TBALLOON1%TITLE = 'CVB1MOBI'
!
!* launching date and time
!
-TBALLOON1%LAUNCH%TDATE%YEAR = 1999
-TBALLOON1%LAUNCH%TDATE%MONTH = 09
-TBALLOON1%LAUNCH%TDATE%DAY = 19
-TBALLOON1%LAUNCH%TIME = 32460.
+TBALLOON1%LAUNCH%nyear = 1999
+TBALLOON1%LAUNCH%nmonth = 09
+TBALLOON1%LAUNCH%nday = 19
+TBALLOON1%LAUNCH%xtime = 32460.
!
!* latitude and longitude of launching site (decimal degree)
!
@@ -194,10 +189,10 @@ TBALLOON2%TITLE = 'CVB2MOBI'
!
!* launching date and time
!
-TBALLOON2%LAUNCH%TDATE%YEAR = 1999
-TBALLOON2%LAUNCH%TDATE%MONTH = 09
-TBALLOON2%LAUNCH%TDATE%DAY = 19
-TBALLOON2%LAUNCH%TIME = 39660.
+TBALLOON2%LAUNCH%nyear = 1999
+TBALLOON2%LAUNCH%nmonth = 09
+TBALLOON2%LAUNCH%nday = 19
+TBALLOON2%LAUNCH%xtime = 39660.
!
!* latitude and longitude of launching site (decimal degree)
!
@@ -250,10 +245,10 @@ TBALLOON3%TITLE = 'RSMASE19'
!
!* launching date and time
!
-TBALLOON3%LAUNCH%TDATE%YEAR = 1999
-TBALLOON3%LAUNCH%TDATE%MONTH = 09
-TBALLOON3%LAUNCH%TDATE%DAY = 19
-TBALLOON3%LAUNCH%TIME = 68400.
+TBALLOON3%LAUNCH%nyear = 1999
+TBALLOON3%LAUNCH%nmonth = 09
+TBALLOON3%LAUNCH%nday = 19
+TBALLOON3%LAUNCH%xtime = 68400.
!
!* latitude and longitude of launching site (decimal degree)
!
@@ -306,10 +301,10 @@ TBALLOON4%TITLE = 'CVB1ACVB'
!
!* launching date and time
!
-TBALLOON4%LAUNCH%TDATE%YEAR = 1999
-TBALLOON4%LAUNCH%TDATE%MONTH = 09
-TBALLOON4%LAUNCH%TDATE%DAY = 19
-TBALLOON4%LAUNCH%TIME = 32460.
+TBALLOON4%LAUNCH%nyear = 1999
+TBALLOON4%LAUNCH%nmonth = 09
+TBALLOON4%LAUNCH%nday = 19
+TBALLOON4%LAUNCH%xtime = 32460.
!
!* latitude and longitude of launching site (decimal degree)
!
@@ -361,10 +356,10 @@ TBALLOON5%TITLE = 'CVB1DEPA'
!
!* launching date and time
!
-TBALLOON5%LAUNCH%TDATE%YEAR = 1999
-TBALLOON5%LAUNCH%TDATE%MONTH = 09
-TBALLOON5%LAUNCH%TDATE%DAY = 19
-TBALLOON5%LAUNCH%TIME = 32435.
+TBALLOON5%LAUNCH%nyear = 1999
+TBALLOON5%LAUNCH%nmonth = 09
+TBALLOON5%LAUNCH%nday = 19
+TBALLOON5%LAUNCH%xtime = 32435.
!
!* latitude and longitude of launching site (decimal degree)
!
@@ -416,10 +411,10 @@ TBALLOON6%TITLE = 'CVB1RCVB'
!
!* launching date and time
!
-TBALLOON6%LAUNCH%TDATE%YEAR = 1999
-TBALLOON6%LAUNCH%TDATE%MONTH = 09
-TBALLOON6%LAUNCH%TDATE%DAY = 19
-TBALLOON6%LAUNCH%TIME = 32460.
+TBALLOON6%LAUNCH%nyear = 1999
+TBALLOON6%LAUNCH%nmonth = 09
+TBALLOON6%LAUNCH%nday = 19
+TBALLOON6%LAUNCH%xtime = 32460.
!
!* latitude and longitude of launching site (decimal degree)
!
@@ -471,10 +466,10 @@ TBALLOON7%TITLE = 'CVB1PISO'
!
!* launching date and time
!
-TBALLOON7%LAUNCH%TDATE%YEAR = 1999
-TBALLOON7%LAUNCH%TDATE%MONTH = 09
-TBALLOON7%LAUNCH%TDATE%DAY = 19
-TBALLOON7%LAUNCH%TIME = 32460.
+TBALLOON7%LAUNCH%nyear = 1999
+TBALLOON7%LAUNCH%nmonth = 09
+TBALLOON7%LAUNCH%nday = 19
+TBALLOON7%LAUNCH%xtime = 32460.
!
!* latitude and longitude of launching site (decimal degree)
!
diff --git a/src/MNH/ini_budget.f90 b/src/MNH/ini_budget.f90
index f0707d44a4f05f3929ac26bf41a1504d98f88bce..3152cb6e5e17022fc128393ad806dff7b7a08fa6 100644
--- a/src/MNH/ini_budget.f90
+++ b/src/MNH/ini_budget.f90
@@ -1,76 +1,112 @@
-!MNH_LIC Copyright 1995-2019 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.
!-----------------------------------------------------------------
-! ######################
- MODULE MODI_INI_BUDGET
-! ######################
-INTERFACE
- SUBROUTINE INI_BUDGET(KLUOUT,PTSTEP,KSV,KRR, &
- ONUMDIFU,ONUMDIFTH,ONUMDIFSV, &
- OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, &
- OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
- OHORELAX_SV,OVE_RELAX,OCHTRANS,ONUDGING,ODRAGTREE,ODEPOTREE, &
- HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD )
-!
-INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
-REAL, INTENT(IN) :: PTSTEP ! time step
-INTEGER, INTENT(IN) :: KSV ! number of scalar variables
-INTEGER, INTENT(IN) :: KRR ! number of moist variables
-LOGICAL, INTENT(IN) :: ONUMDIFU ! switch to activate the numerical
- ! diffusion for momentum
-LOGICAL, INTENT(IN) :: ONUMDIFTH ! for meteorological scalar variables
-LOGICAL, INTENT(IN) :: ONUMDIFSV ! for tracer scalar variables
-LOGICAL, INTENT(IN) :: OHORELAX_UVWTH ! switch for the
- ! horizontal relaxation for U,V,W,TH
-LOGICAL, INTENT(IN) :: OHORELAX_RV ! switch for the
- ! horizontal relaxation for Rv
-LOGICAL, INTENT(IN) :: OHORELAX_RC ! switch for the
- ! horizontal relaxation for Rc
-LOGICAL, INTENT(IN) :: OHORELAX_RR ! switch for the
- ! horizontal relaxation for Rr
-LOGICAL, INTENT(IN) :: OHORELAX_RI ! switch for the
- ! horizontal relaxation for Ri
-LOGICAL, INTENT(IN) :: OHORELAX_RS ! switch for the
- ! horizontal relaxation for Rs
-LOGICAL, INTENT(IN) :: OHORELAX_RG ! switch for the
- ! horizontal relaxation for Rg
-LOGICAL, INTENT(IN) :: OHORELAX_RH ! switch for the
- ! horizontal relaxation for Rh
-LOGICAL, INTENT(IN) :: OHORELAX_TKE ! switch for the
- ! horizontal relaxation for tke
-LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV ! switch for the
- ! horizontal relaxation for scalar variables
-LOGICAL, INTENT(IN) :: OVE_RELAX ! switch to activate the vertical
- ! relaxation
-LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective
- !transport for SV
-LOGICAL, INTENT(IN) :: ONUDGING ! switch to activate nudging
-LOGICAL, INTENT(IN) :: ODRAGTREE ! switch to activate vegetation drag
-LOGICAL, INTENT(IN) :: ODEPOTREE ! switch to activate droplet deposition on tree
-CHARACTER (LEN=*), INTENT(IN) :: HRAD ! type of the radiation scheme
-CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme
-CHARACTER (LEN=*), INTENT(IN) :: HSCONV ! type of the deep convection scheme
-CHARACTER (LEN=*), INTENT(IN) :: HTURB ! type of the turbulence scheme
-CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence
- ! scheme
-CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme
-!
- END SUBROUTINE INI_BUDGET
-!
-END INTERFACE
-!
-END MODULE MODI_INI_BUDGET
-!
-!
-!
+! Modifications:
+! P. Wautelet 17/08/2020: add Budget_preallocate subroutine
+!-----------------------------------------------------------------
+module mode_ini_budget
+
+ use mode_msg
+
+ implicit none
+
+ private
+
+ public :: Budget_preallocate, Ini_budget
+
+ integer, parameter :: NSOURCESMAX = 60 !Maximum number of sources in a budget
+
+contains
+
+subroutine Budget_preallocate()
+
+use modd_budget, only: nbudgets, tbudgets, &
+ 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
+use modd_nsv, only: csvnames, nsv
+
+integer :: ibudget
+integer :: jsv
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_preallocate', 'called' )
+
+if ( allocated( tbudgets ) ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Budget_preallocate', 'tbudgets already allocated' )
+ return
+end if
+
+nbudgets = NBUDGET_SV1 - 1 + nsv
+allocate( tbudgets( nbudgets ) )
+
+tbudgets(NBUDGET_U)%cname = "UU"
+tbudgets(NBUDGET_U)%ccomment = "Budget for U"
+tbudgets(NBUDGET_U)%nid = NBUDGET_U
+
+tbudgets(NBUDGET_V)%cname = "VV"
+tbudgets(NBUDGET_V)%ccomment = "Budget for V"
+tbudgets(NBUDGET_V)%nid = NBUDGET_V
+
+tbudgets(NBUDGET_W)%cname = "WW"
+tbudgets(NBUDGET_W)%ccomment = "Budget for W"
+tbudgets(NBUDGET_W)%nid = NBUDGET_W
+
+tbudgets(NBUDGET_TH)%cname = "TH"
+tbudgets(NBUDGET_TH)%ccomment = "Budget for potential temperature"
+tbudgets(NBUDGET_TH)%nid = NBUDGET_TH
+
+tbudgets(NBUDGET_TKE)%cname = "TK"
+tbudgets(NBUDGET_TKE)%ccomment = "Budget for turbulent kinetic energy"
+tbudgets(NBUDGET_TKE)%nid = NBUDGET_TKE
+
+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 = "RC"
+tbudgets(NBUDGET_RC)%ccomment = "Budget for cloud water mixing ratio"
+tbudgets(NBUDGET_RC)%nid = NBUDGET_RC
+
+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 = "RI"
+tbudgets(NBUDGET_RI)%ccomment = "Budget for cloud ice mixing ratio"
+tbudgets(NBUDGET_RI)%nid = NBUDGET_RI
+
+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 = "RG"
+tbudgets(NBUDGET_RG)%ccomment = "Budget for graupel mixing ratio"
+tbudgets(NBUDGET_RG)%nid = NBUDGET_RG
+
+tbudgets(NBUDGET_RH)%cname = "RH"
+tbudgets(NBUDGET_RH)%ccomment = "Budget for hail mixing ratio"
+tbudgets(NBUDGET_RH)%nid = NBUDGET_RH
+
+do jsv = 1, nsv
+ ibudget = NBUDGET_SV1 - 1 + jsv
+ tbudgets(ibudget)%cname = Trim( csvnames(jsv) )
+ tbudgets(ibudget)%ccomment = 'Budget for scalar variable ' // Trim( csvnames(jsv) )
+ tbudgets(ibudget)%nid = ibudget
+end do
+
+
+end subroutine Budget_preallocate
+
+
! #################################################################
- SUBROUTINE INI_BUDGET(KLUOUT,PTSTEP,KSV,KRR, &
+ SUBROUTINE Ini_budget(KLUOUT,PTSTEP,KSV,KRR, &
ONUMDIFU,ONUMDIFTH,ONUMDIFSV, &
OHORELAX_UVWTH,OHORELAX_RV,OHORELAX_RC,OHORELAX_RR, &
- OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
- OHORELAX_SV,OVE_RELAX,OCHTRANS,ONUDGING,ODRAGTREE,ODEPOTREE, &
+ OHORELAX_RI,OHORELAX_RS, OHORELAX_RG, OHORELAX_RH,OHORELAX_TKE, &
+ OHORELAX_SV, OVE_RELAX, ove_relax_grd, OCHTRANS, &
+ ONUDGING,ODRAGTREE,ODEPOTREE, OAERO_EOL, &
HRAD,HDCONV,HSCONV,HTURB,HTURBDIM,HCLOUD )
! #################################################################
!
@@ -98,12 +134,7 @@ END MODULE MODI_INI_BUDGET
!!
!! IMPLICIT ARGUMENTS
!! ------------------
-!! Module MODD_PARAMETERS: JPBUMAX,JPBUPROMAX
-!!
-!! Module MODD_CONF: CCONF
-!!
-!! Module MODD_DYN: XSEGLEN
-!!
+!! Modules MODD_*
!!
!! REFERENCE
!! ---------
@@ -129,7 +160,7 @@ END MODULE MODI_INI_BUDGET
!! N. Asencio 18/06/99 // MASK case : delete KIMAX and KJMAX arguments,
!! GET_DIM_EXT_ll initializes the dimensions of the
!! extended local domain.
-!! LBU_MASK and XBUSURF are allocated on the extended
+!! LBU_MASK and NBUSURF are allocated on the extended
!! local domain.
!! add 3 local variables IBUDIM1,IBUDIM2,IBUDIM3
!! to define the dimensions of the budget arrays
@@ -144,46 +175,95 @@ END MODULE MODI_INI_BUDGET
!! 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
-!! 04/2016 (C.LAC) negative contribution to the budget splitted between advection, turbulence and microphysics for KHKO/C2R2
-!! C. Barthe 01/2016 Add budget for LIMA
-!! C.Lac 10/2016 Add budget for droplet deposition
-!! S. Riette 11/2016 New budgets for ICE3/ICE4
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! C. Lac 04/2016: negative contribution to the budget split between advection, turbulence and microphysics for KHKO/C2R2
+! C. Barthe 01/2016: add budget for LIMA
+! C. Lac 10/2016: add budget for droplet deposition
+! S. Riette 11/2016: new budgets for ICE3/ICE4
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 15/11/2019: remove unused CBURECORD variable
+! P. Wautelet 24/02/2020: bugfix: corrected condition for budget NCDEPITH
+! P. Wautelet 26/02/2020: bugfix: rename CEVA->REVA for budget for raindrop evaporation in C2R2 (necessary after commit 4ed805fc)
+! P. Wautelet 26/02/2020: bugfix: add missing condition on OCOLD for NSEDIRH budget in LIMA case
+! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
+! B. Vie 02/03/2020: LIMA negativity checks after turbulence, advection and microphysics budgets
+! P .Wautelet 09/03/2020: add missing budgets for electricity
+! P. Wautelet 25/03/2020: add missing ove_relax_grd
+! P. Wautelet 23/04/2020: add nid in tbudgetdata datatype
+! P. Wautelet + Benoit Vié 11/06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! P. Wautelet 30/06/2020: use NADVSV when possible
+! P. Wautelet 30/06/2020: add NNETURSV, NNEADVSV and NNECONSV variables
+! P. Wautelet 06/07/2020: bugfix: add condition on HTURB for NETUR sources for SV budgets
+! P. Wautelet 08/12/2020: add nbusubwrite and nbutotwrite
+! P. Wautelet 11/01/2021: ignore xbuwri for cartesian boxes (write at every xbulen interval)
+! P. Wautelet 01/02/2021: bugfix: add missing CEDS source terms for SV budgets
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
+! P. Wautelet 03/02/2021: budgets: add new source if LIMA splitting: CORR2
+! P. Wautelet 10/02/2021: budgets: add missing sources for NSV_C2R2BEG+3 budget
+! P. Wautelet 11/02/2021: budgets: add missing term SCAV for NSV_LIMA_SCAVMASS budget
+! P. Wautelet 02/03/2021: budgets: add terms for blowing snow
+! P. Wautelet 04/03/2021: budgets: add terms for drag due to buildings
+! P. Wautelet 17/03/2021: choose source terms for budgets with character strings instead of multiple integer variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
-USE MODD_BUDGET
-USE MODD_DYN
-USE MODD_CONF
-USE MODD_PARAM_ICE
-USE MODD_PARAM_C2R2
-USE MODD_ELEC_DESCR, ONLY : LINDUCTIVE
-USE MODD_2D_FRC
-USE MODD_PARAM_LIMA, ONLY : OWARM=>LWARM, OCOLD=>LCOLD, OSEDI=>LSEDI, &
- OHHONI=>LHHONI, ORAIN=>LRAIN, OSEDC=>LSEDC, &
- ONUCL=>LNUCL, OACTI=>LACTI, OSNOW=>LSNOW, &
- OHAIL=>LHAIL, OSCAV=>LSCAV, OMEYERS=>LMEYERS,&
- ODEPOC=>LDEPOC, OPTSPLIT=>LPTSPLIT, &
- NMOD_CCN
-!
+use modd_2d_frc, only: l2d_adv_frc, l2d_rel_frc
+use modd_blowsnow, only: lblowsnow
+use modd_blowsnow_n, only: lsnowsubl
+use modd_budget
+use modd_ch_aerosol, only: lorilam
+use modd_conf, only: l1d, lcartesian, lforcing, lthinshell, nmodel
+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_elec_descr, only: linductive, lrelax2fw_ion
+use modd_field, only: TYPEREAL
+use modd_nsv, only: csvnames, &
+ nsv_aerbeg, nsv_aerend, nsv_aerdepbeg, nsv_aerdepend, nsv_c2r2beg, nsv_c2r2end, &
+ nsv_chembeg, nsv_chemend, nsv_chicbeg, nsv_chicend, nsv_csbeg, nsv_csend, &
+ nsv_dstbeg, nsv_dstend, nsv_dstdepbeg, nsv_dstdepend, nsv_elecbeg, nsv_elecend, &
+#ifdef MNH_FOREFIRE
+ nsv_ffbeg, nsv_ffend, &
+#endif
+ 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_spro, &
+ nsv_lnoxbeg, nsv_lnoxend, nsv_ppbeg, nsv_ppend, &
+ nsv_sltbeg, nsv_sltend, nsv_sltdepbeg, nsv_sltdepend, nsv_snwbeg, nsv_snwend, &
+ nsv_user
+use modd_parameters, only: jphext
+use modd_param_c2r2, only: ldepoc_c2r2 => ldepoc, lrain_c2r2 => lrain, lsedc_c2r2 => lsedc, lsupsat_c2r2 => lsupsat
+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, lspro_lima => lspro, lwarm_lima => lwarm, &
+ nmod_ccn, nmod_ifn, nmod_imm
+use modd_ref, only: lcouples
+use modd_salt, only: lsalt
+use modd_turb_n, only: lsubg_cond
+use modd_viscosity, only: lvisc, lvisc_r, lvisc_sv, lvisc_th, lvisc_uvw
+
USE MODE_ll
-USE MODE_MSG
-!
+
IMPLICIT NONE
!
!* 0.1 declarations of argument
!
!
INTEGER, INTENT(IN) :: KLUOUT ! Logical unit number for prints
-REAL, INTENT(IN) :: PTSTEP ! time step
+REAL, INTENT(IN) :: PTSTEP ! time step
INTEGER, INTENT(IN) :: KSV ! number of scalar variables
INTEGER, INTENT(IN) :: KRR ! number of moist variables
LOGICAL, INTENT(IN) :: ONUMDIFU ! switch to activate the numerical
@@ -210,13 +290,16 @@ LOGICAL, INTENT(IN) :: OHORELAX_TKE ! switch for the
! horizontal relaxation for tke
LOGICAL,DIMENSION(:),INTENT(IN):: OHORELAX_SV ! switch for the
! horizontal relaxation for scalar variables
-LOGICAL, INTENT(IN) :: OVE_RELAX ! switch to activate the vertical
+LOGICAL, INTENT(IN) :: OVE_RELAX ! switch to activate the vertical
! relaxation
-LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective
+logical, intent(in) :: ove_relax_grd ! switch to activate the vertical
+ ! relaxation to the lowest verticals
+LOGICAL, INTENT(IN) :: OCHTRANS ! switch to activate convective
!transport for SV
LOGICAL, INTENT(IN) :: ONUDGING ! switch to activate nudging
LOGICAL, INTENT(IN) :: ODRAGTREE ! switch to activate vegetation drag
LOGICAL, INTENT(IN) :: ODEPOTREE ! switch to activate droplet deposition on tree
+LOGICAL, INTENT(IN) :: OAERO_EOL ! switch to activate wind turbine wake
CHARACTER (LEN=*), INTENT(IN) :: HRAD ! type of the radiation scheme
CHARACTER (LEN=*), INTENT(IN) :: HDCONV ! type of the deep convection scheme
CHARACTER (LEN=*), INTENT(IN) :: HSCONV ! type of the shallow convection scheme
@@ -226,14 +309,11 @@ CHARACTER (LEN=*), INTENT(IN) :: HTURBDIM! dimensionnality of the turbulence
CHARACTER (LEN=*), INTENT(IN) :: HCLOUD ! type of microphysical scheme
!
!* 0.2 declarations of local variables
-!
-INTEGER, DIMENSION(JPBUMAX,JPBUPROMAX+1) :: IPROACTV ! switches set by the
- ! user for process
- ! activation
-INTEGER :: JI, JJ, JK , JJJ ! loop indices
+!
+real, parameter :: ITOL = 1e-6
+
+INTEGER :: JI, JJ ! loop indices
INTEGER :: IIMAX_ll, IJMAX_ll ! size of the physical global domain
-INTEGER :: ITEN ! tens for CBURECORD
-INTEGER :: IPROC ! counter for processes
INTEGER :: IIU, IJU ! size along x and y directions
! of the extended subdomain
INTEGER :: IBUDIM1 ! first dimension of the budget arrays
@@ -241,35 +321,17 @@ INTEGER :: IBUDIM1 ! first dimension of t
! = NBUKMAX in MASK case
INTEGER :: IBUDIM2 ! second dimension of the budget arrays
! = NBUJMAX in CART case
- ! = NBUWRNB in MASK case
+ ! = nbusubwrite in MASK case
INTEGER :: IBUDIM3 ! third dimension of the budget arrays
! = NBUKMAX in CART case
! = NBUMASK in MASK case
-LOGICAL :: GERROR ! switch for error in
- ! budget specifcation
-CHARACTER(LEN=7), DIMENSION(JPBUMAX) :: YEND_COMMENT ! last part of comment
- ! for budgets records
-CHARACTER(LEN=6), DIMENSION(JPBUMAX,JPBUPROMAX) :: YWORK2 ! used for
- ! concatenattion of
- ! comments for budgets
-CHARACTER(LEN=40) :: YSTRING
-INTEGER :: ILEN
-INTEGER :: JSV ! loop indice for the SVs
-INTEGER :: IBUPROCNBR_SV_MAX ! Max number of processes for the SVs
-INTEGER :: ILAST_PROC_NBR ! Index of the last process number
-INTEGER :: IINFO_ll ! return status of the interface routine
-INTEGER :: IRESP ! Return code of FM-routines
-!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!
-!!! the lines below must be update as soon as MODD_BUDGET is updated
-!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!-------------------------------------------------------------------------------
+INTEGER :: JSV ! loop indice for the SVs
+INTEGER :: IINFO_ll ! return status of the interface routine
+integer :: ibudget
+logical :: gtmp
+type(tbusourcedata) :: tzsource ! Used to prepare metadate of source terms
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget', 'called' )
!
!* 1. COMPUTE BUDGET VARIABLES
! ------------------------
@@ -285,21 +347,69 @@ ELSE
NBUKMAX = NBUKH - NBUKL +1
END IF
!
+if ( cbutype == 'CART' .or. cbutype == 'MASK' ) then
+ !Check if xbulen is a multiple of xtstep (within tolerance)
+ if ( Abs( Nint( xbulen / xtstep ) * xtstep - xbulen ) > ( ITOL * xtstep ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbulen is not a multiple of xtstep' )
+
+ if ( cbutype == 'CART' ) then
+ !Check if xseglen is a multiple of xbulen (within tolerance)
+ if ( Abs( Nint( xseglen / xbulen ) * xbulen - xseglen ) > ( ITOL * xseglen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbulen' )
+
+ !Write cartesian budgets every xbulen time period (do not take xbuwri into account)
+ xbuwri = xbulen
+
+ nbusubwrite = 1 !Number of budget time average periods for each write
+ nbutotwrite = nbusubwrite * Nint( xseglen / xbulen ) !Total number of budget time average periods
+ else if ( cbutype == 'MASK' ) then
+ !Check if xbuwri is a multiple of xtstep (within tolerance)
+ if ( Abs( Nint( xbuwri / xtstep ) * xtstep - xbuwri ) > ( ITOL * xtstep ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xtstep' )
+
+ !Check if xbuwri is a multiple of xbulen (within tolerance)
+ if ( Abs( Nint( xbuwri / xbulen ) * xbulen - xbuwri ) > ( ITOL * xbulen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xbuwri is not a multiple of xbulen' )
+
+ !Check if xseglen is a multiple of xbuwri (within tolerance)
+ if ( Abs( Nint( xseglen / xbuwri ) * xbuwri - xseglen ) > ( ITOL * xseglen ) ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'xseglen is not a multiple of xbuwri' )
+
+ nbusubwrite = Nint ( xbuwri / xbulen ) !Number of budget time average periods for each write
+ nbutotwrite = nbusubwrite * Nint( xseglen / xbuwri ) !Total number of budget time average periods
+ end if
+end if
+
IF (CBUTYPE=='CART') THEN ! cartesian case only
!
- NBUWRNB = NINT (XBUWRI / XBULEN) ! only after NBUWRNB budget periods, we write the
- ! result on the FM_FILE
- IF (LBU_ICP) THEN
+ IF ( NBUIL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too small (<1)' )
+ IF ( NBUIL > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIL too large (>NIMAX)' )
+ IF ( NBUIH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too small (<1)' )
+ IF ( NBUIH > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH too large (>NIMAX)' )
+ IF ( NBUIH < NBUIL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUIH < NBUIL' )
+ IF (LBU_ICP) THEN
NBUIMAX_ll = 1
ELSE
NBUIMAX_ll = NBUIH - NBUIL +1
END IF
- IF (LBU_JCP) THEN
+
+ IF ( NBUJL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too small (<1)' )
+ IF ( NBUJL > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJL too large (>NJMAX)' )
+ IF ( NBUJH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too small (<1)' )
+ IF ( NBUJH > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH too large (>NJMAX)' )
+ IF ( NBUJH < NBUJL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUJH < NBUJL' )
+ IF (LBU_JCP) THEN
NBUJMAX_ll = 1
ELSE
NBUJMAX_ll = NBUJH - NBUJL +1
END IF
-!
+
+ IF ( NBUKL < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too small (<1)' )
+ IF ( NBUKL > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKL too large (>NKMAX)' )
+ IF ( NBUKH < 1 ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too small (<1)' )
+ IF ( NBUKH > NKMAX ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH too large (>NKMAX)' )
+ IF ( NBUKH < NBUKL ) CALL Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'NBUKH < NBUKL' )
+
CALL GET_INTERSECTION_ll(NBUIL+JPHEXT,NBUJL+JPHEXT,NBUIH+JPHEXT,NBUJH+JPHEXT, &
NBUSIL,NBUSJL,NBUSIH,NBUSJH,"PHYS",IINFO_ll)
IF ( IINFO_ll /= 1 ) THEN !
@@ -328,15 +438,14 @@ IF (CBUTYPE=='CART') THEN ! cartesian case only
ELSEIF (CBUTYPE=='MASK') THEN ! mask case only
!
LBU_ENABLE=.TRUE.
- NBUWRNB = NINT (XBUWRI / XBULEN) ! only after NBUWRNB budget periods, we write the
! result on the FM_FILE
NBUTIME = 1
CALL GET_DIM_EXT_ll ('B', IIU,IJU)
ALLOCATE( LBU_MASK( IIU ,IJU, NBUMASK) )
LBU_MASK(:,:,:)=.FALSE.
- ALLOCATE( XBUSURF( IIU, IJU, NBUMASK, NBUWRNB) )
- XBUSURF(:,:,:,:) = 0.
+ ALLOCATE( NBUSURF( IIU, IJU, NBUMASK, nbusubwrite) )
+ NBUSURF(:,:,:,:) = 0
!
! three first dimensions of budget arrays in mask case
! the order of the dimensions are the order expected in WRITE_DIACHRO routine:
@@ -345,7 +454,7 @@ ELSEIF (CBUTYPE=='MASK') THEN ! mask case only
! second dimension of the arrays : number of the budget time period
! third dimension of the arrays : number of the budget masks zones
IBUDIM1=NBUKMAX
- IBUDIM2=NBUWRNB
+ IBUDIM2=nbusubwrite
IBUDIM3=NBUMASK
! these variables are not used in this case
NBUIMAX=-1
@@ -357,7 +466,6 @@ ELSEIF (CBUTYPE=='MASK') THEN ! mask case only
NBUIH=IIMAX_ll + 2 * JPHEXT
NBUJL=1
NBUJH=IJMAX_ll + 2 * JPHEXT
-
!
ELSE ! default case
!
@@ -391,17 +499,6 @@ END IF
!* 2. ALLOCATE MEMORY FOR BUDGET ARRAYS AND INITIALIZE
! ------------------------------------------------
!
-ALLOCATE( NBUPROCNBR(JPBUMAX) )
-ALLOCATE( NBUPROCCTR(JPBUMAX) )
-ALLOCATE( CBUACTION(JPBUMAX, JPBUPROMAX) )
-ALLOCATE( CBUCOMMENT(JPBUMAX, JPBUPROMAX) )
-ALLOCATE( CBURECORD(JPBUMAX, JPBUPROMAX) )
-NBUPROCCTR(:) = 0
-NBUCTR_ACTV(:) = 0
-NBUPROCNBR(:) = 0
-CBUACTION(:,:) = 'OF'
-CBURECORD(:,:) = ' '
-CBUCOMMENT(:,:) = ' '
LBU_BEG =.TRUE.
!
!-------------------------------------------------------------------------------
@@ -409,2368 +506,3568 @@ LBU_BEG =.TRUE.
!* 3. INITALIZE VARIABLES
! -------------------
!
-IPROACTV(:,:) = 3
-IPROACTV(:,4) = 1
-IPROACTV(:,JPBUPROMAX+1) = 0
-GERROR=.FALSE.
-YWORK2(:,:) = ' '
-YEND_COMMENT(:) = ' '
-!
-! Budget of RU
-IF (LBU_RU) THEN
- IPROC=4
- IPROACTV(1,IPROC) = NASSEU
- IPROC=IPROC+1
- IF( NMODEL>1 ) IPROACTV(1,IPROC) = NNESTU
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(1,IPROC) = NFRCU
- IPROC=IPROC+1
- IF( ONUDGING ) IPROACTV(1,IPROC) = NNUDU
- IPROC=IPROC+1
- IF ( .NOT. LCARTESIAN ) THEN
- IPROACTV(1,IPROC) = NCURVU
- ELSE
- IPROACTV(1,IPROC) = 4
- END IF
- IPROC=IPROC+1
- IF ( LCORIO ) THEN
- IPROACTV(1,IPROC) = NCORU
- ELSE
- IPROACTV(1,IPROC) = 4
- END IF
- IPROC=IPROC+1
- IF ( ONUMDIFU ) IPROACTV(1,IPROC) = NDIFU
- IPROC=IPROC+1
- IF ( OHORELAX_UVWTH .OR. OVE_RELAX ) THEN
- IPROACTV(1,IPROC) = NRELU
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(1,IPROC) = 4
- ELSE
- IPROACTV(1,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF( ODRAGTREE ) IPROACTV(1,IPROC) = NDRAGU
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' ) IPROACTV(1,IPROC) = NVTURBU
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
- IPROACTV(1,IPROC) = NHTURBU
- ELSE
- IF ( HTURB /= 'NONE' ) THEN
- IPROACTV(1,IPROC) = 4
- ELSE
- IPROACTV(1,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF ( HSCONV == 'EDKF' ) IPROACTV(1,IPROC) = NMAFLU
- IPROC=IPROC+1
- IPROACTV(1,IPROC) = NADVU
- IPROC=IPROC+1
- IPROACTV(1,IPROC) = NPRESU
-!
- YWORK2(1,1) = 'INIF_'
- YWORK2(1,2) = 'ENDF_'
- YWORK2(1,3) = 'AVEF_'
- IPROC=4
- YWORK2(1,IPROC) = 'ASSE_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'NEST_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'FRC_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'NUD_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'CURV_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'COR_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'DIF_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'DRAG_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'VTURB_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'HTURB_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'MAFL_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(1,IPROC) = 'PRES_'
-!
- YEND_COMMENT(1) = 'BU_RU'
- NBUPROCNBR(1) = 3
-!
- CBUACTION(1,1) = 'IG'
- CBUACTION(1,2) = 'CC'
- CBUACTION(1,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(1,JJ) = ADJUSTL( ADJUSTR( YWORK2(1,JJ) ) // &
- ADJUSTL( YEND_COMMENT(1) ) )
- END DO
-!
-END IF
-!
-! Budget of RV
-IF (LBU_RV) THEN
- IPROC=4
- IPROACTV(2,IPROC) = NASSEV
- IPROC=IPROC+1
- IF( NMODEL>1 ) IPROACTV(2,IPROC) = NNESTV
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(2,IPROC) = NFRCV
- IPROC=IPROC+1
- IF( ONUDGING ) IPROACTV(2,IPROC) = NNUDV
- IPROC=IPROC+1
- IF ( .NOT. LCARTESIAN ) THEN
- IPROACTV(2,IPROC) = NCURVV
- ELSE
- IPROACTV(2,IPROC) = 4
- END IF
- IPROC=IPROC+1
- IF ( LCORIO ) THEN
- IPROACTV(2,IPROC) = NCORV
- ELSE
- IPROACTV(2,IPROC) = 4
- END IF
- IPROC=IPROC+1
- IF ( ONUMDIFU ) IPROACTV(2,IPROC) = NDIFV
- IPROC=IPROC+1
- IF ( OHORELAX_UVWTH .OR. OVE_RELAX ) THEN
- IPROACTV(2,IPROC) = NRELV
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(2,IPROC) = 4
- ELSE
- IPROACTV(2,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF( ODRAGTREE ) IPROACTV(2,IPROC) = NDRAGV
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' ) IPROACTV(2,IPROC) = NVTURBV
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
- IPROACTV(2,IPROC) = NHTURBV
- ELSE
- IF ( HTURB /= 'NONE' ) THEN
- IPROACTV(2,IPROC) = 4
- ELSE
- IPROACTV(2,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF ( HSCONV == 'EDKF' ) IPROACTV(2,IPROC) = NMAFLV
- IPROC=IPROC+1
- IPROACTV(2,IPROC) = NADVV
- IPROC=IPROC+1
- IPROACTV(2,IPROC) = NPRESV
-!
- YWORK2(2,1) = 'INIF_'
- YWORK2(2,2) = 'ENDF_'
- YWORK2(2,3) = 'AVEF_'
- IPROC=4
- YWORK2(2,IPROC) = 'ASSE_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'NEST_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'FRC_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'NUD_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'CURV_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'COR_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'DIF_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'DRAG_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'VTURB_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'HTURB_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'MAFL_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(2,IPROC) = 'PRES_'
-!
- YEND_COMMENT(2) = 'BU_RV'
- NBUPROCNBR(2) = 3
-!
- CBUACTION(2,1) = 'IG'
- CBUACTION(2,2) = 'CC'
- CBUACTION(2,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(2,JJ) = ADJUSTL( ADJUSTR( YWORK2(2,JJ) ) // &
- ADJUSTL( YEND_COMMENT(2) ) )
- END DO
-!
-END IF
-!
-! Budget of RW
-IF (LBU_RW) THEN
- IPROC=4
- IPROACTV(3,IPROC) = NASSEW
- IPROC=IPROC+1
- IF( NMODEL>1 ) IPROACTV(3,IPROC) = NNESTW
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(3,IPROC) = NFRCW
- IPROC=IPROC+1
- IF( ONUDGING ) IPROACTV(3,IPROC) = NNUDW
- IPROC=IPROC+1
- IF ( .NOT. LCARTESIAN ) THEN
- IPROACTV(3,IPROC) = NCURVW
- ELSE
- IPROACTV(3,IPROC) = 4
- END IF
- IPROC=IPROC+1
- IF ( LCORIO ) THEN
- IPROACTV(3,IPROC) = NCORW
- ELSE
- IPROACTV(3,IPROC) = 4
- END IF
- IPROC=IPROC+1
- IF ( ONUMDIFU ) IPROACTV(3,IPROC) = NDIFW
- IPROC=IPROC+1
- IF ( OHORELAX_UVWTH .OR. OVE_RELAX ) THEN
- IPROACTV(3,IPROC) = NRELW
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(3,IPROC) = 4
- ELSE
- IPROACTV(3,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' ) IPROACTV(3,IPROC) = NVTURBW
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
- IPROACTV(3,IPROC) = NHTURBW
- ELSE
- IF ( HTURB /= 'NONE' ) THEN
- IPROACTV(3,IPROC) = 4
- ELSE
- IPROACTV(3,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IPROACTV(3,IPROC) = NGRAVW
- IPROC=IPROC+1
- IPROACTV(3,IPROC) = NADVW
- IPROC=IPROC+1
- IPROACTV(3,IPROC) = NPRESW
-!
- YWORK2(3,1) = 'INIF_'
- YWORK2(3,2) = 'ENDF_'
- YWORK2(3,3) = 'AVEF_'
- IPROC=4
- YWORK2(3,IPROC) = 'ASSE_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'NEST_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'FRC_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'NUD_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'CURV_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'COR_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'DIF_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'VTURB_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'HTURB_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'GRAV_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(3,IPROC) = 'PRES_'
-!
- YEND_COMMENT(3) = 'BU_RW'
- NBUPROCNBR(3) = 3
-!
- CBUACTION(3,1) = 'IG'
- CBUACTION(3,2) = 'CC'
- CBUACTION(3,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(3,JJ) = ADJUSTL( ADJUSTR( YWORK2(3,JJ) ) // &
- ADJUSTL( YEND_COMMENT(3) ) )
- END DO
-!
-END IF
-!
-! Budget of RTH
-IF (LBU_RTH) THEN
- IPROC=4
- IPROACTV(4,IPROC) = NASSETH
- IPROC=IPROC+1
- IF( NMODEL>1 ) IPROACTV(4,IPROC) = NNESTTH
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(4,IPROC) = NFRCTH
- IPROC=IPROC+1
- IF( L2D_ADV_FRC ) IPROACTV(4,IPROC) = N2DADVTH
- IPROC=IPROC+1
- IF( L2D_REL_FRC ) IPROACTV(4,IPROC) = N2DRELTH
- IPROC=IPROC+1
- IF( ONUDGING ) IPROACTV(4,IPROC) = NNUDTH
- IPROC=IPROC+1
- IF ( KRR > 0 ) THEN
- IF(.NOT.L1D) IPROACTV(4,IPROC) = NPREFTH
- ELSE
- IPROACTV(4,IPROC) = 4
- END IF
- IPROC=IPROC+1
- IF ( ONUMDIFTH ) IPROACTV(4,IPROC) = NDIFTH
- IPROC=IPROC+1
- IF ( OHORELAX_UVWTH .OR. OVE_RELAX ) THEN
- IPROACTV(4,IPROC) = NRELTH
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(4,IPROC) = 4
- ELSE
- IPROACTV(4,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF ( HRAD /= 'NONE' ) IPROACTV(4,IPROC) = NRADTH
- IPROC=IPROC+1
- IF ( HDCONV /= 'NONE' .OR. HSCONV == 'KAFR') IPROACTV(4,IPROC) = NDCONVTH
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' ) IPROACTV(4,IPROC) = NVTURBTH
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
- IPROACTV(4,IPROC) = NHTURBTH
- ELSE
- IF ( HTURB /= 'NONE' ) THEN
- IPROACTV(4,IPROC) = 4
- ELSE
- IPROACTV(4,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF (HTURB /= 'NONE') IPROACTV(4,IPROC) = NDISSHTH
- IPROC=IPROC+1
- IF (HTURB /= 'NONE' .AND. ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2'))) &
- IPROACTV(4,IPROC) = NNETURTH
- IPROC=IPROC+1
- IF ( HSCONV == 'EDKF' ) IPROACTV(4,IPROC) = NMAFLTH
- IPROC=IPROC+1
- IPROACTV(4,IPROC) = NADVTH
- IPROC=IPROC+1
- IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) IPROACTV(4,IPROC) = NNEADVTH
- IPROC=IPROC+1
- IF (HCLOUD /= 'NONE' .AND. HCLOUD /= 'KHKO' .AND. HCLOUD /= 'C2R2') &
- IPROACTV(4,IPROC) = NNEGATH
- IPROC=IPROC+1
- IF (HCLOUD == 'LIMA') THEN
- IF (OPTSPLIT) IPROACTV(4,IPROC) = NSEDITH
- IPROC=IPROC+1
- IF (OWARM .AND. OACTI .AND. NMOD_CCN.GE.1) IPROACTV(4,IPROC) = NHENUTH
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT) THEN
- IF (OWARM .AND. ORAIN) IPROACTV(4,IPROC) = NREVATH
- IPROC=IPROC+1
- END IF
- IF (OCOLD .AND. ONUCL) IPROACTV(4,IPROC) = NHINDTH
- IPROC=IPROC+1
- IF (OCOLD .AND. ONUCL) IPROACTV(4,IPROC) = NHINCTH
- IPROC=IPROC+1
- IF (OCOLD .AND. ONUCL .AND. OHHONI .AND. NMOD_CCN.GE.1) IPROACTV(4,IPROC) = NHONHTH
- IPROC=IPROC+1
- IF (OPTSPLIT) THEN
- IPROACTV(4,IPROC) = NREVATH
- IPROC=IPROC+1
- END IF
- IF (OCOLD .AND. OWARM .AND. ONUCL) IPROACTV(4,IPROC) = NHONCTH
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. ONUCL .AND. ORAIN)) IPROACTV(4,IPROC) = NHONRTH
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) IPROACTV(4,IPROC) = NDEPSTH
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(4,IPROC) = NDEPGTH
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM)) IPROACTV(4,IPROC) = NIMLTTH
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM)) IPROACTV(4,IPROC) = NBERFITH
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(4,IPROC) = NRIMTH
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW .AND. ORAIN)) IPROACTV(4,IPROC) = NACCTH
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(4,IPROC) = NCFRZTH
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(4,IPROC) = NWETGTH
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(4,IPROC) = NDRYGTH
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(4,IPROC) = NGMLTTH
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT .AND. OHAIL) IPROACTV(4,IPROC) = NWETHTH
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT .AND. OHAIL) IPROACTV(4,IPROC) = NHMLTTH
- IPROC=IPROC+1
- IPROACTV(4,IPROC) = NCEDSTH
- IPROC=IPROC+1
- ELSE
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. LADJ_BEFORE) IPROACTV(4,IPROC) = NADJUTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .OR. (HCLOUD == 'C2R2' .AND. (.NOT. LSUPSAT)) &
- .OR. ( HCLOUD == 'KHKO' .AND. (.NOT. LSUPSAT)) ) &
- IPROACTV(4,IPROC) = NHENUTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NHONTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NSFRTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NDEPSTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NDEPGTH
- IPROC=IPROC+1
- IF (((HCLOUD(1:3) == 'ICE') .AND. LWARM) .OR. ((HCLOUD == 'C2R2' &
- .OR. HCLOUD == 'KHKO') .AND. LRAIN) .OR. HCLOUD(1:3) == 'KES') &
- IPROACTV(4,IPROC) = NREVATH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NRIMTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NACCTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NCFRZTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NWETGTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NDRYGTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NGMLTTH
- IPROC=IPROC+1
- IF (HCLOUD == 'ICE4') IPROACTV(4,IPROC) = NWETHTH
- IPROC=IPROC+1
- IF (HCLOUD == 'ICE4'.AND. LRED) IPROACTV(4,IPROC) = NDRYHTH
- IPROC=IPROC+1
- IF (HCLOUD == 'ICE4') IPROACTV(4,IPROC) = NHMLTTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NIMLTTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(4,IPROC) = NBERFITH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED) IPROACTV(4,IPROC) = NCORRTH
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. .NOT. LRED .OR. (LRED .AND. LADJ_AFTER)) &
- IPROACTV(4,IPROC) = NCDEPITH
- IPROC=IPROC+1
- IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' .OR. HCLOUD(1:3) == 'KES' .OR. &
- HCLOUD == 'REVE') IPROACTV(4,IPROC) = NCONDTH
- IPROC=IPROC+1
- IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2'))&
- IPROACTV(4,IPROC) = NNECONTH
- END IF
-!
- YWORK2(4,1) = 'INIF_'
- YWORK2(4,2) = 'ENDF_'
- YWORK2(4,3) = 'AVEF_'
- IPROC=4
- YWORK2(4,IPROC) = 'ASSE_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'NEST_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'FRC_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = '2DADV_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = '2DREL_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'NUD_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'PREF_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'DIF_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'RAD_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'DCONV_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'VTURB_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'HTURB_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'DISSH_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'NETUR_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'MAFL_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'NEADV_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'NEGA_'
- IPROC=IPROC+1
-
- IF (HCLOUD == 'LIMA') THEN
- YWORK2(4,IPROC) = 'SEDI_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'HENU_'
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT) THEN
- YWORK2(4,IPROC) = 'REVA_'
- IPROC=IPROC+1
- END IF
- YWORK2(4,IPROC) = 'HIND_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'HINC_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'HONH_'
- IPROC=IPROC+1
- IF (OPTSPLIT) THEN
- YWORK2(4,IPROC) = 'REVA_'
- IPROC=IPROC+1
- END IF
- YWORK2(4,IPROC) = 'HONC_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'HONR_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'DEPS_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'DEPG_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'IMLT_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'BERFI_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'RIM_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'ACC_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'CFRZ_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'WETG_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'DRYG_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'GMLT_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'WETH_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'HMLT_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'CEDS_'
- IPROC=IPROC+1
- ELSE
- YWORK2(4,IPROC) = 'ADJU_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'HENU_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'HON_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'SFR_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'DEPS_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'DEPG_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'REVA_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'RIM_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'ACC_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'CFRZ_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'WETG_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'DRYG_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'GMLT_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'WETH_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'DRYH_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'HMLT_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'IMLT_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'BERFI_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'CORR_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'CDEPI_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'COND_'
- IPROC=IPROC+1
- YWORK2(4,IPROC) = 'NECON_'
- END IF
-!
- YEND_COMMENT(4) = 'BU_RTH'
- NBUPROCNBR(4) = 3
-!
- CBUACTION(4,1) = 'IG'
- CBUACTION(4,2) = 'CC'
- CBUACTION(4,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(4,JJ) = ADJUSTL( ADJUSTR( YWORK2(4,JJ) ) // &
- ADJUSTL( YEND_COMMENT(4) ) )
- END DO
-!
-END IF
-!
-! Budget of RTKE
-IF (LBU_RTKE) THEN
- IPROC=4
- IPROACTV(5,IPROC) = NASSETKE
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(5,IPROC) = NFRCTKE
- IPROC=IPROC+1
- IF ( ONUMDIFTH ) IPROACTV(5,IPROC) = NDIFTKE
- IPROC=IPROC+1
- IF ( OHORELAX_TKE ) THEN
- IPROACTV(5,IPROC) = NRELTKE
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(5,IPROC) = 4
- ELSE
- IPROACTV(5,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF( ODRAGTREE ) IPROACTV(5,IPROC) = NDRAGTKE
- IPROC=IPROC+1
- IPROACTV(5,IPROC) = NDPTKE
- IPROC=IPROC+1
- IPROACTV(5,IPROC) = NTPTKE
- IPROC=IPROC+1
- IPROACTV(5,IPROC) = NDISSTKE
- IPROC=IPROC+1
- IPROACTV(5,IPROC) = NTRTKE
- IPROC=IPROC+1
- IPROACTV(5,IPROC) = NADVTKE
-!
- YWORK2(5,1) = 'INIF_'
- YWORK2(5,2) = 'ENDF_'
- YWORK2(5,3) = 'AVEF_'
- IPROC=4
- YWORK2(5,IPROC) = 'ASSE_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'FRC_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'DIF_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'DRAG_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'DP_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'TP_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'DISS_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'TR_'
- IPROC=IPROC+1
- YWORK2(5,IPROC) = 'ADV_'
-!
- YEND_COMMENT(5) = 'BU_RTKE'
- NBUPROCNBR(5) = 3
-!
- CBUACTION(5,1) = 'IG'
- CBUACTION(5,2) = 'CC'
- CBUACTION(5,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(5,JJ) = ADJUSTL( ADJUSTR( YWORK2(5,JJ) ) // &
- ADJUSTL( YEND_COMMENT(5) ) )
- END DO
-!
-END IF
-!
-! Budget of RRV
-IF (LBU_RRV) THEN
- IPROC=4
- IPROACTV(6,IPROC) = NASSERV
- IPROC=IPROC+1
- IF( NMODEL>1 ) IPROACTV(6,IPROC) = NNESTRV
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(6,IPROC) = NFRCRV
- IPROC=IPROC+1
- IF( L2D_ADV_FRC ) IPROACTV(6,IPROC) = N2DADVRV
- IPROC=IPROC+1
- IF( L2D_REL_FRC ) IPROACTV(6,IPROC) = N2DRELRV
- IPROC=IPROC+1
- IF( ONUDGING ) IPROACTV(6,IPROC) = NNUDRV
- IPROC=IPROC+1
- IF ( ONUMDIFTH ) IPROACTV(6,IPROC) = NDIFRV
- IPROC=IPROC+1
- IF ( OHORELAX_RV .OR. OVE_RELAX ) THEN
- IPROACTV(6,IPROC) = NRELRV
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(6,IPROC) = 4
- ELSE
- IPROACTV(6,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF ( HDCONV /= 'NONE' .OR. HSCONV == 'KAFR') IPROACTV(6,IPROC) = NDCONVRV
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' ) IPROACTV(6,IPROC) = NVTURBRV
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
- IPROACTV(6,IPROC) = NHTURBRV
- ELSE
- IF ( HTURB /= 'NONE' ) THEN
- IPROACTV(6,IPROC) = 4
- ELSE
- IPROACTV(6,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF (HTURB /= 'NONE' .AND. ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2'))) &
- IPROACTV(6,IPROC) = NNETURRV
- IPROC=IPROC+1
- IF ( HSCONV == 'EDKF' ) IPROACTV(6,IPROC) = NMAFLRV
- IPROC=IPROC+1
- IPROACTV(6,IPROC) = NADVRV
- IPROC=IPROC+1
- IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) IPROACTV(6,IPROC) = NNEADVRV
- IPROC=IPROC+1
- IF (HCLOUD /= 'NONE' .AND. HCLOUD /= 'KHKO' .AND. HCLOUD /= 'C2R2') &
- IPROACTV(6,IPROC) = NNEGARV
- IPROC=IPROC+1
-
- IF (HCLOUD == 'LIMA') THEN
- IF (OWARM .AND. OACTI .AND. NMOD_CCN.GE.1) IPROACTV(6,IPROC) = NHENURV
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT) THEN
- IF (OWARM .AND. ORAIN) IPROACTV(6,IPROC) = NREVARV
- IPROC=IPROC+1
- END IF
- IF (OCOLD .AND. ONUCL) IPROACTV(6,IPROC) = NHINDRV
- IPROC=IPROC+1
- IF (OCOLD .AND. ONUCL .AND. OHHONI .AND. NMOD_CCN.GE.1) IPROACTV(6,IPROC) = NHONHRV
- IPROC=IPROC+1
- IF (OPTSPLIT) THEN
- IPROACTV(6,IPROC) = NREVARV
- IPROC=IPROC+1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) IPROACTV(6,IPROC) = NDEPSRV
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(6,IPROC) = NDEPGRV
- IPROC=IPROC+1
- IPROACTV(6,IPROC) = NCEDSRV
- IPROC=IPROC+1
+!Create intermediate variable to store rhodj for scalar variables
+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
+ allocate( tburhodj )
- ELSE
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. LADJ_BEFORE) &
- IPROACTV(6,IPROC) = NADJURV
- IPROC=IPROC+1
- IF ((HCLOUD == 'C2R2' .AND. (.NOT. LSUPSAT)) &
- .OR. ( HCLOUD == 'KHKO' .AND. (.NOT. LSUPSAT)) &
- .OR. HCLOUD(1:3) == 'ICE') &
- IPROACTV(6,IPROC) = NHENURV
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(6,IPROC) = NDEPSRV
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(6,IPROC) = NDEPGRV
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'KES' .OR. ((HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') .AND. LRAIN) .OR. &
- ((HCLOUD(1:3) == 'ICE') .AND. LWARM)) IPROACTV(6,IPROC) = NREVARV
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'KES'.OR. HCLOUD == 'REVE' .OR. &
- HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' ) IPROACTV(6,IPROC) = NCONDRV
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED) IPROACTV(6,IPROC) = NCORRRV
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) )) &
- IPROACTV(6,IPROC) = NCDEPIRV
- IPROC=IPROC+1
- IF ( (HCLOUD == 'KHKO' ) .OR. (HCLOUD == 'C2R2')) &
- IPROACTV(6,IPROC) = NNECONRV
- IPROC=IPROC+1
-END IF
+ tburhodj%cmnhname = 'RhodJS'
+ tburhodj%cstdname = ''
+ tburhodj%clongname = 'RhodJS'
+ tburhodj%cunits = 'kg'
+ tburhodj%ccomment = 'RhodJ for Scalars variables'
+ tburhodj%ngrid = 1
+ tburhodj%ntype = TYPEREAL
+ tburhodj%ndims = 3
-!
- YWORK2(6,1) = 'INIF_'
- YWORK2(6,2) = 'ENDF_'
- YWORK2(6,3) = 'AVEF_'
- IPROC=4
- YWORK2(6,IPROC) = 'ASSE_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'NEST_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'FRC_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = '2DADV_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = '2DREL_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'NUD_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'DIF_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'DCONV_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'VTURB_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'HTURB_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'NETUR_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'MAFL_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'NEADV_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'NEGA_'
- IPROC=IPROC+1
-IF (HCLOUD == 'LIMA') THEN
- YWORK2(6,IPROC) = 'HENU_'
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT) THEN
- YWORK2(6,IPROC) = 'REVA_'
- IPROC=IPROC+1
- END IF
- YWORK2(6,IPROC) = 'HIND_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'HONH_'
- IPROC=IPROC+1
- IF (OPTSPLIT) THEN
- YWORK2(6,IPROC) = 'REVA_'
- IPROC=IPROC+1
- END IF
- YWORK2(6,IPROC) = 'DEPS_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'DEPG_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'CEDS_'
-ELSE
- YWORK2(6,IPROC) = 'ADJU_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'HENU_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'DEPS_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'DEPG_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'REVA_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'COND_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'CORR_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'CDEPI_'
- IPROC=IPROC+1
- YWORK2(6,IPROC) = 'NECON_'
-END IF
-!
- YEND_COMMENT(6) = 'BU_RRV'
- NBUPROCNBR(6) = 3
-!
- CBUACTION(6,1) = 'IG'
- CBUACTION(6,2) = 'CC'
- CBUACTION(6,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(6,JJ) = ADJUSTL( ADJUSTR( YWORK2(6,JJ) ) // &
- ADJUSTL( YEND_COMMENT(6) ) )
- END DO
-!
-END IF
-!
-! Budget of RRC
-IF (LBU_RRC) THEN
- IPROC=4
- IPROACTV(7,IPROC) = NASSERC
- IPROC=IPROC+1
- IF( NMODEL>1 ) IPROACTV(7,IPROC) = NNESTRC
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(7,IPROC) = NFRCRC
- IPROC=IPROC+1
- IF ( ONUMDIFTH ) IPROACTV(7,IPROC) = NDIFRC
- IPROC=IPROC+1
- IF ( OHORELAX_RC ) THEN
- IPROACTV(7,IPROC) = NRELRC
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(7,IPROC) = 4
- ELSE
- IPROACTV(7,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF( HDCONV /= 'NONE' .OR. HSCONV == 'KAFR') IPROACTV(7,IPROC) = NDCONVRC
- IPROC=IPROC+1
- IF( ODRAGTREE .AND. ODEPOTREE ) IPROACTV(7,IPROC) = NDEPOTRRC
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' ) IPROACTV(7,IPROC) = NVTURBRC
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
- IPROACTV(7,IPROC) = NHTURBRC
- ELSE
- IF ( HTURB /= 'NONE' ) THEN
- IPROACTV(7,IPROC) = 4
- ELSE
- IPROACTV(7,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF (HTURB /= 'NONE' .AND. ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2'))) &
- IPROACTV(7,IPROC) = NNETURRC
- IPROC=IPROC+1
- IPROACTV(7,IPROC) = NADVRC
- IPROC=IPROC+1
- IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) &
- IPROACTV(7,IPROC) = NNEADVRC
- IPROC=IPROC+1
- IF (HCLOUD /= 'NONE' .AND. HCLOUD /= 'KHKO' .AND. HCLOUD /= 'C2R2') &
- IPROACTV(7,IPROC) = NNEGARC
- IPROC=IPROC+1
-
- IF (HCLOUD == 'LIMA') THEN
- IF (OPTSPLIT .AND. OWARM .AND. ORAIN) IPROACTV(7,IPROC) = NCORRRC
- IPROC=IPROC+1
- IF (OWARM .AND. OSEDC) IPROACTV(7,IPROC) = NSEDIRC
- IPROC=IPROC+1
- IF (OWARM .AND. ODEPOC) IPROACTV(7,IPROC) = NDEPORC
- IPROC=IPROC+1
- IF (OPTSPLIT .AND. OWARM .AND. ORAIN) IPROACTV(7,IPROC) = NR2C1RC
- IPROC=IPROC+1
- IF (OWARM .AND. OACTI .AND. NMOD_CCN.GE.1) IPROACTV(7,IPROC) = NHENURC
- IPROC=IPROC+1
- IF (OPTSPLIT) THEN
- IF (OCOLD .AND. ONUCL) IPROACTV(7,IPROC) = NHINCRC
- IPROC=IPROC+1
- END IF
- IF (OPTSPLIT .OR. (OWARM .AND. ORAIN)) IPROACTV(7,IPROC) = NAUTORC
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OWARM .AND. ORAIN)) IPROACTV(7,IPROC) = NACCRRC
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OWARM .AND. ORAIN)) IPROACTV(7,IPROC) = NREVARC
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT) THEN
- IF (OCOLD .AND. ONUCL) IPROACTV(7,IPROC) = NHINCRC
- IPROC=IPROC+1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. ONUCL)) IPROACTV(7,IPROC) = NHONCRC
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM)) IPROACTV(7,IPROC) = NIMLTRC
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM)) IPROACTV(7,IPROC) = NBERFIRC
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(7,IPROC) = NRIMRC
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(7,IPROC) = NWETGRC
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(7,IPROC) = NDRYGRC
- IPROC=IPROC+1
- IF (OPTSPLIT) IPROACTV(7,IPROC) = NCVRCRC
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT .AND. OHAIL) IPROACTV(7,IPROC) = NWETHRC
- IPROC=IPROC+1
- IPROACTV(7,IPROC) = NCEDSRC
- IPROC=IPROC+1
- ELSE
- IF (HCLOUD(1:3) == 'KES' ) IPROACTV(7,IPROC ) = NACCRRC
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'KES' ) IPROACTV(7,IPROC) = NAUTORC
- IPROC=IPROC+1
- IF ((HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') .AND. (.NOT. LSUPSAT)) &
- IPROACTV(7,IPROC) = NHENURC
- IPROC=IPROC+1
-!
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. LADJ_BEFORE) &
- IPROACTV(7,IPROC) = NADJURC
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. LSEDIC .AND. &
- LRED .AND. (.NOT. LSEDIM_AFTER)) &
- IPROACTV(7,IPROC) = NSEDIRC
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' ) IPROACTV(7,IPROC) = NHONRC
- IPROC=IPROC+1
- IF (((HCLOUD(1:3) == 'ICE' ) .AND. LWARM) .OR. ((HCLOUD == 'C2R2' .OR. &
- HCLOUD == 'KHKO') .AND. LRAIN)) IPROACTV(7,IPROC) = NAUTORC
- IPROC=IPROC+1
- !modif
- IF (((HCLOUD(1:3) == 'ICE' ) .AND. LWARM) .OR. ((HCLOUD == 'C2R2' .OR. &
- HCLOUD == 'KHKO') .AND. LRAIN)) IPROACTV(7,IPROC) = NACCRRC
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(7,IPROC) = NRIMRC
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED) IPROACTV(7,IPROC) = NCMELRC
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(7,IPROC) = NWETGRC
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(7,IPROC) = NDRYGRC
- IPROC=IPROC+1
- IF (HCLOUD == 'ICE4') IPROACTV(7,IPROC) = NWETHRC
- IPROC=IPROC+1
- IF (HCLOUD == 'ICE4' .AND. LRED) IPROACTV(7,IPROC) = NDRYHRC
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' ) IPROACTV(7,IPROC) = NIMLTRC
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(7,IPROC) = NBERFIRC
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED) IPROACTV(7,IPROC) = NCORRRC
- IPROC=IPROC+1
- IF (((HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO').AND. LSEDC) .OR. &
- (HCLOUD(1:3) == 'ICE' .AND. LSEDIC .AND. .NOT. LRED) .OR. &
- (HCLOUD(1:3) == 'ICE' .AND. LSEDIC .AND. LRED .AND. LSEDIM_AFTER)) &
- IPROACTV(7,IPROC) = NSEDIRC
- IPROC=IPROC+1
- IF (((HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO').AND. LDEPOC) .OR. &
- (HCLOUD(1:3) == 'ICE' .AND. LDEPOSC)) IPROACTV(7,IPROC) = NDEPORC
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) )) &
- IPROACTV(7,IPROC) = NCDEPIRC
- IPROC=IPROC+1
- IF (HCLOUD == 'C2R2'.OR. HCLOUD == 'KHKO' .OR. &
- HCLOUD(1:3) == 'KES'.OR. HCLOUD == 'REVE') IPROACTV(7,IPROC) = NCONDRC
- IPROC=IPROC+1
- IF ( (HCLOUD == 'KHKO' ) .OR. (HCLOUD == 'C2R2')) &
- IPROACTV(7,IPROC) = NNECONRC
- IPROC=IPROC+1
- END IF
+ allocate( tburhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tburhodj%xdata(:, :, :) = 0.
+end if
-!
- YWORK2(7,1) = 'INIF_'
- YWORK2(7,2) = 'ENDF_'
- YWORK2(7,3) = 'AVEF_'
- IPROC=4
- YWORK2(7,IPROC) = 'ASSE_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'NEST_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'FRC_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'DIF_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'DCONV_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'DEPOTR'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'VTURB_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'HTURB_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'NETUR_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'NEADV_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'NEGA_'
- IPROC=IPROC+1
-
- IF (HCLOUD == 'LIMA') THEN
- YWORK2(7,IPROC) = 'CORR_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'SEDI_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'DEPO_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'R2C1_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'HENU_'
- IPROC=IPROC+1
- IF (OPTSPLIT) THEN
- YWORK2(7,IPROC) = 'HINC_'
- IPROC=IPROC+1
- END IF
- YWORK2(7,IPROC) = 'AUTO_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'ACCR_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'REVA_'
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT) THEN
- YWORK2(7,IPROC) = 'HINC_'
- IPROC=IPROC+1
- END IF
- YWORK2(7,IPROC) = 'HONC_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'IMLT_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'BERFI_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'RIM_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'WETG_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'DRYG_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'CVRC_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'WETH_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'CEDS_'
- ELSE
- YWORK2(7,IPROC) = 'ACCR_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'AUTO_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'HENU_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'ADJU_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'SEDI_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'HON_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'AUTO_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'ACCR_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'RIM_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'CMEL_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'WETG_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'DRYG_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'WETH_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'DRYH_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'IMLT_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'BERFI_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'CORR_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'SEDI_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'DEPO_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'CDEPI_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'COND_'
- IPROC=IPROC+1
- YWORK2(7,IPROC) = 'NECON_'
- END IF
-!
- YEND_COMMENT(7) = 'BU_RRC'
- NBUPROCNBR(7) = 3
-!
- CBUACTION(7,1) = 'IG'
- CBUACTION(7,2) = 'CC'
- CBUACTION(7,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(7,JJ) = ADJUSTL( ADJUSTR( YWORK2(7,JJ) ) // &
- ADJUSTL( YEND_COMMENT(7) ) )
- END DO
-!
-END IF
-!
-! Budget of RRR
-IF (LBU_RRR) THEN
- IPROC=4
- IPROACTV(8,IPROC) = NASSERR
- IPROC=IPROC+1
- IF( NMODEL>1 ) IPROACTV(8,IPROC) = NNESTRR
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(8,IPROC) = NFRCRR
- IPROC=IPROC+1
- IF ( ONUMDIFTH ) IPROACTV(8,IPROC) = NDIFRR
- IPROC=IPROC+1
- IF ( OHORELAX_RR ) THEN
- IPROACTV(8,IPROC) = NRELRR
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(8,IPROC) = 4
- ELSE
- IPROACTV(8,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IPROACTV(8,IPROC) = NADVRR
- IPROC=IPROC+1
- IF ( HCLOUD /= 'NONE' ) IPROACTV(8,IPROC) = NNEGARR
- IPROC=IPROC+1
-
- IF (HCLOUD == 'LIMA') THEN
- IF (OPTSPLIT .AND. OWARM .AND. ORAIN) IPROACTV(8,IPROC) = NCORRRR
- IPROC=IPROC+1
- IF (OWARM .AND. ORAIN) IPROACTV(8,IPROC) = NSEDIRR
- IPROC=IPROC+1
- IF (OPTSPLIT .AND. OWARM .AND. ORAIN) IPROACTV(8,IPROC) = NR2C1RR
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OWARM .AND. ORAIN)) IPROACTV(8,IPROC) = NAUTORR
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OWARM .AND. ORAIN)) IPROACTV(8,IPROC) = NACCRRR
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OWARM .AND. ORAIN)) IPROACTV(8,IPROC) = NREVARR
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. ONUCL .AND. ORAIN)) IPROACTV(8,IPROC) = NHONRRR
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW .AND. ORAIN)) IPROACTV(8,IPROC) = NACCRR
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(8,IPROC) = NCFRZRR
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(8,IPROC) = NWETGRR
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(8,IPROC) = NDRYGRR
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(8,IPROC) = NGMLTRR
- IPROC=IPROC+1
- IF (OPTSPLIT) IPROACTV(8,IPROC) = NCVRCRR
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT .AND. OHAIL) IPROACTV(8,IPROC) = NWETHRR
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT .AND. OHAIL) IPROACTV(8,IPROC) = NHMLTRR
- ELSE
- IF (HCLOUD(1:3) == 'KES' ) IPROACTV(8,IPROC) = NSEDIRR
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'KES' ) IPROACTV(8,IPROC) = NACCRRR
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'KES' ) IPROACTV(8,IPROC) = NAUTORR
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'KES' ) IPROACTV(8,IPROC) = NREVARR
- IPROC=IPROC+1
-!
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. (.NOT. LSEDIM_AFTER)) &
- IPROACTV(8,IPROC) = NSEDIRR
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' ) IPROACTV(8,IPROC) = NSFRRR
- IPROC=IPROC+1
- IF ((HCLOUD(1:3) == 'ICE' ) .AND. LWARM) &
- IPROACTV(8,IPROC) = NAUTORR
- IPROC=IPROC+1
- IF ((HCLOUD(1:3) == 'ICE' ) .AND. LWARM) &
- IPROACTV(8,IPROC) = NACCRRR
- IPROC=IPROC+1
- IF ((HCLOUD(1:3) == 'ICE' ) .AND. LWARM) &
- IPROACTV(8,IPROC) = NREVARR
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(8,IPROC) = NACCRR
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED) IPROACTV(8,IPROC) = NCMELRR
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' ) IPROACTV(8,IPROC) = NCFRZRR
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' ) IPROACTV(8,IPROC) = NWETGRR
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(8,IPROC) = NDRYGRR
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE') IPROACTV(8,IPROC) = NGMLTRR
- IPROC=IPROC+1
- IF (HCLOUD == 'ICE4') IPROACTV(8,IPROC) = NWETHRR
- IPROC=IPROC+1
- IF (HCLOUD == 'ICE4' .AND. LRED) IPROACTV(8,IPROC) = NDRYHRR
- IPROC=IPROC+1
- IF (HCLOUD == 'ICE4') IPROACTV(8,IPROC) = NHMLTRR
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED) IPROACTV(8,IPROC) = NCORRRR
- IPROC=IPROC+1
- IF ((HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') .AND. LRAIN) IPROACTV(8,IPROC) = NAUTORR
- IPROC=IPROC+1
- IF ((HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO') .AND. LRAIN) IPROACTV(8,IPROC) = NACCRRR
- IPROC=IPROC+1
- IF ((HCLOUD == 'C2R2'.OR. HCLOUD == 'KHKO') .AND. LRAIN) IPROACTV(8,IPROC) = NREVARR
- IPROC=IPROC+1
- IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'KHKO' .OR. &
- (HCLOUD(1:3) == 'ICE' .AND. .NOT. (LRED)) .OR. &
- (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. LSEDIM_AFTER)) &
- IPROACTV(8,IPROC) = NSEDIRR
- IPROC=IPROC+1
- END IF
-!
- YWORK2(8,1) = 'INIF_'
- YWORK2(8,2) = 'ENDF_'
- YWORK2(8,3) = 'AVEF_'
- IPROC=4
- YWORK2(8,IPROC) = 'ASSE_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'NEST_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'FRC_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'DIF_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'NEGA_'
- IPROC=IPROC+1
-
-IF (HCLOUD == 'LIMA') THEN
- YWORK2(8,IPROC) = 'CORR_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'SEDI_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'R2C1_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'AUTO_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'ACCR_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'REVA_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'HONR_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'ACC_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'CFRZ_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'WETG_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'DRYG_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'GMLT_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'CVRC_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'WETH_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'HMLT_'
- IPROC=IPROC+1
-ELSE
- YWORK2(8,IPROC) = 'SEDI_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'ACCR_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'AUTO_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'REVA_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'SEDI_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'SFR_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'AUTO_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'ACCR_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'REVA_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'ACC_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'CMEL_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'CFRZ_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'WETG_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'DRYG_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'GMLT_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'WETH_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'DRYH_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'HMLT_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'CORR_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'AUTO_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'ACCR_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'REVA_'
- IPROC=IPROC+1
- YWORK2(8,IPROC) = 'SEDI_'
-END IF
-!
- YEND_COMMENT(8) = 'BU_RRR'
- NBUPROCNBR(8) = 3
-!
- CBUACTION(8,1) = 'IG'
- CBUACTION(8,2) = 'CC'
- CBUACTION(8,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(8,JJ) = ADJUSTL( ADJUSTR( YWORK2(8,JJ) ) // &
- ADJUSTL( YEND_COMMENT(8) ) )
- END DO
-!
-END IF
-!
-! Budget of RRI
-IF (LBU_RRI) THEN
- IPROC=4
- IPROACTV(9,IPROC) = NASSERI
- IPROC=IPROC+1
- IF( NMODEL>1 ) IPROACTV(9,IPROC) = NNESTRI
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(9,IPROC) = NFRCRI
- IPROC=IPROC+1
- IF( ONUMDIFTH ) IPROACTV(9,IPROC) = NDIFRI
- IPROC=IPROC+1
- IF ( OHORELAX_RI ) THEN
- IPROACTV(9,IPROC) = NRELRI
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(9,IPROC) = 4
- ELSE
- IPROACTV(9,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF( HDCONV /= 'NONE' .OR. HSCONV == 'KAFR') IPROACTV(9,IPROC) = NDCONVRI
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' ) IPROACTV(9,IPROC) = NVTURBRI
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
- IPROACTV(9,IPROC) = NHTURBRI
- ELSE
- IF ( HTURB /= 'NONE' ) THEN
- IPROACTV(9,IPROC) = 4
- ELSE
- IPROACTV(9,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IPROACTV(9,IPROC) = NADVRI
- IPROC=IPROC+1
- IF( HCLOUD /= 'NONE' ) IPROACTV(9,IPROC) = NNEGARI
- IPROC=IPROC+1
-
- IF (HCLOUD=='LIMA') THEN
- IF (OPTSPLIT .AND. OCOLD .AND. OSNOW) IPROACTV(9,IPROC) = NCORRRI
- IPROC=IPROC+1
- IF (OCOLD .AND. OSEDI) IPROACTV(9,IPROC) = NSEDIRI
- IPROC=IPROC+1
- IF (OCOLD .AND. ONUCL) IPROACTV(9,IPROC) = NHINDRI
- IPROC=IPROC+1
- IF (OCOLD .AND. ONUCL) IPROACTV(9,IPROC) = NHINCRI
- IPROC=IPROC+1
- IF (OCOLD .AND. ONUCL .AND. OHHONI .AND. NMOD_CCN.GE.1) IPROACTV(9,IPROC) = NHONHRI
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. ONUCL)) IPROACTV(9,IPROC) = NHONCRI
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) IPROACTV(9,IPROC) = NCNVIRI
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) IPROACTV(9,IPROC) = NCNVSRI
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) IPROACTV(9,IPROC) = NAGGSRI
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM)) IPROACTV(9,IPROC) = NIMLTRI
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM)) IPROACTV(9,IPROC) = NBERFIRI
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(9,IPROC) = NHMSRI
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(9,IPROC) = NCFRZRI
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(9,IPROC) = NWETGRI
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(9,IPROC) = NDRYGRI
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(9,IPROC) = NHMGRI
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT .AND. OHAIL) IPROACTV(9,IPROC) = NWETHRI
- IPROC=IPROC+1
- IPROACTV(9,IPROC) = NCEDSRI
- ELSE
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. LADJ_BEFORE) IPROACTV(9,IPROC) = NADJURI
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. (.NOT. LSEDIM_AFTER)) &
- IPROACTV(9,IPROC) = NSEDIRI
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(9,IPROC) = NHENURI
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(9,IPROC) = NHONRI
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(9,IPROC) = NAGGSRI
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(9,IPROC) = NAUTSRI
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(9,IPROC) = NCFRZRI
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(9,IPROC) = NWETGRI
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(9,IPROC) = NDRYGRI
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' ) IPROACTV(9,IPROC) = NWETHRI
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' .AND. LRED) IPROACTV(9,IPROC) = NDRYHRI
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(9,IPROC) = NIMLTRI
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(9,IPROC) = NBERFIRI
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE' .AND. LRED) IPROACTV(9,IPROC) = NCORRRI
- IPROC=IPROC+1
- IF ((HCLOUD(1:3) == 'ICE' .AND. .NOT. LRED).OR. &
- (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. LSEDIM_AFTER)) &
- IPROACTV(9,IPROC) = NSEDIRI
- IPROC=IPROC+1
- IF (HCLOUD(1:3) == 'ICE' .AND. (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) )) &
- IPROACTV(9,IPROC) = NCDEPIRI
- IPROC=IPROC+1
- END IF
-!
- YWORK2(9,1) = 'INIF_'
- YWORK2(9,2) = 'ENDF_'
- YWORK2(9,3) = 'AVEF_'
- IPROC=4
- YWORK2(9,IPROC) = 'ASSE_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'NEST_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'FRC_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'DIF_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(9,IPROC) = 'DCONV_'
- IPROC=IPROC+1
- YWORK2(9,IPROC) = 'VTURB_'
- IPROC=IPROC+1
- YWORK2(9,IPROC) = 'HTURB_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(9,IPROC) = 'NEGA_'
- IPROC= IPROC+1
- IF (HCLOUD=='LIMA') THEN
- YWORK2(9,IPROC) = 'CORR_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'SEDI_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'HIND_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'HINC_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'HONH_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'HONC_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'CNVI_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'CNVS_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'AGGS_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'IMLT_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'BERFI_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'HMS_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'CFRZ_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'WETG_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'DRYG_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'HMG_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'WETH_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'CEDS_'
- ELSE
- YWORK2(9,IPROC) = 'ADJU_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'SEDI_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'HENU_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'HON_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'AGGS_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'AUTS_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'CFRZ_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'WETG_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'DRYG_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'WETH_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'DRYH_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'IMLT_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'BERFI_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'CORR_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'SEDI_'
- IPROC= IPROC+1
- YWORK2(9,IPROC) = 'CDEPI_'
- END IF
-!
- YEND_COMMENT(9) = 'BU_RRI'
- NBUPROCNBR(9) = 3
-!
- CBUACTION(9,1) = 'IG'
- CBUACTION(9,2) = 'CC'
- CBUACTION(9,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(9,JJ) = ADJUSTL( ADJUSTR( YWORK2(9,JJ) ) // &
- ADJUSTL( YEND_COMMENT(9) ) )
- END DO
-!
-END IF
-!
-! Budget of RRS
-IF (LBU_RRS) THEN
- IPROC=4
- IPROACTV(10,IPROC) = NASSERS
- IPROC= IPROC+1
- IF( NMODEL>1 ) IPROACTV(10,IPROC) = NNESTRS
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(10,IPROC) = NFRCRS
- IPROC= IPROC+1
- IF( ONUMDIFTH ) IPROACTV(10,IPROC) = NDIFRS
- IPROC=IPROC+1
- IF ( OHORELAX_RS ) THEN
- IPROACTV(10,IPROC) = NRELRS
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(10,IPROC) = 4
- ELSE
- IPROACTV(10,IPROC) = 3
- END IF
- END IF
- IPROC= IPROC+1
- IPROACTV(10,IPROC) = NADVRS
- IPROC= IPROC+1
- IF( HCLOUD /= 'NONE' ) IPROACTV(10,IPROC) = NNEGARS
- IPROC=IPROC+1
-
-IF (HCLOUD=='LIMA') THEN
- IF (OPTSPLIT .AND. OCOLD .AND. OSNOW) IPROACTV(10,IPROC) = NCORRRS
- IPROC=IPROC+1
- IF (OCOLD .AND. OSNOW) IPROACTV(10,IPROC) = NSEDIRS
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) IPROACTV(10,IPROC) = NCNVIRS
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) IPROACTV(10,IPROC) = NDEPSRS
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) IPROACTV(10,IPROC) = NCNVSRS
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) IPROACTV(10,IPROC) = NAGGSRS
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(10,IPROC) = NRIMRS
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(10,IPROC) = NHMSRS
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW .AND. ORAIN)) IPROACTV(10,IPROC) = NACCRS
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(10,IPROC) = NCMELRS
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(10,IPROC) = NWETGRS
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(10,IPROC) = NDRYGRS
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT .AND. OHAIL) IPROACTV(10,IPROC) = NWETHRS
- IPROC=IPROC+1
- ELSE
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. (.NOT. LSEDIM_AFTER)) &
- IPROACTV(10,IPROC) = NSEDIRS
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(10,IPROC) = NDEPSRS
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(10,IPROC) = NAGGSRS
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(10,IPROC) = NAUTSRS
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(10,IPROC) = NRIMRS
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(10,IPROC) = NACCRS
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(10,IPROC) = NCMELRS
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(10,IPROC) = NWETGRS
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(10,IPROC) = NDRYGRS
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4') IPROACTV(10,IPROC) = NWETHRS
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' .AND. LRED) IPROACTV(10,IPROC) = NDRYHRS
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE' .AND. LRED) IPROACTV(10,IPROC) = NCORRRS
- IPROC=IPROC+1
- IF ((HCLOUD(1:3) == 'ICE' .AND. .NOT. LRED).OR. &
- (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. LSEDIM_AFTER)) &
- IPROACTV(10,IPROC) = NSEDIRS
- IPROC=IPROC+1
-END IF
-!
- YWORK2(10,1) = 'INIF_'
- YWORK2(10,2) = 'ENDF_'
- YWORK2(10,3) = 'AVEF_'
- IPROC= 4
- YWORK2(10,IPROC) = 'ASSE_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'NEST_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'FRC_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'DIF_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'REL_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(10,IPROC) = 'NEGA_'
- IPROC= IPROC+1
-IF (HCLOUD=='LIMA') THEN
- YWORK2(10,IPROC) = 'CORR_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'SEDI_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'CNVI_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'DEPS_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'CNVS_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'AGGS_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'RIM_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'HMS_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'ACC_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'CMEL_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'WETG_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'DRYG_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'WETH_'
- IPROC= IPROC+1
-ELSE
- YWORK2(10,IPROC) = 'SEDI_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'DEPS_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'AGGS_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'AUTS_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'RIM_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'ACC_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'CMEL_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'WETG_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'DRYG_'
- IPROC= IPROC+1
- YWORK2(10,IPROC) = 'WETH_'
- IPROC=IPROC+1
- YWORK2(10,IPROC) = 'DRYH_'
- IPROC=IPROC+1
- YWORK2(10,IPROC) = 'CORR_'
- IPROC=IPROC+1
- YWORK2(10,IPROC) = 'SEDI_'
-END IF
-!
- YEND_COMMENT(10) = 'BU_RRS'
- NBUPROCNBR(10) = 3
-!
- CBUACTION(10,1) = 'IG'
- CBUACTION(10,2) = 'CC'
- CBUACTION(10,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(10,JJ) = ADJUSTL( ADJUSTR( YWORK2(10,JJ) ) // &
- ADJUSTL( YEND_COMMENT(10) ) )
- END DO
-!
-END IF
-!
-! Budget of RRG
-IF (LBU_RRG) THEN
- IPROC=4
- IPROACTV(11,IPROC) = NASSERG
- IPROC=IPROC+1
- IF( NMODEL>1 ) IPROACTV(11,IPROC) = NNESTRG
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(11,IPROC) = NFRCRG
- IPROC=IPROC+1
- IF( ONUMDIFTH ) IPROACTV(11,IPROC) = NDIFRG
- IPROC=IPROC+1
- IF ( OHORELAX_RG ) THEN
- IPROACTV(11,IPROC) = NRELRG
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(11,IPROC) = 4
- ELSE
- IPROACTV(11,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IPROACTV(11,IPROC) = NADVRG
- IPROC=IPROC+1
- IF( HCLOUD /= 'NONE' ) IPROACTV(11,IPROC) = NNEGARG
- IPROC=IPROC+1
-IF (HCLOUD=='LIMA') THEN
- IF (OCOLD .AND. OSNOW) IPROACTV(11,IPROC) = NSEDIRG
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. ONUCL .AND. ORAIN)) IPROACTV(11,IPROC) = NHONRRG
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(11,IPROC) = NDEPGRG
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(11,IPROC) = NRIMRG
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. ORAIN .AND. OSNOW)) IPROACTV(11,IPROC) = NACCRG
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(11,IPROC) = NCMELRG
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(11,IPROC) = NCFRZRG
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(11,IPROC) = NWETGRG
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(11,IPROC) = NDRYGRG
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(11,IPROC) = NHMGRG
- IPROC=IPROC+1
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) IPROACTV(11,IPROC) = NGMLTRG
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT .AND. OHAIL) IPROACTV(11,IPROC) = NWETHRG
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT .AND. OHAIL) IPROACTV(11,IPROC) = NCOHGRG
- IPROC=IPROC+1
-ELSE
- IF (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. (.NOT. LSEDIM_AFTER)) &
- IPROACTV(11,IPROC) = NSEDIRG
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(11,IPROC) = NSFRRG
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(11,IPROC) = NDEPGRG
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(11,IPROC) = NRIMRG
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(11,IPROC) = NACCRG
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(11,IPROC) = NCMELRG
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(11,IPROC) = NCFRZRG
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(11,IPROC) = NWETGRG
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' .AND. LRED) IPROACTV(11,IPROC) = NGHCVRG
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(11,IPROC) = NDRYGRG
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE') IPROACTV(11,IPROC) = NGMLTRG
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' .AND. .NOT. LRED ) IPROACTV(11,IPROC) = NWETHRG
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' .AND. LRED ) IPROACTV(11,IPROC) = NHGCVRG
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' .AND. LRED) IPROACTV(11,IPROC) = NDRYHRG
- IPROC=IPROC+1
- IF( HCLOUD(1:3) == 'ICE' .AND. LRED) IPROACTV(11,IPROC) = NCORRRG
- IPROC=IPROC+1
- IF ((HCLOUD(1:3) == 'ICE' .AND. .NOT. LRED).OR. &
- (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. LSEDIM_AFTER)) &
- IPROACTV(11,IPROC) = NSEDIRG
- IPROC=IPROC+1
-END IF
-!
- YWORK2(11,1) = 'INIF_'
- YWORK2(11,2) = 'ENDF_'
- YWORK2(11,3) = 'AVEF_'
- IPROC=4
- YWORK2(11,IPROC) = 'ASSE_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'NEST_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'FRC_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'DIF_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'NEGA_'
- IPROC=IPROC+1
-IF (HCLOUD=='LIMA') THEN
- YWORK2(11,IPROC) = 'SEDI_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'HONR_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'DEPG_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'RIM_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'ACC_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'CMEL_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'CFRZ_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'WETG_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'DRYG_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'HMG_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'GMLT_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'WETH_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'COHG_'
-ELSE
- YWORK2(11,IPROC) = 'SEDI_'
- IPROC=IPROC+1
- YWORK2(11,IPROC)= 'SFR_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'DEPG_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'RIM_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'ACC_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'CMEL_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'CFRZ_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'WETG_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'GHCV_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'DRYG_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'GMLT_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'WETH_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'HGCV_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'DRYH_'
- IPROC=IPROC+1
- YWORK2(11,IPROC) = 'CORR_'
- IPROC=IPROC+1
- YWORK2(11,IPROC)= 'SEDI_'
-END IF
-!
- YEND_COMMENT(11) = 'BU_RRG'
- NBUPROCNBR(11) = 3
-!
- CBUACTION(11,1) = 'IG'
- CBUACTION(11,2) = 'CC'
- CBUACTION(11,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(11,JJ) = ADJUSTL( ADJUSTR( YWORK2(11,JJ) ) // &
- ADJUSTL( YEND_COMMENT(11) ) )
- END DO
-!
-END IF
-!
-! Budget of RRH
-IF (LBU_RRH) THEN
- IPROC=4
- IPROACTV(12,IPROC) = NASSERH
- IPROC=IPROC+1
- IF( NMODEL>1 ) THEN
- IPROACTV(12,IPROC) = NNESTRH
- ELSE
- IPROACTV(12,IPROC) = 3
- END IF
- IPROC=IPROC+1
- IF( LFORCING ) THEN
- IPROACTV(12,IPROC) = NFRCRH
- ELSE
- IPROACTV(12,IPROC) = 3
- END IF
- IPROC=IPROC+1
- IF( ONUMDIFTH ) THEN
- IPROACTV(12,IPROC) = NDIFRH
- ELSE
- IPROACTV(12,IPROC) = 3
- END IF
- IPROC=IPROC+1
- IF ( OHORELAX_RH ) THEN
- IPROACTV(12,IPROC) = NRELRH
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(12,IPROC) = 4
- ELSE
- IPROACTV(12,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IPROACTV(12,IPROC) = NADVRH
- IPROC=IPROC+1
- IF( HCLOUD /= 'NONE' ) THEN
- IPROACTV(12,IPROC) = NNEGARH
- ELSE
- IPROACTV(12,IPROC) = 3
- END IF
- IPROC=IPROC+1
-!
- IF (HCLOUD=='LIMA' .AND. OHAIL) THEN
- IPROACTV(12,IPROC) = NSEDIRH
- IPROC=IPROC+1
- IPROACTV(12,IPROC) = NWETGRH
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT) IPROACTV(12,IPROC) = NWETHRH
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT) IPROACTV(12,IPROC) = NCOHGRH
- IPROC=IPROC+1
- IF (.NOT.OPTSPLIT) IPROACTV(12,IPROC) = NHMLTRH
- ELSE
- IF( HCLOUD == 'ICE4' .AND. LRED .AND. .NOT. LSEDIM_AFTER) &
- IPROACTV(12,IPROC) = NSEDIRH
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' .AND. LRED) IPROACTV(12,IPROC) = NGHCVRH
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' .AND. .NOT. LRED) IPROACTV(12,IPROC) = NWETGRH
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4') IPROACTV(12,IPROC) = NWETHRH
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' .AND. LRED) IPROACTV(12,IPROC) = NHGCVRH
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' .AND. LRED) IPROACTV(12,IPROC) = NDRYHRH
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' ) IPROACTV(12,IPROC) = NHMLTRH
- IPROC=IPROC+1
- IF( HCLOUD == 'ICE4' .AND. LRED) IPROACTV(12,IPROC) = NCORRRH
- IPROC=IPROC+1
- IF ((HCLOUD(1:3) == 'ICE' .AND. .NOT. LRED).OR. &
- (HCLOUD(1:3) == 'ICE' .AND. LRED .AND. LSEDIM_AFTER)) &
- IPROACTV(12,IPROC) = NSEDIRH
- END IF
-!
- YWORK2(12,1) = 'INIF_'
- YWORK2(12,2) = 'ENDF_'
- YWORK2(12,3) = 'AVEF_'
- IPROC=4
- YWORK2(12,IPROC) = 'ASSE_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'NEST_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'FRC_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'DIF_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'ADV_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'NEGA_'
- IPROC=IPROC+1
- IF (HCLOUD=='LIMA' .AND. OHAIL) THEN
- YWORK2(12,IPROC) = 'SEDI_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'WETG_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'WETH_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'COHG_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'HMLT_'
- IPROC=IPROC+1
- ELSE
- YWORK2(12,IPROC) = 'SEDI_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'GHCV_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'WETG_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'WETH_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'HGCV_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'DRYH_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'HMLT_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'CORR_'
- IPROC=IPROC+1
- YWORK2(12,IPROC) = 'SEDI_'
- END IF
-!
- YEND_COMMENT(12) = 'BU_RRH'
- NBUPROCNBR(12) = 3
-!
- CBUACTION(12,1) = 'IG'
- CBUACTION(12,2) = 'CC'
- CBUACTION(12,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(12,JJ) = ADJUSTL( ADJUSTR( YWORK2(12,JJ) ) // &
- ADJUSTL( YEND_COMMENT(12) ) )
- END DO
-!
-END IF
-!
-! Budget of RSV
-IF (LBU_RSV) THEN
- IBUPROCNBR_SV_MAX = 0 ! initialize the Max nunmber of processes for the SVs
- DO JSV = 1,KSV
- IPROC=4
- IPROACTV(12+JSV,IPROC) = NASSESV
- IPROC=IPROC+1
- IF( NMODEL>1 ) IPROACTV(12+JSV,IPROC) = NNESTSV
- IPROC=IPROC+1
- IF( LFORCING ) IPROACTV(12+JSV,IPROC) = NFRCSV
- IPROC=IPROC+1
- IF ( ONUMDIFSV ) IPROACTV(12+JSV,IPROC) = NDIFSV
- IPROC=IPROC+1
- IF ( OHORELAX_SV(JSV) ) THEN
- IPROACTV(12+JSV,IPROC) = NRELSV
- ELSE
- IF(OVE_RELAX .OR. OHORELAX_UVWTH .OR. OHORELAX_RV .OR. &
- OHORELAX_RC .OR. OHORELAX_RR .OR. OHORELAX_RI .OR. OHORELAX_RS .OR. &
- OHORELAX_RG .OR. OHORELAX_RH .OR. OHORELAX_TKE .OR. ANY(OHORELAX_SV)) THEN
- IPROACTV(12+JSV,IPROC) = 4
- ELSE
- IPROACTV(12+JSV,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF ( (HDCONV /= 'NONE' .OR. HSCONV == 'KAFR') .AND. OCHTRANS ) &
- IPROACTV(12+JSV,IPROC) = NDCONVSV
- IPROC=IPROC+1
- IF ( ODRAGTREE .AND. ODEPOTREE ) &
- IPROACTV(12+JSV,IPROC) = NDEPOTRSV
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' ) IPROACTV(12+JSV,IPROC) = NVTURBSV
- IPROC=IPROC+1
- IF ( HTURB /= 'NONE' .AND. HTURBDIM == '3DIM' ) THEN
- IPROACTV(12+JSV,IPROC) = NHTURBSV
- ELSE
- IF ( HTURB /= 'NONE' ) THEN
- IPROACTV(12+JSV,IPROC) = 4
- ELSE
- IPROACTV(12+JSV,IPROC) = 3
- END IF
- END IF
- IPROC=IPROC+1
- IF ( HSCONV == 'EDKF' ) IPROACTV(12+JSV,IPROC)= NMAFLSV
- IPROC=IPROC+1
- IPROACTV(12+JSV,IPROC)= NADVSV
- IPROC=IPROC+1
-!
- YWORK2(12+JSV,1) = 'INIF_'
- YWORK2(12+JSV,2) = 'ENDF_'
- YWORK2(12+JSV,3) = 'AVEF_'
- IPROC=4
- YWORK2(12+JSV,IPROC) = 'ASSE_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'NEST_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'FRC_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'DIF_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'REL_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'DCONV_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'DEPOTR'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'VTURB_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'HTURB_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'MAFL_'
- IPROC=IPROC+1
- YWORK2(12+JSV,IPROC) = 'ADV_'
-!
-! complete with the budget of other processes
-!
- ILAST_PROC_NBR = IPROC
- CALL BUDGET_OTHERPROC_SV
-!
- YEND_COMMENT(12+JSV) = 'BU_RSV'
- IBUPROCNBR_SV_MAX = MAX( IBUPROCNBR_SV_MAX, ILAST_PROC_NBR )
- NBUPROCNBR(12+JSV) = 3
-!
- CBUACTION(12+JSV,1) = 'IG'
- CBUACTION(12+JSV,2) = 'CC'
- CBUACTION(12+JSV,3) = 'ES'
-!
- DO JJ=1,3
- CBUCOMMENT(12+JSV,JJ) = ADJUSTL( ADJUSTR( YWORK2(12+JSV,JJ) ) // &
- ADJUSTL( YEND_COMMENT(12+JSV) ) )
- END DO
- END DO
-!
-END IF
+tzsource%ntype = TYPEREAL
+tzsource%ndims = 3
+
+! Budget of RU
+tbudgets(NBUDGET_U)%lenabled = lbu_ru
+
+if ( lbu_ru ) then
+ allocate( tbudgets(NBUDGET_U)%trhodj )
+
+ tbudgets(NBUDGET_U)%trhodj%cmnhname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_U)%trhodj%clongname = 'RhodJX'
+ tbudgets(NBUDGET_U)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_U)%trhodj%ccomment = 'RhodJ for momentum along X axis'
+ tbudgets(NBUDGET_U)%trhodj%ngrid = 2
+ tbudgets(NBUDGET_U)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_U)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_U)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_U)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_U)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_U)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_U)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along X axis'
+ tzsource%ngrid = 2
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force due to trees'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_U), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_U) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_U), cbulist_ru )
+end if
+
+! Budget of RV
+tbudgets(NBUDGET_V)%lenabled = lbu_rv
+
+if ( lbu_rv ) then
+ allocate( tbudgets(NBUDGET_V)%trhodj )
+
+ tbudgets(NBUDGET_V)%trhodj%cmnhname = 'RhodJY'
+ tbudgets(NBUDGET_V)%trhodj%cstdname = ''
+ tbudgets(NBUDGET_V)%trhodj%clongname = 'RhodJY'
+ tbudgets(NBUDGET_V)%trhodj%cunits = 'kg'
+ tbudgets(NBUDGET_V)%trhodj%ccomment = 'RhodJ for momentum along Y axis'
+ tbudgets(NBUDGET_V)%trhodj%ngrid = 3
+ tbudgets(NBUDGET_V)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_V)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_V)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_V)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_V)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_V)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_V)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along Y axis'
+ tzsource%ngrid = 3
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force due to trees'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_V), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_V) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_V), cbulist_rv )
+end if
+
+! Budget of RW
+tbudgets(NBUDGET_W)%lenabled = lbu_rw
+
+if ( lbu_rw ) then
+ allocate( tbudgets(NBUDGET_W)%trhodj )
+
+ tbudgets(NBUDGET_W)%trhodj%cmnhname = 'RhodJZ'
+ 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 Z axis'
+ tbudgets(NBUDGET_W)%trhodj%ngrid = 4
+ tbudgets(NBUDGET_W)%trhodj%ntype = TYPEREAL
+ tbudgets(NBUDGET_W)%trhodj%ndims = 3
+
+ allocate( tbudgets(NBUDGET_W)%trhodj%xdata(ibudim1, ibudim2, ibudim3) )
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = 0.
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_W)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_W)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_W)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_W)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of momentum along Z axis'
+ tzsource%ngrid = 4
+
+ tzsource%cunits = 'm s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm s-2'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'CURV'
+ tzsource%clongname = 'curvature'
+ tzsource%lavailable = .not.l1d .and. .not.lcartesian .and. .not.lthinshell
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'COR'
+ tzsource%clongname = 'Coriolis'
+ tzsource%lavailable = lcorio .and. .not.l1d .and. .not.lthinshell
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifu
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_uvw
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'GRAV'
+ tzsource%clongname = 'gravity'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'PRES'
+ tzsource%clongname = 'pressure'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ tzsource%cmnhname = 'DRAGEOL'
+ tzsource%clongname = 'drag force due to wind turbine'
+ tzsource%lavailable = OAERO_EOL
+ call Budget_source_add( tbudgets(NBUDGET_W), tzsource )
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_W) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_W), cbulist_rw )
+end if
+
+! Budget of RTH
+tbudgets(NBUDGET_TH)%lenabled = lbu_rth
+
+if ( lbu_rth ) then
+ tbudgets(NBUDGET_TH)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_TH)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_TH)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_TH)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_TH)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of potential temperature'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'K'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'K s-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = '2DADV'
+ tzsource%clongname = 'advective forcing'
+ tzsource%lavailable = l2d_adv_frc
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = '2DREL'
+ tzsource%clongname = 'relaxation forcing'
+ tzsource%lavailable = l2d_rel_frc
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'PREF'
+ tzsource%clongname = 'reference pressure'
+ tzsource%lavailable = krr > 0 .and. .not.l1d
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'RAD'
+ tzsource%clongname = 'radiation'
+ tzsource%lavailable = hrad /= 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DISSH'
+ tzsource%clongname = 'dissipation'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ 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 )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_th
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'OCEAN'
+ tzsource%clongname = 'radiative tendency due to SW penetrating ocean'
+ tzsource%lavailable = locean .and. (.not. lcouples)
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ 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 = '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 )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'heat transport by hydrometeors sedimentation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ 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 &
+ .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 ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. lwarm_lima .and. lrain_lima ) .or. lptsplit ) ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) &
+ .or. hcloud == 'KESS'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ 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_TH), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'raindrop homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima .and. lrain_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ 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 = 'IMLT'
+ 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 )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ 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 )
+
+ tzsource%cmnhname = 'RIM'
+ 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 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'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ 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_TH), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ 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 = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ 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 = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ 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 = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ 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 = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_TH), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_TH) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_TH), cbulist_rth )
+end if
+
+! Budget of RTKE
+tbudgets(NBUDGET_TKE)%lenabled = lbu_rtke
+
+if ( lbu_rtke ) then
+ tbudgets(NBUDGET_TKE)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_TKE)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_TKE)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_TKE)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_TKE)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of turbulent kinetic energy'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'm2 s-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 'm2 s-3'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_tke
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DRAG'
+ tzsource%clongname = 'drag force'
+ tzsource%lavailable = odragtree
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DRAGB'
+ tzsource%clongname = 'drag force due to buildings'
+ tzsource%lavailable = ldragbldg
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DP'
+ tzsource%clongname = 'dynamic production'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'TP'
+ tzsource%clongname = 'thermal production'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'DISS'
+ tzsource%clongname = 'dissipation of TKE'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'TR'
+ tzsource%clongname = 'turbulent transport'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_TKE), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_TKE) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_TKE), cbulist_rtke )
+end if
+
+! Budget of RRV
+tbudgets(NBUDGET_RV)%lenabled = lbu_rrv .and. krr >= 1
+
+if ( tbudgets(NBUDGET_RV)%lenabled ) then
+ tbudgets(NBUDGET_RV)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RV)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RV)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RV)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RV)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of water vapor mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = '2DADV'
+ tzsource%clongname = 'advective forcing'
+ tzsource%lavailable = l2d_adv_frc
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = '2DREL'
+ tzsource%clongname = 'relaxation forcing'
+ tzsource%lavailable = l2d_rel_frc
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NUD'
+ tzsource%clongname = 'nudging'
+ tzsource%lavailable = onudging
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rv
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ 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 )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ 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 = '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 )
+
+ 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 &
+ .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 ) )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( ( .not. lptsplit .and. lwarm_lima .and. lrain_lima ) &
+ .or. lptsplit ) ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 ) &
+ .or. hcloud == 'KESS'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ 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_RV), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ 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 )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'deposition on ice'
+ tzsource%lavailable = ( hcloud(1:3) == 'ICE' .and. ( .not. lred .or. ( lred .and. ladj_after ) .or. celec /= 'NONE') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RV), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RV) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RV), cbulist_rrv )
+end if
+
+! Budget of RRC
+tbudgets(NBUDGET_RC)%lenabled = lbu_rrc .and. krr >= 2
+
+if ( tbudgets(NBUDGET_RC)%lenabled ) then
+ if ( hcloud(1:3) == 'ICE' .and. lred .and. lsedic_ice .and. ldeposc_ice ) &
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', 'lred=T + lsedic=T + ldeposc=T:'// &
+ 'DEPO and SEDI source terms are mixed and stored in SEDI' )
+
+ tbudgets(NBUDGET_RC)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RC)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RC)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RC)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RC)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of cloud water mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rc
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ 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 )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ 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 = '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(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of cloud'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lsedc_lima ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. lsedic_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lsedc_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lsedc_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. ldepoc_lima ) &
+ .or. ( hcloud == 'C2R2' .and. ldepoc_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. ldepoc_c2r2 ) &
+ .or. ( hcloud(1:3) == 'ICE' .and. ldeposc_ice .and. celec == 'NONE' )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ 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_RC), tzsource )
+
+ 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 &
+ .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 )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ 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_RC), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ 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 ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ 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 ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ 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_RC), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ 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 )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ 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 )
+
+ tzsource%cmnhname = 'RIM'
+ 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_RC), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'collection by snow and conversion into rain with T>XTT on ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ 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_RC), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ 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_RC), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ 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 )
+
+ tzsource%cmnhname = 'COND'
+ tzsource%clongname = 'vapor condensation or cloud water evaporation'
+ tzsource%lavailable = hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'KESS' .or. hcloud == 'REVE'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RC), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RC) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RC), cbulist_rrc )
+end if
+
+! Budget of RRR
+tbudgets(NBUDGET_RR)%lenabled = lbu_rrr .and. krr >= 3
+
+if ( tbudgets(NBUDGET_RR)%lenabled ) then
+ tbudgets(NBUDGET_RR)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RR)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RR)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RR)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RR)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of rain water mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rr
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ 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 )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ 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 = '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(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of rain drops'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lwarm_lima .and. lrain_lima ) &
+ .or. hcloud == 'KESS' &
+ .or. hcloud(1:3) == 'ICE' &
+ .or. hcloud == 'C2R2' &
+ .or. hcloud == 'KHKO'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ 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'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ 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 ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lwarm_lima .and. lrain_lima ) ) ) &
+ .or. hcloud == 'KESS' &
+ .or. ( hcloud(1:3) == 'ICE' .and. lwarm_ice ) &
+ .or. ( hcloud == 'C2R2' .and. lrain_c2r2 ) &
+ .or. ( hcloud == 'KHKO' .and. lrain_c2r2 )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima .and. lrain_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+
+ tzsource%cmnhname = 'ACC'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'collection of droplets by snow and conversion into rain'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ 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 )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ 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 )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ 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 )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ 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 )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+!PW: a documenter
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RR), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RR) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RR), cbulist_rrr )
+end if
+
+! Budget of RRI
+tbudgets(NBUDGET_RI)%lenabled = lbu_rri .and. krr >= 4
+
+if ( tbudgets(NBUDGET_RI)%lenabled ) then
+ tbudgets(NBUDGET_RI)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RI)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RI)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RI)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RI)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of cloud ice mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_ri
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = hdconv == 'KAFR' .OR. hsconv == 'KAFR'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NETUR'
+ 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'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ 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(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'ADJU'
+ 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 )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation of rain drops'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lsedi_lima ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'heterogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ 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 )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ 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 )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ 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 )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ 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 )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ 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 )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ 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 )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ 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') ) &
+ .or. ( hcloud == 'LIMA' .and. lptsplit )
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'CORR2'
+ tzsource%clongname = 'supplementary correction inside LIMA splitting'
+ tzsource%lavailable = hcloud == 'LIMA' .and. lptsplit
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RI), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RI) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RI), cbulist_rri )
+end if
+
+! Budget of RRS
+tbudgets(NBUDGET_RS)%lenabled = lbu_rrs .and. krr >= 5
+
+if ( tbudgets(NBUDGET_RS)%lenabled ) then
+ tbudgets(NBUDGET_RS)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RS)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RS)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RS)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RS)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of snow/aggregate mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rs
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! 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 )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ 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(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lsnow_lima ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lsnow_lima ) ) ) .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ 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_RS), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ 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_RS), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ 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_RS), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ 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_RS), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RS), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RS) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RS), cbulist_rrs )
+end if
+
+! Budget of RRG
+tbudgets(NBUDGET_RG)%lenabled = lbu_rrg .and. krr >= 6
+
+if ( tbudgets(NBUDGET_RG)%lenabled ) then
+ tbudgets(NBUDGET_RG)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RG)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RG)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RG)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RG)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of graupel mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rg
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! 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 )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ 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 = 'negativity correction'
+ tzsource%lavailable = hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud(1:3) == 'ICE' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lsnow_lima ) &
+ .or. hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lnucl_lima .and. lrain_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = hcloud(1:3) == 'ICE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ 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_RG), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ 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_RG), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting of snow'
+ 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_RG), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ 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_RG), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ 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_RG), tzsource )
+
+ tzsource%cmnhname = 'GHCV'
+ tzsource%clongname = 'graupel to hail conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ 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_RG), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = hcloud == 'LIMA' .and. ( lptsplit .or. (lcold_lima .and. lwarm_lima .and. lsnow_lima ) )
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ 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_RG), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion of hail to graupel'
+ tzsource%lavailable = hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima .and. lwarm_lima .and. lsnow_lima
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'HGCV'
+ tzsource%clongname = 'hail to graupel conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ 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'
+ call Budget_source_add( tbudgets(NBUDGET_RG), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RG) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RG), cbulist_rrg )
+end if
+
+! Budget of RRH
+tbudgets(NBUDGET_RH)%lenabled = lbu_rrh .and. krr >= 7
+
+if ( tbudgets(NBUDGET_RH)%lenabled ) then
+ tbudgets(NBUDGET_RH)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(NBUDGET_RH)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(NBUDGET_RH)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(NBUDGET_RH)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(NBUDGET_RH)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of hail mixing ratio'
+ tzsource%ngrid = 1
+
+ tzsource%cunits = 'kg kg-1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifth
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_rh
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+! tzsource%cmnhname = 'NETUR'
+! 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 )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_r
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lcold_lima .and. lhail_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'GHCV'
+ tzsource%clongname = 'graupel to hail conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. lhail_lima &
+ .and. ( lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima ) ) ) &
+ .or. ( hcloud == 'ICE4' .and. ( .not. lred .or. celec /= 'NONE' ) )
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'COHG'
+ tzsource%clongname = 'conversion from hail to graupel'
+ tzsource%lavailable = hcloud == 'LIMA' .and. .not.lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'HGCV'
+ tzsource%clongname = 'hail to graupel conversion'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'DRYH'
+ tzsource%clongname = 'dry growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = ( hcloud == 'LIMA' .and. .not. lptsplit .and. lhail_lima .and. lcold_lima &
+ .and. lwarm_lima .and. lsnow_lima ) &
+ .or. hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'CORR'
+ tzsource%clongname = 'correction'
+ tzsource%lavailable = hcloud == 'ICE4' .and. lred .and. celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = celec == 'NONE'
+ call Budget_source_add( tbudgets(NBUDGET_RH), tzsource )
+
+
+ call Sourcelist_sort_compact( tbudgets(NBUDGET_RH) )
+
+ call Sourcelist_scan( tbudgets(NBUDGET_RH), cbulist_rrh )
+end if
+
+! Budgets of RSV (scalar variables)
+
+if ( ksv > 999 ) call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'number of scalar variables > 999' )
+
+SV_BUDGETS: do jsv = 1, ksv
+ ibudget = NBUDGET_SV1 - 1 + jsv
+
+ tbudgets(ibudget)%lenabled = lbu_rsv
+
+ if ( lbu_rsv ) then
+ tbudgets(ibudget)%trhodj => tburhodj
+
+ !Allocate all basic source terms (used or not)
+ !The size should be large enough (bigger than necessary is OK)
+ tbudgets(ibudget)%nsourcesmax = NSOURCESMAX
+ allocate( tbudgets(ibudget)%tsources(NSOURCESMAX) )
+
+ allocate( tbudgets(ibudget)%xtmpstore(ibudim1, ibudim2, ibudim3) )
+
+ tbudgets(ibudget)%tsources(:)%ngroup = 0
+
+ tzsource%ccomment = 'Budget of scalar variable ' // csvnames(jsv)
+ tzsource%ngrid = 1
+
+ tzsource%cunits = '1'
+
+ tzsource%cmnhname = 'INIF'
+ tzsource%clongname = 'initial state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'ENDF'
+ tzsource%clongname = 'final state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .true. )
+
+ tzsource%cmnhname = 'AVEF'
+ tzsource%clongname = 'averaged state'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource, odonotinit = .true., ooverwrite = .false. )
+
+ tzsource%cunits = 's-1'
+
+ tzsource%cmnhname = 'ASSE'
+ tzsource%clongname = 'time filter (Asselin)'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEST'
+ tzsource%clongname = 'nesting'
+ tzsource%lavailable = nmodel > 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'FRC'
+ tzsource%clongname = 'forcing'
+ tzsource%lavailable = lforcing
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DIF'
+ tzsource%clongname = 'numerical diffusion'
+ tzsource%lavailable = onumdifsv
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REL'
+ tzsource%clongname = 'relaxation'
+ tzsource%lavailable = ohorelax_sv( jsv ) .or. ( celec /= 'NONE' .and. lrelax2fw_ion &
+ .and. (jsv == nsv_elecbeg .or. jsv == nsv_elecend ) )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DCONV'
+ tzsource%clongname = 'KAFR convection'
+ tzsource%lavailable = ( hdconv == 'KAFR' .or. hsconv == 'KAFR' ) .and. ochtrans
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'VTURB'
+ tzsource%clongname = 'vertical turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HTURB'
+ tzsource%clongname = 'horizontal turbulent diffusion'
+ tzsource%lavailable = hturb == 'TKEL' .and. HTURBDIM == '3DIM'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'MAFL'
+ tzsource%clongname = 'mass flux'
+ tzsource%lavailable = hsconv == 'EDKF'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'VISC'
+ tzsource%clongname = 'viscosity'
+ tzsource%lavailable = lvisc .and. lvisc_sv
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ADV'
+ tzsource%clongname = 'total advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA2'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ ! Add specific source terms to different scalar variables
+ SV_VAR: if ( jsv <= nsv_user ) then
+ ! nsv_user case
+ ! Nothing to do
+
+ else if ( jsv >= nsv_c2r2beg .and. jsv <= nsv_c2r2end ) then SV_VAR
+ ! C2R2 or KHKO Case
+
+ ! Source terms in common for all C2R2/KHKO budgets
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ ! Source terms specific to each budget
+ SV_C2R2: select case( jsv - nsv_c2r2beg + 1 )
+ case ( 1 ) SV_C2R2
+ ! Concentration of activated nuclei
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 2 ) SV_C2R2
+ ! Concentration of cloud droplets
+ tzsource%cmnhname = 'DEPOTR'
+ tzsource%clongname = 'tree droplet deposition'
+ tzsource%lavailable = odragtree .and. odepotree
+ call Budget_source_add( tbudgets(ibudget), tzsource)
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ gtmp = cactccn == 'ABRK' .and. (lorilam .or. ldust .or. lsalt )
+ tzsource%lavailable = gtmp .or. ( .not.gtmp .and. .not.lsupsat_c2r2 )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SELF'
+ tzsource%clongname = 'self-collection of cloud droplets'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lsedc_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = ldepoc_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 3 ) SV_C2R2
+ ! Concentration of raindrops
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCBU'
+ tzsource%clongname = 'self collection - coalescence/break-up'
+ tzsource%lavailable = hcloud /= 'KHKO'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'spontaneous break-up'
+ tzsource%lavailable = lrain_c2r2
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 4 ) SV_C2R2
+ ! Supersaturation
+ tzsource%cmnhname = 'CEVA'
+ tzsource%clongname = 'evaporation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ end select SV_C2R2
+
+
+ else if ( jsv >= nsv_lima_beg .and. jsv <= nsv_lima_end ) then SV_VAR
+ ! LIMA case
+
+ ! Source terms in common for all LIMA budgets (except supersaturation)
+ if ( jsv /= nsv_lima_spro ) then
+ tzsource%cmnhname = 'NETUR'
+ tzsource%clongname = 'negativity correction induced by turbulence'
+ tzsource%lavailable = hturb == 'TKEL'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEADV'
+ tzsource%clongname = 'negativity correction induced by advection'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NECON'
+ tzsource%clongname = 'negativity correction induced by condensation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+ 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
+! call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lwarm_lima .and. lsedc_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPO'
+ tzsource%clongname = 'surface droplet deposition'
+ tzsource%lavailable = lwarm_lima .and. ldepoc_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ 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'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SELF'
+ tzsource%clongname = 'self-collection of cloud droplets'
+ tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lptsplit .or. ( lwarm_lima .and. lrain_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lptsplit .or. ( lwarm_lima .and. lrain_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lptsplit .or. ( lwarm_lima .and. lrain_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ 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 = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth 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 = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ 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 = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lwarm_lima .and. lrain_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'R2C1'
+ tzsource%clongname = 'rain to cloud change after sedimentation'
+ tzsource%lavailable = lptsplit .and. lwarm_lima .and. lrain_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCBU'
+ tzsource%clongname = 'self collection - coalescence/break-up'
+ tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BRKU'
+ tzsource%clongname = 'spontaneous break-up'
+ tzsource%lavailable = lptsplit .or. (lwarm_lima .and. lrain_lima)
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONR'
+ tzsource%clongname = 'rain homogeneous freezing'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lrain_lima .and. lnucl_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ 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 )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CVRC'
+ tzsource%clongname = 'rain to cloud change after other microphysical processes'
+ tzsource%lavailable = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth 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 = 'HMLT'
+ 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 = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ccn_free .and. jsv <= nsv_lima_ccn_free + nmod_ccn - 1 ) then SV_LIMA
+ ! Free CCN concentration
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ 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'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lwarm_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ccn_acti .and. jsv <= nsv_lima_ccn_acti + nmod_ccn - 1 ) then SV_LIMA
+ ! Activated CCN concentration
+ tzsource%cmnhname = 'HENU'
+ tzsource%clongname = 'CCN activation'
+ 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'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lwarm_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_scavmass ) then SV_LIMA
+ ! Scavenged mass variable
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima .and. laero_mass_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ 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 = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lcold_lima .and. lsedi_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. lhhoni_lima .and. nmod_ccn >= 1
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HONC'
+ 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 = 'CNVI'
+ tzsource%clongname = 'conversion of snow to cloud ice'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CNVS'
+ tzsource%clongname = 'conversion of pristine ice to snow'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMS'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to snow riming'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMG'
+ tzsource%clongname = 'Hallett-Mossop ice multiplication process due to graupel riming'
+ tzsource%lavailable = lptsplit .or. ( lcold_lima .and. lwarm_lima .and. lsnow_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth 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 = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ 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 = lptsplit
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ifn_free .and. jsv <= nsv_lima_ifn_free + nmod_ifn - 1 ) then SV_LIMA
+ ! Free IFN concentration
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SCAV'
+ tzsource%clongname = 'scavenging'
+ tzsource%lavailable = lscav_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_ifn_nucl .and. jsv <= nsv_lima_ifn_nucl + nmod_ifn - 1 ) then SV_LIMA
+ ! Nucleated IFN concentration
+ tzsource%cmnhname = 'HIND'
+ tzsource%clongname = 'heterogeneous nucleation by deposition'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima &
+ .and. ( ( lmeyers_lima .and. jsv == nsv_lima_ifn_nucl ) .or. .not. lmeyers_lima )
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. lmeyers_lima .and. jsv == nsv_lima_ifn_nucl
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ 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 .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lima_imm_nucl .and. jsv <= nsv_lima_imm_nucl + nmod_imm - 1 ) then SV_LIMA
+ ! Nucleated IMM concentration
+ tzsource%cmnhname = 'HINC'
+ tzsource%clongname = 'heterogeneous nucleation by contact'
+ tzsource%lavailable = lcold_lima .and. lnucl_lima .and. .not. lmeyers_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CEDS'
+ tzsource%clongname = 'adjustment to saturation'
+ tzsource%lavailable = lcold_lima .and. .not.lptsplit .and. .not.lspro_lima
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv == nsv_lima_hom_haze ) then SV_LIMA
+ ! Homogeneous freezing of CCN
+ tzsource%cmnhname = 'HONH'
+ tzsource%clongname = 'haze homogeneous nucleation'
+ 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
+
+
+ else if ( jsv >= nsv_elecbeg .and. jsv <= nsv_elecend ) then SV_VAR
+ ! Electricity case
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ SV_ELEC: select case( jsv - nsv_elecbeg + 1 )
+ case ( 1 ) SV_ELEC
+ ! volumetric charge of water vapor
+ tzsource%cmnhname = 'DRIFT'
+ tzsource%clongname = 'ion drift motion'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORAY'
+ tzsource%clongname = 'cosmic ray source'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 2 ) SV_ELEC
+ ! volumetric charge of cloud droplets
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'INCG'
+ tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel'
+ tzsource%lavailable = linductive
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = lsedic_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 3 ) SV_ELEC
+ ! volumetric charge of rain drops
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTO'
+ tzsource%clongname = 'autoconversion into rain'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACCR'
+ tzsource%clongname = 'accretion of cloud droplets'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on aggregates'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ case ( 4 ) SV_ELEC
+ ! volumetric charge of ice crystals
+ tzsource%cmnhname = 'HON'
+ tzsource%clongname = 'homogeneous nucleation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'IMLT'
+ tzsource%clongname = 'melting of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'BERFI'
+ tzsource%clongname = 'Bergeron-Findeisen'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NIIS'
+ tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 5 ) SV_ELEC
+ ! volumetric charge of snow
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AGGS'
+ tzsource%clongname = 'aggregation of snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'AUTS'
+ tzsource%clongname = 'autoconversion of ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NIIS'
+ tzsource%clongname = 'non-inductive charge separation due to ice-snow collisions'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 6 ) SV_ELEC
+ ! volumetric charge of graupel
+ tzsource%cmnhname = 'SFR'
+ tzsource%clongname = 'spontaneous freezing'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'RIM'
+ tzsource%clongname = 'riming of cloud water'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'ACC'
+ tzsource%clongname = 'accretion of rain on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CMEL'
+ tzsource%clongname = 'conversion melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CFRZ'
+ tzsource%clongname = 'conversion freezing of rain'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DRYG'
+ tzsource%clongname = 'dry growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'INCG'
+ tzsource%clongname = 'inductive charge transfer between cloud droplets and graupel'
+ tzsource%lavailable = linductive
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'GMLT'
+ tzsource%clongname = 'graupel melting'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = hcloud == 'ICE4'
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ case ( 7: ) SV_ELEC
+ if ( ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) ) then
+ ! volumetric charge of hail
+ tzsource%cmnhname = 'WETG'
+ tzsource%clongname = 'wet growth of graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'WETH'
+ tzsource%clongname = 'wet growth of hail'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'HMLT'
+ tzsource%clongname = 'melting of hail'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SEDI'
+ tzsource%clongname = 'sedimentation'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( ( hcloud == 'ICE3' .and. ( jsv - nsv_elecbeg + 1 ) == 7 ) &
+ .or. ( hcloud == 'ICE4' .and. ( jsv - nsv_elecbeg + 1 ) == 8 ) ) then
+ ! Negative ions (NSV_ELECEND case)
+ tzsource%cmnhname = 'DRIFT'
+ tzsource%clongname = 'ion drift motion'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'CORAY'
+ tzsource%clongname = 'cosmic ray source'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPS'
+ tzsource%clongname = 'deposition on snow'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPG'
+ tzsource%clongname = 'deposition on graupel'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'REVA'
+ tzsource%clongname = 'rain evaporation'
+ tzsource%lavailable = lwarm_ice
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'DEPI'
+ tzsource%clongname = 'condensation/deposition on ice'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'NEUT'
+ tzsource%clongname = 'neutralization'
+ tzsource%lavailable = .true.
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown electricity budget' )
+ end if
+
+ end select SV_ELEC
+
+
+ else if ( jsv >= nsv_lgbeg .and. jsv <= nsv_lgend ) then SV_VAR
+ !Lagrangian variables
+
+
+ else if ( jsv >= nsv_ppbeg .and. jsv <= nsv_ppend ) then SV_VAR
+ !Passive pollutants
+
+
+#ifdef MNH_FOREFIRE
+ else if ( jsv >= nsv_ffbeg .and. jsv <= nsv_ffend ) then SV_VAR
+ !Forefire
+
+#endif
+ else if ( jsv >= nsv_csbeg .and. jsv <= nsv_csend ) then SV_VAR
+ !Conditional sampling
+
+
+ else if ( jsv >= nsv_chembeg .and. jsv <= nsv_chemend ) then SV_VAR
+ !Chemical case
+ tzsource%cmnhname = 'CHEM'
+ tzsource%clongname = 'chemistry activity'
+ 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 )
+
+
+ else if ( jsv >= nsv_chicbeg .and. jsv <= nsv_chicend ) then SV_VAR
+ !Ice phase chemistry
+
+
+ else if ( jsv >= nsv_aerbeg .and. jsv <= nsv_aerend ) then SV_VAR
+ !Chemical aerosol case
+ tzsource%cmnhname = 'NEGA'
+ tzsource%clongname = 'negativity correction'
+ tzsource%lavailable = lorilam
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ else if ( jsv >= nsv_aerdepbeg .and. jsv <= nsv_aerdepend ) then SV_VAR
+ !Aerosol wet deposition
+
+ else if ( jsv >= nsv_dstbeg .and. jsv <= nsv_dstend ) then SV_VAR
+ !Dust
+
+ else if ( jsv >= nsv_dstdepbeg .and. jsv <= nsv_dstdepend ) then SV_VAR
+ !Dust wet deposition
+
+ else if ( jsv >= nsv_sltbeg .and. jsv <= nsv_sltend ) then SV_VAR
+ !Salt
+
+ else if ( jsv >= nsv_sltdepbeg .and. jsv <= nsv_sltdepend ) then SV_VAR
+ !Salt wet deposition
+
+ else if ( jsv >= nsv_snwbeg .and. jsv <= nsv_snwend ) then SV_VAR
+ !Snow
+ tzsource%cmnhname = 'SNSUB'
+ tzsource%clongname = 'blowing snow sublimation'
+ tzsource%lavailable = lblowsnow .and. lsnowsubl
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+ tzsource%cmnhname = 'SNSED'
+ tzsource%clongname = 'blowing snow sedimentation'
+ tzsource%lavailable = lblowsnow
+ call Budget_source_add( tbudgets(ibudget), tzsource )
+
+
+ else if ( jsv >= nsv_lnoxbeg .and. jsv <= nsv_lnoxend ) then SV_VAR
+ !LiNOX passive tracer
+
+ else SV_VAR
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', 'unknown scalar variable' )
+ end if SV_VAR
+
+
+ call Sourcelist_sort_compact( tbudgets(ibudget) )
+
+ call Sourcelist_scan( tbudgets(ibudget), cbulist_rsv )
+ end if
+end do SV_BUDGETS
-!-------------------------------------------------------------------------------
-!* 4. COMPUTE THE INCREMENT BETWEEN TWO ACTIVE SOURCES
-! ------------------------------------------------
-!
-NBUINC(:,:) = 1
-DO JI = 1, JPBUMAX
- DO JJ = 4, JPBUPROMAX-1
- DO JK = JJ+1,JPBUPROMAX
- IF ( IPROACTV(JI,JK) /= 3 ) EXIT
- NBUINC(JI,JJ) = NBUINC(JI,JJ) +1
- END DO
- END DO
-END DO
-!
-!-------------------------------------------------------------------------------
-!* 5. COMPUTE PROCESSES ACTIONS AND NAMES OF BUDGET OUTPUT ARRAYS
-! -----------------------------------------------------------
-!
-!
-DO JI=1,JPBUMAX ! loop on the allowed budgets
- ! names of recording files for:
- CBURECORD(JI,1) = ADJUSTL( CBUCOMMENT(JI,1) ) ! initial guess
- CBURECORD(JI,2) = ADJUSTL( CBUCOMMENT(JI,2) ) ! source cumul
- CBURECORD(JI,3) = ADJUSTL( CBUCOMMENT(JI,3) ) ! end step
-!
- IF (IPROACTV(JI,4) >= 2) THEN
- WRITE(UNIT=KLUOUT,FMT= '("Error in budget specification of ",A7,/," &
- & The first source either is the first element of a group of sources or &
- & is not considered")') YEND_COMMENT(JI)
- WRITE(UNIT=KLUOUT,FMT= '("change this namelist element ")')
- GERROR = .TRUE.
- END IF
-!
- DO JJ=4,JPBUPROMAX ! loop on the allowed processes
- IF (IPROACTV(JI,JJ) == 0) THEN
- IF(IPROACTV(JI,JJ+NBUINC(JI,JJ)) == 0) THEN
- CBUACTION(JI,JJ)='OF'
- ELSE IF (IPROACTV(JI,JJ+NBUINC(JI,JJ)) == 1) THEN
- CBUACTION(JI,JJ)='CC'
- ELSE IF (IPROACTV(JI,JJ+NBUINC(JI,JJ)) == 2) THEN
- WRITE(UNIT=KLUOUT,FMT= '("Error in budget specification of ",A15)') &
- ADJUSTL( ADJUSTR(YWORK2(JI,JJ+NBUINC(JI,JJ)))//ADJUSTL(YEND_COMMENT(JI)))
- WRITE(UNIT=KLUOUT,FMT= '("change this namelist ")')
- GERROR = .TRUE.
- END IF
- ELSE IF (IPROACTV(JI,JJ) <= 2) THEN
- DO JJJ = JJ+NBUINC(JI,JJ), JPBUPROMAX
- IF(IPROACTV(JI,JJJ) /= 3 .AND. IPROACTV(JI,JJJ) /= 4) EXIT
- END DO
-!
- IF (IPROACTV(JI,JJJ) == 1) THEN
- NBUPROCNBR(JI) = NBUPROCNBR(JI)+1
- CBUACTION(JI,JJ) = 'DC'
- CBUCOMMENT(JI,NBUPROCNBR(JI)) = ADJUSTL( &
- ADJUSTR( CBUCOMMENT(JI,NBUPROCNBR(JI)) ) // &
- ADJUSTL( ADJUSTR( YWORK2(JI,JJ) ) // &
- ADJUSTL( YEND_COMMENT(JI) ) ) )
- ITEN=INT(NBUPROCNBR(JI)/10)
- CBURECORD(JI,NBUPROCNBR(JI)) = 'S' // CHAR( ITEN + 48 ) &
- // CHAR( 48+ MODULO( NBUPROCNBR(JI),10*MAX(1,ITEN) ) ) &
- // '_' // ADJUSTL( YEND_COMMENT(JI) )
- ELSE IF (IPROACTV(JI,JJJ) == 0) THEN
- NBUPROCNBR(JI) = NBUPROCNBR(JI)+1
- CBUACTION(JI,JJ) = 'DD'
- CBUCOMMENT(JI,NBUPROCNBR(JI)) = ADJUSTL( &
- ADJUSTR( CBUCOMMENT(JI,NBUPROCNBR(JI)) ) // &
- ADJUSTL( ADJUSTR( YWORK2(JI,JJ) ) // &
- ADJUSTL( YEND_COMMENT(JI) ) ) )
- ITEN=INT(NBUPROCNBR(JI)/10)
- CBURECORD(JI,NBUPROCNBR(JI)) = 'S' // CHAR( ITEN + 48 ) &
- // CHAR( 48+ MODULO( NBUPROCNBR(JI),10*MAX(1,ITEN) ) ) &
- // '_' // ADJUSTL( YEND_COMMENT(JI) )
- ELSE IF (IPROACTV(JI,JJJ) == 2) THEN
- CBUACTION(JI,JJ) = 'NO'
- CBUCOMMENT(JI,NBUPROCNBR(JI)+1) = ADJUSTL( &
- ADJUSTR( CBUCOMMENT(JI,NBUPROCNBR(JI)+1)) // &
- ADJUSTL( YWORK2(JI,JJ) ) )
- END IF
- ELSEIF (IPROACTV(JI,JJ) == 3) THEN
- CBUACTION(JI,JJ) = 'RM'
- ELSEIF (IPROACTV(JI,JJ) == 4) THEN
- CBUACTION(JI,JJ) = 'OF'
- ELSE
- WRITE(UNIT=KLUOUT,FMT= '("Error in budget specification of ",A7)') &
- YEND_COMMENT(JI)
- WRITE(UNIT=KLUOUT,FMT= '("change this namelist ")')
- GERROR = .TRUE.
- END IF
- END DO
-END DO
-! writes on output the explicit chain of sources for all the budgets
-DO JI=1,JPBUMAX ! loop over the allowed budgets
- YSTRING = ADJUSTL( YEND_COMMENT(JI) )
- ILEN = LEN_TRIM(YSTRING)
- IF( ILEN /= 0 ) THEN
- IF( JI <= 12 ) THEN
- WRITE (UNIT=KLUOUT,FMT='(/,"budget ",A7," with ",I2," vectors")') &
- YSTRING(1:ILEN),NBUPROCNBR(JI)
- DO JJ=1,3
- YSTRING = CBUCOMMENT(JI,JJ)
- ILEN = LEN_TRIM(YSTRING)
- WRITE (UNIT=KLUOUT,FMT='(12X,A40)') YSTRING(1:ILEN)
- END DO
- DO JJ=4,NBUPROCNBR(JI) ! loop over the allowed processes
- YSTRING = CBUCOMMENT(JI,JJ)
- ILEN = LEN_TRIM(YSTRING)
- WRITE (UNIT=KLUOUT,FMT='(20X,A40)') YSTRING(1:ILEN)
- END DO
- ELSE
- WRITE (UNIT=KLUOUT, &
- FMT='(/,"budget ",A7," (number ",I3,") with ",I2," vectors")') &
- YSTRING(1:ILEN),JI-12,NBUPROCNBR(JI)
- DO JJ=1,3
- YSTRING = CBUCOMMENT(JI,JJ)
- ILEN = LEN_TRIM(YSTRING)
- WRITE (UNIT=KLUOUT,FMT='(12X,A40)') YSTRING(1:ILEN)
- END DO
- DO JJ=4,NBUPROCNBR(JI) ! loop over the allowed processes
- YSTRING = CBUCOMMENT(JI,JJ)
- ILEN = LEN_TRIM(YSTRING)
- WRITE (UNIT=KLUOUT,FMT='(20X,A40)') YSTRING(1:ILEN)
- END DO
- END IF
- END IF
-END DO
-!
IF (CBUTYPE=='CART') THEN
WRITE(UNIT=KLUOUT, FMT= '(2/,"DESCRIPTION OF THE BUDGET BOX")' )
WRITE(UNIT=KLUOUT, FMT= '("BUIL = ",I4.4)' ) NBUIL
@@ -2792,741 +4089,608 @@ IF (CBUTYPE=='MASK') THEN
WRITE(UNIT=KLUOUT, FMT= '("BUKL = ",I4.4)' ) NBUKL
WRITE(UNIT=KLUOUT, FMT= '("BUKH = ",I4.4)' ) NBUKH
WRITE(UNIT=KLUOUT, FMT= '("BUKMAX = ",I4.4)' ) NBUKMAX
- WRITE(UNIT=KLUOUT, FMT= '("BUWRNB = ",I4.4)' ) NBUWRNB
+ WRITE(UNIT=KLUOUT, FMT= '("BUSUBWRITE = ",I4.4)' ) NBUSUBWRITE
WRITE(UNIT=KLUOUT, FMT= '("BUMASK = ",I4.4)' ) NBUMASK
END IF
-IF (GERROR) THEN
- call Print_msg( NVERB_FATAL, 'GEN', 'INI_BUDGET', '' )
-ENDIF
-!-------------------------------------------------------------------------------
-!* 5. ALLOCATE MEMORY FOR BUDGET STORAGE ARRAYS
-! -----------------------------------------
-IF (LBU_RU) THEN
- ALLOCATE ( XBURU(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(1)) )
- XBURU(:,:,:,:)=0.
- ALLOCATE ( XBURHODJU(IBUDIM1, IBUDIM2, IBUDIM3) )
- XBURHODJU(:,:,:)=0.
-END IF
-!
-IF (LBU_RV) THEN
- ALLOCATE ( XBURV(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(2)) )
- XBURV(:,:,:,:)=0.
- ALLOCATE ( XBURHODJV(IBUDIM1, IBUDIM2, IBUDIM3) )
- XBURHODJV(:,:,:)=0.
-END IF
-!
-IF (LBU_RW) THEN
- ALLOCATE ( XBURW(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(3)) )
- XBURW(:,:,:,:)=0.
- ALLOCATE ( XBURHODJW(IBUDIM1, IBUDIM2, IBUDIM3) )
- XBURHODJW(:,:,:)=0.
-END IF
-!
-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
- ALLOCATE ( XBURHODJ(IBUDIM1, IBUDIM2, IBUDIM3) )
- XBURHODJ(:,:,:)=0.
-END IF
-!
-IF (LBU_RTH) THEN
- ALLOCATE ( XBURTH(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(4)) )
- XBURTH(:,:,:,:)=0.
-END IF
-!
-IF (LBU_RTKE) THEN
- ALLOCATE ( XBURTKE(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(5)) )
- XBURTKE(:,:,:,:)=0.
-END IF
-!
-IF (LBU_RRV) THEN
- ALLOCATE ( XBURRV(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(6)) )
- XBURRV(:,:,:,:)=0.
-END IF
-!
-IF (LBU_RRC) THEN
- ALLOCATE ( XBURRC(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(7)) )
- XBURRC(:,:,:,:)=0.
-END IF
-!
-IF (LBU_RRR) THEN
- ALLOCATE ( XBURRR(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(8)) )
- XBURRR(:,:,:,:)=0.
-END IF
-!
-IF (LBU_RRI) THEN
- ALLOCATE ( XBURRI(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(9)) )
- XBURRI(:,:,:,:)=0.
-END IF
-!
-IF (LBU_RRS) THEN
- ALLOCATE ( XBURRS(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(10)) )
- XBURRS(:,:,:,:)=0.
-END IF
-!
-IF (LBU_RRG) THEN
- ALLOCATE ( XBURRG(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(11)) )
- XBURRG(:,:,:,:)=0.
-END IF
-!
-IF (LBU_RRH) THEN
- ALLOCATE ( XBURRH(IBUDIM1, IBUDIM2, IBUDIM3, NBUPROCNBR(12)) )
- XBURRH(:,:,:,:)=0.
-END IF
-!
-IF (LBU_RSV) THEN
- ALLOCATE ( XBURSV(IBUDIM1, IBUDIM2, IBUDIM3, IBUPROCNBR_SV_MAX, KSV) )
- XBURSV(:,:,:,:,:)=0.
-END IF
-!
-CONTAINS
-! ##############################
- SUBROUTINE BUDGET_OTHERPROC_SV
-! ##############################
-!
-!
-USE MODD_NSV
-USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, NMOD_IFN, NMOD_IMM
-!
- IF (JSV <= NSV_USER) THEN
- ! NSV_USER Case
-! SELECT CASE(JSV)
-! CASE (1)
-! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
-! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC1_'
-! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
-! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
-! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC2_'
-! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
-! CASE (2)
-! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
-! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC3_'
-! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
-! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
-! YWORK2(12+JSV,ILAST_PROC_NBR)= 'PROC4_'
-! IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
-! END SELECT
- !
- ELSEIF (JSV >= NSV_C2R2BEG .AND. JSV <= NSV_C2R2END) THEN
- ! C2R2 or KHKO Case
- SELECT CASE(JSV-NSV_C2R2BEG+1)
- CASE (1) ! Concentration of activated nuclei
- IF (.NOT. LSUPSAT) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HENU_'
- END IF
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEVA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- CASE (2) ! Concentration of cloud droplets
- IF (.NOT. LSUPSAT) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HENU_'
- END IF
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SELF_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'ACCR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (LSEDC) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (LDEPOC) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'DEPO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEVA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- CASE (3) ! Concentration of raindrops
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'AUTO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (HCLOUD /= 'KHKO') THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SCBU_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEVA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'BRKU_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END SELECT
- !
-ELSEIF (JSV >= NSV_LIMA_BEG .AND. JSV <= NSV_LIMA_END) THEN
- ! LIMA case
- IF (JSV == NSV_LIMA_NC) THEN
- ! Cloud droplets conc.
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OPTSPLIT .AND. OWARM .AND. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CORR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OSEDC) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (ODEPOC) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'DEPO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .AND. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'R2C1_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OWARM .AND. OACTI .AND. NMOD_CCN.GE.1) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HENU_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OCOLD .AND. ONUCL .AND. OPTSPLIT) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HINC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OWARM .AND. ORAIN)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SELF_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'AUTO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'ACCR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'REVA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OCOLD .AND. ONUCL .AND. .NOT.OPTSPLIT) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HINC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. ONUCL)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'IMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'RIM_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'DRYG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CVRC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (.NOT.OPTSPLIT .AND. OHAIL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETH_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEDS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- !
- ELSE IF (JSV == NSV_LIMA_NR) THEN
- ! Rain drops conc.
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OPTSPLIT .AND. OWARM .AND. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CORR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OWARM .AND. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .AND. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'R2C1_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'AUTO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SCBU_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'REVA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. ORAIN) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'BRKU_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. ORAIN .AND. ONUCL)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'ACC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CFRZ_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'DRYG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'GMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CVRC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (.NOT.OPTSPLIT .AND. OHAIL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETH_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (.NOT.OPTSPLIT .AND. OHAIL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- !
- ELSE IF (JSV.GE.NSV_LIMA_CCN_FREE .AND. JSV.LT.(NSV_LIMA_CCN_FREE+NMOD_CCN)) THEN
- ! Free CCN conc.
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OWARM .AND. OACTI .AND. NMOD_CCN.GE.1) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HENU_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OCOLD .AND. ONUCL .AND. OHHONI .AND. NMOD_CCN.GE.1) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONH_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEDS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OSCAV) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SCAV_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- !
- ELSE IF (JSV.GE.NSV_LIMA_CCN_ACTI .AND. JSV.LT.(NSV_LIMA_CCN_ACTI+NMOD_CCN)) THEN
- ! Activated CCN conc.
-
- ELSE IF (JSV == NSV_LIMA_NI) THEN
- ! Pristine ice crystals conc.
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OPTSPLIT .AND. OCOLD .AND. OSNOW) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CORR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OSEDI) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OCOLD .AND. ONUCL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HIND_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OCOLD .AND. ONUCL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HINC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OCOLD .AND. ONUCL .AND. OHHONI .AND. NMOD_CCN.GE.1) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONH_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. ONUCL)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CNVI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CNVS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'AGGS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'IMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HMS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CFRZ_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'DRYG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (OPTSPLIT .OR. (OCOLD .AND. OWARM .AND. OSNOW)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HMG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- IF (.NOT.OPTSPLIT .AND. OHAIL) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'WETH_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEDS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- !
- ELSE IF (JSV.GE.NSV_LIMA_IFN_FREE .AND. JSV.LT.(NSV_LIMA_IFN_FREE+NMOD_IFN)) THEN
- ! Free IFN conc.
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OCOLD .AND. ONUCL .AND. (.NOT.OMEYERS)) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HIND_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CEDS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- IF (OSCAV) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'SCAV_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
- !
- ELSE IF (JSV.GE.NSV_LIMA_IFN_NUCL .AND. JSV.LT.(NSV_LIMA_IFN_NUCL+NMOD_IFN)) THEN
- ! Nucleated IFN conc.
-
- ELSE IF (JSV.GE.NSV_LIMA_IMM_NUCL .AND. JSV.LT.(NSV_LIMA_IMM_NUCL+NMOD_IMM)) THEN
- ! Nucleated IMM conc.
-
- ELSE IF (JSV == NSV_LIMA_HOM_HAZE) THEN
- ! Homogeneous freezing of CCN
- IF (OCOLD .AND. ONUCL .AND. OWARM .AND. OHHONI) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'HONH_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = 1
- END IF
-
- END IF
-
-
-
-
-ELSEIF (JSV >= NSV_ELECBEG .AND. JSV <= NSV_ELECEND) THEN
- SELECT CASE(JSV-NSV_ELECBEG+1)
- CASE(1) ! volumetric charge of water vapor
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPSQV
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPGQV
- IF (LWARM) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'REVA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NREVAQV
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPIQV
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEUTQV
- CASE(2) ! volumetric charge of cloud droplets
- IF (LWARM) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'AUTO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NAUTOQC
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'ACCR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NACCRQC
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'RIM_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NRIMQC
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'WETG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NWETGQC
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DRYG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDRYGQC
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'IMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NIMLTQC
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'BERFI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NBERFIQC
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPIQC
- IF (LINDUCTIVE) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'IND_'
- END IF
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NINDQC
- IF (LSEDIC) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NSEDIQC
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEUTQC
- CASE(3) ! volumetric charge of rain drops
- IF (LWARM) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'AUTO_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NAUTOQR
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'ACCR_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NACCRQR
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'REVA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NREVAQR
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'ACC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NACCQR
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'CFRZ_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NCFRZQR
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'WETG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NWETGQR
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DRYG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDRYGQR
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'GMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NGMLTQR
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NSEDIQR
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEUTQR
- CASE(4) ! volumetric charge of ice crystals
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'AGGS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NAGGSQI
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'AUTS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NAUTSQI
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'CFRZ_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NCFRZQI
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'WETG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NWETGQI
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DRYG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDRYGQI
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'IMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NIMLTQI
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'BERFI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NBERFIQI
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPIQI
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'NIIS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NNIISQI
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NSEDIQI
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEUTQI
- CASE(5) ! volumetric charge of snow
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPSQS
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'AGGS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NAGGSQS
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'AUTS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NAUTSQS
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'RIM_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NRIMQS
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'ACC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NACCQS
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'CMEL_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NCMELQS
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'WETG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NWETGQS
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DRYG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDRYGQS
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'NIIS_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NNIISQS
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NSEDIQS
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
- CASE(6) ! volumetric charge of graupel
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DEPG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDEPGQG
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'RIM_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NRIMQG
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'ACC_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NACCQG
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'CMEL_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NCMELQG
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'CFRZ_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NCFRZQG
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'WETG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NWETGQG
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'DRYG_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NDRYGQG
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'GMLT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NGMLTQG
- IF (LINDUCTIVE) THEN
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'IND_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NINDQG
- END IF
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'SEDI_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NSEDIQG
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR) = 'NEUT_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEUTQG
- CASE(7) ! volumetric charge of hail
-! add budget for hail volumetric charge
- END SELECT
-!
-ELSE IF (JSV >= NSV_CHEMBEG .AND. JSV <= NSV_CHEMEND) THEN
- ! Chemical Case
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'CHEM_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NCHEMSV
- ! other processes
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'ADV_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NADVSV
- ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- YWORK2(12+JSV,ILAST_PROC_NBR)= 'NEGA_'
- IPROACTV(12+JSV,ILAST_PROC_NBR) = NNEGASV
- !
- ELSE
- ! other processes
- ! ILAST_PROC_NBR = ILAST_PROC_NBR + 1
- ! YWORK2(12+JSV,ILAST_PROC_NBR)= 'ADV_'
- ! IPROACTV(12+JSV,ILAST_PROC_NBR) = NADVSV
- END IF
- !
- END SUBROUTINE BUDGET_OTHERPROC_SV
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE INI_BUDGET
+call Ini_budget_groups( tbudgets, ibudim1, ibudim2, ibudim3 )
+
+if ( tbudgets(NBUDGET_U) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_U), cbulist_ru )
+if ( tbudgets(NBUDGET_V) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_V), cbulist_rv )
+if ( tbudgets(NBUDGET_W) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_W), cbulist_rw )
+if ( tbudgets(NBUDGET_TH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TH), cbulist_rth )
+if ( tbudgets(NBUDGET_TKE)%lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_TKE), cbulist_rtke )
+if ( tbudgets(NBUDGET_RV) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RV), cbulist_rrv )
+if ( tbudgets(NBUDGET_RC) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RC), cbulist_rrc )
+if ( tbudgets(NBUDGET_RR) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RR), cbulist_rrr )
+if ( tbudgets(NBUDGET_RI) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RI), cbulist_rri )
+if ( tbudgets(NBUDGET_RS) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RS), cbulist_rrs )
+if ( tbudgets(NBUDGET_RG) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RG), cbulist_rrg )
+if ( tbudgets(NBUDGET_RH) %lenabled ) call Sourcelist_nml_compact( tbudgets(NBUDGET_RH), cbulist_rrh )
+if ( lbu_rsv ) call Sourcelist_sv_nml_compact( cbulist_rsv )
+end subroutine Ini_budget
+
+
+subroutine Budget_source_add( tpbudget, tpsource, odonotinit, ooverwrite )
+ use modd_budget, only: tbudgetdata, tbusourcedata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+ type(tbusourcedata), intent(in) :: tpsource ! Metadata basis
+ logical, optional, intent(in) :: odonotinit
+ logical, optional, intent(in) :: ooverwrite
+
+ character(len=4) :: ynum
+ integer :: isourcenumber
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Budget_source_add', 'called for ' // Trim( tpbudget%cname ) &
+ // ': ' // Trim( tpsource%cmnhname ) )
+
+ isourcenumber = tpbudget%nsources + 1
+ if ( isourcenumber > tpbudget%nsourcesmax ) then
+ Write( ynum, '( i4 )' ) tpbudget%nsourcesmax
+ cmnhmsg(1) = 'Insufficient max number of source terms (' // Trim(ynum) // ') for budget ' // Trim( tpbudget%cname )
+ cmnhmsg(2) = 'Please increaze value of parameter NSOURCESMAX'
+ call Print_msg( NVERB_FATAL, 'BUD', 'Budget_source_add' )
+ else
+ tpbudget%nsources = tpbudget%nsources + 1
+ end if
+
+ ! Copy metadata from provided tpsource
+ ! Modifications to source term metadata done with the other dummy arguments
+ tpbudget%tsources(isourcenumber) = tpsource
+
+ if ( present( odonotinit ) ) tpbudget%tsources(isourcenumber)%ldonotinit = odonotinit
+
+ if ( present( ooverwrite ) ) tpbudget%tsources(isourcenumber)%loverwrite = ooverwrite
+end subroutine Budget_source_add
+
+
+subroutine Ini_budget_groups( tpbudgets, kbudim1, kbudim2, kbudim3 )
+ use modd_budget, only: tbudgetdata
+ use modd_field, only: TYPEINT, TYPEREAL
+ use modd_parameters, only: NMNHNAMELGTMAX, NSTDNAMELGTMAX
+
+ use mode_tools, only: Quicksort
+
+ type(tbudgetdata), dimension(:), intent(inout) :: tpbudgets
+ integer, intent(in) :: kbudim1
+ integer, intent(in) :: kbudim2
+ integer, intent(in) :: kbudim3
+
+ character(len=NMNHNAMELGTMAX) :: ymnhname
+ character(len=NSTDNAMELGTMAX) :: ystdname
+ character(len=32) :: ylongname
+ character(len=40) :: yunits
+ character(len=100) :: ycomment
+ integer :: ji, jj, jk
+ integer :: isources ! Number of source terms in a budget
+ integer :: inbgroups ! Number of budget groups
+ integer :: ival
+ integer :: icount
+ integer :: ivalmax, ivalmin
+ integer :: igrid
+ integer :: itype
+ integer :: idims
+ integer, dimension(:), allocatable :: igroups ! Temporary array to store sorted group numbers
+ integer, dimension(:), allocatable :: ipos ! Temporary array to store initial position of group numbers
+ real :: zval
+ real :: zvalmax, zvalmin
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Ini_budget_groups', 'called' )
+
+ BUDGETS: do ji = 1, size( tpbudgets )
+ ENABLED: if ( tpbudgets(ji)%lenabled ) then
+ isources = size( tpbudgets(ji)%tsources )
+ do jj = 1, isources
+ ! Check if ngroup is an allowed value
+ if ( tpbudgets(ji)%tsources(jj)%ngroup < 0 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Ini_budget', 'negative group value is not allowed' )
+ tpbudgets(ji)%tsources(jj)%ngroup = 0
+ end if
+
+ if ( tpbudgets(ji)%tsources(jj)%ngroup > 0 ) tpbudgets(ji)%tsources(jj)%lenabled = .true.
+ end do
+
+ !Count the number of groups of source terms
+ !ngroup=1 is for individual entries, >1 values are groups
+ allocate( igroups(isources ) )
+ allocate( ipos (isources ) )
+ igroups(:) = tpbudgets(ji)%tsources(:)%ngroup
+ ipos(:) = [ ( jj, jj = 1, isources ) ]
+
+ !Sort the group list number
+ call Quicksort( igroups, 1, isources, ipos )
+
+ !Count the number of different groups
+ !and renumber the entries (from 1 to inbgroups)
+ inbgroups = 0
+ ival = igroups(1)
+ if ( igroups(1) /= 0 ) then
+ inbgroups = 1
+ igroups(1) = inbgroups
+ end if
+ do jj = 2, isources
+ if ( igroups(jj) == 1 ) then
+ inbgroups = inbgroups + 1
+ igroups(jj) = inbgroups
+ else if ( igroups(jj) > 0 ) then
+ if ( igroups(jj) /= ival ) then
+ ival = igroups(jj)
+ inbgroups = inbgroups + 1
+ end if
+ igroups(jj) = inbgroups
+ end if
+ end do
+
+ !Write the igroups values to the budget structure
+ do jj = 1, isources
+ tpbudgets(ji)%tsources(ipos(jj))%ngroup = igroups(jj)
+ end do
+
+ !Allocate the group structure + populate it
+ tpbudgets(ji)%ngroups = inbgroups
+ allocate( tpbudgets(ji)%tgroups(inbgroups) )
+
+ do jj = 1, inbgroups
+ !Search the list of sources for each group
+ !not the most efficient algorithm but do the job
+ icount = 0
+ do jk = 1, isources
+ if ( tpbudgets(ji)%tsources(jk)%ngroup == jj ) then
+ icount = icount + 1
+ ipos(icount) = jk !ipos is reused as a temporary work array
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%nsources = icount
+
+ allocate( tpbudgets(ji)%tgroups(jj)%nsourcelist(icount) )
+ tpbudgets(ji)%tgroups(jj)%nsourcelist(:) = ipos(1 : icount)
+
+ ! Set the name of the field
+ ymnhname = tpbudgets(ji)%tsources(ipos(1))%cmnhname
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ymnhname = trim( ymnhname ) // '_' // trim( tpbudgets(ji)%tsources(ipos(jk))%cmnhname )
+ end do
+ tpbudgets(ji)%tgroups(jj)%cmnhname = ymnhname
+
+ ! Set the standard name (CF convention)
+ if ( tpbudgets(ji)%tgroups(jj)%nsources == 1 ) then
+ ystdname = tpbudgets(ji)%tsources(ipos(1))%cstdname
+ else
+ ! The CF standard name is probably wrong if combining several source terms => set to ''
+ ystdname = ''
+ end if
+ tpbudgets(ji)%tgroups(jj)%cstdname = ystdname
+
+ ! Set the long name (CF convention)
+ ylongname = tpbudgets(ji)%tsources(ipos(1))%clongname
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ylongname = trim( ylongname ) // ' + ' // tpbudgets(ji)%tsources(ipos(jk))%clongname
+ end do
+ tpbudgets(ji)%tgroups(jj)%clongname = ylongname
+
+ ! Set the units
+ yunits = tpbudgets(ji)%tsources(ipos(1))%cunits
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( trim( yunits ) /= trim( tpbudgets(ji)%tsources(ipos(jk))%cunits ) ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'incompatible units for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ yunits = 'unknown'
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%cunits = yunits
+
+ ! Set the comment
+ ! It is composed of the source comment followed by the clongnames of the different sources
+ ycomment = trim( tpbudgets(ji)%tsources(ipos(1))%ccomment ) // ': '// trim( tpbudgets(ji)%tsources(ipos(1))%clongname )
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ycomment = trim( ycomment ) // ', ' // trim( tpbudgets(ji)%tsources(ipos(jk))%clongname )
+ end do
+ ycomment = trim( ycomment ) // ' source term'
+ if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) ycomment = trim( ycomment ) // 's'
+ tpbudgets(ji)%tgroups(jj)%ccomment = ycomment
+
+ ! Set the Arakawa grid
+ igrid = tpbudgets(ji)%tsources(ipos(1))%ngrid
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( igrid /= tpbudgets(ji)%tsources(ipos(jk))%ngrid ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different Arakawa grid positions for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ngrid = igrid
+
+ ! Set the data type
+ itype = tpbudgets(ji)%tsources(ipos(1))%ntype
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( itype /= tpbudgets(ji)%tsources(ipos(jk))%ntype ) then
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'incompatible data types for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ntype = itype
+
+ ! Set the number of dimensions
+ idims = tpbudgets(ji)%tsources(ipos(1))%ndims
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( idims /= tpbudgets(ji)%tsources(ipos(jk))%ndims ) then
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'incompatible number of dimensions for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%ndims = idims
+
+ ! Set the fill values
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then
+ ival = tpbudgets(ji)%tsources(ipos(1))%nfillvalue
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( ival /= tpbudgets(ji)%tsources(ipos(jk))%nfillvalue ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different (integer) fill values for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%nfillvalue = ival
+ end if
+
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then
+ zval = tpbudgets(ji)%tsources(ipos(1))%xfillvalue
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( zval /= tpbudgets(ji)%tsources(ipos(jk))%xfillvalue ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Ini_budget', &
+ 'different (real) fill values for the different source terms of the group ' &
+ //trim( tpbudgets(ji)%tgroups(jj)%cmnhname ) )
+ end if
+ end do
+ tpbudgets(ji)%tgroups(jj)%xfillvalue = zval
+ end if
+
+ ! Set the valid min/max values
+ ! Take the min or max of all the sources
+ ! Maybe, it would be better to take the sum? (if same sign, if not already the maximum allowed value for this type)
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEINT ) then
+ ivalmin = tpbudgets(ji)%tsources(ipos(1))%nvalidmin
+ ivalmax = tpbudgets(ji)%tsources(ipos(1))%nvalidmax
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ ivalmin = min( ivalmin, tpbudgets(ji)%tsources(ipos(jk))%nvalidmin )
+ ivalmax = max( ivalmax, tpbudgets(ji)%tsources(ipos(jk))%nvalidmax )
+ end do
+ tpbudgets(ji)%tgroups(jj)%nvalidmin = ivalmin
+ tpbudgets(ji)%tgroups(jj)%nvalidmax = ivalmax
+ end if
+
+ if ( tpbudgets(ji)%tgroups(jj)%ntype == TYPEREAL ) then
+ zvalmin = tpbudgets(ji)%tsources(ipos(1))%xvalidmin
+ zvalmax = tpbudgets(ji)%tsources(ipos(1))%xvalidmax
+ do jk = 2, tpbudgets(ji)%tgroups(jj)%nsources
+ zvalmin = min( zvalmin, tpbudgets(ji)%tsources(ipos(jk))%xvalidmin )
+ zvalmax = max( zvalmax, tpbudgets(ji)%tsources(ipos(jk))%xvalidmax )
+ end do
+ tpbudgets(ji)%tgroups(jj)%xvalidmin = zvalmin
+ tpbudgets(ji)%tgroups(jj)%xvalidmax = zvalmax
+ end if
+
+ allocate( tpbudgets(ji)%tgroups(jj)%xdata(kbudim1, kbudim2, kbudim3 ) )
+ tpbudgets(ji)%tgroups(jj)%xdata(:, :, :) = 0.
+ end do
+
+ deallocate( igroups )
+ deallocate( ipos )
+
+ !Check that a group does not contain more than 1 source term with ldonotinit=.true.
+ do jj = 1, inbgroups
+ if ( tpbudgets(ji)%tgroups(jj)%nsources > 1 ) then
+ do jk = 1, tpbudgets(ji)%tgroups(jj)%nsources
+ if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%ldonotinit ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'a group with more than 1 source term may not contain sources with ldonotinit=true' )
+ if ( tpbudgets(ji)%tsources(tpbudgets(ji)%tgroups(jj)%nsourcelist(jk) )%loverwrite ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Ini_budget', &
+ 'a group with more than 1 source term may not contain sources with loverwrite=true' )
+ end do
+ end if
+ end do
+
+ end if ENABLED
+ end do BUDGETS
+
+end subroutine Ini_budget_groups
+
+
+subroutine Sourcelist_sort_compact( tpbudget )
+ !Sort the list of sources to put the non-available source terms at the end of the list
+ !and compact the list
+ use modd_budget, only: tbudgetdata, tbusourcedata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+
+ integer :: ji
+ integer :: isrc_avail, isrc_notavail
+ type(tbusourcedata), dimension(:), allocatable :: tzsources_avail
+ type(tbusourcedata), dimension(:), allocatable :: tzsources_notavail
+
+ isrc_avail = 0
+ isrc_notavail = 0
+
+ Allocate( tzsources_avail (tpbudget%nsources) )
+ Allocate( tzsources_notavail(tpbudget%nsources) )
+
+ !Separate source terms available or not during the execution
+ !(based on the criteria provided to Budget_source_add and stored in lavailable field)
+ do ji = 1, tpbudget%nsources
+ if ( tpbudget%tsources(ji)%lavailable ) then
+ isrc_avail = isrc_avail + 1
+ tzsources_avail(isrc_avail) = tpbudget%tsources(ji)
+ else
+ isrc_notavail = isrc_notavail + 1
+ tzsources_notavail(isrc_notavail) = tpbudget%tsources(ji)
+ end if
+ end do
+
+ !Reallocate/compact the source list
+ if ( Allocated( tpbudget%tsources ) ) Deallocate( tpbudget%tsources )
+ Allocate( tpbudget%tsources( tpbudget%nsources ) )
+
+ tpbudget%nsourcesmax = tpbudget%nsources
+ !Limit the number of sources to the available list
+ tpbudget%nsources = isrc_avail
+
+ !Fill the source list beginning with the available sources and finishing with the non-available ones
+ do ji = 1, isrc_avail
+ tpbudget%tsources(ji) = tzsources_avail(ji)
+ end do
+
+ do ji = 1, isrc_notavail
+ tpbudget%tsources(isrc_avail + ji) = tzsources_notavail(ji)
+ end do
+
+end subroutine Sourcelist_sort_compact
+
+
+subroutine Sourcelist_scan( tpbudget, hbulist )
+ use modd_budget, only: tbudgetdata
+
+ type(tbudgetdata), intent(inout) :: tpbudget
+ character(len=*), dimension(:), intent(in) :: hbulist
+
+ character(len=:), allocatable :: yline
+ character(len=:), allocatable :: ysrc
+ character(len=:), dimension(:), allocatable :: ymsg
+ integer :: idx
+ integer :: igroup
+ integer :: igroup_idx
+ integer :: ipos
+ integer :: istart
+ integer :: ji
+
+ istart = 1
+
+ ! Case 'LIST_AVAIL': list all the available source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'LIST_AVAIL' ) then
+ Allocate( character(len=65) :: ymsg(tpbudget%nsources + 1) )
+ ymsg(1) = '---------------------------------------------------------------------'
+ ymsg(2) = 'Available source terms for budget ' // Trim( tpbudget%cname )
+ Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name'
+ idx = 3
+ do ji = 1, tpbudget%nsources
+ if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then
+ idx = idx + 1
+ Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname
+ end if
+ end do
+ ymsg(tpbudget%nsources + 1 ) = '---------------------------------------------------------------------'
+ call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg )
+ !To not read the 1st line again
+ istart = 2
+ end if
+ end if
+
+ ! Case 'LIST_ALL': list all the source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'LIST_ALL' ) then
+ Allocate( character(len=65) :: ymsg(tpbudget%nsourcesmax + 1) )
+ ymsg(1) = '---------------------------------------------------------------------'
+ ymsg(2) = 'Source terms for budget ' // Trim( tpbudget%cname )
+ Write( ymsg(3), '( A32, " ", A32 )' ) 'Name', 'Long name'
+ idx = 3
+ do ji = 1, tpbudget%nsourcesmax
+ if ( All( tpbudget%tsources(ji)%cmnhname /= [ 'INIF' , 'ENDF', 'AVEF' ] ) ) then
+ idx = idx + 1
+ Write( ymsg(idx), '( A32, " ", A32 )' ) tpbudget%tsources(ji)%cmnhname, tpbudget%tsources(ji)%clongname
+ end if
+ end do
+ ymsg(tpbudget%nsourcesmax + 1 ) = '---------------------------------------------------------------------'
+ call Print_msg_multi( NVERB_WARNING, 'BUD', 'Sourcelist_scan', ymsg )
+ !To not read the 1st line again
+ istart = 2
+ end if
+ end if
+
+ ! Case 'ALL': enable all available source terms
+ if ( Size( hbulist ) > 0 ) then
+ if ( Trim( hbulist(1) ) == 'ALL' ) then
+ do ji = 1, tpbudget%nsources
+ tpbudget%tsources(ji)%ngroup = 1
+ end do
+ return
+ end if
+ end if
+
+ !Always enable INIF, ENDF and AVEF terms
+ ipos = Source_find( tpbudget, 'INIF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': INIF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ ipos = Source_find( tpbudget, 'ENDF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ENDF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ ipos = Source_find( tpbudget, 'AVEF' )
+ if ( ipos < 1 ) call Print_msg( NVERB_FATAL, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': AVEF not found' )
+ tpbudget%tsources(ipos)%ngroup = 1
+
+ !igroup_idx start at 2 because 1 is reserved for individually stored source terms
+ igroup_idx = 2
+
+ do ji = istart, Size( hbulist )
+ if ( Len_trim( hbulist(ji) ) > 0 ) then
+ ! Scan the line and separate the different sources (separated by + signs)
+ yline = Trim(hbulist(ji))
+
+ idx = Index( yline, '+' )
+ if ( idx < 1 ) then
+ igroup = 1
+ else
+ igroup = igroup_idx
+ igroup_idx = igroup_idx + 1
+ end if
+
+ do
+ idx = Index( yline, '+' )
+ if ( idx < 1 ) then
+ ysrc = yline
+ else
+ ysrc = yline(1 : idx - 1)
+ yline = yline(idx + 1 :)
+ end if
+
+ !Check if the source is known
+ if ( Len_trim( ysrc ) > 0 ) then
+ ipos = Source_find( tpbudget, ysrc )
+
+ if ( ipos > 0 ) then
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' found' )
+
+ if ( .not. tpbudget%tsources(ipos)%lavailable ) then
+ call Print_msg( NVERB_WARNING, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' not available' )
+ tpbudget%tsources(ipos)%ngroup = 0
+ else
+ tpbudget%tsources(ipos)%ngroup = igroup
+ end if
+ else
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_scan', 'source term ' // Trim( tpbudget%cname ) &
+ // ': ' // ysrc // ' not found' )
+ end if
+ end if
+
+ if ( idx < 1 ) exit
+ end do
+ end if
+ end do
+end subroutine Sourcelist_scan
+
+
+subroutine Sourcelist_nml_compact( tpbudget, hbulist )
+ !This subroutine reduce the size of the hbulist to the minimum
+ !The list is generated from the group list
+ use modd_budget, only: NBULISTMAXLEN, tbudgetdata
+
+ type(tbudgetdata), intent(in) :: tpbudget
+ character(len=NBULISTMAXLEN), dimension(:), allocatable, intent(inout) :: hbulist
+
+ integer :: idx
+ integer :: isource
+ integer :: jg
+ integer :: js
+
+ if ( Allocated( hbulist ) ) Deallocate( hbulist )
+
+ if ( tpbudget%ngroups < 3 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'ngroups is too small' )
+ return
+ end if
+
+ Allocate( character(len=NBULISTMAXLEN) :: hbulist(tpbudget%ngroups - 3) )
+ hbulist(:) = ''
+
+ idx = 0
+ do jg = 1, tpbudget%ngroups
+ if ( tpbudget%tgroups(jg)%nsources < 1 ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Sourcelist_nml_compact', 'no source for group' )
+ cycle
+ end if
+
+ !Do not put 'INIF', 'ENDF', 'AVEF' in hbulist because their presence is automatic if the corresponding budget is enabled
+ isource = tpbudget%tgroups(jg)%nsourcelist(1)
+ if ( Any( tpbudget%tsources(isource)%cmnhname == [ 'INIF', 'ENDF', 'AVEF' ] ) ) cycle
+
+ idx = idx + 1
+#if 0
+ !Do not do this way because the group cmnhname may be truncated (NMNHNAMELGTMAX is smaller than NBULISTMAXLEN)
+ !and the name separator is different ('_')
+ hbulist(idx) = Trim( tpbudget%tgroups(jg)%cmnhname )
+#else
+ do js = 1, tpbudget%tgroups(jg)%nsources
+ isource = tpbudget%tgroups(jg)%nsourcelist(js)
+ hbulist(idx) = Trim( hbulist(idx) ) // Trim( tpbudget%tsources(isource)%cmnhname )
+ if ( js < tpbudget%tgroups(jg)%nsources ) hbulist(idx) = Trim( hbulist(idx) ) // '+'
+ end do
+#endif
+ end do
+end subroutine Sourcelist_nml_compact
+
+
+subroutine Sourcelist_sv_nml_compact( hbulist )
+ !This subroutine reduce the size of the hbulist
+ !For SV variables the reduction is simpler than for other variables
+ !because it is too complex to do this cleanly (the enabled source terms are different for each scalar variable)
+ use modd_budget, only: NBULISTMAXLEN, tbudgetdata
+
+ character(len=*), dimension(:), allocatable, intent(inout) :: hbulist
+
+ character(len=NBULISTMAXLEN), dimension(:), allocatable :: ybulist_new
+ integer :: ilines
+ integer :: ji
+
+ ilines = 0
+ do ji = 1, Size( hbulist )
+ if ( Len_trim(hbulist(ji)) > 0 ) ilines = ilines + 1
+ end do
+
+ Allocate( ybulist_new(ilines) )
+
+ ilines = 0
+ do ji = 1, Size( hbulist )
+ if ( Len_trim(hbulist(ji)) > 0 ) then
+ ilines = ilines + 1
+ ybulist_new(ilines) = Trim( hbulist(ji) )
+ end if
+ end do
+
+ call Move_alloc( from = ybulist_new, to = hbulist )
+end subroutine Sourcelist_sv_nml_compact
+
+
+pure function Source_find( tpbudget, hsource ) result( ipos )
+ use modd_budget, only: tbudgetdata
+
+ type(tbudgetdata), intent(in) :: tpbudget
+ character(len=*), intent(in) :: hsource
+ integer :: ipos
+
+ integer :: ji
+ logical :: gfound
+
+ ipos = -1
+ gfound = .false.
+ do ji = 1, tpbudget%nsourcesmax
+ if ( Trim( hsource ) == Trim ( tpbudget%tsources(ji)%cmnhname ) ) then
+ gfound = .true.
+ ipos = ji
+ exit
+ end if
+ end do
+
+end function Source_find
+
+end module mode_ini_budget
diff --git a/src/MNH/ini_cst.f90 b/src/MNH/ini_cst.f90
index 91526bed4b1eb67a892802e447ef6ca75e0b6428..7c3170c4cb7e9e48a0fb645cc70efa30d6a6cae8 100644
--- a/src/MNH/ini_cst.f90
+++ b/src/MNH/ini_cst.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###################
@@ -112,6 +112,13 @@ XG = 9.80665
!* 4. REFERENCE PRESSURE
! -------------------
!
+! Ocean model cst same as in 1D/CMO SURFEX
+! values used in ini_cst to overwrite XP00 and XTH00
+XRH00OCEAN =1024.
+XTH00OCEAN = 286.65
+XSA00OCEAN= 32.6
+XP00OCEAN = 201.E5
+!Atmospheric model
XP00 = 1.E5
XTH00 = 300.
!-------------------------------------------------------------------------------
@@ -132,6 +139,7 @@ XMD = 28.9644E-3
XMV = 18.0153E-3
XRD = XAVOGADRO * XBOLTZ / XMD
XRV = XAVOGADRO * XBOLTZ / XMV
+XEPSILO= XMV/XMD
XCPD = 7.* XRD /2.
XCPV = 4.* XRV
XRHOLW = 1000.
@@ -150,7 +158,11 @@ XALPW = LOG(XESTT) + (XBETAW /XTT) + (XGAMW *LOG(XTT))
XGAMI = (XCI - XCPV) / XRV
XBETAI = (XLSTT/XRV) + (XGAMI * XTT)
XALPI = LOG(XESTT) + (XBETAI /XTT) + (XGAMI *LOG(XTT))
-
+! Values identical to ones used in CMO1D in SURFEX /could be modified
+! Coefficient of thermal expansion of water (K-1)
+XALPHAOC = 1.9E-4
+! Coeff of Haline contraction coeff (S-1)
+XBETAOC= 7.7475E-4
!
! Some machine precision value depending of real4/8 use
!
diff --git a/src/MNH/ini_deep_convection.f90 b/src/MNH/ini_deep_convection.f90
index 6934822e30ae38736c76608ebbe4d9008be92eff..f4747410b9019c4081bb7335cd217cd6b0fb68ea 100644
--- a/src/MNH/ini_deep_convection.f90
+++ b/src/MNH/ini_deep_convection.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -120,6 +120,7 @@ USE MODD_CH_M9_n, ONLY: CNAMES
USE MODD_CONVPAR
USE MODD_DUST, ONLY: CDUSTNAMES
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+use modd_field, only: tfielddata, tfieldlist, TYPEREAL
USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LG, ONLY: CLGNAMES
@@ -132,7 +133,7 @@ USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
USE MODD_SALT, ONLY: CSALTNAMES
USE MODD_TIME
!
-USE MODE_FIELD
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_TOOLS, ONLY: UPCASE
!
diff --git a/src/MNH/ini_elec.f90 b/src/MNH/ini_elec.f90
deleted file mode 100644
index 0154ac6da9168df81b0669edbadf80d11ab61476..0000000000000000000000000000000000000000
--- a/src/MNH/ini_elec.f90
+++ /dev/null
@@ -1,102 +0,0 @@
-!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #########################################################
- SUBROUTINE INI_ELEC(KMI,TPINIFILE,PTSTEP,PDZMIN,KSPLITR, &
- PDXX,PDYY,PDZZ,PDZX,PDZY )
-! #########################################################
-!
-!!**** *INI_ELEC* - routine to initialize the electrical parameters
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to initialize the variables
-! of the atmospheric electricity scheme
-!
-!!** METHOD
-!! ------
-!! The initialization of the scheme is performed as follows :
-!!
-!! EXTERNAL
-!! --------
-!! CLEANLIST_ll : deaalocate a list
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation (routine INI_ELEC)
-!!
-!! AUTHOR
-!! ------
-!! J.-P. Pinty * Laboratoire d'Aerologie *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 29/11/02
-! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_CONF
-USE MODD_CST
-USE MODD_DYN
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n
-USE MODD_NSV, ONLY: NSV, NSV_ELEC, NSV_ELECBEG, NSV_ELECEND
-USE MODD_PARAMETERS
-USE MODD_REF
-USE MODD_TIME
-!
-USE MODE_ll
-use mode_msg
-!
-USE MODI_INI_CLOUD
-!
-USE MODN_CONF_n
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER, INTENT(IN) :: KMI ! Model Index
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE! Initial file
-REAL, INTENT(IN) :: PTSTEP ! Time STEP
-!
-REAL, INTENT(IN) :: PDZMIN ! minimun vertical mesh size
-INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
- ! integration for rain
- ! sedimendation
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IRESP ! Return code of FM routines
-INTEGER :: ILUOUT ! Logical unit number of output-listing
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. PROLOGUE
-! --------
-!
-!
-call Print_msg(NVERB_FATAL,'GEN','INI_ELEC','not yet developed')
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE INI_ELEC
diff --git a/src/MNH/ini_eol_adnr.f90 b/src/MNH/ini_eol_adnr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9e069eed9e0fb5d1578c5831423efbeb0c2828f8
--- /dev/null
+++ b/src/MNH/ini_eol_adnr.f90
@@ -0,0 +1,135 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_INI_EOL_ADNR
+! ##########################
+!
+INTERFACE
+!
+SUBROUTINE INI_EOL_ADNR
+!
+END SUBROUTINE INI_EOL_ADNR
+!
+END INTERFACE
+!
+END MODULE MODI_INI_EOL_ADNR
+!
+! ############################################################
+ SUBROUTINE INI_EOL_ADNR
+! ############################################################
+!
+!!**** *INI_EOL_ADNR*
+!!
+!! PURPOSE
+!! -------
+!! Routine to initialized the ADNR (wind turbine model) variables
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! **MODD_EOL_SHARED_IO:
+!! for namelist NAM_EOL_ADNR (INPUT) :
+!! CHARACTER(LEN=100) :: CFARM_CSVDATA ! File to read, with farm data
+!! CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! File to read, turbine data
+!! for ouputs :
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTORQT ! Torque [Nm]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XPOWT ! Power [W]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTHRU_SUM ! Sum of thrust (N)
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTORQ_SUM ! Sum of torque (Nm)
+!! REAL, DIMENSION(:), ALLOCATABLE :: XPOW_SUM ! Sum of power (W)
+!!
+!! **MODD_EOL_ADNR (OUTPUT):
+!! TYPE(FARM) :: TFARM
+!! TYPE(TURBINE) :: TTURBINE
+!! REAL, DIMENSION(:), ALLOCATABLE :: XA_INDU ! Induction factor(NumEol,données)
+!! REAL, DIMENSION(:), ALLOCATABLE :: XCT_D ! Adapted thrust coef (for U_d) [-]
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin * Meteo France & IFPEN *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 31/05/18
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!--------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_EOL_ADNR
+USE MODD_EOL_SHARED_IO, ONLY: CFARM_CSVDATA, CTURBINE_CSVDATA
+USE MODD_EOL_SHARED_IO, ONLY: XTHRUT, XTHRU_SUM
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_FARM_ADNR
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_TURBINE_ADNR
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_FARM_ADNR
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_TURBINE_ADNR
+! To print in output listing
+USE MODD_LUNIT_n, ONLY: TLUOUT
+!
+IMPLICIT NONE
+!
+! Integers
+INTEGER :: ILUOUT ! Output listing file
+!
+!
+!-------------------------------------------------------------------
+!
+!* 1. READING AND ALLOCATING DATA
+! ---------------------------
+! Reading in csv files
+! Allocation of TFARM and TTURBINE inside the function
+!
+!* 1.1 Wind farm data
+!
+CALL READ_CSVDATA_FARM_ADNR(TRIM(CFARM_CSVDATA),TFARM)
+!
+!* 1.2 Wind turbine data
+!
+CALL READ_CSVDATA_TURBINE_ADNR(TRIM(CTURBINE_CSVDATA),TTURBINE)
+!
+!
+!-------------------------------------------------------------------
+!
+!* 2. PRINTING DATA
+! -------------
+!
+!* 2.0 Output listing index
+ILUOUT= TLUOUT%NLU
+!
+!* 2.1 Wind farm data
+!
+CALL PRINT_DATA_FARM_ADNR(ILUOUT,TFARM)
+!
+!* 2.2 Wind turbine data
+!
+CALL PRINT_DATA_TURBINE_ADNR(ILUOUT,TTURBINE)
+!
+!
+!-------------------------------------------------------------------
+!
+!* 3. ALLOCATING VARIABLES
+! --------------------
+!
+ALLOCATE(XA_INDU (TFARM%NNB_TURBINES))
+ALLOCATE(XCT_D (TFARM%NNB_TURBINES))
+ALLOCATE(XTHRUT (TFARM%NNB_TURBINES))
+ALLOCATE(XTHRU_SUM(TFARM%NNB_TURBINES))
+!
+END SUBROUTINE INI_EOL_ADNR
diff --git a/src/MNH/ini_eol_alm.f90 b/src/MNH/ini_eol_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..41938d789ae7c876168bdf7c62004aa320eb2615
--- /dev/null
+++ b/src/MNH/ini_eol_alm.f90
@@ -0,0 +1,439 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_INI_EOL_ALM
+! ##########################
+!
+INTERFACE
+!
+SUBROUTINE INI_EOL_ALM(PDXX,PDYY)
+!
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY ! mesh size
+!
+END SUBROUTINE INI_EOL_ALM
+!
+END INTERFACE
+!
+END MODULE MODI_INI_EOL_ALM
+!
+! ############################################################
+ SUBROUTINE INI_EOL_ALM(PDXX,PDYY)
+! ############################################################
+!
+!!**** *INI_EOL_ALM* - routine to initialize the Actuator Line Model
+!! to simulate wind turbines
+!!
+!! PURPOSE
+!! -------
+!! Routine to initialized the ALM (wind turbine model) variables
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! *MODD_EOL_SHARED_IO:
+!! *Namelist NAM_EOL_ADNR (INPUT) :
+!! CHARACTER(LEN=100) :: CFARM_CSVDATA ! File to read, with farm data
+!! CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! File to read, turbine data
+!! CHARACTER(LEN=100) :: CBLADE_CSVDATA ! Blade file to read
+!! CHARACTER(LEN=100) :: CAIRFOIL_CSVDATA ! Airfoil file to read
+!! *for ouputs :
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTORQT ! Torque [Nm]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XPOWT ! Power [W]
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTHRU_SUM ! Sum of thrust (N)
+!! REAL, DIMENSION(:), ALLOCATABLE :: XTORQ_SUM ! Sum of torque (Nm)
+!! REAL, DIMENSION(:), ALLOCATABLE :: XPOW_SUM ! Sum of power (W)
+!!
+!! INTEGER :: NNB_BLAELT ! Number of blade elements
+!!
+!! *MODD_EOL_ALM (OUTPUT):
+!! TYPE(FARM) :: TFARM
+!! TYPE(TURBINE) :: TTURBINE
+!! TYPE(BLADE) :: TBLADE
+!! TYPE(AIRFOIL), DIMENSION(:), ALLOCATABLE :: TAIRFOIL
+!! REAL, DIMENSION(:,:,:), ALLOCATABLE :: XELT_RAD ! Blade elements radius [m]
+!! REAL, DIMENSION(:,:,:), ALLOCATABLE :: XAOA_GLB ! Angle of attack of an element [rad]
+!! REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFLIFT_GLB ! Lift force, parallel to Urel [N]
+!! REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFDRAG_GLB ! Drag force, perpendicular to Urel [N]
+!! REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RE_GLB ! Aerodyn. force (lift+drag) in RE [N]
+!! REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RG_GLB ! Aerodyn. force (lift+drag) in RG [N]
+!! REAL, DIMENSION(:,:,:), ALLOCATABLE :: XAOA_SUM ! Sum of angle of attack [rad]
+!! REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RE_SUM ! Sum of aerodyn. force (lift+drag) in RE [N]
+!
+!! *MODD_EOL_KINEMATICS
+!! Positions
+!! Orientations
+!! Velocities
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! PA. Joulin * Meteo France & IFPEN *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 31/05/18
+!! Modification 10/11/20 (PA. Joulin) Updated for a main version
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 Modules
+!
+USE MODD_EOL_ALM
+USE MODD_EOL_SHARED_IO, ONLY: CFARM_CSVDATA
+USE MODD_EOL_SHARED_IO, ONLY: CTURBINE_CSVDATA
+USE MODD_EOL_SHARED_IO, ONLY: CBLADE_CSVDATA
+USE MODD_EOL_SHARED_IO, ONLY: CAIRFOIL_CSVDATA
+USE MODD_EOL_SHARED_IO, ONLY: XTHRUT, XTORQT, XPOWT
+USE MODD_EOL_SHARED_IO, ONLY: XTHRU_SUM, XTORQ_SUM, XPOW_SUM
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_FARM_ALM
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_TURBINE_ALM
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_BLADE_ALM
+USE MODI_EOL_READER, ONLY: READ_CSVDATA_AIRFOIL_ALM
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_FARM_ALM
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_TURBINE_ALM
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_BLADE_ALM
+USE MODI_EOL_PRINTER, ONLY: PRINT_DATA_AIRFOIL_ALM
+USE MODD_EOL_KINE_ALM
+USE MODI_EOL_MATHS
+! To print in output listing
+USE MODD_LUNIT_n, ONLY: TLUOUT
+! Constant
+USE MODD_CST, ONLY: XPI
+! To know the grid
+USE MODD_GRID_n, ONLY: XXHAT,XYHAT,XZS
+USE MODE_ll, ONLY: GET_INDICE_ll
+USE MODD_PARAMETERS, ONLY: JPVEXT
+! MPI stuffs
+USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD
+USE MODD_PRECISION, ONLY: MNHREAL_MPI
+USE MODD_MPIF, ONLY: MPI_SUM
+!
+!* 0.2 Variables
+!
+IMPLICIT NONE
+! Interface
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY ! mesh size
+!
+! Some loop controlers
+! .. for wind turbines
+INTEGER :: JROT ! Rotor index
+INTEGER :: JTELT ! Tower element index
+INTEGER :: JNELT ! Nacelle element index
+INTEGER :: JBLA ! Blade index
+INTEGER :: JBELT ! Balde element index
+! .. for domain
+INTEGER :: IIB,IJB,IKB ! Begin of a CPU domain
+INTEGER :: IIE,IJE ! End of a CPU domain
+INTEGER :: JI,JJ ! Domain index
+! Some variables to be coder-friendly
+INTEGER :: INB_WT, INB_B, INB_BELT ! Total numbers of wind turbines, blades, and blade elt
+INTEGER :: INB_TELT, INB_NELT ! Total numbers of tower elt, and nacelle elt
+REAL :: ZRAD ! Radius along the blade
+! Tower base folowing the terrain
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZPOSINI_TOWO_RG ! Initial tower origin position
+INTEGER :: IINFO ! code info return
+!
+!-------------------------------------------------------------------
+!
+!* 1. READING AND ALLOCATING DATA
+! ---------------------------
+! Reading in csv files
+! Allocation of TFARM, TTURBINE, TBLADE and TAIRFOILS inside the function
+!
+!* 1.1 Wind farm data
+!
+CALL READ_CSVDATA_FARM_ALM(TRIM(CFARM_CSVDATA),TFARM)
+!
+!* 1.2 Wind turbine data
+!
+CALL READ_CSVDATA_TURBINE_ALM(TRIM(CTURBINE_CSVDATA),TTURBINE)
+!
+!* 1.3 Blade data
+!
+CALL READ_CSVDATA_BLADE_ALM(TRIM(CBLADE_CSVDATA),TTURBINE,TBLADE)
+!
+!* 1.4 Airfoil data
+!
+CALL READ_CSVDATA_AIRFOIL_ALM(TRIM(CAIRFOIL_CSVDATA),TBLADE,TAIRFOIL)
+!
+!
+!-------------------------------------------------------------------
+!
+!* 2. PRINTING DATA
+! -------------
+!
+!* 2.1 Wind farm data
+!
+CALL PRINT_DATA_FARM_ALM(TLUOUT%NLU,TFARM)
+!
+!* 2.2 Wind turbine data
+!
+CALL PRINT_DATA_TURBINE_ALM(TLUOUT%NLU,TTURBINE)
+!
+!* 2.3 Blade data
+!
+CALL PRINT_DATA_BLADE_ALM(TLUOUT%NLU,TBLADE)
+!
+!* 2.4 Airfoil data
+!
+CALL PRINT_DATA_AIRFOIL_ALM(TLUOUT%NLU,TAIRFOIL)
+!
+!
+!-------------------------------------------------------------------
+!
+!* 3. ALLOCATING VARIABLES
+! --------------------
+!
+!* 3.0 Preliminaries
+INB_WT = TFARM%NNB_TURBINES
+INB_B = TTURBINE%NNB_BLADES
+INB_BELT = TBLADE%NNB_BLAELT
+! Hard coded variables, but they will be usefull in next updates
+INB_TELT = 2
+INB_NELT = 2
+!
+!* 3.1 MODD_EOL_ALM variables
+! at t
+ALLOCATE(XELT_RAD (INB_WT,INB_B,INB_BELT ))
+ALLOCATE(XAOA_GLB (INB_WT,INB_B,INB_BELT ))
+ALLOCATE(XFDRAG_GLB (INB_WT,INB_B,INB_BELT ))
+ALLOCATE(XFLIFT_GLB (INB_WT,INB_B,INB_BELT ))
+ALLOCATE(XFAERO_RE_GLB(INB_WT,INB_B,INB_BELT,3))
+ALLOCATE(XFAERO_RG_GLB(INB_WT,INB_B,INB_BELT,3))
+ALLOCATE(XTHRUT (INB_WT ))
+ALLOCATE(XTORQT (INB_WT ))
+ALLOCATE(XPOWT (INB_WT ))
+! for mean values
+ALLOCATE(XAOA_SUM (INB_WT,INB_B,INB_BELT ))
+ALLOCATE(XFAERO_RE_SUM(INB_WT,INB_B,INB_BELT,3))
+ALLOCATE(XTHRU_SUM (INB_WT))
+ALLOCATE(XTORQ_SUM (INB_WT))
+ALLOCATE(XPOW_SUM (INB_WT))
+!
+!* 3.2 MODD_EOL_KINE_ALM variables
+!
+! - ORIENTATION MATRIX -
+ALLOCATE(XMAT_RG_RT(INB_WT,3,3))
+ALLOCATE(XMAT_RG_RN(INB_WT,3,3))
+ALLOCATE(XMAT_RT_RN(INB_WT,3,3))
+ALLOCATE(XMAT_RG_RH(INB_WT,3,3))
+ALLOCATE(XMAT_RH_RG(INB_WT,3,3))
+ALLOCATE(XMAT_RN_RH(INB_WT,3,3))
+ALLOCATE(XMAT_RG_RB(INB_WT,INB_B,3,3))
+ALLOCATE(XMAT_RH_RB(INB_WT,INB_B,3,3))
+ALLOCATE(XMAT_RG_RE(INB_WT,INB_B,INB_BELT,3,3))
+ALLOCATE(XMAT_RE_RG(INB_WT,INB_B,INB_BELT,3,3))
+ALLOCATE(XMAT_RB_RE(INB_WT,INB_B,INB_BELT,3,3))
+!
+! - POSITIONS & ORIENTATIONS -
+! Tower
+ALLOCATE(ZPOSINI_TOWO_RG (INB_WT,3) ) ! Initial tower origin pos. in RG
+ALLOCATE(XPOSINI_TOWO_RG (INB_WT,3) ) ! Initial tower origin pos. in RG
+ALLOCATE(XPOS_TOWO_RG (INB_WT,3) ) ! Current tower origin pos. in RG
+ALLOCATE(XPOS_TELT_RG (INB_WT,INB_TELT,3) ) ! Current tower element pos. in RG
+ALLOCATE(XPOS_TELT_RT (INB_WT,INB_TELT,3) ) ! Current tower element pos. in RT
+ALLOCATE(XANGINI_TOW_RG (INB_WT,3) ) ! Initial tower ori. in RG
+! Nacelle
+ALLOCATE(XPOSINI_NACO_RT (INB_WT,3) ) ! Initial nacelle origin pos. in RT
+ALLOCATE(XPOS_NACO_RG (INB_WT,3) ) ! Current nacelle origin pos. in RG
+ALLOCATE(XPOS_NELT_RG (INB_WT,INB_NELT,3) ) ! Current nacelle element pos. in RG
+ALLOCATE(XPOS_NELT_RN (INB_WT,INB_NELT,3) ) ! Current nacelle element pos. in RN
+ALLOCATE(XANGINI_NAC_RT (INB_WT,3) ) ! Initial nacelle ori. in RT
+! Hub
+ALLOCATE(XPOSINI_HUB_RN (INB_WT,3) ) ! Initial hub pos. in RN
+ALLOCATE(XPOS_HUB_RG (INB_WT,3) ) ! Current hub pos. in RG
+ALLOCATE(XANGINI_HUB_RN (INB_WT,3) ) ! Initial hub ori. in RN
+! Blade
+ALLOCATE(XPOSINI_BLA_RH (INB_WT,INB_B,3) ) ! Initial blade root pos. in RH
+ALLOCATE(XPOS_BLA_RG (INB_WT,INB_B,3) ) ! Current blade root pos. in RG
+ALLOCATE(XANGINI_BLA_RH (INB_WT,INB_B,3) ) ! Initial blade ori. RH
+! Element
+ALLOCATE(XPOS_ELT_RB (INB_WT,INB_B,INB_BELT,3) ) ! Element pos. in RB
+ALLOCATE(XPOS_ELT_RG (INB_WT,INB_B,INB_BELT,3) ) ! Element pos. in RG
+ALLOCATE(XPOS_SEC_RB (INB_WT,INB_B,INB_BELT+1,3)) ! Section pos. in RB
+ALLOCATE(XPOS_SEC_RG (INB_WT,INB_B,INB_BELT+1,3)) ! Section pos. in RG
+ALLOCATE(XANGINI_ELT_RB (INB_WT,INB_B,INB_BELT,3) ) ! Initial element ori. in RB
+ALLOCATE(XTWIST_ELT (INB_WT,INB_B,INB_BELT) ) ! Element twist in RB
+ALLOCATE(XCHORD_ELT (INB_WT,INB_B,INB_BELT) ) ! Element chord lenght
+ALLOCATE(XSURF_ELT (INB_WT,INB_B,INB_BELT) ) ! Element lift surface
+!
+! - STRUCTURAL VELOCITIES -
+! Tower
+ALLOCATE(XTVEL_TOWO_RG (INB_WT,3) ) ! Tower base trans. vel. in RG
+ALLOCATE(XTVEL_TELT_RG (INB_WT,INB_TELT,3) ) ! Tower element trans. vel. in RG
+ALLOCATE(XRVEL_RT_RG (INB_WT,3) ) ! RT/RG rot. vel.
+! Nacelle
+ALLOCATE(XTVEL_NACO_RT (INB_WT,3) ) ! Nacelle base trans. vel. in RT
+ALLOCATE(XTVEL_NELT_RG (INB_WT,INB_NELT,3) ) ! Nacelle element trans. vel. in RG
+ALLOCATE(XRVEL_RN_RT (INB_WT,3) ) ! RN/RT rot. vel.
+ALLOCATE(XRVEL_RN_RG (INB_WT,3) ) ! RN/RG rot. vel.
+! Hub
+ALLOCATE(XTVEL_HUB_RN (INB_WT,3) ) ! Hub base trans. vel. in RN
+ALLOCATE(XTVEL_HUB_RG (INB_WT,3) ) ! Hub base trans. vel. in RG
+ALLOCATE(XRVEL_RH_RN (INB_WT,3) ) ! RH/RT rot. vel.
+ALLOCATE(XRVEL_RH_RG (INB_WT,3) ) ! RH/RG rot. vel.
+! Blade
+ALLOCATE(XTVEL_BLA_RH (INB_WT,INB_B,3) ) ! Blade base trans. vel. in RH
+ALLOCATE(XTVEL_BLA_RG (INB_WT,INB_B,3) ) ! Blade base trans. vel. in RG
+ALLOCATE(XRVEL_RB_RH (INB_WT,INB_B,3) ) ! RB/RH rot. vel.
+ALLOCATE(XRVEL_RB_RG (INB_WT,INB_B,3) ) ! RB/RG rot. vel.
+! Elements
+ALLOCATE(XTVEL_ELT_RB (INB_WT,INB_B,INB_BELT,3) ) ! Element base trans. vel. in RB
+ALLOCATE(XTVEL_ELT_RG (INB_WT,INB_B,INB_BELT,3) ) ! Element base trans. vel. in RG
+ALLOCATE(XTVEL_ELT_RE (INB_WT,INB_B,INB_BELT,3) ) ! Element base trans. vel. in RE
+ALLOCATE(XRVEL_RE_RB (INB_WT,INB_B,INB_BELT,3) ) ! RE/RB rot. vel.
+ALLOCATE(XRVEL_RE_RG (INB_WT,INB_B,INB_BELT,3) ) ! RE/RG rot. vel.
+!
+!-------------------------------------------------------------------
+!
+!* 4. FIRST BUILDING OF WIND TURBINES
+! -------------------------------
+!
+!* 4.1 Preliminaries
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE) ! Get begin and end domain index (CPU)
+IKB=1+JPVEXT ! Vertical begin index
+!
+XPOS_REF(:) = 0d0 ! Global Origin
+!
+!
+!* 4.2 Tower
+DO JROT=1, INB_WT
+! Velocities (Rotor, (XYZ))
+ XTVEL_TOWO_RG(JROT,:) = 0d0
+ XRVEL_RT_RG(JROT,:) = 0d0
+! Positions
+ ! Init
+ ZPOSINI_TOWO_RG(JROT,1) = 0
+ ZPOSINI_TOWO_RG(JROT,2) = 0
+ ZPOSINI_TOWO_RG(JROT,3) = 0
+ ! Finding the elevation at the WT position
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF (TFARM%XPOS_X(JROT) >= XXHAT(JI) .AND. &
+ TFARM%XPOS_X(JROT) < XXHAT(JI) + PDXX(JI,JJ,IKB)) THEN
+ IF (TFARM%XPOS_Y(JROT) >= XYHAT(JJ) .AND. &
+ TFARM%XPOS_Y(JROT) < XYHAT(JJ) + PDYY(JI,JJ,IKB)) THEN
+ ! Horizontal position
+ ZPOSINI_TOWO_RG(JROT,1) = TFARM%XPOS_X(JROT) ! Tower base position
+ ZPOSINI_TOWO_RG(JROT,2) = TFARM%XPOS_Y(JROT)
+ ! Finding the elevation at the WT position
+ ZPOSINI_TOWO_RG(JROT,3) = XZS(JI,JJ)
+ END IF
+ END IF
+ END DO
+ END DO
+ ! Sharing information
+ CALL MPI_ALLREDUCE(ZPOSINI_TOWO_RG, XPOSINI_TOWO_RG, SIZE(XPOSINI_TOWO_RG),&
+ MNHREAL_MPI,MPI_SUM,NMNH_COMM_WORLD,IINFO)
+ ! Tower elements
+ DO JTELT=1, INB_TELT
+ XPOS_TELT_RT(JROT,JTELT,1) = 0d0
+ XPOS_TELT_RT(JROT,JTELT,2) = 0d0
+ XPOS_TELT_RT(JROT,JTELT,3) = (JTELT-1)*(TTURBINE%XH_HEIGHT)/(INB_TELT-1)
+ END DO
+ ! Angles
+ XANGINI_TOW_RG(JROT,1) = 0d0
+ XANGINI_TOW_RG(JROT,2) = 0d0
+ XANGINI_TOW_RG(JROT,3) = 0d0
+!
+!
+!* 4.3 Nacelle
+! Velocities
+ XTVEL_NACO_RT(JROT,:) = 0d0
+ XRVEL_RN_RT(JROT,:) = 0d0
+! Positions (Rotor, (XYZ)) ! From last point of tower
+ ! Origin
+ XPOSINI_NACO_RT(JROT,:) = 0d0 ! Distance between nacelle base and tower top
+ ! Elements
+ DO JNELT=1, INB_NELT
+ XPOS_NELT_RN(JROT,JNELT,1) = (JNELT-1)*TTURBINE%XH_DEPORT/(INB_NELT-1)
+ XPOS_NELT_RN(JROT,JNELT,2) = 0d0
+ XPOS_NELT_RN(JROT,JNELT,3) = 0d0
+ END DO
+ ! Angles
+ XANGINI_NAC_RT(JROT,1) = 0d0
+ XANGINI_NAC_RT(JROT,2) = 0d0
+ XANGINI_NAC_RT(JROT,3) = XPI + TFARM%XNAC_YAW(JROT)
+!
+!
+!* 4.4 Hub
+! Velocities
+ XTVEL_HUB_RN(JROT,:) = 0d0
+ XRVEL_RH_RN(JROT,1) = 0d0
+ XRVEL_RH_RN(JROT,2) = 0d0
+ XRVEL_RH_RN(JROT,3) = TFARM%XOMEGA(JROT)
+! Position (Rotor, (XYZ)) ! From nacelle last point
+ XPOSINI_HUB_RN(JROT,1) = 0d0
+ XPOSINI_HUB_RN(JROT,2) = 0d0
+ XPOSINI_HUB_RN(JROT,3) = 0d0
+ XANGINI_HUB_RN(JROT,1) = 0d0
+ XANGINI_HUB_RN(JROT,2) = XPI/2d0 - TTURBINE%XNAC_TILT
+ XANGINI_HUB_RN(JROT,3) = 0d0
+!
+!
+!* 4.5 Blades
+ DO JBLA=1, INB_B
+! Velocities
+ XRVEL_RB_RH(JROT,JBLA,:) = 0d0
+ XTVEL_BLA_RH(JROT,JBLA,:) = 0d0
+! Position (Rotor, Blade, (XYZ)) ! From hub point
+ XPOSINI_BLA_RH(JROT,JBLA,:) = 0d0
+ XANGINI_BLA_RH(JROT,JBLA,1) = 0d0
+ XANGINI_BLA_RH(JROT,JBLA,2) = 0d0
+ XANGINI_BLA_RH(JROT,JBLA,3) = (JBLA-1)*2d0*XPI/INB_B
+!
+!
+!* 4.5 Elements
+! - Positioning of sections (cuts)
+ DO JBELT=1, INB_BELT+1
+
+ XPOS_SEC_RB(JROT,JBLA,JBELT,1) = TTURBINE%XR_MIN + (JBELT-1) &
+ * (TTURBINE%XR_MAX - TTURBINE%XR_MIN)/INB_BELT
+ XPOS_SEC_RB(JROT,JBLA,JBELT,2) = 0d0
+ XPOS_SEC_RB(JROT,JBLA,JBELT,3) = 0d0
+ ENDDO
+ DO JBELT=1, INB_BELT
+! - Positioning of centers (points of application)
+ XPOS_ELT_RB(JROT,JBLA,JBELT,1) = XPOS_SEC_RB(JROT,JBLA,JBELT,1) &
+ + (XPOS_SEC_RB(JROT,JBLA,JBELT+1,1) &
+ - XPOS_SEC_RB(JROT,JBLA,JBELT,1))/2d0
+ XPOS_ELT_RB(JROT,JBLA,JBELT,2) = 0d0
+ XPOS_ELT_RB(JROT,JBLA,JBELT,3) = 0d0
+ XELT_RAD(JROT,JBLA,JBELT) = XPOS_ELT_RB(JROT,JBLA,JBELT,1)
+! - Calculating chord and twist
+ ZRAD = XELT_RAD(JROT,JBLA,JBELT)
+ XCHORD_ELT(JROT,JBLA,JBELT) = INTERP_SPLCUB(ZRAD, TBLADE%XRAD, TBLADE%XCHORD)
+ XTWIST_ELT(JROT,JBLA,JBELT) = INTERP_SPLCUB(ZRAD, TBLADE%XRAD, TBLADE%XTWIST)
+! - Calculating lifting surface
+ XSURF_ELT(JROT,JBLA,JBELT) = XCHORD_ELT(JROT,JBLA,JBELT) &
+ * (XPOS_SEC_RB(JROT,JBLA,JBELT+1,1) &
+ - XPOS_SEC_RB(JROT,JBLA,JBELT,1))
+! Velocities
+ XRVEL_RE_RB(JROT,JBLA,JBELT,:) = 0d0
+ XTVEL_ELT_RB(JROT,JBLA,JBELT,:) = 0d0
+! Orientation
+ XANGINI_ELT_RB(JROT,JBLA,JBELT,1) = -XPI/2d0 + TFARM%XBLA_PITCH(JROT) &
+ + XTWIST_ELT(JROT,JBLA,JBELT)
+ XANGINI_ELT_RB(JROT,JBLA,JBELT,2) = XPI/2d0
+ XANGINI_ELT_RB(JROT,JBLA,JBELT,3) = XPI/2d0
+ END DO ! Loop element
+ END DO ! Loop blade
+END DO ! Loop turbine
+!
+END SUBROUTINE INI_EOL_ALM
diff --git a/src/MNH/ini_lb.f90 b/src/MNH/ini_lb.f90
index 79fff80584ca80575e8a9298452aac79620a63a0..b4d44b50adff30ff2ee57769d3b6be3bbbceba63 100644
--- a/src/MNH/ini_lb.f90
+++ b/src/MNH/ini_lb.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1998-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1998-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -145,6 +145,7 @@ USE MODD_CTURB
USE MODD_CONF
USE MODD_DUST
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+use modd_field, only: tfielddata, TYPELOG, TYPEREAL
USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LG, ONLY: CLGNAMES
@@ -158,7 +159,6 @@ USE MODD_PARAM_n
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
USE MODD_SALT
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
USE MODE_IO_FIELD_READ, only: IO_Field_read, IO_Field_read_lb
USE MODE_MSG
USE MODE_TOOLS, ONLY: UPCASE
diff --git a/src/MNH/ini_les_cart_maskn.f90 b/src/MNH/ini_les_cart_maskn.f90
index b162a3af54d3fca4d012e8a149ce176b40fb9d5d..a3e9c7840171d597857e56403768981a86b0ff4a 100644
--- a/src/MNH/ini_les_cart_maskn.f90
+++ b/src/MNH/ini_les_cart_maskn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2017 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.
!-----------------------------------------------------------------
!#############################
@@ -20,7 +20,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PXHAT_ll ! son model X coordinate
REAL, DIMENSION(:), INTENT(IN) :: PYHAT_ll ! son model X coordinate
INTEGER, INTENT(OUT) :: KLES_IINF ! limits of the cartesian
INTEGER, INTENT(OUT) :: KLES_JINF ! mask in son model
-INTEGER, INTENT(OUT) :: KLES_ISUP ! domain
+INTEGER, INTENT(OUT) :: KLES_ISUP ! physical domain
INTEGER, INTENT(OUT) :: KLES_JSUP !
!
END SUBROUTINE INI_LES_CART_MASK_n
@@ -58,9 +58,9 @@ END MODULE MODI_INI_LES_CART_MASKn
!! Original 07/02/00
!! Modification 01/02/01 (D.Gazen) add module MODD_NSV for NSV variable
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! P.Wautelet: 19/10/2017 : IO: removed extern_userio.f90
-!!
-!! --------------------------------------------------------------------------
+! P. Wautelet 19/10/2017: IO: removed extern_userio.f90
+! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -86,7 +86,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PXHAT_ll ! son model X coordinate
REAL, DIMENSION(:), INTENT(IN) :: PYHAT_ll ! son model X coordinate
INTEGER, INTENT(OUT) :: KLES_IINF ! limits of the cartesian
INTEGER, INTENT(OUT) :: KLES_JINF ! mask in son model
-INTEGER, INTENT(OUT) :: KLES_ISUP ! domain
+INTEGER, INTENT(OUT) :: KLES_ISUP ! physical domain
INTEGER, INTENT(OUT) :: KLES_JSUP !
!
!
@@ -140,32 +140,32 @@ IJE_ll=SIZE(PYHAT_ll)-JPHEXT
!
!* left limit
!
-ZX = ZXHAT_ll(NLESn_IINF(IMI))
+ZX = ZXHAT_ll(NLESn_IINF(IMI) + JPHEXT)
IF (PXHAT_ll(IIB_ll)>ZX) THEN
- KLES_IINF=IIB_ll ! father mask starts left of son domain
+ KLES_IINF=1 ! father mask starts left of son domain
ELSE IF (PXHAT_ll(IIE_ll+1)<ZX) THEN
CALL MASK_OVER_ALL_DOMAIN
RETURN
ELSE
DO JI=IIB_ll,IIE_ll
IF (ABS(PXHAT_ll(JI)-ZX) <= (PXHAT_ll(JI+1)-PXHAT_ll(JI))/2. ) THEN
- KLES_IINF=JI
+ KLES_IINF=JI-JPHEXT
END IF
END DO
END IF
!
!* right limit
!
-ZX = ZXHAT_ll(NLESn_ISUP(IMI)+1)
+ZX = ZXHAT_ll(NLESn_ISUP(IMI) + JPHEXT + 1)
IF (PXHAT_ll(IIB_ll)>ZX) THEN
CALL MASK_OVER_ALL_DOMAIN
RETURN
ELSE IF (PXHAT_ll(IIE_ll+1)<ZX) THEN
- KLES_ISUP=IIE_ll ! father mask ends right of son domain
+ KLES_ISUP=IIE_ll-JPHEXT ! father mask ends right of son domain
ELSE
DO JI=IIB_ll,IIE_ll
IF (ABS(PXHAT_ll(JI+1)-ZX) <= (PXHAT_ll(JI+1)-PXHAT_ll(JI))/2. ) THEN
- KLES_ISUP=JI
+ KLES_ISUP=JI-JPHEXT
END IF
END DO
END IF
@@ -177,32 +177,32 @@ END IF
!
!* bottom limit
!
-ZY = ZYHAT_ll(NLESn_JINF(IMI))
+ZY = ZYHAT_ll(NLESn_JINF(IMI) + JPHEXT)
IF (PYHAT_ll(IJB_ll)>ZY) THEN
- KLES_JINF=IJB_ll ! father mask starts under the son domain
+ KLES_JINF=1 ! father mask starts under the son domain
ELSE IF (PYHAT_ll(IJE_ll+1)<ZY) THEN
CALL MASK_OVER_ALL_DOMAIN
RETURN
ELSE
DO JJ=IJB_ll,IJE_ll
IF (ABS(PYHAT_ll(JJ)-ZY) <= (PYHAT_ll(JJ+1)-PYHAT_ll(JJ))/2. ) THEN
- KLES_JINF=JJ
+ KLES_JINF=JJ-JPHEXT
END IF
END DO
END IF
!
!* top limit
!
-ZY = ZYHAT_ll(NLESn_JSUP(IMI)+1)
+ZY = ZYHAT_ll(NLESn_JSUP(IMI) + JPHEXT + 1)
IF (PYHAT_ll(IJB_ll)>ZY) THEN
CALL MASK_OVER_ALL_DOMAIN
RETURN
ELSE IF (PYHAT_ll(IJE_ll+1)<ZY) THEN
- KLES_JSUP=IJE_ll ! father mask ends over the son domain
+ KLES_JSUP=IJE_ll-JPHEXT ! father mask ends over the son domain
ELSE
DO JJ=IJB_ll,IJE_ll
IF (ABS(PYHAT_ll(JJ+1)-ZY) <= (PYHAT_ll(JJ+1)-PYHAT_ll(JJ))/2. ) THEN
- KLES_JSUP=JJ
+ KLES_JSUP=JJ-JPHEXT
END IF
END DO
END IF
@@ -215,10 +215,10 @@ DEALLOCATE(ZYHAT_ll)
CONTAINS
!
SUBROUTINE MASK_OVER_ALL_DOMAIN
- KLES_IINF=IIB_ll ! father mask not in son domain, so all domain is taken
- KLES_ISUP=IIE_ll
- KLES_JINF=IJB_ll
- KLES_JSUP=IJE_ll
+ KLES_IINF=IIB_ll-JPHEXT ! father mask not in son domain, so all domain is taken
+ KLES_ISUP=IIE_ll-JPHEXT
+ KLES_JINF=IJB_ll-JPHEXT
+ KLES_JSUP=IJE_ll-JPHEXT
DEALLOCATE(ZXHAT_ll)
DEALLOCATE(ZYHAT_ll)
END SUBROUTINE MASK_OVER_ALL_DOMAIN
diff --git a/src/MNH/ini_lesn.f90 b/src/MNH/ini_lesn.f90
index c2a2256834c47187389d50e94d3e902c1682486d..45d7b9f9ac85e947fda34a09e56fe335c79d1d1c 100644
--- a/src/MNH/ini_lesn.f90
+++ b/src/MNH/ini_lesn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2019 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.
@@ -35,7 +35,12 @@
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 02/2019 (C. Lac) Add rain fraction as a LES diagnostic
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!! --------------------------------------------------------------------------
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 12/08/2020: bugfix: use NUNDEF instead of XUNDEF for integer variables
+! P. Wautelet 04/01/2021: bugfix: nles_k was used instead of nspectra_k for a loop index
+! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
+! P. Wautelet 09/07/2021: bugfix: altitude levels are on the correct grid position (mass point)
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -68,6 +73,7 @@ USE MODD_CONDSAMP, ONLY : LCONDSAMP
!
USE MODI_INI_LES_CART_MASKn
USE MODI_COEF_VER_INTERP_LIN
+USE MODI_SHUMAN
!
IMPLICIT NONE
!
@@ -105,31 +111,6 @@ IJU_ll = IJMAX_ll+2*JPHEXT
!
ILUOUT = TLUOUT%NLU
!
-NLES_TOTADV = 1
-NLES_RELA = 2
-NLES_RAD = 3
-NLES_GRAV = 4
-NLES_COR = 5
-NLES_MICR = 6
-NLES_HTURB = 7
-NLES_VTURB = 8
-NLES_FORC = 9
-NLES_PRES = 10
-NLES_DIFF = 11
-NLES_CURV = 12
-NLES_PREF = 13
-NLES_DP = 14
-NLES_TP = 15
-NLES_TR = 16
-NLES_DISS = 17
-NLES_TEND = 18
-NLES_ADVR = 19
-NLES_ADVM = 20
-NLES_NEST = 21
-NLES_MISC = 22
-!
-NLES_TOT = 22
-!
!-------------------------------------------------------------------------------
!
!* 1. Does LES computations are used?
@@ -182,28 +163,39 @@ NLES_MASKS = 1
! -----------------------------------------------------------------------------
!
IF (IMI==1) THEN
- NLESn_IINF(1)= NUNDEF
- NLESn_ISUP(1)= NUNDEF
- NLESn_JINF(1)= NUNDEF
- NLESn_JSUP(1)= NUNDEF
- !
- IF (LLES_CART_MASK) THEN
- IF (NLES_IINF==NUNDEF) NLES_IINF=JPHEXT+1
- IF (NLES_JINF==NUNDEF) NLES_JINF=JPHEXT+1
- IF (NLES_ISUP==NUNDEF) NLES_ISUP=IIU_ll-JPHEXT
- IF (NLES_JSUP==NUNDEF) NLES_JSUP=IJU_ll-JPHEXT
- END IF
- !
- IF ( NLES_IINF==JPHEXT+1 .AND. NLES_JINF==JPHEXT+1 &
- .AND. NLES_ISUP==IIU_ll-JPHEXT .AND. NLES_ISUP==IJU_ll-JPHEXT ) THEN
- LLES_CART_MASK=.FALSE.
- END IF
- !
- IF (.NOT. LLES_CART_MASK) THEN
- NLES_IINF=JPHEXT+1
- NLES_JINF=JPHEXT+1
- NLES_ISUP=IIU_ll-JPHEXT
- NLES_JSUP=IJU_ll-JPHEXT
+ IF ( LLES_CART_MASK ) THEN
+ !Compute LES diagnostics inside a cartesian mask
+
+ !Set default values to physical domain boundaries
+ IF ( NLES_IINF == NUNDEF ) NLES_IINF = 1
+ IF ( NLES_JINF == NUNDEF ) NLES_JINF = 1
+ IF ( NLES_ISUP == NUNDEF ) NLES_ISUP = NIMAX_ll
+ IF ( NLES_JSUP == NUNDEF ) NLES_JSUP = NJMAX_ll
+
+ !Check that selected indices are in physical domain
+ IF ( NLES_IINF < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_IINF too small (<1)' )
+ IF ( NLES_IINF > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_IINF too large (>NIMAX)' )
+ IF ( NLES_ISUP < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_ISUP too small (<1)' )
+ IF ( NLES_ISUP > NIMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_ISUP too large (>NIMAX)' )
+ IF ( NLES_ISUP < NLES_IINF ) CALL Print_msg( NVERB_ERROR, 'BUD', 'INI_LES_n', 'NLES_ISUP < NLES_IINF' )
+
+ IF ( NLES_JINF < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JINF too small (<1)' )
+ IF ( NLES_JINF > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JINF too large (>NJMAX)' )
+ IF ( NLES_JSUP < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JSUP too small (<1)' )
+ IF ( NLES_JSUP > NJMAX_ll ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_JSUP too large (>NJMAX)' )
+ IF ( NLES_JSUP < NLES_JINF ) CALL Print_msg( NVERB_ERROR, 'BUD', 'INI_LES_n', 'NLES_JSUP < NLES_JINF' )
+
+ !Set LLES_CART_MASK to false if whole domain is selected
+ IF ( NLES_IINF == 1 .AND. NLES_JINF == 1 &
+ .AND. NLES_ISUP == NIMAX_ll .AND. NLES_ISUP == NJMAX_ll ) THEN
+ LLES_CART_MASK = .FALSE.
+ END IF
+ ELSE
+ !Compute LES diagnostics on whole physical domain
+ NLES_IINF = 1
+ NLES_JINF = 1
+ NLES_ISUP = NIMAX_ll
+ NLES_JSUP = NJMAX_ll
END IF
!
NLESn_IINF(1)= NLES_IINF
@@ -234,17 +226,16 @@ END IF
! ----------------------------------------------------------------------------
!
IF ( (.NOT. L1D) .AND. CLBCX(1)/='CYCL') THEN
- NLESn_IINF(IMI) = MAX(NLESn_IINF(IMI),JPHEXT+2)
+ NLESn_IINF(IMI) = MAX(NLESn_IINF(IMI),2)
END IF
IF ( (.NOT. L1D) .AND. (.NOT. L2D) .AND. CLBCY(1)/='CYCL') THEN
- NLESn_JINF(IMI) = MAX(NLESn_JINF(IMI),JPHEXT+2)
+ NLESn_JINF(IMI) = MAX(NLESn_JINF(IMI),2)
END IF
!
!* X boundary conditions for 2points correlations computations
! -----------------------------------------------------------
!
-IF ( NLESn_IINF(IMI)==JPHEXT+1 .AND. NLESn_ISUP(IMI)==IIU_ll-JPHEXT &
- .AND. CLBCX(1)=='CYCL' ) THEN
+IF ( CLBCX(1) == 'CYCL' .AND. NLESn_IINF(IMI) == 1 .AND. NLESn_ISUP(IMI) == NIMAX_ll ) THEN
CLES_LBCX(:,IMI) = 'CYCL'
ELSE
CLES_LBCX(:,IMI) = 'OPEN'
@@ -253,8 +244,7 @@ END IF
!* Y boundary conditions for 2points correlations computations
! -----------------------------------------------------------
!
-IF ( NLESn_JINF(IMI)==JPHEXT+1 .AND. NLESn_JSUP(IMI)==IJU_ll-JPHEXT &
- .AND. CLBCY(1)=='CYCL' ) THEN
+IF ( CLBCY(1) == 'CYCL' .AND. NLESn_JINF(IMI) == 1 .AND. NLESn_JSUP(IMI) == NJMAX_ll ) THEN
CLES_LBCY(:,IMI) = 'CYCL'
ELSE
CLES_LBCY(:,IMI) = 'OPEN'
@@ -338,17 +328,13 @@ NLES_TIMES = ( INT( (XSEGLEN-XTSTEP+1.E-6) / XTSTEP ) ) / NLES_DTCOUNT
!
NLES_TCOUNT = 0
!
-!* 3.6 date array for diachro
+!* 3.6 dates array for diachro
! ----------------------
!
-ALLOCATE(XLES_DATIME(16,NLES_TIMES))
-!
-!* 3.7 sampling times array for diachro
-! --------------------------------
-!
-ALLOCATE(XLES_TRAJT(NLES_TIMES,1))
+allocate( tles_dates( nles_times ) )
+allocate( xles_times( nles_times ) )
!
-!* 3.8 No data
+!* 3.7 No data
! -------
!
IF (NLES_TIMES==0) THEN
@@ -381,7 +367,7 @@ IF (ANY(XLES_ALTITUDES(:)/=XUNDEF)) THEN
END DO
END DO
END DO
- CALL COEF_VER_INTERP_LIN(XZZ,ZZ_LES,NKLIN_LES,XCOEFLIN_LES)
+ CALL COEF_VER_INTERP_LIN(MZF(XZZ),ZZ_LES,NKLIN_LES,XCOEFLIN_LES)
!
DEALLOCATE(ZZ_LES)
END IF
@@ -391,14 +377,21 @@ END IF
! --------------------
!
IF (ANY(NLES_LEVELS(:)/=NUNDEF)) THEN
- NLES_K = COUNT (NLES_LEVELS(:)/=XUNDEF)
+ DO JK = 1, SIZE( NLES_LEVELS )
+ IF ( NLES_LEVELS(JK) /= NUNDEF ) THEN
+ IF ( NLES_LEVELS(JK) < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_LEVELS too small (<1)' )
+ IF ( NLES_LEVELS(JK) > NKMAX ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NLES_LEVELS too large (>NKMAX)' )
+ END IF
+ END DO
+
+ NLES_K = COUNT (NLES_LEVELS(:)/=NUNDEF)
CLES_LEVEL_TYPE='K'
ELSE
IF (NLES_K==0) THEN
NLES_K = MIN(SIZE(NLES_LEVELS),NKMAX)
CLES_LEVEL_TYPE='K'
DO JK=1,NLES_K
- NLES_LEVELS(JK) = JK + JPVEXT
+ NLES_LEVELS(JK) = JK
END DO
END IF
END IF
@@ -423,7 +416,7 @@ IF (ANY(XSPECTRA_ALTITUDES(:)/=XUNDEF)) THEN
ALLOCATE(NKLIN_SPEC (SIZE(XZZ,1),SIZE(XZZ,2),NSPECTRA_K))
!
ALLOCATE(ZZ_SPEC (SIZE(XZZ,1),SIZE(XZZ,2),NSPECTRA_K))
- DO JK=1,NLES_K
+ DO JK=1,NSPECTRA_K
DO JJ=1,SIZE(XZZ,2)
DO JI=1,SIZE(XZZ,1)
ZZ_SPEC(JI,JJ,JK) = XSPECTRA_ALTITUDES(JK)
@@ -439,8 +432,15 @@ END IF
!* 5.2 Case of model levels (highest priority)
! --------------------
!
-IF (ANY(NSPECTRA_LEVELS(:)/=XUNDEF)) THEN
- NSPECTRA_K = COUNT (NSPECTRA_LEVELS(:)/=XUNDEF)
+IF (ANY(NSPECTRA_LEVELS(:)/=NUNDEF)) THEN
+ DO JK = 1, SIZE( NSPECTRA_LEVELS )
+ IF ( NSPECTRA_LEVELS(JK) /= NUNDEF ) THEN
+ IF ( NSPECTRA_LEVELS(JK) < 1 ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NSPECTRA_LEVELS too small (<1)' )
+ IF ( NSPECTRA_LEVELS(JK) > NKMAX ) CALL Print_msg( NVERB_ERROR, 'GEN', 'INI_LES_n', 'NSPECTRA_LEVELS too large (>NKMAX)' )
+ END IF
+ END DO
+
+ NSPECTRA_K = COUNT (NSPECTRA_LEVELS(:)/=NUNDEF)
CSPECTRA_LEVEL_TYPE='K'
END IF
!
@@ -745,7 +745,6 @@ ALLOCATE(XLES_RESOLVED_W3 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'3>
ALLOCATE(XLES_RESOLVED_U4 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <u'4>
ALLOCATE(XLES_RESOLVED_V4 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <v'4>
ALLOCATE(XLES_RESOLVED_W4 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'4>
-ALLOCATE(XLES_RESOLVED_Ua_ddxa_P(NLES_K,NLES_TIMES,NLES_MASKS)) ! <ua'dp'/dxa>
ALLOCATE(XLES_RESOLVED_ThlPz (NLES_K,NLES_TIMES,NLES_MASKS)) ! <Thv'dp'/dz>
ALLOCATE(XLES_RESOLVED_WThl2 (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'Thl'2>
ALLOCATE(XLES_RESOLVED_W2Thl (NLES_K,NLES_TIMES,NLES_MASKS)) ! <w'2Thl'>
@@ -935,7 +934,6 @@ XLES_RESOLVED_W3 = XUNDEF
XLES_RESOLVED_U4 = XUNDEF
XLES_RESOLVED_V4 = XUNDEF
XLES_RESOLVED_W4 = XUNDEF
-XLES_RESOLVED_Ua_ddxa_P = XUNDEF
XLES_RESOLVED_WThl2 = XUNDEF
XLES_RESOLVED_W2Thl = XUNDEF
XLES_RESOLVED_ThlPz = XUNDEF
@@ -1960,14 +1958,6 @@ IF (LUSERC ) XCORRj_RcRc = XUNDEF
IF (LUSERI ) XCORRj_RiRi = XUNDEF
IF (NSV>0 ) XCORRj_SvSv = XUNDEF
!
-!
-! 9.3 Two-points correlations in K direction
-! --------------------------------------
-!
-ALLOCATE(XCORRk_WW (NLES_K,NSPECTRA_K,NLES_TIMES))
-!
-XCORRk_WW = XUNDEF
-!
!-------------------------------------------------------------------------------
!
END SUBROUTINE INI_LES_n
diff --git a/src/MNH/ini_lima.f90 b/src/MNH/ini_lima.f90
index 58257019d57ec24e9097d95dc40c878da1e07e01..d90f1e160430b979866f105574478d30d2d5f7dd 100644
--- a/src/MNH/ini_lima.f90
+++ b/src/MNH/ini_lima.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -136,18 +136,16 @@ IF (ALLOCATED(XRTMIN)) RETURN ! In case of nesting microphysics, constants of
!
! Set bounds for mixing ratios and concentrations
ALLOCATE( XRTMIN(7) )
-XRTMIN(1) = 1.0E-20 ! rv
-XRTMIN(2) = 1.0E-20 ! rc
-!XRTMIN(3) = 1.0E-20 ! rr
-XRTMIN(3) = 1.0E-17 ! rr
-XRTMIN(4) = 1.0E-20 ! ri
-XRTMIN(5) = 1.0E-15 ! rs
-XRTMIN(6) = 1.0E-15 ! rg
-XRTMIN(7) = 1.0E-15 ! rh
+XRTMIN(1) = 1.0E-10 ! rv
+XRTMIN(2) = 1.0E-10 ! rc
+XRTMIN(3) = 1.0E-10 ! rr
+XRTMIN(4) = 1.0E-10 ! ri
+XRTMIN(5) = 1.0E-10 ! rs
+XRTMIN(6) = 1.0E-10 ! rg
+XRTMIN(7) = 1.0E-10 ! rh
ALLOCATE( XCTMIN(7) )
XCTMIN(1) = 1.0 ! Not used
XCTMIN(2) = 1.0E-3 ! Nc
-!XCTMIN(3) = 1.0E+1 ! Nr
XCTMIN(3) = 1.0E-3 ! Nr
XCTMIN(4) = 1.0E-3 ! Ni
XCTMIN(5) = 1.0E-3 ! Not used
diff --git a/src/MNH/ini_lima_warm.f90 b/src/MNH/ini_lima_warm.f90
index 0afeea4928ba710840a31261e0f7d62fa44e73c1..3fac15aaefe54e303ddb025473017407a5a60b6d 100644
--- a/src/MNH/ini_lima_warm.f90
+++ b/src/MNH/ini_lima_warm.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! #########################
MODULE MODI_INI_LIMA_WARM
! #########################
@@ -276,6 +277,8 @@ XAHENINTP2 = 0.5*REAL(NAHEN-1) - XTT
! G
!
ALLOCATE (XAHENG(NAHEN))
+ALLOCATE (XAHENG2(NAHEN))
+ALLOCATE (XAHENG3(NAHEN))
ALLOCATE (XPSI1(NAHEN))
ALLOCATE (XPSI3(NAHEN))
XCSTHEN = 1.0 / ( XRHOLW*2.0*XPI )
@@ -288,6 +291,8 @@ DO J1 = 1,NAHEN
(XDIVA*EXP(XALPW-(XBETAW/ZTT)-(XGAMW*ALOG(ZTT)))) &
+ (ZLV/ZTT)**2/(XTHCO*XRV) ) )
XAHENG(J1) = XCSTHEN/(ZG)**(3./2.)
+ XAHENG2(J1) = 1/(ZG)**(1./2.) * GAMMA_X0D(XNUC+1./XALPHAC)/GAMMA_X0D(XNUC)
+ XAHENG3(J1) = (ZG) * GAMMA_X0D(XNUC+1./XALPHAC)/GAMMA_X0D(XNUC)
END DO
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/ini_mean_field.f90 b/src/MNH/ini_mean_field.f90
index 36eafb4586599ef980f804c73ac1674cea7448c8..32ddfbb8847adcfe2cbe1887368abee74b2370b9 100644
--- a/src/MNH/ini_mean_field.f90
+++ b/src/MNH/ini_mean_field.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -48,6 +48,8 @@ END MODULE MODI_INI_MEAN_FIELD
!! -------------
!! Original 11/12/09
!! 10/2016 (C.Lac) Add max values
+!! 02/2021 (T.Nagel) add passive scalar (XSVT) and UW wind component
+!! 05/2021 (PA.Joulin) add wind turbine variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -57,11 +59,17 @@ END MODULE MODI_INI_MEAN_FIELD
USE MODD_MEAN_FIELD_n
USE MODD_MEAN_FIELD
USE MODD_PARAM_n
-
+USE MODD_EOL_MAIN, ONLY: LMAIN_EOL, CMETH_EOL, NMODEL_EOL
+USE MODD_EOL_SHARED_IO, ONLY: XTHRU_SUM, XTORQ_SUM, XPOW_SUM
+USE MODD_EOL_ALM
+USE MODE_MODELN_HANDLER
+!
IMPLICIT NONE
!
+INTEGER :: IMI !Current model index
+!
MEAN_COUNT = 0
-
+!
XUM_MEAN = 0.0
XVM_MEAN = 0.0
XWM_MEAN = 0.0
@@ -69,14 +77,31 @@ XTHM_MEAN = 0.0
XTEMPM_MEAN = 0.0
IF (CTURB /= 'NONE') XTKEM_MEAN = 0.0
XPABSM_MEAN = 0.0
-
+XSVT_MEAN = 0.0
+!
XU2_MEAN = 0.0
XV2_MEAN = 0.0
XW2_MEAN = 0.0
+XUW_MEAN = 0.0
XTH2_MEAN = 0.0
XTEMP2_MEAN = 0.0
XPABS2_MEAN = 0.0
-
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+IF (LMAIN_EOL .AND. IMI==NMODEL_EOL) THEN
+ SELECT CASE(CMETH_EOL)
+ CASE('ADNR') ! Actuator Disc Non-Rotating
+ XTHRU_SUM = 0.0
+ CASE('ALM') ! Actuator Line Method
+ XAOA_SUM = 0.0
+ XFAERO_RE_SUM = 0.0
+ XTHRU_SUM = 0.0
+ XTORQ_SUM = 0.0
+ XPOW_SUM = 0.0
+ END SELECT
+END IF
+!
+!
XUM_MAX = -1.E20
XVM_MAX = -1.E20
XWM_MAX = -1.E20
diff --git a/src/MNH/ini_micron.f90 b/src/MNH/ini_micron.f90
index 718eebb464b59a2d271a80cfbab03dceacc418fd..b8ab64995358f8d40a6ceebeaaf03aba89fe02de 100644
--- a/src/MNH/ini_micron.f90
+++ b/src/MNH/ini_micron.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.
@@ -50,11 +50,12 @@ END MODULE MODI_INI_MICRO_n
!! O.Geoffroy (03/2006) : Add KHKO scheme
!! Modification 01/2016 (JP Pinty) Add LIMA
!! C.LAc 10/2016 Add budget for droplet deposition
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! P.Wautelet 01/2019: bug: add missing allocations
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 01/2019: bugfix: add missing allocations
+! C. Lac 02/2020: add missing allocation of INPRC and ACPRC with deposition
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
-!!
-!! --------------------------------------------------------------------------
+! P. Wautelet 04/06/2020: bugfix: correct bounds of passed arrays
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -94,22 +95,16 @@ USE MODI_SET_CONC_ICE_C1R3
USE MODE_ll
USE MODE_MODELN_HANDLER
USE MODE_BLOWSNOW_SEDIM_LKT
+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
!
USE MODI_INIT_AEROSOL_CONCENTRATION
USE MODI_INI_LIMA
-USE MODI_SET_CONC_LIMA
!
IMPLICIT NONE
!
@@ -140,6 +135,7 @@ INTEGER :: IMI
!
CALL GET_DIM_EXT_ll('B',IIU,IJU)
IKU=SIZE(XZZ,3)
+IMI = GET_CURRENT_MODEL_INDEX()
!
!
!* 2. ALLOCATE Module MODD_PRECIP_n
@@ -161,9 +157,9 @@ ELSE
ALLOCATE(XACPRR(0,0))
END IF
!
-IF (( CCLOUD(1:3) == 'ICE' .AND.LSEDIC) .OR. &
- ((CCLOUD=='C2R2' .OR. CCLOUD=='C3R5' .OR. CCLOUD=='KHKO').AND.LSEDC) .OR. &
- ( CCLOUD=='LIMA' .AND.MSEDC)) THEN
+IF (( CCLOUD(1:3) == 'ICE' .AND.(LSEDIC .OR. LDEPOSC)) .OR. &
+ ((CCLOUD=='C2R2' .OR. CCLOUD=='C3R5' .OR. CCLOUD=='KHKO').AND.(LSEDC .OR. LDEPOC)) .OR. &
+ ( CCLOUD=='LIMA' .AND.(MSEDC .OR. MDEPOC))) THEN
ALLOCATE(XINPRC(IIU,IJU))
ALLOCATE(XACPRC(IIU,IJU))
XINPRC(:,:)=0.0
@@ -291,11 +287,7 @@ ELSE IF (CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') THEN
CALL INI_ICE_C1R3(XTSTEP,ZDZMIN,NSPLITG) ! 1/2 spectral cold cloud
END IF
ELSE IF (CCLOUD == 'LIMA') THEN
- IF (CGETCLOUD /= 'READ') THEN
- CALL INIT_AEROSOL_CONCENTRATION(XRHODREF, &
- XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
- XZZ(:,:,:) )
- END IF
+ IF (CGETCLOUD /= 'READ') CALL INIT_AEROSOL_CONCENTRATION( XRHODREF, XSVT(:, :, :, :), XZZ(:, :, :) )
CALL INI_LIMA(XTSTEP,ZDZMIN,NSPLITR, NSPLITG) ! 1/2 spectral warm cloud
END IF
!
@@ -317,7 +309,7 @@ ENDIF
!
IF (CCLOUD == 'LIMA') THEN
IF (CGETCLOUD/='READ') THEN
- CALL SET_CONC_LIMA(CGETCLOUD,XRHODREF,XRT,XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END))
+ CALL SET_CONC_LIMA(IMI,CGETCLOUD,XRHODREF,XRT,XSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END))
END IF
END IF
!
@@ -326,7 +318,6 @@ END IF
! ----------------------------------
!
!
-IMI = GET_CURRENT_MODEL_INDEX()
!IF (CELEC /= 'NONE') THEN
! CALL INI_ELEC(IMI,TPINIFILE,XTSTEP,ZDZMIN,NSPLITR, &
! XDXX,XDYY,XDZZ,XDZX,XDZY )
diff --git a/src/MNH/ini_modeln.f90 b/src/MNH/ini_modeln.f90
index a7ff5457c1cfbe7464077149deef90d0492ec766..48b3a7348e239e3db4e139c6687184d781a7365c 100644
--- a/src/MNH/ini_modeln.f90
+++ b/src/MNH/ini_modeln.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.
@@ -287,6 +287,12 @@ END MODULE MODI_INI_MODEL_n
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
! P. Wautelet 07/06/2019: allocate lookup tables for optical properties only when needed
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! S. Riette 04/2020: XHL* fields
+! F. Auguste 02/2021: add IBM
+! T.Nigel 02/2021: add turbulence recycling
+! J.L.Redelsperger 06/2011: OCEAN case
!---------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -326,7 +332,7 @@ USE MODD_DEF_EDDYUV_FLUX_n ! FOR UV
USE MODD_DIAG_FLAG, only: LCHEMDIAG, CSPEC_BU_DIAG
USE MODD_DIM_n
USE MODD_DRAG_n
-USE MODD_DRAGTREE
+USE MODD_DRAGTREE_n
USE MODD_DUST
use MODD_DUST_OPT_LKT, only: NMAX_RADIUS_LKT_DUST=>NMAX_RADIUS_LKT, NMAX_SIGMA_LKT_DUST=>NMAX_SIGMA_LKT, &
NMAX_WVL_SW_DUST=>NMAX_WVL_SW, &
@@ -337,6 +343,7 @@ USE MODD_DYN_n
USE MODD_DYNZD
USE MODD_DYNZD_n
USE MODD_ELEC_n, only: XCION_POS_FW, XCION_NEG_FW
+USE MODD_EOL_MAIN
USE MODD_FIELD_n
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
@@ -347,10 +354,12 @@ USE MODD_FRC_n
USE MODD_GET_n
USE MODD_GRID_n
USE MODD_GRID, only: XLONORI,XLATORI
+USE MODD_IBM_PARAM_n, only: LIBM, XIBM_IEPS, XIBM_LS, XIBM_XMUT
USE MODD_IO, only: CIO_DIR, TFILEDATA, TFILE_DUMMY
USE MODD_IO_SURF_MNH, only: IO_SURF_MNH_MODEL
USE MODD_LATZ_EDFLX
USE MODD_LBC_n, only: CLBCX, CLBCY
+use modd_les
USE MODD_LSFIELD_n
USE MODD_LUNIT_n
USE MODD_MEAN_FIELD
@@ -361,6 +370,7 @@ USE MODD_NESTING, only: CDAD_NAME, NDAD, NDT_2_WAY, NDTRATIO, NDXRATIO
USE MODD_NSV
USE MODD_NSV
USE MODD_NUDGING_n, only: LNUDGING
+USE MODD_OCEANH
USE MODD_OUT_n
USE MODD_PARAMETERS
USE MODD_PARAM_KAFR_n
@@ -372,6 +382,7 @@ USE MODD_PASPOL_n
USE MODD_PAST_FIELD_n
use modd_precision, only: LFIINT
USE MODD_RADIATIONS_n
+USE MODD_RECYCL_PARAM_n
USE MODD_REF
USE MODD_REF_n
USE MODD_RELFRC_n
@@ -390,6 +401,7 @@ USE MODD_TURB_n
USE MODD_VAR_ll, only: IP
USE MODE_GATHER_ll
+use mode_ini_budget, only: Budget_preallocate, Ini_budget
USE MODE_INI_ONE_WAY_n
USE MODE_IO
USE MODE_IO_FIELD_READ, only: IO_Field_read
@@ -418,12 +430,13 @@ USE MODI_INI_AEROSET6
USE MODI_INI_AIRCRAFT_BALLOON
USE MODI_INI_AIRCRAFT_BALLOON
USE MODI_INI_BIKHARDT_n
-USE MODI_INI_BUDGET
USE MODI_INI_CPL
USE MODI_INI_DEEP_CONVECTION
USE MODI_INI_DRAG
USE MODI_INI_DYNAMICS
USE MODI_INI_ELEC_n
+USE MODI_INI_EOL_ADNR
+USE MODI_INI_EOL_ALM
USE MODI_INI_LES_N
USE MODI_INI_LG
USE MODI_INI_LW_SETUP
@@ -457,6 +470,11 @@ USE MODI_SUNPOS_n
USE MODI_SURF_SOLAR_GEOM
USE MODI_UPDATE_METRICS
USE MODI_UPDATE_NSV
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+USE YOERDI , ONLY :RCCO2
+#endif
+#endif
!
IMPLICIT NONE
!
@@ -484,6 +502,7 @@ LOGICAL :: GINIDCONV ! logical switch for the deep convection
! initialization
LOGICAL :: GINIRAD ! logical switch for the radiation
! initialization
+logical :: gles ! Logical to determine if LES diagnostics are enabled
!
!
TYPE(LIST_ll), POINTER :: TZINITHALO2D_ll ! pointer for the list of 2D fields
@@ -509,11 +528,12 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDIR_ALB ! direct albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSCA_ALB ! diffuse albedo
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEMIS ! emissivity
REAL, DIMENSION(:,:), ALLOCATABLE :: ZTSRAD ! surface temperature
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZIBM_LS ! LevelSet IBM
!
!
INTEGER, DIMENSION(:,:),ALLOCATABLE :: IINDEX ! indices of non-zero terms
INTEGER, DIMENSION(:),ALLOCATABLE :: IIND
-INTEGER :: JM
+INTEGER :: JM, JT
!
!------------------------------------------
! Dummy pointers needed to correct an ifort Bug
@@ -551,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)
@@ -691,6 +717,41 @@ CALL UPDATE_NSV(KMI)
!
!* 3. ALLOCATE MEMORY
! -----------------
+! * Module RECYCL
+!
+IF (LRECYCL) THEN
+!
+ NR_COUNT = 0
+!
+ ALLOCATE(XUMEANW(IJU,IKU,INT(XNUMBELT))) ; XUMEANW = 0.0
+ ALLOCATE(XVMEANW(IJU,IKU,INT(XNUMBELT))) ; XVMEANW = 0.0
+ ALLOCATE(XWMEANW(IJU,IKU,INT(XNUMBELT))) ; XWMEANW = 0.0
+ ALLOCATE(XUMEANN(IIU,IKU,INT(XNUMBELT))) ; XUMEANN = 0.0
+ ALLOCATE(XVMEANN(IIU,IKU,INT(XNUMBELT))) ; XVMEANN = 0.0
+ ALLOCATE(XWMEANN(IIU,IKU,INT(XNUMBELT))) ; XWMEANN = 0.0
+ ALLOCATE(XUMEANE(IJU,IKU,INT(XNUMBELT))) ; XUMEANE = 0.0
+ ALLOCATE(XVMEANE(IJU,IKU,INT(XNUMBELT))) ; XVMEANE = 0.0
+ ALLOCATE(XWMEANE(IJU,IKU,INT(XNUMBELT))) ; XWMEANE = 0.0
+ ALLOCATE(XUMEANS(IIU,IKU,INT(XNUMBELT))) ; XUMEANS = 0.0
+ ALLOCATE(XVMEANS(IIU,IKU,INT(XNUMBELT))) ; XVMEANS = 0.0
+ ALLOCATE(XWMEANS(IIU,IKU,INT(XNUMBELT))) ; XWMEANS = 0.0
+ ALLOCATE(XTBV(IIU,IJU,IKU)) ; XTBV = 0.0
+ELSE
+ ALLOCATE(XUMEANW(0,0,0))
+ ALLOCATE(XVMEANW(0,0,0))
+ ALLOCATE(XWMEANW(0,0,0))
+ ALLOCATE(XUMEANN(0,0,0))
+ ALLOCATE(XVMEANN(0,0,0))
+ ALLOCATE(XWMEANN(0,0,0))
+ ALLOCATE(XUMEANE(0,0,0))
+ ALLOCATE(XVMEANE(0,0,0))
+ ALLOCATE(XWMEANE(0,0,0))
+ ALLOCATE(XUMEANS(0,0,0))
+ ALLOCATE(XVMEANS(0,0,0))
+ ALLOCATE(XWMEANS(0,0,0))
+ ALLOCATE(XTBV (0,0,0))
+END IF
+!
!
!* 3.1 Module MODD_FIELD_n
!
@@ -703,6 +764,7 @@ IF (LMEAN_FIELD) THEN
ALLOCATE(XWM_MEAN(IIU,IJU,IKU)) ; XWM_MEAN = 0.0
ALLOCATE(XTHM_MEAN(IIU,IJU,IKU)) ; XTHM_MEAN = 0.0
ALLOCATE(XTEMPM_MEAN(IIU,IJU,IKU)) ; XTEMPM_MEAN = 0.0
+ ALLOCATE(XSVT_MEAN(IIU,IJU,IKU)) ; XSVT_MEAN = 0.0
IF (CTURB/='NONE') THEN
ALLOCATE(XTKEM_MEAN(IIU,IJU,IKU))
XTKEM_MEAN = 0.0
@@ -714,6 +776,7 @@ IF (LMEAN_FIELD) THEN
ALLOCATE(XU2_MEAN(IIU,IJU,IKU)) ; XU2_MEAN = 0.0
ALLOCATE(XV2_MEAN(IIU,IJU,IKU)) ; XV2_MEAN = 0.0
ALLOCATE(XW2_MEAN(IIU,IJU,IKU)) ; XW2_MEAN = 0.0
+ ALLOCATE(XUW_MEAN(IIU,IJU,IKU)) ; XUW_MEAN = 0.0
ALLOCATE(XTH2_MEAN(IIU,IJU,IKU)) ; XTH2_MEAN = 0.0
ALLOCATE(XTEMP2_MEAN(IIU,IJU,IKU)) ; XTEMP2_MEAN = 0.0
ALLOCATE(XPABS2_MEAN(IIU,IJU,IKU)) ; XPABS2_MEAN = 0.0
@@ -736,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))
@@ -791,6 +856,43 @@ ALLOCATE(XRVS_PRES(IIU,IJU,IKU)); XRVS_PRES = 0.0
ALLOCATE(XRWS_PRES(IIU,IJU,IKU)); XRWS_PRES = 0.0
ALLOCATE(XRTHS(IIU,IJU,IKU)) ; XRTHS = 0.0
ALLOCATE(XRTHS_CLD(IIU,IJU,IKU)); XRTHS_CLD = 0.0
+
+IF ( LIBM ) THEN
+ ALLOCATE(ZIBM_LS(IIU,IJU,IKU)) ; ZIBM_LS = 0.0
+ ALLOCATE(XIBM_XMUT(IIU,IJU,IKU)); XIBM_XMUT = 0.0
+ELSE
+ ALLOCATE(ZIBM_LS (0,0,0))
+ ALLOCATE(XIBM_XMUT(0,0,0))
+END IF
+
+IF ( LRECYCL ) THEN
+ ALLOCATE(XFLUCTUNW(IJU,IKU)) ; XFLUCTUNW = 0.0
+ ALLOCATE(XFLUCTVNN(IIU,IKU)) ; XFLUCTVNN = 0.0
+ ALLOCATE(XFLUCTUTN(IIU,IKU)) ; XFLUCTUTN = 0.0
+ ALLOCATE(XFLUCTVTW(IJU,IKU)) ; XFLUCTVTW = 0.0
+ ALLOCATE(XFLUCTUNE(IJU,IKU)) ; XFLUCTUNE = 0.0
+ ALLOCATE(XFLUCTVNS(IIU,IKU)) ; XFLUCTVNS = 0.0
+ ALLOCATE(XFLUCTUTS(IIU,IKU)) ; XFLUCTUTS = 0.0
+ ALLOCATE(XFLUCTVTE(IJU,IKU)) ; XFLUCTVTE = 0.0
+ ALLOCATE(XFLUCTWTW(IJU,IKU)) ; XFLUCTWTW = 0.0
+ ALLOCATE(XFLUCTWTN(IIU,IKU)) ; XFLUCTWTN = 0.0
+ ALLOCATE(XFLUCTWTE(IJU,IKU)) ; XFLUCTWTE = 0.0
+ ALLOCATE(XFLUCTWTS(IIU,IKU)) ; XFLUCTWTS = 0.0
+ELSE
+ ALLOCATE(XFLUCTUNW(0,0))
+ ALLOCATE(XFLUCTVNN(0,0))
+ ALLOCATE(XFLUCTUTN(0,0))
+ ALLOCATE(XFLUCTVTW(0,0))
+ ALLOCATE(XFLUCTUNE(0,0))
+ ALLOCATE(XFLUCTVNS(0,0))
+ ALLOCATE(XFLUCTUTS(0,0))
+ ALLOCATE(XFLUCTVTE(0,0))
+ ALLOCATE(XFLUCTWTW(0,0))
+ ALLOCATE(XFLUCTWTN(0,0))
+ ALLOCATE(XFLUCTWTE(0,0))
+ ALLOCATE(XFLUCTWTS(0,0))
+END IF
+!
IF (CTURB /= 'NONE') THEN
ALLOCATE(XTKET(IIU,IJU,IKU))
ALLOCATE(XRTKES(IIU,IJU,IKU))
@@ -839,10 +941,25 @@ ELSE
ALLOCATE(XSRCT(0,0,0))
ALLOCATE(XSIGS(0,0,0))
END IF
+IF (CCLOUD == 'ICE3'.OR.CCLOUD == 'ICE4') THEN
+ ALLOCATE(XHLC_HRC(IIU,IJU,IKU))
+ ALLOCATE(XHLC_HCF(IIU,IJU,IKU))
+ ALLOCATE(XHLI_HRI(IIU,IJU,IKU))
+ ALLOCATE(XHLI_HCF(IIU,IJU,IKU))
+ XHLC_HRC(:,:,:)=0.
+ XHLC_HCF(:,:,:)=0.
+ XHLI_HRI(:,:,:)=0.
+ XHLI_HCF(:,:,:)=0.
+ELSE
+ ALLOCATE(XHLC_HRC(0,0,0))
+ ALLOCATE(XHLC_HCF(0,0,0))
+ ALLOCATE(XHLI_HRI(0,0,0))
+ ALLOCATE(XHLI_HCF(0,0,0))
+END IF
!
IF (NRR>1) THEN
- ALLOCATE(XCLDFR(IIU,IJU,IKU))
- ALLOCATE(XRAINFR(IIU,IJU,IKU))
+ ALLOCATE(XCLDFR(IIU,IJU,IKU)); XCLDFR (:, :, :) = 0.
+ ALLOCATE(XRAINFR(IIU,IJU,IKU)); XRAINFR(:, :, :) = 0.
ELSE
ALLOCATE(XCLDFR(0,0,0))
ALLOCATE(XRAINFR(0,0,0))
@@ -903,11 +1020,19 @@ ALLOCATE(XDZZ(IIU,IJU,IKU))
!
!* 3.3 Modules MODD_REF and MODD_REF_n
!
-IF (KMI == 1) THEN
+! Different reference states for Ocean and Atmosphere models
+! For the moment, same reference states for O and A
+!IF ((KMI == 1).OR.LCOUPLES) THEN
+IF (KMI==1) THEN
ALLOCATE(XRHODREFZ(IKU),XTHVREFZ(IKU))
+ELSE IF (LCOUPLES) THEN
+! in coupled O-A case, need different variables for ocean
+ ALLOCATE(XRHODREFZO(IKU),XTHVREFZO(IKU))
ELSE
!Do not allocate XRHODREFZ and XTHVREFZ because they are the same on all grids (not 'n' variables)
END IF
+!
+ALLOCATE(XPHIT(IIU,IJU,IKU))
ALLOCATE(XRHODREF(IIU,IJU,IKU))
ALLOCATE(XTHVREF(IIU,IJU,IKU))
ALLOCATE(XEXNREF(IIU,IJU,IKU))
@@ -1324,15 +1449,31 @@ END IF
! Initialization of SW bands
NSWB_OLD = 6 ! Number of bands in ECMWF original scheme (from Fouquart et Bonnel (1980))
! then modified through INI_RADIATIONS_ECMWF but remains equal to 6 practically
+
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+NLWB_OLD = 16 ! For XEMIS initialization (should be spectral in the future)
+#endif
+#endif
+
+NLWB_MNH = 16 ! For XEMIS initialization (should be spectral in the future)
+
IF (CRAD == 'ECRA') THEN
NSWB_MNH = 14
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ NLWB_MNH = 16
+#endif
+#endif
ELSE
NSWB_MNH = NSWB_OLD
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ NLWB_MNH = NLWB_OLD
+#endif
+#endif
END IF
-NLWB_MNH = 16 ! For XEMIS initialization (should be spectral in the future)
-
-
ALLOCATE(XSW_BANDS (NSWB_MNH))
ALLOCATE(XLW_BANDS (NLWB_MNH))
ALLOCATE(XZENITH (IIU,IJU))
@@ -1483,7 +1624,17 @@ ALLOCATE(XRI_MF(IIU,IJU,IKU)) ; XRI_MF=0.0
!
ALLOCATE(ZJ(IIU,IJU,IKU))
!
-!* 3.10 Forcing variables (Module MODD_FRC)
+!* 3.10 Forcing variables (Module MODD_FRC and MODD_FRCn)
+!
+IF ( LFORCING ) THEN
+ ALLOCATE(XWTFRC(IIU,IJU,IKU)) ; XWTFRC = XUNDEF
+ ALLOCATE(XUFRC_PAST(IIU,IJU,IKU)) ; XUFRC_PAST = XUNDEF
+ ALLOCATE(XVFRC_PAST(IIU,IJU,IKU)) ; XVFRC_PAST = XUNDEF
+ELSE
+ ALLOCATE(XWTFRC(0,0,0))
+ ALLOCATE(XUFRC_PAST(0,0,0))
+ ALLOCATE(XVFRC_PAST(0,0,0))
+END IF
!
IF (KMI == 1) THEN
IF ( LFORCING ) THEN
@@ -1515,15 +1666,6 @@ IF (KMI == 1) THEN
ALLOCATE(XTENDUFRC(0,0))
ALLOCATE(XTENDVFRC(0,0))
END IF
- IF ( LFORCING ) THEN
- ALLOCATE(XWTFRC(IIU,IJU,IKU))
- ALLOCATE(XUFRC_PAST(IIU,IJU,IKU)) ; XUFRC_PAST = XUNDEF
- ALLOCATE(XVFRC_PAST(IIU,IJU,IKU)) ; XVFRC_PAST = XUNDEF
- ELSE
- ALLOCATE(XWTFRC(0,0,0))
- ALLOCATE(XUFRC_PAST(0,0,0))
- ALLOCATE(XVFRC_PAST(0,0,0))
- END IF
ELSE
!Do not allocate because they are the same on all grids (not 'n' variables)
END IF
@@ -1652,12 +1794,21 @@ ENDIF
!* 4. INITIALIZE BUDGET VARIABLES
! ---------------------------
!
+gles = lles_mean .or. lles_resolved .or. lles_subgrid .or. lles_updraft &
+ .or. lles_downdraft .or. lles_spectra
+!Called if budgets are enabled via NAM_BUDGET
+!or if LES budgets are enabled via NAM_LES (condition on kmi==1 to call it max once)
+if ( ( cbutype /= "NONE" .and. nbumod == kmi ) .or. ( gles .and. kmi == 1 ) ) THEN
+ call Budget_preallocate()
+end if
+
IF ( CBUTYPE /= "NONE" .AND. NBUMOD == KMI ) THEN
- CALL INI_BUDGET(ILUOUT,XTSTEP,NSV,NRR, &
+ CALL Ini_budget(ILUOUT,XTSTEP,NSV,NRR, &
LNUMDIFU,LNUMDIFTH,LNUMDIFSV, &
LHORELAX_UVWTH,LHORELAX_RV, LHORELAX_RC,LHORELAX_RR, &
LHORELAX_RI,LHORELAX_RS,LHORELAX_RG, LHORELAX_RH,LHORELAX_TKE, &
- LHORELAX_SV,LVE_RELAX,LCHTRANS,LNUDGING,LDRAGTREE,LDEPOTREE, &
+ LHORELAX_SV, LVE_RELAX, LVE_RELAX_GRD, &
+ LCHTRANS,LNUDGING,LDRAGTREE,LDEPOTREE,LMAIN_EOL, &
CRAD,CDCONV,CSCONV,CTURB,CTURBDIM,CCLOUD )
END IF
!
@@ -1734,8 +1885,8 @@ NDT_2_WAY(KMI)=4
!
IF ( LUSECHEM .OR. LCHEMDIAG ) THEN
IF ((KMI==1).AND.(CPROGRAM == "MESONH".OR.CPROGRAM == "DIAG ")) &
- CALL CH_INIT_JVALUES(TDTCUR%TDATE%DAY, TDTCUR%TDATE%MONTH, &
- TDTCUR%TDATE%YEAR, ILUOUT, XCH_TUV_DOBNEW)
+ CALL CH_INIT_JVALUES(TDTCUR%nday, TDTCUR%nmonth, &
+ TDTCUR%nyear, ILUOUT, XCH_TUV_DOBNEW)
!
IF (LORILAM) THEN
CALL CH_AER_MOD_INIT
@@ -1752,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(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, &
@@ -1775,7 +1927,10 @@ CALL READ_FIELD(TPINIFILE,IIU,IJU,IKU, &
NADVFRC,TDTADVFRC,XDTHFRC,XDRVFRC, &
NRELFRC,TDTRELFRC,XTHREL,XRVREL, &
XVTH_FLUX_M,XWTH_FLUX_M,XVU_FLUX_M, &
- XRUS_PRES,XRVS_PRES,XRWS_PRES,XRTHS_CLD,XRRS_CLD,XRSVS_CLD )
+ XRUS_PRES,XRVS_PRES,XRWS_PRES,XRTHS_CLD,XRRS_CLD,XRSVS_CLD, &
+ ZIBM_LS,XIBM_XMUT,XUMEANW,XVMEANW,XWMEANW,XUMEANN,XVMEANN, &
+ XWMEANN,XUMEANE,XVMEANE,XWMEANE,XUMEANS,XVMEANS,XWMEANS )
+
!
!-------------------------------------------------------------------------------
!
@@ -2067,6 +2222,13 @@ CALL INI_DYNAMICS(XLON,XLAT,XRHODJ,XTHVREF,XMAP,XZZ,XDXHAT,XDYHAT, &
IF (LDRAG) THEN
CALL INI_DRAG(LMOUNT,XZS,XHSTART,NSTART,XDRAG)
ENDIF
+!* 16.2 Initialize the LevelSet function
+! -------------
+IF (LIBM) THEN
+ ALLOCATE(XIBM_LS(IIU,IJU,IKU,4)) ; XIBM_LS = -XIBM_IEPS
+ XIBM_LS(:,:,:,1)=ZIBM_LS(:,:,:)
+ DEALLOCATE(ZIBM_LS)
+ENDIF
!-------------------------------------------------------------------------------
!
!* 17. SURFACE FIELDS
@@ -2141,10 +2303,14 @@ ALLOCATE(ZSCA_ALB(IIU,IJU,NSWB_MNH))
ALLOCATE(ZEMIS (IIU,IJU,NLWB_MNH))
ALLOCATE(ZTSRAD (IIU,IJU))
!
-IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=6) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
- CALL IO_Field_read(TPINIFILE,'SURF',CSURF)
+IF (LCOUPLES.AND.(KMI>1))THEN
+ CSURF ="NONE"
ELSE
- CSURF = "EXTE"
+ IF ((TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)>=6) .OR. TPINIFILE%NMNHVERSION(1)>4) THEN
+ CALL IO_Field_read(TPINIFILE,'SURF',CSURF)
+ ELSE
+ CSURF = "EXTE"
+ END IF
END IF
!
!
@@ -2252,14 +2418,14 @@ IF (CRAD == 'ECMW') THEN
ZBARE(:,:) = 0.
END IF
!
- IF ( CAOP=='EXPL' .AND. LDUST ) THEN
+ IF ( CAOP=='EXPL' .AND. LDUST .AND. KMI==1) THEN
ALLOCATE( XEXT_COEFF_WVL_LKT_DUST( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
ALLOCATE( XEXT_COEFF_550_LKT_DUST( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST ) )
ALLOCATE( XPIZA_LKT_DUST ( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
ALLOCATE( XCGA_LKT_DUST ( NMAX_RADIUS_LKT_DUST, NMAX_SIGMA_LKT_DUST, NMAX_WVL_SW_DUST ) )
END IF
!
- IF ( CAOP=='EXPL' .AND. LSALT ) THEN
+ IF ( CAOP=='EXPL' .AND. LSALT .AND. KMI==1) THEN
ALLOCATE( XEXT_COEFF_WVL_LKT_SALT( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT, NMAX_WVL_SW_SALT ) )
ALLOCATE( XEXT_COEFF_550_LKT_SALT( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT ) )
ALLOCATE( XPIZA_LKT_SALT ( NMAX_RADIUS_LKT_SALT, NMAX_SIGMA_LKT_SALT, NMAX_WVL_SW_SALT ) )
@@ -2397,18 +2563,18 @@ CALL INI_AIRCRAFT_BALLOON(TPINIFILE,XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
!* 24. STATION initializations
! -----------------------
!
-CALL INI_SURFSTATION_n(XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
- CTURB=="TKEL" , &
- XLATORI, XLONORI )
+CALL INI_SURFSTATION_n(XTSTEP, XSEGLEN, NRR, NSV, &
+ CTURB=="TKEL" , KMI, &
+ XLATORI, XLONORI )
!
!-------------------------------------------------------------------------------
!
!* 25. PROFILER initializations
! ------------------------
!
-CALL INI_POSPROFILER_n(XTSTEP, TDTSEG, XSEGLEN, NRR, NSV, &
- CTURB=="TKEL", &
- XLATORI, XLONORI )
+CALL INI_POSPROFILER_n(XTSTEP, XSEGLEN, NRR, NSV, &
+ CTURB=="TKEL", &
+ XLATORI, XLONORI )
!
!-------------------------------------------------------------------------------
!
@@ -2446,7 +2612,7 @@ ENDIF
!------------------------------------
IF ( LFOREFIRE ) THEN
CALL INIT_FOREFIRE_n(KMI, ILUOUT, IP &
- , TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, TDTCUR%TDATE%DAY, TDTCUR%TIME, XTSTEP)
+ , TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, XTSTEP)
END IF
#endif
@@ -2494,6 +2660,38 @@ IF (LCHEMDIAG) THEN
ELSE
ALLOCATE(XTCHEM(0))
END IF
-
+!-------------------------------------------------------------------------------
+!
+!* 32. Wind turbine
+!
+IF (LMAIN_EOL .AND. KMI == NMODEL_EOL) THEN
+ ALLOCATE(XFX_RG(IIU,IJU,IKU))
+ ALLOCATE(XFY_RG(IIU,IJU,IKU))
+ ALLOCATE(XFZ_RG(IIU,IJU,IKU))
+ ALLOCATE(XFX_SMR_RG(IIU,IJU,IKU))
+ ALLOCATE(XFY_SMR_RG(IIU,IJU,IKU))
+ ALLOCATE(XFZ_SMR_RG(IIU,IJU,IKU))
+ SELECT CASE(CMETH_EOL)
+ CASE('ADNR')
+ CALL INI_EOL_ADNR
+ CASE('ALM')
+ CALL INI_EOL_ALM(XDXX,XDYY)
+ END SELECT
+END IF
+!
+!* 33. Auto-coupling Atmos-Ocean LES NH
+!
+IF (LCOUPLES) THEN
+ ALLOCATE(XSSUFL_C(IIU,IJU,1)); XSSUFL_C=0.0
+ ALLOCATE(XSSVFL_C(IIU,IJU,1)); XSSVFL_C=0.0
+ ALLOCATE(XSSTFL_C(IIU,IJU,1)); XSSTFL_C=0.0
+ ALLOCATE(XSSRFL_C(IIU,IJU,1)); XSSRFL_C=0.
+ELSE
+ ALLOCATE(XSSUFL_C(0,0,0))
+ ALLOCATE(XSSVFL_C(0,0,0))
+ ALLOCATE(XSSTFL_C(0,0,0))
+ ALLOCATE(XSSRFL_C(0,0,0))
+END IF
+!
END SUBROUTINE INI_MODEL_n
diff --git a/src/MNH/ini_nsv.f90 b/src/MNH/ini_nsv.f90
index 5299ffb8a121bb2f46dfe188c5c74197b17611c0..c49362598ed17e813c213a643ce5474e8711d5d1 100644
--- a/src/MNH/ini_nsv.f90
+++ b/src/MNH/ini_nsv.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ###################
MODULE MODI_INI_NSV
! ###################
@@ -64,46 +65,64 @@ END MODULE MODI_INI_NSV
!! J.escobar 04/08/2015 suit Pb with writ_lfin JSA increment , modif in ini_nsv to have good order initialization
!! Modification 01/2016 (JP Pinty) Add LIMA and LUSECHEM condition
!! Modification 07/2017 (V. Vionnet) Add blowing snow condition
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
+! 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
! ------------
!
-USE MODD_NSV
-USE MODD_ELEC_DESCR, ONLY : CELECNAMES
-USE MODD_CH_M9_n, ONLY : NEQ, NEQAQ
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM, LUSECHAQ, LUSECHIC, CCH_SCHEME, LCH_CONV_LINOX
-USE MODD_DIAG_FLAG,ONLY : LELECDIAG,LCHEMDIAG,LCHAQDIAG
-USE MODD_PARAM_n, ONLY : CCLOUD, CELEC
-USE MODD_DYN_n, ONLY : LHORELAX_SV,LHORELAX_SVC2R2,LHORELAX_SVC1R3, &
- LHORELAX_SVLIMA, &
- LHORELAX_SVELEC,LHORELAX_SVCHEM,LHORELAX_SVLG, &
- LHORELAX_SVDST,LHORELAX_SVAER, LHORELAX_SVSLT, &
- LHORELAX_SVPP,LHORELAX_SVCS, LHORELAX_SVCHIC, &
- LHORELAX_SVSNW
+USE MODD_BLOWSNOW, ONLY: CSNOWNAMES, LBLOWSNOW, NBLOWSNOW3D, YPSNOW_INI
+USE MODD_CH_AEROSOL, ONLY: CAERONAMES, CDEAERNAMES, JPMODE, LAERINIT, LDEPOS_AER, LORILAM, &
+ LVARSIGI, LVARSIGJ, NCARB, NM6_AER, NSOA, NSP
+USE MODD_CH_M9_n, ONLY: CICNAMES, CNAMES, NEQ, NEQAQ
+USE MODD_CH_MNHC_n, ONLY: LCH_PH, LUSECHEM, LUSECHAQ, LUSECHIC, CCH_SCHEME, LCH_CONV_LINOX
+USE MODD_CONDSAMP, ONLY: LCONDSAMP, NCONDSAMP
+USE MODD_CONF, ONLY: LLG, CPROGRAM, NVERB
+USE MODD_CST, ONLY: XMNH_TINY
+USE MODD_DIAG_FLAG, ONLY: LCHEMDIAG, LCHAQDIAG
+USE MODD_DUST, ONLY: CDEDSTNAMES, CDUSTNAMES, JPDUSTORDER, LDEPOS_DST, LDSTINIT, LDSTPRES, LDUST, &
+ LRGFIX_DST, LVARSIG, NMODE_DST, YPDEDST_INI, YPDUST_INI
+USE MODD_DYN_n, ONLY: LHORELAX_SV,LHORELAX_SVC2R2,LHORELAX_SVC1R3, &
+ LHORELAX_SVLIMA, &
+ LHORELAX_SVELEC,LHORELAX_SVCHEM,LHORELAX_SVLG, &
+ LHORELAX_SVDST,LHORELAX_SVAER, LHORELAX_SVSLT, &
+ LHORELAX_SVPP,LHORELAX_SVCS, LHORELAX_SVCHIC, &
+ LHORELAX_SVSNW
+#ifdef MNH_FOREFIRE
+USE MODD_DYN_n, ONLY: LHORELAX_SVFF
+#endif
+USE MODD_ELEC_DESCR, ONLY: LLNOX_EXPLICIT
+USE MODD_ELEC_DESCR, ONLY: CELECNAMES
#ifdef MNH_FOREFIRE
-USE MODD_DYN_n, ONLY : LHORELAX_SVFF
USE MODD_FOREFIRE
#endif
-USE MODD_CONF, ONLY : LLG, CPROGRAM
-USE MODD_LG
-USE MODD_DUST
-USE MODD_SALT
-USE MODD_PASPOL
-USE MODD_BLOWSNOW
-USE MODD_CONDSAMP
-USE MODD_CH_AEROSOL
-USE MODD_PREP_REAL, ONLY: XT_LS
-USE MODD_ELEC_DESCR, ONLY : LLNOX_EXPLICIT
-USE MODD_PARAM_C2R2, ONLY : LSUPSAT
-!
-USE MODD_PARAM_LIMA, ONLY: NMOD_CCN, LSCAV, LAERO_MASS, &
- NMOD_IFN, NMOD_IMM, LHHONI, &
- LWARM, LCOLD, LRAIN
-!
-USE MODI_UPDATE_NSV
-USE MODD_CST, ONLY : XMNH_TINY
+USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
+USE MODD_LG, ONLY: CLGNAMES, XLG1MIN, XLG2MIN, XLG3MIN
+USE MODD_LUNIT_n, ONLY: TLUOUT
+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, 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
+USE MODD_PASPOL, ONLY: LPASPOL, NRELEASE
+USE MODD_PREP_REAL, ONLY: XT_LS
+USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
+USE MODD_SALT, ONLY: CSALTNAMES, CDESLTNAMES, JPSALTORDER, &
+ LRGFIX_SLT, LSALT, LSLTINIT, LSLTPRES, LDEPOS_SLT, LVARSIG_SLT, NMODE_SLT, YPDESLT_INI, YPSALT_INI
+
+USE MODE_MSG
+
+USE MODI_CH_AER_INIT_SOA, ONLY: CH_AER_INIT_SOA
+USE MODI_CH_INIT_SCHEME_n, ONLY: CH_INIT_SCHEME_n
+USE MODI_UPDATE_NSV, ONLY: UPDATE_NSV
!
IMPLICIT NONE
!
@@ -115,11 +134,19 @@ INTEGER, INTENT(IN) :: KMI ! model index
!
!* 0.2 Declarations of local variables
!
+CHARACTER(LEN=2) :: YNUM2
+CHARACTER(LEN=3) :: YNUM3
+INTEGER :: ILUOUT
INTEGER :: ISV ! total number of scalar variables
+INTEGER :: IMODEIDX, IMOMENTS
+INTEGER :: JI, JJ, JSV
+INTEGER :: JMODE, JMOM, JSV_NAME
!
!-------------------------------------------------------------------------------
!
-LINI_NSV = .TRUE.
+LINI_NSV = .TRUE.
+
+ILUOUT = TLUOUT%NLU
!
! Users scalar variables are first considered
!
@@ -206,11 +233,33 @@ IF (CCLOUD == 'LIMA' ) THEN
NSV_LIMA_IMM_NUCL_A(KMI) = ISV
ISV = ISV + MAX(1,NMOD_IMM)
END IF
+
+ IF ( NMOD_IFN > 0 ) THEN
+ IF ( .NOT. ALLOCATED( NIMM ) ) ALLOCATE( NIMM(NMOD_CCN) )
+ NIMM(:) = 0
+ IF ( ALLOCATED( NINDICE_CCN_IMM ) ) DEALLOCATE( NINDICE_CCN_IMM )
+ ALLOCATE( NINDICE_CCN_IMM(MAX( 1, NMOD_IMM )) )
+ IF (NMOD_IMM > 0 ) THEN
+ DO JI = 0, NMOD_IMM - 1
+ NIMM(NMOD_CCN - JI) = 1
+ NINDICE_CCN_IMM(NMOD_IMM - JI) = NMOD_CCN - JI
+ END DO
+! ELSE IF (NMOD_IMM == 0) THEN ! PNIS exists but is 0 for the call to resolved_cloud
+! NMOD_IMM = 1
+! NINDICE_CCN_IMM(1) = 0
+ END IF
+ END IF
+
! Homogeneous freezing of CCN
IF (LCOLD .AND. LHHONI) 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
!
@@ -323,6 +372,11 @@ END IF
!
! scalar variables used in chemical core system
!
+IF (LUSECHEM) THEN
+ CALL CH_INIT_SCHEME_n(KMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT,NVERB)
+ IF (LORILAM) CALL CH_AER_INIT_SOA(ILUOUT, NVERB)
+END IF
+
IF (LUSECHEM .AND.(NEQ .GT. 0)) THEN
NSV_CHEM_A(KMI) = NEQ
NSV_CHEMBEG_A(KMI)= ISV+1
@@ -625,5 +679,215 @@ IF (LLG) THEN
CSV(NSV_LGBEG_A(KMI)+1) = 'Y0 '
CSV(NSV_LGEND_A(KMI) ) = 'Z0 '
ENDIF
-!
+
+! Initialize scalar variable names for dust
+IF ( LDUST ) THEN
+ IF ( NMODE_DST < 1 .OR. NMODE_DST > 3 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_DST must in the 1 to 3 interval' )
+
+ ! Initialization of dust names
+ IF( .NOT. ALLOCATED( CDUSTNAMES ) ) THEN
+ IMOMENTS = ( NSV_DSTEND_A(KMI) - NSV_DSTBEG_A(KMI) + 1 ) / NMODE_DST
+ ALLOCATE( CDUSTNAMES(IMOMENTS * NMODE_DST) )
+ !Loop on all dust modes
+ IF ( IMOMENTS == 1 ) THEN
+ DO JMODE = 1, NMODE_DST
+ IMODEIDX = JPDUSTORDER(JMODE)
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2
+ CDUSTNAMES(JMODE) = YPDUST_INI(JSV_NAME)
+ END DO
+ ELSE
+ DO JMODE = 1,NMODE_DST
+ !Find which mode we are dealing with
+ IMODEIDX = JPDUSTORDER(JMODE)
+ DO JMOM = 1, IMOMENTS
+ !Find which number this is of the list of scalars
+ JSV = ( JMODE - 1 ) * IMOMENTS + JMOM
+ !Find what name this corresponds to, always 3 moments assumed in YPDUST_INI
+ JSV_NAME = ( IMODEIDX - 1) * 3 + JMOM
+ !Get the right CDUSTNAMES which should follow the list of scalars transported in XSVM/XSVT
+ CDUSTNAMES(JSV) = YPDUST_INI(JSV_NAME)
+ ENDDO ! Loop on moments
+ ENDDO ! Loop on dust modes
+ END IF
+ END IF
+
+ ! Initialization of deposition scheme names
+ IF ( LDEPOS_DST(KMI) ) THEN
+ IF( .NOT. ALLOCATED( CDEDSTNAMES ) ) THEN
+ ALLOCATE( CDEDSTNAMES(NMODE_DST * 2) )
+ DO JMODE = 1, NMODE_DST
+ IMODEIDX = JPDUSTORDER(JMODE)
+ CDEDSTNAMES(JMODE) = YPDEDST_INI(IMODEIDX)
+ CDEDSTNAMES(NMODE_DST + JMODE) = YPDEDST_INI(NMODE_DST + IMODEIDX)
+ ENDDO
+ END IF
+ END IF
+END IF
+
+! Initialize scalar variable names for salt
+IF ( LSALT ) THEN
+ IF ( NMODE_SLT < 1 .OR. NMODE_SLT > 5 ) CALL Print_msg( NVERB_FATAL, 'GEN', 'INI_NSV', 'NMODE_SLT must in the 1 to 5 interval' )
+
+ IF( .NOT. ALLOCATED( CSALTNAMES ) ) THEN
+ IMOMENTS = ( NSV_SLTEND_A(KMI) - NSV_SLTBEG_A(KMI) + 1 ) / NMODE_SLT
+ ALLOCATE( CSALTNAMES(IMOMENTS * NMODE_SLT) )
+ !Loop on all dust modes
+ IF ( IMOMENTS == 1 ) THEN
+ DO JMODE = 1, NMODE_SLT
+ IMODEIDX = JPSALTORDER(JMODE)
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + 2
+ CSALTNAMES(JMODE) = YPSALT_INI(JSV_NAME)
+ END DO
+ ELSE
+ DO JMODE = 1, NMODE_SLT
+ !Find which mode we are dealing with
+ IMODEIDX = JPSALTORDER(JMODE)
+ DO JMOM = 1, IMOMENTS
+ !Find which number this is of the list of scalars
+ JSV = ( JMODE - 1 ) * IMOMENTS + JMOM
+ !Find what name this corresponds to, always 3 moments assumed in YPSALT_INI
+ JSV_NAME = ( IMODEIDX - 1 ) * 3 + JMOM
+ !Get the right CSALTNAMES which should follow the list of scalars transported in XSVM/XSVT
+ CSALTNAMES(JSV) = YPSALT_INI(JSV_NAME)
+ ENDDO ! Loop on moments
+ ENDDO ! Loop on dust modes
+ END IF
+ END IF
+ ! Initialization of deposition scheme
+ IF ( LDEPOS_SLT(KMI) ) THEN
+ IF( .NOT. ALLOCATED( CDESLTNAMES ) ) THEN
+ ALLOCATE( CDESLTNAMES(NMODE_SLT * 2) )
+ DO JMODE = 1, NMODE_SLT
+ IMODEIDX = JPSALTORDER(JMODE)
+ CDESLTNAMES(JMODE) = YPDESLT_INI(IMODEIDX)
+ CDESLTNAMES(NMODE_SLT + JMODE) = YPDESLT_INI(NMODE_SLT + IMODEIDX)
+ ENDDO
+ ENDIF
+ ENDIF
+END IF
+
+! Initialize scalar variable names for snow
+IF ( LBLOWSNOW ) THEN
+ IF( .NOT. ALLOCATED( CSNOWNAMES ) ) THEN
+ IMOMENTS = ( NSV_SNWEND_A(KMI) - NSV_SNWBEG_A(KMI) + 1 )
+ ALLOCATE( CSNOWNAMES(IMOMENTS) )
+ DO JMOM = 1, IMOMENTS
+ CSNOWNAMES(JMOM) = YPSNOW_INI(JMOM)
+ ENDDO ! Loop on moments
+ END IF
+END IF
+
+!Fill CSVNAMES_A for model KMI
+DO JSV = 1, NSV_USER_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV
+ CSVNAMES_A(JSV,KMI) = 'SVUSER'//YNUM3
+END DO
+
+DO JSV = NSV_C2R2BEG_A(KMI), NSV_C2R2END_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( C2R2NAMES(JSV-NSV_C2R2BEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_C1R3BEG_A(KMI), NSV_C1R3END_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( C1R3NAMES(JSV-NSV_C1R3BEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_LIMA_BEG_A(KMI), NSV_LIMA_END_A(KMI)
+ IF ( JSV == NSV_LIMA_NC_A(KMI) ) THEN
+ CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_WARM_NAMES(1) )
+ ELSE IF ( JSV == NSV_LIMA_NR_A(KMI) ) THEN
+ CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_WARM_NAMES(2) )
+ ELSE IF ( JSV >= NSV_LIMA_CCN_FREE_A(KMI) .AND. JSV < NSV_LIMA_CCN_ACTI_A(KMI) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_FREE_A(KMI) + 1
+ CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_WARM_NAMES(3) ) // YNUM2
+ ELSE IF (JSV >= NSV_LIMA_CCN_ACTI_A(KMI) .AND. JSV < ( NSV_LIMA_CCN_ACTI_A(KMI) + NMOD_CCN ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_CCN_ACTI_A(KMI) + 1
+ CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_WARM_NAMES(4) ) // YNUM2
+ ELSE IF ( JSV == NSV_LIMA_SCAVMASS_A(KMI) ) THEN
+ CSVNAMES_A(JSV,KMI) = TRIM( CAERO_MASS(1) )
+ ELSE IF ( JSV == NSV_LIMA_NI_A(KMI) ) THEN
+ CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_COLD_NAMES(1) )
+ ELSE IF ( JSV >= NSV_LIMA_IFN_FREE_A(KMI) .AND. JSV < NSV_LIMA_IFN_NUCL_A(KMI) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_FREE_A(KMI) + 1
+ CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_COLD_NAMES(2) ) // YNUM2
+ ELSE IF ( JSV >= NSV_LIMA_IFN_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IFN_NUCL_A(KMI) + NMOD_IFN ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) JSV - NSV_LIMA_IFN_NUCL_A(KMI) + 1
+ CSVNAMES_A(JSV,KMI) = TRIM( CLIMA_COLD_NAMES(3) ) // YNUM2
+ ELSE IF ( JSV >= NSV_LIMA_IMM_NUCL_A(KMI) .AND. JSV < ( NSV_LIMA_IMM_NUCL_A(KMI) + NMOD_IMM ) ) THEN
+ WRITE( YNUM2, '( I2.2 )' ) NINDICE_CCN_IMM(JSV-NSV_LIMA_IMM_NUCL_A(KMI)+1)
+ 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
+END DO
+
+DO JSV = NSV_ELECBEG_A(KMI), NSV_ELECEND_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( CELECNAMES(JSV-NSV_ELECBEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_LGBEG_A(KMI), NSV_LGEND_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( CLGNAMES(JSV-NSV_LGBEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_PPBEG_A(KMI), NSV_PPEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_PPBEG_A(KMI)+1
+ CSVNAMES_A(JSV,KMI) = 'SVPP'//YNUM3
+END DO
+
+#ifdef MNH_FOREFIRE
+DO JSV = NSV_FFBEG_A(KMI), NSV_FFEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_FFBEG_A(KMI)+1
+ CSVNAMES_A(JSV,KMI) = 'SVFF'//YNUM3
+END DO
+#endif
+
+DO JSV = NSV_CSBEG_A(KMI), NSV_CSEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_CSBEG_A(KMI)
+ CSVNAMES_A(JSV,KMI) = 'SVCS'//YNUM3
+END DO
+
+DO JSV = NSV_CHEMBEG_A(KMI), NSV_CHEMEND_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( CNAMES(JSV-NSV_CHEMBEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_CHICBEG_A(KMI), NSV_CHICEND_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( CICNAMES(JSV-NSV_CHICBEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_AERBEG_A(KMI), NSV_AEREND_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( CAERONAMES(JSV-NSV_AERBEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_AERDEPBEG_A(KMI), NSV_AERDEPEND_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( CDEAERNAMES(JSV-NSV_AERDEPBEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_DSTBEG_A(KMI), NSV_DSTEND_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( CDUSTNAMES(JSV-NSV_DSTBEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_DSTDEPBEG_A(KMI), NSV_DSTDEPEND_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( CDEDSTNAMES(JSV-NSV_DSTDEPBEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_SLTBEG_A(KMI), NSV_SLTEND_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( CSALTNAMES(JSV-NSV_SLTBEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_SLTDEPBEG_A(KMI), NSV_SLTDEPEND_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( CDESLTNAMES(JSV-NSV_SLTDEPBEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_SNWBEG_A(KMI), NSV_SNWEND_A(KMI)
+ CSVNAMES_A(JSV,KMI) = TRIM( CSNOWNAMES(JSV-NSV_SNWBEG_A(KMI)+1) )
+END DO
+
+DO JSV = NSV_LNOXBEG_A(KMI), NSV_LNOXEND_A(KMI)
+ WRITE( YNUM3, '( I3.3 )' ) JSV-NSV_LNOXBEG_A(KMI)+1
+ CSVNAMES_A(JSV,KMI) = 'SVLNOX'//YNUM3
+END DO
+
END SUBROUTINE INI_NSV
diff --git a/src/MNH/ini_one_wayn.f90 b/src/MNH/ini_one_wayn.f90
index 582bcac1eedeaa9c95d03fcf22910247bccb5259..78e025b2a89dea147d8cac40f2124c1d7412ac72 100644
--- a/src/MNH/ini_one_wayn.f90
+++ b/src/MNH/ini_one_wayn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1999-2019 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.
@@ -85,11 +85,12 @@ SUBROUTINE INI_ONE_WAY_n(KDAD,KMI, &
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
!! B.VIE 2016 : LIMA
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 03/05/2019: restructuration of one_wayn and ini_one_wayn
-!
+! P. Wautelet 04/06/2020: correct call to Set_conc_lima + initialize ZCONCM
+! J-L Redelsperger 06/2021: add Ocean coupling
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -105,6 +106,7 @@ USE MODD_NSV, only: NSV_A, NSV_C1R3BEG_A, NSV_C1R3_A, NSV_C2R2BEG_A,
NSV_SLTBEG_A, NSV_SLTDEPBEG_A, NSV_SLTDEP_A, NSV_SLT_A, NSV_USER_A
USE MODD_PARAM_n, only: CCLOUD
+USE MODD_REF, ONLY: LCOUPLES
USE MODD_REF_n, only: XRHODJ, XRHODREF
!
use mode_bikhardt
@@ -112,10 +114,10 @@ use mode_ll, only: GET_CHILD_DIM_ll, GET_DIM_EXT_ll, GO_TOMODEL_ll,
LS_FORCING_ll, LWEST_ll, LEAST_ll, LNORTH_ll, LSOUTH_ll, &
SET_LSFIELD_1WAY_ll, UNSET_LSFIELD_1WAY_ll
USE MODE_MODELN_HANDLER, only: GOTO_MODEL
+USE MODE_SET_CONC_LIMA
!
USE MODI_SET_CHEMAQ_1WAY
USE MODI_SET_CONC_ICE_C1R3
-USE MODI_SET_CONC_LIMA
USE MODI_SET_CONC_RAIN_C2R2
!
!
@@ -182,6 +184,20 @@ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCHEMM ! chemical concentrations
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCHEMMI ! chemical ice phase concentrations
!-------------------------------------------------------------------------------
!
+IF (LCOUPLES) THEN
+ PLBXUM=0.
+ PLBXVM=0.
+ PLBXWM=0.
+ PLBXTHM=0.
+ PLBYTHM=0.
+ PLBXTKEM=0.
+ PLBYTKEM =0.
+ PLBXRM =0.
+ PLBYRM=0.
+ PLBXSVM =0.
+ PLBYSVM=0.
+RETURN
+ENDIF
!* 0. INITIALISATION
!
CALL GOTO_MODEL(KDAD)
@@ -346,12 +362,13 @@ ENDIF
IF (HCLOUD=="LIMA" ) THEN
IF (CCLOUD/="LIMA") THEN
ALLOCATE(ZCONCM(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),NSV_LIMA_A(KMI)))
+ ZCONCM(:, :, :, :) = 0.
IF (CCLOUD == "REVE") THEN
ZINIT_TYPE = "INI1"
ELSE
ZINIT_TYPE = "NONE"
END IF
- CALL SET_CONC_LIMA (ZINIT_TYPE,XRHODREF,XRT,ZCONCM)
+ CALL SET_CONC_LIMA (KMI,ZINIT_TYPE,XRHODREF,XRT,ZCONCM)
DO JSV=1,NSV_LIMA_A(KMI)
CALL SET_LSFIELD_1WAY_ll(ZCONCM(:,:,:,JSV),&
&ZTSVM(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
diff --git a/src/MNH/ini_posprofilern.f90 b/src/MNH/ini_posprofilern.f90
index 88b86c3cb78e86e51534a62597948d8cace76d03..08b25fba13d2dfdc78cdaf669b31ee81a1bdd62f 100644
--- a/src/MNH/ini_posprofilern.f90
+++ b/src/MNH/ini_posprofilern.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.
@@ -9,14 +9,11 @@ MODULE MODI_INI_POSPROFILER_n
!
INTERFACE
!
- SUBROUTINE INI_POSPROFILER_n(PTSTEP, TPDTSEG, PSEGLEN, &
+ SUBROUTINE INI_POSPROFILER_n(PTSTEP, PSEGLEN, &
KRR, KSV, OUSETKE, &
PLATOR, PLONOR )
!
-USE MODD_TYPE_DATE
-!
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG ! segment date and time
REAL, INTENT(IN) :: PSEGLEN ! segment length
INTEGER, INTENT(IN) :: KRR ! number of moist variables
INTEGER, INTENT(IN) :: KSV ! number of scalar variables
@@ -33,7 +30,7 @@ END INTERFACE
END MODULE MODI_INI_POSPROFILER_n
!
! ########################################################
- SUBROUTINE INI_POSPROFILER_n(PTSTEP, TPDTSEG, PSEGLEN, &
+ SUBROUTINE INI_POSPROFILER_n(PTSTEP, PSEGLEN, &
KRR, KSV, OUSETKE, &
PLATOR, PLONOR )
! ########################################################
@@ -67,6 +64,8 @@ END MODULE MODI_INI_POSPROFILER_n
!! P. Tulet 15/01/2002
!! 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 05/07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -81,7 +80,6 @@ USE MODD_PARAMETERS
USE MODD_PROFILER_n
USE MODD_RADIATIONS_n, ONLY: NAER
USE MODD_TYPE_PROFILER
-USE MODD_TYPE_DATE
!
USE MODE_GRIDPROJ
USE MODE_ll
@@ -96,7 +94,6 @@ IMPLICIT NONE
!
!
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG ! segment date and time
REAL, INTENT(IN) :: PSEGLEN ! segment length
INTEGER, INTENT(IN) :: KRR ! number of moist variables
INTEGER, INTENT(IN) :: KSV ! number of scalar variables
@@ -161,7 +158,7 @@ TYPE(PROFILER), INTENT(INOUT) :: TPROFILER
!
ISTORE = INT ( (PSEGLEN-XTSTEP) / TPROFILER%STEP ) + 1
!
-ALLOCATE(TPROFILER%TIME (ISTORE))
+allocate( tprofiler%tpdates( istore ) )
ALLOCATE(TPROFILER%ERROR (NUMBPROFILER))
ALLOCATE(TPROFILER%X (NUMBPROFILER))
ALLOCATE(TPROFILER%Y (NUMBPROFILER))
@@ -177,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))
@@ -186,7 +187,6 @@ IF (OUSETKE) THEN
ELSE
ALLOCATE(TPROFILER%TKE (0,IKU,0))
END IF
-ALLOCATE(TPROFILER%DATIME(16,ISTORE))
ALLOCATE(TPROFILER%T2M (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%Q2M (ISTORE,NUMBPROFILER))
ALLOCATE(TPROFILER%HU2M (ISTORE,NUMBPROFILER))
@@ -209,7 +209,6 @@ ALLOCATE(TPROFILER%TKE_DISS(ISTORE,IKU,NUMBPROFILER))
!
!
TPROFILER%ERROR= .FALSE.
-TPROFILER%TIME = XUNDEF
TPROFILER%ZON = XUNDEF
TPROFILER%MER = XUNDEF
TPROFILER%FF = XUNDEF
@@ -222,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_profilern.f90 b/src/MNH/ini_profilern.f90
index e2888785fae87aea3ef9fafaa34ee3e3a6f87d4b..598980099bb886c15140e56015a181624c94467f 100644
--- a/src/MNH/ini_profilern.f90
+++ b/src/MNH/ini_profilern.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 profiler 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #######################
SUBROUTINE INI_PROFILER_n
! #######################
@@ -72,10 +67,12 @@
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PROFILER_n
+use modd_conf, only: lcartesian
USE MODD_PARAMETERS
-!
-!
+USE MODD_PROFILER_n
+
+use mode_msg
+
IMPLICIT NONE
!
!
@@ -92,7 +89,10 @@ IMPLICIT NONE
!* 1. Nameliste
! ---------
NUMBPROFILER = 0
-!
+
+if ( numbprofiler > 0 .and. lcartesian ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'INI_PROFILER_n', 'profilers are not available if LCARTESIAN=T' )
+
IF (NUMBPROFILER > 0) THEN
ALLOCATE(TPROFILER%LAT (NUMBPROFILER))
ALLOCATE(TPROFILER%LON (NUMBPROFILER))
diff --git a/src/MNH/ini_prog_var.f90 b/src/MNH/ini_prog_var.f90
index 7f9e33802c3d1f812783407aba724084078871ac..1f099672e93eb078161e9b0a29070dfb7e01f295 100644
--- a/src/MNH/ini_prog_var.f90
+++ b/src/MNH/ini_prog_var.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.
@@ -95,6 +95,10 @@ END MODULE MODI_INI_PROG_VAR
!! 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
+! P. Wautelet 09/03/2021: simplify allocation of scalar variable names
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
+! P. Wautelet 10/03/2021: use scalar variable names for dust and salt
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -109,6 +113,7 @@ USE MODD_CONF_n
USE MODD_DIM_n
USE MODD_DUST
USE MODD_DYN_n
+use modd_field, only: TFIELDDATA, TYPEREAL
USE MODD_FIELD_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LSFIELD_n
@@ -120,7 +125,6 @@ USE MODD_PARAMETERS
USE MODD_SALT
USE MODD_TURB_n
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
@@ -129,8 +133,6 @@ USE MODE_MSG
USE MODE_POS
use mode_tools_ll, only: GET_INDICE_ll
!
-USE MODI_CH_AER_INIT_SOA
-USE MODI_CH_INIT_SCHEME_n
USE MODI_PGDFILTER
!
USE MODN_CH_ORILAM
@@ -246,10 +248,7 @@ IF(PRESENT(HCHEMFILE)) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR','')
END IF ! IIMAX
-! check nsv to be read
IF (.NOT.LDUST) THEN
- ! Always initialize chemical scheme variables before INI_NSV call !
- CALL CH_INIT_SCHEME_n(IMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT,NVERB)
LUSECHEM = .TRUE.
END IF
IF (LORILAM) THEN
@@ -269,7 +268,7 @@ IF(PRESENT(HCHEMFILE)) THEN
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_SALT)
! initialise NSV_* variables
ENDIF
- CALL INI_NSV(1)
+ CALL INI_NSV(IMI)
ALLOCATE(XSVT(IIU,IJU,IKU,NSV))
! Read scalars in chem file
@@ -299,8 +298,6 @@ IF(PRESENT(HCHEMFILE)) THEN
END IF
IF (LORILAM) THEN
- CALL CH_AER_INIT_SOA(ILUOUT,NVERB)
- !
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = 'XY'
@@ -321,11 +318,6 @@ IF(PRESENT(HCHEMFILE)) THEN
END DO ! JSV
!
IF (LDEPOS_AER(IMI)) THEN
- IF(.NOT.ALLOCATED(CDEAERNAMES)) THEN
- ALLOCATE(CDEAERNAMES(JPMODE*2))
- CDEAERNAMES(:) = YPDEAER_INI(:)
- ENDIF
- !
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = 'XY'
@@ -356,50 +348,17 @@ IF(PRESENT(HCHEMFILE)) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!
- IMOMENTS = INT(NSV_DSTEND - NSV_DSTBEG+1)/NMODE_DST
- IF (IMOMENTS == 1) THEN
- DO JMODE=1, NMODE_DST
- !Index from which names are picked
- ISV_NAME_IDX = (JPDUSTORDER(JMODE) - 1)*3 + 2
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + 1 & !Number of moments in this mode
- + (NSV_DSTBEG -1) !Previous list of tracers
- TZFIELD%CMNHNAME = TRIM(YPDUST_INI(ISV_NAME_IDX))//'T'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
- IF (IRESP/=0) THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR',TRIM(TZFIELD%CMNHNAME)//' not found in the CHEM file '//TRIM(HCHEMFILE))
- END IF !IRESP
- END DO !JMOD
- ELSE ! IMOMENTS diff 1
- DO JMODE=1,NMODE_DST
- DO JMOM=1,IMOMENTS
- ISV_NAME_IDX = (JPDUSTORDER(JMODE) - 1)*3 + JMOM
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + JMOM & !Number of moments in this mode
- + (NSV_DSTBEG -1) !Previous list of tracers
- TZFIELD%CMNHNAME = TRIM(YPDUST_INI(ISV_NAME_IDX))//'T'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
- IF (IRESP/=0) THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR',TRIM(TZFIELD%CMNHNAME)//&
- ' not found in the CHEM file '//TRIM(HCHEMFILE))
- END IF !IRESP
- END DO ! JMOM
- END DO !JMOD
- END IF !if IMOMENTS
+ DO JSV = NSV_DSTBEG, NSV_DSTEND
+ TZFIELD%CMNHNAME = TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'T'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
+ CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
+ IF (IRESP/=0) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR',TRIM(TZFIELD%CMNHNAME)//' not found in the CHEM file '//TRIM(HCHEMFILE))
+ END IF !IRESP
+ END DO ! JSV
+
IF (LDEPOS_DST(IMI)) THEN
- IF(.NOT.ALLOCATED(CDEDSTNAMES)) THEN
- ALLOCATE(CDEDSTNAMES(NMODE_DST*2))
- DO JMODE=1,NMODE_DST
- IMODEIDX=JPDUSTORDER(JMODE)
- CDEDSTNAMES(JMODE) = YPDEDST_INI(IMODEIDX)
- CDEDSTNAMES(NMODE_DST+JMODE) = YPDEDST_INI(NMODE_DST+IMODEIDX)
- ENDDO
- ENDIF
- !
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = 'XY'
@@ -430,50 +389,17 @@ IF(PRESENT(HCHEMFILE)) THEN
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .TRUE.
!
- IMOMENTS = INT(NSV_SLTEND - NSV_SLTBEG+1)/NMODE_SLT
- IF (IMOMENTS == 1) THEN
- DO JMODE=1, NMODE_SLT
- !Index from which names are picked
- ISV_NAME_IDX = (JPSALTORDER(JMODE) - 1)*3 + 2
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + 1 & !Number of moments in this mode
- + (NSV_SLTBEG -1) !Previous list of tracers
- TZFIELD%CMNHNAME = TRIM(YPSALT_INI(ISV_NAME_IDX))//'T'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
- IF (IRESP/=0) THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR',TRIM(TZFIELD%CMNHNAME)//' not found in the CHEM file '//TRIM(HCHEMFILE))
- END IF !IRESP
- END DO !JMOD
- ELSE ! IMOMENTS
- DO JMODE=1,NMODE_SLT
- DO JMOM=1,IMOMENTS
- ISV_NAME_IDX = (JPSALTORDER(JMODE) - 1)*3 + JMOM
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + JMOM & !Number of moments in this mode
- + (NSV_SLTBEG -1) !Previous list of tracers
- TZFIELD%CMNHNAME = TRIM(YPSALT_INI(ISV_NAME_IDX))//'T'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
- IF (IRESP/=0) THEN
- CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR',TRIM(TZFIELD%CMNHNAME)//' not found in the CHEM file '//TRIM(HCHEMFILE))
- END IF !IRESP
- END DO ! JMOM
- END DO !JMOD
- END IF !if IMOMENTS
+ DO JSV = NSV_SLTBEG, NSV_SLTEND
+ TZFIELD%CMNHNAME = TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))//'T'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
+ CALL IO_Field_read(TZCHEMFILE,TZFIELD,XSVT(:,:,:,JSV),IRESP)
+ IF (IRESP/=0) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','INI_PROG_VAR',TRIM(TZFIELD%CMNHNAME)//' not found in the CHEM file '//TRIM(HCHEMFILE))
+ END IF !IRESP
+ END DO ! JSV
!
IF (LDEPOS_SLT(IMI)) THEN
- IF(.NOT.ALLOCATED(CDESLTNAMES)) THEN
- ALLOCATE(CDESLTNAMES(NMODE_SLT*2))
- DO JMODE=1,NMODE_SLT
- IMODEIDX=JPDUSTORDER(JMODE)
- CDESLTNAMES(JMODE) = YPDESLT_INI(IMODEIDX)
- CDESLTNAMES(NMODE_SLT+JMODE) = YPDESLT_INI(NMODE_SLT+IMODEIDX)
- ENDDO
- ENDIF
- !
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'ppp'
TZFIELD%CDIR = 'XY'
diff --git a/src/MNH/ini_radiations.f90 b/src/MNH/ini_radiations.f90
index d05fc31f52d33570f14a188844102bc2235e15a8..883179c8b2dd82f38644f08aec0f048b9684bb41 100644
--- a/src/MNH/ini_radiations.f90
+++ b/src/MNH/ini_radiations.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2003-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -206,19 +206,19 @@ DO JI=1,11
IBIS(JI) = INOBIS(JI)+1
END DO
IF ( LFIX_DAT ) THEN ! Ajout PP
- IF( MOD(TPDTEXP%TDATE%YEAR,4).EQ.0 ) THEN
- ZDATE = REAL(TPDTEXP%TDATE%DAY + IBIS(TPDTEXP%TDATE%MONTH-1)) - 1
+ IF( MOD(TPDTEXP%nyear,4).EQ.0 ) THEN
+ ZDATE = REAL(TPDTEXP%nday + IBIS(TPDTEXP%nmonth-1)) - 1
ZAD = 2.0*XPI*ZDATE/366.0
ELSE
- ZDATE = REAL(TPDTEXP%TDATE%DAY + INOBIS(TPDTEXP%TDATE%MONTH-1)) - 1
+ ZDATE = REAL(TPDTEXP%nday + INOBIS(TPDTEXP%nmonth-1)) - 1
ZAD = 2.0*XPI*ZDATE/365.0
END IF
ELSE
- IF( MOD(TPDTCUR%TDATE%YEAR,4).EQ.0 ) THEN
- ZDATE = REAL(TPDTCUR%TDATE%DAY + IBIS(TPDTCUR%TDATE%MONTH-1)) - 1
+ IF( MOD(TPDTCUR%nyear,4).EQ.0 ) THEN
+ ZDATE = REAL(TPDTCUR%nday + IBIS(TPDTCUR%nmonth-1)) - 1
ZAD = 2.0*XPI*ZDATE/366.0
ELSE
- ZDATE = REAL(TPDTCUR%TDATE%DAY + INOBIS(TPDTCUR%TDATE%MONTH-1)) - 1
+ ZDATE = REAL(TPDTCUR%nday + INOBIS(TPDTCUR%nmonth-1)) - 1
ZAD = 2.0*XPI*ZDATE/365.0
END IF
END IF
diff --git a/src/MNH/ini_radiations_ecmwf.f90 b/src/MNH/ini_radiations_ecmwf.f90
index b7188358438cab4e72bbd722068802212d4110ab..e8f11de28487376225ce40d9803858ab0ba1308d 100644
--- a/src/MNH/ini_radiations_ecmwf.f90
+++ b/src/MNH/ini_radiations_ecmwf.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -337,7 +337,7 @@ ENDIF
! summer/winter dependency
!
IF (LFIX_DAT ) THEN ! Ajout PP
- IF( (TPDTEXP%TDATE%MONTH.GE.4).AND.(TPDTEXP%TDATE%MONTH.LE.9) ) THEN
+ IF( (TPDTEXP%nmonth.GE.4).AND.(TPDTEXP%nmonth.LE.9) ) THEN
GSUMMER = .TRUE.
GWINTER = .FALSE.
ELSE
@@ -345,7 +345,7 @@ IF (LFIX_DAT ) THEN ! Ajout PP
GWINTER = .TRUE.
END IF
ELSE
- IF( (TPDTCUR%TDATE%MONTH.GE.4).AND.(TPDTCUR%TDATE%MONTH.LE.9) ) THEN
+ IF( (TPDTCUR%nmonth.GE.4).AND.(TPDTCUR%nmonth.LE.9) ) THEN
GSUMMER = .TRUE.
GWINTER = .FALSE.
ELSE
@@ -518,11 +518,11 @@ END IF
ALLOCATE (ZOZON(KDLON,KFLEV))
!
IF (LFIX_DAT ) THEN ! Ajout PP
- ZYMD = TPDTEXP%TDATE%YEAR * 1E4 + TPDTEXP%TDATE%MONTH * 1E2 + TPDTEXP%TDATE%DAY
- ZHOURS = INT(TPDTEXP%TIME / 60.)
+ ZYMD = TPDTEXP%nyear * 1E4 + TPDTEXP%nmonth * 1E2 + TPDTEXP%nday
+ ZHOURS = INT(TPDTEXP%xtime / 60.)
ELSE
- ZYMD = TPDTCUR%TDATE%YEAR * 1E4 + TPDTCUR%TDATE%MONTH * 1E2 + TPDTCUR%TDATE%DAY
- ZHOURS = INT(TPDTCUR%TIME / 60.)
+ ZYMD = TPDTCUR%nyear * 1E4 + TPDTCUR%nmonth * 1E2 + TPDTCUR%nday
+ ZHOURS = INT(TPDTCUR%xtime / 60.)
END IF
!
! Fortuin langematz climatology loading
diff --git a/src/MNH/ini_radiations_ecrad.f90 b/src/MNH/ini_radiations_ecrad.f90
index 6b3fdd2f29a1ccbc12b22ffb546171d5948c1781..7c9349afeb1656c871411d9b57f8d9c34ffa569d 100644
--- a/src/MNH/ini_radiations_ecrad.f90
+++ b/src/MNH/ini_radiations_ecrad.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.
@@ -165,9 +165,14 @@ LCCNO = .FALSE. ! True if CCN over sea is diagnosed
! Constant cloud condensation nuclei over land and sea
! In ECMWF original code, those values were 900 and 150
+#if ( VER_ECRAD == 101 )
XCCNLND = 900_JPRB ! constant CCN over land in m-3 (needed for Martin et al., 1994 parameterization)
XCCNSEA = 50_JPRB ! constant CCN over sea in m-3
-
+#endif
+#if ( VER_ECRAD == 140 )
+XCCNLND = 900_JPRB ! constant CCN over land in cm-3 (needed for Martin et al., 1994 parameterization)
+XCCNSEA = 50_JPRB ! constant CCN over sea in cm-3 (IFS value, 150 originally in MNH)
+#endif
! NAERMACC is in the namelist
! NAERMACC = 0 -> Use of Tegen aerosol climatology
! NAERMACC = 1 -> Use of MACC aerosol classification
@@ -216,6 +221,12 @@ RCCFC12 = 484.E-12_JPRB
RCCFC22 = 0.E-12_JPRB
RCCCL4 = 0.E-12_JPRB
+#if ( VER_ECRAD == 140 )
+USER_ALB_DIFF(:) = 0.5
+USER_ALB_DIR(:) = 0
+USER_EMISS(:) = 1
+#endif
+
! Radiation computed every NRADFR timesteps
NRADFR = INT(XDTRAD/XTSTEP)
diff --git a/src/MNH/ini_segn.f90 b/src/MNH/ini_segn.f90
index 1011b72700764cd6c65d9bc1ab2d183a2248b905..590efa55c1c37baaab8c9a2ccf4e5eef8c4b2ad4 100644
--- a/src/MNH/ini_segn.f90
+++ b/src/MNH/ini_segn.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.
@@ -172,6 +172,7 @@ END MODULE MODI_INI_SEG_n
USE MODD_CONF
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODN_CONFZ
+USE MODD_DYN_n, ONLY : LOCEAN
USE MODD_DYN
USE MODD_IO, ONLY: NVERB_FATAL, NVERB_WARNING, TFILE_OUTPUTLISTING, TFILEDATA
USE MODD_LUNIT
@@ -180,7 +181,7 @@ USE MODD_PARAM_n, ONLY: CSURF
USE MODD_PARAMETERS
USE MODD_REF, ONLY: LBOUSS
!
-USE MODE_FIELD
+use mode_field, only: Fieldlist_nmodel_resize, Ini_field_list, Ini_field_scalars
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
USE MODE_IO, only: IO_Config_set
@@ -440,6 +441,9 @@ END IF
! routine which read related informations in the EXSEG descriptor in order to
! check coherence between both informations.
!
+CALL IO_Field_read(TPINIFILE,'LOCEAN',LOCEAN,IRESP)
+IF ( IRESP /= 0 ) LOCEAN = .FALSE.
+!
CALL READ_EXSEG_n(KMI,TZFILE_DES,YCONF,GFLAT,GUSERV,GUSERC, &
GUSERR,GUSERI,GUSECI,GUSERS,GUSERG,GUSERH,GUSECHEM, &
GUSECHAQ,GUSECHIC,GCH_PH, &
diff --git a/src/MNH/ini_seriesn.f90 b/src/MNH/ini_seriesn.f90
index cff938acec58cfe8b8f51d92758aafbd7d6db3ef..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.
@@ -42,30 +42,29 @@
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! 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
! --------------
!
-USE MODE_ll
-USE MODE_MSG
-USE MODE_MODELN_HANDLER
-!
-USE MODD_TIME ! Experiment and segment times (TDTEXP and TDTSEG)
USE MODD_CONF
-USE MODD_DYN, ONLY: XSEGLEN
+USE MODD_CONF_n, ONLY: LUSERV, LUSERC, LUSERR, LUSERI, LUSERS, LUSERG, LUSERH
+USE MODD_DIM_n, ONLY: NKMAX
+USE MODD_DYN, ONLY: XSEGLEN
+USE MODD_DYN_n, ONLY: XTSTEP, NSTOP
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_PARAMETERS
+USE MODD_PARAM_n, ONLY: CSURF
+USE MODD_PRECIP_n, ONLY: XINPRR, XINPRS, XINPRG
USE MODD_SERIES
USE MODD_SERIES_n
-USE MODD_PARAMETERS
-USE MODD_CONF_n, ONLY: LUSERV,LUSERC,LUSERR,LUSERI,LUSERS,LUSERG,LUSERH
-USE MODD_DIM_n, ONLY: NKMAX
-USE MODD_DYN_n, ONLY: XTSTEP,NSTOP
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAM_n, ONLY: CSURF
-USE MODD_PRECIP_n, ONLY: XINPRR,XINPRS,XINPRG
-USE MODD_TIME_n
-!
+!
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+USE MODE_MSG
+!
USE MODI_MNHGET_SURF_PARAM_n
!
IMPLICIT NONE
@@ -89,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
@@ -259,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) )
@@ -276,8 +279,7 @@ ALLOCATE( CSCOMMENT1 (NSTEMP_SERIE1) )
ALLOCATE( CSCOMMENT2 (NSTEMP_SERIE2) )
ALLOCATE( CSCOMMENT3 (NSTEMP_SERIE3) )
!
-ALLOCATE( XSTRAJT (NSNBSTEPT,1) )
-ALLOCATE( XSDATIME (16,NSNBSTEPT) )
+allocate( tpsdates( nsnbstept ) )
!
XSSERIES1(:,:,:,:,:,:)=0.
XSSERIES2(:,:,:,:,:,:)=0.
@@ -306,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
! -----------------
@@ -321,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
@@ -360,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
!
@@ -386,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
!
@@ -473,17 +479,4 @@ end if
!
NSCOUNTD=0 ! Counting the nb of temporal series outputs
!
-XSDATIME( 1,:)= TDTEXP%TDATE%YEAR
-XSDATIME( 2,:)= TDTEXP%TDATE%MONTH
-XSDATIME( 3,:)= TDTEXP%TDATE%DAY
-XSDATIME( 4,:)= TDTEXP%TIME
-XSDATIME( 5,:)= TDTSEG%TDATE%YEAR
-XSDATIME( 6,:)= TDTSEG%TDATE%MONTH
-XSDATIME( 7,:)= TDTSEG%TDATE%DAY
-XSDATIME( 8,:)= TDTSEG%TIME
-XSDATIME( 9,:)= TDTMOD%TDATE%YEAR
-XSDATIME(10,:)= TDTMOD%TDATE%MONTH
-XSDATIME(11,:)= TDTMOD%TDATE%DAY
-XSDATIME(12,:)= TDTMOD%TIME
-!
END SUBROUTINE INI_SERIES_n
diff --git a/src/MNH/ini_size_spawn.f90 b/src/MNH/ini_size_spawn.f90
index ee52cc7b68825da6ae3270e567c7a01007378490..0de2efdb4672b8e4e1402330d51dea5d6b759cb4 100644
--- a/src/MNH/ini_size_spawn.f90
+++ b/src/MNH/ini_size_spawn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1999-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1999-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -78,6 +78,7 @@ END MODULE MODI_INI_SIZE_SPAWN
USE MODD_CONF
USE MODD_DIM_n, ONLY: DIM_MODEL
USE MODD_DYN_n, ONLY: CPRESOPT, NITR
+use modd_field, only: tfielddata, tfieldlist
USE MODD_GRID
USE MODD_GRID_n
USE MODD_IO, ONLY: ISNPROC, ISP, TFILEDATA
@@ -89,7 +90,7 @@ USE MODD_PGDGRID
USE MODD_SPAWN
USE MODD_VAR_ll, ONLY: YSPLITTING
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_GRIDPROJ
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
diff --git a/src/MNH/ini_sizen.f90 b/src/MNH/ini_sizen.f90
index 5e21aeeaffa449c582206864c825cfdfaaa846be..4e3425cafeeeb374775f907d85bbfc2296886997 100644
--- a/src/MNH/ini_sizen.f90
+++ b/src/MNH/ini_sizen.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -112,6 +112,7 @@ USE MODD_LUNIT_n, ONLY: CINIFILE, CINIFILEPGD, TLUOUT
USE MODD_NESTING, ONLY: CMY_NAME, CDAD_NAME, NDAD, NDXRATIO_ALL, NDYRATIO_ALL, &
NXOR_ALL, NYOR_ALL, NXEND_ALL,NYEND_ALL
USE MODD_PARAMETERS, ONLY: JPMODELMAX, JPHEXT,JPVEXT
+USE MODD_REF, ONLY: LCOUPLES
!
USE MODE_IO, ONLY: IO_Pack_set
USE MODE_IO_FIELD_READ, only: IO_Field_read
@@ -164,6 +165,12 @@ IF (IRESP /= 0) THEN
END IF
!
IF ( KMI > 1 ) THEN
+ IF ( LCOUPLES ) THEN
+ IF ( KMI == 2 ) THEN
+ CMY_NAME(NDAD(KMI)) = CDAD_NAME(KMI)
+ WRITE(UNIT=ILUOUT,FMT=*) 'NDAD',NDAD(KMI),'changed in '//TRIM(CMY_NAME(NDAD(KMI)))//TRIM(CDAD_NAME(KMI)),KMI
+ END IF
+ END IF
IF ( TRIM(CDAD_NAME(KMI)) /= TRIM(CMY_NAME(NDAD(KMI))) ) THEN
WRITE(UNIT=ILUOUT,FMT=9005) NDAD(KMI)
WRITE(ILUOUT,FMT=*) ' THE INITIAL FM-File IS NOT CONSISTANT WITH THE ONE OF THE DAD MODEL!'
diff --git a/src/MNH/ini_spectren.f90 b/src/MNH/ini_spectren.f90
index 1d6bc3eefe6e98c6b53edb1a4346b1c613ed793b..1067f2ceffdbf2de2b8de02dcf94039a76a01378 100644
--- a/src/MNH/ini_spectren.f90
+++ b/src/MNH/ini_spectren.f90
@@ -58,7 +58,7 @@ USE MODD_CTURB
USE MODD_CURVCOR_n
USE MODD_DEEP_CONVECTION_n
USE MODD_DIM_n
-USE MODD_DRAGTREE
+USE MODD_DRAGTREE_n
USE MODD_DUST
USE MODD_DYN
USE MODD_DYN_n
diff --git a/src/MNH/ini_stationn.f90 b/src/MNH/ini_stationn.f90
index ea90fed1e128870ed60fac373163ea75c2fe674d..8bfe8866f73bfc3c855b971514bfb88027409cff 100644
--- a/src/MNH/ini_stationn.f90
+++ b/src/MNH/ini_stationn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 profiler 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #######################
SUBROUTINE INI_STATION_n
! #######################
@@ -22,7 +17,7 @@
!!** METHOD
!! ------
!!
-!! Must be defined (for each aircraft):
+!! Must be defined (for each station):
!! ---------------
!!
!! No default exist for these variables.
@@ -37,7 +32,7 @@
!!
!!
!!
-!! Can be defined (for each aircraft):
+!! Can be defined (for each station):
!! --------------
!!
!!
@@ -64,15 +59,19 @@
!! MODIFICATIONS
!! -------------
!! Original 15/01/2002
+!! Modification: 02/2021 (E.Jezequel) Read stations from CVS file
!!
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_STATION_n
+USE MODD_ALLSTATION_n
+USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_PARAMETERS
!
+USE MODI_STATION_READER
+!
!
IMPLICIT NONE
!
@@ -84,68 +83,62 @@ IMPLICIT NONE
!
! 0.2 declaration of local variables
!
+INTEGER :: JI
!
!----------------------------------------------------------------------------
!
!* 1. Nameliste
! ---------
-NUMBSTAT = 0
-!
-IF (NUMBSTAT > 0) THEN
-ALLOCATE (TSTATION%LAT(NUMBSTAT))
-ALLOCATE (TSTATION%LON(NUMBSTAT))
-ALLOCATE (TSTATION%I(NUMBSTAT))
-ALLOCATE (TSTATION%J(NUMBSTAT))
-ALLOCATE (TSTATION%Z(NUMBSTAT))
-ALLOCATE (TSTATION%K(NUMBSTAT))
-ALLOCATE (TSTATION%NAME(NUMBSTAT))
-ALLOCATE (TSTATION%TYPE(NUMBSTAT))
-!
-TSTATION%LON = XUNDEF
-TSTATION%LAT = XUNDEF
-TSTATION%Z = XUNDEF
-TSTATION%K = XUNDEF
-TSTATION%I = XUNDEF
-TSTATION%J = XUNDEF
-TSTATION%NAME = " "
-TSTATION%TYPE = " "
-!
-TSTATION%STEP = 10.
-!
-!* location (latitude, longitude, altitude)
-!
-!***************************************************************
-! * Horizontal location
-! You have to choose between (TSTATION%LAT,TSTATION%LON)
-! or (TSTATION%I,TSTATION%J) for all the stations
-! if both are defined it will choose (TSTATION%LAT,TSTATION%LON)
-!***************************************************************
-!
-!TSTATION%LAT = (/ 45.0 /)
-!TSTATION%LON = (/ 4.5 /)
-TSTATION%I = (/ 25 /)
-TSTATION%J = (/ 20 /)
-!
-!***************************************************************
-! * Vertical location
-! You have to choose between TSTATION%K and TSTATION%Z
-! for all the stations
-! if both are defined it will choose TSTATION%K
-!***************************************************************
-!TSTATION%Z = (/ 10., 500. /)
-!
-TSTATION%K = (/ 10 /)
-!
-!***************************************************************
-!* station name
-!***************************************************************
-TSTATION%NAME = (/ 'BIDON' /)
-!***************************************************************
-!* station type
-!***************************************************************
-TSTATION%TYPE = (/ 'sol '/)
-!
-!----------------------------------------------------------------------------
-ENDIF
+
+IF (CFILE_STAT=="NO_INPUT_CSV") THEN
+ NUMBSTAT = NNUMB_STAT
+
+ IF (NUMBSTAT > 0) THEN
+ ALLOCATE (TSTATION%LAT(NUMBSTAT))
+ ALLOCATE (TSTATION%LON(NUMBSTAT))
+ ALLOCATE (TSTATION%X(NUMBSTAT))
+ ALLOCATE (TSTATION%Y(NUMBSTAT))
+ ALLOCATE (TSTATION%Z(NUMBSTAT))
+ ALLOCATE (TSTATION%K(NUMBSTAT))
+ ALLOCATE (TSTATION%NAME(NUMBSTAT))
+ ALLOCATE (TSTATION%TYPE(NUMBSTAT))
+ !
+ TSTATION%LON = XUNDEF
+ TSTATION%LAT = XUNDEF
+ TSTATION%Z = XUNDEF
+ TSTATION%K = XUNDEF
+ TSTATION%X = XUNDEF
+ TSTATION%Y = XUNDEF
+ TSTATION%NAME = " "
+ TSTATION%TYPE = " "
+ !
+ TSTATION%STEP = XSTEP_STAT
+ !
+ IF (LCARTESIAN) THEN
+ DO JI=1,NUMBSTAT
+ TSTATION%X(JI)= XX_STAT(JI)
+ TSTATION%Y(JI)= XY_STAT(JI)
+ TSTATION%Z(JI)= XZ_STAT(JI)
+ TSTATION%NAME(JI)= CNAME_STAT(JI)
+ TSTATION%TYPE(JI)= CTYPE_STAT(JI)
+ END DO
+ ELSE
+ DO JI=1,NUMBSTAT
+ TSTATION%LAT(JI)= XLAT_STAT(JI)
+ TSTATION%LON(JI)= XLON_STAT(JI)
+ TSTATION%Z(JI)= XZ_STAT(JI)
+ TSTATION%NAME(JI)= CNAME_STAT(JI)
+ TSTATION%TYPE(JI)= CTYPE_STAT(JI)
+ END DO
+ ENDIF
+ ENDIF
+ELSE
+!
+!* 2. CSV DATA
+!
+ CALL READ_CSV_STATION(CFILE_STAT,TSTATION,LCARTESIAN)
+ TSTATION%STEP = XSTEP_STAT
+END IF
+
!
END SUBROUTINE INI_STATION_n
diff --git a/src/MNH/ini_surf_rad.f90 b/src/MNH/ini_surf_rad.f90
index a6c4934e7a32a5926d90601e893a7ecf0a7eb62d..be7c6f342153a6991a14bc8e03b3cc5465b409ba 100644
--- a/src/MNH/ini_surf_rad.f90
+++ b/src/MNH/ini_surf_rad.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2003-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -63,9 +63,10 @@ END MODULE MODI_INI_SURF_RAD
!* 0. DECLARATIONS
! ------------
!
+use modd_field, only: tfielddata, tfieldlist
USE MODD_IO, ONLY: TFILEDATA
!
-USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME, TFIELDDATA, TFIELDLIST
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
!
diff --git a/src/MNH/ini_surfstationn.f90 b/src/MNH/ini_surfstationn.f90
index 0c099b7fbd6bcd5ae0243e75412d060eb4bfdbeb..f53ee35d11e73fd6873e8e7abf40d90a227579af 100644
--- a/src/MNH/ini_surfstationn.f90
+++ b/src/MNH/ini_surfstationn.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.
@@ -9,19 +9,19 @@ MODULE MODI_INI_SURFSTATION_n
!
INTERFACE
!
- SUBROUTINE INI_SURFSTATION_n(PTSTEP, TPDTSEG, PSEGLEN, &
- KRR, KSV, OUSETKE, &
+ SUBROUTINE INI_SURFSTATION_n(PTSTEP, PSEGLEN, &
+ KRR, KSV, OUSETKE, KMI, &
PLATOR, PLONOR )
!
USE MODD_TYPE_DATE
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG ! segment date and time
REAL, INTENT(IN) :: PSEGLEN ! segment length
INTEGER, INTENT(IN) :: KRR ! number of moist variables
INTEGER, INTENT(IN) :: KSV ! number of scalar variables
LOGICAL, INTENT(IN) :: OUSETKE ! flag to use tke
REAL, INTENT(IN) :: PLATOR ! latitude of origine point
REAL, INTENT(IN) :: PLONOR ! longitude of origine point
+INTEGER, INTENT(IN) :: KMI ! MODEL NUMBER
!
!-------------------------------------------------------------------------------
!
@@ -32,8 +32,8 @@ END INTERFACE
END MODULE MODI_INI_SURFSTATION_n
!
! ########################################################
- SUBROUTINE INI_SURFSTATION_n(PTSTEP, TPDTSEG, PSEGLEN, &
- KRR, KSV, OUSETKE, &
+ SUBROUTINE INI_SURFSTATION_n(PTSTEP, PSEGLEN, &
+ KRR, KSV, OUSETKE, KMI, &
PLATOR, PLONOR )
! ########################################################
!
@@ -65,22 +65,30 @@ END MODULE MODI_INI_SURFSTATION_n
!! -------------
!! P. Tulet 15/01/2002
!! A. Lemonsu 19/11/2002
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! R. Schoetter 11/2019: work for cartesian coordinates + parallel.
+! E.Jezequel 02/2021: read stations from CVS file
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_ALLSTATION_n
USE MODD_CONF
+USE MODD_DIM_n
USE MODD_DYN_n
USE MODD_GRID
USE MODD_GRID_n
USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_NESTING
USE MODD_PARAMETERS
+USE MODD_SHADOWS_n
USE MODD_STATION_n
USE MODD_TYPE_DATE
+USE MODD_VAR_ll, ONLY: IP
!
+USE MODE_GATHER_ll
USE MODE_GRIDPROJ
USE MODE_ll
USE MODE_MSG
@@ -94,13 +102,13 @@ IMPLICIT NONE
!
!
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG ! segment date and time
REAL, INTENT(IN) :: PSEGLEN ! segment length
INTEGER, INTENT(IN) :: KRR ! number of moist variables
INTEGER, INTENT(IN) :: KSV ! number of scalar variables
LOGICAL, INTENT(IN) :: OUSETKE ! flag to use tke
REAL, INTENT(IN) :: PLATOR ! latitude of origine point
REAL, INTENT(IN) :: PLONOR ! longitude of origine point
+INTEGER, INTENT(IN) :: KMI ! MODEL NUMBER
!
!-------------------------------------------------------------------------------
!
@@ -108,6 +116,7 @@ REAL, INTENT(IN) :: PLONOR ! longitude of origine point
!
INTEGER :: ISTORE ! number of storage instants
INTEGER :: ILUOUT ! logical unit
+INTEGER :: IIU_ll,IJU_ll,IRESP
!
!----------------------------------------------------------------------------
ILUOUT = TLUOUT%NLU
@@ -131,8 +140,8 @@ LSTATION = (NUMBSTAT>0)
! -----------------------------
!
IF(NUMBSTAT>0) THEN
- CALL ALLOCATE_STATION_n(TSTATION)
- CALL INI_INTERP_STATION_n(TSTATION)
+ CALL ALLOCATE_STATION_n(TSTATION,KMI)
+ IF (.NOT. LCARTESIAN) CALL INI_INTERP_STATION_n(TSTATION)
ENDIF
!----------------------------------------------------------------------------
!
@@ -152,22 +161,29 @@ TSTATION%STEP = XTSTEP
END SUBROUTINE DEFAULT_STATION_n
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
-SUBROUTINE ALLOCATE_STATION_n(TSTATION)
+SUBROUTINE ALLOCATE_STATION_n(TSTATION,KMI)
!
TYPE(STATION), INTENT(INOUT) :: TSTATION !
-!
-ISTORE = INT ( (PSEGLEN-XTSTEP) / TSTATION%STEP ) + 1
-!
-!
-!
-ALLOCATE(TSTATION%TIME(ISTORE))
+INTEGER, INTENT(IN) :: KMI ! Model Index
+!
+if ( tstation%step < xtstep ) then
+ call Print_msg( NVERB_ERROR, 'GEN', 'INI_SURFSTATION_n', 'TSTATION%STEP smaller than XTSTEP' )
+ tstation%step = xtstep
+end if
+
+IF (KMI==1) THEN
+ ISTORE = NINT ( (PSEGLEN-XTSTEP) / TSTATION%STEP ) + 1
+ELSE
+ ISTORE = NINT ( (PSEGLEN-XTSTEP * NDTRATIO(KMI)) / TSTATION%STEP ) + 1
+END IF
+
+allocate( tstation%tpdates( istore ) )
ALLOCATE(TSTATION%ERROR (NUMBSTAT))
-ALLOCATE(TSTATION%X (NUMBSTAT))
-ALLOCATE(TSTATION%Y (NUMBSTAT))
+!ALLOCATE(TSTATION%X (NUMBSTAT))
+!ALLOCATE(TSTATION%Y (NUMBSTAT))
ALLOCATE(TSTATION%SV (ISTORE,NUMBSTAT,KSV))
ALLOCATE(TSTATION%TSRAD (ISTORE,NUMBSTAT))
ALLOCATE(TSTATION%ZS (NUMBSTAT))
-ALLOCATE(TSTATION%DATIME(16,ISTORE))
ALLOCATE(TSTATION%ZON (ISTORE,NUMBSTAT))
ALLOCATE(TSTATION%MER (ISTORE,NUMBSTAT))
ALLOCATE(TSTATION%W (ISTORE,NUMBSTAT))
@@ -199,7 +215,6 @@ ALLOCATE(TSTATION%DSTAOD (ISTORE,NUMBSTAT))
ALLOCATE(TSTATION%SFCO2 (ISTORE,NUMBSTAT))
!
TSTATION%ERROR = .FALSE.
-TSTATION%TIME = XUNDEF
TSTATION%ZON = XUNDEF
TSTATION%MER = XUNDEF
TSTATION%W = XUNDEF
@@ -239,7 +254,6 @@ INTEGER :: JII !
INTEGER :: IIU, IJU !
!
IF ( ALL(TSTATION%LAT(:)/=XUNDEF) .AND. ALL(TSTATION%LON(:)/=XUNDEF) ) THEN
- LSTATLAT = .TRUE.
DO JII=1,NUMBSTAT
CALL GET_DIM_EXT_ll ('B',IIU,IJU)
CALL SM_XYHAT(PLATOR,PLONOR, &
@@ -247,18 +261,7 @@ IF ( ALL(TSTATION%LAT(:)/=XUNDEF) .AND. ALL(TSTATION%LON(:)/=XUNDEF) ) THEN
TSTATION%X(JII), TSTATION%Y(JII) )
ENDDO
ELSE
- LSTATLAT = .FALSE.
- DO JII=1,NUMBSTAT
- TSTATION%X(JII) = XXHAT(TSTATION%I(JII))
- TSTATION%Y(JII) = XYHAT(TSTATION%I(JII))
- CALL GET_DIM_EXT_ll ('B',IIU,IJU)
- CALL SM_LATLON(PLATOR,PLONOR, &
- TSTATION%X(JII), TSTATION%Y(JII), &
- TSTATION%LAT(JII), TSTATION%LON(JII) )
- ENDDO
-END IF
!
-IF ( ANY(TSTATION%LAT(:)==XUNDEF) .OR. ANY(TSTATION%LON(:)==XUNDEF) ) THEN
WRITE(ILUOUT,*) 'Error in station position '
WRITE(ILUOUT,*) 'either LATitude or LONgitude segment'
WRITE(ILUOUT,*) 'or I and J segment'
diff --git a/src/MNH/ini_tke_eps.f90 b/src/MNH/ini_tke_eps.f90
index c76c795b5e67772a14cd56384910110c2a55a010..0d7341a84f5d131f26cf87678b88c69eb51c0517 100644
--- a/src/MNH/ini_tke_eps.f90
+++ b/src/MNH/ini_tke_eps.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -84,18 +84,21 @@ END MODULE MODI_INI_TKE_EPS
!! Aug 10, 1998 (N. Asencio) add parallel code
!! May 2006 Remove KEPS
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! March 2021 (JL Redelsperger) Add Ocean LES case)
!! -------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CTURB ! XLINI, XCED, XCMFS, XTKEMIN
-USE MODD_CST ! XG, XRD, XRV
-USE MODD_PARAMETERS ! JPVEXT
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+USE MODD_CST, ONLY: XG, XALPHAOC
+USE MODD_CTURB, ONLY: XLINI, XCED, XCMFS, XTKEMIN, XCSHF
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_PARAMETERS, ONLY: JPVEXT
!
-USE MODI_SHUMAN ! DZF, MXF, MYF, MZM
USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+!
+USE MODI_SHUMAN, ONLY: DZF, MXF, MYF, MZM
!
IMPLICIT NONE
!
@@ -148,11 +151,20 @@ IF (HGETTKET == 'INIT' ) THEN
PVT(:,:,IKE+1) = PVT(:,:,IKE)
!
! determines TKE
- PTKET(:,:,:)=(XLINI**2/XCED)*( &
- XCMFS*( DZF(MXF(MZM(PUT)))**2 &
- +DZF(MYF(MZM(PVT)))**2) / ZDELTZ &
- -(XG/PTHVREF)*XCSHF*DZF(MZM(PTHT)) &
- ) / ZDELTZ
+ ! Equilibrium/Stationary/neutral 1D TKE equation
+ IF (LOCEAN) THEN
+ PTKET(:,:,:)=(XLINI**2/XCED)*( &
+ XCMFS*( DZF(MXF(MZM(PUT)))**2 &
+ +DZF(MYF(MZM(PVT)))**2) / ZDELTZ &
+ -(XG*XALPHAOC)*XCSHF*DZF(MZM(PTHT)) &
+ ) / ZDELTZ
+ ELSE
+ PTKET(:,:,:)=(XLINI**2/XCED)*( &
+ XCMFS*( DZF(MXF(MZM(PUT)))**2 &
+ +DZF(MYF(MZM(PVT)))**2) / ZDELTZ &
+ -(XG/PTHVREF)*XCSHF*DZF(MZM(PTHT)) &
+ ) / ZDELTZ
+ END IF
! positivity control
WHERE (PTKET < XTKEMIN) PTKET=XTKEMIN
!
diff --git a/src/MNH/init_aerosol_concentration.f90 b/src/MNH/init_aerosol_concentration.f90
index 3ff2fef9b18ac18ceebf057ed9de7835d3b2330e..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
!######################################
@@ -23,7 +28,7 @@ END MODULE MODI_INIT_AEROSOL_CONCENTRATION
!! Define the aerosol distributions
!!
!!
-!! MODD_BLANK :
+!! MODD_BLANKn :
!! CDUMMY2 : CCN ou IFN pour le panache
!! NDUMMY1 : hauteur base du panache
!! NDUMMY2 : hauteur sommet du panache
@@ -53,7 +58,7 @@ USE MODD_PARAM_LIMA, ONLY : LWARM, LACTI, NMOD_CCN, LSCAV, LAERO_MASS, &
LCOLD, LNUCL, NMOD_IFN, LMEYERS, &
XIFN_CONC, LIFN_HOM
USE MODD_PARAMETERS, ONLY : JPVEXT
-USE MODD_BLANK, ONLY : CDUMMY2, NDUMMY1, NDUMMY2, XDUMMY8
+USE MODD_BLANK_n, ONLY : CDUMMY2, NDUMMY1, NDUMMY2, XDUMMY8
!
IMPLICIT NONE
!
diff --git a/src/MNH/init_aerosol_properties.f90 b/src/MNH/init_aerosol_properties.f90
index 84f1a5bd0eca3a6f509a72b224f882d3dfe027d0..52f7ddc882a89149d5f467797f07c70b1a9f5ba2 100644
--- a/src/MNH/init_aerosol_properties.f90
+++ b/src/MNH/init_aerosol_properties.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.
@@ -36,27 +36,28 @@ END MODULE MODI_INIT_AEROSOL_PROPERTIES
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! 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
! ------------
!
-USE MODD_PARAM_n, ONLY : CCLOUD
USE MODD_LUNIT, ONLY : TLUOUT0
-USE MODD_PARAM_LIMA, ONLY : LWARM, LACTI, NMOD_CCN, HINI_CCN, HTYPE_CCN, &
+USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, HINI_CCN, HTYPE_CCN, &
XR_MEAN_CCN, XLOGSIG_CCN, XRHO_CCN, &
XKHEN_MULTI, XMUHEN_MULTI, XBETAHEN_MULTI, &
XLIMIT_FACTOR, CCCN_MODES, LSCAV, &
XACTEMP_CCN, XFSOLUB_CCN, &
- LCOLD, LNUCL, NMOD_IFN, NSPECIE, CIFN_SPECIES, &
+ NMOD_IFN, NSPECIE, CIFN_SPECIES, &
XMDIAM_IFN, XSIGMA_IFN, XRHO_IFN, XFRAC, XFRAC_REF, &
- CINT_MIXING, NMOD_IMM, NINDICE_CCN_IMM, NIMM, &
- NPHILLIPS
+ CINT_MIXING, NPHILLIPS
!
use mode_msg
!
USE MODI_GAMMA
+USE MODI_LIMA_INIT_CCN_ACTIVATION_SPECTRUM
!
IMPLICIT NONE
!
@@ -85,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
!
!-------------------------------------------------------------------------------
!
@@ -110,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 /)
@@ -131,12 +149,14 @@ IF ( NMOD_CCN .GE. 1 ) THEN
RCCN(:) = (/ 0.01E-6 , 0.05E-6 , 0.008E-6 /)
LOGSIGCCN(:) = (/ 0.788 , 0.993 , 0.916 /)
RHOCCN(:) = (/ 1000. , 2200. , 1000. /)
- CASE DEFAULT
-! d'après Jaenicke 1993, aerosols troposphere libre, masse volumique typique
+ CASE ('FREETROP') ! d'après Jaenicke 1993, aerosols troposphere libre, masse volumique typique
RCCN(:) = (/ 0.0035E-6 , 0.125E-6 , 0.26E-6 /)
LOGSIGCCN(:) = (/ 0.645 , 0.253 , 0.425 /)
RHOCCN(:) = (/ 1000. , 1000. , 1000. /)
- ENDSELECT
+ CASE DEFAULT
+ call Print_msg(NVERB_FATAL,'GEN','INIT_AEROSOL_PROPERTIES','CCN_MODES must be JUNGFRAU, COPT, CAMS, CAMS_JPP,'// &
+ 'CAMS_ACC, CAMS_AIT, SIRTA, CPS00, MOCAGE or FREETROP')
+ ENDSELECT
!
DO I=1, MIN(NMOD_CCN,3)
XR_MEAN_CCN(I) = RCCN(I)
@@ -193,48 +213,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
@@ -265,7 +297,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)
@@ -276,6 +308,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
@@ -311,7 +365,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.
@@ -320,7 +374,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
@@ -329,6 +383,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.
@@ -359,22 +431,6 @@ IF ( NMOD_IFN .GE. 1 ) THEN
XFRAC_REF(4)=0.06
END IF
!
-! Immersion modes
-!
- IF (.NOT.(ALLOCATED(NIMM))) ALLOCATE(NIMM(NMOD_CCN))
- NIMM(:)=0
- IF (ALLOCATED(NINDICE_CCN_IMM)) DEALLOCATE(NINDICE_CCN_IMM)
- ALLOCATE(NINDICE_CCN_IMM(MAX(1,NMOD_IMM)))
- IF (NMOD_IMM .GE. 1) THEN
- DO J = 0, NMOD_IMM-1
- NIMM(NMOD_CCN-J)=1
- NINDICE_CCN_IMM(NMOD_IMM-J) = NMOD_CCN-J
- END DO
-! ELSE IF (NMOD_IMM == 0) THEN ! PNIS existe mais vaut 0, pour l'appel à resolved_cloud
-! NMOD_IMM = 1
-! NINDICE_CCN_IMM(1) = 0
- END IF
-!
END IF ! NMOD_IFN > 0
!
END SUBROUTINE INIT_AEROSOL_PROPERTIES
diff --git a/src/MNH/init_for_convlfi.f90 b/src/MNH/init_for_convlfi.f90
deleted file mode 100644
index 733aa93ca7bbeb0deb5e0cb40c82c58edbeea179..0000000000000000000000000000000000000000
--- a/src/MNH/init_for_convlfi.f90
+++ /dev/null
@@ -1,277 +0,0 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!###########################
-MODULE MODI_INIT_FOR_CONVLFI
-!###########################
-!
-!
-INTERFACE
- SUBROUTINE INIT_FOR_CONVLFI(TPINIFILE)
-!
-USE MODD_IO,ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! file being read
-!
-END SUBROUTINE INIT_FOR_CONVLFI
-END INTERFACE
-END MODULE MODI_INIT_FOR_CONVLFI
-!
-! ############################################
- SUBROUTINE INIT_FOR_CONVLFI(TPINIFILE)
-! ############################################
-!
-!!**** *INIT_FOR_CONVLFI * - light monitor to initialize the variables
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to initialize some variables
-! necessary in the conversion program.
-!
-!!** METHOD
-!! ------
-!! This initialization takes some parts of the whole initialization modules
-!! of monitor INIT:
-!! geometry and dimensions from ini_sizen
-!! grids, metric coefficients, dates and times from set_grid
-!! reading of the pressure field
-!!
-!!
-!! EXTERNAL
-!! --------
-!! INI_CST : to initialize physical constants
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! I. Mallet * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 20/02/01
-!! J.-P. Pinty and D. Gazen 31/03/04 Add the 2D capability for V5D plots
-!! 10/10/2011 J.Escobar call INI_PARAZ_ll
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_CST
-USE MODD_DIM_n
-USE MODD_FIELD_n
-USE MODD_GRID
-USE MODD_GRID_n
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_TIME
-USE MODD_TIME_n
-USE MODD_VAR_ll, ONLY: NPROC
-!
-USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
-USE MODE_TIME
-USE MODE_GRIDPROJ
-USE MODE_GRIDCART
-!
-USE MODE_GATHER_ll
-USE MODE_IO, only: IO_Pack_set
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_ll
-!
-USE MODI_INI_CST
-!JUANZ
-USE MODE_SPLITTINGZ_ll
-!JUANZ
-!
-IMPLICIT NONE
-!
-!* 0.1 Arguments variables
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE ! file being read
-!
-!* 0.2 Local variables
-!
-INTEGER :: IRESP
-CHARACTER (LEN=40) :: YTITLE ! Title for date print
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZJ ! Jacobian
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll ! Position x in the conformal
- ! plane (array on the complete domain)
-REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT_ll ! Position y in the conformal
- ! plane (array on the complete domain)
-REAL :: ZXHATM,ZYHATM ! coordinates of mass point
-REAL :: ZLATORI, ZLONORI ! lat and lon of left-bottom point
-!
-INTEGER :: IIU,IJU ! Upper dimension in x,y direction (local)
-INTEGER :: IKU ! Upper dimension in z direction
-INTEGER :: IINFO_ll ! return code of // routines
-INTEGER :: IID
-TYPE(TFIELDDATA) :: TZFIELD
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. INITIALIZE EACH MODEL SIZES AND DEPENDENCY (ini_sizen)
-! ------------------------------------------
-!
-!* 1.1 Read the geometry kind in the LFIFM file (Cartesian or spherical)
-!
-CALL IO_Field_read(TPINIFILE,'CARTESIAN',LCARTESIAN)
-!
-!* 1.2 Read configuration and dimensions in initial file and initialize
-! subdomain dimensions and parallel variables
-!
-CALL IO_Field_read(TPINIFILE,'IMAX',NIMAX_ll)
-CALL IO_Field_read(TPINIFILE,'JMAX',NJMAX_ll)
-!
-CALL IO_Field_read(TPINIFILE,'L1D',L1D,IRESP)
-IF (IRESP/=0) THEN
- L1D=.FALSE.
- IF( (NIMAX_ll == 1).AND.(NJMAX_ll == 1) ) L1D=.TRUE.
-ENDIF
-!
-CALL IO_Field_read(TPINIFILE,'L2D',L2D,IRESP)
-IF (IRESP/=0) THEN
- L2D=.FALSE.
- IF( (NIMAX_ll /= 1).AND.(NJMAX_ll == 1) ) L2D=.TRUE.
-ENDIF
-!
-CALL IO_Field_read(TPINIFILE,'PACK',LPACK,IRESP)
-IF (IRESP/=0) LPACK=.TRUE.
-!
-CALL IO_Pack_set(L1D,L2D,LPACK)
-!
-CALL IO_Field_read(TPINIFILE,'KMAX',NKMAX)
-!
-CSPLIT ='BSPLITTING' ; NHALO = 1
-CALL SET_SPLITTING_ll(CSPLIT)
-CALL SET_JP_ll(1,JPHEXT,JPVEXT, NHALO)
-CALL SET_DAD0_ll()
-CALL SET_DIM_ll(NIMAX_ll, NJMAX_ll, NKMAX)
-CALL IO_Pack_set(L1D,L2D,LPACK)
-CALL SET_LBX_ll('OPEN', 1)
-CALL SET_LBY_ll('OPEN', 1)
-CALL SET_XRATIO_ll(1, 1)
-CALL SET_YRATIO_ll(1, 1)
-CALL SET_XOR_ll(1, 1)
-CALL SET_XEND_ll(NIMAX_ll+2*JPHEXT, 1)
-CALL SET_YOR_ll(1, 1)
-CALL SET_YEND_ll(NJMAX_ll+2*JPHEXT, 1)
-CALL SET_DAD_ll(0, 1)
-!JUANZ CALL INI_PARA_ll(IINFO_ll)
-CALL INI_PARAZ_ll(IINFO_ll)
-!
-!* 1.4 Compute sizes of arrays of the extended sub-domain (ini_modeln)
-!
-IKU=NKMAX + 2*JPVEXT
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. INITIALIZE GRIDS AND METRIC COEFFICIENTS (set_grid)
-! ---------------------
-!
-! 2.1 reading
-!
-CALL IO_Field_read(TPINIFILE,'LAT0',XLAT0)
-CALL IO_Field_read(TPINIFILE,'LON0',XLON0)
-CALL IO_Field_read(TPINIFILE,'BETA',XBETA)
-CALL IO_Field_read(TPINIFILE,'XHAT',XXHAT)
-CALL IO_Field_read(TPINIFILE,'YHAT',XYHAT)
-!
-IF (.NOT.LCARTESIAN) THEN
- CALL IO_Field_read(TPINIFILE,'RPK',XRPK)
- CALL IO_Field_read(TPINIFILE,'LONORI',XLONORI)
- CALL IO_Field_read(TPINIFILE,'LATORI',XLATORI)
- !
- IF (TPINIFILE%NMNHVERSION(1)<4 .OR. (TPINIFILE%NMNHVERSION(1)==4 .AND. TPINIFILE%NMNHVERSION(2)<=5)) THEN
- CALL FIND_FIELD_ID_FROM_MNHNAME('LONORI',IID,IRESP)
- TZFIELD = TFIELDLIST(IID)
- TZFIELD%CMNHNAME = 'LONOR'
- CALL IO_Field_read(TPINIFILE,TZFIELD,XLONORI)
- !
- CALL FIND_FIELD_ID_FROM_MNHNAME('LATORI',IID,IRESP)
- TZFIELD = TFIELDLIST(IID)
- TZFIELD%CMNHNAME = 'LATOR'
- CALL IO_Field_read(TPINIFILE,TZFIELD,XLATORI)
- !
- ALLOCATE(ZXHAT_ll(NIMAX_ll+ 2 * JPHEXT),ZYHAT_ll(NJMAX_ll+2 * JPHEXT))
- CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,IRESP) !//
- CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,IRESP) !//
- ZXHATM = - 0.5 * (ZXHAT_ll(1)+ZXHAT_ll(2))
- ZYHATM = - 0.5 * (ZYHAT_ll(1)+ZYHAT_ll(2))
- CALL SM_LATLON(XLATORI,XLONORI,ZXHATM,ZYHATM,ZLATORI,ZLONORI)
- DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
- XLATORI = ZLATORI
- XLONORI = ZLONORI
- END IF
-END IF
-!
-ALLOCATE(XZS(IIU,IJU))
-CALL IO_Field_read(TPINIFILE,'ZS',XZS,IRESP)
-IF (IRESP/=0) XZS(:,:)=0.
-!
-ALLOCATE(XZSMT(IIU,IJU))
-CALL IO_Field_read(TPINIFILE,'ZSMT',XZSMT,IRESP)
-IF (IRESP/=0) XZSMT(:,:)=XZS(:,:)
-!
-ALLOCATE(XZHAT(IKU))
-CALL IO_Field_read(TPINIFILE,'ZHAT',XZHAT)
-CALL IO_Field_read(TPINIFILE,'ZTOP',XZTOP)
-!
-CALL IO_Field_read(TPINIFILE,'SLEVE',LSLEVE,IRESP)
-IF (IRESP/=0) LSLEVE = .FALSE.
-!
-IF (LSLEVE) THEN
- CALL IO_Field_read(TPINIFILE,'LEN1',XLEN1)
- CALL IO_Field_read(TPINIFILE,'LEN2',XLEN2)
-END IF
-!
-CALL IO_Field_read(TPINIFILE,'DTEXP',TDTEXP)
-CALL IO_Field_read(TPINIFILE,'DTMOD',TDTMOD)
-CALL IO_Field_read(TPINIFILE,'DTSEG',TDTSEG)
-CALL IO_Field_read(TPINIFILE,'DTCUR',TDTCUR)
-!
-YTITLE='CURRENT DATE AND TIME'
-CALL SM_PRINT_TIME(TDTCUR,TLUOUT,YTITLE)
-!
-!* 2.2 Spatial grid
-!
-ALLOCATE(XDXHAT(IIU))
-ALLOCATE(XDYHAT(IJU))
-ALLOCATE(XZZ(IIU,IJU,IKU))
-ALLOCATE(ZJ(IIU,IJU,IKU))
-!
-CALL INI_CST
-!
-IF (LCARTESIAN) THEN
- CALL SM_GRIDCART(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XDXHAT,XDYHAT,XZZ,ZJ)
-ELSE
- ALLOCATE(XLON(IIU,IJU))
- ALLOCATE(XLAT(IIU,IJU))
- ALLOCATE(XMAP(IIU,IJU))
- CALL SM_GRIDPROJ(XXHAT,XYHAT,XZHAT,XZS,LSLEVE,XLEN1,XLEN2,XZSMT,XLATORI,XLONORI, &
- XMAP,XLAT,XLON,XDXHAT,XDYHAT,XZZ,ZJ)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. INITIALIZE THE PROGNOSTIC AND SURFACE FIELDS (read_field)
-! --------------------------------------------
-ALLOCATE(XPABST(IIU,IJU,IKU))
-CALL IO_Field_read(TPINIFILE,'PABST',XPABST)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE INIT_FOR_CONVLFI
diff --git a/src/MNH/init_ground_paramn.f90 b/src/MNH/init_ground_paramn.f90
index f8e37bd5ae848f9c2b7666495657cc0d07044935..95b13ded39772be285af6ed0e2cf04ee1a72f36e 100644
--- a/src/MNH/init_ground_paramn.f90
+++ b/src/MNH/init_ground_paramn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2003-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -74,10 +74,11 @@ END MODULE MODI_INIT_GROUND_PARAM_n
! ------------
!
USE MODE_DATETIME
-USE MODE_FIELD
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_ll
!
USE MODD_DYN_n, ONLY : NSTOP, XTSTEP
+use modd_field, only: TFIELDLIST
USE MODD_REF_n, ONLY : XRHODREF
USE MODD_CH_M9_n, ONLY : CNAMES
USE MODD_NSV
@@ -190,12 +191,12 @@ CALL FIND_FIELD_ID_FROM_MNHNAME('DTCUR',IID,IRESP)
TZTCUR=>TFIELDLIST(IID)%TFIELD_T0D(1)%DATA
!
TZDATE = TZTCUR
-TZDATE%TIME = TZDATE%TIME + NSTOP * XTSTEP
+TZDATE%xtime = TZDATE%xtime + NSTOP * XTSTEP
CALL DATETIME_CORRECTDATE(TZDATE)
!Done field by field because TYPE(DATE) different in MesoNH and SURFEX
-TDATE_END%YEAR = TZDATE%TDATE%YEAR
-TDATE_END%MONTH = TZDATE%TDATE%MONTH
-TDATE_END%DAY = TZDATE%TDATE%DAY
+TDATE_END%YEAR = TZDATE%nyear
+TDATE_END%MONTH = TZDATE%nmonth
+TDATE_END%DAY = TZDATE%nday
!
DO JLAYER=NSV_SNWBEG,NSV_SNWEND
HSV(JLAYER) = TRIM(CSNOWNAMES(JLAYER-NSV_SNWBEG+1))
@@ -219,13 +220,13 @@ ELSE
ENDIF
CALL INIT_SURF_ATM_n(YSURF_CUR,'MESONH',HINIT,.FALSE., &
ILU,ISV,SIZE(PSW_BANDS), &
- YSV_SURF,ZCO2,ZRHODREF, &
+ YSV_SURF,ZCO2,ZRHODREF, &
ZZENITH,ZAZIM,PSW_BANDS,ZDIR_ALB,ZSCA_ALB, &
ZEMIS,ZTSRAD,ZTSURF, &
- TZTCUR%TDATE%YEAR, TZTCUR%TDATE%MONTH, &
- TZTCUR%TDATE%DAY, TZTCUR%TIME, &
+ TZTCUR%nyear, TZTCUR%nmonth, &
+ TZTCUR%nday, TZTCUR%xtime, &
TDATE_END,' ',' ', &
- 'OK' )
+ 'OK' )
!
PDIR_ALB = XUNDEF
PSCA_ALB = XUNDEF
diff --git a/src/MNH/init_mnh.f90 b/src/MNH/init_mnh.f90
index 0af93332edcd778e0b5841e2f5346e056a40bc47..555f37fa2e310ff6eeeb4538196dc23cef089d97 100644
--- a/src/MNH/init_mnh.f90
+++ b/src/MNH/init_mnh.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.
@@ -76,7 +76,7 @@
!* 0. DECLARATIONS
! ------------
USE MODD_CONF
-USE MODD_DYN_n, ONLY: CPRESOPT,NITR ! 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
@@ -84,7 +84,7 @@ USE MODD_LUNIT_n
USE MODD_MNH_SURFEX_n
USE MODD_PARAMETERS
!
-USE MODE_FIELD
+use mode_field, only: Alloc_field_scalars, Fieldlist_goto_model
USE MODE_IO_FILE, ONLY: IO_File_open
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
USE MODE_ll
diff --git a/src/MNH/initial_guess.f90 b/src/MNH/initial_guess.f90
index cc86efe6508b07f4f65b235a08400aa6f59e3c8c..004d6be13168a80d05113e16940d8d9283283f72 100644
--- a/src/MNH/initial_guess.f90
+++ b/src/MNH/initial_guess.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.
@@ -77,7 +77,6 @@ END MODULE MODI_INITIAL_GUESS
!! LBU_BEG : logical for budget begnning
!! .TRUE. = budget begining
!! .FALSE. = no budget begining
-!! NBUPROCCTR : process counter used for each budget variable
!! Switches for budgets activations:
!!
!! LBU_RU : logical for budget of RU (wind component along x)
@@ -139,22 +138,27 @@ END MODULE MODI_INITIAL_GUESS
!! 20/05/06 Remove KEPS
!! 10/09 (C.Lac) FIT for variables advected with PPM
!! 04/13 (C.Lac) FIT for all variables
-!! 07/19 (J.Escobar) add reproductiblity test => MPPDB_CHECK( PRRS/RT/RHO )
-!!
+! J. Escobar) 07/2019: add reproductiblity test => MPPDB_CHECK( PRRS/RT/RHO )
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CONF
-USE MODD_GRID_n
-USE MODD_BUDGET
USE MODD_BLOWSNOW
USE MODD_BLOWSNOW_n
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ 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, &
+ lbu_beg, lbu_enable, tbudgets
+USE MODD_CONF
+USE MODD_GRID_n
+
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_MPPDB
+
+USE MODI_SHUMAN
!
IMPLICIT NONE
!
@@ -230,69 +234,53 @@ END IF
!
IF (LBU_ENABLE) THEN
IF (LBU_BEG) THEN
- NBUPROCCTR(:)=1
- NBUCTR_ACTV(:)=1
-!
- IF (LBUDGET_U) CALL BUDGET (PRUS,1,'INIF_BU_RU')
- IF (LBUDGET_V) CALL BUDGET (PRVS,2,'INIF_BU_RV')
- IF (LBUDGET_W) CALL BUDGET (PRWS,3,'INIF_BU_RW')
- IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'INIF_BU_RTH')
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'INIF_BU_RTKE')
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'INIF_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'INIF_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8,'INIF_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'INIF_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'INIF_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'INIF_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'INIF_BU_RRH')
- DO JSV=1,KSV
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'INIF_BU_RSV')
- END DO
-!
- NBUPROCCTR(:)=2
- NBUCTR_ACTV(:)=2
-!
- IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ENDF_BU_RU')
- IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ENDF_BU_RV')
- IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ENDF_BU_RW')
- IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ENDF_BU_RTH')
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ENDF_BU_RTKE')
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'ENDF_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'ENDF_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8,'ENDF_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'ENDF_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ENDF_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ENDF_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ENDF_BU_RRH')
- DO JSV=1,KSV
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ENDF_BU_RSV')
- END DO
-!
- LBU_BEG=.FALSE.
- END IF
-!
- NBUPROCCTR(:)=4
- NBUCTR_ACTV(:)=4
+ !Remark: does not need a call to Budget_store_init because the budget array is overwritten for this source term
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'INIF', prus (:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'INIF', prvs (:, :, :) )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'INIF', prws (:, :, :) )
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'INIF', prths (:, :, :) )
+ if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'INIF', prtkes(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'INIF', prrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'INIF', prrs (:, :, :, 2) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'INIF', prrs (:, :, :, 3) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'INIF', prrs (:, :, :, 4) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'INIF', prrs (:, :, :, 5) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'INIF', prrs (:, :, :, 6) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'INIF', prrs (:, :, :, 7) )
+ if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'INIF', prsvs(:, :, :, jsv) )
+ end do
+ end if
+ END IF
!
! stores the Asselin source term
!
- IF (LBUDGET_U) CALL BUDGET (PRUS,1,'ASSE_BU_RU')
- IF (LBUDGET_V) CALL BUDGET (PRVS,2,'ASSE_BU_RV')
- IF (LBUDGET_W) CALL BUDGET (PRWS,3,'ASSE_BU_RW')
- IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'ASSE_BU_RTH')
- IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ASSE_BU_RTKE')
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'ASSE_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'ASSE_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8,'ASSE_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'ASSE_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ASSE_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ASSE_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ASSE_BU_RRH')
- DO JSV=1,KSV
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ASSE_BU_RSV')
- END DO
+ !The Asselin source term is computed from the end of the previous time step to now
+ !Therefore, it has to be stored only if not the 1st timestep of the budget
+ if ( .not. lbu_beg ) then
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'ASSE', prus (:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'ASSE', prvs (:, :, :) )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'ASSE', prws (:, :, :) )
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'ASSE', prths (:, :, :) )
+ if ( lbudget_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'ASSE', prtkes(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'ASSE', prrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'ASSE', prrs (:, :, :, 2) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'ASSE', prrs (:, :, :, 3) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'ASSE', prrs (:, :, :, 4) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'ASSE', prrs (:, :, :, 5) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'ASSE', prrs (:, :, :, 6) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'ASSE', prrs (:, :, :, 7) )
+ if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'ASSE', prsvs(:, :, :, jsv) )
+ end do
+ end if
+ end if
+
+ LBU_BEG=.FALSE.
END IF
-!
+
!-------------------------------------------------------------------------------
!
END SUBROUTINE INITIAL_GUESS
diff --git a/src/MNH/ion_attach_elec.f90 b/src/MNH/ion_attach_elec.f90
index bfecbd9a16f54dc039518c785c481438bda2e442..dfda780c2d9864e4b3bb710ce27e5599df2076d3 100644
--- a/src/MNH/ion_attach_elec.f90
+++ b/src/MNH/ion_attach_elec.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -76,29 +76,29 @@ END MODULE MODI_ION_ATTACH_ELEC
!! Original 2010
!! Modifications:
!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
-!!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
+use modd_budget, only : lbudget_sv, NBUDGET_SV1, tbudgets
+USE MODD_CONF, ONLY: CCONF
USE MODD_CST
-USE MODD_CONF, ONLY : CCONF
USE MODD_ELEC_DESCR
-USE MODD_ELEC_n
+USE MODD_ELEC_n
USE MODD_ELEC_PARAM
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELEC
+USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_RAIN_ICE_DESCR
USE MODD_RAIN_ICE_PARAM
-USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELEC
-USE MODD_BUDGET, ONLY : LBU_RSV
-USE MODD_REF, ONLY : XTHVREFZ
+USE MODD_REF, ONLY: XTHVREFZ
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools_ll, only: GET_INDICE_ll
-USE MODI_BUDGET
USE MODI_MOMG
-!
+
IMPLICIT NONE
!
! 0.1 Declaration of arguments
@@ -145,6 +145,11 @@ REAL :: ZCOMB ! Recombination
!
!
!-------------------------------------------------------------------------------
+if ( lbudget_sv ) then
+ do jrr = 1, nsv_elec
+ call Budget_store_init( tbudgets( NBUDGET_SV1 - 1 + nsv_elecbeg - 1 + jrr), 'NEUT', psvs(:, :, :, jrr) )
+ end do
+end if
!
!* 1. COMPUTE THE ION RECOMBINATION and TEMPERATURE
! ---------------------------------------------
@@ -261,11 +266,11 @@ ENDDO
!* 5. BUDGET
! ------
!
-IF (LBU_RSV) THEN
- DO JRR = 1, NSV_ELEC
- CALL BUDGET(PSVS(:,:,:,JRR), 11+NSV_ELECBEG+JRR, 'NEUT_BU_RSV')
- ENDDO
-END IF
+if ( lbudget_sv ) then
+ do jrr = 1, nsv_elec
+ call Budget_store_end( tbudgets( NBUDGET_SV1 - 1 + nsv_elecbeg - 1 + jrr), 'NEUT', psvs(:, :, :, jrr) )
+ end do
+end if
!
!------------------------------------------------------------------------------
!
diff --git a/src/MNH/ion_drift.f90 b/src/MNH/ion_drift.f90
index b3187ca833f755e9a0ad1ab341f829d89d26c633..7d863c9182faea2b9a54f8ecbf6c2186e74c0578 100644
--- a/src/MNH/ion_drift.f90
+++ b/src/MNH/ion_drift.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.
@@ -12,7 +12,7 @@ INTERFACE
SUBROUTINE ION_DRIFT(PDRIFTP, PDRIFTM, PSVT, HLBCX, HLBCY)
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDRIFTP, PDRIFTM
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRIFTP, PDRIFTM
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
!
END SUBROUTINE ION_DRIFT
@@ -65,7 +65,7 @@ IMPLICIT NONE
!* 0.1 declarations of arguments
!
CHARACTER(LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX,HLBCY
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PDRIFTP, PDRIFTM
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PDRIFTP, PDRIFTM
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
!
!
diff --git a/src/MNH/khko_notadjust.f90 b/src/MNH/khko_notadjust.f90
index 806c6c9652e2dd3515a1657eb1444d864d687637..344c2e97643255c8eca1400ab2da6eeb7bd860a0 100644
--- a/src/MNH/khko_notadjust.f90
+++ b/src/MNH/khko_notadjust.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.
@@ -9,11 +9,11 @@
!
INTERFACE
!
- SUBROUTINE KHKO_NOTADJUST(KRR, KTCOUNT, TPFILE, HRAD, OCLOSE_OUT, &
+ SUBROUTINE KHKO_NOTADJUST(KRR, KTCOUNT, TPFILE, HRAD, &
PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PZZ, &
PTHT,PRVT,PRCT,PRRT, &
PTHS, PRVS, PRCS, PRRS, PCCS, PCNUCS, PSAT, &
- PCLDFR, PSRCS, PNPRO,PSSPRO )
+ PCLDFR, PSRCS, PNPRO,PSSPRO )
!
USE MODD_IO, ONLY: TFILEDATA
!
@@ -21,9 +21,6 @@ INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KTCOUNT ! Number of moist variables
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the OUTPUT FM-file
- ! Condensation
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
!
@@ -59,13 +56,13 @@ END INTERFACE
!
END MODULE MODI_KHKO_NOTADJUST
!
-! ################################################################################
- SUBROUTINE KHKO_NOTADJUST(KRR, KTCOUNT, TPFILE, HRAD, OCLOSE_OUT, &
+! ###############################################################################
+ SUBROUTINE KHKO_NOTADJUST(KRR, KTCOUNT, TPFILE, HRAD, &
PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PZZ, &
PTHT,PRVT,PRCT,PRRT, &
PTHS, PRVS, PRCS, PRRS, PCCS, PCNUCS, PSAT, &
- PCLDFR, PSRCS, PNPRO,PSSPRO )
-! ################################################################################
+ PCLDFR, PSRCS, PNPRO,PSSPRO )
+! ###############################################################################
!
!!**** * - compute pseudo-prognostic of supersaturation according to Thouron
! et al. 2012
@@ -93,27 +90,30 @@ END MODULE MODI_KHKO_NOTADJUST
!! M.Mazoyer : 10/2016 New KHKO output fields
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 10/02/2021: add CEVA source for NSV_C2R2BEG+3 budget
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, 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, ONLY: NSV_C2R2BEG
USE MODD_PARAMETERS
USE MODD_RAIN_C2R2_DESCR, ONLY: XRTMIN
-!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
+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_BUDGET
+
USE MODI_PROGNOS
!
IMPLICIT NONE
@@ -125,9 +125,6 @@ INTEGER, INTENT(IN) :: KRR ! Number of moist variables
INTEGER, INTENT(IN) :: KTCOUNT ! Number of moist variables
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the OUTPUT FM-file
- ! Condensation
REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
!
@@ -194,6 +191,15 @@ TYPE(TFIELDDATA) :: TZFIELD
!* 1. PRELIMINARIES
! -------------
!
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'CEVA', pcnucs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'CEVA', pccs (:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 3), 'CEVA', psat (:, :, :) * prhodj(:, :, :) )
+end if
+
ILUOUT = TLUOUT%NLU
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB=1+JPVEXT
@@ -382,7 +388,7 @@ END IF
PNPRO(:,:,:) = 0.0
PNPRO(:,:,:) = ZACT(:,:,:)
!
-IF ( OCLOSE_OUT ) THEN
+IF ( tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'SURSAT'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'SURSAT'
@@ -411,13 +417,13 @@ END IF
!* 7. STORE THE BUDGET TERMS
! ----------------------
!
-!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),6,'COND_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),7,'COND_BU_RRC')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),4,'COND_BU_RTH')
-IF (LBUDGET_SV) THEN
- CALL BUDGET (PCNUCS(:,:,:) * PRHODJ(:,:,:),13+(NSV_C2R2BEG-1),'CEVA_BU_RSV') ! RCN
- CALL BUDGET (PCCS(:,:,:) * PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),'CEVA_BU_RSV') ! RCC
-END IF
-!
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'COND', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'COND', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'COND', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'CEVA', pcnucs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'CEVA', pccs (:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 3), 'CEVA', psat (:, :, :) * prhodj(:, :, :) )
+end if
+
END SUBROUTINE KHKO_NOTADJUST
diff --git a/src/MNH/latlon_to_xy.f90 b/src/MNH/latlon_to_xy.f90
index eded99bf5b50b499036ac347716a959a350e790f..972999064186796b7d4b1721bdd304e0d51f15c4 100644
--- a/src/MNH/latlon_to_xy.f90
+++ b/src/MNH/latlon_to_xy.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -54,14 +54,18 @@
!! remove the USE MODI_DEFAULT_DESFM Apr. 17, 1996 (J.Stein)
!! no transfer of the file when closing Dec. 09, 1996 (V.Masson)
!! + changes call to READ_HGRID
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. 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 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 10/04/2020: add missing initializations (LATLON_TO_XY was not working)
+! J. Escobar 21/07/2020: missing modi_version
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
+use MODD_CONF, only: CPROGRAM
+USE MODD_DIM_n
USE MODD_GRID
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PGDDIM
@@ -69,13 +73,20 @@ USE MODD_PGDGRID
USE MODD_PARAMETERS
USE MODD_LUNIT
!
+USE MODE_FIELD, ONLY: INI_FIELD_LIST
USE MODE_GRIDPROJ
USE MODE_IO, only: IO_Config_set, IO_Init
+use MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+use MODE_INIT_ll, only: SET_DIM_ll, SET_JP_ll
+USE MODE_MODELN_HANDLER, ONLY: GOTO_MODEL
+USE MODE_POS, ONLY: POSNAM
+use MODE_SPLITTINGZ_ll
!
USE MODI_INI_CST
USE MODI_READ_HGRID
+USE MODI_VERSION
!
USE MODN_CONFIO, ONLY: NAM_CONFIO
!
@@ -99,6 +110,7 @@ INTEGER :: II,IJ ! indexes of the point
REAL :: ZI,ZJ ! fractionnal indexes of the point
TYPE(TFILEDATA),POINTER :: TZINIFILE => NULL()
TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL()
+LOGICAL :: GFOUND
!
!* 0.3 Declaration of namelists
! ------------------------
@@ -115,19 +127,38 @@ NAMELIST/NAM_INIFILE/ YINIFILE
!* 1. Initializations
! ---------------
!
-CALL INI_CST
+CALL GOTO_MODEL(1)
+!
+CALL VERSION()
+!
+CPROGRAM='LAT2XY'
+!
+CALL IO_Init()
+!
+CALL INI_CST()
+!
+CALL INI_FIELD_LIST(1)
!
!* 2. Reading of namelist file
! ------------------------
!
-CALL IO_Init()
!
CALL IO_File_add2list(TZNMLFILE,'LATLON2XY1.nam','NML','READ')
CALL IO_File_open(TZNMLFILE)
INAM=TZNMLFILE%NLU
-READ(INAM,NAM_INIFILE)
!
-READ(INAM,NAM_CONFIO)
+CALL POSNAM(INAM,'NAM_INIFILE',GFOUND)
+IF (GFOUND) THEN
+ READ(UNIT=INAM,NML=NAM_INIFILE)
+ PRINT*, ' namelist NAM_INIFILE read'
+END IF
+!
+CALL POSNAM(INAM,'NAM_CONFIO',GFOUND)
+IF (GFOUND) THEN
+ READ(UNIT=INAM,NML=NAM_CONFIO)
+ PRINT*, ' namelist NAM_CONFIO read'
+END IF
+!
CALL IO_Config_set()
CALL IO_File_close(TZNMLFILE)
!
@@ -137,6 +168,15 @@ CALL IO_File_close(TZNMLFILE)
CALL IO_File_add2list(TZINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=2)
CALL IO_File_open(TZINIFILE)
!
+CALL IO_Field_read(TZINIFILE,'IMAX', NIMAX)
+CALL IO_Field_read(TZINIFILE,'JMAX', NJMAX)
+NKMAX = 1
+CALL IO_Field_read(TZINIFILE,'JPHEXT',JPHEXT)
+!
+CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
+CALL SET_DIM_ll(NIMAX, NJMAX, NKMAX)
+CALL INI_PARAZ_ll(IRESP)
+!
!* 2. Reading of MESONH file
! ----------------------
!
diff --git a/src/MNH/les_budget.f90 b/src/MNH/les_budget.f90
index 5219c5930a3a6a5c702f8ad724f0c68bfe692946..7209f09ae62dcb9a988c7ca633ad556e623c0917 100644
--- a/src/MNH/les_budget.f90
+++ b/src/MNH/les_budget.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.
@@ -9,12 +9,12 @@
!
INTERFACE
!
- SUBROUTINE LES_BUDGET(PVARS,KBUDN,HBUVAR)
+ SUBROUTINE LES_BUDGET(PVARS,KBUDN,HBUVAR,oadd)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
-INTEGER , INTENT(IN) :: KBUDN ! variable number
-CHARACTER (LEN=*) , INTENT(IN) :: HBUVAR ! Identifier of the Budget of the
- ! variable that is considered
+INTEGER, INTENT(IN) :: KBUDN ! variable number
+CHARACTER(LEN=*), INTENT(IN) :: HBUVAR ! Identifier of the budget of the variable that is considered
+logical, intent(in) :: oadd ! Flag to determine if source is to be added (true) or if is absolute (false)
END SUBROUTINE LES_BUDGET
@@ -23,7 +23,7 @@ END INTERFACE
END MODULE MODI_LES_BUDGET
!
! ####################################
- SUBROUTINE LES_BUDGET(PVARS,KBUDN,HBUVAR)
+ SUBROUTINE LES_BUDGET(PVARS,KBUDN,HBUVAR,oadd)
! ####################################
!
!!**** *LES_BUDGET* - stores
@@ -48,17 +48,19 @@ END MODULE MODI_LES_BUDGET
!! Original September 19, 2002
!! 25/11/2016 Q.Rodier correction bug variance u'^2 v'^2 w'^2
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 17/08/2020: treat LES budgets correctly
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use modd_budget, only: 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
USE MODD_LES
USE MODD_LES_BUDGET
USE MODD_NSV
!
USE MODI_SHUMAN
-USE MODI_THL_RT_FROM_TH_R
USE MODI_LES_VER_INT
USE MODI_LES_MEAN_ll
!
@@ -72,10 +74,10 @@ IMPLICIT NONE
! ------------------------------
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
-INTEGER , INTENT(IN) :: KBUDN ! variable number
-CHARACTER (LEN=*) , INTENT(IN) :: HBUVAR ! Identifier of the Budget of the
- ! variable that is considered
-
+INTEGER, INTENT(IN) :: KBUDN ! variable number
+CHARACTER(LEN=*), INTENT(IN) :: HBUVAR ! Identifier of the budget of the variable that is considered
+logical, intent(in) :: oadd ! Flag to determine if source is to be added (true) or if is absolute (false)
+!
!* 0.2 declaration of local variables
! ------------------------------
!
@@ -122,8 +124,12 @@ SELECT CASE (KBUDN)
!
!* u
!
- CASE(1)
- CALL LES_BUDGET_ANOMALY(PVARS,'X',ZANOM)
+ CASE( NBUDGET_U )
+ if ( oadd ) then
+ CALL LES_BUDGET_ANOMALY(XCURRENT_RUS + PVARS,'X',ZANOM)
+ else
+ CALL LES_BUDGET_ANOMALY(PVARS,'X',ZANOM)
+ end if
!
!* action in KE budget
ZWORK_LES = 0.5*( ZANOM ** 2 - XU_ANOM ** 2 ) / XCURRENT_TSTEP
@@ -131,13 +137,21 @@ SELECT CASE (KBUDN)
X_LES_BU_RES_KE(:,ILES_BU) = X_LES_BU_RES_KE(:,ILES_BU) + ZLES_PROF(:)
!
!* update fields
- XCURRENT_RUS = PVARS
+ if ( oadd ) then
+ XCURRENT_RUS = XCURRENT_RUS + PVARS
+ else
+ XCURRENT_RUS = PVARS
+ end if
XU_ANOM = ZANOM
!
!* v
!
- CASE(2)
- CALL LES_BUDGET_ANOMALY(PVARS,'Y',ZANOM)
+ CASE( NBUDGET_V )
+ if ( oadd ) then
+ CALL LES_BUDGET_ANOMALY(XCURRENT_RVS + PVARS,'Y',ZANOM)
+ else
+ CALL LES_BUDGET_ANOMALY(PVARS,'Y',ZANOM)
+ end if
!
!* action in KE budget
ZWORK_LES = 0.5*( ZANOM ** 2 - XV_ANOM ** 2 ) / XCURRENT_TSTEP
@@ -145,13 +159,21 @@ SELECT CASE (KBUDN)
X_LES_BU_RES_KE(:,ILES_BU) = X_LES_BU_RES_KE(:,ILES_BU) + ZLES_PROF(:)
!
!* update fields
- XCURRENT_RVS = PVARS
+ if ( oadd ) then
+ XCURRENT_RVS = XCURRENT_RVS + PVARS
+ else
+ XCURRENT_RVS = PVARS
+ end if
XV_ANOM = ZANOM
!
!* w
!
- CASE(3)
- CALL LES_BUDGET_ANOMALY(PVARS,'Z',ZANOM)
+ CASE( NBUDGET_W )
+ if ( oadd ) then
+ CALL LES_BUDGET_ANOMALY(XCURRENT_RWS + PVARS,'Z',ZANOM)
+ else
+ CALL LES_BUDGET_ANOMALY(PVARS,'Z',ZANOM)
+ end if
!
!* action in KE budget
ZWORK_LES = 0.5*( ZANOM ** 2 - XW_ANOM ** 2 ) / XCURRENT_TSTEP
@@ -178,13 +200,21 @@ SELECT CASE (KBUDN)
END DO
!
!* update fields
- XCURRENT_RWS = PVARS
+ if ( oadd ) then
+ XCURRENT_RWS = XCURRENT_RWS + PVARS
+ else
+ XCURRENT_RWS = PVARS
+ end if
XW_ANOM = ZANOM
!
!* Th
!
- CASE(4)
- XCURRENT_RTHLS = XCURRENT_RTHLS + PVARS - XCURRENT_RTHS
+ CASE( NBUDGET_TH )
+ if ( oadd ) then
+ XCURRENT_RTHLS = XCURRENT_RTHLS + PVARS
+ else
+ XCURRENT_RTHLS = XCURRENT_RTHLS + PVARS - XCURRENT_RTHS
+ end if
CALL LES_BUDGET_ANOMALY(XCURRENT_RTHLS,'-',ZANOM)
!
!* action in WTHL budget
@@ -206,15 +236,24 @@ SELECT CASE (KBUDN)
END IF
!
!* update fields
- XCURRENT_RTHS = PVARS
+ if ( oadd ) then
+ XCURRENT_RTHS = XCURRENT_RTHS + PVARS
+ else
+ XCURRENT_RTHS = PVARS
+ end if
XTHL_ANOM = ZANOM
!
!* Tke
!
- CASE(5)
+ CASE( NBUDGET_TKE )
ALLOCATE(ZTEND(IIU,IJU,IKU))
- ZTEND(:,:,:) = (PVARS(:,:,:)-XCURRENT_RTKES(:,:,:)) / XCURRENT_RHODJ
- XCURRENT_RTKES = PVARS
+ if ( oadd ) then
+ ZTEND(:,:,:) = PVARS(:,:,:) / XCURRENT_RHODJ
+ XCURRENT_RTKES = XCURRENT_RTKES+PVARS
+ else
+ ZTEND(:,:,:) = (PVARS(:,:,:)-XCURRENT_RTKES(:,:,:)) / XCURRENT_RHODJ
+ XCURRENT_RTKES = PVARS
+ end if
CALL LES_VER_INT( ZTEND, ZWORK_LES )
DEALLOCATE(ZTEND)
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
@@ -222,9 +261,13 @@ SELECT CASE (KBUDN)
!
!* Rv, Rr, Ri, Rs, Rg, Rh
!
- CASE(6,8,9,10,11,12)
+ CASE( NBUDGET_RV, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH )
!* transformation into conservative variables: RT
- XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-5)
+ if ( oadd ) then
+ XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:)
+ else
+ XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1))
+ end if
CALL LES_BUDGET_ANOMALY(XCURRENT_RRTS,'-',ZANOM)
!
!* action in WRT budget
@@ -244,16 +287,29 @@ SELECT CASE (KBUDN)
X_LES_BU_RES_THLRT(:,ILES_BU) = X_LES_BU_RES_THLRT(:,ILES_BU) + ZLES_PROF(:)
!
!* update fields
- XCURRENT_RRS(:,:,:,KBUDN-5) = PVARS
+ if ( oadd ) then
+ XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) = XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) + PVARS
+ else
+ XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) = PVARS
+ end if
XRT_ANOM = ZANOM
!
!* Rc
!
- CASE(7)
+ CASE( NBUDGET_RC )
!* transformation into conservative variables: theta_l; RT
- XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-5)
- XCURRENT_RTHLS = XCURRENT_RTHLS - XCURRENT_L_O_EXN_CP &
- * (PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-5))
+ if ( oadd ) then
+ XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:)
+ else
+ XCURRENT_RRTS = XCURRENT_RRTS + PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1))
+ end if
+ if ( oadd ) then
+ XCURRENT_RTHLS = XCURRENT_RTHLS - XCURRENT_L_O_EXN_CP &
+ * (PVARS(:,:,:) )
+ else
+ XCURRENT_RTHLS = XCURRENT_RTHLS - XCURRENT_L_O_EXN_CP &
+ * (PVARS(:,:,:) - XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)))
+ end if
!* anomaly of THL
ALLOCATE(ZTHL_ANOM(IIU,IJU,NLES_K))
@@ -291,31 +347,43 @@ SELECT CASE (KBUDN)
!
!
!* update fields
- XCURRENT_RRS(:,:,:,KBUDN-5) = PVARS
+ if ( oadd ) then
+ XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) = XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) + PVARS
+ else
+ XCURRENT_RRS(:,:,:,KBUDN-(NBUDGET_RV-1)) = PVARS
+ end if
XRT_ANOM = ZANOM
XTHL_ANOM = ZTHL_ANOM
DEALLOCATE(ZTHL_ANOM)
!
!* SV
!
- CASE(13:)
- CALL LES_BUDGET_ANOMALY(PVARS,'-',ZANOM)
+ CASE( NBUDGET_SV1: )
+ if ( oadd ) then
+ CALL LES_BUDGET_ANOMALY(XCURRENT_RSVS(:,:,:,KBUDN-(NBUDGET_SV1-1)) + PVARS,'-',ZANOM)
+ else
+ CALL LES_BUDGET_ANOMALY(PVARS,'-',ZANOM)
+ end if
!
!* action in WSV budget
- ZWORK_LES = ( ZANOM * XW_ANOM - XSV_ANOM(:,:,:,KBUDN-12) * XW_ANOM ) / &
+ ZWORK_LES = ( ZANOM * XW_ANOM - XSV_ANOM(:,:,:,KBUDN-(NBUDGET_SV1-1)) * XW_ANOM ) / &
XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_WSV(:,ILES_BU,KBUDN-12) = X_LES_BU_RES_WSV(:,ILES_BU,KBUDN-12) + ZLES_PROF(:)
+ X_LES_BU_RES_WSV(:,ILES_BU,KBUDN-(NBUDGET_SV1-1)) = X_LES_BU_RES_WSV(:,ILES_BU,KBUDN-(NBUDGET_SV1-1)) + ZLES_PROF(:)
!
!* action in SV2 budget
- ZWORK_LES = ( ZANOM **2 - XSV_ANOM(:,:,:,KBUDN-12) **2 ) / &
+ ZWORK_LES = ( ZANOM **2 - XSV_ANOM(:,:,:,KBUDN-(NBUDGET_SV1-1)) **2 ) / &
XCURRENT_TSTEP
CALL LES_MEAN_ll( ZWORK_LES, LLES_CURRENT_CART_MASK, ZLES_PROF)
- X_LES_BU_RES_SV2(:,ILES_BU,KBUDN-12) = X_LES_BU_RES_SV2(:,ILES_BU,KBUDN-12) + ZLES_PROF(:)
+ X_LES_BU_RES_SV2(:,ILES_BU,KBUDN-(NBUDGET_SV1-1)) = X_LES_BU_RES_SV2(:,ILES_BU,KBUDN-(NBUDGET_SV1-1)) + ZLES_PROF(:)
!
!* update fields
- XCURRENT_RSVS(:,:,:,KBUDN-12) = PVARS
- XSV_ANOM(:,:,:,KBUDN-12) = ZANOM
+ if ( oadd ) then
+ XCURRENT_RSVS(:,:,:,KBUDN-(NBUDGET_SV1-1)) = XCURRENT_RSVS(:,:,:,KBUDN-(NBUDGET_SV1-1)) + PVARS
+ else
+ XCURRENT_RSVS(:,:,:,KBUDN-(NBUDGET_SV1-1)) = PVARS
+ end if
+ XSV_ANOM(:,:,:,KBUDN-(NBUDGET_SV1-1)) = ZANOM
END SELECT
!
@@ -338,37 +406,39 @@ CHARACTER (LEN=*), INTENT(IN) :: HBU ! Identifier of the Budget of the
! variable that is considered
INTEGER, INTENT(OUT) :: KLES_BU ! LES budget identifier
!
-IF (HBU(1:3)=='ADV') THEN
+IF (HBU=='ADV') THEN
KLES_BU = NLES_TOTADV
-ELSE IF (HBU(1:3)=='REL') THEN
+ELSE IF (HBU=='REL') THEN
KLES_BU = NLES_RELA
-ELSE IF (HBU(1:5)=='VTURB') THEN
+ELSE IF (HBU=='VTURB') THEN
KLES_BU = NLES_VTURB
-ELSE IF (HBU(1:5)=='HTURB') THEN
+ELSE IF (HBU=='HTURB') THEN
KLES_BU = NLES_HTURB
-ELSE IF (HBU(1:4)=='GRAV') THEN
+ELSE IF (HBU=='GRAV') THEN
KLES_BU = NLES_GRAV
-ELSE IF (HBU(1:4)=='PRES') THEN
+ELSE IF (HBU=='PRES') THEN
KLES_BU = NLES_PRES
-ELSE IF (HBU(1:4)=='PREF') THEN
+ELSE IF (HBU=='PREF') THEN
KLES_BU = NLES_PREF
-ELSE IF (HBU(1:4)=='CURV') THEN
+ELSE IF (HBU=='CURV') THEN
KLES_BU = NLES_CURV
-ELSE IF (HBU(1:3)=='COR') THEN
+ELSE IF (HBU=='COR') THEN
KLES_BU = NLES_COR
-ELSE IF (HBU(1:2)=='DP') THEN
+ELSE IF (HBU=='DP') THEN
KLES_BU = NLES_DP
-ELSE IF (HBU(1:2)=='TP') THEN
+ELSE IF (HBU=='TP') THEN
KLES_BU = NLES_TP
-ELSE IF (HBU(1:2)=='TR') THEN
+ELSE IF (HBU=='TR') THEN
KLES_BU = NLES_TR
-ELSE IF (HBU(1:4)=='DISS') THEN
+ELSE IF ( HBU == 'DISS' .OR. HBU == 'DISSH' ) THEN
+ !Both DISS and DISSH source terms are included in the same index
+ !but they are stored in different budgets (DISS goes to NBUDGET_TKE, DISSH to NBUDGET_TH)
KLES_BU = NLES_DISS
-ELSE IF (HBU(1:3)=='DIF') THEN
+ELSE IF (HBU=='DIF') THEN
KLES_BU = NLES_DIFF
-ELSE IF (HBU(1:3)=='RAD') THEN
+ELSE IF (HBU=='RAD') THEN
KLES_BU = NLES_RAD
-ELSE IF (HBU(1:4)=='NEST') THEN
+ELSE IF (HBU=='NEST') THEN
KLES_BU = NLES_NEST
ELSE
KLES_BU = NLES_MISC
diff --git a/src/MNH/les_ini_timestepn.f90 b/src/MNH/les_ini_timestepn.f90
index f1d8cb6a3cacee43cf315ac25ca908f3b2b8f173..c93c4c887d19394fa34a5e9ee91e760fddb04503 100644
--- a/src/MNH/les_ini_timestepn.f90
+++ b/src/MNH/les_ini_timestepn.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.
@@ -48,8 +48,9 @@ END MODULE MODI_LES_INI_TIMESTEP_n
!! MODIFICATIONS
!! -------------
!! Original 06/11/02
-!!
-!! --------------------------------------------------------------------------
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -68,6 +69,7 @@ USE MODD_TIME
USE MODD_CONF
USE MODD_LES_BUDGET
!
+use mode_datetime, only: Datetime_distance
USE MODE_ll
USE MODE_MODELN_HANDLER
!
@@ -143,25 +145,8 @@ NLES_TCOUNT = NLES_TCOUNT + 1
!
NLES_CURRENT_TCOUNT = NLES_TCOUNT
!
-!
-XLES_DATIME( 1,NLES_TCOUNT) = TDTEXP%TDATE%YEAR
-XLES_DATIME( 2,NLES_TCOUNT) = TDTEXP%TDATE%MONTH
-XLES_DATIME( 3,NLES_TCOUNT) = TDTEXP%TDATE%DAY
-XLES_DATIME( 4,NLES_TCOUNT) = TDTEXP%TIME
-XLES_DATIME( 5,NLES_TCOUNT) = TDTSEG%TDATE%YEAR
-XLES_DATIME( 6,NLES_TCOUNT) = TDTSEG%TDATE%MONTH
-XLES_DATIME( 7,NLES_TCOUNT) = TDTSEG%TDATE%DAY
-XLES_DATIME( 8,NLES_TCOUNT) = TDTSEG%TIME
-XLES_DATIME( 9,NLES_TCOUNT) = TDTMOD%TDATE%YEAR
-XLES_DATIME(10,NLES_TCOUNT) = TDTMOD%TDATE%MONTH
-XLES_DATIME(11,NLES_TCOUNT) = TDTMOD%TDATE%DAY
-XLES_DATIME(12,NLES_TCOUNT) = TDTMOD%TIME
-XLES_DATIME(13,NLES_TCOUNT) = TDTCUR%TDATE%YEAR
-XLES_DATIME(14,NLES_TCOUNT) = TDTCUR%TDATE%MONTH
-XLES_DATIME(15,NLES_TCOUNT) = TDTCUR%TDATE%DAY
-XLES_DATIME(16,NLES_TCOUNT) = TDTCUR%TIME
-!
-XLES_TRAJT(NLES_TCOUNT,1) = (KTCOUNT-1) * XTSTEP
+tles_dates(nles_tcount) = tdtcur
+call Datetime_distance( tdtseg, tdtcur, xles_times(nles_tcount) )
!
!* forward-in-time time-step
!
@@ -192,10 +177,10 @@ IMI = GET_CURRENT_MODEL_INDEX()
!
ALLOCATE(LLES_CURRENT_CART_MASK(IIU,IJU,NLES_K))
!
-IIINF_MASK = MAX(IIB, NLESn_IINF(IMI)-(IIB_ll-1-JPHEXT))
-IJINF_MASK = MAX(IJB, NLESn_JINF(IMI)-(IJB_ll-1-JPHEXT))
-IISUP_MASK = MIN(IIE, NLESn_ISUP(IMI)-(IIB_ll-1-JPHEXT))
-IJSUP_MASK = MIN(IJE, NLESn_JSUP(IMI)-(IJB_ll-1-JPHEXT))
+IIINF_MASK = MAX(IIB, NLESn_IINF(IMI)+JPHEXT-(IIB_ll-1-JPHEXT))
+IJINF_MASK = MAX(IJB, NLESn_JINF(IMI)+JPHEXT-(IJB_ll-1-JPHEXT))
+IISUP_MASK = MIN(IIE, NLESn_ISUP(IMI)+JPHEXT-(IIB_ll-1-JPHEXT))
+IJSUP_MASK = MIN(IJE, NLESn_JSUP(IMI)+JPHEXT-(IJB_ll-1-JPHEXT))
!
!
LLES_CURRENT_CART_MASK(:,:,:) = .FALSE.
diff --git a/src/MNH/les_masksn.f90 b/src/MNH/les_masksn.f90
deleted file mode 100644
index 4add46bb679c571b27504ffe3a721408c882effe..0000000000000000000000000000000000000000
--- a/src/MNH/les_masksn.f90
+++ /dev/null
@@ -1,188 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 les 2006/08/30 18:38:57
-!-----------------------------------------------------------------
-! ################
-MODULE MODI_LES_MASKS_n
-! ################
-!
-!
-!
-INTERFACE LES_MASKS_n
-!
- SUBROUTINE LES_MASKS_n(KTCOUNT)
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
-!
-END SUBROUTINE LES_MASKS_n
-!
-END INTERFACE
-!
-END MODULE MODI_LES_MASKS_n
-
-! #######################
- SUBROUTINE LES_MASKS_n(KTCOUNT)
-! #######################
-!
-!
-!!**** *LES_MASKS_n* initializes the LES variables for
-!! the current time-step of model _n
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/02/00
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_LES
-USE MODD_LES_n
-USE MODD_FIELD_n
-USE MODD_CONF_n
-USE MODD_TIME_n
-USE MODD_DYN_n
-USE MODD_TIME
-!
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-INTEGER, INTENT(IN) :: KTCOUNT ! current model time-step
-!
-!
-! 0.2 declaration of local variables
-!
-INTEGER :: IXOR_ll, IYOR_ll ! origine point coordinates
-! ! of current processor domain
-! ! on model domain on all
-! ! processors
-INTEGER :: IIB_ll, IJB_ll ! SO point coordinates of
-! ! current processor phys. domain
-! ! on model domain on all
-! ! processors
-INTEGER :: IIE_ll, IJE_ll ! NE point coordinates of
-! ! current processor phys. domain
-! ! on model domain on all
-! ! processors
-INTEGER :: IIINF_MASK, IISUP_MASK ! cart. mask local proc. limits
-INTEGER :: IJINF_MASK, IJSUP_MASK ! cart. mask local proc. limits
-!
-INTEGER :: JK ! vertical loop counter
-INTEGER :: IIB, IJB, IIE, IJE ! hor. indices
-INTEGER :: IIU, IJU ! hor. indices
-INTEGER :: IKU ! ver. index
-INTEGER :: IRR, IRRC, IRRR, IRRI, IRRS, IRRG ! moist variables indices
-INTEGER :: IMI ! Current model index
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. Does current time-step is a LES time-step?
-! -----------------------------------------
-!
-LLES_CALL= .FALSE.
-!
-IF (.NOT. LLES) RETURN
-!
-IF ( KTCOUNT>1 .AND. MOD (KTCOUNT-1,NLES_DTCOUNT)==0) LLES_CALL=.TRUE.
-!
-IF (.NOT. LLES_CALL) RETURN
-!
-NLES_TCOUNT = NLES_TCOUNT + 1
-!
-NLES_CURRENT_TCOUNT = NLES_TCOUNT
-!
-!
-XLES_DATIME( 1,NLES_TCOUNT) = TDTEXP%TDATE%YEAR
-XLES_DATIME( 2,NLES_TCOUNT) = TDTEXP%TDATE%MONTH
-XLES_DATIME( 3,NLES_TCOUNT) = TDTEXP%TDATE%DAY
-XLES_DATIME( 4,NLES_TCOUNT) = TDTEXP%TIME
-XLES_DATIME( 5,NLES_TCOUNT) = TDTSEG%TDATE%YEAR
-XLES_DATIME( 6,NLES_TCOUNT) = TDTSEG%TDATE%MONTH
-XLES_DATIME( 7,NLES_TCOUNT) = TDTSEG%TDATE%DAY
-XLES_DATIME( 8,NLES_TCOUNT) = TDTSEG%TIME
-XLES_DATIME( 9,NLES_TCOUNT) = TDTMOD%TDATE%YEAR
-XLES_DATIME(10,NLES_TCOUNT) = TDTMOD%TDATE%MONTH
-XLES_DATIME(11,NLES_TCOUNT) = TDTMOD%TDATE%DAY
-XLES_DATIME(12,NLES_TCOUNT) = TDTMOD%TIME
-XLES_DATIME(13,NLES_TCOUNT) = TDTCUR%TDATE%YEAR
-XLES_DATIME(14,NLES_TCOUNT) = TDTCUR%TDATE%MONTH
-XLES_DATIME(15,NLES_TCOUNT) = TDTCUR%TDATE%DAY
-XLES_DATIME(16,NLES_TCOUNT) = TDTCUR%TIME
-!
-XLES_TRAJT(NLES_TCOUNT,1) = (KTCOUNT-1) * XTSTEP
-!
-!-------------------------------------------------------------------------------
-!
-CALL GET_OR_ll ('B',IXOR_ll,IYOR_ll)
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-!
-IIB_ll=IXOR_ll+IIB-1
-IJB_ll=IYOR_ll+IJB-1
-IIE_ll=IXOR_ll+IIE-1
-IJE_ll=IYOR_ll+IJE-1
-!
-IKU = SIZE(XTHT,3)
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Definition of masks
-! -------------------
-!
-!* 2.1 Cartesian (sub-)domain (on local processor)
-! ----------------------
-!
-ALLOCATE(LLES_CURRENT_CART_MASK(IIU,IJU,NLES_K))
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-!
-IIINF_MASK = MAX(IIB, NLESn_IINF(IMI)-(IIB_ll-1-JPHEXT))
-IJINF_MASK = MAX(IJB, NLESn_JINF(IMI)-(IJB_ll-1-JPHEXT))
-IISUP_MASK = MIN(IIE, NLESn_ISUP(IMI)-(IIB_ll-1-JPHEXT))
-IJSUP_MASK = MIN(IJE, NLESn_JSUP(IMI)-(IJB_ll-1-JPHEXT))
-!
-LLES_CURRENT_CART_MASK(:,:,:) = .FALSE.
-LLES_CURRENT_CART_MASK(IIINF_MASK:IISUP_MASK,IJINF_MASK:IJSUP_MASK,:) = .TRUE.
-!
-CLES_CURRENT_LBCX(:) = CLES_LBCX(:,IMI)
-CLES_CURRENT_LBCY(:) = CLES_LBCY(:,IMI)
-!
-!
-!* 2.2 Cloud masks
-! -----------
-!
-CALL LES_CLOUD_MASKS_n
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE LES_MASKS_n
diff --git a/src/MNH/les_specn.f90 b/src/MNH/les_specn.f90
index d95300068acd362bb731f6c51a9f656b56df3205..9be8e1f806c535837045c3199af39c14bac9815a 100644
--- a/src/MNH/les_specn.f90
+++ b/src/MNH/les_specn.f90
@@ -1,12 +1,31 @@
-!MNH_LIC Copyright 2000-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 12/10/2020: restructure Les_diachro_spec subroutine to use tfield_metadata_base type
+!-----------------------------------------------------------------
! ######################
MODULE MODE_LES_SPEC_n
! ######################
-!
+
+use modd_field, only: tfield_metadata_base
+
+implicit none
+
+private
+
+public :: Les_spec_n
+
+
+real, dimension(:,:,:,:), allocatable :: xspectrax ! spectra coeffcients for
+real, dimension(:,:,:,:), allocatable :: xspectray ! x and y direction spectra
+
+type(tfield_metadata_base) :: tlesfieldx
+type(tfield_metadata_base) :: tlesfieldy
+
+
CONTAINS
!
! ######################
@@ -48,27 +67,33 @@ CONTAINS
!! Original 07/02/00
!! 01/02/01 (D. Gazen) add module MODD_NSV for NSV variable
!! 01/04/03 (V. Masson) bug in spectra normalization
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CONF
-USE MODD_CONF_n
-USE MODD_GRID_n
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LBC_n, ONLY: CLBCX, CLBCY
-USE MODD_LES
-USE MODD_LES_n
-USE MODD_NSV, ONLY: NSV
-!
-USE MODE_LES_DIACHRO
-USE MODE_ll
-!
-USE MODI_WRITE_LES_n
-!
+use modd_conf_n, only: luserv, luserc, luseri
+use modd_field, only: NMNHDIM_COMPLEX, NMNHDIM_BUDGET_LES_TIME, NMNHDIM_SPECTRA_SPEC_NI, &
+ NMNHDIM_SPECTRA_SPEC_NJ, NMNHDIM_SPECTRA_LEVEL, NMNHDIM_UNUSED, &
+ TYPEREAL
+use modd_io, only: tfiledata
+use modd_lbc_n, only: clbcx, clbcy
+use modd_les, only: nspectra_k
+use modd_les_n, only: nles_times, nspectra_ni, nspectra_nj, &
+ XCORRi_UU, XCORRi_VV, XCORRi_UV, XCORRi_WU, XCORRi_WV, XCORRi_WW, &
+ XCORRi_WTh, XCORRi_WThl, XCORRi_WRv, XCORRi_WRc, XCORRi_WRi, XCORRi_WSv, &
+ XCORRi_ThTh, XCORRi_ThRv, XCORRi_ThRc, XCORRi_ThRi, XCORRi_ThlThl, &
+ XCORRi_ThlRv, XCORRi_ThlRc, XCORRi_ThlRi, &
+ XCORRi_RvRv, XCORRi_RcRc, XCORRi_RiRi, XCORRi_SvSv, &
+ XCORRj_UU, XCORRj_VV, XCORRj_UV, XCORRj_WU, XCORRj_WV, XCORRj_WW, &
+ XCORRj_WTh, XCORRj_WThl, XCORRj_WRv, XCORRj_WRc, XCORRj_WRi, XCORRj_WSv, &
+ XCORRj_ThTh, XCORRj_ThRv, XCORRj_ThRc, XCORRj_ThRi, XCORRj_ThlThl, &
+ XCORRj_ThlRv, XCORRj_ThlRc, XCORRj_ThlRi, &
+ XCORRj_RvRv, XCORRj_RcRc, XCORRj_RiRi, XCORRj_SvSv
+
+use modd_nsv, only: nsv
+
IMPLICIT NONE
!
!
@@ -78,15 +103,10 @@ TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
!
!* 0.2 declaration of local variables
!
-INTEGER :: JSV ! scalar loop counter
-!
-CHARACTER(len=5) :: YGROUP
-!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSPECTRAX ! spectra coeffcients for
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSPECTRAY ! x and y direction spectra
-!
-INTEGER :: ISPECTRA_NI
-INTEGER :: ISPECTRA_NJ
+INTEGER :: ISPECTRA_NI
+INTEGER :: ISPECTRA_NJ
+INTEGER :: JSV ! scalar loop counter
+CHARACTER(len=5) :: YGROUP
!-------------------------------------------------------------------------------
!
IF (CLBCX(1)=='CYCL') THEN
@@ -101,137 +121,119 @@ ELSE
ISPECTRA_NJ = NSPECTRA_NJ - 1
END IF
!
-ALLOCATE( ZSPECTRAX(ISPECTRA_NI,2,NSPECTRA_K,NLES_TIMES) )
-ALLOCATE( ZSPECTRAY(ISPECTRA_NJ,2,NSPECTRA_K,NLES_TIMES) )
-!
-!
!* 1. (ni,z,t) and (nj,z,t) spectra
! -----------------------------
!
-IF (NSPECTRA_K>0) THEN
- CALL LES_SPEC('X',XCORRi_UU, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_UU, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"UU ","U*U spectra","m3 s-2",ZSPECTRAX,ZSPECTRAY)
-!
- CALL LES_SPEC('X',XCORRi_VV, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_VV, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"VV ","V*V spectra","m3 s-2",ZSPECTRAX,ZSPECTRAY)
-!
- CALL LES_SPEC('X',XCORRi_WW, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_WW, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"WW ","W*W spectra","m3 s-2",ZSPECTRAX,ZSPECTRAY)
-!
- CALL LES_SPEC('X',XCORRi_UV, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_UV, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"UV ","U*V spectra","m3 s-2",ZSPECTRAX,ZSPECTRAY)
-!
- CALL LES_SPEC('X',XCORRi_WU, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_WU, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"WU ","W*U spectra","m3 s-2",ZSPECTRAX,ZSPECTRAY)
-!
- CALL LES_SPEC('X',XCORRi_WV, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_WV, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"WV ","W*V spectra","m3 s-2",ZSPECTRAX,ZSPECTRAY)
-!
- CALL LES_SPEC('X',XCORRi_ThTh, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_ThTh, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"THTH ","Th*Th spectra","m K2",ZSPECTRAX,ZSPECTRAY)
-!
- IF (LUSERC) THEN
- CALL LES_SPEC('X',XCORRi_ThlThl, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_ThlThl, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"TLTL ","Thl*Thl spectra","m K2",ZSPECTRAX,ZSPECTRAY)
- END IF
-!
- CALL LES_SPEC('X',XCORRi_WTh, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_WTh, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"WTH ","W*Th spectra","m2 K s-1",ZSPECTRAX,ZSPECTRAY)
-!
- IF (LUSERC) THEN
- CALL LES_SPEC('X',XCORRi_WThl, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_WThl, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"WTHL ","W*Thl spectra","m2 K s-1",ZSPECTRAX,ZSPECTRAY)
- END IF
- !
- IF (LUSERV) THEN
- CALL LES_SPEC('X',XCORRi_RvRv, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_RvRv, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"RVRV ","rv*rv spectra","m",ZSPECTRAX,ZSPECTRAY)
- !
- CALL LES_SPEC('X',XCORRi_ThRv, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_ThRv, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"THRV ","th*rv spectra","K m",ZSPECTRAX,ZSPECTRAY)
- !
- IF (LUSERC) THEN
- CALL LES_SPEC('X',XCORRi_ThlRv, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_ThlRv, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"TLRV ","thl*rv spectra","K m",ZSPECTRAX,ZSPECTRAY)
- END IF
- !
- CALL LES_SPEC('X',XCORRi_WRv, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_WRv, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"WRV ","W*rv spectra","m K s-1",ZSPECTRAX,ZSPECTRAY)
- END IF
- IF (LUSERC) THEN
- CALL LES_SPEC('X',XCORRi_RcRc, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_RcRc, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"RCRC ","rc*rc spectra","m",ZSPECTRAX,ZSPECTRAY)
- !
- CALL LES_SPEC('X',XCORRi_ThRc, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_ThRc, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"THRC ","th*rc spectra","K m",ZSPECTRAX,ZSPECTRAY)
- !
- CALL LES_SPEC('X',XCORRi_ThlRc, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_ThlRc, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"TLRC ","thl*rc spectra","K m",ZSPECTRAX,ZSPECTRAY)
- !
- CALL LES_SPEC('X',XCORRi_WRc, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_WRc, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"WRC ","W*rc spectra","m K s-1",ZSPECTRAX,ZSPECTRAY)
- END IF
- IF (LUSERI) THEN
- CALL LES_SPEC('X',XCORRi_RiRi, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_RiRi, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"RIRI ","ri*ri spectra","m",ZSPECTRAX,ZSPECTRAY)
- !
- CALL LES_SPEC('X',XCORRi_ThRi, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_ThRi, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"THRI ","th*ri spectra","K m",ZSPECTRAX,ZSPECTRAY)
- !
- CALL LES_SPEC('X',XCORRi_ThlRi, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_ThlRi, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"TLRI ","thl*ri spectra","K m",ZSPECTRAX,ZSPECTRAY)
- !
- CALL LES_SPEC('X',XCORRi_WRi, ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_WRi, ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,"WRI ","W*ri spectra","m K s-1",ZSPECTRAX,ZSPECTRAY)
- END IF
- DO JSV=1,NSV
- WRITE (YGROUP,FMT="(A2,I3.3)") "SS",JSV
- CALL LES_SPEC('X',XCORRi_SvSv(:,:,:,JSV), ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_SvSv(:,:,:,JSV), ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,YGROUP,"Sv*Sv spectra","m",ZSPECTRAX,ZSPECTRAY)
- END DO
- DO JSV=1,NSV
- WRITE (YGROUP,FMT="(A2,I3.3)") "WS",JSV
- CALL LES_SPEC('X',XCORRi_WSv(:,:,:,JSV), ZSPECTRAX)
- CALL LES_SPEC('Y',XCORRj_WSv(:,:,:,JSV), ZSPECTRAY)
- CALL LES_DIACHRO_SPEC(TPDIAFILE,YGROUP,"W*Sv spectra","m2 s-1",ZSPECTRAX,ZSPECTRAY)
- END DO
-END IF
-!
-DEALLOCATE( ZSPECTRAX )
-DEALLOCATE( ZSPECTRAY )
+if ( nspectra_k > 0 ) then
+ allocate( xspectrax(ispectra_ni, 2, nspectra_k, nles_times) )
+ allocate( xspectray(ispectra_nj, 2, nspectra_k, nles_times) )
+
+ tlesfieldx%clongname = ''
+ tlesfieldx%ngrid = 0
+ tlesfieldx%ntype = TYPEREAL
+ tlesfieldx%ndims = 4
+ tlesfieldx%ndimlist(1) = NMNHDIM_SPECTRA_SPEC_NI
+ tlesfieldx%ndimlist(2) = NMNHDIM_COMPLEX
+ tlesfieldx%ndimlist(3) = NMNHDIM_SPECTRA_LEVEL
+ tlesfieldx%ndimlist(4) = NMNHDIM_BUDGET_LES_TIME
+ tlesfieldx%ndimlist(5:) = NMNHDIM_UNUSED
+
+ tlesfieldy = tlesfieldx
+ tlesfieldy%ndimlist(1) = NMNHDIM_SPECTRA_SPEC_NJ
+
+ call Les_specn_write_one_field( tpdiafile, XCORRi_UU, XCORRj_UU, 'UU', 'U*U spectra', 'm3 s-2' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_VV, XCORRj_VV, 'VV', 'V*V spectra', 'm3 s-2' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_WW, XCORRj_WW, 'WW', 'W*W spectra', 'm3 s-2' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_UV, XCORRj_UV, 'UV', 'U*V spectra', 'm3 s-2' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_WU, XCORRj_WU, 'WU', 'W*U spectra', 'm3 s-2' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_WV, XCORRj_WV, 'WV', 'W*V spectra', 'm3 s-2' )
+
+ call Les_specn_write_one_field( tpdiafile, XCORRi_ThTh, XCORRj_ThTh, 'THTH', 'Th*Th spectra', 'm K2' )
+ if ( luserc ) then
+ call Les_specn_write_one_field( tpdiafile, XCORRi_ThlThl, XCORRj_ThlThl, 'TLTL', 'Thl*Thl spectra', 'm K2' )
+ end if
+
+ call Les_specn_write_one_field( tpdiafile, XCORRi_WTh, XCORRj_WTh, 'WTH', 'W*Th spectra', 'm2 K s-1' )
+ if ( luserc ) then
+ call Les_specn_write_one_field( tpdiafile, XCORRi_WThl, XCORRj_WThl, 'WTHL', 'W*Thl spectra', 'm2 K s-1' )
+ end if
+
+ if ( luserv ) then
+ call Les_specn_write_one_field( tpdiafile, XCORRi_RvRv, XCORRj_RvRv, 'RVRV', 'rv*rv spectra', 'm' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_ThRv, XCORRj_ThRv, 'THRV', 'th*rv spectra', 'K m' )
+ if ( luserc ) then
+ call Les_specn_write_one_field( tpdiafile, XCORRi_ThlRv, XCORRj_ThlRv, 'TLRV', 'thl*rv spectra', 'K m' )
+ end if
+ call Les_specn_write_one_field( tpdiafile, XCORRi_WRv, XCORRj_WRv, 'WRV', 'W*rv spectra', 'm K s-1' )
+ end if
+
+ if ( luserc ) then
+ call Les_specn_write_one_field( tpdiafile, XCORRi_RcRc, XCORRj_RcRc, 'RCRC', 'rc*rc spectra', 'm' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_ThRc, XCORRj_ThRc, 'THRC', 'th*rc spectra', 'K m' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_ThlRc, XCORRj_ThlRc, 'TLRC', 'thl*rc spectra', 'K m' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_WRc, XCORRj_WRc, 'WRC', 'W*rc spectra', 'm K s-1' )
+ end if
+
+ if ( luseri ) then
+ call Les_specn_write_one_field( tpdiafile, XCORRi_RiRi, XCORRj_RiRi, 'RIRI', 'ri*ri spectra', 'm' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_ThRi, XCORRj_ThRi, 'THRI', 'th*ri spectra', 'K m' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_ThlRi, XCORRj_ThlRi, 'TLRI', 'thl*ri spectra', 'K m' )
+ call Les_specn_write_one_field( tpdiafile, XCORRi_WRi, XCORRj_WRi, 'WRI', 'W*ri spectra', 'm K s-1' )
+ end if
+
+ do jsv = 1, nsv
+ Write( ygroup, fmt = "( a2, i3.3 )" ) "SS", jsv
+ call Les_specn_write_one_field( tpdiafile, XCORRi_SvSv(:,:,:,JSV), XCORRj_SvSv(:,:,:,JSV), ygroup, 'Sv*Sv spectra','m' )
+ end do
+
+ do jsv = 1, nsv
+ Write( ygroup, fmt = "( a2, i3.3 )" ) "WS", jsv
+ call Les_specn_write_one_field( tpdiafile, XCORRi_WSv(:,:,:,JSV), XCORRj_WSv(:,:,:,JSV), ygroup, 'W*Sv spectra','m2 s-1' )
+ end do
+
+ deallocate( xspectrax )
+ deallocate( xspectray )
+end if
+
+END SUBROUTINE LES_SPEC_n
!
!------------------------------------------------------------------------------
-!
-CONTAINS
-!
+
+subroutine Les_specn_write_one_field( tpdiafile, zcorri, zcorrj, ymnhname, ycomment, yunits )
+
+use modd_io, only: tfiledata
+
+use mode_les_diachro, only: Les_diachro_spec
+
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+real, dimension(:,:,:), intent(in) :: zcorri ! 2 pts correlation data
+real, dimension(:,:,:), intent(in) :: zcorrj ! 2 pts correlation data
+character(len=*), intent(in) :: ymnhname
+character(len=*), intent(in) :: ycomment
+character(len=*), intent(in) :: yunits
+
+call Les_spec('X', zcorri, xspectrax)
+call Les_spec('Y', zcorrj, xspectray)
+
+tlesfieldx%cmnhname = ymnhname
+tlesfieldx%ccomment = ycomment
+tlesfieldx%cunits = yunits
+
+tlesfieldy%cmnhname = tlesfieldx%cmnhname
+tlesfieldy%ccomment = tlesfieldx%ccomment
+tlesfieldy%cunits = tlesfieldx%cunits
+
+call Les_diachro_spec( tpdiafile, tlesfieldx, tlesfieldy, xspectrax, xspectray )
+
+end subroutine Les_specn_write_one_field
+
!------------------------------------------------------------------------------
!
SUBROUTINE LES_SPEC(HDIR,ZCORR,ZSPECTRA)
!
-USE MODD_CST
+use modd_conf, only: l2d
+use modd_cst, only: xpi
+use modd_grid_n, only: xxhat, xyhat
!
CHARACTER(len=1), INTENT(IN) :: HDIR ! direction of spectra
REAL, DIMENSION(:,:,:), INTENT(IN) :: ZCORR ! 2 pts correlation data
@@ -290,7 +292,5 @@ ZSPECTRA(:,:,:,:) = ZSPECTRA(:,:,:,:) / (2.*XPI*ZDX*(INK/2))
END SUBROUTINE LES_SPEC
!
!------------------------------------------------------------------------------
-!
-END SUBROUTINE LES_SPEC_n
END MODULE MODE_LES_SPEC_n
diff --git a/src/MNH/les_ver_int.f90 b/src/MNH/les_ver_int.f90
index ab51b22a7e8881170588bd3089b5dd0e8dde315d..15a870219fb81713460ad401ce207c26aabbb6e6 100644
--- a/src/MNH/les_ver_int.f90
+++ b/src/MNH/les_ver_int.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2019 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.
@@ -63,8 +63,8 @@ END MODULE MODI_LES_VER_INT
!! -------------
!! Original 07/02/00
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!!
-!! --------------------------------------------------------------------------
+! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -94,7 +94,7 @@ INTEGER :: JK ! vertical loop counter
!
IF (CLES_LEVEL_TYPE=='K') THEN
DO JK = 1, NLES_K
- PA_LES(:,:,JK) = PA_MNH(:,:,NLES_LEVELS(JK))
+ PA_LES(:,:,JK) = PA_MNH(:,:,NLES_LEVELS(JK) + JPVEXT )
END DO
ELSE IF (CLES_LEVEL_TYPE=='Z') THEN
PA_LES = VER_INTERP_LIN(PA_MNH,NKLIN_CURRENT_LES,XCOEFLIN_CURRENT_LES)
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/lidar.f90 b/src/MNH/lidar.f90
index 976de3ca396061d429dbdb10531c45da38bfc020..4a3d987e8873486c7ce58e984cf78dc6b21a49da 100644
--- a/src/MNH/lidar.f90
+++ b/src/MNH/lidar.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2007-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2007-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -86,6 +86,7 @@ END MODULE MODI_LIDAR
!! add inputs (lidar charact. and cloud fraction)
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! B.VIE 2016 : LIMA
+! P. Wautelet 18/03/2020: remove ICE2 option
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -260,7 +261,7 @@ SELECT CASE ( HCLOUD )
ZRTMIN(2) = 1.0E-20
ZRTMIN(3) = 1.0E-20
ZLBEXR = 1.0/(-1.0-3.0)
- CASE('ICE2','ICE3','ICE4')
+ CASE('ICE3','ICE4')
ZRTMIN(1:SIZE(WRTMIN)) = WRTMIN(1:SIZE(WRTMIN))
ZLBEXR = WLBEXR
ZCCS = XCCS
@@ -370,7 +371,7 @@ ZREFF_FACT = 1.0E-3*(3.E3/(4.0*XPI*0.67E-3))**0.33 ! Continental N=500
ZREFF_FACT = 1.0E-3*(3.E3/(4.0*XPI*0.80E-3))**0.33 ! Maritime N=150
!
SELECT CASE ( HCLOUD )
- CASE('KESS','ICE2','ICE3','ICE4')
+ CASE('KESS','ICE3','ICE4')
DO JK = IKB, IKE
DO JJ = IJB, IJE
DO JI = IIB, IIE
@@ -462,7 +463,7 @@ END SELECT
! SOLID ICE
!
SELECT CASE ( HCLOUD )
- CASE('ICE2','ICE3','ICE4')
+ CASE('ICE3','ICE4')
DO JK = IKB, IKE
DO JJ = IJB, IJE
DO JI = IIB, IIE
@@ -512,7 +513,7 @@ SELECT CASE ( HCLOUD )
END DO
END SELECT
SELECT CASE ( HCLOUD )
- CASE('ICE2','ICE3','ICE4','C3R5','LIMA')
+ CASE('ICE3','ICE4','C3R5','LIMA')
DO JK = IKB, IKE
DO JJ = IJB, IJE
DO JI = IIB, IIE
diff --git a/src/MNH/lima.f90 b/src/MNH/lima.f90
index 851660cf9fc9c96c62d3af27de1c3667d02115fe..c248f1acf5366d8bea72fab2055770f2562e5cc4 100644
--- a/src/MNH/lima.f90
+++ b/src/MNH/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.
@@ -9,17 +9,18 @@ MODULE MODI_LIMA
!
INTERFACE
!
- SUBROUTINE LIMA ( KKA, KKU, KKL, &
- PTSTEP, TPFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PDZZ, &
- PRHODJ, PPABSM, PPABST, &
- NCCN, NIFN, NIMM, &
- PTHM, 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_IO, ONLY: TFILEDATA
+USE MODD_NSV, only: NSV_LIMA_BEG
!
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
@@ -27,7 +28,6 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
!
REAL, INTENT(IN) :: PTSTEP ! Time step
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of output
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -41,15 +41,15 @@ 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) :: PTHM ! 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(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations sources
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
!
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud droplets deposition
@@ -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, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PDZZ, &
- PRHODJ, PPABSM, PPABST, &
- NCCN, NIFN, NIMM, &
- PTHM, 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
@@ -96,19 +100,28 @@ END MODULE MODI_LIMA
!! -------------
!! Original 15/03/2018
!!
-!! B.Vié 02/2019 : minor correction on budget
-!!
-!!
+! B. Vie 02/2019: minor correction on budget
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
+! P. Wautelet 26/02/2020: bugfix: corrected condition to write budget CORR_BU_RRS
+! 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
! ------------
-USE MODD_BUDGET, ONLY: LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR, &
- LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, LBUDGET_SV
-USE MODD_CLOUDPAR_n, ONLY: NSPLITR, NSPLITG
+use modd_budget, only: lbu_enable, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
+ lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, XRHOLW, XP00, XRD
USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, NSV_LIMA_CCN_ACTI, &
- NSV_LIMA_SCAVMASS, NSV_LIMA_NI, NSV_LIMA_IFN_FREE, &
+USE MODD_NSV, ONLY: NSV_LIMA_BEG, &
+ 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_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY: LCOLD, LRAIN, LWARM, NMOD_CCN, NMOD_IFN, NMOD_IMM, LHHONI, &
@@ -117,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_BUDGET
+USE MODI_LIMA_COMPUTE_CLOUD_FRACTIONS
USE MODI_LIMA_DROPS_TO_DROPLETS_CONV
USE MODI_LIMA_INST_PROCS
USE MODI_LIMA_NUCLEATION_PROCS
@@ -137,7 +152,6 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
!
REAL, INTENT(IN) :: PTSTEP ! Time step
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of output
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
@@ -151,15 +165,15 @@ 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) :: PTHM ! 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(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at time t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! w for CCN activation
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! Mixing ratios sources
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations sources
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
!
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRC ! Cloud instant precip
REAL, DIMENSION(:,:), INTENT(OUT) :: PINDEP ! Cloud droplets deposition
@@ -170,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 :
!
!
@@ -189,7 +207,7 @@ REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZHOMFS
!
! Other 3D thermodynamical variables
-REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZEXN, ZT, ZTM
+REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZEXN, ZT
!
! Packed prognostic & thermo variables
@@ -214,9 +232,11 @@ REAL, DIMENSION(:), ALLOCATABLE :: &
Z_RC_AUTO, Z_CC_AUTO, Z_CR_AUTO, & ! autoconversion of cloud droplets (AUTO) : rc, Nc, rr=-rc, Nr
Z_RC_ACCR, Z_CC_ACCR, & ! accretion of droplets by rain drops (ACCR) : rc, Nc, rr=-rr
Z_CR_SCBU, & ! self collectio break up of drops (SCBU) : Nr
- Z_TH_EVAP, Z_RC_EVAP, Z_CC_EVAP, Z_RR_EVAP, Z_CR_EVAP, & ! evaporation of rain drops (EVAP) : rv=-rr-rc, rc, Nc, rr, Nr, th
+! Z_TH_EVAP, Z_RC_EVAP, Z_CC_EVAP, Z_RR_EVAP, Z_CR_EVAP, & ! evaporation of rain drops (EVAP) : rv=-rr-rc, rc, Nc, rr, Nr, th
+ 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
@@ -232,10 +252,12 @@ REAL, DIMENSION(:), ALLOCATABLE :: &
Z_RI_DRYG, Z_CI_DRYG, Z_RS_DRYG, Z_RG_DRYG, & ! dry growth of graupel (DRYG) : rc, Nc, rr, Nr, ri, Ni, rs, rg, th
Z_RI_HMG, Z_CI_HMG, Z_RG_HMG, & ! hallett mossop graupel (HMG) : ri, Ni, rg
Z_TH_GMLT, Z_RR_GMLT, Z_CR_GMLT, & ! graupel melting (GMLT) : rr, Nr, rg=-rr, th
- Z_RC_WETH, Z_CC_WETH, Z_RR_WETH, Z_CR_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
- Z_RI_WETH, Z_CI_WETH, Z_RS_WETH, Z_RG_WETH, Z_RH_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
- Z_RG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
- Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
+! Z_RC_WETH, Z_CC_WETH, Z_RR_WETH, Z_CR_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
+! Z_RI_WETH, Z_CI_WETH, Z_RS_WETH, Z_RG_WETH, Z_RH_WETH, & ! wet growth of hail (WETH) : rc, Nc, rr, Nr, ri, Ni, rs, rg, rh, th
+! Z_RG_COHG, & ! conversion of hail into graupel (COHG) : rg, rh
+! Z_RR_HMLT, Z_CR_HMLT ! hail melting (HMLT) : rr, Nr, rh=-rr, th
+ Z_RV_CORR2, Z_RC_CORR2, Z_RR_CORR2, Z_RI_CORR2, &
+ Z_CC_CORR2, Z_CR_CORR2, Z_CI_CORR2
!
! for the conversion from rain to cloud, we need a 3D variable instead of a 1D packed variable
REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
@@ -250,7 +272,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZB_IFNN
!
! for each process & species, we need 3D variables to store total mmr and conc change (kg/kg and #/kg and theta)
-REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: &
! instantaneous processes :
ZTOT_CR_BRKU, & ! spontaneous break up of drops (BRKU)
ZTOT_TH_HONR, ZTOT_RR_HONR, ZTOT_CR_HONR, & ! rain drops homogeneous freezing (HONR)
@@ -261,9 +283,11 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
ZTOT_RC_AUTO, ZTOT_CC_AUTO, ZTOT_CR_AUTO, & ! autoconversion of cloud droplets (AUTO)
ZTOT_RC_ACCR, ZTOT_CC_ACCR, & ! accretion of droplets by rain drops (ACCR)
ZTOT_CR_SCBU, & ! self collectio break up of drops (SCBU)
- ZTOT_TH_EVAP, ZTOT_RC_EVAP, ZTOT_CC_EVAP, ZTOT_RR_EVAP, ZTOT_CR_EVAP, & ! evaporation of rain drops (EVAP)
+! ZTOT_TH_EVAP, ZTOT_RC_EVAP, ZTOT_CC_EVAP, ZTOT_RR_EVAP, ZTOT_CR_EVAP, & ! evaporation of rain drops (EVAP)
+ 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)
@@ -279,11 +303,14 @@ REAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)) :: &
ZTOT_RI_DRYG, ZTOT_CI_DRYG, ZTOT_RS_DRYG, ZTOT_RG_DRYG, & ! dry growth of graupel (DRYG)
ZTOT_RI_HMG, ZTOT_CI_HMG, ZTOT_RG_HMG, & ! hallett mossop graupel (HMG)
ZTOT_TH_GMLT, ZTOT_RR_GMLT, ZTOT_CR_GMLT, & ! graupel melting (GMLT)
- ZTOT_RC_WETH, ZTOT_CC_WETH, ZTOT_RR_WETH, ZTOT_CR_WETH, & ! wet growth of hail (WETH)
- ZTOT_RI_WETH, ZTOT_CI_WETH, ZTOT_RS_WETH, ZTOT_RG_WETH, ZTOT_RH_WETH, & ! wet growth of hail (WETH)
- ZTOT_RG_COHG, & ! conversion of hail into graupel (COHG)
- ZTOT_RR_HMLT, ZTOT_CR_HMLT, & ! hail melting (HMLT)
- ZTOT_RR_CVRC, ZTOT_CR_CVRC ! conversion of rain into cloud droplets if diameter too small
+! ZTOT_RC_WETH, ZTOT_CC_WETH, ZTOT_RR_WETH, ZTOT_CR_WETH, & ! wet growth of hail (WETH)
+! ZTOT_RI_WETH, ZTOT_CI_WETH, ZTOT_RS_WETH, ZTOT_RG_WETH, ZTOT_RH_WETH, & ! wet growth of hail (WETH)
+! ZTOT_RG_COHG, & ! conversion of hail into graupel (COHG)
+! ZTOT_RR_HMLT, ZTOT_CR_HMLT, & ! hail melting (HMLT)
+ ZTOT_RR_CVRC, ZTOT_CR_CVRC, & ! conversion of rain into cloud droplets if diameter too small
+ ZTOT_RV_CORR2, ZTOT_RC_CORR2, ZTOT_RR_CORR2, ZTOT_RI_CORR2, &
+ ZTOT_CC_CORR2, ZTOT_CR_CORR2, ZTOT_CI_CORR2
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZTOT_IFNN_IMLT
!
!For mixing-ratio splitting
@@ -298,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
@@ -306,7 +335,8 @@ INTEGER :: INB_ITER_MAX
INTEGER :: KRR
INTEGER :: IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, IKTB, IKTE
! loops and packing
-INTEGER :: II, IPACK
+INTEGER :: II, IPACK, JI, JJ, JK
+integer :: idx
INTEGER, DIMENSION(:), ALLOCATABLE :: I1, I2, I3
! Inverse ov PTSTEP
REAL :: ZINV_TSTEP
@@ -316,6 +346,7 @@ REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: ZW2D
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZRT_SUM ! Total condensed water mr
REAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3)) :: ZCPT ! Total condensed water mr
LOGICAL, DIMENSION(SIZE(PRT,1),SIZE(PRT,2)) :: GDEP
+real, dimension(:,:,:), allocatable :: zrhodjontstep
!
!-------------------------------------------------------------------------------
!
@@ -374,99 +405,110 @@ ZIMMNS(:,:,:,:) = 0.
ZHOMFT(:,:,:) = 0.
ZHOMFS(:,:,:) = 0.
-IF(LBU_ENABLE) THEN
- ZTOT_CR_BRKU(:,:,:) = 0.
- ZTOT_TH_HONR(:,:,:) = 0.
- ZTOT_RR_HONR(:,:,:) = 0.
- ZTOT_CR_HONR(:,:,:) = 0.
- ZTOT_TH_IMLT(:,:,:) = 0.
- ZTOT_RC_IMLT(:,:,:) = 0.
- ZTOT_CC_IMLT(:,:,:) = 0.
- ZTOT_TH_HONC(:,:,:) = 0.
- ZTOT_RC_HONC(:,:,:) = 0.
- ZTOT_CC_HONC(:,:,:) = 0.
- ZTOT_CC_SELF(:,:,:) = 0.
- ZTOT_RC_AUTO(:,:,:) = 0.
- ZTOT_CC_AUTO(:,:,:) = 0.
- ZTOT_CR_AUTO(:,:,:) = 0.
- ZTOT_RC_ACCR(:,:,:) = 0.
- ZTOT_CC_ACCR(:,:,:) = 0.
- ZTOT_CR_SCBU(:,:,:) = 0.
- ZTOT_TH_EVAP(:,:,:) = 0.
- ZTOT_RC_EVAP(:,:,:) = 0.
- ZTOT_CC_EVAP(:,:,:) = 0.
- ZTOT_RR_EVAP(:,:,:) = 0.
- ZTOT_CR_EVAP(:,:,:) = 0.
- ZTOT_RI_CNVI(:,:,:) = 0.
- ZTOT_CI_CNVI(:,:,:) = 0.
- ZTOT_TH_DEPS(:,:,:) = 0.
- ZTOT_RS_DEPS(:,:,:) = 0.
- ZTOT_RI_CNVS(:,:,:) = 0.
- ZTOT_CI_CNVS(:,:,:) = 0.
- ZTOT_RI_AGGS(:,:,:) = 0.
- ZTOT_CI_AGGS(:,:,:) = 0.
- ZTOT_TH_DEPG(:,:,:) = 0.
- ZTOT_RG_DEPG(:,:,:) = 0.
- ZTOT_TH_BERFI(:,:,:) = 0.
- ZTOT_RC_BERFI(:,:,:) = 0.
- ZTOT_TH_RIM(:,:,:) = 0.
- ZTOT_RC_RIM(:,:,:) = 0.
- ZTOT_CC_RIM(:,:,:) = 0.
- ZTOT_RS_RIM(:,:,:) = 0.
- ZTOT_RG_RIM(:,:,:) = 0.
- ZTOT_RI_HMS(:,:,:) = 0.
- ZTOT_CI_HMS(:,:,:) = 0.
- ZTOT_RS_HMS(:,:,:) = 0.
- ZTOT_TH_ACC(:,:,:) = 0.
- ZTOT_RR_ACC(:,:,:) = 0.
- ZTOT_CR_ACC(:,:,:) = 0.
- ZTOT_RS_ACC(:,:,:) = 0.
- ZTOT_RG_ACC(:,:,:) = 0.
- ZTOT_RS_CMEL(:,:,:) = 0.
- ZTOT_TH_CFRZ(:,:,:) = 0.
- ZTOT_RR_CFRZ(:,:,:) = 0.
- ZTOT_CR_CFRZ(:,:,:) = 0.
- ZTOT_RI_CFRZ(:,:,:) = 0.
- ZTOT_CI_CFRZ(:,:,:) = 0.
- ZTOT_TH_WETG(:,:,:) = 0.
- ZTOT_RC_WETG(:,:,:) = 0.
- ZTOT_CC_WETG(:,:,:) = 0.
- ZTOT_RR_WETG(:,:,:) = 0.
- ZTOT_CR_WETG(:,:,:) = 0.
- ZTOT_RI_WETG(:,:,:) = 0.
- ZTOT_CI_WETG(:,:,:) = 0.
- ZTOT_RS_WETG(:,:,:) = 0.
- ZTOT_RG_WETG(:,:,:) = 0.
- ZTOT_RH_WETG(:,:,:) = 0.
- ZTOT_TH_DRYG(:,:,:) = 0.
- ZTOT_RC_DRYG(:,:,:) = 0.
- ZTOT_CC_DRYG(:,:,:) = 0.
- ZTOT_RR_DRYG(:,:,:) = 0.
- ZTOT_CR_DRYG(:,:,:) = 0.
- ZTOT_RI_DRYG(:,:,:) = 0.
- ZTOT_CI_DRYG(:,:,:) = 0.
- ZTOT_RS_DRYG(:,:,:) = 0.
- ZTOT_RG_DRYG(:,:,:) = 0.
- ZTOT_RI_HMG(:,:,:) = 0.
- ZTOT_CI_HMG(:,:,:) = 0.
- ZTOT_RG_HMG(:,:,:) = 0.
- ZTOT_TH_GMLT(:,:,:) = 0.
- ZTOT_RR_GMLT(:,:,:) = 0.
- ZTOT_CR_GMLT(:,:,:) = 0.
- ZTOT_RC_WETH(:,:,:) = 0.
- ZTOT_CC_WETH(:,:,:) = 0.
- ZTOT_RR_WETH(:,:,:) = 0.
- ZTOT_CR_WETH(:,:,:) = 0.
- ZTOT_RI_WETH(:,:,:) = 0.
- ZTOT_CI_WETH(:,:,:) = 0.
- ZTOT_RS_WETH(:,:,:) = 0.
- ZTOT_RG_WETH(:,:,:) = 0.
- ZTOT_RH_WETH(:,:,:) = 0.
- ZTOT_RG_COHG(:,:,:) = 0.
- ZTOT_RR_HMLT(:,:,:) = 0.
- ZTOT_CR_HMLT(:,:,:) = 0.
- ZTOT_RR_CVRC(:,:,:) = 0.
- ZTOT_CR_CVRC(:,:,:) = 0.
+if ( lbu_enable ) then
+ allocate( ZTOT_CR_BRKU (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_BRKU(:,:,:) = 0.
+ allocate( ZTOT_TH_HONR (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_HONR(:,:,:) = 0.
+ allocate( ZTOT_RR_HONR (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_HONR(:,:,:) = 0.
+ allocate( ZTOT_CR_HONR (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_HONR(:,:,:) = 0.
+ allocate( ZTOT_TH_IMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_IMLT(:,:,:) = 0.
+ allocate( ZTOT_RC_IMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_IMLT(:,:,:) = 0.
+ allocate( ZTOT_CC_IMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_IMLT(:,:,:) = 0.
+ allocate( ZTOT_IFNN_IMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3), nmod_ifn ) ); ZTOT_IFNN_IMLT(:,:,:,:) = 0.
+ allocate( ZTOT_TH_HONC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_HONC(:,:,:) = 0.
+ allocate( ZTOT_RC_HONC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_HONC(:,:,:) = 0.
+ allocate( ZTOT_CC_HONC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_HONC(:,:,:) = 0.
+ allocate( ZTOT_CC_SELF (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_SELF(:,:,:) = 0.
+ allocate( ZTOT_RC_AUTO (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_AUTO(:,:,:) = 0.
+ allocate( ZTOT_CC_AUTO (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_AUTO(:,:,:) = 0.
+ allocate( ZTOT_CR_AUTO (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_AUTO(:,:,:) = 0.
+ allocate( ZTOT_RC_ACCR (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_ACCR(:,:,:) = 0.
+ allocate( ZTOT_CC_ACCR (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_ACCR(:,:,:) = 0.
+ allocate( ZTOT_CR_SCBU (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_SCBU(:,:,:) = 0.
+ allocate( ZTOT_TH_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_EVAP(:,:,:) = 0.
+! allocate( ZTOT_RC_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_EVAP(:,:,:) = 0.
+! allocate( ZTOT_CC_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_EVAP(:,:,:) = 0.
+ allocate( ZTOT_RR_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_EVAP(:,:,:) = 0.
+! allocate( ZTOT_CR_EVAP (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_EVAP(:,:,:) = 0.
+ allocate( ZTOT_RI_CNVI (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_CNVI(:,:,:) = 0.
+ 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.
+ allocate( ZTOT_CI_AGGS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_AGGS(:,:,:) = 0.
+ allocate( ZTOT_TH_DEPG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_DEPG(:,:,:) = 0.
+ allocate( ZTOT_RG_DEPG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_DEPG(:,:,:) = 0.
+ allocate( ZTOT_TH_BERFI(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_BERFI(:,:,:) = 0.
+ allocate( ZTOT_RC_BERFI(size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_BERFI(:,:,:) = 0.
+ allocate( ZTOT_TH_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_RIM(:,:,:) = 0.
+ allocate( ZTOT_RC_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_RIM(:,:,:) = 0.
+ allocate( ZTOT_CC_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_RIM(:,:,:) = 0.
+ allocate( ZTOT_RS_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_RIM(:,:,:) = 0.
+ allocate( ZTOT_RG_RIM (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_RIM(:,:,:) = 0.
+ allocate( ZTOT_RI_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_HMS(:,:,:) = 0.
+ allocate( ZTOT_CI_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_HMS(:,:,:) = 0.
+ allocate( ZTOT_RS_HMS (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_HMS(:,:,:) = 0.
+ allocate( ZTOT_TH_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_ACC(:,:,:) = 0.
+ allocate( ZTOT_RR_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_ACC(:,:,:) = 0.
+ allocate( ZTOT_CR_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_ACC(:,:,:) = 0.
+ allocate( ZTOT_RS_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_ACC(:,:,:) = 0.
+ allocate( ZTOT_RG_ACC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_ACC(:,:,:) = 0.
+ allocate( ZTOT_RS_CMEL (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_CMEL(:,:,:) = 0.
+ allocate( ZTOT_TH_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_CFRZ(:,:,:) = 0.
+ allocate( ZTOT_RR_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_CFRZ(:,:,:) = 0.
+ allocate( ZTOT_CR_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_CFRZ(:,:,:) = 0.
+ allocate( ZTOT_RI_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_CFRZ(:,:,:) = 0.
+ allocate( ZTOT_CI_CFRZ (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_CFRZ(:,:,:) = 0.
+ allocate( ZTOT_TH_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_WETG(:,:,:) = 0.
+ allocate( ZTOT_RC_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_WETG(:,:,:) = 0.
+ allocate( ZTOT_CC_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_WETG(:,:,:) = 0.
+ allocate( ZTOT_RR_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_WETG(:,:,:) = 0.
+ allocate( ZTOT_CR_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_WETG(:,:,:) = 0.
+ allocate( ZTOT_RI_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_WETG(:,:,:) = 0.
+ allocate( ZTOT_CI_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_WETG(:,:,:) = 0.
+ allocate( ZTOT_RS_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_WETG(:,:,:) = 0.
+ allocate( ZTOT_RG_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_WETG(:,:,:) = 0.
+ allocate( ZTOT_RH_WETG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RH_WETG(:,:,:) = 0.
+ allocate( ZTOT_TH_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RC_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_DRYG(:,:,:) = 0.
+ allocate( ZTOT_CC_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RR_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_DRYG(:,:,:) = 0.
+ allocate( ZTOT_CR_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RI_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_DRYG(:,:,:) = 0.
+ allocate( ZTOT_CI_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RS_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RG_DRYG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_DRYG(:,:,:) = 0.
+ allocate( ZTOT_RI_HMG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_HMG(:,:,:) = 0.
+ allocate( ZTOT_CI_HMG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_HMG(:,:,:) = 0.
+ allocate( ZTOT_RG_HMG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_HMG(:,:,:) = 0.
+ allocate( ZTOT_TH_GMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_TH_GMLT(:,:,:) = 0.
+ allocate( ZTOT_RR_GMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_GMLT(:,:,:) = 0.
+ allocate( ZTOT_CR_GMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_GMLT(:,:,:) = 0.
+! allocate( ZTOT_RC_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_WETH(:,:,:) = 0.
+! allocate( ZTOT_CC_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_WETH(:,:,:) = 0.
+! allocate( ZTOT_RR_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_WETH(:,:,:) = 0.
+! allocate( ZTOT_CR_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_WETH(:,:,:) = 0.
+! allocate( ZTOT_RI_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_WETH(:,:,:) = 0.
+! allocate( ZTOT_CI_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_WETH(:,:,:) = 0.
+! allocate( ZTOT_RS_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RS_WETH(:,:,:) = 0.
+! allocate( ZTOT_RG_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_WETH(:,:,:) = 0.
+! allocate( ZTOT_RH_WETH (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RH_WETH(:,:,:) = 0.
+! allocate( ZTOT_RG_COHG (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RG_COHG(:,:,:) = 0.
+! allocate( ZTOT_RR_HMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_HMLT(:,:,:) = 0.
+! allocate( ZTOT_CR_HMLT (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_HMLT(:,:,:) = 0.
+ allocate( ZTOT_RR_CVRC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_CVRC(:,:,:) = 0.
+ allocate( ZTOT_CR_CVRC (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_CVRC(:,:,:) = 0.
+
+ allocate( ZTOT_RV_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RV_CORR2(:,:,:) = 0.
+ allocate( ZTOT_RC_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RC_CORR2(:,:,:) = 0.
+ allocate( ZTOT_RR_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RR_CORR2(:,:,:) = 0.
+ allocate( ZTOT_RI_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_RI_CORR2(:,:,:) = 0.
+ allocate( ZTOT_CC_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CC_CORR2(:,:,:) = 0.
+ allocate( ZTOT_CR_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CR_CORR2(:,:,:) = 0.
+ allocate( ZTOT_CI_CORR2 (size( ptht, 1), size( ptht, 2), size( ptht, 3) ) ); ZTOT_CI_CORR2(:,:,:) = 0.
END IF
!
! Initial values computed as source * PTSTEP
@@ -515,67 +557,102 @@ 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 (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 (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'CORR_BU_RRC')
- IF (LBUDGET_RR .AND. LWARM .AND. LRAIN) CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'CORR_BU_RRR')
- IF (LBUDGET_RI .AND. LCOLD .AND. LSNOW) CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CORR_BU_RRI')
- IF (LBUDGET_RI .AND. LCOLD .AND. LSNOW) CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:),10 , 'CORR_BU_RRS')
- IF (LBUDGET_SV) THEN
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'CORR_BU_RSV')
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'CORR_BU_RSV')
- IF (LCOLD .AND. LSNOW) CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CORR_BU_RSV')
- 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
! -------------
!
!
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc .and. lwarm .and. lsedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri .and. lcold .and. lsedi ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lcold .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lcold .and. lhail ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm .and. lsedc ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm .and. lrain ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold .and. lsedi ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+ end if
+end if
+
ZRT_SUM = (ZRVS + ZRCS + ZRRS + ZRIS + ZRSS + ZRGS + ZRHS)*PTSTEP
ZCPT = XCPD + (XCPV * ZRVS + XCL * (ZRCS + ZRRS) + XCI * (ZRIS + ZRSS + ZRGS + ZRHS))*PTSTEP
IF (LWARM .AND. LSEDC) CALL LIMA_SEDIMENTATION(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
@@ -605,42 +682,55 @@ ZTHS(:,:,:) = ZT(:,:,:) / ZEXN(:,:,:) * ZINV_TSTEP
!
! Call budgets
!
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'SEDI_BU_RTH')
- IF (LBUDGET_RC .AND. LWARM .AND. LSEDC) CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC')
- IF (LBUDGET_RR .AND. LWARM .AND. LRAIN) CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR')
- IF (LBUDGET_RI .AND. LCOLD .AND. LSEDI) CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI')
- IF (LBUDGET_RS .AND. LCOLD .AND. LSNOW) CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'SEDI_BU_RRS')
- IF (LBUDGET_RG .AND. LCOLD .AND. LSNOW) CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'SEDI_BU_RRG')
- IF (LBUDGET_RH .AND. LCOLD .AND. LHAIL) CALL BUDGET (ZRHS(:,:,:)*PRHODJ(:,:,:), 12 , 'SEDI_BU_RRH')
- IF (LBUDGET_SV) THEN
- IF (LWARM .AND. LSEDC) CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'SEDI_BU_RSV')
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'SEDI_BU_RSV')
- IF (LCOLD .AND. LSEDI) CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'SEDI_BU_RSV')
- END IF
-END IF
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'SEDI', zths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc .and. lwarm .and. lsedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr .and. lwarm .and. lrain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri .and. lcold .and. lsedi ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', zris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', zrss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lcold .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', zrgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lcold .and. lhail ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', zrhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( lwarm .and. lsedc ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lwarm .and. lrain ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', zcrs(:, :, :) * prhodj(:, :, :) )
+ if ( lcold .and. lsedi ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', zcis(:, :, :) * prhodj(:, :, :) )
+ end if
+end if
!
! 1.bis Deposition at 1st level above ground
!
IF (LWARM .AND. LDEPOC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
+
PINDEP(:,:)=0.
GDEP(:,:) = .FALSE.
- GDEP(:,:) = ZRCS(:,:,IKB) >0 .AND. ZCCS(:,:,IKB) >0
+ GDEP(:,:) = ZRCS(:,:,IKB) >0 .AND. ZCCS(:,:,IKB) >0 .AND. ZRCT(:,:,IKB) >0 .AND. ZCCT(:,:,IKB) >0
WHERE (GDEP)
ZRCS(:,:,IKB) = ZRCS(:,:,IKB) - XVDEPOC * ZRCT(:,:,IKB) / PDZZ(:,:,IKB)
ZCCS(:,:,IKB) = ZCCS(:,:,IKB) - XVDEPOC * ZCCT(:,:,IKB) / PDZZ(:,:,IKB)
PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * ZRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
PINDEP(:,:) = XVDEPOC * ZRCT(:,:,IKB) * PRHODREF(:,:,IKB) /XRHOLW
END WHERE
-!
- IF ( LBUDGET_RC ) CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
- IF ( LBUDGET_SV ) CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'DEPO_BU_RSV')
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', zccs(:, :, :) * prhodj(:, :, :) )
END IF
!
!
Z_RR_CVRC(:,:,:) = 0.
Z_CR_CVRC(:,:,:) = 0.
IF (LWARM .AND. LRAIN) THEN
+ if( lbu_enable ) then
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
+ end if
+
CALL LIMA_DROPS_TO_DROPLETS_CONV(PRHODREF, ZRCS*PTSTEP, ZRRS*PTSTEP, ZCCS*PTSTEP, ZCRS*PTSTEP, &
Z_RR_CVRC, Z_CR_CVRC)
!
@@ -648,15 +738,13 @@ IF (LWARM .AND. LRAIN) THEN
ZRRS(:,:,:) = ZRRS(:,:,:) + Z_RR_CVRC(:,:,:)/PTSTEP
ZCCS(:,:,:) = ZCCS(:,:,:) - Z_CR_CVRC(:,:,:)/PTSTEP
ZCRS(:,:,:) = ZCRS(:,:,:) + Z_CR_CVRC(:,:,:)/PTSTEP
- !
- IF(LBU_ENABLE) THEN
- IF (LBUDGET_RC) CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'R2C1_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'R2C1_BU_RRR')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'R2C1_BU_RSV')
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'R2C1_BU_RSV')
- END IF
- END IF
+
+ if( lbu_enable ) then
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'R2C1', zrcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'R2C1', zrrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'R2C1', zccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'R2C1', zcrs(:, :, :) * prhodj(:, :, :) )
+ end if
END IF
!
! Update variables
@@ -677,21 +765,33 @@ IF ( LCOLD ) ZCIT(:,:,:) = ZCIS(:,:,:) * PTSTEP
!
!-------------------------------------------------------------------------------
!
-!* 2. Nucleation processes
-! --------------------
+!* 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
!
+!-------------------------------------------------------------------------------
!
-IF( LACTIT ) THEN
- ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
-ELSE
- ZTM(:,:,:) = ZT(:,:,:)
-END IF
+!* 2. Nucleation processes
+! --------------------
!
-CALL LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, OCLOSE_OUT, PRHODJ, &
- PRHODREF, ZEXN, PPABST, ZT, ZTM, PW_NU, &
+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 )
+ ZCCNFT, ZCCNAT, ZIFNFT, ZIFNNT, ZIMMNT, ZHOMFT, &
+ PCLDFR, PICEFR, PPRCFR )
!
! Saving sources before microphysics time-splitting loop
!
@@ -739,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
@@ -760,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
@@ -802,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))
@@ -832,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.
@@ -887,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.
@@ -940,6 +1053,13 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
ALLOCATE(Z_RR_GMLT(IPACK)) ; Z_RR_GMLT = 0.
ALLOCATE(Z_CR_GMLT(IPACK)) ; Z_CR_GMLT = 0.
+ ALLOCATE(Z_RV_CORR2(IPACK)) ; Z_RV_CORR2 = 0.
+ ALLOCATE(Z_RC_CORR2(IPACK)) ; Z_RC_CORR2 = 0.
+ ALLOCATE(Z_RR_CORR2(IPACK)) ; Z_RR_CORR2 = 0.
+ ALLOCATE(Z_RI_CORR2(IPACK)) ; Z_RI_CORR2 = 0.
+ ALLOCATE(Z_CC_CORR2(IPACK)) ; Z_CC_CORR2 = 0.
+ ALLOCATE(Z_CR_CORR2(IPACK)) ; Z_CR_CORR2 = 0.
+ ALLOCATE(Z_CI_CORR2(IPACK)) ; Z_CI_CORR2 = 0.
!
!*** 4.1 Tendecies computation
!
@@ -954,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, &
@@ -968,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, &
@@ -989,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
@@ -1146,7 +1269,6 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
ZRGT1D = ZRGT1D + ZA_RG(:) * ZMAXTIME(:) + ZB_RG(:)
ZRHT1D = ZRHT1D + ZA_RH(:) * ZMAXTIME(:) + ZB_RH(:)
!
-
DO II=1,NMOD_IFN
ZIFNN1D(:,II) = ZIFNN1D(:,II) + ZB_IFNN(:,II)
END DO
@@ -1154,16 +1276,28 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
!*** 4.5
!
WHERE (ZRCT1D .LE. XRTMIN(2))
+ Z_RV_CORR2(:) = ZRCT1D(:)
+ Z_RC_CORR2(:) = -ZRCT1D(:)
+ Z_CC_CORR2(:) = -ZCCT1D(:)
+
ZRVT1D = ZRVT1D + ZRCT1D
ZRCT1D = 0.
ZCCT1D = 0.
END WHERE
WHERE (ZRRT1D .LE. XRTMIN(3))
+ Z_RV_CORR2(:) = Z_RV_CORR2(:) + ZRRT1D(:)
+ Z_RR_CORR2(:) = -ZRRT1D(:)
+ Z_CR_CORR2(:) = -ZCRT1D(:)
+
ZRVT1D = ZRVT1D + ZRRT1D
ZRRT1D = 0.
ZCRT1D = 0.
END WHERE
WHERE (ZRIT1D .LE. XRTMIN(4))
+ Z_RV_CORR2(:) = Z_RV_CORR2(:) + ZRIT1D(:)
+ Z_RI_CORR2(:) = -ZRIT1D(:)
+ Z_CI_CORR2(:) = -ZCIT1D(:)
+
ZRVT1D = ZRVT1D + ZRIT1D
ZRIT1D = 0.
ZCIT1D = 0.
@@ -1197,8 +1331,6 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
!
CALL LIMA_DROPS_TO_DROPLETS_CONV(PRHODREF, ZRCT, ZRRT, ZCCT, ZCRT, &
Z_RR_CVRC, Z_CR_CVRC )
- ZTOT_RR_CVRC(:,:,:) = ZTOT_RR_CVRC(:,:,:) + Z_RR_CVRC(:,:,:)
- ZTOT_CR_CVRC(:,:,:) = ZTOT_CR_CVRC(:,:,:) + Z_CR_CVRC(:,:,:)
ZRCT(:,:,:) = ZRCT(:,:,:) - Z_RR_CVRC(:,:,:)
ZRRT(:,:,:) = ZRRT(:,:,:) + Z_RR_CVRC(:,:,:)
ZCCT(:,:,:) = ZCCT(:,:,:) - Z_CR_CVRC(:,:,:)
@@ -1207,6 +1339,9 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
!*** 4.4 Unpacking for budgets
!
IF(LBU_ENABLE) THEN
+ ZTOT_RR_CVRC(:,:,:) = ZTOT_RR_CVRC(:,:,:) + Z_RR_CVRC(:,:,:)
+ ZTOT_CR_CVRC(:,:,:) = ZTOT_CR_CVRC(:,:,:) + Z_CR_CVRC(:,:,:)
+
DO II=1,IPACK
! Instantaneous processes
ZTOT_CR_BRKU(I1(II),I2(II),I3(II)) = ZTOT_CR_BRKU(I1(II),I2(II),I3(II)) + Z_CR_BRKU(II)
@@ -1216,6 +1351,10 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
ZTOT_TH_IMLT(I1(II),I2(II),I3(II)) = ZTOT_TH_IMLT(I1(II),I2(II),I3(II)) + Z_TH_IMLT(II)
ZTOT_RC_IMLT(I1(II),I2(II),I3(II)) = ZTOT_RC_IMLT(I1(II),I2(II),I3(II)) + Z_RC_IMLT(II)
ZTOT_CC_IMLT(I1(II),I2(II),I3(II)) = ZTOT_CC_IMLT(I1(II),I2(II),I3(II)) + Z_CC_IMLT(II)
+ DO JI = 1, NMOD_IFN
+ ZTOT_IFNN_IMLT(I1(II),I2(II),I3(II),JI) = ZTOT_IFNN_IMLT(I1(II),I2(II),I3(II),JI) + ZB_IFNN(II,JI)
+ END DO
+
! Tendencies
ZTOT_TH_HONC(I1(II),I2(II),I3(II)) = ZTOT_TH_HONC(I1(II),I2(II),I3(II)) + Z_TH_HONC(II) * ZMAXTIME(II)
ZTOT_RC_HONC(I1(II),I2(II),I3(II)) = ZTOT_RC_HONC(I1(II),I2(II),I3(II)) + Z_RC_HONC(II) * ZMAXTIME(II)
@@ -1228,11 +1367,16 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
ZTOT_CC_ACCR(I1(II),I2(II),I3(II)) = ZTOT_CC_ACCR(I1(II),I2(II),I3(II)) + Z_CC_ACCR(II) * ZMAXTIME(II)
ZTOT_CR_SCBU(I1(II),I2(II),I3(II)) = ZTOT_CR_SCBU(I1(II),I2(II),I3(II)) + Z_CR_SCBU(II) * ZMAXTIME(II)
ZTOT_TH_EVAP(I1(II),I2(II),I3(II)) = ZTOT_TH_EVAP(I1(II),I2(II),I3(II)) + Z_TH_EVAP(II) * ZMAXTIME(II)
+!!$ ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) + Z_RC_EVAP(II) * ZMAXTIME(II)
+!!$ ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) + Z_CC_EVAP(II) * ZMAXTIME(II)
ZTOT_RR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RR_EVAP(I1(II),I2(II),I3(II)) + Z_RR_EVAP(II) * ZMAXTIME(II)
+!!$ ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) + Z_CR_EVAP(II) * ZMAXTIME(II)
ZTOT_RI_CNVI(I1(II),I2(II),I3(II)) = ZTOT_RI_CNVI(I1(II),I2(II),I3(II)) + Z_RI_CNVI(II) * ZMAXTIME(II)
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)
@@ -1297,6 +1441,15 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
!!$ ZTOT_RG_COHG(I1(II),I2(II),I3(II)) = ZTOT_RG_COHG(I1(II),I2(II),I3(II)) + Z_RG_COHG(II) * ZMAXTIME(II)
!!$ ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) + Z_RR_HMLT(II) * ZMAXTIME(II)
!!$ ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) + Z_CR_HMLT(II) * ZMAXTIME(II)
+
+ !Correction term
+ ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RV_CORR2(I1(II),I2(II),I3(II)) + Z_RV_CORR2(II)
+ ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RC_CORR2(I1(II),I2(II),I3(II)) + Z_RC_CORR2(II)
+ ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RR_CORR2(I1(II),I2(II),I3(II)) + Z_RR_CORR2(II)
+ ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_RI_CORR2(I1(II),I2(II),I3(II)) + Z_RI_CORR2(II)
+ ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CC_CORR2(I1(II),I2(II),I3(II)) + Z_CC_CORR2(II)
+ ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CR_CORR2(I1(II),I2(II),I3(II)) + Z_CR_CORR2(II)
+ ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) = ZTOT_CI_CORR2(I1(II),I2(II),I3(II)) + Z_CI_CORR2(II)
END DO
ENDIF
!
@@ -1333,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)
@@ -1385,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)
@@ -1437,7 +1595,15 @@ DO WHILE(ANY(ZTIME(IIB:IIE,IJB:IJE,IKB:IKE)<PTSTEP))
DEALLOCATE(Z_TH_GMLT)
DEALLOCATE(Z_RR_GMLT)
DEALLOCATE(Z_CR_GMLT)
- !
+
+ DEALLOCATE(Z_RV_CORR2)
+ DEALLOCATE(Z_RC_CORR2)
+ DEALLOCATE(Z_RR_CORR2)
+ DEALLOCATE(Z_RI_CORR2)
+ DEALLOCATE(Z_CC_CORR2)
+ DEALLOCATE(Z_CR_CORR2)
+ DEALLOCATE(Z_CI_CORR2)
+ !
ENDDO
ENDDO
!
@@ -1473,260 +1639,165 @@ IF ( LCOLD .AND. LHHONI) PSVS(:,:,:,NSV_LIMA_HOM_HAZE) = ZHOMFT(:,:,:) *ZINV_TST
!
! Call budgets
!
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_EVAP(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'REVA_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'HONC_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'HONR_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DEPS(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DEPS_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DEPG(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DEPG_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'IMLT_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_BERFI(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'BERFI_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'RIM_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'ACC_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'CFRZ_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'WETG_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'DRYG_BU_RTH')
- ZTHS(:,:,:) = ZTHS(:,:,:) + ZTOT_TH_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZTHS(:,:,:)*PRHODJ(:,:,:), 4 , 'GMLT_BU_RTH')
- END IF
+if ( lbu_enable ) then
+ allocate( zrhodjontstep(size( prhodj, 1), size( prhodj, 2), size( prhodj, 3) ) )
+ zrhodjontstep(:, :, :) = zinv_tstep * prhodj(:, :, :)
- IF (LBUDGET_RV) THEN
- ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RR_EVAP(:,:,:)/PTSTEP
- CALL BUDGET (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'REVA_BU_RRV')
- ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RS_DEPS(:,:,:)/PTSTEP
- CALL BUDGET (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'DEPS_BU_RRV')
- ZRVS(:,:,:) = ZRVS(:,:,:) - ZTOT_RG_DEPG(:,:,:)/PTSTEP
- CALL BUDGET (ZRVS(:,:,:)*PRHODJ(:,:,:), 6 , 'DEPG_BU_RRV')
- END IF
+ if ( lbudget_th ) then
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', ztot_th_evap (:, :, :) * zrhodjontstep(:, :, :) )
+ 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(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', ztot_th_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'ACC', ztot_th_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', ztot_th_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'WETG', ztot_th_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYG', ztot_th_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', ztot_th_gmlt (:, :, :) * zrhodjontstep(:, :, :) )
+ end if
- IF (LBUDGET_RC) THEN
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'AUTO_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'ACCR_BU_RRC')
- ! impact of rain evap !!!!!!
- ZRCS(:,:,:) = ZRCS(:,:,:)
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'REVA_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'HONC_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'IMLT_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_BERFI(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'BERFI_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'RIM_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'WETG_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) + ZTOT_RC_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'DRYG_BU_RRC')
- ZRCS(:,:,:) = ZRCS(:,:,:) - ZTOT_RR_CVRC(:,:,:)/PTSTEP
- CALL BUDGET (ZRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'CVRC_BU_RRC')
- END IF
-
- IF (LBUDGET_RR) THEN
- ZRRS(:,:,:) = ZRRS(:,:,:) - ZTOT_RC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'AUTO_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) - ZTOT_RC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'ACCR_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_EVAP(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'REVA_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'HONR_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'ACC_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'CFRZ_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'WETG_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'DRYG_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'GMLT_BU_RRR')
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZTOT_RR_CVRC(:,:,:)/PTSTEP
- CALL BUDGET (ZRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'CVRC_BU_RRR')
- END IF
-
- IF (LBUDGET_RI) THEN
- ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HONC_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CNVI_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CNVS_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'AGGS_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'IMLT_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) - ZTOT_RC_BERFI(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'BERFI_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_HMS(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HMS_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'CFRZ_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'WETG_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'DRYG_BU_RRI')
- ZRIS(:,:,:) = ZRIS(:,:,:) + ZTOT_RI_HMG(:,:,:)/PTSTEP
- CALL BUDGET (ZRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'HMG_BU_RRI')
- END IF
-
- IF (LBUDGET_RS) THEN
- ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CNVI_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_DEPS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'DEPS_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CNVS_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) - ZTOT_RI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'AGGS_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'RIM_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_HMS(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'HMS_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'ACC_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_CMEL(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'CMEL_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'WETG_BU_RRS')
- ZRSS(:,:,:) = ZRSS(:,:,:) + ZTOT_RS_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRSS(:,:,:)*PRHODJ(:,:,:), 10 , 'DRYG_BU_RRS')
- END IF
-
- IF (LBUDGET_RG) THEN
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'HONR_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_DEPG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'DEPG_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'RIM_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'ACC_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RS_CMEL(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'CMEL_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_CFRZ(:,:,:)/PTSTEP - ZTOT_RI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'CFRZ_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'WETG_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'DRYG_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) + ZTOT_RG_HMG(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'HMG_BU_RRG')
- ZRGS(:,:,:) = ZRGS(:,:,:) - ZTOT_RR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZRGS(:,:,:)*PRHODJ(:,:,:), 11 , 'GMLT_BU_RRG')
- END IF
+ 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
- IF (LBUDGET_RH) THEN
- ZRHS(:,:,:) = ZRHS(:,:,:) + ZTOT_RH_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZRHS(:,:,:)*PRHODJ(:,:,:), 12 , 'WETG_BU_RRH')
- END IF
+ if ( lbudget_rc ) then
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', ztot_rc_auto (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', ztot_rc_accr (:, :, :) * zrhodjontstep(:, :, :) )
+ !call Budget_store_add( tbudgets(NBUDGET_RC), 'REVA', 0. )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'HONC', ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'IMLT', ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', ztot_rc_berfi(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', ztot_rc_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'WETG', ztot_rc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYG', ztot_rc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'CVRC', -ztot_rr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RC), 'CORR2', ztot_rc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
- IF (LBUDGET_SV) THEN
- !
- ! Cloud droplets
- !
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_SELF(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'SELF_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'AUTO_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_ACCR(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'ACCR_BU_RSV')
- ! impact of rain evap !!!!!!
- ZCCS(:,:,:) = ZCCS(:,:,:)
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'REVA_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'HONC_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'IMLT_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_RIM(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'RIM_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'WETG_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) + ZTOT_CC_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'DRYG_BU_RSV')
- ZCCS(:,:,:) = ZCCS(:,:,:) - ZTOT_CR_CVRC(:,:,:)/PTSTEP
- CALL BUDGET (ZCCS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NC , 'CVRC_BU_RSV')
- !
- ! Rain drops
- !
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_AUTO(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'AUTO_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_SCBU(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'SCBU_BU_RSV')
- ! Rain evaporation !!!!!!!!!!!!!
- ZCRS(:,:,:) = ZCRS(:,:,:)
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'REVA_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_BRKU(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'BRKU_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_HONR(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'HONR_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_ACC(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'ACC_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'CFRZ_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'WETG_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'DRYG_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_GMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'GMLT_BU_RSV')
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZTOT_CR_CVRC(:,:,:)/PTSTEP
- CALL BUDGET (ZCRS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NR , 'CVRC_BU_RSV')
- !
- ! Ice crystals
- !
- ZCIS(:,:,:) = ZCIS(:,:,:) - ZTOT_CC_HONC(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HONC_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CNVI(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CNVI_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CNVS(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CNVS_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_AGGS(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'AGGS_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) - ZTOT_CC_IMLT(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'IMLT_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_HMS(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HMS_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_CFRZ(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'CFRZ_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_WETG(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'WETG_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_DRYG(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'DRYG_BU_RSV')
- ZCIS(:,:,:) = ZCIS(:,:,:) + ZTOT_CI_HMG(:,:,:)/PTSTEP
- CALL BUDGET (ZCIS(:,:,:)*PRHODJ(:,:,:), 12+NSV_LIMA_NI , 'HMG_BU_RSV')
- END IF
-!!$ ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_RC_EVAP(I1(II),I2(II),I3(II)) + Z_RC_EVAP(II) * ZMAXTIME(II)
-!!$ ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CC_EVAP(I1(II),I2(II),I3(II)) + Z_CC_EVAP(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) = ZTOT_CR_EVAP(I1(II),I2(II),I3(II)) + Z_CR_EVAP(II) * ZMAXTIME(II)
+ if ( lbudget_rr ) then
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', -ztot_rc_auto(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', -ztot_rc_accr(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', ztot_rr_evap(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'HONR', ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'ACC', ztot_rr_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', ztot_rr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'WETG', ztot_rr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYG', ztot_rr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'CVRC', ztot_rr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RR), 'CORR2', ztot_rr_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
-!!$ ZTOT_RC_WETH(I1(II),I2(II),I3(II)) = ZTOT_RC_WETH(I1(II),I2(II),I3(II)) + Z_RC_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CC_WETH(I1(II),I2(II),I3(II)) = ZTOT_CC_WETH(I1(II),I2(II),I3(II)) + Z_CC_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RR_WETH(I1(II),I2(II),I3(II)) = ZTOT_RR_WETH(I1(II),I2(II),I3(II)) + Z_RR_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_WETH(I1(II),I2(II),I3(II)) = ZTOT_CR_WETH(I1(II),I2(II),I3(II)) + Z_CR_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RI_WETH(I1(II),I2(II),I3(II)) = ZTOT_RI_WETH(I1(II),I2(II),I3(II)) + Z_RI_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_CI_WETH(I1(II),I2(II),I3(II)) = ZTOT_CI_WETH(I1(II),I2(II),I3(II)) + Z_CI_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RS_WETH(I1(II),I2(II),I3(II)) = ZTOT_RS_WETH(I1(II),I2(II),I3(II)) + Z_RS_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RG_WETH(I1(II),I2(II),I3(II)) = ZTOT_RG_WETH(I1(II),I2(II),I3(II)) + Z_RG_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RH_WETH(I1(II),I2(II),I3(II)) = ZTOT_RH_WETH(I1(II),I2(II),I3(II)) + Z_RH_WETH(II) * ZMAXTIME(II)
-!!$ ZTOT_RG_COHG(I1(II),I2(II),I3(II)) = ZTOT_RG_COHG(I1(II),I2(II),I3(II)) + Z_RG_COHG(II) * ZMAXTIME(II)
-!!$ ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_RR_HMLT(I1(II),I2(II),I3(II)) + Z_RR_HMLT(II) * ZMAXTIME(II)
-!!$ ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) = ZTOT_CR_HMLT(I1(II),I2(II),I3(II)) + Z_CR_HMLT(II) * ZMAXTIME(II)
-
-END IF
+ if ( lbudget_ri ) then
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'HONC', -ztot_rc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'CNVI', ztot_ri_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'CNVS', ztot_ri_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', ztot_ri_aggs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'IMLT', -ztot_rc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ 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(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RI), 'CORR2', ztot_ri_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rs ) then
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'CNVI', -ztot_ri_cnvi(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', ztot_rs_deps(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'CNVS', -ztot_ri_cnvs(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', -ztot_ri_aggs(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', ztot_rs_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'HMS', ztot_rs_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'ACC', ztot_rs_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'WETG', ztot_rs_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYG', ztot_rs_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rg ) then
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'HONR', -ztot_rr_honr(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', ztot_rg_depg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', ztot_rg_rim (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'ACC', ztot_rg_acc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', -ztot_rs_cmel(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', ( -ztot_rr_cfrz(:, :, :) - ztot_ri_cfrz(:, :, :) ) &
+ * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'WETG', ztot_rg_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYG', ztot_rg_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'HMG', ztot_rg_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', -ztot_rr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_rh ) then
+ call Budget_store_add( tbudgets(NBUDGET_RH), 'WETG', ztot_rh_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ end if
+
+ if ( lbudget_sv ) then
+ !
+ ! Cloud droplets
+ !
+ idx = NBUDGET_SV1 - 1 + nsv_lima_nc
+ 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. )
+ 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(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'WETG', ztot_cc_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cc_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CVRC', -ztot_cr_cvrc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CORR2', ztot_cc_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ !
+ ! Rain drops
+ !
+ 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(:, :, :) )
+ !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(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CFRZ', ztot_cr_cfrz(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'WETG', ztot_cr_wetg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'DRYG', ztot_cr_dryg(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'GMLT', ztot_cr_gmlt(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CVRC', ztot_cr_cvrc(:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CORR2', ztot_cr_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+ !
+ ! Ice crystals
+ !
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ni
+ call Budget_store_add( tbudgets(idx), 'HONC', -ztot_cc_honc (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CNVI', ztot_ci_cnvi (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CNVS', ztot_ci_cnvs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'AGGS', ztot_ci_aggs (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'IMLT', -ztot_cc_imlt (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'HMS', ztot_ci_hms (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CFRZ', ztot_ci_cfrz (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'WETG', ztot_ci_wetg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'DRYG', ztot_ci_dryg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'HMG', ztot_ci_hmg (:, :, :) * zrhodjontstep(:, :, :) )
+ call Budget_store_add( tbudgets(idx), 'CORR2', ztot_ci_corr2(:, :, :) * zrhodjontstep(:, :, :) )
+
+ do ii = 1, nmod_ifn
+ idx = nsv_lima_ifn_nucl + ii - 1
+ call Budget_store_add( tbudgets(idx), 'IMLT', ztot_ifnn_imlt(:, :, :, ii) * zrhodjontstep(:, :, :) )
+ end do
+ end if
+
+ deallocate( zrhodjontstep )
+end if
!
END SUBROUTINE LIMA
diff --git a/src/MNH/lima_adjust.f90 b/src/MNH/lima_adjust.f90
index 752c861b9d9792eed74add2178143552c425b9c1..31ea1fefa3f64de70ef37019f48128354ae84871 100644
--- a/src/MNH/lima_adjust.f90
+++ b/src/MNH/lima_adjust.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.
@@ -9,22 +9,19 @@
!
INTERFACE
!
- SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, HRAD, &
- HTURBDIM, OCLOSE_OUT, 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_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=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
- ! turbulence scheme
-CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the OUTPUT FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
REAL, INTENT(IN) :: PTSTEP ! Time step
@@ -34,23 +31,22 @@ 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
!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration source
+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(OUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
!
END SUBROUTINE LIMA_ADJUST
!
@@ -58,13 +54,14 @@ END INTERFACE
!
END MODULE MODI_LIMA_ADJUST
!
-! ##########################################################################
- SUBROUTINE LIMA_ADJUST(KRR, KMI, TPFILE, HRAD, &
- HTURBDIM, OCLOSE_OUT, 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
!!
@@ -108,7 +105,6 @@ END MODULE MODI_LIMA_ADJUST
!! Module MODD_BUDGET:
!! NBUMOD
!! CBUTYPE
-!! NBUPROCCTR
!! LBU_RTH
!! LBU_RRV
!! LBU_RRC
@@ -134,18 +130,26 @@ END MODULE MODI_LIMA_ADJUST
!! Original ??/??/13
!! C. Barthe * LACy* jan. 2014 add budgets
!! JP Chaboureau *LA* March 2014 fix the calculation of icy cloud fraction
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! 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
+! P. Wautelet 23/07/2021: replace non-standard FLOAT function by REAL function
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+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
@@ -155,14 +159,15 @@ USE MODD_PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED
USE MODD_PARAM_LIMA_WARM
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+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_BUDGET
USE MODI_CONDENS
+USE MODI_CONDENSATION
USE MODI_LIMA_FUNCTIONS
+USE MODI_LIMA_CCN_ACTIVATION
!
IMPLICIT NONE
!
@@ -172,11 +177,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) :: OCLOSE_OUT ! Conditional closure of
- ! the OUTPUT FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid
! Condensation
REAL, INTENT(IN) :: PTSTEP ! Time step
@@ -186,23 +186,22 @@ 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
!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentration source
+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(OUT) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCLDFR ! Cloud fraction
!
!
!* 0.2 Declarations of local variables :
@@ -262,9 +261,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
@@ -276,6 +278,7 @@ 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
@@ -290,6 +293,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
@@ -315,6 +321,7 @@ ALLOCATE(ZCTMIN(ISIZE))
ZCTMIN(:) = XCTMIN(:) / ZDT
!
! Prepare 3D water mixing ratios
+!
PRVT(:,:,:) = PRT(:,:,:,1)
PRVS(:,:,:) = PRS(:,:,:,1)
!
@@ -372,8 +379,42 @@ 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(:, :, :) )
+ 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 ( 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
+ 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
+ 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
+
!-------------------------------------------------------------------------------
!
!
@@ -589,12 +630,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
@@ -603,6 +642,7 @@ IF( IMICRO >= 1 ) THEN
!
ALLOCATE(ZRVS(IMICRO))
ALLOCATE(ZRCS(IMICRO))
+ ALLOCATE(ZCCS(IMICRO))
ALLOCATE(ZTHS(IMICRO))
!
ALLOCATE(ZRHODREF(IMICRO))
@@ -616,6 +656,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))
@@ -626,25 +667,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( REAL(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( 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
!
@@ -668,6 +731,7 @@ IF( IMICRO >= 1 ) THEN
DEALLOCATE(ZRCT)
DEALLOCATE(ZRVS)
DEALLOCATE(ZRCS)
+ DEALLOCATE(ZCCS)
DEALLOCATE(ZTHS)
DEALLOCATE(ZRHODREF)
DEALLOCATE(ZZT)
@@ -677,10 +741,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
!
@@ -1020,6 +1080,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))
@@ -1101,28 +1163,30 @@ 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.
+ WHERE (PRCS(:,:,:) + PRIS(:,:,:) + PRSS(:,:,:) > 1.E-12 / ZDT)
+ 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 ( OCLOSE_OUT ) THEN
+IF ( tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'NEB'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'NEB'
@@ -1172,7 +1236,7 @@ END IF
!
! write SSI in LFI
!
-IF ( OCLOSE_OUT ) THEN
+IF ( tpfile%lopened ) THEN
ZT(:,:,:) = ( PTHS(:,:,:) * ZDT ) * ZEXNS(:,:,:)
ZW(:,:,:) = EXP( XALPI - XBETAI/ZT(:,:,:) - XGAMI*ALOG(ZT(:,:,:) ) )
ZW1(:,:,:)= 2.0*PPABST(:,:,:)-PPABSM(:,:,:)
@@ -1195,28 +1259,43 @@ END IF
!* 7. STORE THE BUDGET TERMS
! ----------------------
!
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:),4,'CEDS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:) * PRHODJ(:,:,:),6,'CEDS_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:) * PRHODJ(:,:,:),7,'CEDS_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:) * PRHODJ(:,:,:),9,'CEDS_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (PCCS(:,:,:) * PRHODJ(:,:,:),12+NSV_LIMA_NC,'CEDS_BU_RSV') ! RCC
- CALL BUDGET (PCIS(:,:,:) * PRHODJ(:,:,:),12+NSV_LIMA_NI,'CEDS_BU_RSV') ! RCI
- IF (NMOD_CCN .GE. 1) THEN
- DO JL = 1, NMOD_CCN
- CALL BUDGET (PNFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'CEDS_BU_RSV') ! RCC
- END DO
- END IF
- IF (NMOD_IFN .GE. 1) THEN
- DO JL = 1, NMOD_IFN
- CALL BUDGET (PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'CEDS_BU_RSV') ! RCC
- END DO
- END IF
- END IF
-END IF
+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(:, :, :) )
+ 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 ( 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
+ 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
+ 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_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..6f7dbb738c7ebbe213c1145f31eba74964ecf3c4
--- /dev/null
+++ b/src/MNH/lima_adjust_split.f90
@@ -0,0 +1,849 @@
+!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
+! P. Wautelet 23/07/2021: replace non-standard FLOAT function by REAL function
+!-------------------------------------------------------------------------------
+!
+!* 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, ZT2, & ! 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, ZRV2, &
+ ZRC, ZRC2, &
+ 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=1
+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(:,:,:) = PRS(:,:,:,1)*PTSTEP
+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(:,:,:) = PRS(:,:,:,2)*PTSTEP
+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(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)*PTSTEP
+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(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1)*PTSTEP
+ PNAT(:,:,:,:) = PSVS(:,:,:,NSV_LIMA_CCN_ACTI:NSV_LIMA_CCN_ACTI+NMOD_CCN-1)*PTSTEP
+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(:,:,:)
+ ZT2(:,:,:) = ZT(:,:,:)
+!
+!* 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
+ ZRV2=PRVT
+ ZRC2=PRCT
+ 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, ZT2, PDTHRAD, PW_NU+ZW_MF, &
+ PTHT, ZRV2, ZRC2, 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( REAL(NAHEN)-0.0001, XAHENINTP1 * ZZT(:) + XAHENINTP2 ) )
+ IVEC1(:) = INT( ZVEC1(:) )
+ ZVEC1(:) = ZVEC1(:) - REAL( 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 211fbd35f53472766670fcec4fd26ae627f67a26..b7786ea4f056c16c1f632f33e51df67f572c71d1 100644
--- a/src/MNH/lima_ccn_activation.f90
+++ b/src/MNH/lima_ccn_activation.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.
@@ -8,22 +8,19 @@
! ###############################
!
INTERFACE
- SUBROUTINE LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
+ SUBROUTINE LIMA_CCN_ACTIVATION (TPFILE, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ 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
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the output FM file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -36,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, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT )
+ SUBROUTINE LIMA_CCN_ACTIVATION (TPFILE, &
+ PRHODREF, PEXNREF, PPABST, PT, PDTHRAD, PW_NU, &
+ PTHT, PRVT, PRCT, PCCT, PRRT, PNFT, PNAT, &
+ PCLDFR )
! #############################################################################
!
!!
@@ -87,6 +87,7 @@ END MODULE MODI_LIMA_CCN_ACTIVATION
!! MODIFICATIONS
!! -------------
!! Original ??/??/13
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
@@ -96,15 +97,17 @@ 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_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_tools, only: Countjv
@@ -114,17 +117,13 @@ 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
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the output FM file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -137,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 :
!
@@ -147,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
@@ -183,7 +185,6 @@ TYPE(TFIELDDATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
ILUOUT = TLUOUT%NLU
-ZW(:,:,:)=0.
!
!* 1. PREPARE COMPUTATIONS - PACK
! ---------------------------
@@ -198,9 +199,9 @@ IKE=SIZE(PRHODREF,3) - JPVEXT
! Saturation vapor mixing ratio and radiative tendency
!
ZEPS= XMV / XMD
-ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-XALPW+XBETAW/PT(:,:,:)+XGAMW*ALOG(PT(:,:,:))) - 1.0)
ZTDT(:,:,:) = 0.
-IF (LACTIT) ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/PTSTEP ! dT/dt
+IF (LACTIT .AND. SIZE(PDTHRAD).GT.0) ZTDT(:,:,:) = PDTHRAD(:,:,:) * PEXNREF(:,:,:)
!
! find locations where CCN are available
!
@@ -214,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. ZT(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. ZT(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
+!
+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 (LSUBG_COND) GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) = GNUCT(IIB:IIE,IJB:IJE,IKB:IKE) &
+ .AND. PCLDFR(IIB:IIE,IJB:IJE,IKB:IKE)>0.01
+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
@@ -236,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))
@@ -251,7 +255,9 @@ IF( INUCT >= 1 ) THEN
ALLOCATE(ZRHODREF(INUCT))
ALLOCATE(ZEXNREF(INUCT))
DO JL=1,INUCT
- ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
+ ZRCT(JL) = PRCT(I1(JL),I2(JL),I3(JL))/PCLDFR(I1(JL),I2(JL),I3(JL))
+ ZCCT(JL) = PCCT(I1(JL),I2(JL),I3(JL))/PCLDFR(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))
ZZTDT(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
@@ -303,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
@@ -318,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
!
@@ -328,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
!
-!
!-------------------------------------------------------------------------------
!
!
@@ -348,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)
!
!
@@ -397,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
!
@@ -420,16 +436,21 @@ 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)*(ZT(:,:,:)-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 )
+ ZW2(:,:,:) = PCLDFR(:,:,:) * UNPACK( ZZW6(:),MASK=GNUCT(:,:,:),FIELD=0.0 )
!
!
!-------------------------------------------------------------------------------
@@ -443,6 +464,8 @@ IF( INUCT >= 1 ) THEN
DEALLOCATE(ZVEC1)
DEALLOCATE(ZNFT)
DEALLOCATE(ZNAT)
+ DEALLOCATE(ZCCT)
+ DEALLOCATE(ZRCT)
DEALLOCATE(ZZT)
DEALLOCATE(ZSMAX)
DEALLOCATE(ZZW1)
@@ -459,7 +482,12 @@ IF( INUCT >= 1 ) THEN
!
END IF ! INUCT
!
-IF ( OCLOSE_OUT ) THEN
+IF ( tpfile%lopened ) THEN
+ IF ( INUCT == 0 ) THEN
+ ZW (:,:,:) = 0.
+ ZW2(:,:,:) = 0.
+ END IF
+
TZFIELD%CMNHNAME ='SMAX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -496,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
@@ -550,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
!
@@ -571,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
@@ -581,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
@@ -591,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
@@ -609,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
@@ -630,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'
@@ -653,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
@@ -712,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
@@ -724,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 )
@@ -739,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
@@ -770,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
@@ -795,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 26948c4f4cfd7c5e4903a040993cc3a33e7c236c..86b7a9408b864e7d93dde71f280c0ce432bf57a8 100644
--- a/src/MNH/lima_ccn_hom_freezing.f90
+++ b/src/MNH/lima_ccn_hom_freezing.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_LIMA_CCN_HOM_FREEZING
! #################################
@@ -9,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
@@ -32,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
@@ -39,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
@@ -64,7 +69,6 @@ END MODULE MODI_LIMA_CCN_HOM_FREEZING
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
XG
@@ -81,8 +85,6 @@ USE MODD_PARAM_LIMA_WARM, ONLY: XLBC
!
use mode_tools, only: Countjv
!
-USE MODI_BUDGET
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -108,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_cold.f90 b/src/MNH/lima_cold.f90
index 28b88ca60f3aa5848d53e9e1863dc8ed44ecf251..3e0a6b3e49e007c6b36efdad8d80ab6c33ee0fe9 100644
--- a/src/MNH/lima_cold.f90
+++ b/src/MNH/lima_cold.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2013-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #####################
@@ -16,7 +16,9 @@ INTERFACE
PTHS, PRS, PSVS, &
PINPRS, PINPRG, PINPRH)
!
-LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+USE MODD_NSV, only: NSV_LIMA_BEG
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
! cloud ice sedimentation
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
@@ -39,11 +41,11 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
@@ -106,24 +108,29 @@ END MODULE MODI_LIMA_COLD
!! MODIFICATIONS
!! -------------
!! Original ??/??/13
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! 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 (no more budget calls in this subroutine)
+! P. Wautelet 28/05/2020: bugfix: correct array start for PSVT and PSVS
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
+
+use modd_budget, only: lbu_enable, &
+ lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_NSV
USE MODD_PARAM_LIMA
-!
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
+USE MODI_LIMA_COLD_HOM_NUCL
USE MODI_LIMA_COLD_SEDIMENTATION
+USE MODI_LIMA_COLD_SLOW_PROCESSES
USE MODI_LIMA_MEYERS
USE MODI_LIMA_PHILLIPS
-USE MODI_LIMA_COLD_HOM_NUCL
-USE MODI_LIMA_COLD_SLOW_PROCESSES
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -151,11 +158,11 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRS ! Snow instant precip
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPRG ! Graupel instant precip
@@ -301,6 +308,15 @@ END IF
!* 1. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
!
+if ( lbu_enable ) then
+ if ( lbudget_ri .and. osedi ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lsnow ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lhail ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv .and. osedi ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', pcis(:, :, :) * prhodj(:, :, :) )
+end if
+
CALL LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
PZZ, PRHODJ, PRHODREF, &
PRIT, PCIT, &
@@ -308,15 +324,14 @@ CALL LIMA_COLD_SEDIMENTATION (OSEDI, KSPLITG, PTSTEP, KMI, &
PINPRS, PINPRG,&
PINPRH )
-IF (LBU_ENABLE) THEN
- IF (LBUDGET_RI .AND. OSEDI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI')
- IF (LBUDGET_RS .AND. LSNOW) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10 ,'SEDI_BU_RRS')
- IF (LBUDGET_RG .AND. LSNOW) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11 ,'SEDI_BU_RRG')
- IF (LBUDGET_RH .AND. LHAIL) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12 ,'SEDI_BU_RRH')
- IF (LBUDGET_SV) THEN
- IF (OSEDI) CALL BUDGET (PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'SEDI_BU_RSV') ! RCI
- END IF
-END IF
+if ( lbu_enable ) then
+ if ( lbudget_ri .and. osedi ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg .and. lsnow ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh .and. lhail ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv .and. osedi ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'SEDI', pcis(:, :, :) * prhodj(:, :, :) )
+end if
!-------------------------------------------------------------------------------
!
!
@@ -349,8 +364,7 @@ IF (LNUCL) THEN
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
PCCT, &
- PCCS, PCRS, PNFS, &
- PCIS, PNIS, PNHS )
+ PCCS, PCRS, PNFS, PCIS, PNHS )
END IF
!
END IF
diff --git a/src/MNH/lima_cold_hom_nucl.f90 b/src/MNH/lima_cold_hom_nucl.f90
index f6c3f42114c5cbff0cece4bbef71e1eaf538c2cb..407ae868d0a8dc3de26edbc0c024a60fe0c4ba79 100644
--- a/src/MNH/lima_cold_hom_nucl.f90
+++ b/src/MNH/lima_cold_hom_nucl.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -14,8 +14,7 @@ INTERFACE
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
PCCT, &
- PCCS, PCRS, PNFS, &
- PCIS, PNIS, PNHS )
+ PCCS, PCRS, PNFS, PCIS, PNHS )
!
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
REAL, INTENT(IN) :: PTSTEP ! Time step
@@ -53,8 +52,6 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
!HOMOGENEOUS nucleation of haze
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
- !for IMMERSION
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHS ! haze homogeneous freezing
!
END SUBROUTINE LIMA_COLD_HOM_NUCL
@@ -68,8 +65,7 @@ END MODULE MODI_LIMA_COLD_HOM_NUCL
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
PTHS, PRVS, PRCS, PRRS, PRIS, PRGS, &
PCCT, &
- PCCS, PCRS, PNFS, &
- PCIS, PNIS, PNHS )
+ PCCS, PCRS, PNFS, PCIS, PNHS )
! ######################################################################
!
!! PURPOSE
@@ -90,15 +86,19 @@ END MODULE MODI_LIMA_COLD_HOM_NUCL
!! Original ??/??/13
!! C. Barthe * LACy* jan. 2014 add budgets
!! B.Vie 10/2016 Bug zero division
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! M. Leriche 05/2019: suppress unused actived coated IN (immersion) source
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rg, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RG, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, XCL, XCI, &
XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
XG
@@ -112,11 +112,10 @@ USE MODD_PARAM_LIMA_COLD, ONLY: XRCOEF_HONH, XCEXP_DIFVAP_HONH, XCOEF_DIFVAP_HON
XC_HONC, XTEXP1_HONC, XTEXP2_HONC, XTEXP3_HONC, &
XTEXP4_HONC, XTEXP5_HONC
USE MODD_PARAM_LIMA_WARM, ONLY: XLBC
-!
+
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-!
-USE MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -157,8 +156,6 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNFS ! CCN C. available source
!HOMOGENEOUS nucleation of haze
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIS ! Ice crystal C. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. source
- !for IMMERSION
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNHS ! haze homogeneous freezing
!
!* 0.2 Declarations of local variables :
@@ -184,8 +181,6 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZCCS ! Cloud water conc. source
REAL, DIMENSION(:), ALLOCATABLE :: ZCRS ! Rain water conc. source
REAL, DIMENSION(:,:), ALLOCATABLE :: ZNFS ! available nucleus conc. source
REAL, DIMENSION(:), ALLOCATABLE :: ZCIS ! Pristine ice conc. source
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZNIS ! Nucleated Ice nuclei conc. source
- !by Immersion
REAL, DIMENSION(:), ALLOCATABLE :: ZZNHS ! Nucleated Ice nuclei conc. source
!by Homogeneous freezing
!
@@ -222,6 +217,7 @@ INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
INTEGER :: JL, JMOD_CCN, JMOD_IMM ! Loop index
!
INTEGER :: INEGT ! Case number of hom. nucleation
+integer :: idx
LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: GNEGT ! Test where to compute the hom. nucleation
INTEGER , DIMENSION(SIZE(GNEGT)) :: I1,I2,I3 ! Used to replace the COUNT
@@ -283,7 +279,6 @@ IF (INEGT.GT.0) THEN
ALLOCATE(ZCIS(INEGT))
!
ALLOCATE(ZNFS(INEGT,NMOD_CCN))
- ALLOCATE(ZNIS(INEGT,NMOD_IMM))
ALLOCATE(ZZNHS(INEGT))
!
ALLOCATE(ZRHODREF(INEGT))
@@ -316,9 +311,6 @@ IF (INEGT.GT.0) THEN
DO JMOD_CCN = 1, NMOD_CCN
ZNFS(JL,JMOD_CCN) = PNFS(I1(JL),I2(JL),I3(JL),JMOD_CCN)
ENDDO
- DO JMOD_IMM = 1, NMOD_IMM
- ZNIS(JL,JMOD_IMM) = PNIS(I1(JL),I2(JL),I3(JL),JMOD_IMM)
- ENDDO
ZZNHS(JL) = ZNHS(I1(JL),I2(JL),I3(JL))
ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
ZZT(JL) = ZT(I1(JL),I2(JL),I3(JL))
@@ -355,6 +347,21 @@ IF (INEGT.GT.0) THEN
!* 2. Haze homogeneous freezing
! ------------------------
!
+ if ( nbumod == kmi .and. lbu_enable .and. ohhoni .and. nmod_ccn > 0 ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONH', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HONH', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONH', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( nmod_ccn > 0 ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HONH', pnfs(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', znhs(:, :, :) * prhodj(:, :, :) )
+ end if
+ end if
+ end if
!
! Compute the haze homogeneous nucleation source: RHHONI
!
@@ -446,31 +453,27 @@ IF (INEGT.GT.0) THEN
END IF ! OHHONI
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE .AND. OHHONI .AND. NMOD_CCN.GT.0 ) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HONH_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- 6,'HONH_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'HONH_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NI,'HONH_BU_RSV') ! RCI
- IF (NMOD_CCN.GE.1) THEN
- DO JL=1, NMOD_CCN
- CALL BUDGET ( UNPACK(ZNFS(:,JL),MASK=GNEGT(:,:,:),FIELD=PNFS(:,:,:,JL))*PRHODJ(:,:,:),&
- 12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV')
- END DO
- CALL BUDGET ( UNPACK(ZZNHS(:),MASK=GNEGT(:,:,:),FIELD=ZNHS(:,:,:))*PRHODJ(:,:,:),&
- 12+NSV_LIMA_HOM_HAZE,'HONH_BU_RSV')
-
- END IF
- END IF
- END IF
-!
+ if ( nbumod == kmi .and. lbu_enable .and. ohhoni .and. nmod_ccn > 0 ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONH', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HONH', &
+ Unpack( zrvs(:), mask = gnegt(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONH', &
+ Unpack( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', &
+ Unpack( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ if ( nmod_ccn > 0 ) then
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HONH', &
+ Unpack( znfs(:, jl), mask = gnegt(:, :, :), field = pnfs(:, :, :, jl) ) * prhodj(:, :, :) )
+ end do
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', &
+ Unpack( zznhs(:), mask = gnegt(:, :, :), field = znhs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+ end if
!
!-------------------------------------------------------------------------------
!
@@ -483,6 +486,19 @@ IF (INEGT.GT.0) THEN
! -> Pruppacher(1995)
!
IF (LWARM) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONC', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HONC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONC', &
+ Unpack( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HONC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONC', &
+ Unpack( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+
ZZW(:) = 0.0
ZZX(:) = 0.0
WHERE( (ZZT(:)<XTT-35.0) .AND. (ZCCT(:)>XCTMIN(2)) .AND. (ZRCT(:)>XRTMIN(2)) )
@@ -505,23 +521,20 @@ IF (LWARM) THEN
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HONC_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GNEGT(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:),&
- 7,'HONC_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'HONC_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NC,'HONC_BU_RSV')
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NI,'HONC_BU_RSV')
- END IF
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONC', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HONC', &
+ Unpack( zrcs(:), mask = gnegt(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONC', &
+ Unpack( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HONC', &
+ Unpack( zccs(:), mask = gnegt(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONC', &
+ Unpack( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
END IF
!
!
@@ -535,6 +548,16 @@ END IF
! Compute the drop homogeneous nucleation source: RRHONG
!
IF (LWARM .AND. LRAIN) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONR', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HONR', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'HONR', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HONR', pcrs(:, :, :) * prhodj(:, :, :) )
+ end if
+ end if
+
ZZW(:) = 0.0
WHERE( (ZZT(:)<XTT-35.0) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) )
ZZW(:) = ZRRS(:) ! Instantaneous freezing of the raindrops
@@ -546,21 +569,18 @@ IF (LWARM .AND. LRAIN) THEN
ENDWHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HONR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GNEGT(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:),&
- 8,'HONR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GNEGT(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:),&
- 11,'HONR_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GNEGT(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NR,'HONR_BU_RSV')
- END IF
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HONR', &
+ Unpack( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HONR', &
+ Unpack( zrrs(:), mask = gnegt(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'HONR', &
+ Unpack( zrgs(:), mask = gnegt(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HONR', &
+ Unpack( zcrs(:), mask = gnegt(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
END IF
!
!
@@ -614,7 +634,6 @@ END IF
DEALLOCATE(ZCIS)
!
DEALLOCATE(ZNFS)
- DEALLOCATE(ZNIS)
DEALLOCATE(ZZNHS)
!
DEALLOCATE(ZRHODREF)
@@ -632,57 +651,6 @@ END IF
DEALLOCATE(ZZX)
DEALLOCATE(ZZY)
!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- IF( OHHONI .AND. NMOD_CCN.GT.0 ) CALL BUDGET (ZW,4,'HONH_BU_RTH')
- IF (LWARM) CALL BUDGET (ZW,4,'HONC_BU_RTH')
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZW,4,'HONR_BU_RTH')
- ENDIF
- IF (LBUDGET_RV) THEN
- ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- IF( OHHONI .AND. NMOD_CCN.GT.0 ) CALL BUDGET (ZW,6,'HONH_BU_RRV')
- ENDIF
- IF (LBUDGET_RC) THEN
- ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
- IF (LWARM) CALL BUDGET (ZW,7,'HONC_BU_RRC')
- ENDIF
- IF (LBUDGET_RR) THEN
- ZW(:,:,:) = PRRS(:,:,:)*PRHODJ(:,:,:)
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZW,8,'HONR_BU_RRR')
- ENDIF
- IF (LBUDGET_RI) THEN
- ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- IF( OHHONI .AND. NMOD_CCN.GT.0 ) CALL BUDGET (ZW,9,'HONH_BU_RRI')
- IF (LWARM) CALL BUDGET (ZW,9,'HONC_BU_RRI')
- ENDIF
- IF (LBUDGET_RG) THEN
- ZW(:,:,:) = PRGS(:,:,:)*PRHODJ(:,:,:)
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZW,11,'HONR_BU_RRG')
- ENDIF
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
- IF (LWARM) CALL BUDGET (ZW,12+NSV_LIMA_NC,'HONC_BU_RSV')
- ZW(:,:,:) = PCRS(:,:,:)*PRHODJ(:,:,:)
- IF (LWARM .AND. LRAIN) CALL BUDGET (ZW,12+NSV_LIMA_NR,'HONR_BU_RSV')
- ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- IF( OHHONI .AND. NMOD_CCN.GT.0 ) CALL BUDGET (ZW,12+NSV_LIMA_NI,'HONH_BU_RSV')
- IF (LWARM) CALL BUDGET (ZW,12+NSV_LIMA_NI,'HONC_BU_RSV')
- IF( OHHONI .AND. NMOD_CCN.GT.0 ) THEN
- DO JL=1, NMOD_CCN
- ZW(:,:,:) = PNFS(:,:,:,JL)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV')
- END DO
- ZW(:,:,:) = ZNHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,12+NSV_LIMA_HOM_HAZE,'HONH_BU_RSV')
- END IF
- END IF
- END IF
-!
END IF ! INEGT>0
!
!
diff --git a/src/MNH/lima_cold_slow_processes.f90 b/src/MNH/lima_cold_slow_processes.f90
index 1973c65f3d23fa1a538243e90ac5371ad626d50c..9fcacdd5a39b10fc469e99ffba04621f848456a7 100644
--- a/src/MNH/lima_cold_slow_processes.f90
+++ b/src/MNH/lima_cold_slow_processes.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -77,15 +77,19 @@ END MODULE MODI_LIMA_COLD_SLOW_PROCESSES
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_ri, lbudget_rs, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RI, NBUDGET_RS, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
XCL, XCI, XTT, XLSTT, XALPI, XBETAI, XGAMI
USE MODD_NSV, ONLY: NSV_LIMA_NI
@@ -101,10 +105,9 @@ USE MODD_PARAM_LIMA_COLD, ONLY: XLBI, XLBEXI, XLBS, XLBEXS, XBI, XCXS, XCCS, &
XCOLEXIS, XAGGS_CLARGE1, XAGGS_CLARGE2, &
XAGGS_RLARGE1, XAGGS_RLARGE2
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_BUDGET
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -332,7 +335,13 @@ IF( IMICRO >= 1 ) THEN
!* 2.1 Conversion of snow to r_i: RSCNVI
! ----------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CNVI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CNVI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVI', pcis(:, :, :) * prhodj(:, :, :) )
+ end if
+
WHERE ( ZRST(:)>XRTMIN(5) )
ZLBDAS(:) = MIN( XLBDAS_MAX, &
XLBS*( ZRHODREF(:)*MAX( ZRST(:),XRTMIN(5) ) )**XLBEXS )
@@ -353,23 +362,26 @@ IF( IMICRO >= 1 ) THEN
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'CNVI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
- 10,'CNVI_BU_RRS')
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'CNVI_BU_RSV')
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CNVI', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CNVI', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVI', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
!
!
!* 2.2 Deposition of water vapor on r_s: RVDEPS
! -----------------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DEPS', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'DEPS', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ZZW(:) = 0.0
WHERE ( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>ZRTMIN(5)) )
ZZW(:) = ( ZSSI(:)/(ZRHODREF(:)*ZAI(:)) ) * &
@@ -380,25 +392,28 @@ IF( IMICRO >= 1 ) THEN
ZRVS(:) = ZRVS(:) - ZZW(:)
ZTHS(:) = ZTHS(:) + ZZW(:)*ZLSFACT(:)
END WHERE
-!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- 6,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
- 10,'DEPS_BU_RRS')
- END IF
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DEPS', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'DEPS', &
+ Unpack( zrvs(:), mask = gmicro(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ end if
!
!* 2.3 Conversion of pristine ice to r_s: RICNVS
! ------------------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CNVS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CNVS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ZZW(:) = 0.0
WHERE ( (ZLBDAI(:)<XLBDAICNVS_LIM) .AND. (ZCIT(:)>XCTMIN(4)) &
.AND. (ZSSI(:)>0.0) )
@@ -418,23 +433,28 @@ IF( IMICRO >= 1 ) THEN
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'CNVS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:),&
- 10,'CNVS_BU_RRS')
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'CNVS_BU_RSV')
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CNVS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CNVS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CNVS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
!
!
!* 2.4 Aggregation of r_i on r_s: CIAGGS and RIAGGS
! ---------------------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'AGGS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
WHERE ( (ZRIT(:)>XRTMIN(4)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRIS(:)>ZRTMIN(4)) &
.AND. (ZCIS(:)>ZCTMIN(4)) )
ZZW1(:,3) = (ZLBDAI(:) / ZLBDAS(:))**3
@@ -448,28 +468,21 @@ IF( IMICRO >= 1 ) THEN
ZRIS(:) = ZRIS(:) - ZZW1(:,2)
ZRSS(:) = ZRSS(:) + ZZW1(:,2)
END WHERE
-!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'AGGS_BU_RRS')
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'AGGS_BU_RSV')
- END IF
-!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'AGGS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
!------------------------------------------------------------------------------
!
!
!* 3. Unpacking & Deallocating
! ------------------------
!
-!
!
ZW(:,:,:) = PRVS(:,:,:)
PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
@@ -513,41 +526,6 @@ IF( IMICRO >= 1 ) THEN
DEALLOCATE(ZZW1)
IF (NBUMOD==KMI .AND. LBU_ENABLE) DEALLOCATE(ZRHODJ)
!
-!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,4,'DEPS_BU_RTH')
- ENDIF
- IF (LBUDGET_RV) THEN
- ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,6,'DEPS_BU_RRV')
- ENDIF
- IF (LBUDGET_RI) THEN
- ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,9,'CNVI_BU_RRI')
- CALL BUDGET (ZW,9,'CNVS_BU_RRI')
- CALL BUDGET (ZW,9,'AGGS_BU_RRI')
- ENDIF
- IF (LBUDGET_RS) THEN
- ZW(:,:,:) = PRSS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,10,'CNVI_BU_RRS')
- CALL BUDGET (ZW,10,'DEPS_BU_RRS')
- CALL BUDGET (ZW,10,'CNVS_BU_RRS')
- CALL BUDGET (ZW,10,'AGGS_BU_RRS')
- ENDIF
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,12+NSV_LIMA_NI,'CNVI_BU_RSV')
- CALL BUDGET (ZW,12+NSV_LIMA_NI,'CNVS_BU_RSV')
- CALL BUDGET (ZW,12+NSV_LIMA_NI,'AGGS_BU_RSV')
- ENDIF
- ENDIF
-!
END IF
!
!++cb++
@@ -556,3 +534,4 @@ DEALLOCATE(ZCTMIN)
!--cb--
!
END SUBROUTINE LIMA_COLD_SLOW_PROCESSES
+
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 2f2c911100c174146817e1ab5db7e2ae87966098..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
@@ -57,13 +52,13 @@ END MODULE MODI_LIMA_DROPLETS_AUTOCONVERSION
!! MODIFICATIONS
!! -------------
!! Original 15/03/2018
-!!
+!! B. Vie 02/03/2020 : missing CC process
!-------------------------------------------------------------------------------
!
!* 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
!
@@ -125,13 +116,9 @@ WHERE( PRCT(:)>XRTMIN(2) .AND. PLBDC(:)>0. .AND. LDCOMPUTE(:) )
! min (80 microns, D_h, D_r)
ZW3(:) = ZW3(:) * MAX( 0.0,ZW1(:) )**3 / XAC
!
- P_CC_AUTO(:) = 0.
+ P_CC_AUTO(:) = -ZW3(:)
P_CR_AUTO(:) = ZW3(:)
!
- PA_RC(:) = PA_RC(:) + P_RC_AUTO(:)
- PA_CC(:) = PA_CC(:)
- 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..16a5617407f80b8bd99fd57dc25b5687ed6433db
--- /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_CCN,XD,XSIGMA,XLIMIT_FACTOR,XK,XMU,XBETA,XKAPPA)
+ !
+ CHARACTER(LEN=*), INTENT(IN) :: CTYPE_CCN ! 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_CCN,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_CCN ! 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_CCN
+! ---------------------------------
+!
+! Kappa values are from Petters and Kreidenweis (2007), table 1.
+!
+SELECT CASE (CTYPE_CCN)
+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 fe22db3a839f9a512f80485587ac6f7d6cfab536..ce7a127815611c7cd97b37c3c2d51c91665fb0e1 100644
--- a/src/MNH/lima_inst_procs.f90
+++ b/src/MNH/lima_inst_procs.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_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,13 +82,14 @@ 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
!! -------
!! Compute sources of instantaneous microphysical processes for the
-!! time-splitted version of LIMA
+!! time-split version of LIMA
!!
!! AUTHOR
!! ------
@@ -95,7 +102,7 @@ SUBROUTINE LIMA_INST_PROCS (PTSTEP, LDCOMPUTE,
!-------------------------------------------------------------------------------
!
!
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, NMOD_CCN, NMOD_IFN
+USE MODD_PARAM_LIMA, ONLY : LCOLD, LWARM, LRAIN
!
USE MODI_LIMA_DROPS_BREAK_UP
USE MODI_LIMA_DROPS_HOM_FREEZING
@@ -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.f90 b/src/MNH/lima_meyers.f90
index 775a104ec5eb74d5d885a93f146f53c2deac0d91..7e55e1ab7cbc257097990a208dfeebc1ecc50972 100644
--- a/src/MNH/lima_meyers.f90
+++ b/src/MNH/lima_meyers.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.
@@ -106,25 +106,28 @@ END MODULE MODI_LIMA_MEYERS
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+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_CST
-USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NI
+USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_NUCL
USE MODD_PARAMETERS
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_COLD
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_BUDGET
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -314,6 +317,15 @@ IF( INEGT >= 1 ) THEN
!
!* compute the heterogeneous nucleation by deposition: RVHNDI
!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HIND', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HIND', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HIND', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv .and. nmod_ifn > 0) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', pins(:, :, :, 1) * prhodj(:, :, :) )
+ end if
+
DO JL=1,INEGT
ZINS(JL,1) = PINS(I1(JL),I2(JL),I3(JL),1)
END DO
@@ -328,8 +340,6 @@ IF( INEGT >= 1 ) THEN
END WHERE
!
ZINS(:,1) = ZINS(:,1) + ZZX(:)
- ZW(:,:,:) = PINS(:,:,:,1)
- PINS(:,:,:,1) = UNPACK( ZINS(:,1), MASK=GNEGT(:,:,:), FIELD=ZW(:,:,:) )
!
ZRVS(:) = ZRVS(:) - ZZW(:)
ZRIS(:) = ZRIS(:) + ZZW(:)
@@ -338,27 +348,37 @@ IF( INEGT >= 1 ) THEN
!
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HIND_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- 6,'HIND_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'HIND_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NI,'HIND_BU_RSV')
- END IF
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HIND', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HIND', &
+ Unpack ( zrvs(:), mask = gnegt(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HIND', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv .and. nmod_ifn > 0 ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
+ Unpack ( zins(:, 1), mask = gnegt(:, :, :), field = pins(:, :, :, 1) ) * prhodj(:, :, :) )
+ end if
!
!* compute the heterogeneous nucleation by contact: RVHNCI
!
- DO JL=1,INEGT
- ZINS(JL,1) = PINS(I1(JL),I2(JL),I3(JL),1)
- END DO
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HINC', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HINC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HINC', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ if ( nmod_ifn > 0 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
+ Unpack ( zins(:, 1), mask = gnegt(:, :, :), field = pins(:, :, :, 1) ) * prhodj(:, :, :) )
+ end if
+ end if
+
ZZW(:) = 0.0
ZZX(:) = 0.0
ZZY(:) = 0.0
@@ -396,17 +416,18 @@ IF( INEGT >= 1 ) THEN
PCIS(:,:,:) = UNPACK( ZCIS(:),MASK=GNEGT(:,:,:),FIELD=ZW(:,:,:) )
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:), 4,'HINC_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), 7,'HINC_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9,'HINC_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HINC_BU_RSV')
- CALL BUDGET ( PCIS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NI,'HINC_BU_RSV')
- END IF
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HINC', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HINC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HINC', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', pcis(:, :, :) * prhodj(:, :, :) )
+ if ( nmod_ifn > 0 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', pins(:, :, :, 1) * prhodj(:, :, :) )
+ end if
+ end if
-!
DEALLOCATE(ZRVT)
DEALLOCATE(ZRCT)
DEALLOCATE(ZRRT)
@@ -438,43 +459,7 @@ IF( INEGT >= 1 ) THEN
DEALLOCATE(ZLSFACT)
DEALLOCATE(ZLVFACT)
!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,4,'HIND_BU_RTH')
- CALL BUDGET (ZW,4,'HINC_BU_RTH')
- ENDIF
- IF (LBUDGET_RV) THEN
- ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,6,'HIND_BU_RRV')
- ENDIF
- IF (LBUDGET_RC) THEN
- ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,7,'HINC_BU_RRC')
- ENDIF
- IF (LBUDGET_RI) THEN
- ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,9,'HIND_BU_RRI')
- CALL BUDGET (ZW,9,'HINC_BU_RRI')
- ENDIF
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,12+NSV_LIMA_NC,'HINC_BU_RSV')
- ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,12+NSV_LIMA_NI,'HIND_BU_RSV')
- CALL BUDGET (ZW,12+NSV_LIMA_NI,'HINC_BU_RSV')
- END IF
- END IF
-!
END IF
-
-
-
-
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/lima_meyers_nucleation.f90 b/src/MNH/lima_meyers_nucleation.f90
index 0aa09ccbabce9769552385398f63cbc8e8283e81..f0c38fd6ad95ec88b8b3517646347640ce7f9091 100644
--- a/src/MNH/lima_meyers_nucleation.f90
+++ b/src/MNH/lima_meyers_nucleation.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.
@@ -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_RC_HINC, P_CC_HINC )
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
!
REAL, INTENT(IN) :: PTSTEP
!
@@ -33,11 +34,14 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Activated ice nuclei C.
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CC_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
+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
@@ -49,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_RC_HINC, P_CC_HINC )
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
! #############################################################################
!!
!! PURPOSE
@@ -69,13 +74,12 @@ END MODULE MODI_LIMA_MEYERS_NUCLEATION
!! -------------
!! Original 15/03/2018
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 27/02/2020: add P_TH_HINC dummy argument + change intent of *_HIND and *_HINC dummy arguments (INOUT->OUT)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
USE MODD_CST
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NI
USE MODD_PARAMETERS
@@ -84,8 +88,6 @@ USE MODD_PARAM_LIMA_COLD
use mode_tools, only: Countjv
-USE MODI_BUDGET
-!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -108,11 +110,14 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCCT ! Cloud water C. at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Ice crystal C. source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Activated ice nuclei C.
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CC_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
+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 :
@@ -168,6 +173,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS
P_TH_HIND(:,:,:) = 0.
P_RI_HIND(:,:,:) = 0.
P_CI_HIND(:,:,:) = 0.
+P_TH_HINC(:,:,:) = 0.
P_RC_HINC(:,:,:) = 0.
P_CC_HINC(:,:,:) = 0.
!
@@ -302,7 +308,8 @@ IF( INEGT >= 1 ) THEN
!
P_RC_HINC(:,:,:) = - UNPACK( ZZW(:), MASK=GNEGT(:,:,:), FIELD=0. )
P_CC_HINC(:,:,:) = - UNPACK( ZZX(:), MASK=GNEGT(:,:,:), FIELD=0. )
- PTHT(:,:,:) = PTHT(:,:,:) + UNPACK( ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)), MASK=GNEGT(:,:,:), FIELD=0. )
+ P_TH_HINC(:,:,:) = UNPACK( ZZW(:)*(ZLSFACT(:)-ZLVFACT(:)), MASK=GNEGT(:,:,:), FIELD=0. )
+ PTHT(:,:,:) = PTHT(:,:,:) + P_TH_HINC(:,:,:)
PRCT(:,:,:) = PRCT(:,:,:) + P_RC_HINC(:,:,:)
PRIT(:,:,:) = PRIT(:,:,:) - P_RC_HINC(:,:,:)
PCCT(:,:,:) = PCCT(:,:,:) + P_CC_HINC(:,:,:)
diff --git a/src/MNH/lima_mixed.f90 b/src/MNH/lima_mixed.f90
index 7525be5b3a195b44b6020d8f7d0320b66a0b089b..49024b7b518893f1b9b101175676fb8a5d18f558 100644
--- a/src/MNH/lima_mixed.f90
+++ b/src/MNH/lima_mixed.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.
@@ -15,7 +15,9 @@ INTERFACE
PTHT, PRT, PSVT, &
PTHS, PRS, PSVS)
!
-LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
+USE MODD_NSV, only: NSV_LIMA_BEG
+!
+LOGICAL, INTENT(IN) :: OSEDI ! switch to activate the
! cloud ice sedimentation
LOGICAL, INTENT(IN) :: OHHONI ! enable haze freezing
INTEGER, INTENT(IN) :: KSPLITG ! Number of small time step
@@ -38,12 +40,11 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
-
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
!
END SUBROUTINE LIMA_MIXED
END INTERFACE
@@ -91,14 +92,16 @@ END MODULE MODI_LIMA_MIXED
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets (no more call to budget in this subroutine)
+! 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbu_enable, nbumod
USE MODD_CST, ONLY: XP00, XRD, XRV, XMV, XMD, XCPD, XCPV, &
XCL, XCI, XTT, XLSTT, XLVTT, &
XALPI, XBETAI, XGAMI
@@ -112,10 +115,9 @@ USE MODD_PARAM_LIMA_MIXED, ONLY: XLBG, XLBEXG, XLBH, XLBEXH
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_LIMA_MIXED_FAST_PROCESSES
USE MODI_LIMA_MIXED_SLOW_PROCESSES
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -143,12 +145,11 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! abs. pressure at time t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
-
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
!
!* 0.2 Declarations of local variables :
!
@@ -178,19 +179,10 @@ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
PCRS, & ! Rain water C. source
PCIS ! Ice crystal C. source
!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNFS ! CCN C. available source
- !used as Free ice nuclei for
- !HOMOGENEOUS nucleation of haze
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNAS ! Cloud C. nuclei C. source
- !used as Free ice nuclei for
- !IMMERSION freezing
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PIFS ! Free ice nuclei C. source
!for DEPOSITION and CONTACT
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PINS ! Activated ice nuclei C. source
!for DEPOSITION and CONTACT
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNIS ! Activated ice nuclei C. source
- !for IMMERSION
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: PNHS ! Hom. freezing of CCN
!
! Replace PACK
LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: GMICRO
@@ -309,18 +301,6 @@ IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
IF ( LCOLD ) PCIS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NI)
!
-IF ( 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) )
- 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)
-ELSE
- ALLOCATE( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- PNFS(:,:,:,:) = 0.
- PNAS(:,:,:,:) = 0.
-END IF
-!
IF ( 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) )
@@ -333,22 +313,6 @@ ELSE
PINS(:,:,:,:) = 0.
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)
-ELSE
- ALLOCATE( PNIS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- PNIS(:,:,:,:) = 0.0
-END IF
-!
-IF ( OHHONI ) THEN
- ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
- PNHS(:,:,:) = PSVS(:,:,:,NSV_LIMA_HOM_HAZE)
-ELSE
- ALLOCATE( PNHS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3)) )
- PNHS(:,:,:) = 0.0
-END IF
-!
!-------------------------------------------------------------------------------
!
!
@@ -529,7 +493,7 @@ IF( IMICRO >= 1 ) THEN
ZLBDAI, ZLBDAG, &
ZRHODJ, GMICRO, PRHODJ, KMI, &
PTHS, PRVS, PRCS, PRIS, PRGS, &
- PCCS, PCIS )
+ PCCS, PCIS, PINS )
!
!-------------------------------------------------------------------------------
!
@@ -642,119 +606,6 @@ END IF
!
IF (NBUMOD==KMI .AND. LBU_ENABLE) DEALLOCATE(ZRHODJ)
!
-!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- IF (LSNOW) CALL BUDGET (ZW,4,'DEPG_BU_RTH')
- CALL BUDGET (ZW,4,'IMLT_BU_RTH')
- CALL BUDGET (ZW,4,'BERFI_BU_RTH')
- IF (LSNOW) CALL BUDGET (ZW,4,'RIM_BU_RTH')
- IF (LSNOW .AND. LRAIN) CALL BUDGET (ZW,4,'ACC_BU_RTH')
- IF (LSNOW) CALL BUDGET (ZW,4,'CFRZ_BU_RTH')
- IF (LSNOW) CALL BUDGET (ZW,4,'WETG_BU_RTH')
- IF (LSNOW) CALL BUDGET (ZW,4,'DRYG_BU_RTH')
- IF (LSNOW) CALL BUDGET (ZW,4,'GMLT_BU_RTH')
- IF (LHAIL) CALL BUDGET (ZW,4,'WETH_BU_RTH')
- IF (LHAIL) CALL BUDGET (ZW,4,'HMLT_BU_RTH')
- ENDIF
- IF (LBUDGET_RV) THEN
- ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- IF (LSNOW) CALL BUDGET (ZW,6,'DEPG_BU_RRV')
- ENDIF
- IF (LBUDGET_RC) THEN
- ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,7,'IMLT_BU_RRC')
- CALL BUDGET (ZW,7,'BERFI_BU_RRC')
- IF (LSNOW) CALL BUDGET (ZW,7,'RIM_BU_RRC')
- IF (LSNOW) CALL BUDGET (ZW,7,'WETG_BU_RRC')
- IF (LSNOW) CALL BUDGET (ZW,7,'DRYG_BU_RRC')
- IF (LHAIL) CALL BUDGET (ZW,7,'WETH_BU_RRC')
- ENDIF
- IF (LBUDGET_RR .AND. LRAIN) THEN
- ZW(:,:,:) = PRRS(:,:,:)*PRHODJ(:,:,:)
- IF (LSNOW .AND. LRAIN) CALL BUDGET (ZW,8,'ACC_BU_RRR')
- IF (LSNOW) CALL BUDGET (ZW,8,'CFRZ_BU_RRR')
- IF (LSNOW) CALL BUDGET (ZW,8,'WETG_BU_RRR')
- IF (LSNOW) CALL BUDGET (ZW,8,'DRYG_BU_RRR')
- IF (LSNOW) CALL BUDGET (ZW,8,'GMLT_BU_RRR')
- IF (LHAIL) CALL BUDGET (ZW,8,'WETH_BU_RRR')
- IF (LHAIL) CALL BUDGET (ZW,8,'HMLT_BU_RRR')
- ENDIF
- IF (LBUDGET_RI) THEN
- ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,9,'IMLT_BU_RRI')
- CALL BUDGET (ZW,9,'BERFI_BU_RRI')
- IF (LSNOW) CALL BUDGET (ZW,9,'HMS_BU_RRI')
- IF (LSNOW) CALL BUDGET (ZW,9,'CFRZ_BU_RRI')
- IF (LSNOW) CALL BUDGET (ZW,9,'WETG_BU_RRI')
- IF (LSNOW) CALL BUDGET (ZW,9,'DRYG_BU_RRI')
- IF (LSNOW) CALL BUDGET (ZW,9,'HMG_BU_RRI')
- IF (LHAIL) CALL BUDGET (ZW,9,'WETH_BU_RRI')
- ENDIF
- IF (LBUDGET_RS .AND. LSNOW) THEN
- ZW(:,:,:) = PRSS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,10,'RIM_BU_RRS')
- CALL BUDGET (ZW,10,'HMS_BU_RRS')
- IF (LRAIN) CALL BUDGET (ZW,10,'ACC_BU_RRS')
- CALL BUDGET (ZW,10,'CMEL_BU_RRS')
- CALL BUDGET (ZW,10,'WETG_BU_RRS')
- CALL BUDGET (ZW,10,'DRYG_BU_RRS')
- IF (LHAIL) CALL BUDGET (ZW,10,'WETH_BU_RRS')
- ENDIF
- IF (LBUDGET_RG .AND. LSNOW) THEN
- ZW(:,:,:) = PRGS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,11,'DEPG_BU_RRG')
- CALL BUDGET (ZW,11,'RIM_BU_RRG')
- IF (LRAIN) CALL BUDGET (ZW,11,'ACC_BU_RRG')
- CALL BUDGET (ZW,11,'CMEL_BU_RRG')
- CALL BUDGET (ZW,11,'CFRZ_BU_RRG')
- CALL BUDGET (ZW,11,'WETG_BU_RRG')
- CALL BUDGET (ZW,11,'DRYG_BU_RRG')
- CALL BUDGET (ZW,11,'HMG_BU_RRG')
- CALL BUDGET (ZW,11,'GMLT_BU_RRG')
- IF (LHAIL) CALL BUDGET (ZW,11,'WETH_BU_RRG')
- IF (LHAIL) CALL BUDGET (ZW,11,'COHG_BU_RRG')
- ENDIF
- IF (LBUDGET_RH .AND. LHAIL) THEN
- ZW(:,:,:) = PRHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,12,'WETG_BU_RRH')
- IF (LHAIL) CALL BUDGET (ZW,12,'WETH_BU_RRH')
- IF (LHAIL) CALL BUDGET (ZW,12,'COHG_BU_RRH')
- IF (LHAIL) CALL BUDGET (ZW,12,'HMLT_BU_RRH')
- ENDIF
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,12+NSV_LIMA_NC,'IMLT_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NC,'RIM_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NC,'WETG_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NC,'DRYG_BU_RSV')
- IF (LHAIL) CALL BUDGET (ZW,12+NSV_LIMA_NC,'WETH_BU_RSV')
-!
- ZW(:,:,:) = PCRS(:,:,:)*PRHODJ(:,:,:)
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NR,'ACC_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NR,'CFRZ_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NR,'WETG_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NR,'DRYG_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NR,'GMLT_BU_RSV')
- IF (LHAIL) CALL BUDGET (ZW,12+NSV_LIMA_NR,'WETH_BU_RSV')
- IF (LHAIL) CALL BUDGET (ZW,12+NSV_LIMA_NR,'HMLT_BU_RSV')
-!
- ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,12+NSV_LIMA_NI,'IMLT_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NI,'HMS_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NI,'CFRZ_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NI,'WETG_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NI,'DRYG_BU_RSV')
- IF (LSNOW) CALL BUDGET (ZW,12+NSV_LIMA_NI,'HMG_BU_RSV')
- IF (LHAIL) CALL BUDGET (ZW,12+NSV_LIMA_NI,'WETH_BU_RSV')
- ENDIF
- ENDIF
-!
END IF ! IMICRO >= 1
!
!------------------------------------------------------------------------------
@@ -777,27 +628,14 @@ PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
IF ( LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
PSVS(:,:,:,NSV_LIMA_NI) = PCIS(:,:,:)
!
-IF ( 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 ( 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 ( NMOD_IMM .GE. 1 ) THEN
- PSVS(:,:,:,NSV_LIMA_IMM_NUCL:NSV_LIMA_IMM_NUCL+NMOD_IMM-1) = PNIS(:,:,:,:)
-END IF
-!
!++cb++
-IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
-IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
IF (ALLOCATED(PIFS)) DEALLOCATE(PIFS)
IF (ALLOCATED(PINS)) DEALLOCATE(PINS)
-IF (ALLOCATED(PNIS)) DEALLOCATE(PNIS)
-IF (ALLOCATED(PNHS)) DEALLOCATE(PNHS)
!--cb--
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_mixed_fast_processes.f90 b/src/MNH/lima_mixed_fast_processes.f90
index fdb9724bcc844fa74054e06b81c066867c806c04..09c86c8a20e23fb9cd16adb859604d1aae2c37e5 100644
--- a/src/MNH/lima_mixed_fast_processes.f90
+++ b/src/MNH/lima_mixed_fast_processes.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -15,7 +15,7 @@ INTERFACE
ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
ZTHS, ZCCS, ZCRS, ZCIS, &
ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
- ZRHODJ, GMICRO, PRHODJ, KMI, PTHS, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, &
PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
PCCS, PCRS, PCIS )
!
@@ -62,7 +62,7 @@ REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel dist
REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr.
!
! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
INTEGER, INTENT(IN) :: KMI
@@ -89,7 +89,7 @@ END MODULE MODI_LIMA_MIXED_FAST_PROCESSES
ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, &
ZTHS, ZCCS, ZCRS, ZCIS, &
ZLBDAC, ZLBDAR, ZLBDAS, ZLBDAG, ZLBDAH, &
- ZRHODJ, GMICRO, PRHODJ, KMI, PTHS, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI, PTHS, &
PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, &
PCCS, PCRS, PCIS )
! #######################################################################
@@ -141,21 +141,24 @@ END MODULE MODI_LIMA_MIXED_FAST_PROCESSES
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST
+USE MODD_NSV
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_COLD
USE MODD_PARAM_LIMA_MIXED
-!
-USE MODD_NSV
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -203,7 +206,7 @@ REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope param of the graupel dist
REAL, DIMENSION(:), INTENT(IN) :: ZLBDAH ! Slope param of the hail distr.
!
! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
INTEGER, INTENT(IN) :: KMI
@@ -238,19 +241,30 @@ REAL :: ZTHRH, ZTHRC
! FAST RS PROCESSES
! #################
!
-IF (LSNOW) THEN
+SNOW: IF (LSNOW) THEN
!
!
!* 1.1 Cloud droplet riming of the aggregates
! -------------------------------------------
!
-!
ZZW1(:,:) = 0.0
!
GRIM(:) = (ZRCT(:)>XRTMIN(2)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP) .AND. (ZZT(:)<XTT)
IGRIM = COUNT( GRIM(:) )
!
IF( IGRIM>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'RIM', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ end if
!
! 1.1.0 allocations
!
@@ -323,29 +337,22 @@ IF( IGRIM>0 ) THEN
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
+
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'RIM', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'RIM', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ end if
END IF
!
-! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'RIM_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NC,'RIM_BU_RSV')
- END IF
-END IF
-!
-!
!* 1.2 Hallett-Mossop ice multiplication process due to snow riming
! -----------------------------------------------------------------
!
@@ -354,6 +361,16 @@ GRIM(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) &
.AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRCT(:)>XRTMIN(2))
IGRIM = COUNT( GRIM(:) )
IF( IGRIM>0 ) THEN
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'HMS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ALLOCATE(ZVEC1(IGRIM))
ALLOCATE(ZVEC2(IGRIM))
ALLOCATE(IVEC2(IGRIM))
@@ -380,19 +397,16 @@ IF( IGRIM>0 ) THEN
DEALLOCATE(IVEC2)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
-END IF
-!
-! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO,FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'HMS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO,FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'HMS_BU_RRS')
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCIS(:),MASK=GMICRO,FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'HMS_BU_RSV')
+
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HMS', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'HMS', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMS', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
END IF
!
!
@@ -405,6 +419,19 @@ GACC(:) = (ZRRT(:)>XRTMIN(3)) .AND. (ZRST(:)>XRTMIN(5)) .AND. (ZRRS(:)>XRTMIN(3)
IGACC = COUNT( GACC(:) )
!
IF( IGACC>0 .AND. LRAIN) THEN
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
!
! 1.3.0 allocations
!
@@ -510,32 +537,32 @@ IF( IGACC>0 .AND. LRAIN) THEN
DEALLOCATE(ZVEC3)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
+
+ ! Budget storage
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'ACC', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
END IF
!
-IF (NBUMOD==KMI .AND. LBU_ENABLE .AND. LRAIN) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'ACC_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'ACC_BU_RSV')
- END IF
-END IF
-!
-!
!* 1.4 Conversion-Melting of the aggregates
! -----------------------------------------
!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+end if
+
ZZW(:) = 0.0
WHERE( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) .AND. (ZZT(:)>XTT) )
ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
@@ -560,16 +587,14 @@ WHERE( (ZRST(:)>XRTMIN(5)) .AND. (ZRSS(:)>XRTMIN(5)/PTSTEP) .AND. (ZZT(:)>XTT) )
END WHERE
!
! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'CMEL_BU_RRG')
-END IF
-!
-END IF ! LSNOW
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+end if
+
+END IF SNOW
!
!------------------------------------------------------------------------------
!
@@ -581,7 +606,21 @@ END IF ! LSNOW
!* 2.1 Rain contact freezing
! --------------------------
!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CFRZ', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+
ZZW1(:,3:4) = 0.0
WHERE( (ZRIT(:)>XRTMIN(4)) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZRRS(:)>XRTMIN(3)/PTSTEP) )
ZZW1(:,3) = MIN( ZRIS(:),XICFRR * ZRIT(:) * ZCRT(:) & ! RICFRRG
@@ -599,32 +638,48 @@ WHERE( (ZRIT(:)>XRTMIN(4)) .AND. (ZRRT(:)>XRTMIN(3)) .AND. (ZRIS(:)>XRTMIN(4)/PT
ZCIS(:) = MAX( ZCIS(:)-ZZW1(:,3)*(ZCIT(:)/ZRIT(:)),0.0 ) ! CICFRRG
ZCRS(:) = MAX( ZCRS(:)-ZZW1(:,4)*(ZCRT(:)/ZRRT(:)),0.0 ) ! CRCFRIG
END WHERE
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'CFRZ_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'CFRZ_BU_RSV')
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'CFRZ_BU_RSV')
- END IF
-END IF
-!
+
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CFRZ', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'CFRZ', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'CFRZ', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
!
!* 2.2 Compute the Dry growth case
! --------------------------------
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
!
ZZW1(:,:) = 0.0
WHERE( ((ZRCT(:)>XRTMIN(2)) .AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCS(:)>XRTMIN(2)/PTSTEP)) .OR. &
@@ -836,40 +891,56 @@ WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'WETG_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- 12,'WETG_BU_RRH')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NC,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'WETG_BU_RSV')
- END IF
- END IF
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
!
! Dry case
!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
+
WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
.AND. ZRDRYG(:)<ZRWETG(:) .AND. ZRDRYG(:)>0.0 ) ! case
ZRCS(:) = ZRCS(:) - ZZW1(:,1)
@@ -887,40 +958,42 @@ WHERE( ZRGT(:)>XRTMIN(6) .AND. ZZT(:)<XTT &
END WHERE
!
! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'DRYG_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NC,'DRYG_BU_RSV')
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'DRYG_BU_RSV')
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'DRYG_BU_RSV')
- END IF
-END IF
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DRYG', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'DRYG', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'DRYG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+end if
!
!
!* 2.5 Hallett-Mossop ice multiplication process due to graupel riming
! --------------------------------------------------------------------
!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HMG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'HMG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
+
GDRY(:) = (ZZT(:)<XHMTMAX) .AND. (ZZT(:)>XHMTMIN) .AND. (ZRDRYG(:)<ZZW(:))&
.AND. (ZRGT(:)>XRTMIN(6)) .AND. (ZRCT(:)>XRTMIN(2))
IGDRY = COUNT( GDRY(:) )
@@ -953,23 +1026,29 @@ IF( IGDRY>0 ) THEN
END IF
!
! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO,FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'HMG_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO,FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'HMG_BU_RRG')
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCIS(:),MASK=GMICRO,FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'HMG_BU_RSV')
-END IF
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HMG', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'HMG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HMG', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+end if
!
!* 2.6 Melting of the graupeln
! ----------------------------
!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'GMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+end if
+
ZZW(:) = 0.0
WHERE( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) .AND. (ZZT(:)>XTT) )
ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
@@ -994,21 +1073,16 @@ WHERE( (ZRGT(:)>XRTMIN(6)) .AND. (ZRGS(:)>XRTMIN(6)/PTSTEP) .AND. (ZZT(:)>XTT) )
! Dshed=1mm and 500 microns
END WHERE
!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'GMLT_BU_RRG')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'GMLT_BU_RSV')
- END IF
-END IF
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'GMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'GMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+end if
!
!
!------------------------------------------------------------------------------
@@ -1018,7 +1092,7 @@ END IF
! #################
!
!
-IF (LHAIL) THEN
+HAIL: IF (LHAIL) THEN
!
GHAIL(:) = ZRHT(:)>XRTMIN(7)
IHAIL = COUNT(GHAIL(:))
@@ -1028,6 +1102,31 @@ IF( IHAIL>0 ) THEN
!* 3.1 Wet growth of hail
! ----------------------------
!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
+
ZZW1(:,:) = 0.0
WHERE( GHAIL(:) .AND. ( (ZRCT(:)>XRTMIN(2) .AND. ZRCS(:)>XRTMIN(2)/PTSTEP) .OR. &
(ZRIT(:)>XRTMIN(4) .AND. ZRIS(:)>XRTMIN(4)/PTSTEP) ) )
@@ -1209,43 +1308,33 @@ IF( IHAIL>0 ) THEN
ZCRS(:) = MAX( ZCRS(:)-MAX( ZZW1(:,4)-ZZW1(:,1),0.0 ) &
*(ZCRT(:)/MAX(ZRRT(:),XRTMIN(3))),0.0 )
END WHERE
-!
+
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:), mask = gmicro(:, :, :), field = prss(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'WETH', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'WETH', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'WETH', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ end if
+ end if
END IF ! IHAIL>0
!
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:),MASK=GMICRO(:,:,:),FIELD=PRSS)*PRHODJ(:,:,:), &
- 10,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- 12,'WETH_BU_RRH')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NC,'WETH_BU_RSV')
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'WETH_BU_RSV')
- CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'WETH_BU_RSV')
- END IF
-END IF
-!
-!
! Partial reconversion of hail to graupel when rc and rh are small
!
!
@@ -1253,6 +1342,13 @@ END IF
! -----------------------------------------------
!
IF ( IHAIL>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'COHG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'COHG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ZTHRH=0.01E-3
ZTHRC=0.001E-3
ZZW(:) = 0.0
@@ -1266,21 +1362,29 @@ IF ( IHAIL>0 ) THEN
ZRHS(:) = ZRHS(:) - ZZW(:) ! of hail into graupel
!
END WHERE
+
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'COHG', &
+ Unpack( zrgs(:), mask = gmicro(:, :, :), field = prgs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'COHG', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ end if
END IF
!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'COHG_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- 12,'COHG_BU_RRH')
-END IF
-!
-!
!* 3.4 Melting of the hailstones
!
IF ( IHAIL>0 ) THEN
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ZZW(:) = 0.0
WHERE( GHAIL(:) .AND. (ZRHS(:)>XRTMIN(7)/PTSTEP) .AND. (ZRHT(:)>XRTMIN(7)) .AND. (ZZT(:)>XTT) )
ZZW(:) = ZRVT(:)*ZPRES(:)/((XMV/XMD)+ZRVT(:)) ! Vapor pressure
@@ -1302,25 +1406,20 @@ IF ( IHAIL>0 ) THEN
ZCRS(:) = MAX( ZCRS(:) + ZZW(:)*(XCCH*ZLBDAH(:)**XCXH/ZRHT(:)),0.0 )
!
END WHERE
+
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( zrhs(:), mask = gmicro(:, :, :), field = prhs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'HMLT', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
END IF
-!
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=PRRS)*PRHODJ(:,:,:), &
- 8,'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:),MASK=GMICRO(:,:,:),FIELD=PRHS)*PRHODJ(:,:,:), &
- 12,'HMLT_BU_RRH')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=PCRS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NR,'HMLT_BU_RSV')
- END IF
-END IF
-!
-END IF
+
+END IF HAIL
!
!------------------------------------------------------------------------------
!
diff --git a/src/MNH/lima_mixed_slow_processes.f90 b/src/MNH/lima_mixed_slow_processes.f90
index 7c58f4910a4603219de2d1c7887db6b2760be388..6ef9b55f5035df58c4423f6250ebb369fcbed506 100644
--- a/src/MNH/lima_mixed_slow_processes.f90
+++ b/src/MNH/lima_mixed_slow_processes.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_LIMA_MIXED_SLOW_PROCESSES
! #####################################
@@ -9,9 +14,9 @@ INTERFACE
ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
ZCCS, ZCIS, ZIFS, ZINS, &
ZLBDAI, ZLBDAG, &
- ZRHODJ, GMICRO, PRHODJ, KMI, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI,&
PTHS, PRVS, PRCS, PRIS, PRGS, &
- PCCS, PCIS )
+ PCCS, PCIS, PINS )
!
REAL, DIMENSION(:), INTENT(IN) :: ZRHODREF ! RHO Dry REFerence
REAL, DIMENSION(:), INTENT(IN) :: ZZT ! Temperature
@@ -41,7 +46,7 @@ REAL, DIMENSION(:), INTENT(IN) :: ZLBDAI ! Slope parameter of the ice crys
REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope parameter of the graupel distr.
!
! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
INTEGER, INTENT(IN) :: KMI
@@ -52,6 +57,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PINS
!
END SUBROUTINE LIMA_MIXED_SLOW_PROCESSES
END INTERFACE
@@ -64,9 +70,9 @@ END MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
ZRVS, ZRCS, ZRIS, ZRGS, ZTHS, &
ZCCS, ZCIS, ZIFS, ZINS, &
ZLBDAI, ZLBDAG, &
- ZRHODJ, GMICRO, PRHODJ, KMI, &
+ PRHODJ1D, GMICRO, PRHODJ, KMI,&
PTHS, PRVS, PRCS, PRIS, PRGS, &
- PCCS, PCIS )
+ PCCS, PCIS, PINS )
! #######################################################################
!
!!
@@ -105,23 +111,26 @@ END MODULE MODI_LIMA_MIXED_SLOW_PROCESSES
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use modd_budget, only: lbu_enable, nbumod, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rc, lbudget_ri, lbudget_rg, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RC, NBUDGET_RI, NBUDGET_RG, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST, ONLY : XTT, XALPI, XBETAI, XGAMI, &
XALPW, XBETAW, XGAMW
+USE MODD_NSV
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, NMOD_IFN, LSNOW
-USE MODD_PARAM_LIMA_COLD, ONLY : XDI, X0DEPI, X2DEPI, XSCFAC
+USE MODD_PARAM_LIMA_COLD, ONLY : XDI, X0DEPI, X2DEPI, XSCFAC
USE MODD_PARAM_LIMA_MIXED, ONLY : XLBG, XLBEXG, XLBDAG_MAX, &
- X0DEPG, XEX0DEPG, X1DEPG, XEX1DEPG
-!
-USE MODD_NSV
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
+ X0DEPG, XEX0DEPG, X1DEPG, XEX1DEPG
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -154,7 +163,7 @@ REAL, DIMENSION(:), INTENT(IN) :: ZLBDAI ! Slope parameter of the ice crys
REAL, DIMENSION(:), INTENT(IN) :: ZLBDAG ! Slope parameter of the graupel distr.
!
! used for budget storage
-REAL, DIMENSION(:), INTENT(IN) :: ZRHODJ
+REAL, DIMENSION(:), INTENT(IN) :: PRHODJ1D
LOGICAL, DIMENSION(:,:,:), INTENT(IN) :: GMICRO
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
INTEGER, INTENT(IN) :: KMI
@@ -165,6 +174,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCS
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCIS
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PINS
!
!* 0.2 Declarations of local variables :
!
@@ -191,24 +201,35 @@ IF (LSNOW) THEN
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- 6,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:),MASK=GMICRO(:,:,:),FIELD=PRGS)*PRHODJ(:,:,:), &
- 11,'DEPG_BU_RRG')
- END IF
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', &
+ Unpack( zzw(:) * zlsfact(:) * prhodj1d(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', &
+ Unpack( -zzw(:) * prhodj1d(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', &
+ Unpack( zzw(:) * prhodj1d(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
END IF
!
!
!* 2 cloud ice Melting: RIMLTC and CIMLTC
! -----------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'IMLT', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'IMLT', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'IMLT', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'IMLT', pcis(:, :, :) * prhodj(:, :, :) )
+ do jmod_ifn = 1,nmod_ifn
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl + jmod_ifn - 1), 'IMLT', &
+ pins(:, :, :, jmod_ifn) * prhodj(:, :, :) )
+ enddo
+ end if
+ end if
+
ZMASK(:) = 1.0
WHERE( (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZZT(:)>XTT) )
ZRCS(:) = ZRCS(:) + ZRIS(:)
@@ -226,29 +247,37 @@ END IF
ENDDO
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'IMLT_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NC,'IMLT_BU_RSV')
- CALL BUDGET (UNPACK(ZCIS(:),MASK=GMICRO(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:), &
- 12+NSV_LIMA_NI,'IMLT_BU_RSV')
- END IF
- END IF
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'IMLT', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'IMLT', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'IMLT', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'IMLT', &
+ Unpack( zcis(:), mask = gmicro(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ do jmod_ifn = 1,nmod_ifn
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl + jmod_ifn - 1), 'IMLT', &
+ Unpack( zins(:, jmod_ifn), mask = gmicro(:, :, :), field = pins(:, :, :, jmod_ifn) ) * prhodj(:, :, :) )
+ enddo
+ end if
+ end if
!
!* 3 Bergeron-Findeisen effect: RCBERI
! --------------------------------------
!
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'BERFI', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'BERFI', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'BERFI', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
ZZW(:) = 0.0
WHERE( (ZRCS(:)>XRTMIN(2)/PTSTEP) .AND. (ZRIS(:)>XRTMIN(4)/PTSTEP) .AND. (ZCIT(:)>XCTMIN(4)) )
ZZW(:) = EXP( (XALPW-XALPI) - (XBETAW-XBETAI)/ZZT(:) &
@@ -262,18 +291,14 @@ END IF
END WHERE
!
! Budget storage
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:), &
- 7,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GMICRO(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:), &
- 9,'BERFI_BU_RRI')
- END IF
-!
+ if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'BERFI', &
+ Unpack( zths(:), mask = gmicro(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'BERFI', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'BERFI', &
+ Unpack( zris(:), mask = gmicro(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ end if
!------------------------------------------------------------------------------
!
END SUBROUTINE LIMA_MIXED_SLOW_PROCESSES
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 e3efc478d7c83f49440a8f7c344103bd4ec19768..122d4b3c867f2e98af5b9d6461a492df26a45e5e 100644
--- a/src/MNH/lima_nucleation_procs.f90
+++ b/src/MNH/lima_nucleation_procs.f90
@@ -1,31 +1,31 @@
-!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_NUCLEATION_PROCS
! ###############################
!
INTERFACE
- SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, OCLOSE_OUT, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
+ 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 )
+ PNFT, PNAT, PIFT, PINT, PNIT, PNHT, &
+ PCLDFR, PICEFR, PPRCFR )
!
USE MODD_IO, ONLY: TFILEDATA
!
REAL, INTENT(IN) :: PTSTEP ! Double Time step
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
@@ -47,20 +47,25 @@ 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, OCLOSE_OUT, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PT, PTM, 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
!! -------
-!! Compute nucleation processes for the time-splitted version of LIMA
+!! Compute nucleation processes for the time-split version of LIMA
!!
!! AUTHOR
!! ------
@@ -69,22 +74,30 @@ SUBROUTINE LIMA_NUCLEATION_PROCS (PTSTEP, TPFILE, OCLOSE_OUT, PRHODJ,
!! MODIFICATIONS
!! -------------
!! Original 15/03/2018
-!!
+! M. Leriche 06/2019: missing update of PNFT after CCN hom. ncl.
+! P. Wautelet 27/02/2020: bugfix: PNFT was not updated after LIMA_CCN_HOM_FREEZING
+! P. Wautelet 27/02/2020: add Z_TH_HINC variable (for budgets)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
!-------------------------------------------------------------------------------
!
-USE MODD_PARAM_LIMA, ONLY : LCOLD, LNUCL, LMEYERS, LSNOW, LWARM, LACTI, LRAIN, LHHONI, &
- NMOD_CCN, NMOD_IFN, NMOD_IMM
-USE MODD_BUDGET, ONLY : LBU_ENABLE, LBUDGET_TH, LBUDGET_RV, LBUDGET_RC, LBUDGET_RR,&
- LBUDGET_RI, LBUDGET_RS, LBUDGET_RG, LBUDGET_RH, LBUDGET_SV
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_FREE, &
- NSV_LIMA_NI, NSV_LIMA_IFN_FREE
-!
+use modd_budget, only: lbu_enable, lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
+ lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets
USE MODD_IO, ONLY: TFILEDATA
-USE MODI_BUDGET
+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, XCTMIN, XRTMIN, LSPRO
+USE MODD_TURB_n, ONLY : LSUBG_COND
+
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
+
USE MODI_LIMA_CCN_ACTIVATION
-USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
-USE MODI_LIMA_MEYERS_NUCLEATION
USE MODI_LIMA_CCN_HOM_FREEZING
+USE MODI_LIMA_MEYERS_NUCLEATION
+USE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
!
!-------------------------------------------------------------------------------
!
@@ -93,15 +106,14 @@ IMPLICIT NONE
!-------------------------------------------------------------------------------
!
REAL, INTENT(IN) :: PTSTEP ! Double Time step
-TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
+TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PDTHRAD ! Radiative temperature tendency
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHT ! Theta at t
@@ -123,108 +135,124 @@ 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_RC_HINC, Z_CC_HINC
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZCCT, ZCRT, ZCIT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3),NMOD_CCN) :: ZNFT, ZNAT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3),NMOD_IFN) :: ZIFT, ZINT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3),NMOD_IMM) :: ZNIT
-REAL, DIMENSION(SIZE(PT,1),SIZE(PT,2),SIZE(PT,3)) :: ZNHT
+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
!
+integer :: idx
INTEGER :: JL
-!-------------------------------------------------------------------------------
-!
-ZTHT(:,:,:) = PTHT(:,:,:)
-ZRVT(:,:,:) = PRVT(:,:,:)
-ZRCT(:,:,:) = PRCT(:,:,:)
-ZCCT(:,:,:) = PCCT(:,:,:)
-ZRRT(:,:,:) = PRRT(:,:,:)
-ZCRT(:,:,:) = PCRT(:,:,:)
-ZRIT(:,:,:) = PRIT(:,:,:)
-ZCIT(:,:,:) = PCIT(:,:,:)
-ZRST(:,:,:) = PRST(:,:,:)
-ZRGT(:,:,:) = PRGT(:,:,:)
-ZNFT(:,:,:,:) = PNFT(:,:,:,:)
-ZNAT(:,:,:,:) = PNAT(:,:,:,:)
-ZIFT(:,:,:,:) = PIFT(:,:,:,:)
-ZINT(:,:,:,:) = PINT(:,:,:,:)
-ZNIT(:,:,:,:) = PNIT(:,:,:,:)
-ZNHT(:,:,:) = PNHT(:,:,:)
!
!-------------------------------------------------------------------------------
!
-IF (LWARM .AND. LACTI .AND. NMOD_CCN.GE.1) THEN
- CALL LIMA_CCN_ACTIVATION (PTSTEP, TPFILE, OCLOSE_OUT, &
- PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
- ZTHT, ZRVT, ZRCT, ZCCT, ZRRT, ZNFT, ZNAT)
- PTHT(:,:,:) = ZTHT(:,:,:)
- PRVT(:,:,:) = ZRVT(:,:,:)
- PRCT(:,:,:) = ZRCT(:,:,:)
- PCCT(:,:,:) = ZCCT(:,:,:)
- PNFT(:,:,:,:) = ZNFT(:,:,:,:)
- PNAT(:,:,:,:) = ZNAT(:,:,:,:)
-!
-! Call budgets
-!
- IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (PTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 4, 'HENU_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 6, 'HENU_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 7, 'HENU_BU_RRC')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (PCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_NC, 'HENU_BU_RSV')
- DO JL=1, NMOD_CCN
- CALL BUDGET (PNFT(:,:,:,JL)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_CCN_FREE+JL-1,'HENU_BU_RSV')
- END DO
- END IF
- END IF
+IF ( LWARM .AND. LACTI .AND. NMOD_CCN >=1 ) THEN
+
+ IF (.NOT.LSUBG_COND .AND. .NOT.LSPRO) 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( 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
!
!-------------------------------------------------------------------------------
!
-IF (LCOLD .AND. LNUCL .AND. .NOT.LMEYERS .AND. NMOD_IFN.GE.1) THEN
+IF ( LCOLD .AND. LNUCL .AND. .NOT.LMEYERS .AND. NMOD_IFN >= 1 ) THEN
+ if ( lbu_enable ) then
+ if ( lbudget_sv ) then
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
+
CALL LIMA_PHILLIPS_IFN_NUCLEATION (PTSTEP, &
PRHODREF, PEXNREF, PPABST, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCIT, ZNAT, ZIFT, ZINT, ZNIT, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PNAT, PIFT, PINT, PNIT, &
Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_RC_HINC, Z_CC_HINC )
-!
-! Call budgets
-!
- IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ((PTHT(:,:,:)+Z_TH_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,4, 'HIND_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ((PRVT(:,:,:)-Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,6, 'HIND_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET ((PRIT(:,:,:)+Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,9, 'HIND_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ((PCIT(:,:,:)+Z_CI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI, 'HIND_BU_RSV')
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET ((ZIFT(:,:,:,JL))*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV')
- END DO
- END IF
- END IF
-!
- IF (LBUDGET_TH) CALL BUDGET (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,4,'HINC_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (ZRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,7,'HINC_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,9,'HINC_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (ZCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NC,'HINC_BU_RSV')
- CALL BUDGET (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HINC_BU_RSV')
- END IF
- END IF
-!
- PTHT(:,:,:) = ZTHT(:,:,:)
- PRVT(:,:,:) = ZRVT(:,:,:)
- PRCT(:,:,:) = ZRCT(:,:,:)
- PCCT(:,:,:) = ZCCT(:,:,:)
- PRIT(:,:,:) = ZRIT(:,:,:)
- PCIT(:,:,:) = ZCIT(:,:,:)
- PNAT(:,:,:,:) = ZNAT(:,:,:,:)
- PIFT(:,:,:,:) = ZIFT(:,:,:,:)
- PINT(:,:,:,:) = ZINT(:,:,:,:)
- PNIT(:,:,:,:) = ZNIT(:,:,:,:)
+ 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 )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HIND', pift(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HIND', pint(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HINC', pnat(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HINC', pnit(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ end if
+ end if
END IF
!
!-------------------------------------------------------------------------------
@@ -232,63 +260,73 @@ END IF
IF (LCOLD .AND. LNUCL .AND. LMEYERS) THEN
CALL LIMA_MEYERS_NUCLEATION (PTSTEP, &
PRHODREF, PEXNREF, PPABST, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCIT, ZINT, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ PCCT, PCIT, PINT, &
Z_TH_HIND, Z_RI_HIND, Z_CI_HIND, &
- Z_RC_HINC, Z_CC_HINC )
-!
-! Call budgets
-!
- IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ((PTHT(:,:,:)+Z_TH_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,4, 'HIND_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ((PRVT(:,:,:)-Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,6, 'HIND_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET ((PRIT(:,:,:)+Z_RI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,9, 'HIND_BU_RRI')
- IF (LBUDGET_SV) CALL BUDGET ((PCIT(:,:,:)+Z_CI_HIND(:,:,:))*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HIND_BU_RSV')
-!
- IF (LBUDGET_TH) CALL BUDGET (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,4,'HINC_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (ZRCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,7,'HINC_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,9,'HINC_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (ZCCT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NC,'HINC_BU_RSV')
- CALL BUDGET (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_NI,'HINC_BU_RSV')
- END IF
- END IF
-!
-PTHT(:,:,:) = ZTHT(:,:,:)
-PRVT(:,:,:) = ZRVT(:,:,:)
-PRCT(:,:,:) = ZRCT(:,:,:)
-PCCT(:,:,:) = ZCCT(:,:,:)
-PRIT(:,:,:) = ZRIT(:,:,:)
-PCIT(:,:,:) = ZCIT(:,:,:)
-PINT(:,:,:,:) = ZINT(:,:,:,:)
+ 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 )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HIND', z_ri_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ if (nmod_ifn > 0 ) &
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HIND', &
+ z_ci_hind(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HINC', z_th_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HINC', z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HINC', -z_rc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ if (nmod_ifn > 0 ) &
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl), 'HINC', &
+ -z_cc_hinc(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
END IF
!
!-------------------------------------------------------------------------------
!
-IF (LCOLD .AND. LNUCL .AND. LHHONI .AND. NMOD_CCN.GE.1) THEN
- CALL LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
- ZTHT, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, &
- ZCCT, ZCRT, ZCIT, ZNFT, ZNHT )
-!
-! Call budgets
-!
- IF (LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET (ZTHT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 4, 'HONH_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (ZRVT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 6, 'HONH_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET (ZRIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 9, 'HONH_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (ZCIT(:,:,:)*PRHODJ(:,:,:)/PTSTEP, 12+NSV_LIMA_NI, 'HONH_BU_RSV')
- DO JL=1, NMOD_CCN
- CALL BUDGET (ZNFT(:,:,:,JL)*PRHODJ(:,:,:)/PTSTEP,12+NSV_LIMA_CCN_FREE+JL-1,'HONH_BU_RSV')
- END DO
- END IF
- END IF
-!
-PTHT(:,:,:) = ZTHT(:,:,:)
-PRVT(:,:,:) = ZRVT(:,:,:)
-PRIT(:,:,:) = ZRIT(:,:,:)
-PCIT(:,:,:) = ZCIT(:,:,:)
-PNHT(:,:,:) = ZNHT(:,:,:)
+IF ( LCOLD .AND. LNUCL .AND. LHHONI .AND. NMOD_CCN >= 1) THEN
+ if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HONH', PTHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HONH', PRVT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
+
+ CALL LIMA_CCN_HOM_FREEZING (PRHODREF, PEXNREF, PPABST, PW_NU, &
+ PTHT, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, &
+ 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 )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HONH', PRIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HONH', PCIT(:, :, :) * prhodj(:, :, :) / ptstep )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HONH', PNFT(:, :, :, jl) * prhodj(:, :, :) / ptstep )
+ end do
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_hom_haze), 'HONH', PNHT(:, :, :) * prhodj(:, :, :) / ptstep )
+ end if
+ end if
ENDIF
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_phillips.f90 b/src/MNH/lima_phillips.f90
index 03af388b71ef40b0ad5e71b8ddea351a304c1483..1ca330e353e142451acd53c6bec902cae233b4b8 100644
--- a/src/MNH/lima_phillips.f90
+++ b/src/MNH/lima_phillips.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.
@@ -115,28 +115,32 @@ END MODULE MODI_LIMA_PHILLIPS
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 02/02/2021: budgets: add missing source terms for SV budgets in LIMA
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+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_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
XALPW, XBETAW, XGAMW, XPI
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_IFN_FREE
+USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NI, NSV_LIMA_CCN_ACTI, NSV_LIMA_IFN_FREE, NSV_LIMA_IFN_NUCL, NSV_LIMA_IMM_NUCL
USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT
USE MODD_PARAM_LIMA, ONLY : NMOD_IFN, NSPECIE, XFRAC, &
NMOD_CCN, NMOD_IMM, NIND_SPECIE, NINDICE_CCN_IMM, &
XDSI0, XRTMIN, XCTMIN, NPHILLIPS
USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_LIMA_PHILLIPS_INTEG
USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
@@ -189,6 +193,7 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIS ! Activated ice nuclei C. sou
INTEGER :: IIB, IIE, IJB, IJE, IKB, IKE ! Physical domain
INTEGER :: JL, JMOD_CCN, JMOD_IFN, JSPECIE, JMOD_IMM ! Loop index
INTEGER :: INEGT ! Case number of sedimentation, nucleation,
+integer :: idx
!
LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: GNEGT ! Test where to compute the nucleation
@@ -432,8 +437,21 @@ CALL LIMA_PHILLIPS_INTEG(ZZT, ZSI, ZSI0, ZSW, ZZY, Z_FRAC_ACT)
!* 5. COMPUTE THE HETEROGENEOUS NUCLEATION OF INSOLUBLE IFN
! -----------------------------------------------------
!
-!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HIND', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'HIND', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HIND', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', pcis(:, :, :) * prhodj(:, :, :) )
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free -1 + jl
+ call Budget_store_init( tbudgets(idx), 'HIND', pifs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl -1 + jl
+ call Budget_store_init( tbudgets(idx), 'HIND', pins(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+end if
+
DO JMOD_IFN = 1,NMOD_IFN ! IFN modes
ZZX(:)=0.
DO JSPECIE = 1, NSPECIE ! Each IFN mode is mixed with DM1, DM2, BC, O
@@ -467,34 +485,50 @@ END DO
!
!
! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HIND_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GNEGT(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:),&
- 6,'HIND_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'HIND_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NI,'HIND_BU_RSV')
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV')
- END DO
- END IF
- END IF
-END IF
-!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HIND', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HIND', &
+ Unpack ( zrvs(:), mask = gnegt(:, :, :), field = prvs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HIND', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HIND', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ do jl = 1, nmod_ifn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_free -1 + jl
+ call Budget_store_end( tbudgets(idx), 'HIND', pifs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ifn_nucl -1 + jl
+ call Budget_store_end( tbudgets(idx), 'HIND', pins(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+end if
!-------------------------------------------------------------------------------
!
!
!* 6. COMPUTE THE HETEROGENEOUS NUCLEATION OF COATED IFN
! --------------------------------------------------
!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HINC', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HINC', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HINC', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HINC', pnas(:, :, :, 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), 'HINC', pnis(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+end if
!
! Heterogeneous nucleation by immersion of the activated CCN
! Currently, we represent coated IFN as a pure aerosol type (NIND_SPECIE)
@@ -537,25 +571,28 @@ DO JMOD_IMM = 1,NMOD_IMM ! Coated IFN modes
END DO
!
! Budget storage
-IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GNEGT(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HINC_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GNEGT(:,:,:),FIELD=PRCS)*PRHODJ(:,:,:),&
- 7,'HINC_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:),MASK=GNEGT(:,:,:),FIELD=PRIS)*PRHODJ(:,:,:),&
- 9,'HINC_BU_RRI')
- IF (LBUDGET_SV) THEN
- CALL BUDGET ( UNPACK(ZCCS(:),MASK=GNEGT(:,:,:),FIELD=PCCS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NC,'HINC_BU_RSV')
- CALL BUDGET ( UNPACK(ZCIS(:),MASK=GNEGT(:,:,:),FIELD=PCIS)*PRHODJ(:,:,:),&
- 12+NSV_LIMA_NI,'HINC_BU_RSV')
- END IF
-END IF
-!
-!
+if ( nbumod == kmi .and. lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HINC', &
+ Unpack ( zths(:), mask = gnegt(:, :, :), field = pths(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HINC', &
+ Unpack ( zrcs(:), mask = gnegt(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HINC', &
+ Unpack ( zris(:), mask = gnegt(:, :, :), field = pris(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HINC', &
+ Unpack ( zccs(:), mask = gnegt(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_ni), 'HINC', &
+ Unpack ( zcis(:), mask = gnegt(:, :, :), field = pcis(:, :, :) ) * prhodj(:, :, :) )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HINC', pnas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ do jl = 1, nmod_imm
+ idx = NBUDGET_SV1 - 1 + nsv_lima_imm_nucl - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HINC', pnis(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
+end if
!-------------------------------------------------------------------------------
!
!
@@ -619,46 +656,6 @@ DEALLOCATE(ZZY)
DEALLOCATE(ZSI_W)
!--cb--
!
-!
-ELSE
-!
-! Advance the budget calls
-!
- IF (NBUMOD==KMI .AND. LBU_ENABLE) THEN
- IF (LBUDGET_TH) THEN
- ZW(:,:,:) = PTHS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,4,'HIND_BU_RTH')
- CALL BUDGET (ZW,4,'HINC_BU_RTH')
- ENDIF
- IF (LBUDGET_RV) THEN
- ZW(:,:,:) = PRVS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,6,'HIND_BU_RRV')
- ENDIF
- IF (LBUDGET_RC) THEN
- ZW(:,:,:) = PRCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,7,'HINC_BU_RRC')
- ENDIF
- IF (LBUDGET_RI) THEN
- ZW(:,:,:) = PRIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,9,'HIND_BU_RRI')
- CALL BUDGET (ZW,9,'HINC_BU_RRI')
- ENDIF
- IF (LBUDGET_SV) THEN
-!print*, 'LBUDGET_SV dans lima_phillips = ', LBUDGET_SV
- ZW(:,:,:) = PCCS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,12+NSV_LIMA_NC,'HINC_BU_RSV')
- ZW(:,:,:) = PCIS(:,:,:)*PRHODJ(:,:,:)
- CALL BUDGET (ZW,12+NSV_LIMA_NI,'HIND_BU_RSV')
- CALL BUDGET (ZW,12+NSV_LIMA_NI,'HINC_BU_RSV')
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET ( PIFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'HIND_BU_RSV')
- END DO
- END IF
- END IF
- END IF
-!
-!
END IF ! INEGT > 0
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_phillips_ifn_nucleation.f90 b/src/MNH/lima_phillips_ifn_nucleation.f90
index a6cd6aa804cfb86b819599cee52b962fc3f489d7..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 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.
@@ -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_RC_HINC, P_CC_HINC )
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
!
REAL, INTENT(IN) :: PTSTEP
!
@@ -36,11 +37,14 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! Free IFN conc.
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Nucleated IFN conc.
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Nucleated (by immersion) CCN conc.
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CC_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
+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
@@ -52,13 +56,14 @@ 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_RC_HINC, P_CC_HINC )
+ P_TH_HINC, P_RC_HINC, P_CC_HINC, &
+ PICEFR )
! #################################################################################
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to compute the heterogeneous nucleation
-!! following Phillips (2008) for the time-splitted version of LIMA
+!! following Phillips (2008) for the time-split version of LIMA
!!
!!
!!** METHOD
@@ -103,13 +108,13 @@ END MODULE MODI_LIMA_PHILLIPS_IFN_NUCLEATION
!! -------------
!! Original 15/03/2018
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 27/02/2020: bugfix: P_TH_HIND was not accumulated (will affect budgets) + add P_TH_HINC dummy argument
+! + change intent of *_HIND and *_HINC dummy arguments (INOUT->OUT)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
USE MODD_CST, ONLY : XP00, XRD, XMV, XMD, XCPD, XCPV, XCL, XCI, &
XTT, XLSTT, XLVTT, XALPI, XBETAI, XGAMI, &
XALPW, XBETAW, XGAMW, XPI
@@ -122,7 +127,6 @@ USE MODD_PARAM_LIMA_COLD, ONLY : XMNU0
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_LIMA_PHILLIPS_INTEG
USE MODI_LIMA_PHILLIPS_REF_SPECTRUM
@@ -151,11 +155,14 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PIFT ! Free IFN conc.
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PINT ! Nucleated IFN conc.
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNIT ! Nucleated (by immersion) CCN conc.
!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_TH_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CI_HIND
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_RC_HINC
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: P_CC_HINC
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_TH_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_RI_HIND
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: P_CI_HIND
+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 :
@@ -218,6 +225,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZTCELSIUS, ZZT_SI0_BC
P_TH_HIND(:,:,:) = 0.
P_RI_HIND(:,:,:) = 0.
P_CI_HIND(:,:,:) = 0.
+P_TH_HINC(:,:,:) = 0.
P_RC_HINC(:,:,:) = 0.
P_CC_HINC(:,:,:) = 0.
!
@@ -408,8 +416,9 @@ IF (INEGT > 0) THEN
PRVT(:,:,:) = PRVT(:,:,:) - ZW(:,:,:)
PRIT(:,:,:) = PRIT(:,:,:) + ZW(:,:,:)
!
- P_TH_HIND(:,:,:) = UNPACK( ZZW(:)*ZLSFACT(:), MASK=GNEGT(:,:,:), FIELD=0. )
- PTHT(:,:,:) = PTHT(:,:,:) + P_TH_HIND(:,:,:)
+ ZW(:,:,:) = UNPACK( ZZW(:)*ZLSFACT(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ P_TH_HIND(:,:,:) = P_TH_HIND(:,:,:) + ZW(:,:,:)
+ PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:)
END DO
!
!
@@ -453,7 +462,10 @@ IF (INEGT > 0) THEN
P_RC_HINC(:,:,:) = P_RC_HINC(:,:,:) - ZW(:,:,:)
PRCT(:,:,:) = PRCT(:,:,:) - ZW(:,:,:)
PRIT(:,:,:) = PRIT(:,:,:) + ZW(:,:,:)
- PTHT(:,:,:) = PTHT(:,:,:) + UNPACK( ZZY(:)*ZLSFACT(:), MASK=GNEGT(:,:,:), FIELD=0. )
+!
+ ZW(:,:,:) = UNPACK( ZZY(:)*ZLSFACT(:), MASK=GNEGT(:,:,:), FIELD=0. )
+ P_TH_HINC(:,:,:) = P_TH_HINC(:,:,:) + ZW(:,:,:)
+ PTHT(:,:,:) = PTHT(:,:,:) + ZW(:,:,:)
END IF
END DO
!
diff --git a/src/MNH/lima_precip_scavenging.f90 b/src/MNH/lima_precip_scavenging.f90
index 351ee92f0222640114445e455096dcd65234ae2b..aaabf3f298cc30a22fab869f8602151d82e12897 100644
--- a/src/MNH/lima_precip_scavenging.f90
+++ b/src/MNH/lima_precip_scavenging.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-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.
@@ -11,7 +11,9 @@ INTERFACE
SUBROUTINE LIMA_PRECIP_SCAVENGING (HCLOUD, KLUOUT, KTCOUNT, PTSTEP, &
PRRT, PRHODREF, PRHODJ, PZZ, &
PPABST, PTHT, PSVT, PRSVS, PINPAP )
-!
+
+use modd_nsv, only: nsv_lima_beg
+
CHARACTER(LEN=4), INTENT(IN) :: HCLOUD ! cloud paramerization
INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing
INTEGER, INTENT(IN) :: KTCOUNT ! iteration count
@@ -25,8 +27,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Particle Concentration [kg-1]
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Particle Concentration [kg-1]
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
!
@@ -95,15 +97,19 @@ END MODULE MODI_LIMA_PRECIP_SCAVENGING
!! -------------
!! Original ??/??/13
!!
-!! Philippe Wautelet 28/05/2018: corrected truncated integer division (3/2 -> 1.5)
+! P. Wautelet 28/05/2018: corrected truncated integer division (3/2 -> 1.5)
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 03/06/2020: bugfix: correct array starts for PSVT and PRSVS
+! P. Wautelet 11/02/2021: bugfix: ZRTMIN was of wrong size (replaced by a scalar)
+! P. Wautelet 11/02/2021: budgets: add missing term SCAV for NSV_LIMA_SCAVMASS budget
!-------------------------------------------------------------------------------
!
!* 0.DECLARATIONS
! --------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
USE MODD_CST
USE MODD_NSV
USE MODD_PARAMETERS
@@ -116,9 +122,9 @@ USE MODD_PARAM_LIMA, ONLY: NMOD_IFN, NSPECIE, XFRAC,
XRTMIN, XCTMIN
USE MODD_PARAM_LIMA_WARM, ONLY: XCR, XDR
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_GAMMA
USE MODI_INI_NSV
USE MODI_LIMA_FUNCTIONS
@@ -140,8 +146,8 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Altitude
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! Absolute pressure at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Particle Concentration [/m**3]
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Particle Concentration [/m**3]
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PRSVS ! Total Number Scavenging Rate
!
REAL, DIMENSION(:,:), INTENT(INOUT) :: PINPAP
!
@@ -240,6 +246,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: &
ZVOLDR_INV ! INV of Mean volumic Raindrop diameter [m]
REAL :: ZDENS_RATIO_SQRT
INTEGER :: SV_VAR, NM, JM
+integer :: idx
REAL :: XMDIAMP
REAL :: XSIGMAP
REAL :: XRHOP
@@ -248,7 +255,20 @@ REAL :: XFRACP
!
!
!------------------------------------------------------------------------------
-!
+
+if ( lbudget_sv ) then
+ do jl = 1, nmod_ccn
+ idx = nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ do jl = 1, nmod_ifn
+ idx = nsv_lima_ifn_free - 1 + jl
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ if ( laero_mass ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
+ end if
+end if
!
!* 1. PRELIMINARY COMPUTATIONS
! ------------------------
@@ -555,21 +575,19 @@ DO JSV = 1, NMOD_CCN+NMOD_IFN
ENDIF
ENDDO
!
-IF (LBUDGET_SV) THEN
- IF (NMOD_CCN.GE.1) THEN
- DO JL=1, NMOD_CCN
- CALL BUDGET ( PRSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-1), &
- 12+NSV_LIMA_CCN_FREE+JL-1,'SCAV_BU_RSV')
- END DO
- END IF
- IF (NMOD_IFN.GE.1) THEN
- DO JL=1, NMOD_IFN
- CALL BUDGET ( PRSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-1), &
- 12+NSV_LIMA_IFN_FREE+JL-1,'SCAV_BU_RSV')
- END DO
- END IF
-END IF
-!
+if ( lbudget_sv ) then
+ do jl = 1, nmod_ccn
+ idx = nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ do jl = 1, nmod_ifn
+ idx = nsv_lima_ifn_free - 1 + jl
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + idx), 'SCAV', prsvs(:, :, :, idx) )
+ end do
+ if ( laero_mass ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_scavmass), 'SCAV', prsvs(:, :, :, nsv_lima_scavmass) )
+ end if
+end if
!------------------------------------------------------------------------------
!
!
@@ -673,7 +691,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZRRS, & ! Rain water m.r. source
ZRHODREF, & ! RHO Dry REFerence
ZZW ! Work array
!
-REAL, DIMENSION(3) :: ZRTMIN
+REAL :: ZRTMIN3
!
!
REAL :: ZVTRMAX, ZDZMIN, ZT
@@ -730,11 +748,11 @@ END IF
! optimization by looking for locations where
! the precipitating fields are larger than a minimal value only !!!
!
-ZRTMIN(:) = XRTMIN(:) / ZTSTEP
+ZRTMIN3 = XRTMIN(3) / ZTSTEP
ZZS(:,:,:) = PRAIN(:,:,:)
DO JN = 1 , ISPLITR
GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(3)
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN3
!
ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
IF( ISEDIM >= 1 ) THEN
@@ -762,14 +780,14 @@ DO JN = 1 , ISPLITR
END DO
IF( JN==1 ) THEN
PINPAP(:,:) = ZWSED(:,:,IKB)* &
- ( PSVT_MASS(:,:,IKB)/MAX(ZRTMIN(3),PRRT(:,:,IKB)) )
+ ( PSVT_MASS(:,:,IKB)/MAX(ZRTMIN3,PRRT(:,:,IKB)) )
END IF
DEALLOCATE(ZRHODREF)
DEALLOCATE(ZRRS)
DEALLOCATE(ZZW)
IF( JN==ISPLITR ) THEN
GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN(3)
+ GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZZS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN3
ZWSED(:,:,:) = 0.0
WHERE( GSEDIM(:,:,:) )
ZWSED(:,:,:) = 1.0/ZTSTEP - PRAIN(:,:,:)/ZZS(:,:,:)
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_sedimentation.f90 b/src/MNH/lima_sedimentation.f90
index 88a0a544ba43209e515ae2bf972eff8a57b79714..365ae0f23362e17a84e8f9ab1682d8dc165f38dd 100644
--- a/src/MNH/lima_sedimentation.f90
+++ b/src/MNH/lima_sedimentation.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2018-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2018-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -65,6 +65,7 @@ END MODULE MODI_LIMA_SEDIMENTATION
!! B.Vie 02/2019 Desactivate (comment) the heat transport by droplets
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! B. Vie 03/2020: disable temperature change of droplets by air temperature
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -230,7 +231,7 @@ DO JN = 1 , NSPLITSED(KID)
DEALLOCATE(ZZY)
!
PINPR(:,:) = PINPR(:,:) + ZWSEDR(:,:,KKB)/XRHOLW/NSPLITSED(KID) ! in m/s
- PT(:,:,:) = PT(:,:,:) + ZWDT(:,:,:)
+ !PT(:,:,:) = PT(:,:,:) + ZWDT(:,:,:)
END IF
END DO
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 b66b19c3d56f807c7378db7f8a85bcc003584c39..bd98d503c551fc74862ea85aeb1a80795beea2ce 100644
--- a/src/MNH/lima_tendencies.f90
+++ b/src/MNH/lima_tendencies.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_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,13 +214,14 @@ 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
!! -------
!! Compute sources of non-instantaneous microphysical processes for the
-!! time-splitted version of LIMA
+!! time-split version of LIMA
!!
!! AUTHOR
!! ------
@@ -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 1ac67f3ce0e7830f0112bad40bf766dbcb0fd783..14b1a09fc41ca0b6afe5a36bbc3ca9322548d920 100644
--- a/src/MNH/lima_warm.f90
+++ b/src/MNH/lima_warm.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.
@@ -9,7 +9,7 @@
!
INTERFACE
SUBROUTINE LIMA_WARM (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
- TPFILE, OCLOSE_OUT, KRR, PZZ, PRHODJ,&
+ TPFILE, KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PW_NU, PPABSM, PPABST, &
PTHM, PRCM, &
PTHT, PRT, PSVT, &
@@ -17,6 +17,7 @@ INTERFACE
PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
!
USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NSV, only: NSV_LIMA_BEG
!
LOGICAL, INTENT(IN) :: OACTIT ! Switch to activate the
! activation by radiative
@@ -31,8 +32,6 @@ REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
@@ -51,11 +50,11 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
!
!
!
@@ -70,7 +69,7 @@ END INTERFACE
END MODULE MODI_LIMA_WARM
! #####################################################################
SUBROUTINE LIMA_WARM (OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
- TPFILE, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
+ TPFILE, KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PW_NU, PPABSM, PPABST, &
PTHM, PRCM, &
PTHT, PRT, PSVT, &
@@ -126,30 +125,36 @@ END MODULE MODI_LIMA_WARM
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
!! J. Escobar : for real*4 , use XMNH_HUGE
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! 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 (no more budget calls in this subroutine)
+! B. Vie 03/02/2020: correction of activation of water deposition on the ground
+! 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
! ------------
!
-USE MODD_PARAMETERS
-USE MODD_CST
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
+USE MODD_CST
+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_WARM
-USE MODD_NSV
-!
-!
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
-USE MODI_LIMA_WARM_SEDIMENTATION
-USE MODI_LIMA_WARM_NUCL
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
USE MODI_LIMA_WARM_COAL
USE MODI_LIMA_WARM_EVAP
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODI_LIMA_WARM_NUCL
+USE MODI_LIMA_WARM_SEDIMENTATION
!
IMPLICIT NONE
!
@@ -168,8 +173,6 @@ REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
INTEGER, INTENT(IN) :: KRR ! Number of moist variables
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
@@ -188,11 +191,11 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCM ! Cloud water m.r. at t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Concentrations at t
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(IN) :: PSVT ! Concentrations at time t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRS ! m.r. source
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS ! Concentrations source
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG:), INTENT(INOUT) :: PSVS ! Concentration sources
!
!
!
@@ -219,18 +222,19 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
PCCS, & ! Cloud water C. source
PCRS ! Rain water C. source
!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNFS ! CCN C. available source
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZNFS ! CCN C. available source
!used as Free ice nuclei for
!HOMOGENEOUS nucleation of haze
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: PNAS ! Cloud C. nuclei C. source
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZNAS ! Cloud C. nuclei C. source
!used as Free ice nuclei for
!IMMERSION freezing
!
!
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
- :: ZT, ZTM
+ :: ZT
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: ZWLBDR,ZWLBDR3,ZWLBDC,ZWLBDC3
+integer :: idx
INTEGER :: JL
!
LOGICAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2)) :: GDEP
@@ -269,15 +273,15 @@ IF ( LWARM ) PCCS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NC)
IF ( LWARM .AND. LRAIN ) PCRS(:,:,:) = PSVS(:,:,:,NSV_LIMA_NR)
!
IF ( 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) )
- 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)
+ 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( PNFS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- ALLOCATE( PNAS(SIZE(PRHODJ,1),SIZE(PRHODJ,2),SIZE(PRHODJ,3),1) )
- PNFS(:,:,:,:) = 0.
- PNAS(:,:,:,:) = 0.
+ 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
!
!-------------------------------------------------------------------------------
@@ -302,11 +306,6 @@ WHERE (PRRT(:,:,:)>XRTMIN(3) .AND. PCRT(:,:,:)>XCTMIN(3))
ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
END WHERE
ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:)/XP00)**(XRD/XCPD)
-IF( OACTIT ) THEN
- ZTM(:,:,:) = PTHM(:,:,:) * (PPABSM(:,:,:)/XP00)**(XRD/XCPD)
-ELSE
- ZTM(:,:,:) = ZT(:,:,:)
-END IF
!
!-------------------------------------------------------------------------------
!
@@ -315,6 +314,13 @@ END IF
! -------------------------------------
!
!
+if ( lbudget_rc .and. osedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr .and. orain ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( orain ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
+
CALL LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
PZZ, PRHODREF, PPABST, ZT, &
ZWLBDC, &
@@ -322,29 +328,32 @@ CALL LIMA_WARM_SEDIMENTATION (OSEDC, KSPLITR, PTSTEP, KMI, &
PRCS, PRRS, PCCS, PCRS, &
PINPRC, PINPRR, &
PINPRR3D )
-!
-IF (LBUDGET_RC .AND. OSEDC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC')
-IF (LBUDGET_RR .AND. ORAIN) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR')
-IF (LBUDGET_SV) THEN
- IF (OSEDC) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'SEDI_BU_RSV')
- IF (ORAIN) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'SEDI_BU_RSV')
-END IF
+
+if ( lbudget_rc .and. osedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr .and. orain ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( orain ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
!
! 2.bis Deposition at 1st level above ground
!
IF (LDEPOC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
+
PINDEP(:,:)=0.
GDEP(:,:) = .FALSE.
- GDEP(:,:) = PRCS(:,:,2) >0 .AND. PCCS(:,:,2) >0
+ GDEP(:,:) = PRCS(:,:,2) >0 .AND. PCCS(:,:,2) >0 .AND. PRCT(:,:,2) >0 .AND. PCCT(:,:,2) >0
WHERE (GDEP)
PRCS(:,:,2) = PRCS(:,:,2) - XVDEPOC * PRCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
PCCS(:,:,2) = PCCS(:,:,2) - XVDEPOC * PCCT(:,:,2) / ( PZZ(:,:,3) - PZZ(:,:,2))
PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
PINDEP(:,:) = XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
END WHERE
-!
- IF ( LBUDGET_RC ) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
- IF ( LBUDGET_SV ) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'DEPO_BU_RSV')
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
END IF
!
!-------------------------------------------------------------------------------
@@ -353,23 +362,37 @@ END IF
! --------------------------------------
!
!
-IF (LACTI .AND. NMOD_CCN.GE.1) THEN
-!
- CALL LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, TPFILE, OCLOSE_OUT,&
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PRCM, PRVT, PRCT, PRRT, &
- PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
-!
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HENU_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HENU_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HENU_BU_RRC')
- IF (LBUDGET_SV) THEN
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'HENU_BU_RSV') ! RCN
- DO JL=1, NMOD_CCN
- CALL BUDGET ( PNFS(:,:,:,JL)*PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'HENU_BU_RSV')
- END DO
- END IF
-!
+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(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', znfs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_init( tbudgets(idx), 'HENU', znas(:, :, :, jl) * prhodj(:, :, :) )
+ 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 )
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+ do jl = 1, nmod_ccn
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_free - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', znfs(:, :, :, jl) * prhodj(:, :, :) )
+ idx = NBUDGET_SV1 - 1 + nsv_lima_ccn_acti - 1 + jl
+ call Budget_store_end( tbudgets(idx), 'HENU', znas(:, :, :, jl) * prhodj(:, :, :) )
+ end do
+ end if
END IF ! LACTI
!
!
@@ -393,27 +416,34 @@ END IF ! LACTI
!
!
IF (ORAIN) THEN
-!
+
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'REVA', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'REVA', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
+
CALL LIMA_WARM_EVAP (PTSTEP, KMI, &
PRHODREF, PEXNREF, PPABST, ZT, &
ZWLBDC3, ZWLBDC, ZWLBDR3, ZWLBDR, &
PRVT, PRCT, PRRT, PCRT, &
PRVS, PRCS, PRRS, PCCS, PCRS, PTHS, &
PEVAP3D )
-!
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6 ,'REVA_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'REVA_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'REVA_BU_RRR')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4 ,'REVA_BU_RTH')
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'REVA_BU_RSV')
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'REVA_BU_RSV')
-!
-!
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'REVA', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'REVA', pccs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
!-------------------------------------------------------------------------------
!
! 5. SPONTANEOUS BREAK-UP (NUMERICAL FILTER)
! --------------------
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
+
ZWLBDR(:,:,:) = 1.E10
WHERE (PRRS(:,:,:)>XRTMIN(3)/PTSTEP.AND.PCRS(:,:,:)>XCTMIN(3)/PTSTEP )
ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / PRRS(:,:,:)
@@ -425,11 +455,7 @@ IF (ORAIN) THEN
END WHERE
!
! Budget storage
- IF (LBUDGET_SV) &
- CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,&
- &'BRKU_BU_RSV')
-
-!
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
ENDIF ! ORAIN
!
!------------------------------------------------------------------------------
@@ -448,14 +474,12 @@ IF ( LWARM ) PSVS(:,:,:,NSV_LIMA_NC) = PCCS(:,:,:)
IF ( LWARM .AND. LRAIN ) PSVS(:,:,:,NSV_LIMA_NR) = PCRS(:,:,:)
!
IF ( 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(:,:,:,:)
+ 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(:,:,:,:)
END IF
!
-!++cb++
-IF (ALLOCATED(PNFS)) DEALLOCATE(PNFS)
-IF (ALLOCATED(PNAS)) DEALLOCATE(PNAS)
-!--cb--
+IF (ALLOCATED(ZNFS)) DEALLOCATE(ZNFS)
+IF (ALLOCATED(ZNAS)) DEALLOCATE(ZNAS)
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/lima_warm_coal.f90 b/src/MNH/lima_warm_coal.f90
index aaae2a04be021958b9d559584d07004c012c40ea..4ec69ac5823e786c1dc06b9149d655e772db9e40 100644
--- a/src/MNH/lima_warm_coal.f90
+++ b/src/MNH/lima_warm_coal.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -95,24 +95,23 @@ END MODULE MODI_LIMA_WARM_COAL
!! -------------
!! Original ??/??/13
!! C. Barthe * LACy * jan. 2014 add budgets
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_sv, NBUDGET_RC, NBUDGET_RR, NBUDGET_SV1, tbudgets
USE MODD_NSV, ONLY: NSV_LIMA_NC, NSV_LIMA_NR
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT
USE MODD_PARAM_LIMA
USE MODD_PARAM_LIMA_WARM
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
-USE MODI_BUDGET
-
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -249,6 +248,8 @@ IF (LRAIN) THEN
! ------------------------------------
!
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
GSELF(:) = ZCCT(:)>XCTMIN(2)
ISELF = COUNT(GSELF(:))
IF( ISELF>0 ) THEN
@@ -257,14 +258,10 @@ IF (LRAIN) THEN
ZCCS(:) = ZCCS(:) - MIN( ZCCS(:),ZZW1(:) )
END WHERE
END IF
-!
-!
- ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:))&
- &*PRHODJ(:,:,:),12+NSV_LIMA_NC,'SELF_BU_RSV')
-!
-!
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'SELF', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+
!-------------------------------------------------------------------------------
!
!
@@ -273,6 +270,13 @@ IF (LRAIN) THEN
!
!
!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ !call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'AUTO', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
+ end if
+
ZZW2(:) = 0.0
ZZW1(:) = 0.0
WHERE( ZRCT(:)>XRTMIN(2) )
@@ -292,28 +296,19 @@ IF (LRAIN) THEN
ZZW3(:) = ZZW3(:) * MAX( 0.0,ZZW1(:) )**3 / XAC
ZCRS(:) = ZCRS(:) + ZZW3(:)
END WHERE
-!
-!
- ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),7 ,'AUTO_BU_RRC')
- ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),8 ,'AUTO_BU_RRR')
- ZW(:,:,:) = PCRS(:,:,:)
- IF (LBUDGET_SV) THEN
- ZW(:,:,:) = PCRS(:,:,:)
- CALL BUDGET (UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),12+NSV_LIMA_NR,'AUTO_BU_RSV')
- ZW(:,:,:) = PCCS(:,:,:)
- CALL BUDGET (UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),12+NSV_LIMA_NC,'AUTO_BU_RSV')
- END IF
-!
-!
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ !This budget is = 0 for nsv_lima_nc => not necessary to call it (ZCCS is not modified in this part)
+ !call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'AUTO', &
+ ! Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'AUTO', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+ end if
+
!-------------------------------------------------------------------------------
!
!
@@ -321,7 +316,7 @@ IF (LRAIN) THEN
! --------------------
!
!
- GACCR(:) = ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3)
+ GACCR(:) = ZRRT(:)>XRTMIN(3) .AND. ZCRT(:)>XCTMIN(3)
IACCR = COUNT(GACCR(:))
IF( IACCR>0 ) THEN
ALLOCATE(ZZW4(IMICRO)); ZZW4(:) = XACCR1/ZLBDR(:)
@@ -333,6 +328,12 @@ IF (LRAIN) THEN
!
IACCR = COUNT(GACCR(:))
IF( IACCR>0 ) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
WHERE( GACCR(:).AND.(ZZW4(:)>1.E-4) ) ! Accretion for D>100 10-6 m
ZZW3(:) = ZLBDC3(:) / ZLBDR3(:)
ZZW1(:) = ( ZCCT(:)*ZCRT(:) / ZLBDC3(:) )*ZRHODREF(:)
@@ -358,23 +359,14 @@ IF (LRAIN) THEN
ZRCS(:) = ZRCS(:) - ZZW2(:)
ZRRS(:) = ZRRS(:) + ZZW2(:)
END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nc), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
END IF
-!
-!
- ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),7 ,'ACCR_BU_RRC')
- ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),8 ,'ACCR_BU_RRR')
- ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),12+NSV_LIMA_NC,'ACCR_BU_RSV')
-!
-!
!-------------------------------------------------------------------------------
!
!
@@ -389,6 +381,8 @@ IF (LRAIN) THEN
ISCBU = 0.0
END IF
IF( ISCBU>0 ) THEN
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SCBU', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
!
!* 5.1 efficiencies
!
@@ -416,14 +410,9 @@ IF (LRAIN) THEN
END WHERE
ZCRS(:) = ZCRS(:) - MIN( ZCRS(:),ZZW3(:) * ZRHODREF(:) )
DEALLOCATE(ZSCBU)
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_lima_nr), 'SCBU', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
END IF
-!
-!
- ZW(:,:,:) = PCRS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),12+NSV_LIMA_NR,'SCBU_BU_RSV')
-!
END IF ! LRAIN
!
!
@@ -464,28 +453,6 @@ END IF ! LRAIN
DEALLOCATE(ZLBDC3)
DEALLOCATE(ZLBDR)
DEALLOCATE(ZLBDC)
-!
-!
-!-------------------------------------------------------------------------------
-!
-ELSE
-!* 7. Budgets are forwarded
-! ------------------------
-!
-!
- IF (LBUDGET_SV .AND. LRAIN) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'SELF_BU_RSV')
-!
- IF (LBUDGET_RC .AND. LRAIN) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'AUTO_BU_RRC')
- IF (LBUDGET_RR .AND. LRAIN) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'AUTO_BU_RRR')
- IF (LBUDGET_SV .AND. LRAIN) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'AUTO_BU_RSV')
- IF (LBUDGET_SV .AND. LRAIN) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'AUTO_BU_RSV')
-!
- IF (LBUDGET_RC .AND. LRAIN) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'ACCR_BU_RRC')
- IF (LBUDGET_RR .AND. LRAIN) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'ACCR_BU_RRR')
- IF (LBUDGET_SV .AND. LRAIN) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NC,'ACCR_BU_RSV')
-!
- IF (LBUDGET_SV .AND. LRAIN) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),12+NSV_LIMA_NR,'SCBU_BU_RSV')
-
END IF ! IMICRO
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/lima_warm_nucl.f90 b/src/MNH/lima_warm_nucl.f90
index 3cd2f705228d3a81608c24308e85cfefe259cd9e..549a5fc8460f4ac857a2171b64b324f9aec84b95 100644
--- a/src/MNH/lima_warm_nucl.f90
+++ b/src/MNH/lima_warm_nucl.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.
@@ -8,10 +8,10 @@
! ##########################
!
INTERFACE
- SUBROUTINE LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, TPFILE, OCLOSE_OUT,&
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PRCM, PRVT, PRCT, PRRT, &
- PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
+ SUBROUTINE LIMA_WARM_NUCL( OACTIT, PTSTEP, KMI, TPFILE, &
+ PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
+ PRCM, PRVT, PRCT, PRRT, &
+ PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
!
USE MODD_IO, ONLY: TFILEDATA
!
@@ -22,14 +22,12 @@ REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the output FM file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -51,12 +49,12 @@ REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNAS ! CCN C. activated source
END SUBROUTINE LIMA_WARM_NUCL
END INTERFACE
END MODULE MODI_LIMA_WARM_NUCL
-! #############################################################################
- SUBROUTINE LIMA_WARM_NUCL (OACTIT, PTSTEP, KMI, TPFILE, OCLOSE_OUT,&
- PRHODREF, PEXNREF, PPABST, ZT, ZTM, PW_NU, &
- PRCM, PRVT, PRCT, PRRT, &
- PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
-! #############################################################################
+! #######################################################################
+ SUBROUTINE LIMA_WARM_NUCL( OACTIT, PTSTEP, KMI, TPFILE, &
+ PRHODREF, PEXNREF, PPABST, PT, PTM, PW_NU, &
+ PRCM, PRVT, PRCT, PRRT, &
+ PTHS, PRVS, PRCS, PCCS, PNFS, PNAS )
+! #######################################################################
!
!!
!! PURPOSE
@@ -105,20 +103,20 @@ END MODULE MODI_LIMA_WARM_NUCL
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! B. Vie 03/03/2020: use DTHRAD instead of dT/dt in Smax diagnostic computation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CST
+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
USE MODD_PARAM_LIMA_WARM
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_tools, only: Countjv
@@ -135,14 +133,12 @@ REAL, INTENT(IN) :: PTSTEP ! Double Time step
! (single if cold start)
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the output FM file
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Reference Exner function
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! abs. pressure at time t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZT ! Temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: ZTM ! Temperature at time t-dt
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PT ! Temperature
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTM ! Temperature at time t-dt
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PW_NU ! updraft velocity used for
! the nucleation param.
@@ -171,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
@@ -209,7 +206,6 @@ TYPE(TFIELDDATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
ILUOUT = TLUOUT%NLU
-ZW(:,:,:)=0.
!
!* 1. PREPARE COMPUTATIONS - PACK
! ---------------------------
@@ -222,37 +218,15 @@ IJE=SIZE(PRHODREF,2) - JPHEXT
IKB=1+JPVEXT
IKE=SIZE(PRHODREF,3) - JPVEXT
!
-!++cb++
-!ALLOCATE(ZRTMIN(SIZE(XRTMIN)))
-!--cb--
ALLOCATE(ZCTMIN(SIZE(XCTMIN)))
-!++cb++
-!ZRTMIN(:) = XRTMIN(:) / PTSTEP
-!--cb--
ZCTMIN(:) = XCTMIN(:) / PTSTEP
!
! Saturation vapor mixing ratio and radiative tendency
!
ZEPS= XMV / XMD
-!
-ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:) * &
- EXP(-XALPW+XBETAW/ZT(:,:,:)+XGAMW*ALOG(ZT(:,:,:))) - 1.0)
+ZRVSAT(:,:,:) = ZEPS / (PPABST(:,:,:)*EXP(-XALPW+XBETAW/PT(:,:,:)+XGAMW*ALOG(PT(:,:,:))) - 1.0)
ZTDT(:,:,:) = 0.
-!! ZDRC(:,:,:) = 0.
-IF (OACTIT) THEN
- ZTDT(:,:,:) = (ZT(:,:,:)-ZTM(:,:,:))/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)*(ZT(:,:,:)-XTT))*ZDRC(:,:,:)/XCPD)
-END IF
+IF (OACTIT .AND. SIZE(PTM).GT.0) ZTDT(:,:,:) = PTM(:,:,:) * PEXNREF(:,:,:) ! dThRad
!
! find locations where CCN are available
!
@@ -271,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))&
- .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
- .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4)
+ 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(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))&
- .AND. ZT(IIB:IIE,IJB:IJE,IKB:IKE)>(XTT-22.) &
- .AND. ZCONC_TOT(IIB:IIE,IJB:IJE,IKB:IKE)>ZCTMIN(4)
+ 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(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))
@@ -305,8 +279,9 @@ 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) = ZT(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))
ZZTDT(JL) = ZTDT(I1(JL),I2(JL),I3(JL))
@@ -334,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))
@@ -359,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
@@ -374,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
!
@@ -384,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
!
-!
!-------------------------------------------------------------------------------
!
!
@@ -404,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)
!
!
@@ -421,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
@@ -438,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
!
@@ -455,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
!
@@ -484,7 +464,7 @@ IF( INUCT >= 1 ) THEN
!
PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT))/ &
+ ZW(:,:,:) = ZW(:,:,:) * (XLVTT+(XCPV-XCL)*(PT(:,:,:)-XTT))/ &
(PEXNREF(:,:,:)*(XCPD+XCPV*PRVT(:,:,:)+XCL*(PRCT(:,:,:)+PRRT(:,:,:))))
PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)
!
@@ -507,6 +487,7 @@ IF( INUCT >= 1 ) THEN
DEALLOCATE(ZNFS)
DEALLOCATE(ZNAS)
DEALLOCATE(ZCCS)
+ DEALLOCATE(ZRCS)
DEALLOCATE(ZZT)
DEALLOCATE(ZSMAX)
DEALLOCATE(ZZW1)
@@ -526,7 +507,12 @@ END IF ! INUCT
!++cb++
DEALLOCATE(ZCTMIN)
!--cb--
-IF ( OCLOSE_OUT ) THEN
+IF ( tpfile%lopened ) THEN
+ IF ( INUCT == 0 ) THEN
+ ZW (:,:,:) = 0.
+ ZW2(:,:,:) = 0.
+ END IF
+
TZFIELD%CMNHNAME ='SMAX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -563,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
@@ -617,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
!
@@ -638,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
@@ -648,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
@@ -658,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
@@ -676,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
@@ -697,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'
@@ -720,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
@@ -779,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
@@ -806,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
@@ -837,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
@@ -862,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/lochead.f90 b/src/MNH/lochead.f90
deleted file mode 100644
index 5bb77e10e11d38be1b544b40841ff5f96d5cf014..0000000000000000000000000000000000000000
--- a/src/MNH/lochead.f90
+++ /dev/null
@@ -1,184 +0,0 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ###################
- MODULE MODI_LOCHEAD
-! ###################
-INTERFACE
- SUBROUTINE LOCHEAD(PLATMIN,PLATMAX,PLONMIN,PLONMAX, &
- PGLBLATMIN,PGLBLATMAX,PGLBLONMIN,PGLBLONMAX, &
- KGLBNBLAT,KGLBNBLON,PCUTVAL,KSHIFT,KMAX, &
- HSAVEDDATAFILE,ODATASAVE )
-!
-REAL, INTENT(IN) :: PLATMIN ! min latitude of the local field.
-REAL, INTENT(IN) :: PLATMAX ! max latitude of the local field.
-REAL, INTENT(IN) :: PLONMIN ! min longitude of the local field.
-REAL, INTENT(IN) :: PLONMAX ! min longitude of the local field.
-REAL, INTENT(IN) :: PGLBLATMIN ! min latitude of the global file
-REAL, INTENT(IN) :: PGLBLATMAX ! max latitude of the global file
-REAL, INTENT(IN) :: PGLBLONMIN ! min longitude of the global file
-REAL, INTENT(IN) :: PGLBLONMAX ! max longitude of the global file
-INTEGER, INTENT(IN) :: KGLBNBLAT ! number of latitude rows in global file
-INTEGER, INTENT(IN) :: KGLBNBLON ! number of longitude rows in global file
-REAL, INTENT(IN) :: PCUTVAL ! special value in data file
-INTEGER, INTENT(OUT):: KSHIFT ! shift applied to longitude array
-INTEGER, INTENT(OUT):: KMAX ! maximum index of new longitude
-! ! array in local area
-CHARACTER(LEN=28), INTENT(IN) :: HSAVEDDATAFILE! Name of the local field file
-LOGICAL, INTENT(IN) :: ODATASAVE ! flag to save data on the local
-! ! field file
-!
-END SUBROUTINE LOCHEAD
-END INTERFACE
-END MODULE MODI_LOCHEAD
-!
-!
-! ################################################################
- SUBROUTINE LOCHEAD(PLATMIN,PLATMAX,PLONMIN,PLONMAX, &
- PGLBLATMIN,PGLBLATMAX,PGLBLONMIN,PGLBLONMAX, &
- KGLBNBLAT,KGLBNBLON,PCUTVAL,KSHIFT,KMAX, &
- HSAVEDDATAFILE,ODATASAVE )
-! ################################################################
-!
-!!**** *LOCHEAD* writes the head of a the local 'latlon' file.
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 29/08/95
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!----------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_find_byname
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-REAL, INTENT(IN) :: PLATMIN ! min latitude of the local area
-REAL, INTENT(IN) :: PLATMAX ! max latitude of the local area
-REAL, INTENT(INOUT) :: PLONMIN ! min longitude of the local area
-REAL, INTENT(INOUT) :: PLONMAX ! min longitude of the local area
-REAL, INTENT(IN) :: PGLBLATMIN ! min latitude of the global file
-REAL, INTENT(IN) :: PGLBLATMAX ! max latitude of the global file
-REAL, INTENT(IN) :: PGLBLONMIN ! min longitude of the global file
-REAL, INTENT(IN) :: PGLBLONMAX ! max longitude of the global file
-INTEGER, INTENT(IN) :: KGLBNBLAT ! number of latitude rows in global file
-INTEGER, INTENT(IN) :: KGLBNBLON ! number of longitude rows in global file
-REAL, INTENT(IN) :: PCUTVAL ! special value in data file
-INTEGER, INTENT(OUT):: KSHIFT ! shift applied to longitude array
-INTEGER, INTENT(OUT):: KMAX ! maximum index of new longitude
-! ! array in local area
-CHARACTER(LEN=28), INTENT(IN) :: HSAVEDDATAFILE! Name of the local field file
-LOGICAL, INTENT(IN) :: ODATASAVE ! flag to save data on the local
-! ! field file
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: ISAVE ! logical unit
-INTEGER :: IRESP ! return code
-REAL, DIMENSION(KGLBNBLAT) :: Z1 ! latitudes of global field
-REAL, DIMENSION(KGLBNBLON) :: Z2 ! longitudes of global field
-REAL :: ZDLAT ! latitude mesh in the data file
-REAL :: ZDLON ! longitude mesh in the data file
-REAL :: Z1MIN ! min latitude of the local file
-REAL :: Z1MAX ! max latitude of the local file
-REAL :: Z2MIN ! min longitude of the local file
-REAL :: Z2MAX ! max longitude of the local file
-INTEGER, DIMENSION(1) :: INB1 ! number of lines in local file
-INTEGER, DIMENSION(1) :: INB2 ! number of columns in local file
-INTEGER :: JLAT ! loop control
-INTEGER :: JLON ! loop control
-TYPE(TFILEDATA),POINTER :: TZFILE
-!-------------------------------------------------------------------------------
-!
-IF (ODATASAVE) THEN
- CALL IO_File_find_byname(HSAVEDDATAFILE,TZFILE,IRESP)
- ISAVE = TZFILE%NLU
-END IF
-!
-ZDLAT=(PGLBLATMAX-PGLBLATMIN)/KGLBNBLAT
-ZDLON=(PGLBLONMAX-PGLBLONMIN)/KGLBNBLON
-!
-Z1(:)=(/ (PGLBLATMAX-(JLAT-0.5)*ZDLAT, JLAT=1,KGLBNBLAT) /)
-Z2(:)=(/ (PGLBLONMIN+(JLON-0.5)*ZDLON, JLON=1,KGLBNBLON) /)
-!
-IF (MINVAL(Z1)>PLATMAX .OR. MAXVAL(Z1)<PLATMIN) THEN
- KSHIFT=0
- RETURN
-END IF
-Z1MIN=MINVAL(Z1,MASK=(Z1>PLATMIN))-0.5*ZDLAT
-Z1MAX=MAXVAL(Z1,MASK=(Z1<PLATMAX))+0.5*ZDLAT
-INB1(:)=MINLOC(Z1,MASK=(Z1>PLATMIN)) &
- -MAXLOC(Z1,MASK=(Z1<PLATMAX)) +1
-!
-!* Computations on longitudes, shift of longitudes below PLONMIN
-!
-IF ( (PLONMAX+NINT((PGLBLONMIN-180.-PLONMIN)/360.)*360.<PGLBLONMIN) &
- .AND.(PLONMIN+NINT((PGLBLONMIN+180.-PLONMIN)/360.)*360.>PGLBLONMAX) ) THEN
- KMAX=0
- KSHIFT=0
-ELSE
- IF (PLONMAX+NINT((PGLBLONMIN-180.-PLONMIN)/360.)*360.>PGLBLONMIN) THEN
- Z2(:)=Z2(:)+NINT((PGLBLONMIN-180.-PLONMIN)/360.)*360.
- ELSE
- Z2(:)=Z2(:)+NINT((PGLBLONMIN+180.-PLONMIN)/360.)*360.
- END IF
- KSHIFT=COUNT(Z2(:)<PLONMIN)
- WHERE(Z2<PLONMIN)
- Z2=Z2+360.
- ENDWHERE
- Z2=CSHIFT(Z2,SHIFT=KSHIFT)
- INB2(:)=MAXLOC(Z2,MASK=(Z2<PLONMAX))
- KMAX=INB2(1)
- Z2MIN=MINVAL(Z2,MASK=(Z2>PLONMIN))-0.5*ZDLON
- Z2MAX=MAXVAL(Z2,MASK=(Z2<PLONMAX))+0.5*ZDLON
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF ( (KMAX>0) .AND. (INB1(1)>0) .AND. (ODATASAVE) ) THEN
- WRITE(ISAVE,*) 'local file ',HSAVEDDATAFILE
- WRITE(ISAVE,'(A8,F13.8)') 'nodata: ',PCUTVAL
- WRITE(ISAVE,'(A7,F13.8)') 'north: ',Z1MAX
- WRITE(ISAVE,'(A7,F13.8)') 'south: ',Z1MIN
- WRITE(ISAVE,'(A7,F13.8)') 'east: ', Z2MAX
- WRITE(ISAVE,'(A7,F13.8)') 'west: ', Z2MIN
- WRITE(ISAVE,'(A6,I7)') 'rows: ', INB1(1)
- WRITE(ISAVE,'(A6,I7)') 'cols: ', INB2(1)
-END IF
-!
-!-------------------------------------------------------------------------------
-END SUBROUTINE LOCHEAD
diff --git a/src/MNH/ls_coupling.f90 b/src/MNH/ls_coupling.f90
index 9af87a483a3b5cc7bcdd6c6c4b5c4bbc0b9a467d..3f8c43e1e52e2eb03af63022b721195dd0c492b1 100644
--- a/src/MNH/ls_coupling.f90
+++ b/src/MNH/ls_coupling.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -159,7 +159,7 @@ END MODULE MODI_LS_COUPLING
!!
!! MODIFICATIONS
!! -------------
-!! Original 03/09/96 The previous routine SET_COUPLING have been splitted
+!! Original 03/09/96 The previous routine SET_COUPLING have been split
!! in 2 routines (UVW_LS_COUPLING and LS_COUPLING),
!! and the temporal advance have been removed.
!! Correction of the LS sources names (removing of R).
diff --git a/src/MNH/mean_field.f90 b/src/MNH/mean_field.f90
index b2fd6e083d992ea0e245bd333d2ba7402327896e..048eb689dfa04f798b16e555bb6b220e896b3484 100644
--- a/src/MNH/mean_field.f90
+++ b/src/MNH/mean_field.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -10,11 +10,12 @@
!
INTERFACE
- SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST)
+ SUBROUTINE MEAN_FIELD( PUT, PVT, PWT, PTHT, PTKET, PPABST, PSVT )
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVT ! Passive scalar variables
END SUBROUTINE MEAN_FIELD
@@ -22,9 +23,9 @@ END INTERFACE
END MODULE MODI_MEAN_FIELD
!
-! #######################################################
- SUBROUTINE MEAN_FIELD(PUT, PVT, PWT, PTHT, PTKET,PPABST)
-! #######################################################
+! #################################################################
+ SUBROUTINE MEAN_FIELD( PUT, PVT, PWT, PTHT, PTKET, PPABST, PSVT )
+! #################################################################
!
!!**** *MEAN_FIELD * -
!!
@@ -46,6 +47,7 @@ END MODULE MODI_MEAN_FIELD
!! -------------
!! Original 07/2009
!! (C.Lac) 09/2016 Max values
+!! (PA.Joulin) 12/2020 Wind turbine variables
!!---------------------------------------------------------------
!
!
@@ -57,8 +59,15 @@ USE MODD_MEAN_FIELD_n
USE MODD_PARAM_n
USE MODD_MEAN_FIELD
USE MODD_CST
-
-!
+USE MODD_PASPOL
+!
+USE MODD_EOL_MAIN, ONLY: LMAIN_EOL, CMETH_EOL, NMODEL_EOL
+USE MODD_EOL_SHARED_IO, ONLY: XTHRUT, XTORQT, XPOWT
+USE MODD_EOL_SHARED_IO, ONLY: XTHRU_SUM, XTORQ_SUM, XPOW_SUM
+USE MODD_EOL_ALM
+USE MODD_EOL_ADNR
+USE MODE_MODELN_HANDLER
+!
IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
@@ -66,12 +75,17 @@ IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT, PVT, PWT ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET ! variables
REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! variables
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSVT
!
!* 0.2 Declarations of local variables :
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZTEMPT
INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
INTEGER :: JI,JJ,JK ! Loop indexes
+!
+INTEGER :: IMI !Current model index
+!
+!
!-----------------------------------------------------------------------
!
!* 0. ARRAYS BOUNDS INITIALIZATION
@@ -94,15 +108,32 @@ IKE=IKU-JPVEXT
XWM_MEAN = PWT + XWM_MEAN
XTHM_MEAN = PTHT + XTHM_MEAN
XTEMPM_MEAN = ZTEMPT + XTEMPM_MEAN
+ IF (LPASPOL) XSVT_MEAN = PSVT + XSVT_MEAN
IF (CTURB/='NONE') XTKEM_MEAN = PTKET + XTKEM_MEAN
XPABSM_MEAN = PPABST + XPABSM_MEAN
!
XU2_MEAN = PUT**2 + XU2_MEAN
XV2_MEAN = PVT**2 + XV2_MEAN
XW2_MEAN = PWT**2 + XW2_MEAN
+ XUW_MEAN = PUT*PWT + XUW_MEAN
XTH2_MEAN = PTHT**2 + XTH2_MEAN
XTEMP2_MEAN = ZTEMPT**2 + XTEMP2_MEAN
XPABS2_MEAN = PPABST**2 + XPABS2_MEAN
+!
+! Wind turbine variables
+ IMI = GET_CURRENT_MODEL_INDEX()
+ IF (LMAIN_EOL .AND. IMI==NMODEL_EOL) THEN
+ SELECT CASE(CMETH_EOL)
+ CASE('ADNR') ! Actuator Disc Non-Rotating
+ XTHRU_SUM = XTHRUT + XTHRU_SUM
+ CASE('ALM') ! Actuator Line Method
+ XAOA_SUM = XAOA_GLB + XAOA_SUM
+ XFAERO_RE_SUM = XFAERO_RE_GLB + XFAERO_RE_SUM
+ XTHRU_SUM = XTHRUT + XTHRU_SUM
+ XTORQ_SUM = XTORQT + XTORQ_SUM
+ XPOW_SUM = XPOWT + XPOW_SUM
+ END SELECT
+ END IF
!
MEAN_COUNT = MEAN_COUNT + 1
!
diff --git a/src/MNH/mean_prof.f90 b/src/MNH/mean_prof.f90
deleted file mode 100644
index 773ee9a8c5c3c293871c5cae788c6c2360787ff4..0000000000000000000000000000000000000000
--- a/src/MNH/mean_prof.f90
+++ /dev/null
@@ -1,196 +0,0 @@
-!MNH_LIC Copyright 1997-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #####################
- MODULE MODI_MEAN_PROF
-! #####################
-INTERFACE
- SUBROUTINE MEAN_PROF(PVAR_MX,PZMASS_MX,PZS_LS,PCLIMGR,&
- PF_FREE,PZ_FREE)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR_MX ! thermodynamical field
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZMASS_MX ! mass points altitude
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS_LS ! large scale orography
-REAL, INTENT(IN) :: PCLIMGR ! climatological gradient
-! ! near the ground
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_FREE ! mean profile of the
-! ! thermodynamical field
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PZ_FREE ! discretization in x,y,z
-! ! of the profile on the
-! ! flat grid where zs is the
-! ! minimum of both orographies
-END SUBROUTINE MEAN_PROF
-END INTERFACE
-END MODULE MODI_MEAN_PROF
-! ##############################################################
- SUBROUTINE MEAN_PROF(PVAR_MX,PZMASS_MX,PZS_LS,PCLIMGR,&
- PF_FREE,PZ_FREE)
-! ##############################################################
-!
-!!**** *MEAN_PROF* - Computation of the profile of the free atmospheres
-!! i.e. without the Boundary layer structures
-!!
-!! PURPOSE
-!! -------
-!! This routine computes the profile used for the shift of a variable
-!! and the altitude of the discretization points of this profile.
-!
-!! CAUTION:
-!! The shift profile is only defined on the inner vertical points of the grid.
-!!
-!!** METHOD
-!! ------
-!! The profile is discretized on the vertical GS grid defined by
-!! the MESO-NH level array XZHAT and by a constant orography,
-!! corresponding to the minimum of the Arpege and MESO-NH orographies.
-!! If necessary, the profile is extrapolated under the minimum
-!! altitude of the Arpege orography with a climatological vertical
-!! gradient PCLIMGR (uniform on the whole domain).
-!!
-!! EXTERNAL
-!! --------
-!!
-!! function ZSECT : to compute the mean of a 3D field at a constant
-!! altitude
-!! Module MODI_ZSECT: contains interface for function ZSECT
-!!
-!! 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_GRID1 : contains grid variables for model1
-!! XZS : orography of MESO-NH
-!! XZHAT : GS levels
-!! Module MODD_PARAMETERS
-!! JPVEXT
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 26/08/97
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CONF
-USE MODD_GRID_n
-USE MODD_LUNIT, ONLY: TLUOUT0
-USE MODD_PARAMETERS
-!
-USE MODI_ZSECT
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR_MX ! thermodynamical field
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZMASS_MX ! mass points altitude
-REAL, DIMENSION(:,:), INTENT(IN) :: PZS_LS ! large scale orography
-REAL, INTENT(IN) :: PCLIMGR ! climatological gradient
-! ! near the ground
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_FREE ! mean profile of the
-! ! thermodynamical field
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PZ_FREE ! discretization in x,y,z
-! ! of the profile on the
-! ! flat grid where zs is the
-! ! minimum of both orographies
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: ILEVEL,IKB,IKE,ILB,ILE,JK
-REAL :: ZMIN
-REAL, DIMENSION(SIZE(PF_FREE,3)) :: ZF_FREE
-REAL, DIMENSION(SIZE(PZ_FREE,3)) :: ZZ_FREE
-!-------------------------------------------------------------------------------
-!
-!
-IKB=JPVEXT+1
-IKE=SIZE(PZ_FREE,3)-JPVEXT
-!
-!* 1. Computation of the altitude of the GS grid for the shift profile
-! ----------------------------------------------------------------
-!
-ZMIN=MIN(MINVAL(PZS_LS),MINVAL(XZS))
-ZZ_FREE(1:IKE)=ZMIN+0.5*(XZHAT(1:IKE)+XZHAT(2:IKE+1))*(1.-ZMIN/XZHAT(IKE+1))
-ZZ_FREE(IKE+1)=2.*XZHAT(IKE+1)-ZZ_FREE(IKE)
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Computation of the shift profile
-! --------------------------------
-!
-!* 2.1 Defined values
-! --------------
-!
-ZF_FREE(:)=-999.
-DO JK=IKB,IKE
- ZF_FREE(JK)=ZSECT(ZZ_FREE(JK),PZMASS_MX(:,:,IKB:IKE+1),&
- PVAR_MX(:,:,IKB:IKE+1))
-END DO
-!
-!* 2.2 Low levels values (extrapolation with constant gradient)
-! --------------------------------------------------------
-!
-ILEVEL=0
-DO JK=1,IKE
- IF (ABS(ZF_FREE(JK)+999.)<1.E-10) THEN
- ILEVEL=JK+1
- ELSE
- EXIT
- ENDIF
-ENDDO
-!
-DO JK=1,ILEVEL-1
- ZF_FREE(JK)=ZF_FREE(ILEVEL)&
- +PCLIMGR*(ZZ_FREE(JK)-ZZ_FREE(ILEVEL))
-ENDDO
-!
-!* 2.3 Upper levels values (linear extrapolation)
-! ------------------------------------------
-!
-ILEVEL=IKE+1
-DO JK=IKE+1,1,-1
- IF (ABS(ZF_FREE(JK)+999.)<1.E-10) THEN
- ILEVEL=JK-1
- ELSE
- EXIT
- ENDIF
-ENDDO
-!
-DO JK=IKE+1,ILEVEL+1
- ZF_FREE(JK)=ZF_FREE(ILEVEL) &
- +(ZF_FREE(ILEVEL)-ZF_FREE(ILEVEL-1)) &
- /(ZZ_FREE(ILEVEL)-ZZ_FREE(ILEVEL-1)) &
- *(ZZ_FREE(JK)-ZZ_FREE(ILEVEL))
-ENDDO
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. 3D output profiles arrays
-! -------------------------
-!
-PZ_FREE(:,:,:)=SPREAD(SPREAD(ZZ_FREE(:),1,SIZE(PZ_FREE,1)),2,SIZE(PZ_FREE,2))
-PF_FREE(:,:,:)=SPREAD(SPREAD(ZF_FREE(:),1,SIZE(PF_FREE,1)),2,SIZE(PF_FREE,2))
-!
-!-------------------------------------------------------------------------------
-!
-WRITE(TLUOUT0%NLU,*) 'Routine MEAN_PROF completed'
-!
-END SUBROUTINE MEAN_PROF
diff --git a/src/MNH/menu_diachro.f90 b/src/MNH/menu_diachro.f90
index 7cf66861c15bf5c3e13f8b2e2045c2be7835e157..7c4fcea5abf4f33dfeb259ec7a071b8a9cb1ce44 100644
--- a/src/MNH/menu_diachro.f90
+++ b/src/MNH/menu_diachro.f90
@@ -1,8 +1,18 @@
-!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.
!-----------------------------------------------------------------
+#ifdef MNH_IOLFI
+module mode_menu_diachro
+
+implicit none
+
+private
+
+public :: Menu_diachro
+
+contains
! ##################################################
SUBROUTINE MENU_DIACHRO(TPDIAFILE,HGROUP)
! ##################################################
@@ -47,16 +57,18 @@
!! Original 08/01/96
!! Updated PM
!! Updated JD 24/06/99 : add GPACK to disable pack option
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 15/12/2020: more intelligent ygroup allocation (waste less memory + no more risk of out of range accesses)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CONF
+use modd_field, only: tfielddata, TYPEINT
USE MODD_IO, only: TFILEDATA
+use modd_parameters, only: NMNHNAMELGTMAX
!
-USE MODE_FIELD
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
@@ -71,16 +83,21 @@ CHARACTER(LEN=*), INTENT(IN) :: HGROUP
!* 0.1 Local variables
! ---------------
-!
-CHARACTER(LEN=NMNHNAMELGTMAX),DIMENSION(1500),SAVE :: YGROUP
+integer, parameter :: NALLOCSTEP = 50
+
+character(len=NMNHNAMELGTMAX), dimension(:), allocatable, save :: ygroup
+character(len=NMNHNAMELGTMAX), dimension(:), allocatable :: ygroup_tmp
INTEGER :: ILENG, J, JJ, IALREADY
INTEGER :: IRESPDIA
INTEGER,SAVE :: IGROUP=0
INTEGER,DIMENSION(:),ALLOCATABLE :: ITABCHAR
LOGICAL :: GPACK
TYPE(TFIELDDATA) :: TZFIELD
+type(tfiledata) :: tzfile
!------------------------------------------------------------------------------
!
+if ( tpdiafile%cformat == 'NETCDF4' ) return
+
GPACK=LPACK
LPACK=.FALSE.
!
@@ -91,6 +108,11 @@ IF(HGROUP == 'END')THEN
LPACK=GPACK
RETURN
ENDIF
+
+ !Write only in LFI files
+ tzfile = tpdiafile
+ tzfile%cformat = 'LFI'
+
ILENG=NMNHNAMELGTMAX*IGROUP
TZFIELD%CMNHNAME = 'MENU_BUDGET.DIM'
@@ -103,7 +125,7 @@ IF(HGROUP == 'END')THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write(TPDIAFILE,TZFIELD,ILENG)
+ CALL IO_Field_write(tzfile,TZFIELD,ILENG)
ALLOCATE(ITABCHAR(ILENG))
DO JJ=1,IGROUP
@@ -122,12 +144,16 @@ IF(HGROUP == 'END')THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write(TPDIAFILE,TZFIELD,ITABCHAR)
+ CALL IO_Field_write(tzfile,TZFIELD,ITABCHAR)
DEALLOCATE(ITABCHAR)
ELSE IF(HGROUP == 'READ')THEN
+ !Read only in LFI files
+ tzfile = tpdiafile
+ tzfile%cformat = 'LFI'
+
TZFIELD%CMNHNAME = 'MENU_BUDGET.DIM'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'MENU_BUDGET.DIM'
@@ -138,7 +164,7 @@ ELSE IF(HGROUP == 'READ')THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_read(TPDIAFILE,TZFIELD,ILENG,IRESPDIA)
+ CALL IO_Field_read(tzfile,TZFIELD,ILENG,IRESPDIA)
IF(IRESPDIA == -47)THEN
! print *,' No record MENU_BUDGET '
LPACK=GPACK
@@ -156,7 +182,7 @@ ELSE IF(HGROUP == 'READ')THEN
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_read(TPDIAFILE,TZFIELD,ITABCHAR)
+ CALL IO_Field_read(tzfile,TZFIELD,ITABCHAR)
IGROUP=ILENG/NMNHNAMELGTMAX
DO JJ=1,IGROUP
DO J = 1,NMNHNAMELGTMAX
@@ -181,16 +207,21 @@ ELSE
ENDIF
IF(IALREADY == 0)THEN
IGROUP=IGROUP+1
+
+ !Reallocate ygroup if too small
+ if ( Modulo( igroup, NALLOCSTEP ) == 1 ) then
+ Allocate( ygroup_tmp( NALLOCSTEP * ( igroup / NALLOCSTEP + 1 ) ) )
+ ygroup_tmp( 1 : igroup - 1 ) = ygroup( 1 : igroup - 1 )
+ call Move_alloc( from = ygroup_tmp, to = ygroup )
+ end if
+
YGROUP(IGROUP)=ADJUSTL(HGROUP)
ENDIF
ENDIF
LPACK=GPACK
-!
-!-----------------------------------------------------------------------------
-!
-!* 2. EXITS
-! -----
-!
-RETURN
+
END SUBROUTINE MENU_DIACHRO
+
+end module mode_menu_diachro
+#endif
diff --git a/src/MNH/mesonh.f90 b/src/MNH/mesonh.f90
index 27bd93e2cc2c8f80ad698f4ae9733821ecd29f9d..84017a6b994ac7be3f3681429bfd3a61771b67ed 100644
--- a/src/MNH/mesonh.f90
+++ b/src/MNH/mesonh.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.
@@ -75,7 +75,8 @@
!! J.Escobar 15/09/2015 WENO5 & JPHEXT <> 1
!! G.Delautier 06/2016 phasage surfex 8
!! J. Pianezze 01/08/2016 add sfxoasis coupling functions
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! P. Wautelet 05/2016-04/2018 new data structures and calls for I/O
+!! P. Wautelet 06/07/2021 use FINALIZE_MNH
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -87,16 +88,15 @@
USE MODD_SFX_OASIS, ONLY : LOASIS, LOASIS_GRID
#endif
!
-USE MODD_CONF
+USE MODD_CONF, only: CPROGRAM, NMODEL
USE MODD_NESTING
USE MODD_CONF_n
-USE MODD_IO, ONLY: NIO_VERB,NVERB_DEBUG
!
USE MODI_MODEL_n
USE MODI_KID_MODEL
!
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_IO, only: IO_Init
-USE MODE_IO_MANAGE_STRUCT, only: IO_Filelist_print
USE MODE_ll
USE MODE_MODELN_HANDLER
!
@@ -108,7 +108,6 @@ USE MODD_MNH_SURFEX_n
USE MODI_SFX_OASIS_INIT
USE MODI_MNH_OASIS_GRID
USE MODI_MNH_OASIS_DEFINE
- USE MODI_SFX_OASIS_END
#endif
!
USE MODE_MPPDB
@@ -213,26 +212,12 @@ DO
!
END DO
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
-!
!-------------------------------------------------------------------------------
!
!* 3. FINALIZE THE PARALLEL SESSION
! -----------------------------
!
-IF (LCHECK) THEN
- CALL MPPDB_BARRIER()
-ELSE
- CALL END_PARA_ll(IINFO_ll)
-#ifdef CPLOASIS
-IF (LOASIS) THEN
- CALL SFX_OASIS_END
-END IF
-#endif
-END IF
-!
-!
-CALL SURFEX_DEALLO_LIST
+CALL FINALIZE_MNH()
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/mnh2lpdm.f90 b/src/MNH/mnh2lpdm.f90
index 3bb745967feb6b7aeb33a6dd14696e7fde871088..d7ed74c744552ac516721d92bbf73dd793938b14 100644
--- a/src/MNH/mnh2lpdm.f90
+++ b/src/MNH/mnh2lpdm.f90
@@ -1,8 +1,8 @@
-!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
+!-----------------------------------------------------------------------
! ######spl
PROGRAM MNH2LPDM
! ##############
@@ -13,9 +13,10 @@
! Creation : 16.07.2002
! Modification : 07.01.2006 (T.LAUVAUX, adaptation LPDM)
! Modification : 04.01.2009 (F. BONNARDOT, DP/SER/ENV )
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. 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 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 05/11/2020: correct I/O of MNH2LPDM
!
!-----------------------------------------------------------------------------
!
@@ -27,9 +28,12 @@
!* 0.1 Modules.
!
USE MODD_CONF, ONLY : CPROGRAM
-USE MODD_IO, ONLY : TFILEDATA,TPTR2FILE
+USE MODD_IO, ONLY : TFILEDATA, TFILE_OUTPUTLISTING, TPTR2FILE
+use modd_lunit, only: TLUOUT0
+use modd_lunit_n, only: TLUOUT
USE MODD_MNH2LPDM
!
+USE MODE_FIELD, ONLY: INI_FIELD_LIST, INI_FIELD_SCALARS
USE MODE_IO, ONLY: IO_Init, IO_Config_set
USE MODE_IO_FILE, ONLY: IO_File_open, IO_File_close
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list
@@ -37,8 +41,10 @@ USE MODE_MODELN_HANDLER
use mode_msg
USE MODE_POS
!
+USE MODI_INI_CST
USE MODI_MNH2LPDM_ECH
USE MODI_MNH2LPDM_INI
+USE MODI_VERSION
!
USE MODN_CONFIO
!
@@ -69,6 +75,17 @@ TYPE(TFILEDATA),POINTER :: TZNMLFILE => NULL() ! Namelist file
!
CPROGRAM='M2LPDM'
CALL GOTO_MODEL(1)
+CALL VERSION()
+CALL IO_Init()
+CALL INI_CST()
+CALL INI_FIELD_LIST(1)
+CALL INI_FIELD_SCALARS()
+!
+CALL IO_File_add2list(TLUOUT0,'OUTPUT_LISTING1','OUTPUTLISTING','WRITE')
+CALL IO_File_open(TLUOUT0)
+!Set output files for PRINT_MSG
+TLUOUT => TLUOUT0
+TFILE_OUTPUTLISTING => TLUOUT0
!
!* 1.1 Variables generales.
!
diff --git a/src/MNH/mnh2lpdm_ech.f90 b/src/MNH/mnh2lpdm_ech.f90
index 7602cbaedeb897c40394f7621d8ef34b8278d706..67eb3ed1cfee5dd9b9b67986bac802aa11071fb9 100644
--- a/src/MNH/mnh2lpdm_ech.f90
+++ b/src/MNH/mnh2lpdm_ech.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2009-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -12,9 +12,10 @@
! Auteur : Francois Bonnardot, DP/SERV/ENV
! Creation : 07.01.2009
! Modifications:
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! Philippe Wautelet 28/05/2018: corrected truncated integer division (1/3 -> 1./3.)
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 28/05/2018: corrected truncated integer division (1/3 -> 1./3.)
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 05/11/2020: correct I/O of MNH2LPDM
!-----------------------------------------------------------------------
!
!* 0. DECLARATIONS.
@@ -35,6 +36,7 @@ USE MODD_TIME
!
USE MODD_MNH2LPDM
!
+use modd_field, only: tfielddata, TYPEREAL
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
@@ -59,6 +61,7 @@ INTEGER :: ICURAA,ICURMM,ICURJJ ! Date courante.
INTEGER :: ICURHH,ICURMN,ICURSS ! Heure courante.
INTEGER :: JI,JJ,JK
TYPE(DATE_TIME) :: TZDTCUR
+type(tfielddata) :: tzfield
TYPE(TFILEDATA),POINTER :: TZFILE
!
!
@@ -83,10 +86,10 @@ CALL IO_File_open(TPFILE)
!
CALL IO_Field_read(TPFILE,'DTCUR',TZDTCUR)
!
-ICURAA=MOD(TZDTCUR%TDATE%YEAR,100) ! Annee sur 2 caracteres.
-ICURMM=TZDTCUR%TDATE%MONTH
-ICURJJ=TZDTCUR%TDATE%DAY
-ICURSS=NINT(TZDTCUR%TIME)
+ICURAA=MOD(TZDTCUR%nyear,100) ! Annee sur 2 caracteres.
+ICURMM=TZDTCUR%nmonth
+ICURJJ=TZDTCUR%nday
+ICURSS=NINT(TZDTCUR%xtime)
!
ICURMN = NINT( (REAL(ICURSS)/60.0)/5.0 )*5 ! Heure arrondie a 5 minutes pres.
ICURSS = 0
@@ -106,13 +109,57 @@ CALL IO_Field_read(TPFILE,'VT', XVT)
CALL IO_Field_read(TPFILE,'WT', XWT)
CALL IO_Field_read(TPFILE,'THT', XTHT)
CALL IO_Field_read(TPFILE,'TKET', XTKET)
-!PW:TODO: where are these fields (LM,THW_FLX,DISS,FMU,FMV) written?
-!Warning: not in fieldlist => won't be found
-CALL IO_Field_read(TPFILE,'LM', XLM)
-CALL IO_Field_read(TPFILE,'THW_FLX',XWPTHP)
-CALL IO_Field_read(TPFILE,'DISS', XDISSIP)
-CALL IO_Field_read(TPFILE,'FMU', XSFU)
-CALL IO_Field_read(TPFILE,'FMV', XSFV)
+
+tzfield%cmnhname = 'LM'
+tzfield%clongname = ''
+tzfield%cunits = 'm'
+tzfield%cdir = 'XY'
+tzfield%ccomment = 'Mixing length'
+tzfield%ngrid = 1
+tzfield%ntype = TYPEREAL
+tzfield%ndims = 3
+CALL IO_Field_read(TPFILE, tzfield, XLM)
+
+tzfield%cmnhname = 'THW_FLX'
+tzfield%clongname = ''
+tzfield%cunits = 'K s-1' !correct?
+tzfield%cdir = 'XY'
+tzfield%ccomment = 'Conservative potential temperature vertical flux'
+tzfield%ngrid = 4
+tzfield%ntype = TYPEREAL
+tzfield%ndims = 3
+CALL IO_Field_read(TPFILE, tzfield, XWPTHP)
+
+tzfield%cmnhname = 'DISS'
+tzfield%clongname = ''
+tzfield%cunits = '' !TODO: set units
+tzfield%cdir = 'XY'
+tzfield%ccomment = 'X_Y_Z_DISS'
+tzfield%ngrid = 1
+tzfield%ntype = TYPEREAL
+tzfield%ndims = 3
+CALL IO_Field_read(TPFILE, tzfield, XDISSIP)
+
+tzfield%cmnhname = 'FMU'
+tzfield%clongname = ''
+tzfield%cunits = 'kg m-1 s-2'
+tzfield%cdir = 'XY'
+tzfield%ccomment = 'X_Y_FMU'
+tzfield%ngrid = 4
+tzfield%ntype = TYPEREAL
+tzfield%ndims = 2
+CALL IO_Field_read(TPFILE, tzfield, XSFU)
+
+tzfield%cmnhname = 'FMV'
+tzfield%clongname = ''
+tzfield%cunits = 'kg m-1 s-2'
+tzfield%cdir = 'XY'
+tzfield%ccomment = 'X_Y_FMV'
+tzfield%ngrid = 4
+tzfield%ntype = TYPEREAL
+tzfield%ndims = 2
+CALL IO_Field_read(TPFILE, tzfield, XSFV)
+
CALL IO_Field_read(TPFILE,'INPRT', XINRT)
CALL IO_Field_read(TPFILE,'RVT', XRMVT)
CALL IO_Field_read(TPFILE,'RCT', XRMCT)
diff --git a/src/MNH/mnh2lpdm_ini.f90 b/src/MNH/mnh2lpdm_ini.f90
index 0d317661df0526b0141eab771a1efda2892fba32..a430219a2c3e26b0ff17d55d836544c41648e91c 100644
--- a/src/MNH/mnh2lpdm_ini.f90
+++ b/src/MNH/mnh2lpdm_ini.f90
@@ -1,8 +1,8 @@
-!MNH_LIC Copyright 2009-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2009-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-!--------------------------------------------------------------------------
+!-----------------------------------------------------------------------
! ######spl
SUBROUTINE MNH2LPDM_INI(TPFILE1,TPFILE2,TPLOGFILE,TPGRIDFILE,TPDATEFILE)
!--------------------------------------------------------------------------
@@ -20,8 +20,9 @@
! TPDATEFILE Date file
!
! Modifications:
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 05/11/2020: correct I/O of MNH2LPDM
!--------------------------------------------------------------------------
!
!
@@ -33,6 +34,7 @@
!
USE MODD_CST
USE MODD_DIM_n
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_GRID
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
@@ -81,6 +83,7 @@ INTEGER, DIMENSION(:), ALLOCATABLE :: TAB1D
INTEGER, DIMENSION(:,:), ALLOCATABLE :: TAB2D
TYPE(DATE_TIME) :: TZDTCUR1,TZDTCUR2,TZDTEXP1
INTEGER :: IFDAT,IFGRI,IFLOG
+type(tfielddata) :: tzfield
!
!
!
@@ -114,27 +117,27 @@ CALL IO_Field_read(TPFILE2,'DTCUR',TZDTCUR2)
CALL DATETIME_DISTANCE(TZDTEXP1,TZDTCUR1,ZECHEANCE1)
CALL DATETIME_DISTANCE(TZDTEXP1,TZDTCUR2,ZECHEANCE2)
!
-IHHMDL=INT(TZDTEXP1%TIME/3600)
-IMNMDL=INT((TZDTEXP1%TIME-IHHMDL*3600)/60)
-ISSMDL=INT(TZDTEXP1%TIME-IHHMDL*3600-IMNMDL*60)
-IHHCUR1=INT(TZDTCUR1%TIME/3600)
-IMNCUR1=INT((TZDTCUR1%TIME-IHHCUR1*3600)/60)
-ISSCUR1=INT(TZDTCUR1%TIME-IHHCUR1*3600-IMNCUR1*60)
-IHHCUR2=INT(TZDTCUR2%TIME/3600)
-IMNCUR2=INT((TZDTCUR2%TIME-IHHCUR2*3600)/60)
-ISSCUR2=INT(TZDTCUR2%TIME-IHHCUR2*3600-IMNCUR2*60)
-!
-WRITE(YDATMDL, '(I4.4,5I2.2)') TZDTEXP1%TDATE%YEAR, TZDTEXP1%TDATE%MONTH, TZDTEXP1%TDATE%DAY, &
+IHHMDL=INT(TZDTEXP1%xtime/3600)
+IMNMDL=INT((TZDTEXP1%xtime-IHHMDL*3600)/60)
+ISSMDL=INT(TZDTEXP1%xtime-IHHMDL*3600-IMNMDL*60)
+IHHCUR1=INT(TZDTCUR1%xtime/3600)
+IMNCUR1=INT((TZDTCUR1%xtime-IHHCUR1*3600)/60)
+ISSCUR1=INT(TZDTCUR1%xtime-IHHCUR1*3600-IMNCUR1*60)
+IHHCUR2=INT(TZDTCUR2%xtime/3600)
+IMNCUR2=INT((TZDTCUR2%xtime-IHHCUR2*3600)/60)
+ISSCUR2=INT(TZDTCUR2%xtime-IHHCUR2*3600-IMNCUR2*60)
+!
+WRITE(YDATMDL, '(I4.4,5I2.2)') TZDTEXP1%nyear, TZDTEXP1%nmonth, TZDTEXP1%nday, &
IHHMDL, IMNMDL, ISSMDL
-WRITE(YDATCUR1,'(I4.4,5I2.2)') TZDTCUR1%TDATE%YEAR, TZDTCUR1%TDATE%MONTH, TZDTCUR1%TDATE%DAY, &
+WRITE(YDATCUR1,'(I4.4,5I2.2)') TZDTCUR1%nyear, TZDTCUR1%nmonth, TZDTCUR1%nday, &
IHHCUR1, IMNCUR1, ISSCUR1
-WRITE(YDATCUR2,'(I4.4,5I2.2)') TZDTCUR2%TDATE%YEAR, TZDTCUR2%TDATE%MONTH, TZDTCUR2%TDATE%DAY, &
+WRITE(YDATCUR2,'(I4.4,5I2.2)') TZDTCUR2%nyear, TZDTCUR2%nmonth, TZDTCUR2%nday, &
IHHCUR2, IMNCUR2, ISSCUR2
!
-NMDLAA=MOD( TZDTEXP1%TDATE%YEAR, 100 ) ! Annee arrondi a 2 chiffres.
-NMDLMM=TZDTEXP1%TDATE%MONTH
-NMDLJJ=TZDTEXP1%TDATE%DAY
-NMDLSS=NINT(TZDTEXP1%TIME)
+NMDLAA=MOD( TZDTEXP1%nyear, 100 ) ! Annee arrondi a 2 chiffres.
+NMDLMM=TZDTEXP1%nmonth
+NMDLJJ=TZDTEXP1%nday
+NMDLSS=NINT(TZDTEXP1%xtime)
!
!* Heure du modele arrondie a 5 minutes pres.
!
@@ -204,8 +207,15 @@ CALL IO_Field_read(TPFILE1,'ZS',XZS)
!
!* 2.8 Rugosite Z0.
!
-!PW:TODO: where is this field written? Warning: not in fieldlist => won't be found
-CALL IO_Field_read(TPFILE1,'Z0',XZ0)
+tzfield%cmnhname = 'Z0'
+tzfield%clongname = ''
+tzfield%cunits = 'm'
+tzfield%cdir = 'XY'
+tzfield%ccomment = 'X_Y_Z0'
+tzfield%ngrid = 4
+tzfield%ntype = TYPEREAL
+tzfield%ndims = 2
+CALL IO_Field_read(TPFILE1,tzfield,XZ0)
!
XXPTSOMNH=XXHAT(1)+(XXHAT(2)-XXHAT(1))/2
XYPTSOMNH=XYHAT(1)+(XYHAT(2)-XYHAT(1))/2
diff --git a/src/MNH/mnhget_surf_paramn.f90 b/src/MNH/mnhget_surf_paramn.f90
index da6c4608943b601d01edfbb2a234079a68c551cb..ff527fcf295540f0ec92cf3c285998a33b3f0cb2 100644
--- a/src/MNH/mnhget_surf_paramn.f90
+++ b/src/MNH/mnhget_surf_paramn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2003-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -9,15 +9,19 @@
INTERFACE
SUBROUTINE MNHGET_SURF_PARAM_n(PCOVER,PSEA,KCOVER,PRN,PH,PLE,PLEI,PGFLUX, &
PT2M,PQ2M,PHU2M,PZON10M,PMER10M,PZS,PTOWN,&
- PBARE, PLAI_TREE, PH_TREE )
+ PBARE, PLAI_TREE, PH_TREE, PWALL_O_HOR, &
+ PBUILD_HEIGHT,PNATURE )
!
REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PCOVER ! cover types
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PSEA ! sea fraction
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTOWN ! town fraction
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PNATURE ! nature fraction
INTEGER, INTENT(OUT), OPTIONAL :: KCOVER ! number of cover types
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PBARE ! Bare soil fraction
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PLAI_TREE !
-REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PH_TREE
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PLAI_TREE ! Tree leaf area index [m^2(leaf)/m^2(nature)]
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PH_TREE ! Tree height [m]
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PWALL_O_HOR ! Facade area density [m^2(fac.)/m^2(town)]
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PBUILD_HEIGHT ! Building height [m]
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PRN ! Net radiation at surface (W/m2)
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PH ! Sensible heat flux (W/m2)
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PLE ! Total Latent heat flux (W/m2)
@@ -38,7 +42,8 @@ END MODULE MODI_MNHGET_SURF_PARAM_n
! ########################################
SUBROUTINE MNHGET_SURF_PARAM_n(PCOVER,PSEA,KCOVER,PRN,PH,PLE,PLEI,PGFLUX, &
PT2M,PQ2M,PHU2M,PZON10M,PMER10M,PZS,PTOWN,&
- PBARE, PLAI_TREE, PH_TREE )
+ PBARE, PLAI_TREE, PH_TREE, PWALL_O_HOR, &
+ PBUILD_HEIGHT,PNATURE )
! ########################################
!
!!**** *MNHGET_SURF_PARAM_n* - gets some surface fields on MESONH grid
@@ -74,6 +79,8 @@ END MODULE MODI_MNHGET_SURF_PARAM_n
!! S. Donier 06/2015 : bug surface aerosols
!! 06/2016 (G.Delautier) phasage surfex 8
!! 01/2018 (G.Delautier) SURFEX 8.1
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! P. Wautelet 11/03/2020: bugfix: add present checks before working on optional arrays
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -101,10 +108,13 @@ IMPLICIT NONE
REAL, DIMENSION(:,:,:), INTENT(OUT), OPTIONAL :: PCOVER ! cover types
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PSEA ! sea fraction
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTOWN ! town fraction
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PNATURE ! nature fraction
INTEGER, INTENT(OUT), OPTIONAL :: KCOVER ! number of cover types
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PBARE ! Bare soil fraction
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PLAI_TREE !
REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PH_TREE !
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PWALL_O_HOR ! Facade area density [m^2(fac.)/m^2(town)]
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PBUILD_HEIGHT ! Building height [m]
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PRN ! Net radiation at surface (W/m2)
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PH ! Sensible heat flux (W/m2)
REAL, DIMENSION(:), INTENT(INOUT), OPTIONAL :: PLE ! Total Latent heat flux (W/m2)
@@ -137,6 +147,8 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZNATURE! nature fraction
REAL, DIMENSION(:), ALLOCATABLE :: ZTOWN ! town fraction
REAL, DIMENSION(:), ALLOCATABLE :: ZVH
REAL, DIMENSION(:), ALLOCATABLE :: ZLAI
+REAL, DIMENSION(:), ALLOCATABLE :: ZWALL_O_HOR ! Facade surface density [m^2(fac.)/m^2(town)]
+REAL, DIMENSION(:), ALLOCATABLE :: ZBUILD_HEIGHT ! Building height [m]
REAL, DIMENSION(:), ALLOCATABLE :: ZBARE ! bare soil fraction
REAL, DIMENSION(:), ALLOCATABLE :: ZZS ! orography
REAL, DIMENSION(:), ALLOCATABLE :: ZRN ! net radiation at surface (W/m2)
@@ -170,8 +182,9 @@ IF (PRESENT(PCOVER)) THEN
DEALLOCATE(ZCOVER)
END IF
!
-IF (PRESENT(PSEA) .OR. PRESENT(PTOWN) .OR. &
- PRESENT(PBARE) .OR. PRESENT(PLAI_TREE) .OR. PRESENT(PH_TREE)) THEN
+IF (PRESENT(PSEA) .OR. PRESENT(PTOWN) .OR. PRESENT(PNATURE) .OR. &
+ PRESENT(PBARE) .OR. PRESENT(PLAI_TREE) .OR. PRESENT(PH_TREE) .OR. &
+ PRESENT(PWALL_O_HOR) .OR. PRESENT(PBUILD_HEIGHT) ) THEN
ALLOCATE(ZSEA ( ILU ))
ALLOCATE(ZWATER ( ILU ))
ALLOCATE(ZNATURE( ILU ))
@@ -183,6 +196,9 @@ IF (PRESENT(PSEA) .OR. PRESENT(PTOWN) .OR. &
IF (PRESENT(PTOWN)) THEN
CALL REMOVE_HALO(ZTOWN,PTOWN)
END IF
+ IF (PRESENT(PNATURE)) THEN
+ CALL REMOVE_HALO(ZNATURE,PNATURE)
+ END IF
END IF
!
IF (PRESENT(PBARE)) THEN
@@ -242,12 +258,28 @@ IF (PRESENT(PH_TREE) .OR.PRESENT(PLAI_TREE)) THEN
YSURF_CUR%WM,YSURF_CUR%DUO,YSURF_CUR%DU,YSURF_CUR%UG,&
YSURF_CUR%U,YSURF_CUR%USS,&
'MESONH',ILU,1,PNATURE=ZNATURE,PLAI_TREE=ZLAI,PH_TREE=ZVH)
- CALL REMOVE_HALO(ZLAI,PLAI_TREE)
- CALL REMOVE_HALO(ZVH,PH_TREE)
+ IF ( PRESENT( PLAI_TREE ) ) CALL REMOVE_HALO(ZLAI,PLAI_TREE)
+ IF ( PRESENT( PH_TREE ) ) CALL REMOVE_HALO(ZVH,PH_TREE)
DEALLOCATE(ZVH)
DEALLOCATE(ZLAI)
END IF
!
+IF (PRESENT(PWALL_O_HOR) .OR. PRESENT(PBUILD_HEIGHT)) THEN
+ IF ( PRESENT ( PBUILD_HEIGHT ) ) PBUILD_HEIGHT(:,:) = XUNDEF
+ IF ( PRESENT ( PWALL_O_HOR ) ) PWALL_O_HOR(:,:) = XUNDEF
+ ALLOCATE(ZBUILD_HEIGHT ( ILU ))
+ ALLOCATE(ZWALL_O_HOR ( ILU ))
+ CALL GET_SURF_VAR_n(YSURF_CUR%FM,YSURF_CUR%IM,YSURF_CUR%SM,YSURF_CUR%TM, &
+ YSURF_CUR%WM,YSURF_CUR%DUO,YSURF_CUR%DU,YSURF_CUR%UG,&
+ YSURF_CUR%U,YSURF_CUR%USS,&
+ 'MESONH',ILU,1,PTOWN=ZTOWN, &
+ PWALL_O_HOR=ZWALL_O_HOR,PBUILD_HEIGHT=ZBUILD_HEIGHT )
+ IF ( PRESENT ( PBUILD_HEIGHT ) ) CALL REMOVE_HALO(ZBUILD_HEIGHT,PBUILD_HEIGHT)
+ IF ( PRESENT ( PWALL_O_HOR ) ) CALL REMOVE_HALO(ZWALL_O_HOR,PWALL_O_HOR)
+ DEALLOCATE(ZBUILD_HEIGHT)
+ DEALLOCATE(ZWALL_O_HOR)
+END IF
+!
IF (ALLOCATED(ZSEA)) THEN
DEALLOCATE(ZSEA )
DEALLOCATE(ZWATER )
diff --git a/src/MNH/modd_aircraft_balloon.f90 b/src/MNH/modd_aircraft_balloon.f90
index 9ff02772fc696e682c0efc396edbb3c0b6780748..33d6f973fbc2407e4d9f72b8922e1d2e1179dc27 100644
--- a/src/MNH/modd_aircraft_balloon.f90
+++ b/src/MNH/modd_aircraft_balloon.f90
@@ -33,14 +33,17 @@
!! March, 2013 : O.Caumont, C.Lac : add vertical profiles
!! Oct,2016 : G.DELAUTIER LIMA
! P. Wautelet 08/02/2019: add missing NULL association for pointers
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!
-USE MODD_TYPE_DATE
-!
+use modd_type_date, only: date_time
+
+implicit none
+
TYPE FLYER
!
!
@@ -109,7 +112,7 @@ REAL :: P_CUR ! current p (if 'AIRCRA' and 'ALTDEF'
!
!* data records
!
-REAL, DIMENSION(:), POINTER :: TIME => NULL() ! t(n) (n: recording instants)
+type(date_time), dimension(:), pointer :: tpdates => NULL() ! dates(n) (n: recording instants)
REAL, DIMENSION(:), POINTER :: X => NULL() ! X(n)
REAL, DIMENSION(:), POINTER :: Y => NULL() ! Y(n)
REAL, DIMENSION(:), POINTER :: Z => NULL() ! Z(n)
@@ -140,7 +143,6 @@ REAL, DIMENSION(:,:), POINTER :: AER => NULL() ! Extinction at 550 nm
REAL, DIMENSION(:,:), POINTER :: DST_WL => NULL() ! Extinction by wavelength
REAL, DIMENSION(:), POINTER :: ZS => NULL() ! zs(n)
REAL, DIMENSION(:), POINTER :: TSRAD => NULL() ! Ts(n)
-REAL, DIMENSION(:,:), POINTER :: DATIME => NULL() ! record for diachro
!
REAL, DIMENSION(:) , POINTER :: THW_FLUX => NULL() ! thw_flux(n)
REAL, DIMENSION(:) , POINTER :: RCW_FLUX => NULL() ! rcw_flux(n)
diff --git a/src/MNH/modd_allstationn.f90 b/src/MNH/modd_allstationn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..933c1657174cab1dfee31f99a8be37abddbb3a12
--- /dev/null
+++ b/src/MNH/modd_allstationn.f90
@@ -0,0 +1,94 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ############################
+ MODULE MODD_ALLSTATION_n
+! ############################
+!
+!!**** *MODD_STATION* - declaration of stations
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to define
+! the different stations types.
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! NONE
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! E. Jezequel *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/06/21
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+USE MODD_STATION_n
+USE MODD_TYPE_STATION
+
+IMPLICIT NONE
+
+TYPE ALLSTATION_t
+!
+!-------------------------------------------------------------------------------------------
+!
+!
+ INTEGER :: NNUMB_STAT !Number of stations as defined in namelist
+ REAL, DIMENSION(100) :: XX_STAT, XY_STAT, XZ_STAT, XLAT_STAT, XLON_STAT
+ CHARACTER(LEN=7), DIMENSION(100) :: CNAME_STAT, CTYPE_STAT
+ CHARACTER(LEN=20) :: CFILE_STAT
+ REAL :: XSTEP_STAT
+ LOGICAL :: LDIAG_SURFRAD
+ !
+!
+END TYPE ALLSTATION_t
+
+TYPE(ALLSTATION_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: ALLSTATION_MODEL
+
+INTEGER, POINTER :: NNUMB_STAT=>NULL()
+REAL, POINTER :: XSTEP_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XX_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XY_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XLAT_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XLON_STAT=>NULL()
+REAL, DIMENSION(:), POINTER :: XZ_STAT=>NULL()
+CHARACTER (LEN=7),DIMENSION(:), POINTER :: CNAME_STAT=>NULL()
+CHARACTER (LEN=7),DIMENSION(:), POINTER :: CTYPE_STAT=>NULL()
+CHARACTER (LEN=20),POINTER :: CFILE_STAT=>NULL()
+LOGICAL, POINTER :: LDIAG_SURFRAD=>NULL()
+CONTAINS
+
+SUBROUTINE ALLSTATION_GOTO_MODEL(KFROM, KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+!
+! Current model is set to model KTO
+
+NNUMB_STAT =>ALLSTATION_MODEL(KTO)%NNUMB_STAT
+XSTEP_STAT =>ALLSTATION_MODEL(KTO)%XSTEP_STAT
+XX_STAT =>ALLSTATION_MODEL(KTO)%XX_STAT
+XY_STAT =>ALLSTATION_MODEL(KTO)%XY_STAT
+XZ_STAT =>ALLSTATION_MODEL(KTO)%XZ_STAT
+XLAT_STAT =>ALLSTATION_MODEL(KTO)%XLAT_STAT
+XLON_STAT =>ALLSTATION_MODEL(KTO)%XLON_STAT
+CNAME_STAT =>ALLSTATION_MODEL(KTO)%CNAME_STAT
+CTYPE_STAT =>ALLSTATION_MODEL(KTO)%CTYPE_STAT
+CFILE_STAT =>ALLSTATION_MODEL(KTO)%CFILE_STAT
+LDIAG_SURFRAD =>ALLSTATION_MODEL(KTO)%LDIAG_SURFRAD
+END SUBROUTINE ALLSTATION_GOTO_MODEL
+
+END MODULE MODD_ALLSTATION_n
diff --git a/src/MNH/modd_blank.f90 b/src/MNH/modd_blank.f90
deleted file mode 100644
index 64e2eda86cd827987744006b326ab2f9f93499b9..0000000000000000000000000000000000000000
--- a/src/MNH/modd_blank.f90
+++ /dev/null
@@ -1,66 +0,0 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #################
- MODULE MODD_BLANK
-! #################
-!
-!!**** *MODD_BLANK* - Declarative module for MesoNH developpers namelist
-!!
-!! PURPOSE
-!! -------
-!!
-!! Offer dummy real, integer, logical and character variables for
-!! test and debugging purposes.
-!!
-!!** METHOD
-!! ------
-!!
-!! Eight dummy real, integer, logical and character*80 variables are
-!! defined and passed through the namelist read operations. None of the
-!! MesoNH routines uses any of those variables. When a developper choses
-!! to introduce temporarily a parameter to some subroutine, he has to
-!! introduce a USE MODD_BLANK statement into that subroutine. Then he
-!! can use any of the variables defined here and change them easily via
-!! the namelist input.
-!!
-!! REFERENCE
-!! ---------
-!! None
-!!
-!! AUTHOR
-!! ------
-!! K. Suhre *Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 25/04/96
-!! updated 17/11/00 (P Jabouille) Use dummy array
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY : JPDUMMY
-!
-IMPLICIT NONE
-!
-REAL, SAVE :: XDUMMY1, XDUMMY2, XDUMMY3, XDUMMY4, &
- XDUMMY5, XDUMMY6, XDUMMY7, XDUMMY8
-INTEGER, SAVE :: NDUMMY1, NDUMMY2, NDUMMY3, NDUMMY4, &
- NDUMMY5, NDUMMY6, NDUMMY7, NDUMMY8
-LOGICAL, SAVE :: LDUMMY1, LDUMMY2, LDUMMY3, LDUMMY4, &
- LDUMMY5, LDUMMY6, LDUMMY7, LDUMMY8
-CHARACTER(len=80), SAVE :: CDUMMY1, CDUMMY2, CDUMMY3, CDUMMY4, &
- CDUMMY5, CDUMMY6, CDUMMY7, CDUMMY8
-!
-REAL, SAVE, DIMENSION(JPDUMMY) :: XDUMMY
-INTEGER, SAVE, DIMENSION(JPDUMMY) :: NDUMMY
-LOGICAL, SAVE, DIMENSION(JPDUMMY) :: LDUMMY
-CHARACTER(len=80), SAVE, DIMENSION(JPDUMMY) :: CDUMMY
-!
-END MODULE MODD_BLANK
diff --git a/src/MNH/modd_blankn.f90 b/src/MNH/modd_blankn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6428103136f77d7639c070c7032add80316721f5
--- /dev/null
+++ b/src/MNH/modd_blankn.f90
@@ -0,0 +1,173 @@
+!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.
+!-----------------------------------------------------------------
+! #################
+ MODULE MODD_BLANK_n
+! #################
+!
+!!**** *MODD_BLANK$n* - Declarative module for MesoNH developpers namelist
+!!
+!! PURPOSE
+!! -------
+!!
+!! Offer dummy real, integer, logical and character variables for
+!! test and debugging purposes.
+!!
+!!** METHOD
+!! ------
+!!
+!! Eight dummy real, integer, logical and character*80 variables are
+!! defined and passed through the namelist read operations. None of the
+!! MesoNH routines uses any of those variables. When a developper choses
+!! to introduce temporarily a parameter to some subroutine, he has to
+!! introduce a USE MODD_BLANK statement into that subroutine. Then he
+!! can use any of the variables defined here and change them easily via
+!! the namelist input.
+!!
+!! REFERENCE
+!! ---------
+!! None
+!!
+!! AUTHOR
+!! ------
+!! K. Suhre *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 25/04/96
+!! updated 17/11/00 (P Jabouille) Use dummy array
+!! updated 26/10/21 (Q.Rodier) Use for n model (grid-nesting)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_PARAMETERS, ONLY : JPDUMMY, JPMODELMAX
+!
+IMPLICIT NONE
+!
+TYPE BLANK_t
+!
+ LOGICAL :: LDUMMY1
+ LOGICAL :: LDUMMY2
+ LOGICAL :: LDUMMY3
+ LOGICAL :: LDUMMY4
+ LOGICAL :: LDUMMY5
+ LOGICAL :: LDUMMY6
+ LOGICAL :: LDUMMY7
+ LOGICAL :: LDUMMY8
+!
+ CHARACTER(len=80) :: CDUMMY1
+ CHARACTER(len=80) :: CDUMMY2
+ CHARACTER(len=80) :: CDUMMY3
+ CHARACTER(len=80) :: CDUMMY4
+ CHARACTER(len=80) :: CDUMMY5
+ CHARACTER(len=80) :: CDUMMY6
+ CHARACTER(len=80) :: CDUMMY7
+ CHARACTER(len=80) :: CDUMMY8
+!
+ INTEGER :: NDUMMY1
+ INTEGER :: NDUMMY2
+ INTEGER :: NDUMMY3
+ INTEGER :: NDUMMY4
+ INTEGER :: NDUMMY5
+ INTEGER :: NDUMMY6
+ INTEGER :: NDUMMY7
+ INTEGER :: NDUMMY8
+!
+ REAL :: XDUMMY1
+ REAL :: XDUMMY2
+ REAL :: XDUMMY3
+ REAL :: XDUMMY4
+ REAL :: XDUMMY5
+ REAL :: XDUMMY6
+ REAL :: XDUMMY7
+ REAL :: XDUMMY8
+!
+END TYPE BLANK_t
+!
+TYPE(BLANK_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: BLANK_MODEL
+!
+LOGICAL, POINTER :: LDUMMY1=>NULL()
+LOGICAL, POINTER :: LDUMMY2=>NULL()
+LOGICAL, POINTER :: LDUMMY3=>NULL()
+LOGICAL, POINTER :: LDUMMY4=>NULL()
+LOGICAL, POINTER :: LDUMMY5=>NULL()
+LOGICAL, POINTER :: LDUMMY6=>NULL()
+LOGICAL, POINTER :: LDUMMY7=>NULL()
+LOGICAL, POINTER :: LDUMMY8=>NULL()
+!
+CHARACTER(len=80), POINTER :: CDUMMY1=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY2=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY3=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY4=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY5=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY6=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY7=>NULL()
+CHARACTER(len=80), POINTER :: CDUMMY8=>NULL()
+!
+INTEGER, POINTER :: NDUMMY1=>NULL()
+INTEGER, POINTER :: NDUMMY2=>NULL()
+INTEGER, POINTER :: NDUMMY3=>NULL()
+INTEGER, POINTER :: NDUMMY4=>NULL()
+INTEGER, POINTER :: NDUMMY5=>NULL()
+INTEGER, POINTER :: NDUMMY6=>NULL()
+INTEGER, POINTER :: NDUMMY7=>NULL()
+INTEGER, POINTER :: NDUMMY8=>NULL()
+!
+REAL, POINTER :: XDUMMY1=>NULL()
+REAL, POINTER :: XDUMMY2=>NULL()
+REAL, POINTER :: XDUMMY3=>NULL()
+REAL, POINTER :: XDUMMY4=>NULL()
+REAL, POINTER :: XDUMMY5=>NULL()
+REAL, POINTER :: XDUMMY6=>NULL()
+REAL, POINTER :: XDUMMY7=>NULL()
+REAL, POINTER :: XDUMMY8=>NULL()
+!
+CONTAINS
+!
+SUBROUTINE BLANK_GOTO_MODEL(KFROM,KTO)
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+LDUMMY1=>BLANK_MODEL(KTO)%LDUMMY1
+LDUMMY2=>BLANK_MODEL(KTO)%LDUMMY2
+LDUMMY3=>BLANK_MODEL(KTO)%LDUMMY3
+LDUMMY4=>BLANK_MODEL(KTO)%LDUMMY4
+LDUMMY5=>BLANK_MODEL(KTO)%LDUMMY5
+LDUMMY6=>BLANK_MODEL(KTO)%LDUMMY6
+LDUMMY7=>BLANK_MODEL(KTO)%LDUMMY7
+LDUMMY8=>BLANK_MODEL(KTO)%LDUMMY8
+
+CDUMMY1=>BLANK_MODEL(KTO)%CDUMMY1
+CDUMMY2=>BLANK_MODEL(KTO)%CDUMMY2
+CDUMMY3=>BLANK_MODEL(KTO)%CDUMMY3
+CDUMMY4=>BLANK_MODEL(KTO)%CDUMMY4
+CDUMMY5=>BLANK_MODEL(KTO)%CDUMMY5
+CDUMMY6=>BLANK_MODEL(KTO)%CDUMMY6
+CDUMMY7=>BLANK_MODEL(KTO)%CDUMMY7
+CDUMMY8=>BLANK_MODEL(KTO)%CDUMMY8
+!
+NDUMMY1=>BLANK_MODEL(KTO)%NDUMMY1
+NDUMMY2=>BLANK_MODEL(KTO)%NDUMMY2
+NDUMMY3=>BLANK_MODEL(KTO)%NDUMMY3
+NDUMMY4=>BLANK_MODEL(KTO)%NDUMMY4
+NDUMMY5=>BLANK_MODEL(KTO)%NDUMMY5
+NDUMMY6=>BLANK_MODEL(KTO)%NDUMMY6
+NDUMMY7=>BLANK_MODEL(KTO)%NDUMMY7
+NDUMMY8=>BLANK_MODEL(KTO)%NDUMMY8
+!
+XDUMMY1=>BLANK_MODEL(KTO)%XDUMMY1
+XDUMMY2=>BLANK_MODEL(KTO)%XDUMMY2
+XDUMMY3=>BLANK_MODEL(KTO)%XDUMMY3
+XDUMMY4=>BLANK_MODEL(KTO)%XDUMMY4
+XDUMMY5=>BLANK_MODEL(KTO)%XDUMMY5
+XDUMMY6=>BLANK_MODEL(KTO)%XDUMMY6
+XDUMMY7=>BLANK_MODEL(KTO)%XDUMMY7
+XDUMMY8=>BLANK_MODEL(KTO)%XDUMMY8
+!
+END SUBROUTINE BLANK_GOTO_MODEL
+!
+END MODULE MODD_BLANK_n
diff --git a/src/MNH/modd_budget.f90 b/src/MNH/modd_budget.f90
index 14387e9f096dfadc2fa95b186c91d1bf6e299cfe..7442dfd3e0184598cd4ee7687456a5e31b900e5b 100644
--- a/src/MNH/modd_budget.f90
+++ b/src/MNH/modd_budget.f90
@@ -1,7 +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.
+!-----------------------------------------------------------------
! ##################
MODULE MODD_BUDGET
! ##################
@@ -10,13 +11,12 @@
!!
!! PURPOSE
!! -------
-! The purpose of this declarative module is to specify the budget
-! variables.
+! The purpose of this declarative module is to specify the budget
+! variables
!
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
-!! MODD_PARAMETERS: JPBUMAX, JPBUPROCMAX
!!
!! REFERENCE
!! ---------
@@ -31,57 +31,152 @@
!! Original 23/02/95
!! J.-P. Lafore 10/02/98 adding of rhodj declaration for budget
!! V. Ducrocq 4/06/99 //
-!! J.-P. Pinty 25/09/00 additional budget terms for C2R2 scheme
-!! D. Gazen 22/01/01 add NCHEMSV
-!! V. Masson 06/11/02 new flags for budget calls and time counters
-!! V. Masson 27/11/02 add 2way nesting effect
-!! P. Jabouille 07/07/04 add budget terms for microphysics
-!! C. Barthe 19/11/09 add budget terms for electricity
-!! C.Lac 04/2016 negative contribution to the budget splitted between advection, turbulence and microphysics for KHKO/C2R2
-!! C. Barthe /16 add budget terms for LIMA
-!! C. LAc 10/2016 add droplets deposition
-!! S. Riette 11/2016 New budgets for ICE3/ICE4
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 19/07/2019: parameters to identify budget number
+! P. Wautelet 15/11/2019: remove unused CBURECORD variable
+! P. Wautelet 17/01/2020: add new budget data types
+! P. Wautelet 27/01/2020: use the tfield_metadata_base abstract datatype
+! P. Wautelet 28/01/2020: add trhodj in tbudgetdata datatype
+! P. Wautelet 09/03/2020: add tburhodj variable
+! P. Wautelet 17/04/2020: set default values for budgets switch values
+! P. Wautelet 23/04/2020: add nid in tbudgetdata datatype
+! P. Wautelet 17/08/2020: add xtmplesstore in tbudgetdata datatype
+! P. Wautelet 08/10/2020: add clessource in tbudgetdata datatype
+! P. Wautelet 08/12/2020: add nbusubwrite and nbutotwrite
+! P. Wautelet 11/01/2021: remove nbuwrnb (replaced by nbusubwrite)
+! P. Wautelet 14/01/2021: change xbusurf type to integer (+ rename it to nbusurf)
+! P. Wautelet 03/03/2021: add tbudiachrometadata type (useful to pass more information to Write_diachro)
+! P. Wautelet 17/03/2021: choose source terms for budgets with character strings instead of multiple integer variables
+! P. Wautelet 30/03/2021: budgets: cartesian subdomain limits are defined in the physical domain
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-USE MODD_PARAMETERS, ONLY :JPBUMAX, JPBUPROMAX, NMNHNAMELGTMAX
-!
-IMPLICIT NONE
-!
+
+use modd_field, only: tfield_metadata_base
+use modd_parameters, only: NBUNAMELGTMAX, NCOMMENTLGTMAX
+
+implicit none
+
+public
+
+integer, parameter :: NBULISTMAXLEN = 256
+integer, parameter :: NBULISTMAXLINES = 50
+
+integer, parameter :: NBUDGET_RHO = 0 ! Reference number for budget of RhoJ
+integer, parameter :: NBUDGET_U = 1 ! Reference number for budget of RhoJu and/or LES budgets with u
+integer, parameter :: NBUDGET_V = 2 ! Reference number for budget of RhoJv and/or LES budgets with u
+integer, parameter :: NBUDGET_W = 3 ! Reference number for budget of RhoJw and/or LES budgets with u
+integer, parameter :: NBUDGET_TH = 4 ! Reference number for budget of RhoJTh and/or LES budgets with th
+integer, parameter :: NBUDGET_TKE = 5 ! Reference number for budget of RhoJTke and/or LES budgets with Tke
+integer, parameter :: NBUDGET_RV = 6 ! Reference number for budget of RhoJrv and/or LES budgets with rv
+integer, parameter :: NBUDGET_RC = 7 ! Reference number for budget of RhoJrc and/or LES budgets with rc
+integer, parameter :: NBUDGET_RR = 8 ! Reference number for budget of RhoJrr and/or LES budgets with rr
+integer, parameter :: NBUDGET_RI = 9 ! Reference number for budget of RhoJri and/or LES budgets with ri
+integer, parameter :: NBUDGET_RS = 10 ! Reference number for budget of RhoJrs and/or LES budgets with rs
+integer, parameter :: NBUDGET_RG = 11 ! Reference number for budget of RhoJrg and/or LES budgets with rg
+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
+
+
+type, extends( tfield_metadata_base ) :: tbusourcedata
+ integer :: ngroup = 0 ! Number of the source term group in which storing the source term
+ ! (0: no store, 1: individual store, >1: number of the group)
+ logical :: lavailable = .false. ! If true, the source is available in the run (conditions to access it are met),
+ ! but it doesn't mean it is used (see lenabled field)
+ logical :: lenabled = .false.
+ logical :: ldonotinit = .false. ! if true, does not need a call to Budget_store_init
+ ! It may be true only if the source term is in a group not containing other sources
+ logical :: loverwrite = .false. ! if true, source term values will overwrite the previous ones
+ ! It may be true only if the source term is in a group not containing other sources
+end type tbusourcedata
+
+type, extends( tfield_metadata_base ) :: tbugroupdata
+ integer :: nsources = 0 ! Number of source terms composing this group
+ integer, dimension(:), allocatable :: nsourcelist ! List of the source terms composing this group
+ real, dimension(:,:,:), allocatable :: xdata ! Array to store the budget data
+end type tbugroupdata
+
+type, extends( tfield_metadata_base ) :: tburhodata
+ real, dimension(:,:,:), allocatable :: xdata ! Array to store the budget data
+end type tburhodata
+
+type :: tbudiachrometadata
+ 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
+ integer :: njh = -1
+ integer :: nkl = -1
+ integer :: nkh = -1
+ integer :: nsv = -1 !Reference number of the corresponding scalar variable
+end type tbudiachrometadata
+
+type tbudgetdata
+ character(len=NBUNAMELGTMAX) :: cname = ''
+ character(len=NCOMMENTLGTMAX) :: ccomment = ''
+ character(len=100) :: clessource = '' ! Last source stored
+ integer :: nid = -1 !Identifier number (based on parameters NBUDGET_*)
+ integer :: ngroups = 0 !Number of groups of source terms to store
+ integer :: nsources = 0 !Number of available source terms
+ integer :: nsourcesmax = 0 !Maximum number of source terms
+ integer :: ntmpstoresource = 0 !Reference of the source term using the xtmpstore array
+ logical :: lenabled = .false. ! True if corresponding budget flag is set to true
+ real, dimension(:,:,:), allocatable :: xtmpstore ! Array to store temporary data
+ ! (to allow to store the difference between 2 places)
+ real, dimension(:,:,:), allocatable :: xtmplesstore ! Array to store temporary data for LES budgets
+ ! (to allow to store the difference between 2 places)
+ type(tbusourcedata), dimension(:), allocatable :: tsources ! Full list of source terms (used or not)
+ type(tbugroupdata), dimension(:), allocatable :: tgroups ! Full list of groups of source terms (to be written)
+ type(tburhodata), pointer :: trhodj => null() ! Budget array for rhodj
+end type tbudgetdata
+
+
+type(tbudgetdata), dimension(:), allocatable, save :: tbudgets
+type(tburhodata), pointer, save :: tburhodj => null() ! Budget array for rhodj used inside some tbudgets
+
+
! General variables
LOGICAL, SAVE :: LBU_ENABLE
!
-INTEGER, SAVE, DIMENSION(JPBUMAX,JPBUPROMAX) & ! number of processes to be
- :: NBUINC ! avoided for every budget
- ! between one active
- ! source to the next one
-INTEGER, SAVE, DIMENSION(JPBUMAX) & ! counter for all the processes
- :: NBUCTR_ACTV ! activated or not
-!
CHARACTER (LEN=4), SAVE :: CBUTYPE ! type of desired budget 'CART'
! (cartesian box) or 'MASK' (budget
! zone defined by a mask) or 'NONE'
! (no budget)
INTEGER, SAVE :: NBUMOD ! model in which budget is
! calculated
-INTEGER, SAVE, DIMENSION(:), & ! number of processes for each
- ALLOCATABLE :: NBUPROCNBR ! budget
-!
-INTEGER, SAVE, DIMENSION(:), & ! process counter linked to each
- ALLOCATABLE :: NBUPROCCTR ! budget
-!
-CHARACTER(LEN=2), SAVE, DIMENSION(:,:), & ! resulting string character of the
- ALLOCATABLE :: CBUACTION ! transcription of the budget actions
- ! (integer) read in namelists or
- ! set by default
-CHARACTER (LEN=NMNHNAMELGTMAX), SAVE, DIMENSION(:,:),& ! names of records on the FM file
- ALLOCATABLE :: CBURECORD ! for the budgets
-!
-CHARACTER (LEN=99), SAVE, DIMENSION(:,:),& ! name of a process for a budget. It
- ALLOCATABLE :: CBUCOMMENT ! will appear in the comment part of
- ! the previous record
!
LOGICAL, SAVE :: LBU_BEG ! switch for budget beginning
!
@@ -90,23 +185,23 @@ REAL, SAVE :: XBULEN ! length in seconds of the budget
!
INTEGER, SAVE :: NBUSTEP ! number of model timesteps required
! for the budget time average
-REAL, SAVE :: XBUWRI ! period in seconds of
- ! budget writing on FM-files
-INTEGER, SAVE :: NBUWRNB ! number of budget periods when storage
- ! arrays are written on FM-files
+REAL, SAVE :: XBUWRI ! period in seconds between
+ ! budget writing for budget masks
INTEGER, SAVE :: NBUTSHIFT ! temporal shift for budgets writing
+integer, save :: nbusubwrite = 0 ! Number of budget time average periods for each write
+integer, save :: nbutotwrite = 0 ! Total number of budget time average periods
!
INTEGER, SAVE :: NBUKL, NBUKH ! lowest and highest K indice values
- ! of the budget box
+ ! of the budget box in the physical domain
LOGICAL, SAVE :: LBU_KCP ! switch for compression in K
! direction
!
! Variables used by the cartesian box case ('CART') only
!
INTEGER, SAVE :: NBUIL, NBUIH ! lowest and highest I indice values
- ! of the cartesian box
+ ! of the cartesian box in the physical domain
INTEGER, SAVE :: NBUJL, NBUJH ! lowest and highest J indice values
- ! of the cartesian box
+ ! of the cartesian box in the physical domain
LOGICAL, SAVE :: LBU_ICP ! switch for compression in I
! direction
LOGICAL, SAVE :: LBU_JCP ! switch for comppression in J
@@ -119,8 +214,8 @@ INTEGER, SAVE :: NBUMASK ! number of MASK zones for which
LOGICAL, SAVE, DIMENSION(:,:,:), & ! define the zone where the MASK
ALLOCATABLE :: LBU_MASK ! is True
!
-REAL, SAVE, DIMENSION(:,:,:,:), & ! surface for each mask at each
- ALLOCATABLE :: XBUSURF ! budget step
+INTEGER, SAVE, DIMENSION(:,:,:,:), & ! surface for each mask at each
+ ALLOCATABLE :: NBUSURF ! budget step
!
INTEGER, SAVE :: NBUTIME ! number of budget time periods
!
@@ -141,499 +236,116 @@ INTEGER, SAVE :: NBUJMAX ! second dimension of the budget
! tabular
INTEGER, SAVE :: NBUKMAX ! dimension along K of the budget
! tabular
-REAL, SAVE, DIMENSION(:,:,:,:), & ! budget arrays for RU, RV and
- ALLOCATABLE :: XBURU, XBURV, XBURW ! RW (wind components) respectively
-REAL, SAVE, DIMENSION(:,:,:,:), & ! budget arrays for RTH (potential
- ALLOCATABLE :: XBURTH, XBURTKE ! temperature) and RTKE (kinetic
- ! energy)
-REAL, SAVE, DIMENSION(:,:,:,:), & ! budget arrays for RRV (water vapor)
- ALLOCATABLE :: XBURRV, XBURRC ! and RRC (cloud water)
-REAL, SAVE, DIMENSION(:,:,:,:), & ! budget arrays for RRR (rain water)
- ALLOCATABLE :: XBURRR, XBURRI ! and RRI (ice)
-REAL, SAVE, DIMENSION(:,:,:,:), & ! budget arrays for RRS (snow)
- ALLOCATABLE :: XBURRS, XBURRG ! and RRG (graupel)
-REAL, SAVE, DIMENSION(:,:,:,:), & ! budget array for RRH (hail)
- ALLOCATABLE :: XBURRH !
-REAL, SAVE, DIMENSION(:,:,:,:,:), &
- ALLOCATABLE :: XBURSV ! Budget of the SVx
-REAL, SAVE, DIMENSION(:,:,:), & ! budget arrays for RHODJ at
- ALLOCATABLE :: XBURHODJ , & ! scalar localization
- XBURHODJU, & ! U localization
- XBURHODJV, & ! V localization
- XBURHODJW ! and W localization
!
! Allowed processes for the budget of the x scalar variables
! (transport part only)
!
-! For each budget, the switches values (from 0 to JPBUPROMAX) for budgets
+! For each budget, the switches values for budgets
! activation may be set by the user in a namelist. Their default value is 0.
! In the following declaration, the corresponding process names are given
! beside as comments.
!
! Allowed processes for the budget of RU (wind component along x)
!
-! Courant namelist: NAM_BURU
+! Current namelist: NAM_BU_RU
!
-LOGICAL, SAVE :: LBU_RU ! True when the budget of RU is performed
+LOGICAL, SAVE :: LBU_RU = .FALSE. ! True when the budget of RU is performed
!
-INTEGER, SAVE :: NASSEU ! time filter
-INTEGER, SAVE :: NNESTU ! Efffect of 2way nesting on U
-INTEGER, SAVE :: NADVU ! advection
-INTEGER, SAVE :: NFRCU ! forcing
-INTEGER, SAVE :: NNUDU ! nudging
-INTEGER, SAVE :: NCURVU ! curvature
-INTEGER, SAVE :: NCORU ! Coriolis terms
-INTEGER, SAVE :: NDIFU ! numerical diffusion
-INTEGER, SAVE :: NRELU ! relaxation
-INTEGER, SAVE :: NHTURBU ! horizontal TURBulence
-INTEGER, SAVE :: NVTURBU ! vertical turbulence
-INTEGER, SAVE :: NDRAGU ! vegetation drag
-INTEGER, SAVE :: NMAFLU ! mass flux
-INTEGER, SAVE :: NPRESU ! pressure term
-!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RU
+!
! Allowed processes for the budget of RV (wind component along y)
!
-! Courant namelist: NAM_BURV
-!
-LOGICAL, SAVE :: LBU_RV ! True when the budget of RV is performed
-!
-INTEGER, SAVE :: NASSEV ! time filter
-INTEGER, SAVE :: NNESTV ! Efffect of 2way nesting on V
-INTEGER, SAVE :: NADVV ! advection
-INTEGER, SAVE :: NFRCV ! forcing
-INTEGER, SAVE :: NNUDV ! nudging
-INTEGER, SAVE :: NCURVV ! curvature
-INTEGER, SAVE :: NCORV ! Coriolis terms
-INTEGER, SAVE :: NDIFV ! numerical diffusion
-INTEGER, SAVE :: NRELV ! relaxation
-INTEGER, SAVE :: NHTURBV ! horizontal turbulence
-INTEGER, SAVE :: NVTURBV ! vertical turbulence
-INTEGER, SAVE :: NDRAGV ! vegetation drag
-INTEGER, SAVE :: NMAFLV ! mass flux
-INTEGER, SAVE :: NPRESV ! pressure term
+! Current namelist: NAM_BU_RV
+!
+LOGICAL, SAVE :: LBU_RV = .FALSE. ! True when the budget of RV is performed
+!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RV
!
! Allowed processes for the budget of RW (wind vertical component)
!
-! Courant namelist: NAM_BURW
+! Current namelist: NAM_BU_RW
!
-LOGICAL, SAVE :: LBU_RW ! True when the budget of RW is performed
+LOGICAL, SAVE :: LBU_RW = .FALSE. ! True when the budget of RW is performed
!
-INTEGER, SAVE :: NASSEW ! time filter
-INTEGER, SAVE :: NNESTW ! Efffect of 2way nesting on W
-INTEGER, SAVE :: NADVW ! advection
-INTEGER, SAVE :: NFRCW ! forcing
-INTEGER, SAVE :: NNUDW ! nudging
-INTEGER, SAVE :: NCURVW ! curvature
-INTEGER, SAVE :: NCORW ! Coriolis terms
-INTEGER, SAVE :: NGRAVW ! gravity term
-INTEGER, SAVE :: NDIFW ! numerical diffusion
-INTEGER, SAVE :: NRELW ! relaxation
-INTEGER, SAVE :: NHTURBW ! horizontal turbulence
-INTEGER, SAVE :: NVTURBW ! vertical turbulence
-INTEGER, SAVE :: NPRESW ! pressure term
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RW
!
! Allowed processes for the budget of RTH (potential temperature)
!
-! Courant namelist: NAM_BURTH
-!
-LOGICAL, SAVE :: LBU_RTH ! True when the budget of RTH is performed
-!
-INTEGER, SAVE :: NASSETH ! time filter
-INTEGER, SAVE :: NNESTTH ! Efffect of 2way nesting on Th
-INTEGER, SAVE :: NADVTH ! Total advection for PPM
-INTEGER, SAVE :: NFRCTH ! forcing
-INTEGER, SAVE :: N2DADVTH ! 2d advecting forcing
-INTEGER, SAVE :: N2DRELTH ! 2d relaxation forcing
-INTEGER, SAVE :: NNUDTH ! nudging
-INTEGER, SAVE :: NPREFTH ! theta source term due to the reference pressure
- ! (Dyn. Sources) only present if KRR>0
-INTEGER, SAVE :: NDIFTH ! numerical diffusion
-INTEGER, SAVE :: NRELTH ! relaxation
-INTEGER, SAVE :: NRADTH ! RADiation
-INTEGER, SAVE :: NDCONVTH ! KAFR CONVection
-INTEGER, SAVE :: NMAFLTH ! Mass flux
-INTEGER, SAVE :: NHTURBTH ! horizontal turbulence
-INTEGER, SAVE :: NVTURBTH ! vertical turbulence
-INTEGER, SAVE :: NDISSHTH ! dissipative heating
-INTEGER, SAVE :: NNEGATH ! negative correction induced by hydrometeors
-INTEGER, SAVE :: NNETURTH ! negative correction induced by hydrometeors
-INTEGER, SAVE :: NNEADVTH ! negative correction induced by hydrometeors
-INTEGER, SAVE :: NNECONTH ! negative correction induced by hydrometeors
-INTEGER, SAVE :: NREVATH ! rain evaporation
-INTEGER, SAVE :: NCONDTH ! evaporation/condensation
-INTEGER, SAVE :: NHENUTH ! HEterogenous NUcleation ICE3
-INTEGER, SAVE :: NHONTH ! HOmogeneous Nucleation ICE3
-INTEGER, SAVE :: NSFRTH ! Spontaneous FReezing ICE3
-INTEGER, SAVE :: NDEPSTH ! DEPosition on Snow ICE3
-INTEGER, SAVE :: NDEPGTH ! DEPosition on Graupel ICE3
-INTEGER, SAVE :: NRIMTH ! RIMing of cloudwater ICE3
-INTEGER, SAVE :: NACCTH ! ACCretion of rainwater ICE3
-INTEGER, SAVE :: NCFRZTH ! Conversion FReeZing ICE3
-INTEGER, SAVE :: NWETGTH ! WET Growth of graupel ICE3
-INTEGER, SAVE :: NDRYGTH ! DRY Growth of graupel ICE3
-INTEGER, SAVE :: NGMLTTH ! Graupel MeLTing ICE3
-INTEGER, SAVE :: NIMLTTH ! Ice MeLTing ICE3
-INTEGER, SAVE :: NBERFITH ! BERgeron-FIndeisen gth. ICE3
-INTEGER, SAVE :: NCDEPITH ! Cond./DEPosition on ice ICE3
-INTEGER, SAVE :: NWETHTH ! wet growth of hail ICE4
-INTEGER, SAVE :: NDRYHTH ! dry growth of hail ICE4
-INTEGER, SAVE :: NHMLTTH ! melting of hail ICE4
-INTEGER, SAVE :: NADJUTH ! adjustement before rain_ice ICE3
-INTEGER, SAVE :: NCORRTH ! tendencies correction after ICE3
-INTEGER, SAVE :: NHINDTH ! Heterogeneous Nucleation by Deposition LIMA
-INTEGER, SAVE :: NHINCTH ! Heterogeneous Nucleation by Contact LIMA
-INTEGER, SAVE :: NHONHTH ! Haze Homogeneous Nucleation LIMA
-INTEGER, SAVE :: NHONCTH ! droplet homogeneous nucleation LIMA
-INTEGER, SAVE :: NHONRTH ! drop homogeneous nucleation LIMA
-INTEGER, SAVE :: NCEDSTH ! adjustment
-INTEGER, SAVE :: NSEDITH ! Temperature transport by hydrometeors sedimentation
+! Current namelist: NAM_BU_RTH
+!
+LOGICAL, SAVE :: LBU_RTH = .FALSE. ! True when the budget of RTH is performed
+!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RTH
!
! Allowed processes for the budget of RTKE (kinetic energy)
!
-! Courant namelist: NAM_BURTKE
+! Current namelist: NAM_BU_RTKE
!
-LOGICAL, SAVE :: LBU_RTKE ! True when the budget of RTKE is performed
-!
-INTEGER, SAVE :: NASSETKE ! time filter
-INTEGER, SAVE :: NADVTKE ! Total advection for PPM
-INTEGER, SAVE :: NFRCTKE ! forcing
-INTEGER, SAVE :: NDIFTKE ! numerical diffusion
-INTEGER, SAVE :: NRELTKE ! relaxation
-INTEGER, SAVE :: NDPTKE ! dynamic production of TKE
-INTEGER, SAVE :: NTPTKE ! thermal production of TKE
-INTEGER, SAVE :: NDRAGTKE ! vegetation drag
-INTEGER, SAVE :: NDISSTKE ! dissipation of TKE
-INTEGER, SAVE :: NTRTKE ! turbulent transport of TKE
+LOGICAL, SAVE :: LBU_RTKE = .FALSE. ! True when the budget of RTKE is performed
!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RTKE
!
! Allowed processes for the budget of moist variable RRV (water vapor)
!
-! Courant namelist: NAM_BURRV
-!
-LOGICAL, SAVE :: LBU_RRV ! true when the budget of RRV is performed
-!
-INTEGER, SAVE :: NASSERV ! time filter
-INTEGER, SAVE :: NNESTRV ! Effect of 2way nesting on Rv
-INTEGER, SAVE :: NADVRV ! Total advection for PPM
-INTEGER, SAVE :: NFRCRV ! forcing
-INTEGER, SAVE :: N2DADVRV ! 2d advecting forcing
-INTEGER, SAVE :: N2DRELRV ! 2d relaxation forcing
-INTEGER, SAVE :: NNUDRV ! nudging
-INTEGER, SAVE :: NDIFRV ! numerical diffusion
-INTEGER, SAVE :: NRELRV ! relaxation
-INTEGER, SAVE :: NDCONVRV ! KAFR CONVection
-INTEGER, SAVE :: NMAFLRV ! Mass flux
-INTEGER, SAVE :: NHTURBRV ! horizontal turbulence
-INTEGER, SAVE :: NVTURBRV ! vertical turbulence
-INTEGER, SAVE :: NNEGARV ! negative correction
-INTEGER, SAVE :: NNETURRV ! negative correction
-INTEGER, SAVE :: NNECONRV ! negative correction
-INTEGER, SAVE :: NNEADVRV ! negative correction
-INTEGER, SAVE :: NREVARV ! rain evaporation
-INTEGER, SAVE :: NCONDRV ! evaporation/condensation
-INTEGER, SAVE :: NHENURV ! HEterogenous NUcleation ICE3
-INTEGER, SAVE :: NDEPSRV ! DEPosition on Snow ICE3
-INTEGER, SAVE :: NDEPGRV ! DEPosition on Graupel ICE3
-INTEGER, SAVE :: NCDEPIRV ! Cond./DEPosition on ice ICE3
-INTEGER, SAVE :: NADJURV ! adjustement before rain_ice ICE3
-INTEGER, SAVE :: NCORRRV ! tendencies correction after ICE3
-INTEGER, SAVE :: NHINDRV ! Heterogeneous Nucleation by Deposition LIMA
-INTEGER, SAVE :: NHONHRV ! Haze Homogeneous Nucleation LIMA
-INTEGER, SAVE :: NCEDSRV ! adjustement
+! Current namelist: NAM_BU_RRV
+!
+LOGICAL, SAVE :: LBU_RRV = .FALSE. ! true when the budget of RRV is performed
+!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RRV
!
! Allowed processes for the budget of moist variable RRC (cloud water)
!
-! Courant namelist: NAM_BURRC
-!
-LOGICAL, SAVE :: LBU_RRC ! True when the budget of RRC is performed
-!
-INTEGER, SAVE :: NASSERC ! time filter
-INTEGER, SAVE :: NNESTRC ! Efffect of 2way nesting on Rc
-INTEGER, SAVE :: NADVRC ! Total advection for PPM
-INTEGER, SAVE :: NFRCRC ! forcing
-INTEGER, SAVE :: NDIFRC ! numerical diffusion
-INTEGER, SAVE :: NRELRC ! relaxation
-INTEGER, SAVE :: NDCONVRC ! Deep CONVection
-INTEGER, SAVE :: NHTURBRC ! horizontal turbulence
-INTEGER, SAVE :: NVTURBRC ! vertical turbulence
-INTEGER, SAVE :: NNEGARC ! negative correction
-INTEGER, SAVE :: NNETURRC ! negative correction
-INTEGER, SAVE :: NNECONRC ! negative correction
-INTEGER, SAVE :: NNEADVRC ! negative correction
-INTEGER, SAVE :: NACCRRC ! accretion
-INTEGER, SAVE :: NAUTORC ! autoconversion
-INTEGER, SAVE :: NCONDRC ! evaporation/condensation
-INTEGER, SAVE :: NHONRC ! HOmogeneous Nucleation ICE3
-INTEGER, SAVE :: NRIMRC ! RIMing of cloudwater ICE3
-INTEGER, SAVE :: NCMELRC ! collection by snow and conversion into rain with T>XTT ICE3
-INTEGER, SAVE :: NWETGRC ! WET Growth of graupel ICE3
-INTEGER, SAVE :: NDRYGRC ! DRY Growth of graupel ICE3
-INTEGER, SAVE :: NIMLTRC ! Ice MeLTing ICE3
-INTEGER, SAVE :: NBERFIRC ! BERgeron-FIndeisen gth. ICE3
-INTEGER, SAVE :: NCDEPIRC ! Cond./DEPosition on ice ICE3
-INTEGER, SAVE :: NHENURC ! CCN Activation C2R2
-INTEGER, SAVE :: NSEDIRC ! sedimentation C2R2
-INTEGER, SAVE :: NDEPORC ! ground deposition
-INTEGER, SAVE :: NDEPOTRRC ! deposition on tree
-INTEGER, SAVE :: NWETHRC ! wet growth of hail
-INTEGER, SAVE :: NDRYHRC ! dry growth of hail ICE4
-INTEGER, SAVE :: NADJURC ! adjustement before rain_ice ICE3
-INTEGER, SAVE :: NHINCRC ! Heterogeneous Nucleation by Contact LIMA
-INTEGER, SAVE :: NHONCRC ! droplet homogeneous nucleation LIMA
-INTEGER, SAVE :: NCEDSRC ! adjustment LIMA
-INTEGER, SAVE :: NREVARC ! evaporation of rain drops
-INTEGER, SAVE :: NCORRRC ! rain <-> cloud transfer at the beginning of LIMA
-INTEGER, SAVE :: NR2C1RC ! rain -> cloud change after sedimentation in LIMA
-INTEGER, SAVE :: NCVRCRC ! rain -> cloud change after other microphysical processes in LIMA
+! Current namelist: NAM_BU_RRC
+!
+LOGICAL, SAVE :: LBU_RRC = .FALSE. ! True when the budget of RRC is performed
+!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RRC
!
! Allowed processes for the budget of moist variable RRR (rain water)
!
-! Courant namelist: NAM_BURRR
-!
-LOGICAL, SAVE :: LBU_RRR ! True when the budget of RRR is performed
-!
-INTEGER, SAVE :: NASSERR ! time filter
-INTEGER, SAVE :: NNESTRR ! Efffect of 2way nesting on Rr
-INTEGER, SAVE :: NADVRR ! Total advection for PPM
-INTEGER, SAVE :: NFRCRR ! forcing
-INTEGER, SAVE :: NDIFRR ! numerical diffusion
-INTEGER, SAVE :: NRELRR ! relaxation
-INTEGER, SAVE :: NNEGARR ! negative correction
-INTEGER, SAVE :: NACCRRR ! accretion
-INTEGER, SAVE :: NAUTORR ! autoconversion
-INTEGER, SAVE :: NREVARR ! rain evaporation
-INTEGER, SAVE :: NSEDIRR ! sedimentation
-INTEGER, SAVE :: NSFRRR ! Spontaneous FReezing ICE3
-INTEGER, SAVE :: NACCRR ! ACCretion of rainwater ICE3
-INTEGER, SAVE :: NCMELRR ! collection of droplets by snow and conversion into rain with T>XTT ICE3
-INTEGER, SAVE :: NCFRZRR ! Conversion FReeZing ICE3
-INTEGER, SAVE :: NWETGRR ! WET Growth of graupel ICE3
-INTEGER, SAVE :: NDRYGRR ! DRY Growth of graupel ICE3
-INTEGER, SAVE :: NGMLTRR ! Graupel MeLTing ICE3
-INTEGER, SAVE :: NWETHRR ! wet growth of hail ICE4
-INTEGER, SAVE :: NDRYHRR ! dry growth of hail ICE4
-INTEGER, SAVE :: NHMLTRR ! melting of hail ICE4
-INTEGER, SAVE :: NCORRRR ! tendencies correction after ICE3
-INTEGER, SAVE :: NHONRRR ! drop homogeneous nucleation LIMA
-INTEGER, SAVE :: NR2C1RR ! rain -> cloud change after sedimentation in LIMA
-INTEGER, SAVE :: NCVRCRR ! rain -> cloud change after other microphysical processes in LIMA
+! Current namelist: NAM_BU_RRR
+!
+LOGICAL, SAVE :: LBU_RRR = .FALSE. ! True when the budget of RRR is performed
+!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RRR
!
! Allowed processes for the budget of moist variable RRI (ice)
!
-! Courant namelist: NAM_BURRI
-!
-LOGICAL, SAVE :: LBU_RRI ! True when the budget of RRI is performed
-!
-INTEGER, SAVE :: NASSERI ! time filter
-INTEGER, SAVE :: NNESTRI ! Efffect of 2way nesting on Ri
-INTEGER, SAVE :: NADVRI ! Total advection for PPM
-INTEGER, SAVE :: NFRCRI ! forcing
-INTEGER, SAVE :: NDIFRI ! numerical diffusion
-INTEGER, SAVE :: NRELRI ! relaxation
-INTEGER, SAVE :: NDCONVRI ! Deep CONVection
-INTEGER, SAVE :: NHTURBRI ! horizontal turbulence
-INTEGER, SAVE :: NVTURBRI ! vertical turbulence
-INTEGER, SAVE :: NNEGARI ! negative correction
-INTEGER, SAVE :: NSEDIRI ! SEDImentation ICE3
-INTEGER, SAVE :: NHENURI ! HEterogenous NUcleation ICE3
-INTEGER, SAVE :: NHONRI ! HOmogeneous Nucleation ICE3
-INTEGER, SAVE :: NAGGSRI ! AGGregation of snow ICE3
-INTEGER, SAVE :: NAUTSRI ! AUToconversion of ice ICE3
-INTEGER, SAVE :: NCFRZRI ! Conversion FReeZing ICE3
-INTEGER, SAVE :: NWETGRI ! WET Growth of graupel ICE3
-INTEGER, SAVE :: NDRYGRI ! DRY Growth of graupel ICE3
-INTEGER, SAVE :: NIMLTRI ! Ice MeLTing ICE3
-INTEGER, SAVE :: NBERFIRI ! BERgeron-FIndeisen gth. ICE3
-INTEGER, SAVE :: NCDEPIRI ! Cond./DEPosition on ice ICE3
-INTEGER, SAVE :: NWETHRI ! wet growth of hail ICE4
-INTEGER, SAVE :: NDRYHRI ! dry growth of hail ICE4
-INTEGER, SAVE :: NADJURI ! adjustement before rain_ice ICE3
-INTEGER, SAVE :: NHINDRI ! heterogeneous nucleation by deposition LIMA
-INTEGER, SAVE :: NHINCRI ! heterogeneous nucleation by contact LIMA
-INTEGER, SAVE :: NHONHRI ! haze homogeneous nucleation source LIMA
-INTEGER, SAVE :: NHONCRI ! droplet homogeneous nucleation LIMA
-INTEGER, SAVE :: NCNVIRI ! Conversion of snow to r_i LIMA
-INTEGER, SAVE :: NCNVSRI ! Conversion of pristine ice to r_s LIMA
-INTEGER, SAVE :: NHMSRI ! Hallett-Mossop ice multiplication process due to snow riming LIMA
-INTEGER, SAVE :: NHMGRI ! Hallett-Mossop ice multiplication process due to graupel riming LIMA
-INTEGER, SAVE :: NCEDSRI ! adjustement LIMA
-INTEGER, SAVE :: NCORRRI ! ice <-> snow transfer at the beginning of LIMA
+! Current namelist: NAM_BU_RRI
+!
+LOGICAL, SAVE :: LBU_RRI = .FALSE. ! True when the budget of RRI is performed
+!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RRI
!
! Allowed processes for the budget of moist variable RRS (snow)
!
-! Courant namelist: NAM_BURRS
-!
-LOGICAL, SAVE :: LBU_RRS ! True when the budget of RRS is performed
-!
-INTEGER, SAVE :: NASSERS ! time filter
-INTEGER, SAVE :: NNESTRS ! Efffect of 2way nesting on Rs
-INTEGER, SAVE :: NADVRS ! Total advection for PPM
-INTEGER, SAVE :: NFRCRS ! forcing
-INTEGER, SAVE :: NDIFRS ! numerical diffusion
-INTEGER, SAVE :: NRELRS ! relaxation
-INTEGER, SAVE :: NNEGARS ! negative correction
-INTEGER, SAVE :: NSEDIRS ! SEDImentation ICE3
-INTEGER, SAVE :: NDEPSRS ! DEPosition on Snow ICE3
-INTEGER, SAVE :: NAGGSRS ! AGGregation of snow ICE3
-INTEGER, SAVE :: NAUTSRS ! AUToconversion of ice ICE3
-INTEGER, SAVE :: NRIMRS ! RIMing of cloudwater ICE3
-INTEGER, SAVE :: NACCRS ! ACCretion of rainwater ICE3
-INTEGER, SAVE :: NCMELRS ! Conversion MeLTing ICE3
-INTEGER, SAVE :: NWETGRS ! WET Growth of graupel ICE3
-INTEGER, SAVE :: NDRYGRS ! DRY Growth of graupel ICE3
-INTEGER, SAVE :: NWETHRS ! wet growth of hail ICE4
-INTEGER, SAVE :: NDRYHRS ! dry growth of hail ICE4
-INTEGER, SAVE :: NCNVIRS ! Conversion of snow to r_i LIMA
-INTEGER, SAVE :: NCNVSRS ! Conversion of pristine ice to r_s LIMA
-INTEGER, SAVE :: NHMSRS ! Hallett-Mossop ice multiplication process due to snow riming LIMA
-INTEGER, SAVE :: NCORRRS ! ice <-> snow transfer at the beginning of LIMA
+! Current namelist: NAM_BU_RRS
+!
+LOGICAL, SAVE :: LBU_RRS = .FALSE. ! True when the budget of RRS is performed
+!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RRS
!
! Allowed processes for the budget of moist variable RRG (graupel)
!
-! Courant namelist: NAM_BURRG
-!
-LOGICAL, SAVE :: LBU_RRG ! True when the budget of RRG is performed
-!
-INTEGER, SAVE :: NASSERG ! time filter
-INTEGER, SAVE :: NNESTRG ! Efffect of 2way nesting on Rg
-INTEGER, SAVE :: NADVRG ! Total advection for PPM
-INTEGER, SAVE :: NFRCRG ! forcing
-INTEGER, SAVE :: NDIFRG ! numerical diffusion
-INTEGER, SAVE :: NRELRG ! relaxation
-INTEGER, SAVE :: NNEGARG ! negative correction
-INTEGER, SAVE :: NSEDIRG ! SEDImentation ICE3
-INTEGER, SAVE :: NSFRRG ! Spontaneous FReezing ICE3
-INTEGER, SAVE :: NDEPGRG ! DEPosition on Snow ICE3
-INTEGER, SAVE :: NRIMRG ! RIMing of cloudwater ICE3
-INTEGER, SAVE :: NACCRG ! ACCretion of rainwater ICE3
-INTEGER, SAVE :: NCMELRG ! Conversion MeLTing ICE3
-INTEGER, SAVE :: NCFRZRG ! Conversion FReeZing ICE3
-INTEGER, SAVE :: NWETGRG ! WET Growth of graupel ICE3
-INTEGER, SAVE :: NDRYGRG ! DRY Growth of graupel ICE3
-INTEGER, SAVE :: NGMLTRG ! Graupel MeLTing ICE3
-INTEGER, SAVE :: NWETHRG ! wet growth of hail ICE4
-INTEGER, SAVE :: NDRYHRG ! dry growth of hail ICE4
-INTEGER, SAVE :: NCORRRG ! tendencies correction after ICE3
-INTEGER, SAVE :: NHGCVRG ! Hail to Graupel ConVersion ICE4
-INTEGER, SAVE :: NGHCVRG ! Graupel to Hail ConVersion ICE4
-INTEGER, SAVE :: NHONRRG ! drop homogeneous nucleation LIMA
-INTEGER, SAVE :: NHMGRG ! Hallett-Mossop ice multiplication process due to graupel riming
-INTEGER, SAVE :: NCOHGRG ! conversion of hail to graupel
+! Current namelist: NAM_BU_RRG
+!
+LOGICAL, SAVE :: LBU_RRG = .FALSE. ! True when the budget of RRG is performed
+!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RRG
!
! Allowed processes for the budget of moist variable RRH (hail)
!
-! Courant namelist: NAM_BURRH
-!
-LOGICAL, SAVE :: LBU_RRH ! True when the budget of RRH is performed
-!
-INTEGER, SAVE :: NASSERH ! time filter
-INTEGER, SAVE :: NNESTRH ! Efffect of 2way nesting on Rh
-INTEGER, SAVE :: NADVRH ! Total advection for PPM
-INTEGER, SAVE :: NFRCRH ! forcing
-INTEGER, SAVE :: NDIFRH ! numerical diffusion
-INTEGER, SAVE :: NRELRH ! relaxation
-INTEGER, SAVE :: NNEGARH ! negative correction
-INTEGER, SAVE :: NSEDIRH ! sedimentation
-INTEGER, SAVE :: NWETGRH ! wet growth of graupel
-INTEGER, SAVE :: NWETHRH ! wet growth of hail
-INTEGER, SAVE :: NCOHGRH ! reconversion from hail to graupel LIMA
-INTEGER, SAVE :: NDRYHRH ! dry growth of hail ICE4
-INTEGER, SAVE :: NHMLTRH ! melting
-INTEGER, SAVE :: NCORRRH ! tendencies correction after ICE3
-INTEGER, SAVE :: NHGCVRH ! Hail to Graupel ConVersion ICE4
-INTEGER, SAVE :: NGHCVRH ! Graupel to Hail ConVersion ICE4
-!
-! Courant namelist: NAM_BURSV
-!
-LOGICAL, SAVE :: LBU_RSV ! True when the budget of RSVx is performed
-!
-INTEGER, SAVE :: NASSESV ! Asselin-Robert time filter
-INTEGER, SAVE :: NNESTSV ! Efffect of 2way nesting on Sv
-INTEGER, SAVE :: NADVSV ! Total advection for PPM
-INTEGER, SAVE :: NFRCSV ! forcing
-INTEGER, SAVE :: NDIFSV ! numerical diffusion
-INTEGER, SAVE :: NRELSV ! relaxation
-INTEGER, SAVE :: NDCONVSV ! Deep CONVection
-INTEGER, SAVE :: NMAFLSV ! mass flux
-INTEGER, SAVE :: NDEPOTRSV ! deposition on tree
-INTEGER, SAVE :: NHTURBSV ! horizontal turbulence
-INTEGER, SAVE :: NVTURBSV ! vertical turbulence
-INTEGER, SAVE :: NCHEMSV ! chemistry activity
-!
-INTEGER, SAVE :: NNEGASV
-!
-! Allowed processes for the budget of electric charge carried by water vapor
-INTEGER, SAVE :: NDEPSQV
-INTEGER, SAVE :: NDEPGQV
-INTEGER, SAVE :: NREVAQV
-INTEGER, SAVE :: NDEPIQV
-INTEGER, SAVE :: NNEUTQV
-!
-! Allowed processes for the budget of electric charge carried by cloud droplets
-INTEGER, SAVE :: NAUTOQC
-INTEGER, SAVE :: NACCRQC
-INTEGER, SAVE :: NRIMQC
-INTEGER, SAVE :: NWETGQC
-INTEGER, SAVE :: NDRYGQC
-INTEGER, SAVE :: NIMLTQC
-INTEGER, SAVE :: NBERFIQC
-INTEGER, SAVE :: NDEPIQC
-INTEGER, SAVE :: NINDQC ! inductive process
-INTEGER, SAVE :: NSEDIQC
-INTEGER, SAVE :: NNEUTQC
-!
-! Allowed processes for the budget of electric charge carried by rain drops
-INTEGER, SAVE :: NAUTOQR
-INTEGER, SAVE :: NACCRQR
-INTEGER, SAVE :: NREVAQR
-INTEGER, SAVE :: NACCQR
-INTEGER, SAVE :: NCFRZQR
-INTEGER, SAVE :: NWETGQR
-INTEGER, SAVE :: NDRYGQR
-INTEGER, SAVE :: NGMLTQR
-INTEGER, SAVE :: NSEDIQR
-INTEGER, SAVE :: NNEUTQR
-!
-! Allowed processes for the budget of electric charge carried by ice crystals
-INTEGER, SAVE :: NAGGSQI
-INTEGER, SAVE :: NAUTSQI
-INTEGER, SAVE :: NCFRZQI
-INTEGER, SAVE :: NWETGQI
-INTEGER, SAVE :: NDRYGQI
-INTEGER, SAVE :: NIMLTQI
-INTEGER, SAVE :: NBERFIQI
-INTEGER, SAVE :: NDEPIQI
-INTEGER, SAVE :: NNIISQI ! non-inductive I-S
-INTEGER, SAVE :: NSEDIQI
-INTEGER, SAVE :: NNEUTQI
-!
-! Allowed processes for the budget of electric charge carried by snow
-INTEGER, SAVE :: NDEPSQS
-INTEGER, SAVE :: NAGGSQS
-INTEGER, SAVE :: NAUTSQS
-INTEGER, SAVE :: NRIMQS
-INTEGER, SAVE :: NACCQS
-INTEGER, SAVE :: NCMELQS
-INTEGER, SAVE :: NWETGQS
-INTEGER, SAVE :: NDRYGQS
-INTEGER, SAVE :: NNIISQS ! non-inductive I-S
-INTEGER, SAVE :: NSEDIQS
-INTEGER, SAVE :: NNEUTQS
-!
-! Allowed processes for the budget of electric charge carried by graupel
-INTEGER, SAVE :: NDEPGQG
-INTEGER, SAVE :: NRIMQG
-INTEGER, SAVE :: NACCQG
-INTEGER, SAVE :: NCMELQG
-INTEGER, SAVE :: NCFRZQG
-INTEGER, SAVE :: NWETGQG
-INTEGER, SAVE :: NDRYGQG
-INTEGER, SAVE :: NGMLTQG
-INTEGER, SAVE :: NINDQG ! inductive process
-INTEGER, SAVE :: NSEDIQG
-INTEGER, SAVE :: NNEUTQG
-!
-! must add processes for electric charge carried by hail
+! Current namelist: NAM_BU_RRH
+!
+LOGICAL, SAVE :: LBU_RRH = .FALSE. ! True when the budget of RRH is performed
+!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RRH
+!
+! Current namelist: NAM_BU_RSV
+!
+LOGICAL, SAVE :: LBU_RSV = .FALSE. ! True when the budget of RSVx is performed
+!
+CHARACTER(LEN=NBULISTMAXLEN), DIMENSION(:), ALLOCATABLE :: CBULIST_RSV
!
!
REAL :: XTIME_BU ! budget time in this time-step
diff --git a/src/MNH/modd_ch_aerosol.f90 b/src/MNH/modd_ch_aerosol.f90
index 4eb7fed5cc8a2c7f1fbe9a6820d1206842dfa513..defa8f71ac910543930848a11f9c6d01494b0a62 100644
--- a/src/MNH/modd_ch_aerosol.f90
+++ b/src/MNH/modd_ch_aerosol.f90
@@ -1,4 +1,4 @@
-!ORILAM_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC Copyright 2006-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.
@@ -30,12 +30,12 @@
!! -------------
!! (30-01-01) P.Tulet (LA) * modifications for secondary biogenics aerosols
!! (25-08-16) M.Leriche (LA) * NM6_AER is now in SAVE and assign in ini_nsv
-! P. Wautelet: 07/06/2019: allocate weights only when needed!!
-!
+! P. Wautelet 07/06/2019: allocate weights only when needed
+! P. Wautelet 09/03/2021: simplify allocation of scalar variable names
!!--------------------------------------------------------------------
!! DECLARATIONS
!! ------------
-USE MODD_PARAMETERS, ONLY: JPMODELMAX
+USE MODD_PARAMETERS, ONLY: JPMODELMAX, JPSVNAMELGTMAX
!
IMPLICIT NONE
!
@@ -46,15 +46,15 @@ LOGICAL :: LINITPM = .TRUE. ! switch to initialize BC
LOGICAL :: LAERINIT = .FALSE. ! switch to initialize aerosols
LOGICAL,DIMENSION(JPMODELMAX) :: LDEPOS_AER = .FALSE. ! switch to AER wet depositon
-
-CHARACTER(LEN=9),DIMENSION(:),ALLOCATABLE :: CDEAERNAMES
-CHARACTER(LEN=9),DIMENSION(4), PARAMETER :: YPDEAER_INI = &
- (/'DEAERM31C','DEAERM32C' &
- ,'DEAERM31R','DEAERM32R' /)
+
! and OC from CO concentration (real_case)
INTEGER, PARAMETER :: JPMODE=2 ! number of modes
INTEGER, PARAMETER :: JPIN=JPMODE*3 ! number of differential equations
INTEGER, SAVE, DIMENSION(JPMODE) :: NM0,NM3,NM6 ! index of the moments in arrays
+
+CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(JPMODE*2), PARAMETER :: CDEAERNAMES = &
+ (/'DEAERM31C','DEAERM32C' &
+ ,'DEAERM31R','DEAERM32R' /)
!
!* indices of Aerosol chemical parameters
!
diff --git a/src/MNH/modd_cst.f90 b/src/MNH/modd_cst.f90
index 0becaf15d7402f8c460d16f69a05b4630bfb6301..73607888ccbf0791641a83952225dd0a2a76e9ce 100644
--- a/src/MNH/modd_cst.f90
+++ b/src/MNH/modd_cst.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modd 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###############
MODULE MODD_CST
! ###############
@@ -42,6 +37,7 @@
!! C. Mari 31/10/00 add NDAYSEC
!! V. Masson 01/03/03 add conductivity of ice
!! J.Escobar : 10/2017 : for real*4 , add XMNH_HUGE_12_LOG
+!! J.L. Redelsperger 03/2021 add constants for ocean penetrating solar
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -63,11 +59,14 @@ REAL,SAVE :: XRADIUS,XOMEGA ! Earth radius, earth rotation
REAL,SAVE :: XG ! Gravity constant
!
REAL,SAVE :: XP00 ! Reference pressure
+REAL,SAVE :: XP00OCEAN ! Reference pressure for ocean model
+REAL,SAVE :: XRH00OCEAN ! Reference density for ocean model
!
REAL,SAVE :: XSTEFAN,XI0 ! Stefan-Boltzman constant, solar constant
!
REAL,SAVE :: XMD,XMV ! Molar mass of dry air and molar mass of vapor
REAL,SAVE :: XRD,XRV ! Gaz constant for dry air, gaz constant for vapor
+REAL,SAVE :: XEPSILO ! XMV/XMD
REAL,SAVE :: XCPD,XCPV ! Cpd (dry air), Cpv (vapor)
REAL,SAVE :: XRHOLW ! Volumic mass of liquid water
REAL,SAVE :: XCL,XCI ! Cl (liquid), Ci (ice)
@@ -82,8 +81,19 @@ REAL,SAVE :: XALPW,XBETAW,XGAMW ! Constants for saturation vapor
REAL,SAVE :: XALPI,XBETAI,XGAMI ! Constants for saturation vapor
! pressure function over solid ice
REAL,SAVE :: XCONDI ! thermal conductivity of ice (W m-1 K-1)
-REAL, SAVE :: XTH00 ! reference value for the potential
- ! temperature
+REAL,SAVE :: XALPHAOC ! thermal expansion coefficient for ocean (K-1)
+REAL,SAVE :: XBETAOC ! Haline contraction coeff for ocean (S-1)
+REAL,SAVE :: XTH00 ! reference value for the potential temperature
+REAL,SAVE :: XTH00OCEAN ! Ref value for pot temp in ocean model
+REAL,SAVE :: XSA00OCEAN ! Ref value for SAlinity in ocean model
+REAL,SAVE :: XROC=0.69! 3 coeffs for SW penetration in Ocean (Hoecker et al)
+REAL,SAVE :: XD1=1.1
+REAL,SAVE :: XD2=23.
+! Values used in SURFEX CMO
+!REAL,SAVE :: XROC=0.58
+!REAL,SAVE :: XD1=0.35
+!REAL,SAVE :: XD2=23.
+
REAL,SAVE :: XRHOLI ! Volumic mass of liquid water
!
INTEGER, SAVE :: NDAYSEC ! Number of seconds in a day
diff --git a/src/MNH/modd_dragbldgn.f90 b/src/MNH/modd_dragbldgn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f89fc0d09d34143191714cca3d89bbf9a55ab580
--- /dev/null
+++ b/src/MNH/modd_dragbldgn.f90
@@ -0,0 +1,54 @@
+!MNH_LIC Copyright 2019-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_DRAGBLDG_n
+!! #####################
+!!
+!!*** *MODD_DRAGBLDG*
+!!
+!! PURPOSE
+!! -------
+! Declaration to take into account building drag in Meso-NH instead of SURFEX.
+!!
+!!** AUTHOR
+!! ------
+!! R.Schoetter *CNRM*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/2019
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+!
+IMPLICIT NONE
+!
+TYPE DRAGBLDG_t
+ !
+ LOGICAL :: LDRAGBLDG ! flag used to take into account building drag in
+ ! ! the atmospheric model instead of SURFEX.
+ !
+END TYPE DRAGBLDG_t
+!
+TYPE(DRAGBLDG_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: DRAGBLDG_MODEL
+!
+LOGICAL, POINTER :: LDRAGBLDG=>NULL()
+!
+CONTAINS
+!
+SUBROUTINE DRAGBLDG_GOTO_MODEL(KFROM, KTO)
+ !
+ INTEGER, INTENT(IN) :: KFROM, KTO
+ !
+ LDRAGBLDG=>DRAGBLDG_MODEL(KTO)%LDRAGBLDG
+ !
+END SUBROUTINE DRAGBLDG_GOTO_MODEL
+!
+END MODULE MODD_DRAGBLDG_n
diff --git a/src/MNH/modd_dragtree.f90 b/src/MNH/modd_dragtree.f90
deleted file mode 100644
index 7390bf68283e54df8e4086a89c8d7953616aa8c4..0000000000000000000000000000000000000000
--- a/src/MNH/modd_dragtree.f90
+++ /dev/null
@@ -1,36 +0,0 @@
-!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 MODD_DRAGTREE
-!! #####################
-!!
-!!*** *MODD_DRAGTREE*
-!!
-!! PURPOSE
-!! -------
-! Declaration to take into account tree drag in Meso-NH
-! instead of SURFEX.
-!!
-!!** AUTHOR
-!! ------
-!! C.Lac *CNRM*
-!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/06/11
-!! 06/16 (C.Lac) Add droplet deposition
-!-----------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! -----------------
-IMPLICIT NONE
-LOGICAL :: LDRAGTREE ! flag used to take into account tree drag in
-! ! the atmospheric model instead of SURFEX.
-LOGICAL :: LDEPOTREE ! flag for droplet deposition on trees
-!
-REAL :: XVDEPOTREE ! Droplet deposition velocity
-!
-END MODULE MODD_DRAGTREE
diff --git a/src/MNH/modd_dragtreen.f90 b/src/MNH/modd_dragtreen.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0ed016777983a5fcc69e029270e2c41838aba595
--- /dev/null
+++ b/src/MNH/modd_dragtreen.f90
@@ -0,0 +1,65 @@
+!MNH_LIC Copyright 2011-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_DRAGTREE_n
+!! #####################
+!!
+!!*** *MODD_DRAGTREE*
+!!
+!! PURPOSE
+!! -------
+! Declaration to take into account tree drag in Meso-NH
+! instead of SURFEX.
+!!
+!!** AUTHOR
+!! ------
+!! C.Lac *CNRM*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 30/06/11
+!! 06/16 (C.Lac) Add droplet deposition
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+!
+IMPLICIT NONE
+!
+TYPE DRAGTREE_t
+ !
+ LOGICAL :: LDRAGTREE ! flag used to take into account tree drag in
+ ! ! the atmospheric model instead of SURFEX.
+ LOGICAL :: LDEPOTREE ! flag for droplet deposition on trees
+ !
+ REAL :: XVDEPOTREE ! Droplet deposition velocity
+ !
+END TYPE DRAGTREE_t
+!
+TYPE(DRAGTREE_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: DRAGTREE_MODEL
+!
+LOGICAL,POINTER :: LDRAGTREE=>NULL()
+LOGICAL,POINTER :: LDEPOTREE=>NULL()
+REAL ,POINTER :: XVDEPOTREE=>NULL()
+!
+CONTAINS
+!
+SUBROUTINE DRAGTREE_GOTO_MODEL(KFROM, KTO)
+ !
+ INTEGER, INTENT(IN) :: KFROM, KTO
+ !
+ LDRAGTREE=>DRAGTREE_MODEL(KTO)%LDRAGTREE
+ LDEPOTREE=>DRAGTREE_MODEL(KTO)%LDEPOTREE
+ XVDEPOTREE=>DRAGTREE_MODEL(KTO)%XVDEPOTREE
+ !
+END SUBROUTINE DRAGTREE_GOTO_MODEL
+!
+END MODULE MODD_DRAGTREE_n
diff --git a/src/MNH/modd_dynn.f90 b/src/MNH/modd_dynn.f90
index c3b64335c44521991cc06f96a9825de59183ca7c..bf719ed52d8d3120df46e26c4f15b74b4d26237e 100644
--- a/src/MNH/modd_dynn.f90
+++ b/src/MNH/modd_dynn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! #################
@@ -43,6 +43,7 @@
!! Modification 01/2016 (JP Pinty) Add LIMA
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Modification 07/2017 (V. Vionnet) Add blowing snow variable
+!! Modification 03/2021 (JL Redelsperger) Add logical LOCEAN
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -55,6 +56,7 @@ TYPE DYN_t
!
INTEGER :: NSTOP ! Number of time step
REAL :: XTSTEP ! Time step
+ LOGICAL :: LOCEAN
!
!++++++++++++++++++++++++++++++++++
!PART USED BY THE PRESSURE SOLVER
@@ -194,6 +196,7 @@ CHARACTER(LEN=5), POINTER :: CPRESOPT=>NULL()
INTEGER, POINTER :: NITR=>NULL()
LOGICAL, POINTER :: LITRADJ=>NULL()
LOGICAL, POINTER :: LRES=>NULL()
+LOGICAL, POINTER :: LOCEAN=>NULL()
REAL, POINTER :: XRES=>NULL()
REAL, POINTER :: XRELAX=>NULL()
REAL, POINTER :: XDXHATM=>NULL()
@@ -297,6 +300,7 @@ CPRESOPT=>DYN_MODEL(KTO)%CPRESOPT
NITR=>DYN_MODEL(KTO)%NITR
LITRADJ=>DYN_MODEL(KTO)%LITRADJ
LRES=>DYN_MODEL(KTO)%LRES
+LOCEAN=>DYN_MODEL(KTO)%LOCEAN
XRES=>DYN_MODEL(KTO)%XRES
XRELAX=>DYN_MODEL(KTO)%XRELAX
XDXHATM=>DYN_MODEL(KTO)%XDXHATM
diff --git a/src/MNH/modd_elec_descr.f90 b/src/MNH/modd_elec_descr.f90
index 649d0dc14f76786b4907e86980553036e4456d12..82d346588cb8f8c435011290facd2b8c667f311f 100644
--- a/src/MNH/modd_elec_descr.f90
+++ b/src/MNH/modd_elec_descr.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 modd 2006/06/27 13:57:12
-!-----------------------------------------------------------------
! #######################
MODULE MODD_ELEC_DESCR
! #######################
@@ -42,6 +37,8 @@
!* 0. DECLARATIONS
! ------------
!
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
+
IMPLICIT NONE
!
! Namelist
@@ -161,7 +158,7 @@ INTEGER :: NNB_CG ! Nb of CG flashes
INTEGER :: NNB_CG_POS ! Nb of positive CG flashes
REAL :: XALT_CG ! Altitude (m) at which CG are detected
!
-CHARACTER(LEN=10), DIMENSION(8) &
+CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(8) &
:: CELECNAMES=(/'QNIONP','QCELEC','QRELEC','QIELEC','QSELEC', &
'QGELEC','QHELEC','QNIONN'/)
! QNIONP (QNIONN): Positive (Negative) ion concentration
diff --git a/src/MNH/modd_eol_adnr.f90 b/src/MNH/modd_eol_adnr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d0aa66e3efa2cc0de33cfe908e086d2620e982bf
--- /dev/null
+++ b/src/MNH/modd_eol_adnr.f90
@@ -0,0 +1,69 @@
+!MNH_LIC Copyright 2016-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_EOL_ADNR
+!! #####################
+!!
+!!*** *MODD_EOL_ADNR*
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several models are available. One of the models is the Non-Rotating
+!! Actuator Disk (ADNR). MODD_EOL_ADNR contains all the declarations for
+!! the ADNR model.
+!!
+!!** AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/16
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+IMPLICIT NONE
+!
+! ------ TYPES ------
+TYPE FARM
+ INTEGER :: NNB_TURBINES ! Number of wind turbines [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XPOS_X ! Tower base position, X coord [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XPOS_Y ! Tower base position, Y coord [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XCT_INF ! Thrust coefficient from U_infinite [-]
+END TYPE FARM
+!
+TYPE TURBINE
+ CHARACTER(LEN=10) :: CNAME ! Wind turbine name [-]
+ REAL :: XH_HEIGHT ! Hub height [m]
+ REAL :: XR_MAX ! Radius max of the blade [m]
+END TYPE TURBINE
+!
+! ------ VARIABLES ------
+! Farm data
+TYPE(FARM) :: TFARM
+TYPE(TURBINE) :: TTURBINE
+!
+! Global (CPU) variables
+REAL, DIMENSION(:), ALLOCATABLE :: XA_INDU ! Induction factor
+REAL, DIMENSION(:), ALLOCATABLE :: XCT_D ! Adapted thrust coef (for U_d) [-]
+!
+! Implicit from MODD_EOL_SHARED_IO:
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRU_SUM ! Sum of thrust (N)
+!
+! Namelist NAM_EOL_ADNR :
+! Implicit from MODD_EOL_SHARED_IO:
+!CHARACTER(LEN=100) :: CFARM_CSVDATA ! File to read, with farm data
+!CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! File to read, turbine data
+!CHARACTER(LEN=3) :: CINTERP ! Interpolation method for wind speed
+!
+END MODULE MODD_EOL_ADNR
diff --git a/src/MNH/modd_eol_alm.f90 b/src/MNH/modd_eol_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c04f0cb538ec0d35b16b0cb2ceb5a005401dfa81
--- /dev/null
+++ b/src/MNH/modd_eol_alm.f90
@@ -0,0 +1,118 @@
+!MNH_LIC Copyright 2017-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_EOL_ALM
+!! #####################
+!!
+!!*** *MODD_EOL_ALM*
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several models are available. One of the models is the Actuator
+!! Line Method (ALM). MODD_EOL_ALM contains all the declarations for
+!! the ALM model.
+!!
+!!
+!!** AUTHOR
+!! ------
+!! PA.Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/01/17
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+IMPLICIT NONE
+!
+! ------ TYPES ------
+!
+TYPE FARM
+ INTEGER :: NNB_TURBINES ! Number of wind turbines [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XPOS_X ! Tower base position, X coord [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XPOS_Y ! Tower base position, Y coord [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XOMEGA ! Rotor rotation speed [rad/s]
+ REAL, DIMENSION(:), ALLOCATABLE :: XNAC_YAW ! Nacelle yaw angle [rad]
+ REAL, DIMENSION(:), ALLOCATABLE :: XBLA_PITCH ! Blade picth angle [rad]
+END TYPE FARM
+!
+TYPE TURBINE
+ CHARACTER(LEN=10) :: CNAME ! Nom de la turbine [-]
+ INTEGER :: NNB_BLADES ! Number of blades [-]
+ REAL :: XH_HEIGHT ! Hub height [m]
+ REAL :: XH_DEPORT ! Hub deport [m]
+ REAL :: XNAC_TILT ! Tilt of the nacelle [m]
+ REAL :: XR_MIN ! Minimum blade radius [m]
+ REAL :: XR_MAX ! Maximum blade radius [m]
+END TYPE TURBINE
+!
+TYPE BLADE
+ INTEGER :: NNB_BLAELT ! Number of blade element
+ INTEGER :: NNB_BLADAT ! Number of blade data
+ REAL, DIMENSION(:), ALLOCATABLE :: XRAD ! Data node radius [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XCHORD ! Element chord [m]
+ REAL, DIMENSION(:), ALLOCATABLE :: XTWIST ! Element twist [rad]
+ CHARACTER(LEN=20), DIMENSION(:), ALLOCATABLE :: CAIRFOIL ! Arifoil name [-]
+END TYPE BLADE
+!
+TYPE AIRFOIL
+ CHARACTER(LEN=15) :: CNAME ! Airfoil name [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XAA ! Attack Angle [rad]
+ REAL, DIMENSION(:), ALLOCATABLE :: XRE ! Reynolds Number [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XCL ! Lift coefficient [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XCD ! Drag coefficient [-]
+ REAL, DIMENSION(:), ALLOCATABLE :: XCM ! Moment coefficient [-]
+END TYPE AIRFOIL
+!
+! ------ VARIABLES ------
+! --- Farm data ---
+TYPE(FARM) :: TFARM
+TYPE(TURBINE) :: TTURBINE
+TYPE(BLADE) :: TBLADE
+TYPE(AIRFOIL), DIMENSION(:), ALLOCATABLE :: TAIRFOIL
+!
+! --- Global variables (Code & CPU) ---
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XELT_RAD ! Blade elements radius [m]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XAOA_GLB ! Angle of attack of an element [rad]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFLIFT_GLB ! Lift force, parallel to Urel [N]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFDRAG_GLB ! Drag force, perpendicular to Urel [N]
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RE_GLB ! Aerodyn. force (lift+drag) in RE [N]
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RG_GLB ! Aerodyn. force (lift+drag) in RG [N]
+!
+! Mean values
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XAOA_SUM ! Sum of angle of attack [rad]
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XFAERO_RE_SUM ! Sum of aerodyn. force (lift+drag) in RE [N]
+!
+! Implicit from MODD_EOL_SHARED_IO :
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+!REAL, DIMENSION(:), ALLOCATABLE :: XTORQT ! Torque [Nm]
+!REAL, DIMENSION(:), ALLOCATABLE :: XPOWT ! Power [W]
+!REAL, DIMENSION(:), ALLOCATABLE :: XTHRU_SUM ! Sum of thrust (N)
+!REAL, DIMENSION(:), ALLOCATABLE :: XTORQ_SUM ! Sum of torque (Nm)
+!REAL, DIMENSION(:), ALLOCATABLE :: XPOW_SUM ! Sum of power (W)
+!
+!
+! --- Namelist NAM_EOL_ALM ---
+! Implicit from MODD_EOL_SHARED_IO :
+!CHARACTER(LEN=100) :: CFARM_CSVDATA ! Farm file to read
+!CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! Turbine file to read
+!CHARACTER(LEN=100) :: CBLADE_CSVDATA ! Blade file to read
+!CHARACTER(LEN=100) :: CAIRFOIL_CSVDATA ! Airfoil file to read
+!CHARACTER(LEN=3) :: CINTERP ! Interpolation method for wind speed
+!
+INTEGER :: NNB_BLAELT ! Number of blade elements
+!
+LOGICAL :: LTIMESPLIT ! Flag to apply Time splitting method
+LOGICAL :: LTIPLOSSG ! Flag to apply Glauert's tip loss correction
+LOGICAL :: LTECOUTPTS ! Flag to get Tecplot file output of element points
+!
+END MODULE MODD_EOL_ALM
diff --git a/src/MNH/modd_eol_kine_alm.f90 b/src/MNH/modd_eol_kine_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4ee2d3a5dea26a35b5fb7ba72952152a2dff00c9
--- /dev/null
+++ b/src/MNH/modd_eol_kine_alm.f90
@@ -0,0 +1,109 @@
+!MNH_LIC Copyright 2018-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_EOL_KINE_ALM
+!! #####################
+!!
+!!*** *MODD_EOL_KINE_ALM*
+!!
+!! PURPOSE
+!! -------
+! Declaration to take into account wind turbine motion
+!
+!!
+!!** AUTHOR
+!! ------
+!! PA.Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/18
+! P. Wautelet 19/07/2021: replace double precision by real to allow MNH_REAL=4 compilation
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+!
+! - Matrix to move from one fram to an other -
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XMAT_RG_RT ! RG = Repere GLOBAL, RT = Repere TOWER
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XMAT_RG_RN, XMAT_RT_RN ! RN = Repere NACELLE
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XMAT_RG_RH, XMAT_RH_RG, XMAT_RN_RH ! RH = Repere HUB
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XMAT_RG_RB, XMAT_RH_RB ! RB = Repere BLADE
+REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: XMAT_RG_RE, XMAT_RE_RG, XMAT_RB_RE ! RE = Repere ELEMENT
+
+! - POSITIONS & ORIENTATIONS -
+REAL, DIMENSION(3) :: XPOS_REF ! Reference position
+
+! Tower
+REAL, DIMENSION(:,:), ALLOCATABLE :: XPOSINI_TOWO_RG ! Initial tower origin position, in global reference frame
+REAL, DIMENSION(:,:), ALLOCATABLE :: XPOS_TOWO_RG ! Current tower origin real position, in global reference frame
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XPOS_TELT_RG ! Current tower element position, in global reference frame
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XPOS_TELT_RT ! Current tower element position, in tower frame
+REAL, DIMENSION(:,:), ALLOCATABLE :: XANGINI_TOW_RG ! Initial tower orientation in global ref frame
+
+! Nacelle
+REAL, DIMENSION(:,:), ALLOCATABLE :: XPOSINI_NACO_RT ! Initial nacelle position, in tower reference frame
+REAL, DIMENSION(:,:), ALLOCATABLE :: XPOS_NACO_RG ! Initial nacelle position, in global reference frame
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XPOS_NELT_RG ! Initial nacelle position, in global reference frame
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XPOS_NELT_RN ! Initial nacelle position, in nacelle reference frame
+REAL, DIMENSION(:,:), ALLOCATABLE :: XANGINI_NAC_RT ! Initial nacelle orientation, in tower reference frame
+
+! Hub
+REAL, DIMENSION(:,:), ALLOCATABLE :: XPOSINI_HUB_RN ! Initial hub position, in nacelle reference frame
+REAL, DIMENSION(:,:), ALLOCATABLE :: XPOS_HUB_RG ! Current hub position, in global reference frame
+REAL, DIMENSION(:,:), ALLOCATABLE :: XANGINI_HUB_RN ! Initial hub orientation, in nacelle reference frame
+
+! Blade
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XPOSINI_BLA_RH ! Initial blade root position, in hub reference frame
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XPOS_BLA_RG ! Current blade root position, in global reference frame
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XANGINI_BLA_RH ! Initial blade orientation, in hub reference frame
+
+! Element
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XPOS_ELT_RB ! Element position, in blade reference frame
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XPOS_ELT_RG ! Element position, in global reference frame
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XPOS_SEC_RB ! Section position, in blade reference frame
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XPOS_SEC_RG ! Section position, in global reference frame
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XANGINI_ELT_RB ! Initial element orientation in blade reference frame
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XTWIST_ELT ! Element twist, interpolated from data
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XCHORD_ELT ! Element chord lenght, interpolated from data
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XSURF_ELT ! Element lift surface
+!
+!
+! - STRUCTURAL VELOCITIES -
+! Tower
+REAL, DIMENSION(:,:), ALLOCATABLE :: XTVEL_TOWO_RG ! Tower base translation velocity, in global reference frame
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XTVEL_TELT_RG ! Tower element velocity, in global reference frame
+REAL, DIMENSION(:,:), ALLOCATABLE :: XRVEL_RT_RG ! RT/RG rotational velocity
+
+! Nacelle
+REAL, DIMENSION(:,:), ALLOCATABLE :: XTVEL_NACO_RT ! Nacelle base translation velocity, in tower reference frame
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XTVEL_NELT_RG ! Nacelle element translation velocity, in global reference frame
+REAL, DIMENSION(:,:), ALLOCATABLE :: XRVEL_RN_RT ! RN/RT rotational velocity
+REAL, DIMENSION(:,:), ALLOCATABLE :: XRVEL_RN_RG ! RN/RG rotational velocity
+
+! Hub
+REAL, DIMENSION(:,:), ALLOCATABLE :: XTVEL_HUB_RN ! Hub base translation velocity, in global reference frame
+REAL, DIMENSION(:,:), ALLOCATABLE :: XTVEL_HUB_RG ! Hub base translation velocity, in global reference frame
+REAL, DIMENSION(:,:), ALLOCATABLE :: XRVEL_RH_RN ! RH/RN rotational velocity
+REAL, DIMENSION(:,:), ALLOCATABLE :: XRVEL_RH_RG ! RH/RG rotational velocity
+
+! Blade
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XTVEL_BLA_RH ! Blade base translation velocity, in global reference frame
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XTVEL_BLA_RG ! Blade base translation velocity, in global reference frame
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XRVEL_RB_RH ! RB/RH rotational velocity
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XRVEL_RB_RG ! RB/RG rotational velocity
+
+! Elements
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XTVEL_ELT_RB ! Element base translation velocity, in global reference frame
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XTVEL_ELT_RG ! Element base translation velocity, in global reference frame
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XTVEL_ELT_RE ! Element base translation velocity, in element reference frame
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XRVEL_RE_RB ! RE/RB rotational velocity
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: XRVEL_RE_RG ! RE/RG rotational velocity
+
+END MODULE MODD_EOL_KINE_ALM
diff --git a/src/MNH/modd_eol_main.f90 b/src/MNH/modd_eol_main.f90
new file mode 100644
index 0000000000000000000000000000000000000000..671d1602adf0e24accb6095af65e27c5f3013e3f
--- /dev/null
+++ b/src/MNH/modd_eol_main.f90
@@ -0,0 +1,55 @@
+!MNH_LIC Copyright 2017-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_EOL_MAIN
+!! #####################
+!!
+!!*** *MODD_EOL_MAIN*
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several methods are available. MODD_EOL_MAIN contains all the
+!! main declarations.
+!!
+!!** AUTHOR
+!! ------
+!! PA.Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/01/17
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+USE MODD_PARAMETERS
+!
+!
+! Necessary for each models
+IMPLICIT NONE
+!
+! ------ VARIABLES ------
+!
+! Aerodynamic forces in cartesian mesh
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFX_RG ! Along X in RG frame [F]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFY_RG ! Along Y in RG frame [F]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFZ_RG ! Along Z in RG frame [F]
+! Smeared forces
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFX_SMR_RG ! Along X in RG frame [F]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFY_SMR_RG ! Along Y in RG frame [F]
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: XFZ_SMR_RG ! ALong Z in RG frame [F]
+!
+! Namelist NAM_EOL :
+LOGICAL :: LMAIN_EOL ! Flag to take into account wind turbine
+CHARACTER(LEN=4) :: CMETH_EOL ! Aerodynamic method
+CHARACTER(LEN=4) :: CSMEAR ! Type of smearing
+INTEGER :: NMODEL_EOL ! Son number, where the wind farm is
+!
+END MODULE MODD_EOL_MAIN
diff --git a/src/MNH/modd_eol_shared_io.f90 b/src/MNH/modd_eol_shared_io.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6132fb28f19890e2f30b56539b55735b70f26be6
--- /dev/null
+++ b/src/MNH/modd_eol_shared_io.f90
@@ -0,0 +1,58 @@
+!MNH_LIC Copyright 2020-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODD_EOL_SHARED_IO
+!! #####################
+!!
+!!*** *MODD_EOL_SHARED_IO*
+!!
+!! PURPOSE
+!! -------
+!! It is possible to include wind turbines parameterization in Meso-NH,
+!! and several models are available.
+!!
+!! MODD_EOL_SHARED_IO contains the declarations for the inputs/output
+!! shared by the differents models.
+!!
+!!
+!!** AUTHOR
+!! ------
+!! PA.Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 17/11/20
+!!
+!-----------------------------------------------------------------------------
+!
+IMPLICIT NONE
+!
+!* 1. INPUTS VAR
+! ---------------
+!
+! --- Namelistis NAM_EOL_ADNR/NAM_EOL_ALM ---
+! * .csv files
+CHARACTER(LEN=100) :: CFARM_CSVDATA ! Farm file to read
+CHARACTER(LEN=100) :: CTURBINE_CSVDATA ! Turbine file to read
+CHARACTER(LEN=100) :: CBLADE_CSVDATA ! Blade file to read
+CHARACTER(LEN=100) :: CAIRFOIL_CSVDATA ! Airfoil file to read
+! * flags
+CHARACTER(LEN=3) :: CINTERP ! Interpolation method for wind speed
+!
+!
+!* 2. OUTPUTS VAR
+! -----------------
+!
+! --- Thruts torque and power ---
+REAL, DIMENSION(:), ALLOCATABLE :: XTHRUT ! Thrust [N]
+REAL, DIMENSION(:), ALLOCATABLE :: XTORQT ! Torque [Nm]
+REAL, DIMENSION(:), ALLOCATABLE :: XPOWT ! Power [W]
+REAL, DIMENSION(:), ALLOCATABLE :: XTHRU_SUM ! Sum of thrust (N)
+REAL, DIMENSION(:), ALLOCATABLE :: XTORQ_SUM ! Sum of torque (Nm)
+REAL, DIMENSION(:), ALLOCATABLE :: XPOW_SUM ! Sum of power (W)
+!
+END MODULE MODD_EOL_SHARED_IO
diff --git a/src/MNH/modd_fieldn.f90 b/src/MNH/modd_fieldn.f90
index fc035297ae4920fe913e4eee72285e3bf275d008..b5a6220fdb82f3902fa57e028c7328f665882fca 100644
--- a/src/MNH/modd_fieldn.f90
+++ b/src/MNH/modd_fieldn.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.
@@ -53,6 +53,8 @@
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 06/03/2019: correct XZWS entry
! P. Wautelet 14/03/2019: add XZWS_DEFAULT parameter
+! S. Riette 04/2020: highLow cloud
+! T. Nagel 02/2021: add fields for turbulence recycling
!!
!-------------------------------------------------------------------------------
!
@@ -88,7 +90,8 @@ TYPE FIELD_t
! (rho e)
! REAL, DIMENSION(:,:,:), POINTER :: XPABST=>NULL() ! absolute pressure at
! ! time t
-! REAL, DIMENSION(:,:,:,:), POINTER :: XRT=>NULL() ! Moist variables (rho Rn)
+! REAL, DIMENSION(:,:,:), POINTER :: XPHIT=>NULL()
+! REAL, DIMENSION(:,:,:,:), POINTER :: XRT=>NULL() ! Moist variables (rho Rn)
! ! at time t
REAL, DIMENSION(:,:,:,:), POINTER, contiguous :: XRRS=>NULL() ! Source of Moist variables
! (rho Rn)
@@ -110,25 +113,42 @@ TYPE FIELD_t
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XTHM=>NULL() ! Theta at Previous time step
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRCM=>NULL() ! Cloud mixing ratio at Previous time step
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XPABSM=>NULL() ! Theta at Previous time step
-!
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUNW=>NULL() !U normal velocity fluctuations WEST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVTW=>NULL() !V tangential velocity fluctuations WEST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVNN=>NULL() !V normal velocity fluctuations NORTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUTN=>NULL() !U tangential velocity fluctuations NORTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUNE=>NULL() !U normal velocity fluctuations EAST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVTE=>NULL() !V tangential velocity fluctuations EAST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTVNS=>NULL() !V normal velocity fluctuations SOUTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTUTS=>NULL() !U tangential velocity fluctuations SOUTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTW=>NULL() !W tangential velocity fluctuations WEST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTN=>NULL() !W tangential velocity fluctuations NORTH boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTE=>NULL() !W tangential velocity fluctuations EAST boundary
+ REAL, DIMENSION(:,:) ,POINTER :: XFLUCTWTS=>NULL() !W tangential velocity fluctuations SOUTH boundary
+ REAL, DIMENSION(:,:,:), POINTER :: XHLC_HRC=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XHLC_HCF=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XHLI_HRI=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XHLI_HCF=>NULL()
+ !
END TYPE FIELD_t
TYPE(FIELD_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: FIELD_MODEL
-REAL, DIMENSION(:,:), POINTER, contiguous :: XZWS=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XUT=>NULL(),XVT=>NULL(),XWT=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRUS=>NULL(),XRVS=>NULL(),XRWS=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRUS_PRES=>NULL(),XRVS_PRES=>NULL(),XRWS_PRES=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XTHT=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRTHS=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRTHS_CLD=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XSUPSAT=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XNACT=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XNPRO=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XSSPRO=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XTKET=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRTKES=>NULL()
-REAL, DIMENSION(:,:,:), POINTER, contiguous :: XPABST=>NULL()
+REAL, DIMENSION(:,:), POINTER, contiguous :: XZWS=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XUT=>NULL(),XVT=>NULL(),XWT=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRUS=>NULL(),XRVS=>NULL(),XRWS=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRUS_PRES=>NULL(),XRVS_PRES=>NULL(),XRWS_PRES=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XTHT=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRTHS=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRTHS_CLD=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XSUPSAT=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XNACT=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XNPRO=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XSSPRO=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XTKET=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRTKES=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XPABST=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XPHIT=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER, contiguous :: XRT=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER, contiguous :: XRRS=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER, contiguous :: XRRS_CLD=>NULL()
@@ -137,8 +157,12 @@ REAL, DIMENSION(:,:,:,:), POINTER, contiguous :: XRSVS=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER, contiguous :: XRSVS_CLD=>NULL()
REAL, POINTER :: XDRYMASST=>NULL()
REAL, POINTER :: XDRYMASSS=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XSRC=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XSRC=>NULL()
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XSRCT=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XHLC_HRC=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XHLC_HCF=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XHLI_HRI=>NULL()
+REAL, DIMENSION(:,:,:), POINTER, contiguous :: XHLI_HCF=>NULL()
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XSIGS=>NULL()
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XCLDFR=>NULL()
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRAINFR=>NULL()
@@ -146,6 +170,9 @@ REAL, DIMENSION(:,:,:), POINTER, contiguous :: XCIT=>NULL()
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XTHM=>NULL()
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XPABSM=>NULL()
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XRCM=>NULL()
+REAL, DIMENSION(:,:), POINTER :: XFLUCTUNW=>NULL(),XFLUCTVNN=>NULL(),XFLUCTUTN=>NULL(),XFLUCTVTW=>NULL()
+REAL, DIMENSION(:,:), POINTER :: XFLUCTUNE=>NULL(),XFLUCTVNS=>NULL(),XFLUCTUTS=>NULL(),XFLUCTVTE=>NULL()
+REAL, DIMENSION(:,:), POINTER :: XFLUCTWTW=>NULL(),XFLUCTWTN=>NULL(),XFLUCTWTE=>NULL(),XFLUCTWTS=>NULL()
CONTAINS
@@ -176,6 +203,7 @@ FIELD_MODEL(KFROM)%XRTHS=>XRTHS
!FIELD_MODEL(KFROM)%XTKET=>XTKET !Done in FIELDLIST_GOTO_MODEL
FIELD_MODEL(KFROM)%XRTKES=>XRTKES
!FIELD_MODEL(KFROM)%XPABST=>XPABST !Done in FIELDLIST_GOTO_MODEL
+!FIELD_MODEL(KFROM)%XPHIT=>XPHIT !Done in FIELDLIST_GOTO_MODEL
!FIELD_MODEL(KFROM)%XRT=>XRT !Done in FIELDLIST_GOTO_MODEL
FIELD_MODEL(KFROM)%XRRS=>XRRS
!FIELD_MODEL(KFROM)%XRRS_CLD=>XRRS_CLD !Done in FIELDLIST_GOTO_MODEL
@@ -190,6 +218,22 @@ FIELD_MODEL(KFROM)%XSRC=>XSRC
FIELD_MODEL(KFROM)%XTHM=>XTHM
FIELD_MODEL(KFROM)%XPABSM=>XPABSM
FIELD_MODEL(KFROM)%XRCM=>XRCM
+FIELD_MODEL(KFROM)%XFLUCTUNW=>XFLUCTUNW
+FIELD_MODEL(KFROM)%XFLUCTVNN=>XFLUCTVNN
+FIELD_MODEL(KFROM)%XFLUCTUTN=>XFLUCTUTN
+FIELD_MODEL(KFROM)%XFLUCTVTW=>XFLUCTVTW
+FIELD_MODEL(KFROM)%XFLUCTUNE=>XFLUCTUNE
+FIELD_MODEL(KFROM)%XFLUCTVNS=>XFLUCTVNS
+FIELD_MODEL(KFROM)%XFLUCTUTS=>XFLUCTUTS
+FIELD_MODEL(KFROM)%XFLUCTVTE=>XFLUCTVTE
+FIELD_MODEL(KFROM)%XFLUCTWTW=>XFLUCTWTW
+FIELD_MODEL(KFROM)%XFLUCTWTN=>XFLUCTWTN
+FIELD_MODEL(KFROM)%XFLUCTWTE=>XFLUCTWTE
+FIELD_MODEL(KFROM)%XFLUCTWTS=>XFLUCTWTS
+FIELD_MODEL(KFROM)%XHLC_HRC=>XHLC_HRC
+FIELD_MODEL(KFROM)%XHLC_HCF=>XHLC_HCF
+FIELD_MODEL(KFROM)%XHLI_HRI=>XHLI_HRI
+FIELD_MODEL(KFROM)%XHLI_HCF=>XHLI_HCF
!
! Current model is set to model KTO
!XZWS=>FIELD_MODEL(KTO)%XZWS !Done in FIELDLIST_GOTO_MODEL
@@ -212,6 +256,7 @@ XRTHS=>FIELD_MODEL(KTO)%XRTHS
!XTKET=>FIELD_MODEL(KTO)%XTKET !Done in FIELDLIST_GOTO_MODEL
XRTKES=>FIELD_MODEL(KTO)%XRTKES
!XPABST=>FIELD_MODEL(KTO)%XPABST !Done in FIELDLIST_GOTO_MODEL
+!XPHIT=>FIELD_MODEL(KTO)%XPHIT !Done in FIELDLIST_GOTO_MODEL
!XRT=>FIELD_MODEL(KTO)%XRT !Done in FIELDLIST_GOTO_MODEL
XRRS=>FIELD_MODEL(KTO)%XRRS
!XRRS_CLD=>FIELD_MODEL(KTO)%XRRS_CLD !Done in FIELDLIST_GOTO_MODEL
@@ -228,7 +273,22 @@ XSRC=>FIELD_MODEL(KTO)%XSRC
XTHM=>FIELD_MODEL(KTO)%XTHM
XPABSM=>FIELD_MODEL(KTO)%XPABSM
XRCM=>FIELD_MODEL(KTO)%XRCM
-
+XFLUCTUNW=>FIELD_MODEL(KTO)%XFLUCTUNW
+XFLUCTVNN=>FIELD_MODEL(KTO)%XFLUCTVNN
+XFLUCTUTN=>FIELD_MODEL(KTO)%XFLUCTUTN
+XFLUCTVTW=>FIELD_MODEL(KTO)%XFLUCTVTW
+XFLUCTUNE=>FIELD_MODEL(KTO)%XFLUCTUNE
+XFLUCTVNS=>FIELD_MODEL(KTO)%XFLUCTVNS
+XFLUCTUTS=>FIELD_MODEL(KTO)%XFLUCTUTS
+XFLUCTVTE=>FIELD_MODEL(KTO)%XFLUCTVTE
+XFLUCTWTW=>FIELD_MODEL(KTO)%XFLUCTWTW
+XFLUCTWTN=>FIELD_MODEL(KTO)%XFLUCTWTN
+XFLUCTWTE=>FIELD_MODEL(KTO)%XFLUCTWTE
+XFLUCTWTS=>FIELD_MODEL(KTO)%XFLUCTWTS
+XHLC_HRC=>FIELD_MODEL(KTO)%XHLC_HRC
+XHLC_HCF=>FIELD_MODEL(KTO)%XHLC_HCF
+XHLI_HRI=>FIELD_MODEL(KTO)%XHLI_HRI
+XHLI_HCF=>FIELD_MODEL(KTO)%XHLI_HCF
END SUBROUTINE FIELD_GOTO_MODEL
END MODULE MODD_FIELD_n
diff --git a/src/MNH/modd_frc.f90 b/src/MNH/modd_frc.f90
index 0fdd3c63315b69c0bc97eaa7852cea8b93884763..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
!!
@@ -45,6 +45,8 @@
!! add SST and surface pressure forcing
!! 01/2004 V. Masson surface externalization: removes SST forcing
!! 09/2017 Q.Rodier add LTEND_UV_FRC
+!! 03/2021 JL Redelsperger Parameters defining sfc forcing shape for idealized ocean case
+!! 06/2021 F. Couvreux add LRELAX_UVMEAN_FRC
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -64,7 +66,6 @@ TYPE (DATE_TIME), SAVE, DIMENSION(:), ALLOCATABLE :: TDTFRC ! date of
REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XUFRC, &! geostrophic wind
XVFRC, &! components U and V
XWFRC ! large scale vertical wind
-REAL, SAVE, DIMENSION(:,:,:),ALLOCATABLE:: XWTFRC ! large scale vertical wind
REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTHFRC, &! large scale TH profile
XRVFRC ! large scale RV profile
REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XGXTHFRC,&! large scale TH gradient
@@ -84,11 +85,12 @@ REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XTENDVFRC ! large scale V tendency
LOGICAL, SAVE :: LGEOST_UV_FRC ! enables geostrophic wind term
LOGICAL, SAVE :: LGEOST_TH_FRC ! enables thermal wind advection
LOGICAL, SAVE :: LTEND_THRV_FRC ! enables tendency forcing
-LOGICAL, SAVE :: LTEND_UV_FRC ! enables tendency forcing of the wind
+LOGICAL, SAVE :: LTEND_UV_FRC ! enables tendency forcing of the wind
LOGICAL, SAVE :: LVERT_MOTION_FRC ! enables prescribed a forced vertical
! transport for all prognostic variables
LOGICAL, SAVE :: LRELAX_THRV_FRC ! enables temp. and humidity relaxation
-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
@@ -101,5 +103,10 @@ LOGICAL, SAVE :: LTRANS ! enables a Galilean translation of the
! domain of simulation
LOGICAL, SAVE :: LPGROUND_FRC ! enables surf. pressure forcing
!
+LOGICAL, SAVE :: LDEEPOC ! activates sfc forcing for ideal ocean deep conv
+REAL, SAVE :: XCENTX_OC ! center of sfc forc for ideal ocean
+REAL, SAVE :: XRADX_OC ! radius of sfc forc for ideal ocean
+REAL, SAVE :: XCENTY_OC ! center of sfc forc for ideal ocean
+REAL, SAVE :: XRADY_OC ! radius of sfc forc for ideal ocean
!
END MODULE MODD_FRC
diff --git a/src/MNH/modd_frcn.f90 b/src/MNH/modd_frcn.f90
index 3a01de69f39beb23c12defa4307cfbb4d07b8161..fc9c683629d057037e5a9884658007863b4c6aba 100644
--- a/src/MNH/modd_frcn.f90
+++ b/src/MNH/modd_frcn.f90
@@ -35,11 +35,12 @@
!
USE MODD_PARAMETERS, ONLY: JPMODELMAX
IMPLICIT NONE
-
+!
TYPE FRC_t
!
- REAL, DIMENSION(:,:,:), POINTER :: XUFRC_PAST=>NULL()! Forcing wind components
- REAL, DIMENSION(:,:,:), POINTER :: XVFRC_PAST=>NULL()! at previous time-step
+ REAL, DIMENSION(:,:,:), POINTER :: XUFRC_PAST=>NULL() ! Forcing wind components
+ REAL, DIMENSION(:,:,:), POINTER :: XVFRC_PAST=>NULL() ! at previous time-step
+ REAL, DIMENSION(:,:,:), POINTER :: XWTFRC=>NULL() ! large scale vertical wind
!
END TYPE FRC_t
@@ -47,6 +48,7 @@ TYPE(FRC_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: FRC_MODEL
REAL, DIMENSION(:,:,:), POINTER :: XUFRC_PAST=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XVFRC_PAST=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XWTFRC=>NULL()
CONTAINS
@@ -56,11 +58,13 @@ INTEGER, INTENT(IN) :: KFROM, KTO
! Save current state for allocated arrays
FRC_MODEL(KFROM)%XUFRC_PAST=>XUFRC_PAST
FRC_MODEL(KFROM)%XVFRC_PAST=>XVFRC_PAST
+FRC_MODEL(KFROM)%XWTFRC=>XWTFRC
!
! Current model is set to model KTO
XUFRC_PAST=>FRC_MODEL(KTO)%XUFRC_PAST
XVFRC_PAST=>FRC_MODEL(KTO)%XVFRC_PAST
-
+XWTFRC=>FRC_MODEL(KTO)%XWTFRC
+!
END SUBROUTINE FRC_GOTO_MODEL
END MODULE MODD_FRC_n
diff --git a/src/MNH/modd_getn.f90 b/src/MNH/modd_getn.f90
index bae3402d5f9a9453dbc6f7f0fa706e3755793aa3..f6531c4f82818662547b4332cfd7e6e2559a28f2 100644
--- a/src/MNH/modd_getn.f90
+++ b/src/MNH/modd_getn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! NEC0 masdev4_7 2007/06/16 01:41:59
-!-----------------------------------------------------------------
! #################
MODULE MODD_GET_n
! #################
@@ -53,6 +48,7 @@
!! 05/2006 Remove EPS and LGETALL
!! M. Leriche 04/2010 add get indicators for pH in cloud and rain
!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! S. Riette 04/2020 HighLow cloud
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -92,6 +88,7 @@ TYPE GET_t
! CLouD FRaction
CHARACTER (LEN=4) :: CGETSRCT ! Get indicator for SRCM
! and SRCT related to the subgrid condensation
+ CHARACTER (LEN=4) :: CGETHL ! Get indicator for HighLow cloud
CHARACTER (LEN=4) :: CGETCIT ! Get indicator for the
! primary ice concentration
CHARACTER (LEN=4) :: CGETCONV ! Get indicator for the
@@ -127,6 +124,7 @@ CHARACTER (LEN=4), POINTER :: CGETLSTHM=>NULL(), CGETLSRVM=>NULL()
CHARACTER (LEN=4), POINTER :: CGETSIGS=>NULL(),CGETSRC=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCLDFR=>NULL()
CHARACTER (LEN=4), POINTER :: CGETSRCT=>NULL()
+CHARACTER (LEN=4), POINTER :: CGETHL=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCIT=>NULL()
CHARACTER (LEN=4), POINTER :: CGETCONV=>NULL()
CHARACTER (LEN=4), POINTER :: CGETRAD=>NULL()
@@ -181,6 +179,7 @@ CGETSIGS=>GET_MODEL(KTO)%CGETSIGS
CGETSRC=>GET_MODEL(KTO)%CGETSRC
CGETCLDFR=>GET_MODEL(KTO)%CGETCLDFR
CGETSRCT=>GET_MODEL(KTO)%CGETSRCT
+CGETHL=>GET_MODEL(KTO)%CGETHL
CGETCIT=>GET_MODEL(KTO)%CGETCIT
CGETZWS=>GET_MODEL(KTO)%CGETZWS
CGETCONV=>GET_MODEL(KTO)%CGETCONV
diff --git a/src/MNH/modd_ibm_lsf.f90 b/src/MNH/modd_ibm_lsf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..27dfa7d21e5d01cfca424c965a94f4ef6b070afa
--- /dev/null
+++ b/src/MNH/modd_ibm_lsf.f90
@@ -0,0 +1,78 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODD_IBM_LSF
+ ! #######################
+ !
+ !!**** MODD_IBM_LSF_ - declaration of the control parameters
+ !! used in the LSF building
+ !!
+ !! PURPOSE
+ !! -------
+ !!**** The purpose of this declarative module is to declare the constants
+ !! which allow to initialize the embedded fluid-solid interface
+ !!
+ !!
+ !! IMPLICIT ARGUMENTS
+ !! ------------------
+ !! None
+ !!
+ !! REFERENCE
+ !! ---------
+ !!
+ !! AUTHOR
+ !! ------
+ !! Franck Auguste (CERFACS-AE)
+ !!
+ !! MODIFICATIONS
+ !! -------------
+ !! Original 01/01/2019
+ !
+ !------------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ USE MODD_PARAMETERS, ONLY: JPMODELMAX
+ !
+ IMPLICIT NONE
+ !
+ TYPE LSF_t
+ !
+ LOGICAL :: LIBM_LSF = .FALSE. ! IBM logical
+ CHARACTER(LEN=4) :: CIBM_TYPE = 'NONE' ! switch generalized/idealized surface
+ INTEGER :: NIBM_SMOOTH = 1 ! smooth levels for LS
+ REAL :: XIBM_SMOOTH = 0.0001 ! smooth weighting
+ !
+ END TYPE LSF_t
+ !
+ TYPE(LSF_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: LSF_MODEL
+ !
+ LOGICAL , POINTER :: LIBM_LSF=>NULL()
+ CHARACTER(LEN=4) , POINTER :: CIBM_TYPE=>NULL()
+ INTEGER , POINTER :: NIBM_SMOOTH=>NULL()
+ REAL , POINTER :: XIBM_SMOOTH=>NULL()
+ !
+CONTAINS
+ !
+ SUBROUTINE LSF_GOTO_MODEL(KFROM, KTO)
+ !
+ INTEGER, INTENT(IN) :: KFROM, KTO
+ !
+ ! Save current state for allocated arrays
+ !
+ ! Current model is set to model KTO
+ LIBM_LSF=>LSF_MODEL(KTO)%LIBM_LSF
+ CIBM_TYPE=>LSF_MODEL(KTO)%CIBM_TYPE
+ XIBM_SMOOTH=>LSF_MODEL(KTO)%XIBM_SMOOTH
+ NIBM_SMOOTH=>LSF_MODEL(KTO)%NIBM_SMOOTH
+ !
+ END SUBROUTINE LSF_GOTO_MODEL
+ !
+END MODULE MODD_IBM_LSF
+!
+
diff --git a/src/MNH/modd_ibm_paramn.f90 b/src/MNH/modd_ibm_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..642abc204a3d1a3a68f20e35eb4e4840cfe9e276
--- /dev/null
+++ b/src/MNH/modd_ibm_paramn.f90
@@ -0,0 +1,325 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+MODULE MODD_IBM_PARAM_n
+ ! #######################
+ !
+ !**** MODD_IBM_PARAM_n - declaration of the control parameters
+ ! used in the immersed boundary method
+ !
+ ! PURPOSE
+ ! -------
+ !**** The purpose of this declarative module is to declare the constants
+ ! which allow to initialize the embedded surface
+ !
+ !
+ ! IMPLICIT ARGUMENTS
+ ! ------------------
+ ! None
+ !
+ ! REFERENCE
+ ! ---------
+ !
+ ! AUTHOR
+ ! ------
+ ! Franck Auguste (CERFACS-AE)
+ !
+ ! MODIFICATIONS
+ ! -------------
+ ! Original 01/01/2019
+ !
+ !----------------------------------------------------------------------------
+ !
+ !**** 0. DECLARATIONS
+ ! ---------------
+ !
+ USE MODD_PARAMETERS, ONLY: JPMODELMAX
+ IMPLICIT NONE
+ !
+ TYPE IBM_t
+ !
+ LOGICAL :: LIBM,LIBM_TROUBLE ! IBM logical
+ CHARACTER(LEN=6) :: CIBM_ADV ! GCT switch
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE1_P,CIBM_MODE_INTE1_Q,CIBM_MODE_INTE1_R,CIBM_MODE_INTE1_S ! 1D interpolation type
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE1_T,CIBM_MODE_INTE1_E
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE1NV,CIBM_MODE_INTE1TV,CIBM_MODE_INTE1CV
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE3_P,CIBM_MODE_INTE3_Q,CIBM_MODE_INTE3_R,CIBM_MODE_INTE3_S ! 3D interpolation type
+ CHARACTER(LEN=3) :: CIBM_MODE_INTE3_T,CIBM_MODE_INTE3_E,CIBM_MODE_INTE3_V
+ CHARACTER(LEN=3) :: CIBM_TYPE_BOUND_P,CIBM_TYPE_BOUND_Q,CIBM_TYPE_BOUND_R,CIBM_TYPE_BOUND_S ! Boundary interpolation type
+ CHARACTER(LEN=3) :: CIBM_TYPE_BOUND_T,CIBM_TYPE_BOUND_E
+ CHARACTER(LEN=3) :: CIBM_MODE_BOUND_P,CIBM_MODE_BOUND_Q,CIBM_MODE_BOUND_R,CIBM_MODE_BOUND_S ! Boundary interpolation type
+ CHARACTER(LEN=3) :: CIBM_MODE_BOUND_T,CIBM_MODE_BOUND_E
+ CHARACTER(LEN=3) :: CIBM_FORC_BOUND_P,CIBM_FORC_BOUND_Q,CIBM_FORC_BOUND_R,CIBM_FORC_BOUND_S ! Boundary interpolation type
+ CHARACTER(LEN=3) :: CIBM_FORC_BOUND_T,CIBM_FORC_BOUND_E
+ REAL :: XIBM_FORC_BOUND_P,XIBM_FORC_BOUND_Q,XIBM_FORC_BOUND_R,XIBM_FORC_BOUND_S ! Boundary interpolation type
+ REAL :: XIBM_FORC_BOUND_T,XIBM_FORC_BOUND_E
+ CHARACTER(LEN=3) :: CIBM_TYPE_BOUNN_V,CIBM_TYPE_BOUNT_V,CIBM_TYPE_BOUNC_V ! BI type (velocity)
+ CHARACTER(LEN=3) :: CIBM_MODE_BOUNN_V,CIBM_MODE_BOUNT_V,CIBM_MODE_BOUNC_V
+ CHARACTER(LEN=3) :: CIBM_FORC_BOUNN_V,CIBM_FORC_BOUNT_V,CIBM_FORC_BOUNC_V,CIBM_FORC_BOUNR_V
+ REAL :: XIBM_FORC_BOUNN_V,XIBM_FORC_BOUNT_V,XIBM_FORC_BOUNC_V
+ REAL :: XIBM_RADIUS_P,XIBM_RADIUS_Q,XIBM_RADIUS_R,XIBM_RADIUS_S ! radius of IDW,MDW
+ REAL :: XIBM_RADIUS_T,XIBM_RADIUS_E,XIBM_RADIUS_V
+ REAL :: XIBM_POWERS_P,XIBM_POWERS_Q,XIBM_POWERS_R,XIBM_POWERS_S ! power of IDW,MDW
+ REAL :: XIBM_POWERS_T,XIBM_POWERS_E,XIBM_POWERS_V
+ INTEGER :: NIBM_LAYER_V,NIBM_LAYER_T,NIBM_LAYER_P,NIBM_LAYER_R ! layers number in each type
+ INTEGER :: NIBM_LAYER_E,NIBM_LAYER_Q,NIBM_LAYER_S
+ INTEGER :: NIBM_ITR ! maximum iteration in pressure solver
+ REAL :: XIBM_RUG ,XIBM_VISC, XIBM_CNU ! physical parameters for wall model
+ REAL :: XIBM_EPSI ! min truncation parameters
+ REAL :: XIBM_IEPS ! max truncation parameters
+ !
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_XMUT=>NULL() ! turbulent viscosity
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_CURV=>NULL() ! parameter for interface curvature
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_LS=>NULL() ! LSF for MNH
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SU=>NULL() ! volume fraction based on LSF
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SUTR=>NULL() ! volume fraction based on LSF if trouble
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_P=>NULL() ! Ghosts,Images location/Index
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:), POINTER :: NIBM_IMAGE_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:), POINTER :: NIBM_IMAGE_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_V=>NULL()
+ !
+ END TYPE IBM_t
+ !
+ TYPE(IBM_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: IBM_MODEL
+ !
+ LOGICAL , POINTER :: LIBM=>NULL()
+ LOGICAL , POINTER :: LIBM_TROUBLE=>NULL()
+ CHARACTER(LEN=6), POINTER :: CIBM_ADV=>NULL()
+ REAL , POINTER :: XIBM_EPSI=>NULL()
+ REAL , POINTER :: XIBM_IEPS=>NULL()
+ INTEGER , POINTER :: NIBM_ITR=>NULL()
+ !
+ INTEGER, POINTER :: NIBM_LAYER_P=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_Q=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_R=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_S=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_T=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_V=>NULL()
+ INTEGER, POINTER :: NIBM_LAYER_E=>NULL()
+ !
+ REAL, POINTER :: XIBM_RADIUS_P=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_Q=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_R=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_S=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_T=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_E=>NULL()
+ REAL, POINTER :: XIBM_RADIUS_V=>NULL()
+ REAL, POINTER :: XIBM_POWERS_P=>NULL()
+ REAL, POINTER :: XIBM_POWERS_Q=>NULL()
+ REAL, POINTER :: XIBM_POWERS_R=>NULL()
+ REAL, POINTER :: XIBM_POWERS_S=>NULL()
+ REAL, POINTER :: XIBM_POWERS_T=>NULL()
+ REAL, POINTER :: XIBM_POWERS_E=>NULL()
+ REAL, POINTER :: XIBM_POWERS_V=>NULL()
+ !
+ REAL, POINTER :: XIBM_FORC_BOUNN_V=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUNT_V=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUNC_V=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_P=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_Q=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_R=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_S=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_T=>NULL()
+ REAL, POINTER :: XIBM_FORC_BOUND_E=>NULL()
+ !
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUND_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUND_E=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1NV=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1TV=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE1CV=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_INTE3_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUNN_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUNN_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUNT_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUNT_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_MODE_BOUNC_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_TYPE_BOUNC_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNN_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNR_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNT_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUNC_V=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_P=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_Q=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_R=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_S=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_T=>NULL()
+ CHARACTER(LEN=3), POINTER :: CIBM_FORC_BOUND_E=>NULL()
+ !
+ REAL, POINTER :: XIBM_RUG=>NULL()
+ REAL, POINTER :: XIBM_VISC=>NULL()
+ REAL, POINTER :: XIBM_CNU=>NULL()
+ !
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_XMUT=>NULL()
+ REAL, DIMENSION(:,:,:) , POINTER :: XIBM_CURV=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_LS=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SU=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_SUTR=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_P=>NULL()
+ REAL, DIMENSION(:,:,:,:) , POINTER :: XIBM_GHOST_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:) , POINTER :: XIBM_IMAGE_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:) , POINTER :: NIBM_GHOST_V=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:) , POINTER :: NIBM_IMAGE_P=>NULL()
+ INTEGER, DIMENSION(:,:,:,:,:,:) , POINTER :: NIBM_IMAGE_V=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_P=>NULL()
+ REAL, DIMENSION(:,:,:,:,:,:) , POINTER :: XIBM_TESTI_V=>NULL()
+ !
+CONTAINS
+ !
+ SUBROUTINE IBM_GOTO_MODEL(KFROM, KTO)
+ !
+ INTEGER, INTENT(IN) :: KFROM, KTO
+ !
+ ! Save current state for allocated arrays
+ IBM_MODEL(KFROM)%XIBM_XMUT=>XIBM_XMUT
+ IBM_MODEL(KFROM)%XIBM_CURV=>XIBM_CURV
+ IBM_MODEL(KFROM)%XIBM_LS=>XIBM_LS
+ IBM_MODEL(KFROM)%XIBM_SU=>XIBM_SU
+ IBM_MODEL(KFROM)%XIBM_GHOST_P=>XIBM_GHOST_P
+ IBM_MODEL(KFROM)%XIBM_GHOST_V=>XIBM_GHOST_V
+ IBM_MODEL(KFROM)%XIBM_GHOST_P=>XIBM_GHOST_P
+ IBM_MODEL(KFROM)%XIBM_GHOST_V=>XIBM_GHOST_V
+ IBM_MODEL(KFROM)%NIBM_IMAGE_P=>NIBM_IMAGE_P
+ IBM_MODEL(KFROM)%NIBM_IMAGE_V=>NIBM_IMAGE_V
+ IBM_MODEL(KFROM)%NIBM_IMAGE_P=>NIBM_IMAGE_P
+ IBM_MODEL(KFROM)%NIBM_IMAGE_V=>NIBM_IMAGE_V
+ IBM_MODEL(KFROM)%XIBM_TESTI_P=>XIBM_TESTI_P
+ IBM_MODEL(KFROM)%XIBM_TESTI_V=>XIBM_TESTI_V
+ !
+ ! Current model is set to model KTO
+ LIBM=>IBM_MODEL(KTO)%LIBM
+ LIBM_TROUBLE=>IBM_MODEL(KTO)%LIBM_TROUBLE
+ CIBM_ADV=>IBM_MODEL(KTO)%CIBM_ADV
+ XIBM_EPSI=>IBM_MODEL(KTO)%XIBM_EPSI
+ XIBM_IEPS=>IBM_MODEL(KTO)%XIBM_IEPS
+ XIBM_RUG=>IBM_MODEL(KTO)%XIBM_RUG
+ XIBM_VISC=>IBM_MODEL(KTO)%XIBM_VISC
+ XIBM_CNU=>IBM_MODEL(KTO)%XIBM_CNU
+ NIBM_ITR=>IBM_MODEL(KTO)%NIBM_ITR
+ NIBM_LAYER_E=>IBM_MODEL(KTO)%NIBM_LAYER_E
+ NIBM_LAYER_P=>IBM_MODEL(KTO)%NIBM_LAYER_P
+ NIBM_LAYER_Q=>IBM_MODEL(KTO)%NIBM_LAYER_Q
+ NIBM_LAYER_R=>IBM_MODEL(KTO)%NIBM_LAYER_R
+ NIBM_LAYER_S=>IBM_MODEL(KTO)%NIBM_LAYER_S
+ NIBM_LAYER_T=>IBM_MODEL(KTO)%NIBM_LAYER_T
+ NIBM_LAYER_V=>IBM_MODEL(KTO)%NIBM_LAYER_V
+ XIBM_XMUT=>IBM_MODEL(KTO)%XIBM_XMUT
+ XIBM_CURV=>IBM_MODEL(KTO)%XIBM_CURV
+ XIBM_LS=>IBM_MODEL(KTO)%XIBM_LS
+ XIBM_SU=>IBM_MODEL(KTO)%XIBM_SU
+ XIBM_SUTR=>IBM_MODEL(KTO)%XIBM_SUTR
+ XIBM_GHOST_P=>IBM_MODEL(KTO)%XIBM_GHOST_P
+ XIBM_GHOST_V=>IBM_MODEL(KTO)%XIBM_GHOST_V
+ NIBM_GHOST_P=>IBM_MODEL(KTO)%NIBM_GHOST_P
+ NIBM_GHOST_V=>IBM_MODEL(KTO)%NIBM_GHOST_V
+ XIBM_IMAGE_P=>IBM_MODEL(KTO)%XIBM_IMAGE_P
+ XIBM_IMAGE_V=>IBM_MODEL(KTO)%XIBM_IMAGE_V
+ NIBM_IMAGE_P=>IBM_MODEL(KTO)%NIBM_IMAGE_P
+ NIBM_IMAGE_V=>IBM_MODEL(KTO)%NIBM_IMAGE_V
+ XIBM_TESTI_P=>IBM_MODEL(KTO)%XIBM_TESTI_P
+ XIBM_TESTI_V=>IBM_MODEL(KTO)%XIBM_TESTI_V
+ XIBM_RADIUS_P=>IBM_MODEL(KTO)%XIBM_RADIUS_P
+ XIBM_POWERS_P=>IBM_MODEL(KTO)%XIBM_POWERS_P
+ XIBM_RADIUS_Q=>IBM_MODEL(KTO)%XIBM_RADIUS_Q
+ XIBM_POWERS_Q=>IBM_MODEL(KTO)%XIBM_POWERS_Q
+ XIBM_RADIUS_R=>IBM_MODEL(KTO)%XIBM_RADIUS_R
+ XIBM_POWERS_R=>IBM_MODEL(KTO)%XIBM_POWERS_R
+ XIBM_RADIUS_S=>IBM_MODEL(KTO)%XIBM_RADIUS_S
+ XIBM_POWERS_S=>IBM_MODEL(KTO)%XIBM_POWERS_S
+ XIBM_RADIUS_T=>IBM_MODEL(KTO)%XIBM_RADIUS_T
+ XIBM_POWERS_T=>IBM_MODEL(KTO)%XIBM_POWERS_T
+ XIBM_RADIUS_E=>IBM_MODEL(KTO)%XIBM_RADIUS_E
+ XIBM_POWERS_E=>IBM_MODEL(KTO)%XIBM_POWERS_E
+ XIBM_RADIUS_V=>IBM_MODEL(KTO)%XIBM_RADIUS_V
+ XIBM_POWERS_V=>IBM_MODEL(KTO)%XIBM_POWERS_V
+ XIBM_FORC_BOUND_P => IBM_MODEL(KTO)%XIBM_FORC_BOUND_P
+ XIBM_FORC_BOUND_Q => IBM_MODEL(KTO)%XIBM_FORC_BOUND_Q
+ XIBM_FORC_BOUND_R => IBM_MODEL(KTO)%XIBM_FORC_BOUND_R
+ XIBM_FORC_BOUND_S => IBM_MODEL(KTO)%XIBM_FORC_BOUND_S
+ XIBM_FORC_BOUND_T => IBM_MODEL(KTO)%XIBM_FORC_BOUND_T
+ XIBM_FORC_BOUND_E => IBM_MODEL(KTO)%XIBM_FORC_BOUND_E
+ XIBM_FORC_BOUNN_V => IBM_MODEL(KTO)%XIBM_FORC_BOUNN_V
+ XIBM_FORC_BOUNT_V => IBM_MODEL(KTO)%XIBM_FORC_BOUNT_V
+ XIBM_FORC_BOUNC_V => IBM_MODEL(KTO)%XIBM_FORC_BOUNC_V
+ CIBM_MODE_INTE1_P => IBM_MODEL(KTO)%CIBM_MODE_INTE1_P
+ CIBM_MODE_INTE3_P => IBM_MODEL(KTO)%CIBM_MODE_INTE3_P
+ CIBM_MODE_BOUND_P => IBM_MODEL(KTO)%CIBM_MODE_BOUND_P
+ CIBM_TYPE_BOUND_P => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_P
+ CIBM_MODE_INTE1_Q => IBM_MODEL(KTO)%CIBM_MODE_INTE1_Q
+ CIBM_MODE_INTE3_Q => IBM_MODEL(KTO)%CIBM_MODE_INTE3_Q
+ CIBM_MODE_BOUND_Q => IBM_MODEL(KTO)%CIBM_MODE_BOUND_Q
+ CIBM_TYPE_BOUND_Q => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_Q
+ CIBM_MODE_INTE1_R => IBM_MODEL(KTO)%CIBM_MODE_INTE1_R
+ CIBM_MODE_INTE3_R => IBM_MODEL(KTO)%CIBM_MODE_INTE3_R
+ CIBM_MODE_BOUND_R => IBM_MODEL(KTO)%CIBM_MODE_BOUND_R
+ CIBM_TYPE_BOUND_R => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_R
+ CIBM_MODE_INTE1_S => IBM_MODEL(KTO)%CIBM_MODE_INTE1_S
+ CIBM_MODE_INTE3_S => IBM_MODEL(KTO)%CIBM_MODE_INTE3_S
+ CIBM_MODE_BOUND_S => IBM_MODEL(KTO)%CIBM_MODE_BOUND_S
+ CIBM_TYPE_BOUND_S => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_S
+ CIBM_MODE_INTE1_T => IBM_MODEL(KTO)%CIBM_MODE_INTE1_T
+ CIBM_MODE_INTE3_T => IBM_MODEL(KTO)%CIBM_MODE_INTE3_T
+ CIBM_MODE_BOUND_T => IBM_MODEL(KTO)%CIBM_MODE_BOUND_T
+ CIBM_TYPE_BOUND_T => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_T
+ CIBM_MODE_INTE1_E => IBM_MODEL(KTO)%CIBM_MODE_INTE1_E
+ CIBM_MODE_INTE3_E => IBM_MODEL(KTO)%CIBM_MODE_INTE3_E
+ CIBM_MODE_BOUND_E => IBM_MODEL(KTO)%CIBM_MODE_BOUND_E
+ CIBM_TYPE_BOUND_E => IBM_MODEL(KTO)%CIBM_TYPE_BOUND_E
+ CIBM_MODE_INTE1NV => IBM_MODEL(KTO)%CIBM_MODE_INTE1NV
+ CIBM_MODE_INTE1TV => IBM_MODEL(KTO)%CIBM_MODE_INTE1TV
+ CIBM_MODE_INTE1CV => IBM_MODEL(KTO)%CIBM_MODE_INTE1CV
+ CIBM_MODE_INTE3_V => IBM_MODEL(KTO)%CIBM_MODE_INTE3_V
+ CIBM_MODE_BOUNN_V => IBM_MODEL(KTO)%CIBM_MODE_BOUNN_V
+ CIBM_TYPE_BOUNN_V => IBM_MODEL(KTO)%CIBM_TYPE_BOUNN_V
+ CIBM_MODE_BOUNT_V => IBM_MODEL(KTO)%CIBM_MODE_BOUNT_V
+ CIBM_TYPE_BOUNT_V => IBM_MODEL(KTO)%CIBM_TYPE_BOUNT_V
+ CIBM_MODE_BOUNC_V => IBM_MODEL(KTO)%CIBM_MODE_BOUNC_V
+ CIBM_TYPE_BOUNC_V => IBM_MODEL(KTO)%CIBM_TYPE_BOUNC_V
+ CIBM_FORC_BOUNN_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNN_V
+ CIBM_FORC_BOUNR_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNR_V
+ CIBM_FORC_BOUNT_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNT_V
+ CIBM_FORC_BOUNC_V => IBM_MODEL(KTO)%CIBM_FORC_BOUNC_V
+ CIBM_FORC_BOUND_P => IBM_MODEL(KTO)%CIBM_FORC_BOUND_P
+ CIBM_FORC_BOUND_Q => IBM_MODEL(KTO)%CIBM_FORC_BOUND_Q
+ CIBM_FORC_BOUND_R => IBM_MODEL(KTO)%CIBM_FORC_BOUND_R
+ CIBM_FORC_BOUND_S => IBM_MODEL(KTO)%CIBM_FORC_BOUND_S
+ CIBM_FORC_BOUND_T => IBM_MODEL(KTO)%CIBM_FORC_BOUND_T
+ CIBM_FORC_BOUND_E => IBM_MODEL(KTO)%CIBM_FORC_BOUND_E
+ !
+ END SUBROUTINE IBM_GOTO_MODEL
+ !
+END MODULE MODD_IBM_PARAM_n
+!
diff --git a/src/MNH/modd_ice_c1r3_descr.f90 b/src/MNH/modd_ice_c1r3_descr.f90
index 17af3a73f709e66eaa101861b41a26f47bee88a1..2a3de68e101decd05852e6645621dcabeada2d73 100644
--- a/src/MNH/modd_ice_c1r3_descr.f90
+++ b/src/MNH/modd_ice_c1r3_descr.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modd 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ##########################
MODULE MODD_ICE_C1R3_DESCR
! ##########################
@@ -53,6 +48,7 @@
!! J.-P. Pinty 29/11/02 add C1R3NAMES
!!
!-------------------------------------------------------------------------------
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
!
!* 0. DECLARATIONS
! ------------
@@ -77,8 +73,8 @@ REAL,SAVE :: XLBEXG,XLBG ! Graupel distribution parameters
REAL,SAVE :: XLBDAS_MAX,XLBDAG_MAX ! Max values allowed for the shape
! parameters (snow,graupeln)
!
-CHARACTER(LEN=10),DIMENSION(2),PARAMETER &
- :: C1R3NAMES=(/'CICE ','CIN '/)
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(2),PARAMETER &
+ :: C1R3NAMES=(/'CICE','CIN '/)
! basenames of the SV articles stored
! in the binary files
!
diff --git a/src/MNH/modd_les.f90 b/src/MNH/modd_les.f90
index c30666b2e4e2cdbb2fdce8ea65291c2bf0bcc51c..db71d6f33aa854d4fa66308dece4c9cc7ad7bbcd 100644
--- a/src/MNH/modd_les.f90
+++ b/src/MNH/modd_les.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1995-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.
!-----------------------------------------------------------------
! ###############
@@ -41,7 +41,9 @@
!! J.Pergaud Oct , 2007 MF LES
!! P. Aumond Oct ,2009 User multimaskS + 4th order
!! C.Lac Oct ,2014 Correction on user masks
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! 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
+! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -63,9 +65,9 @@ LOGICAL :: LLES_DOWNDRAFT ! flag to activate the computations in downdrafts
LOGICAL :: LLES_SPECTRA ! flag to activate the spectra computations
LOGICAL :: LLES_PDF ! flag to activate the pdf computations
!
-INTEGER, DIMENSION(900) :: NLES_LEVELS ! model levels for LES comp.
+INTEGER, DIMENSION(900) :: NLES_LEVELS ! physical model levels for LES comp.
REAL, DIMENSION(900) :: XLES_ALTITUDES ! alt. levels for LES comp.
-INTEGER, DIMENSION(900) :: NSPECTRA_LEVELS ! model levels for spectra comp.
+INTEGER, DIMENSION(900) :: NSPECTRA_LEVELS ! physical model levels for spectra comp.
REAL, DIMENSION(900) :: XSPECTRA_ALTITUDES ! alt. levels for spectra comp.
!
INTEGER, DIMENSION( 10) :: NLES_TEMP_SERIE_I ! I, J and Z point
@@ -81,7 +83,7 @@ REAL :: XLES_TEMP_MEAN_END ! for start and end of the temporal averaged comp.
REAL :: XLES_TEMP_MEAN_STEP ! time step for each averaging
LOGICAL :: LLES_CART_MASK ! flag to use a cartesian mask
-INTEGER :: NLES_IINF ! definition of the cartesians mask
+INTEGER :: NLES_IINF ! definition of the cartesians mask in physical domain
INTEGER :: NLES_ISUP ! for NLES_CART_MODNBR model
INTEGER :: NLES_JINF ! "
INTEGER :: NLES_JSUP ! "
@@ -94,7 +96,7 @@ INTEGER :: NPDF ! number of pdf intervals
!
!-------------------------------------------------------------------------------
!
-INTEGER, DIMENSION(JPMODELMAX) :: NLESn_IINF ! definition of the cartesians mask
+INTEGER, DIMENSION(JPMODELMAX) :: NLESn_IINF ! definition of the cartesians mask in physical domain
INTEGER, DIMENSION(JPMODELMAX) :: NLESn_ISUP ! for all models
INTEGER, DIMENSION(JPMODELMAX) :: NLESn_JINF ! "
INTEGER, DIMENSION(JPMODELMAX) :: NLESn_JSUP ! "
@@ -136,11 +138,8 @@ INTEGER :: NLES_CURRENT_TCOUNT
INTEGER :: NLES_CURRENT_TIMES
! current model NLES_TIMES (number of LES samplings)
!
-REAL, DIMENSION(:,:), ALLOCATABLE :: XLES_CURRENT_TRAJT
-! trajt array for write_diachro routine
-!
INTEGER :: NLES_CURRENT_IINF, NLES_CURRENT_ISUP, NLES_CURRENT_JINF, NLES_CURRENT_JSUP
-! coordinates for write_diachro, set to NLESn_IINF(current model), etc...
+! coordinates (in physical domain) for write_diachro, set to NLESn_IINF(current model), etc...
!
REAL :: XLES_CURRENT_DOMEGAX, XLES_CURRENT_DOMEGAY
! minimum wavelength in spectra analysis
@@ -151,9 +150,6 @@ CHARACTER(LEN=4), DIMENSION(2) :: CLES_CURRENT_LBCX
CHARACTER(LEN=4), DIMENSION(2) :: CLES_CURRENT_LBCY
! current model Y boundary conditions for 2 points correlations computations
!
-REAL, DIMENSION(:,:), ALLOCATABLE :: XLES_CURRENT_DATIME
-! date array for diachro
-!
REAL, DIMENSION(:), ALLOCATABLE :: XLES_CURRENT_Z
! altitudes for diachro
!
diff --git a/src/MNH/modd_les_budget.f90 b/src/MNH/modd_les_budget.f90
index 355b3890b566a508e94163f700d59bbacb432456..062eb355286b592ace756db804a5257fbe31d3f2 100644
--- a/src/MNH/modd_les_budget.f90
+++ b/src/MNH/modd_les_budget.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC 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_LES_BUDGET
! ###############
@@ -113,30 +108,30 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: X_LES_BU_SBG_Tke
!
!* index for each processus taken into account in the budgets
!
-INTEGER :: NLES_TOTADV
-INTEGER :: NLES_RELA
-INTEGER :: NLES_RAD
-INTEGER :: NLES_GRAV
-INTEGER :: NLES_COR
-INTEGER :: NLES_MICR
-INTEGER :: NLES_HTURB
-INTEGER :: NLES_VTURB
-INTEGER :: NLES_FORC
-INTEGER :: NLES_PRES
-INTEGER :: NLES_DIFF
-INTEGER :: NLES_CURV
-INTEGER :: NLES_PREF
-INTEGER :: NLES_DP
-INTEGER :: NLES_TP
-INTEGER :: NLES_TR
-INTEGER :: NLES_DISS
-INTEGER :: NLES_TEND
-INTEGER :: NLES_MISC
-INTEGER :: NLES_ADVR
-INTEGER :: NLES_ADVM
-INTEGER :: NLES_NEST
-!
-INTEGER :: NLES_TOT
+integer, parameter :: NLES_TOTADV= 1
+integer, parameter :: NLES_RELA = 2
+integer, parameter :: NLES_RAD = 3
+integer, parameter :: NLES_GRAV = 4
+integer, parameter :: NLES_COR = 5
+integer, parameter :: NLES_MICR = 6
+integer, parameter :: NLES_HTURB = 7
+integer, parameter :: NLES_VTURB = 8
+integer, parameter :: NLES_FORC = 9
+integer, parameter :: NLES_PRES = 10
+integer, parameter :: NLES_DIFF = 11
+integer, parameter :: NLES_CURV = 12
+integer, parameter :: NLES_PREF = 13
+integer, parameter :: NLES_DP = 14
+integer, parameter :: NLES_TP = 15
+integer, parameter :: NLES_TR = 16
+integer, parameter :: NLES_DISS = 17
+integer, parameter :: NLES_TEND = 18
+integer, parameter :: NLES_ADVR = 19
+integer, parameter :: NLES_ADVM = 20
+integer, parameter :: NLES_NEST = 21
+integer, parameter :: NLES_MISC = 22
+
+integer, parameter :: NLES_TOT = 22
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/modd_lesn.f90 b/src/MNH/modd_lesn.f90
index 9fe76c3f8f7eacbc68b7724d4f0df26562d791d3..28db43c4d13ba4f85754ace59ad988145b5f1c75 100644
--- a/src/MNH/modd_lesn.f90
+++ b/src/MNH/modd_lesn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -40,7 +40,8 @@
!! O.Thouron June, 2008 New radiation diagnostics
!! 10/2016 (C.Lac) Add droplet deposition
! P. Wautelet 08/02/2019: add missing NULL association for pointers
-!! 02/2019 (C. Lac) Add rain fraction as a LES diagnostic
+! C. Lac 02/2019: add rain fraction as a LES diagnostic
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -63,8 +64,8 @@ TYPE LES_t
INTEGER :: NSPECTRA_NI ! number of wave lengths in I direction
INTEGER :: NSPECTRA_NJ ! number of wave lengths in J direction
!
- REAL, DIMENSION(:,:), POINTER :: XLES_DATIME=>NULL() ! date array for diachro
- REAL, DIMENSION(:,:), POINTER :: XLES_TRAJT=>NULL() ! sampling times array for diachro
+ type(date_time), dimension(:), pointer :: tles_dates => null() !Dates array
+ real, dimension(:), pointer :: xles_times => null() !Times from the start of the segment
!
REAL, DIMENSION(:), POINTER :: XLES_Z=>NULL() ! altitudes
REAL :: XLES_ZS ! mean orography
@@ -205,7 +206,6 @@ TYPE LES_t
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_U4=>NULL() ! <u'4>
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_V4=>NULL() ! <v'4>
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_W4=>NULL() ! <w'4>
- REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_Ua_ddxa_P=>NULL() ! <ua'dp'/dxa>
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_ThlPz=>NULL() ! <Thl'dp'/dz>
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_WThl2=>NULL() ! <w'Thl'2>
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_W2Thl=>NULL() ! <w'2Thl'>
@@ -338,10 +338,6 @@ TYPE LES_t
REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_VThl=>NULL() ! <v'Thl'>
! ______
REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_WThl=>NULL() ! <w'Thl'>
-! _____
- REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_ENTLES=>NULL() ! Up entr flux
-! _____
- REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_DETLES=>NULL() ! Up detr flux
! _____
REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_URt=>NULL() ! <u'Rt'>
! _____
@@ -641,10 +637,6 @@ TYPE LES_t
!
!-------------------------------------------------------------------------------
!
-!* 2-points correlations in K direction
-!
- REAL, DIMENSION(:,:,:), POINTER :: XCORRk_WW=>NULL() ! between w and w
-!
!lw and sw fluxes up and down
REAL, DIMENSION(:,:), POINTER :: XLES_SWU => NULL() !mean on the domain of the sw_up flux
!temporal serie
@@ -670,8 +662,8 @@ INTEGER, POINTER :: NLES_DTCOUNT=>NULL()
INTEGER, POINTER :: NLES_TCOUNT=>NULL()
INTEGER, POINTER :: NSPECTRA_NI=>NULL()
INTEGER, POINTER :: NSPECTRA_NJ=>NULL()
-REAL, DIMENSION(:,:), POINTER :: XLES_DATIME=>NULL()
-REAL, DIMENSION(:,:), POINTER :: XLES_TRAJT=>NULL()
+type(date_time), dimension(:), pointer :: tles_dates => null()
+real, dimension(:), pointer :: xles_times => null()
REAL, DIMENSION(:), POINTER :: XLES_Z=>NULL()
REAL, POINTER :: XLES_ZS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XCOEFLIN_LES=>NULL()
@@ -782,7 +774,6 @@ REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_W3=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_U4=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_V4=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_W4=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_Ua_ddxa_P=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_ThlPz=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_WThl2=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_RESOLVED_W2Thl=>NULL()
@@ -865,8 +856,6 @@ REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_WV=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_UThl=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_VThl=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_WThl=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_ENTLES=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_DETLES=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_URt=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_VRt=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLES_SUBGRID_WRt=>NULL()
@@ -1084,7 +1073,6 @@ REAL, DIMENSION(:,:,:), POINTER :: XCORRj_RvRv=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XCORRj_RcRc=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XCORRj_RiRi=>NULL()
REAL, DIMENSION(:,:,:,:), POINTER :: XCORRj_SvSv=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XCORRk_WW=>NULL()
REAL, DIMENSION(:,:), POINTER :: XLES_SWU=>NULL()
REAL, DIMENSION(:,:), POINTER :: XLES_SWD=>NULL()
REAL, DIMENSION(:,:), POINTER :: XLES_LWU=>NULL()
@@ -1099,8 +1087,8 @@ SUBROUTINE LES_GOTO_MODEL(KFROM, KTO)
INTEGER, INTENT(IN) :: KFROM, KTO
!
! Save current state for allocated arrays
-LES_MODEL(KFROM)%XLES_DATIME=>XLES_DATIME
-LES_MODEL(KFROM)%XLES_TRAJT=>XLES_TRAJT
+les_model(kfrom)%tles_dates=>tles_dates
+les_model(kfrom)%xles_times=>xles_times
LES_MODEL(KFROM)%XLES_Z=>XLES_Z
LES_MODEL(KFROM)%XCOEFLIN_LES=>XCOEFLIN_LES
LES_MODEL(KFROM)%NKLIN_LES=>NKLIN_LES
@@ -1210,7 +1198,6 @@ LES_MODEL(KFROM)%XLES_RESOLVED_W3=>XLES_RESOLVED_W3
LES_MODEL(KFROM)%XLES_RESOLVED_U4=>XLES_RESOLVED_U4
LES_MODEL(KFROM)%XLES_RESOLVED_V4=>XLES_RESOLVED_V4
LES_MODEL(KFROM)%XLES_RESOLVED_W4=>XLES_RESOLVED_W4
-LES_MODEL(KFROM)%XLES_RESOLVED_Ua_ddxa_P=>XLES_RESOLVED_Ua_ddxa_P
LES_MODEL(KFROM)%XLES_RESOLVED_ThlPz=>XLES_RESOLVED_ThlPz
LES_MODEL(KFROM)%XLES_RESOLVED_WThl2=>XLES_RESOLVED_WThl2
LES_MODEL(KFROM)%XLES_RESOLVED_W2Thl=>XLES_RESOLVED_W2Thl
@@ -1293,8 +1280,6 @@ LES_MODEL(KFROM)%XLES_SUBGRID_WV=>XLES_SUBGRID_WV
LES_MODEL(KFROM)%XLES_SUBGRID_UThl=>XLES_SUBGRID_UThl
LES_MODEL(KFROM)%XLES_SUBGRID_VThl=>XLES_SUBGRID_VThl
LES_MODEL(KFROM)%XLES_SUBGRID_WThl=>XLES_SUBGRID_WThl
-LES_MODEL(KFROM)%XLES_SUBGRID_ENTLES=>XLES_SUBGRID_ENTLES
-LES_MODEL(KFROM)%XLES_SUBGRID_DETLES=>XLES_SUBGRID_DETLES
LES_MODEL(KFROM)%XLES_SUBGRID_URt=>XLES_SUBGRID_URt
LES_MODEL(KFROM)%XLES_SUBGRID_VRt=>XLES_SUBGRID_VRt
LES_MODEL(KFROM)%XLES_SUBGRID_WRt=>XLES_SUBGRID_WRt
@@ -1512,7 +1497,6 @@ LES_MODEL(KFROM)%XCORRj_RvRv=>XCORRj_RvRv
LES_MODEL(KFROM)%XCORRj_RcRc=>XCORRj_RcRc
LES_MODEL(KFROM)%XCORRj_RiRi=>XCORRj_RiRi
LES_MODEL(KFROM)%XCORRj_SvSv=>XCORRj_SvSv
-LES_MODEL(KFROM)%XCORRk_WW=>XCORRk_WW
LES_MODEL(KFROM)%XLES_SWU=>XLES_SWU
LES_MODEL(KFROM)%XLES_SWD=>XLES_SWD
LES_MODEL(KFROM)%XLES_LWU=>XLES_LWU
@@ -1527,8 +1511,8 @@ NLES_DTCOUNT=>LES_MODEL(KTO)%NLES_DTCOUNT
NLES_TCOUNT=>LES_MODEL(KTO)%NLES_TCOUNT
NSPECTRA_NI=>LES_MODEL(KTO)%NSPECTRA_NI
NSPECTRA_NJ=>LES_MODEL(KTO)%NSPECTRA_NJ
-XLES_DATIME=>LES_MODEL(KTO)%XLES_DATIME
-XLES_TRAJT=>LES_MODEL(KTO)%XLES_TRAJT
+tles_dates=>les_model(kto)%tles_dates
+xles_times=>les_model(kto)%xles_times
XLES_Z=>LES_MODEL(KTO)%XLES_Z
XLES_ZS=>LES_MODEL(KTO)%XLES_ZS
XCOEFLIN_LES=>LES_MODEL(KTO)%XCOEFLIN_LES
@@ -1639,7 +1623,6 @@ XLES_RESOLVED_W3=>LES_MODEL(KTO)%XLES_RESOLVED_W3
XLES_RESOLVED_U4=>LES_MODEL(KTO)%XLES_RESOLVED_U4
XLES_RESOLVED_V4=>LES_MODEL(KTO)%XLES_RESOLVED_V4
XLES_RESOLVED_W4=>LES_MODEL(KTO)%XLES_RESOLVED_W4
-XLES_RESOLVED_Ua_ddxa_P=>LES_MODEL(KTO)%XLES_RESOLVED_Ua_ddxa_P
XLES_RESOLVED_ThlPz=>LES_MODEL(KTO)%XLES_RESOLVED_ThlPz
XLES_RESOLVED_WThl2=>LES_MODEL(KTO)%XLES_RESOLVED_WThl2
XLES_RESOLVED_W2Thl=>LES_MODEL(KTO)%XLES_RESOLVED_W2Thl
@@ -1722,8 +1705,6 @@ XLES_SUBGRID_WV=>LES_MODEL(KTO)%XLES_SUBGRID_WV
XLES_SUBGRID_UThl=>LES_MODEL(KTO)%XLES_SUBGRID_UThl
XLES_SUBGRID_VThl=>LES_MODEL(KTO)%XLES_SUBGRID_VThl
XLES_SUBGRID_WThl=>LES_MODEL(KTO)%XLES_SUBGRID_WThl
-XLES_SUBGRID_ENTLES=>LES_MODEL(KTO)%XLES_SUBGRID_ENTLES
-XLES_SUBGRID_DETLES=>LES_MODEL(KTO)%XLES_SUBGRID_DETLES
XLES_SUBGRID_URt=>LES_MODEL(KTO)%XLES_SUBGRID_URt
XLES_SUBGRID_VRt=>LES_MODEL(KTO)%XLES_SUBGRID_VRt
XLES_SUBGRID_WRt=>LES_MODEL(KTO)%XLES_SUBGRID_WRt
@@ -1941,7 +1922,6 @@ XCORRj_RvRv=>LES_MODEL(KTO)%XCORRj_RvRv
XCORRj_RcRc=>LES_MODEL(KTO)%XCORRj_RcRc
XCORRj_RiRi=>LES_MODEL(KTO)%XCORRj_RiRi
XCORRj_SvSv=>LES_MODEL(KTO)%XCORRj_SvSv
-XCORRk_WW=>LES_MODEL(KTO)%XCORRk_WW
XLES_SWU=>LES_MODEL(KTO)%XLES_SWU
XLES_SWD=>LES_MODEL(KTO)%XLES_SWD
XLES_LWU=>LES_MODEL(KTO)%XLES_LWU
diff --git a/src/MNH/modd_lg.f90 b/src/MNH/modd_lg.f90
index a2a5d840a161b904c353e52dd1a76fb0d26a06b9..80b567facd54cb7d385a01b258169b0d615230d4 100644
--- a/src/MNH/modd_lg.f90
+++ b/src/MNH/modd_lg.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 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_LG
! ##############
@@ -31,11 +26,14 @@
!! -------------
!! Original 27/06/2001
!-------------------------------------------------------------------------------
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
+
+IMPLICIT NONE
!
!* 0. DECLARATIONS
! ------------
!
-CHARACTER(LEN=10),DIMENSION(3),PARAMETER :: CLGNAMES=(/'LGX','LGY','LGZ'/)
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(3),PARAMETER :: CLGNAMES=(/'LGX','LGY','LGZ'/)
! basenames of the lagrangian articles stored
! in the binary files
REAL,PARAMETER :: XLG1MIN=-1.E+9, XLG2MIN=-1.E+9, XLG3MIN=0.
diff --git a/src/MNH/modd_mean_fieldn.f90 b/src/MNH/modd_mean_fieldn.f90
index 0bf49a62dd62c1e4cf4f52d8f5ea45cebf83e27c..38572bc0bb2cb8f50ea1bc4cd4352100af779c84 100644
--- a/src/MNH/modd_mean_fieldn.f90
+++ b/src/MNH/modd_mean_fieldn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/Attic/modd_mean_fieldn.f90,v $ $Revision: 1.1.2.1.12.1 $
-! MASDEV4_7 modd 2006/06/27 14:17:24
-!-----------------------------------------------------------------
! ###################
MODULE MODD_MEAN_FIELD_n
! ###################
@@ -51,8 +46,9 @@ TYPE MEAN_FIELD_t
REAL, DIMENSION(:,:,:), POINTER :: XTEMPM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTKEM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABSM_MEAN=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XSVT_MEAN=>NULL()
- REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL()
+ REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL(),XUW_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTH2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTEMP2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABS2_MEAN=>NULL()
@@ -76,8 +72,9 @@ REAL, DIMENSION(:,:,:), POINTER :: XTHM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTEMPM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTKEM_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABSM_MEAN=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSVT_MEAN=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XU2_MEAN=>NULL(),XV2_MEAN=>NULL(),XW2_MEAN=>NULL(),XUW_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTH2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTEMP2_MEAN=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XPABS2_MEAN=>NULL()
@@ -103,6 +100,7 @@ MEAN_FIELD_MODEL(KFROM)%XTHM_MEAN=>XTHM_MEAN
MEAN_FIELD_MODEL(KFROM)%XTEMPM_MEAN=>XTEMPM_MEAN
MEAN_FIELD_MODEL(KFROM)%XTKEM_MEAN=>XTKEM_MEAN
MEAN_FIELD_MODEL(KFROM)%XPABSM_MEAN=>XPABSM_MEAN
+MEAN_FIELD_MODEL(KFROM)%XSVT_MEAN=>XSVT_MEAN
MEAN_FIELD_MODEL(KFROM)%XUM_MAX=>XUM_MAX
MEAN_FIELD_MODEL(KFROM)%XVM_MAX=>XVM_MAX
@@ -115,6 +113,7 @@ MEAN_FIELD_MODEL(KFROM)%XPABSM_MAX=>XPABSM_MAX
MEAN_FIELD_MODEL(KFROM)%XU2_MEAN=>XU2_MEAN
MEAN_FIELD_MODEL(KFROM)%XV2_MEAN=>XV2_MEAN
MEAN_FIELD_MODEL(KFROM)%XW2_MEAN=>XW2_MEAN
+MEAN_FIELD_MODEL(KFROM)%XUW_MEAN=>XUW_MEAN
MEAN_FIELD_MODEL(KFROM)%XTH2_MEAN=>XTH2_MEAN
MEAN_FIELD_MODEL(KFROM)%XTEMP2_MEAN=>XTEMP2_MEAN
MEAN_FIELD_MODEL(KFROM)%XPABS2_MEAN=>XPABS2_MEAN
@@ -128,6 +127,7 @@ XTHM_MEAN=>MEAN_FIELD_MODEL(KTO)%XTHM_MEAN
XTEMPM_MEAN=>MEAN_FIELD_MODEL(KTO)%XTEMPM_MEAN
XTKEM_MEAN=>MEAN_FIELD_MODEL(KTO)%XTKEM_MEAN
XPABSM_MEAN=>MEAN_FIELD_MODEL(KTO)%XPABSM_MEAN
+XSVT_MEAN=>MEAN_FIELD_MODEL(KTO)%XSVT_MEAN
XUM_MAX=>MEAN_FIELD_MODEL(KTO)%XUM_MAX
XVM_MAX=>MEAN_FIELD_MODEL(KTO)%XVM_MAX
@@ -140,6 +140,7 @@ XPABSM_MAX=>MEAN_FIELD_MODEL(KTO)%XPABSM_MAX
XU2_MEAN=>MEAN_FIELD_MODEL(KTO)%XU2_MEAN
XV2_MEAN=>MEAN_FIELD_MODEL(KTO)%XV2_MEAN
XW2_MEAN=>MEAN_FIELD_MODEL(KTO)%XW2_MEAN
+XUW_MEAN=>MEAN_FIELD_MODEL(KTO)%XUW_MEAN
XTH2_MEAN=>MEAN_FIELD_MODEL(KTO)%XTH2_MEAN
XTEMP2_MEAN=>MEAN_FIELD_MODEL(KTO)%XTEMP2_MEAN
XPABS2_MEAN=>MEAN_FIELD_MODEL(KTO)%XPABS2_MEAN
diff --git a/src/MNH/modd_mnh_surfexn.f90 b/src/MNH/modd_mnh_surfexn.f90
index 5863841a2e60edefea80eac670e1d60e63ffaaa7..ce56aad27ac4ab9b84403d8bc04933a10245c6f1 100644
--- a/src/MNH/modd_mnh_surfexn.f90
+++ b/src/MNH/modd_mnh_surfexn.f90
@@ -1,3 +1,13 @@
+!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.
+!-----------------------------------------------------------------
+! Author:
+! ???
+! Modifications:
+! P. Wautelet 06/07/2021: secure SURFEX_DEALLO_LIST (possibility to call it even if YSURF_LIST not allocated)
+!-----------------------------------------------------------------
MODULE MODD_MNH_SURFEX_n
!
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
@@ -57,12 +67,15 @@ INTEGER :: J
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (LHOOK) CALL DR_HOOK("MODD_MNH_SURFEX_n:SURFEX_DEALLO_LIST",0,ZHOOK_HANDLE)
!
-DO J=1,SIZE(YSURF_LIST)
- CALL SURFEX_DEALLO(YSURF_LIST(J))
-ENDDO
+IF ( ASSOCIATED( YSURF_CUR ) ) NULLIFY(YSURF_CUR)
!
-IF (ASSOCIATED(YSURF_CUR)) NULLIFY(YSURF_CUR)
-IF (ALLOCATED(YSURF_LIST)) DEALLOCATE(YSURF_LIST)
+IF ( ALLOCATED( YSURF_LIST ) ) THEN
+ DO J = 1, SIZE( YSURF_LIST )
+ CALL SURFEX_DEALLO( YSURF_LIST(J) )
+ ENDDO
+ !
+ DEALLOCATE(YSURF_LIST)
+END IF
!
IF (LHOOK) CALL DR_HOOK("MODD_MNH_SURFEX_n:SURFEX_DEALLO_LIST",1,ZHOOK_HANDLE)
!
diff --git a/src/MNH/modd_nsv.f90 b/src/MNH/modd_nsv.f90
index 2417f728a4b1ac4058cbfb41d3850a406cbacb6a..7a842a5c1cacb3073ca3daa6139f327c1ed1543e 100644
--- a/src/MNH/modd_nsv.f90
+++ b/src/MNH/modd_nsv.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
! ###############
MODULE MODD_NSV
! ###############
@@ -27,14 +28,17 @@
!! Pialat/Tulet 15/02/12 add ForeFire
!! 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
! ------------
!
-USE MODD_PARAMETERS, ONLY : JPMODELMAX,& ! Maximum allowed number of nested models
- JPSVMAX ! Maximum number of scalar variables
+USE MODD_PARAMETERS, ONLY : JPMODELMAX, & ! Maximum allowed number of nested models
+ JPSVMAX, & ! Maximum number of scalar variables
+ JPSVNAMELGTMAX ! Maximum length of a scalar variable name
!
IMPLICIT NONE
SAVE
@@ -43,6 +47,8 @@ REAL,DIMENSION(JPSVMAX) :: XSVMIN ! minimum value for SV variables
!
LOGICAL :: LINI_NSV = .FALSE. ! becomes True when routine INI_NSV is called
!
+CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE, TARGET :: CSVNAMES_A !Names of all the scalar variables
+
INTEGER,DIMENSION(JPMODELMAX)::NSV_A = 0 ! total number of scalar variables
! NSV_A = NSV_USER_A+NSV_C2R2_A+NSV_CHEM_A+..
INTEGER,DIMENSION(JPMODELMAX)::NSV_USER_A = 0 ! number of user scalar variables with
@@ -129,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
@@ -144,6 +151,7 @@ INTEGER,DIMENSION(JPMODELMAX)::NSV_SNWEND_A = 0 ! NSV_SNWBEG_A...NSV_SNWEND_A
!
! variables updated for the current model
!
+CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(:), POINTER :: CSVNAMES !Names of all the scalar variables
CHARACTER(LEN=6), DIMENSION(:), ALLOCATABLE :: CSV ! name of the scalar variables
INTEGER :: NSV = 0 ! total number of user scalar variables
!
@@ -230,6 +238,7 @@ INTEGER :: NSV_LIMA_IFN_FREE !
INTEGER :: NSV_LIMA_IFN_NUCL !
INTEGER :: NSV_LIMA_IMM_NUCL !
INTEGER :: NSV_LIMA_HOM_HAZE !
+INTEGER :: NSV_LIMA_SPRO !
!
#ifdef MNH_FOREFIRE
INTEGER :: NSV_FF = 0 ! number of ForeFire scalar variables
diff --git a/src/MNH/modd_oceanh.f90 b/src/MNH/modd_oceanh.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e9936173ec35b1d57c9884cd19cd98774c9d0334
--- /dev/null
+++ b/src/MNH/modd_oceanh.f90
@@ -0,0 +1,47 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #################
+ MODULE MODD_OCEANH
+! #################
+!
+!!**** *MODD_OCEAN* - declaration of variables used in ocean version
+!!
+!! PURPOSE
+!! -------
+! Declarative module for the variables
+!! at interface for OCEAN LES MESONH version including auto-coupling O-A LES
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! AUTHOR
+!! ------
+!! JL Redelsperger LOPS
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 03/2021
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_TYPE_DATE
+!
+IMPLICIT NONE
+!
+!* fields for Sea Sfc FORCINGs
+! ------------------
+!
+INTEGER, SAVE :: NFRCLT ! number of sea surface forcings PLUS 1
+INTEGER, SAVE :: NINFRT ! Interval in second between forcings
+TYPE (DATE_TIME), SAVE, DIMENSION(:), ALLOCATABLE :: TFRCLT ! date/time of sea surface forcings
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XSSUFL,XSSVFL,XSSTFL,XSSOLA ! Time evol Flux U V T Solar_Rad at sea surface
+REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XSSUFL_XY,XSSVFL_XY,XSSTFL_XY! XY flux shape
+REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XSSUFL_T,XSSVFL_T,XSSTFL_T,XSSOLA_T ! given time forcing fluxes
+!
+END MODULE MODD_OCEANH
diff --git a/src/MNH/modd_param_ecradn.f90 b/src/MNH/modd_param_ecradn.f90
index a7bf0b344753be234bbed47285ed5880b1de3018..3be9a339116b1b1db0928a80979b3a923350681c 100644
--- a/src/MNH/modd_param_ecradn.f90
+++ b/src/MNH/modd_param_ecradn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2017-2019 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.
@@ -42,6 +42,9 @@
USE MODD_PARAMETERS, ONLY: JPMODELMAX
USE PARKIND1 , ONLY : JPIM,JPRB
#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH
+#endif
USE radiation_config, ONLY : config_type
#endif
IMPLICIT NONE
@@ -59,6 +62,18 @@ TYPE PARAM_ECRAD_t
INTEGER(KIND=JPIM) :: NRADIP ! 0: 40 mum, 1: Liou and Ou (1994), 2: Liou and Ou (1994) improved,
! 3: Sun and Rikus (1999)
REAL(KIND=JPRB) :: XCLOUD_FRAC_STD ! Cloud water content horizontal fractional standard deviation in a gridbox
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ LOGICAL :: LSPEC_ALB
+ LOGICAL :: LSPEC_EMISS
+ REAL(KIND=JPRB), DIMENSION(14) :: USER_ALB_DIFF
+ REAL(KIND=JPRB), DIMENSION(14) :: USER_ALB_DIR
+ REAL(KIND=JPRB), DIMENSION(16) :: USER_EMISS
+
+ CHARACTER (LEN=4) :: SURF_TYPE
+#endif
+#endif
+
INTEGER(KIND=JPIM) :: NLWSCATTERING ! 0: No longwave scattering
! 1: Longwave scattering by clouds only
! 2: Longwave scattering by clouds and aerosols
@@ -192,6 +207,16 @@ REAL(KIND=JPRB), POINTER :: XRMINICE=>NULL()
INTEGER(KIND=JPIM), POINTER :: NMINICE=>NULL()
INTEGER(KIND=JPIM), POINTER :: NDECOLAT=>NULL()
REAL(KIND=JPRB), POINTER :: XCLOUD_FRAC_STD=>NULL()
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+LOGICAL, POINTER :: LSPEC_ALB=>NULL()
+LOGICAL, POINTER :: LSPEC_EMISS=>NULL()
+REAL(KIND=JPRB), DIMENSION(:), POINTER :: USER_ALB_DIFF=>NULL()
+REAL(KIND=JPRB), DIMENSION(:), POINTER :: USER_ALB_DIR=>NULL()
+REAL(KIND=JPRB), DIMENSION(:), POINTER :: USER_EMISS=>NULL()
+CHARACTER(LEN=4), POINTER :: SURF_TYPE
+#endif
+#endif
!INTEGER, POINTER :: NSW=>NULL()
!INTEGER, POINTER :: NSW_EC=>NULL()
REAL(KIND=JPRB), POINTER :: XCCH4=>NULL()
@@ -261,6 +286,16 @@ INTEGER, INTENT(IN) :: KFROM, KTO
NMINICE=>PARAM_ECRAD_MODEL(KTO)%NMINICE
NDECOLAT=>PARAM_ECRAD_MODEL(KTO)%NDECOLAT
XCLOUD_FRAC_STD=>PARAM_ECRAD_MODEL(KTO)%XCLOUD_FRAC_STD
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ LSPEC_ALB=>PARAM_ECRAD_MODEL(KTO)%LSPEC_ALB
+ LSPEC_EMISS=>PARAM_ECRAD_MODEL(KTO)%LSPEC_EMISS
+ USER_ALB_DIFF=>PARAM_ECRAD_MODEL(KTO)%USER_ALB_DIFF
+ USER_ALB_DIR=>PARAM_ECRAD_MODEL(KTO)%USER_ALB_DIR
+ USER_EMISS=>PARAM_ECRAD_MODEL(KTO)%USER_EMISS
+ SURF_TYPE=>PARAM_ECRAD_MODEL(KTO)%SURF_TYPE
+#endif
+#endif
! NSW=>PARAM_ECRAD_MODEL(KTO)%NSW
! NSW_EC=>PARAM_ECRAD_MODEL(KTO)%NSW_EC
XCCH4=>PARAM_ECRAD_MODEL(KTO)%XCCH4
diff --git a/src/MNH/modd_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_cold.f90 b/src/MNH/modd_param_lima_cold.f90
index 2df3032ba305cac20467c695bd73119ccb42ad43..64494219e13b43678a4600d0f3de3c5a3291241c 100644
--- a/src/MNH/modd_param_lima_cold.f90
+++ b/src/MNH/modd_param_lima_cold.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_COLD
! ###########################
@@ -16,6 +21,7 @@
!! Original ??/??/13
!!
!-------------------------------------------------------------------------------
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
!
IMPLICIT NONE
!
@@ -48,7 +54,7 @@ REAL,SAVE :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
REAL,SAVE :: XLBDAS_MAX ! Max values allowed for the shape
! parameter of snow
!
-CHARACTER(LEN=8),DIMENSION(5),PARAMETER &
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
:: CLIMA_COLD_NAMES=(/'CICE ','CIFNFREE','CIFNNUCL', &
'CCNINIMM','CCCNNUCL'/)
! basenames of the SV articles stored
@@ -57,7 +63,7 @@ CHARACTER(LEN=8),DIMENSION(5),PARAMETER &
! IN:Ice-nuclei Nucleated (activated IFN by Dep/Cond)
! NI:Nuclei Immersed (activated IFN by Imm)
! HF:Homogeneous Freezing
-CHARACTER(LEN=3),DIMENSION(5),PARAMETER &
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(5),PARAMETER &
:: CLIMA_COLD_CONC=(/'NI ','NIF','NIN','NNI','NNH'/)!for DIAG
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/modd_param_lima_warm.f90 b/src/MNH/modd_param_lima_warm.f90
index d0688aa72acecbfa45b0810043a36b5386ffe2cb..65a3d10279364cb382048f19ed657c7eca2d2c39 100644
--- a/src/MNH/modd_param_lima_warm.f90
+++ b/src/MNH/modd_param_lima_warm.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_WARM
! ###########################
@@ -16,6 +21,7 @@
!! Original ??/??/13
!!
!-------------------------------------------------------------------------------
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
!
IMPLICIT NONE
!
@@ -30,17 +36,17 @@ REAL,SAVE :: XAR,XBR,XCR,XDR,XF0R,XF1R, & ! Raindrop charact.
XAC,XBC,XCC,XDC,XF0C,XF2C,XC1C ! Cloud droplet charact.
!
!
-CHARACTER(LEN=8),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=5),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
!
!* Special issue for Below-Cloud SCAVenging of Aerosol particles
-CHARACTER(LEN=6),DIMENSION(2) :: CAERO_MASS =(/'MASSAP', 'MAP '/)
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(2) :: CAERO_MASS =(/'MASSAP', 'MAP '/)
!
!-------------------------------------------------------------------------------
!
@@ -70,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_parameters.f90 b/src/MNH/modd_parameters.f90
index 8b0c0a4fcbed60e0f60b94df6c8e11102ad4b77b..c21c6e70955e1e1ecbe501225f6d3f83dd66a1ec 100644
--- a/src/MNH/modd_parameters.f90
+++ b/src/MNH/modd_parameters.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ######################
@@ -29,7 +29,7 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original 4/07/94
+!! Original 4/07/94
!! Modification 10/03/95 (I.Mallet) add the coupling files maximum number
!! Modification 10/04/95 (Ph. Hereil) add the budget related informations
!! Modification 15/03/99 (V. Masson) add default value
@@ -39,8 +39,10 @@
!! Modification 17/05/04 (P.Jabouille) add JPOUTMAX
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! B.VIE 2016 LIMA
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! Q. Rodier : 29/03/2019 : increase maximum number of outputs to 999
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! Q. Rodier 29/03/2019: increase maximum number of outputs to 999
+! P. Wautelet 17/01/2020: add NBUNAMELGTMAX and NCOMMENTLGTMAX parameters
+! P. Wautelet 13/03/2020: remove JPBUMAX and JPBUPROMAX
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -57,12 +59,10 @@ INTEGER, PARAMETER :: JPVEXT = 1 ! Vertical External points number
INTEGER, PARAMETER :: JPVEXT_TURB = 1 ! Vertical External points number
INTEGER, PARAMETER :: JPMODELMAX = 8 ! Maximum allowed number of nested models
INTEGER, PARAMETER :: JPCPLFILEMAX = 24 ! Maximum allowed number of CouPLing FILEs
-INTEGER, PARAMETER :: JPBUMAX= 250 ! Maximum of allowed budgets
-INTEGER, PARAMETER :: JPBUPROMAX = 60 ! Maximum of allowed processes for all
- ! budgets
INTEGER, PARAMETER :: JPRIMMAX = 6 ! Maximum number of points for the
! horizontal relaxation for the outermost verticals
INTEGER, PARAMETER :: JPSVMAX = 200 ! Maximum number of scalar variables
+INTEGER, PARAMETER :: JPSVNAMELGTMAX = 10 ! Maximum length of a scalar variable name (do not set to less than 10)
!
!
REAL, PARAMETER :: XUNDEF = 999. ! default value for undefined or unused
@@ -78,8 +78,10 @@ INTEGER, PARAMETER :: JPDUMMY = 20 ! Size of dummy array
INTEGER, PARAMETER :: JPOUTMAX = 999 ! Maximum allowed number of OUTput files
INTEGER, PARAMETER :: JPOUTVARMAX = 192 ! Maximum allowed number of variables in an output file
!
-INTEGER, PARAMETER :: NMNHNAMELGTMAX = 32 ! Maximum length of a MNH variable name
-INTEGER, PARAMETER :: NSTDNAMELGTMAX = 64 ! Maximum length of the standard name of a variable (CF convention)
+INTEGER, PARAMETER :: NBUNAMELGTMAX = 32 ! Maximum length of a budget name
+INTEGER, PARAMETER :: NCOMMENTLGTMAX = 100 ! Maximum length of a comment
+INTEGER, PARAMETER :: NMNHNAMELGTMAX = 32 ! Maximum length of a MNH variable name
+INTEGER, PARAMETER :: NSTDNAMELGTMAX = 64 ! Maximum length of the standard name of a variable (CF convention)
!
INTEGER, PARAMETER :: NDIRNAMELGTMAX = 512 ! Maximum length of a directory name
INTEGER, PARAMETER :: NFILENAMELGTMAX = 32 ! Maximum length of a file name (must be at least NFILENAMELGTMAXLFI)
diff --git a/src/MNH/modd_precision.f90 b/src/MNH/modd_precision.f90
index b7cec6c0ef345fa9f69cb7fbbd7528234dc99e3b..a759ddf1f11072a20864f52cc148e8e3fa66d79d 100644
--- a/src/MNH/modd_precision.f90
+++ b/src/MNH/modd_precision.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2019-2019 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 for details. version 1.
@@ -9,6 +9,7 @@
! P. Wautelet 22/03/2019: add MNHINT/REAL32/64_MPI, MNH2REAL32/64_MPI + more public parameters
! P. Wautelet 27/03/2019: add MNHTIME and MNHTIME_MPI
! P. Wautelet 26/04/2019: add MNHLOG and MNHLOG_MPI/MNHLOG32_MPI/MNHLOG64_MPI
+! P. Wautelet 06/01/2021: use kind=CDFINT to define parameters used in netCDF calls
!-----------------------------------------------------------------
module modd_precision
@@ -53,8 +54,13 @@ integer, parameter :: MNHREAL128 = selected_real_kind( p = 33, r = 4931 )
integer, parameter :: MNHINT32_MPI = MPI_INTEGER4
integer, parameter :: MNHINT64_MPI = MPI_INTEGER8
+#ifdef MNH_NO_MPI_LOGICAL48
+integer, parameter :: MNHLOG32_MPI = MPI_LOGICAL
+integer, parameter :: MNHLOG64_MPI = MPI_LOGICAL
+#else
integer, parameter :: MNHLOG32_MPI = MPI_LOGICAL4
integer, parameter :: MNHLOG64_MPI = MPI_LOGICAL8
+#endif
integer, parameter :: MNHREAL32_MPI = MPI_REAL4
integer, parameter :: MNHREAL64_MPI = MPI_REAL8
@@ -113,17 +119,17 @@ integer, parameter :: LFIINT = MNHINT64
integer, parameter :: CDFINT = selected_int_kind( r = 9 )
#if (MNH_INT == 4)
-integer, parameter :: MNHINT_NF90 = NF90_INT
+integer(kind=CDFINT), parameter :: MNHINT_NF90 = NF90_INT
#elif (MNH_INT == 8)
-integer, parameter :: MNHINT_NF90 = NF90_INT64
+integer(kind=CDFINT), parameter :: MNHINT_NF90 = NF90_INT64
#else
#error "Invalid MNH_INT"
#endif
#if (MNH_REAL == 4)
-integer, parameter :: MNHREAL_NF90 = NF90_FLOAT
+integer(kind=CDFINT), parameter :: MNHREAL_NF90 = NF90_FLOAT
#elif (MNH_REAL == 8)
-integer, parameter :: MNHREAL_NF90 = NF90_DOUBLE
+integer(kind=CDFINT), parameter :: MNHREAL_NF90 = NF90_DOUBLE
#else
#error "Invalid MNH_REAL"
#endif
diff --git a/src/MNH/modd_prep_real.f90 b/src/MNH/modd_prep_real.f90
index d2d06321744568f7b2f1caf138f96388ff092c75..6933ae26a8f64486b93121fa44923c6a8a67774a 100644
--- a/src/MNH/modd_prep_real.f90
+++ b/src/MNH/modd_prep_real.f90
@@ -28,6 +28,7 @@
!! Original 05/05
!! 05/06 (I.Mallet) add *_SV_* variables to allow chemical
!! initialization from HCHEMFILE
+!! 09/20 (Q. Rodier) add geopotential height for GFS GRIB read
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -70,6 +71,7 @@ REAL :: XLEN2_LS ! Decay scale for small-scale
REAL,DIMENSION(:,:), ALLOCATABLE :: XPS_LS ! surface pressure
REAL,DIMENSION(:,:), ALLOCATABLE :: XZS_LS ! orography
REAL,DIMENSION(:,:), ALLOCATABLE :: XZSMT_LS ! smooth orography
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: XGH_LS ! geopotential height
REAL,DIMENSION(:,:,:), ALLOCATABLE :: XZFLUX_LS! altitude of pressure points
REAL,DIMENSION(:,:,:), ALLOCATABLE :: XZMASS_LS! altitude of mass points
REAL,DIMENSION(:,:,:), ALLOCATABLE :: XPMHP_LS ! pressure minus hyd. pressure
diff --git a/src/MNH/modd_radiationsn.f90 b/src/MNH/modd_radiationsn.f90
index b8403e23a60d3a5a35a5bc728028de07da268da2..2036ab07bd9463f837c2b2d0548cf8b5528f69b1 100644
--- a/src/MNH/modd_radiationsn.f90
+++ b/src/MNH/modd_radiationsn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -59,6 +59,11 @@ TYPE RADIATIONS_t
INTEGER :: NRAD ! number of satellite radiances to synthesize
INTEGER :: NAER ! number od AERosol classes
INTEGER :: NSWB_OLD ! number of SW bands in ECMWF original code (usually 6)
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ INTEGER :: NLWB_OLD ! number of LW bands for emissivity original code (usually 2)
+#endif
+#endif
INTEGER :: NSWB_MNH! number of SW bands practically used (14 if ECRAD, NSWB if original code)
INTEGER :: NLWB_MNH! number of LW bands practically used (16 if RRTM)
INTEGER :: NSTATM ! index od the STAndard ATMosphere level just above
@@ -132,6 +137,11 @@ INTEGER, POINTER :: NFLUX=>NULL()
INTEGER, POINTER :: NRAD=>NULL()
INTEGER, POINTER :: NAER=>NULL()
INTEGER, POINTER :: NSWB_OLD=>NULL()
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+INTEGER, POINTER :: NLWB_OLD=>NULL()
+#endif
+#endif
INTEGER, POINTER :: NSWB_MNH=>NULL()
INTEGER, POINTER :: NLWB_MNH=>NULL()
INTEGER, POINTER :: NSTATM=>NULL()
@@ -223,6 +233,11 @@ NFLUX=>RADIATIONS_MODEL(KTO)%NFLUX
NRAD=>RADIATIONS_MODEL(KTO)%NRAD
NAER=>RADIATIONS_MODEL(KTO)%NAER
NSWB_OLD=>RADIATIONS_MODEL(KTO)%NSWB_OLD
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+NLWB_OLD=>RADIATIONS_MODEL(KTO)%NLWB_OLD
+#endif
+#endif
NSWB_MNH=>RADIATIONS_MODEL(KTO)%NSWB_MNH
NLWB_MNH=>RADIATIONS_MODEL(KTO)%NLWB_MNH
NSTATM=>RADIATIONS_MODEL(KTO)%NSTATM
diff --git a/src/MNH/modd_rain_c2r2_descr.f90 b/src/MNH/modd_rain_c2r2_descr.f90
index a7d71b5510d191cbe04796cfe5c19b6ad1617aac..82146aac4fbb15f11b6e90534fec2dab76af9772 100644
--- a/src/MNH/modd_rain_c2r2_descr.f90
+++ b/src/MNH/modd_rain_c2r2_descr.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 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.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modd 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###########################
MODULE MODD_RAIN_C2R2_DESCR
! ###########################
@@ -50,6 +45,7 @@
!! J.-P. Pinty 29/11/02 add cloud doplet fall speed parameters
!!
!-------------------------------------------------------------------------------
+USE MODD_PARAMETERS, ONLY: JPSVNAMELGTMAX
!
!* 0. DECLARATIONS
! ------------
@@ -66,7 +62,7 @@ REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XCTMIN
REAL,SAVE :: XLBC, XLBEXC, & ! shape parameters of the cloud droplets
XLBR, XLBEXR ! shape parameters of the raindrops
!
-CHARACTER(LEN=10),DIMENSION(4),PARAMETER &
+CHARACTER(LEN=JPSVNAMELGTMAX),DIMENSION(4),PARAMETER &
:: C2R2NAMES=(/'CCCN ','CCLOUD','CRAIN ','SUPSAT'/)
! basenames of the SV articles stored
! in the binary files
diff --git a/src/MNH/modd_recycl_paramn.f90 b/src/MNH/modd_recycl_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bfc4d7b3e7d1c7c605b745dc00316ea44705f280
--- /dev/null
+++ b/src/MNH/modd_recycl_paramn.f90
@@ -0,0 +1,169 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+ MODULE MODD_RECYCL_PARAM_n
+! #######################
+!
+!**** MODD_RECYCL_PARAM_n - declaration of the control parameters
+! used in the turbulence recycling method
+!
+! PURPOSE
+! -------
+!**** The purpose of this module is to declare the constants
+! allowing to initialize the turbulence recycling method
+!
+!
+! IMPLICIT ARGUMENTS
+! ------------------
+! None
+!
+! REFERENCE
+! ---------
+!
+! AUTHOR
+! ------
+! Tim Nagel (Meteo-France)
+!
+! MODIFICATIONS
+! -------------
+! Original 01/02/2021
+!
+!------------------------------------------------------------------------------
+!
+!**** 0. DECLARATIONS
+! ---------------
+!
+USE MODD_PARAMETERS, ONLY: JPMODELMAX
+IMPLICIT NONE
+!
+TYPE RECYCL_t
+!
+LOGICAL :: LRECYCL,LRECYCLN,LRECYCLW,LRECYCLE,LRECYCLS ! Recycling logical
+REAL :: XDRECYCLN,XDRECYCLW,XDRECYCLE,XDRECYCLS, &
+ XARECYCLN,XARECYCLW,XARECYCLE,XARECYCLS, &
+ XTMOY,XTMOYCOUNT,XNUMBELT,XRCOEFF,XTBVTOP,XTBVBOT
+
+INTEGER :: NR_COUNT
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANW=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANW=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANW=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANN=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANN=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANN=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANE=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANE=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANE=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XUMEANS=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XVMEANS=>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XWMEANS=>NULL()
+!
+END TYPE RECYCL_t
+
+TYPE(RECYCL_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: RECYCL_MODEL
+
+LOGICAL ,POINTER :: LRECYCL=>NULL()
+LOGICAL ,POINTER :: LRECYCLN=>NULL()
+LOGICAL ,POINTER :: LRECYCLW=>NULL()
+LOGICAL ,POINTER :: LRECYCLE=>NULL()
+LOGICAL ,POINTER :: LRECYCLS=>NULL()
+
+REAL ,POINTER :: XDRECYCLN=>NULL()
+REAL ,POINTER :: XARECYCLN=>NULL()
+REAL ,POINTER :: XDRECYCLW=>NULL()
+REAL ,POINTER :: XARECYCLW=>NULL()
+REAL ,POINTER :: XDRECYCLE=>NULL()
+REAL ,POINTER :: XARECYCLE=>NULL()
+REAL ,POINTER :: XDRECYCLS=>NULL()
+REAL ,POINTER :: XARECYCLS=>NULL()
+REAL ,POINTER :: XTMOY=>NULL()
+REAL ,POINTER :: XTMOYCOUNT=>NULL()
+REAL ,POINTER :: XNUMBELT=>NULL()
+REAL ,POINTER :: XRCOEFF=>NULL()
+REAL ,POINTER :: XTBVTOP=>NULL()
+REAL ,POINTER :: XTBVBOT=>NULL()
+
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANW=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANW=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANW=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANN=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANN=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANN=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANE=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANE=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANE=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XUMEANS=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XVMEANS=>NULL()
+REAL, DIMENSION(:,:,:),POINTER :: XWMEANS=>NULL()
+
+
+
+INTEGER ,POINTER :: NR_COUNT =>NULL()
+REAL, DIMENSION(:,:,:) ,POINTER :: XTBV=>NULL()
+
+CONTAINS
+
+SUBROUTINE RECYCL_GOTO_MODEL(KFROM, KTO)
+
+INTEGER, INTENT(IN) :: KFROM, KTO
+!
+! Save current state for allocated arrays
+RECYCL_MODEL(KFROM)%XUMEANW=>XUMEANW
+RECYCL_MODEL(KFROM)%XVMEANW=>XVMEANW
+RECYCL_MODEL(KFROM)%XWMEANW=>XWMEANW
+RECYCL_MODEL(KFROM)%XUMEANN=>XUMEANN
+RECYCL_MODEL(KFROM)%XVMEANN=>XVMEANN
+RECYCL_MODEL(KFROM)%XWMEANN=>XWMEANN
+RECYCL_MODEL(KFROM)%XUMEANE=>XUMEANE
+RECYCL_MODEL(KFROM)%XVMEANE=>XVMEANE
+RECYCL_MODEL(KFROM)%XWMEANE=>XWMEANE
+RECYCL_MODEL(KFROM)%XUMEANS=>XUMEANS
+RECYCL_MODEL(KFROM)%XVMEANS=>XVMEANS
+RECYCL_MODEL(KFROM)%XWMEANS=>XWMEANS
+
+
+!
+! Current model is set to model KTO
+LRECYCL=>RECYCL_MODEL(KTO)%LRECYCL
+LRECYCLN=>RECYCL_MODEL(KTO)%LRECYCLN
+LRECYCLW=>RECYCL_MODEL(KTO)%LRECYCLW
+LRECYCLE=>RECYCL_MODEL(KTO)%LRECYCLE
+LRECYCLS=>RECYCL_MODEL(KTO)%LRECYCLS
+XDRECYCLN=>RECYCL_MODEL(KTO)%XDRECYCLN
+XARECYCLN=>RECYCL_MODEL(KTO)%XARECYCLN
+XDRECYCLW=>RECYCL_MODEL(KTO)%XDRECYCLW
+XARECYCLW=>RECYCL_MODEL(KTO)%XARECYCLW
+XDRECYCLE=>RECYCL_MODEL(KTO)%XDRECYCLE
+XARECYCLE=>RECYCL_MODEL(KTO)%XARECYCLE
+XDRECYCLS=>RECYCL_MODEL(KTO)%XDRECYCLS
+XARECYCLS=>RECYCL_MODEL(KTO)%XARECYCLS
+XTMOY=>RECYCL_MODEL(KTO)%XTMOY
+XTMOYCOUNT=>RECYCL_MODEL(KTO)%XTMOYCOUNT
+XNUMBELT=>RECYCL_MODEL(KTO)%XNUMBELT
+XRCOEFF=>RECYCL_MODEL(KTO)%XRCOEFF
+XTBVTOP=>RECYCL_MODEL(KTO)%XTBVTOP
+XTBVBOT=>RECYCL_MODEL(KTO)%XTBVBOT
+
+XUMEANW=>RECYCL_MODEL(KTO)%XUMEANW
+XVMEANW=>RECYCL_MODEL(KTO)%XVMEANW
+XWMEANW=>RECYCL_MODEL(KTO)%XWMEANW
+XUMEANN=>RECYCL_MODEL(KTO)%XUMEANN
+XVMEANN=>RECYCL_MODEL(KTO)%XVMEANN
+XWMEANN=>RECYCL_MODEL(KTO)%XWMEANN
+XUMEANE=>RECYCL_MODEL(KTO)%XUMEANE
+XVMEANE=>RECYCL_MODEL(KTO)%XVMEANE
+XWMEANE=>RECYCL_MODEL(KTO)%XWMEANE
+XUMEANS=>RECYCL_MODEL(KTO)%XUMEANS
+XVMEANS=>RECYCL_MODEL(KTO)%XVMEANS
+XWMEANS=>RECYCL_MODEL(KTO)%XWMEANS
+
+NR_COUNT=>RECYCL_MODEL(KTO)%NR_COUNT
+
+END SUBROUTINE RECYCL_GOTO_MODEL
+
+END MODULE MODD_RECYCL_PARAM_n
+!
+
diff --git a/src/MNH/modd_ref.f90 b/src/MNH/modd_ref.f90
index 8b2f932878b87b893353170624ea8473cf167f79..3d1e6025ba5ac880c2d388e7adfe3be615ad2099 100644
--- a/src/MNH/modd_ref.f90
+++ b/src/MNH/modd_ref.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ###############
@@ -46,6 +46,13 @@ REAL,SAVE, DIMENSION(:), ALLOCATABLE, TARGET :: XRHODREFZ ! rhod(z) for referenc
REAL,SAVE, DIMENSION(:), ALLOCATABLE, TARGET :: XTHVREFZ ! Thetav(z) for reference
! state without orography
REAL,SAVE :: XEXNTOP ! Exner function at model top
+!
+! For coupled A-O case
+REAL,SAVE, DIMENSION(:), ALLOCATABLE, TARGET :: XRHODREFZO! rhod(z) for ocean ref state in coupled mode
+REAL,SAVE, DIMENSION(:), ALLOCATABLE, TARGET :: XTHVREFZO !Thetav(z) for ocean ref state in coupled mode
+REAL,SAVE :: XEXNTOPO ! Exner function at ocean model top in coupled mode
+!
LOGICAL, SAVE :: LBOUSS ! Boussinesq approximation
+LOGICAL, SAVE ::LCOUPLES ! AUTOCOUPLED ATMS-OCEAN LES VERSION
!
END MODULE MODD_REF
diff --git a/src/MNH/modd_seriesn.f90 b/src/MNH/modd_seriesn.f90
index 0078ed222a0d9db9bf9f232a32187e60021fdcec..b407ae675e0c28458fbc50ca03bcce61e273d138 100644
--- a/src/MNH/modd_seriesn.f90
+++ b/src/MNH/modd_seriesn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 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 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_SERIES_n
! ####################
@@ -37,12 +32,16 @@
!! Original 29/01/98
!! 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
! ------------
!
USE MODD_PARAMETERS, ONLY: JPMODELMAX
+use modd_type_date, only: date_time
+
IMPLICIT NONE
TYPE SERIES_t
@@ -68,8 +67,7 @@ TYPE SERIES_t
REAL, DIMENSION(:,:,:,:,:,:), POINTER :: XSSERIES1=>NULL() ! 1st group: temporal serie (t)
REAL, DIMENSION(:,:,:,:,:,:), POINTER :: XSSERIES2=>NULL() ! 2nd group:temporal serie (z,t)
REAL, DIMENSION(:,:,:,:,:,:), POINTER :: XSSERIES3=>NULL() ! 3rd group:temporal serie (x,t)
- REAL, DIMENSION(:,:) , POINTER :: XSTRAJT=>NULL() ! time trajectory
- REAL, DIMENSION(:,:), POINTER :: XSDATIME=>NULL() ! Dates of exp, seg and current
+ type(date_time), dimension(:), pointer :: tpsdates => NULL() ! dates
CHARACTER(LEN=50),DIMENSION(:),POINTER :: CSCOMMENT1=>NULL() ! strings
! associated with the 1st group
CHARACTER(LEN=50),DIMENSION(:),POINTER :: CSCOMMENT2=>NULL() ! with the 2nd
@@ -82,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
@@ -128,8 +129,7 @@ INTEGER, POINTER :: NSTEMP_SERIE3=>NULL()
REAL, DIMENSION(:,:,:,:,:,:), POINTER :: XSSERIES1=>NULL()
REAL, DIMENSION(:,:,:,:,:,:), POINTER :: XSSERIES2=>NULL()
REAL, DIMENSION(:,:,:,:,:,:), POINTER :: XSSERIES3=>NULL()
-REAL, DIMENSION(:,:), POINTER :: XSTRAJT=>NULL()
-REAL, DIMENSION(:,:), POINTER :: XSDATIME=>NULL()
+type(date_time), dimension(:), pointer :: tpsdates => NULL()
CHARACTER(LEN=50),DIMENSION(:),POINTER :: CSCOMMENT1=>NULL()
CHARACTER(LEN=50),DIMENSION(:),POINTER :: CSCOMMENT2=>NULL()
CHARACTER(LEN=50),DIMENSION(:),POINTER :: CSCOMMENT3=>NULL()
@@ -139,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()
@@ -175,8 +178,7 @@ ENDIF
SERIES_MODEL(KFROM)%XSSERIES1=>XSSERIES1
SERIES_MODEL(KFROM)%XSSERIES2=>XSSERIES2
SERIES_MODEL(KFROM)%XSSERIES3=>XSSERIES3
-SERIES_MODEL(KFROM)%XSTRAJT=>XSTRAJT
-SERIES_MODEL(KFROM)%XSDATIME=>XSDATIME
+series_model(kfrom)%tpsdates=>tpsdates
SERIES_MODEL(KFROM)%CSCOMMENT1=>CSCOMMENT1
SERIES_MODEL(KFROM)%CSCOMMENT2=>CSCOMMENT2
SERIES_MODEL(KFROM)%CSCOMMENT3=>CSCOMMENT3
@@ -186,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
@@ -215,8 +220,7 @@ NSTEMP_SERIE3=>SERIES_MODEL(KTO)%NSTEMP_SERIE3
XSSERIES1=>SERIES_MODEL(KTO)%XSSERIES1
XSSERIES2=>SERIES_MODEL(KTO)%XSSERIES2
XSSERIES3=>SERIES_MODEL(KTO)%XSSERIES3
-XSTRAJT=>SERIES_MODEL(KTO)%XSTRAJT
-XSDATIME=>SERIES_MODEL(KTO)%XSDATIME
+tpsdates=>series_model(kto)%tpsdates
CSCOMMENT1=>SERIES_MODEL(KTO)%CSCOMMENT1
CSCOMMENT2=>SERIES_MODEL(KTO)%CSCOMMENT2
CSCOMMENT3=>SERIES_MODEL(KTO)%CSCOMMENT3
@@ -226,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_sub_modeln.f90 b/src/MNH/modd_sub_modeln.f90
index 64744d5bfe6d8b11a865e277cee18057f257ecee..5aa9e24379b3579b6ce93c59efc55b563bc2ad5f 100644
--- a/src/MNH/modd_sub_modeln.f90
+++ b/src/MNH/modd_sub_modeln.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.
@@ -10,6 +10,8 @@
! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
! J. Escobar 09/07/2019: norme Doctor -> Rename Module Type variable TZ -> T
! J. Escobar 09/07/2019: for bug in management of XLSZWSM variable, add/use specific 2D TLSFIELD2D_ll pointer
+! P. Wautelet 07/01/2021: rename ibak/iout into nfile_backup_current/nfile_output_current
+! F. Auguste 01/02/2021: add IBM
!-----------------------------------------------------------------
! #################
MODULE MODD_SUB_MODEL_n
@@ -36,15 +38,17 @@ TYPE SUB_MODEL_t
TYPE(HALO2LIST_ll), POINTER :: THALO2T_ll => NULL()
TYPE(HALO2LIST_ll), POINTER :: THALO2MT_ll => NULL()
TYPE(HALO2LIST_ll), POINTER :: THALO2SC_ll => NULL()
- INTEGER :: IBAK, IOUT ! number of the backup / output
+ integer :: nfile_backup_current = 0 ! Number of the current backup file
+ integer :: nfile_output_current = 0 ! Number of the current output file
REAL(kind=MNHTIME), DIMENSION(2) :: XT_START
REAL(kind=MNHTIME), DIMENSION(2) :: XT_STORE, XT_BOUND, XT_GUESS
- REAL(kind=MNHTIME), DIMENSION(2) :: XT_ADV, XT_SOURCES, XT_DRAG
+ REAL(kind=MNHTIME), DIMENSION(2) :: XT_ADV, XT_SOURCES, XT_DRAG, XT_EOL
REAL(kind=MNHTIME), DIMENSION(2) :: XT_ADVUVW, XT_GRAV, XT_VISC
REAL(kind=MNHTIME), DIMENSION(2) :: XT_DIFF, XT_RELAX, XT_PARAM, XT_SPECTRA
REAL(kind=MNHTIME), DIMENSION(2) :: XT_HALO, XT_RAD_BOUND, XT_PRESS
REAL(kind=MNHTIME), DIMENSION(2) :: XT_CLOUD, XT_STEP_SWA, XT_STEP_MISC
REAL(kind=MNHTIME), DIMENSION(2) :: XT_ELEC
+ REAL(kind=MNHTIME), DIMENSION(2) :: XT_IBM_FORC,XT_IBM_DETE,XT_IBM_PREP
REAL(kind=MNHTIME), DIMENSION(2) :: XT_COUPL, XT_1WAY, XT_STEP_BUD
REAL(kind=MNHTIME), DIMENSION(2) :: XT_RAD, XT_DCONV, XT_GROUND, XT_TRACER, XT_MAFL
REAL(kind=MNHTIME), DIMENSION(2) :: XT_TURB, XT_2WAY, XT_SHADOWS
@@ -53,8 +57,6 @@ TYPE SUB_MODEL_t
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XWT_ACT_NUC=>NULL()
! Vertical motion used for ACTivation/NUCleation
LOGICAL, DIMENSION(:,:), POINTER :: GMASKkids=>NULL() ! kids domains mask
-
- LOGICAL :: GCLOSE_OUT = .FALSE. ! conditional closure of the OUTPUT FM-file
END TYPE SUB_MODEL_t
TYPE(SUB_MODEL_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: SUB_MODEL_MODEL
@@ -64,24 +66,24 @@ TYPE(LIST_ll), POINTER :: TLSFIELD2D_ll => NULL()
TYPE(LIST_ll), POINTER :: TFIELDT_ll=>NULL(),TFIELDMT_ll=>NULL(),TFIELDSC_ll=>NULL()
TYPE(HALO2LIST_ll), POINTER :: THALO2M_ll=>NULL(), TLSHALO2_ll=>NULL()
TYPE(HALO2LIST_ll), POINTER :: THALO2T_ll=>NULL(), THALO2MT_ll=>NULL(), THALO2SC_ll=>NULL()
-INTEGER, POINTER :: IBAK=>NULL()
-INTEGER, POINTER :: IOUT=>NULL()
+integer, pointer :: nfile_backup_current => Null()
+integer, pointer :: nfile_output_current => Null()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_START=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_STORE=>NULL(), XT_BOUND=>NULL(), XT_GUESS=>NULL()
-REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_ADV=>NULL(), XT_SOURCES=>NULL(), XT_DRAG=>NULL()
+REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_ADV=>NULL(), XT_SOURCES=>NULL(), XT_DRAG=>NULL(), XT_EOL=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_ADVUVW=>NULL(), XT_GRAV=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_DIFF=>NULL(), XT_RELAX=>NULL(), XT_PARAM=>NULL(), XT_SPECTRA=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_HALO=>NULL(), XT_RAD_BOUND=>NULL(), XT_PRESS=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_VISC=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_CLOUD=>NULL(), XT_STEP_SWA=>NULL(), XT_STEP_MISC=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_ELEC=>NULL(), XT_SHADOWS=>NULL()
+REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_IBM_FORC=>NULL(),XT_IBM_PREP=>NULL(),XT_IBM_DETE=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_COUPL=>NULL(), XT_1WAY=>NULL(), XT_STEP_BUD=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_RAD=>NULL(), XT_DCONV=>NULL(), XT_GROUND=>NULL(), XT_MAFL=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_TURB=>NULL(), XT_2WAY=>NULL(), XT_TRACER=>NULL()
REAL(kind=MNHTIME), DIMENSION(:), POINTER :: XT_FORCING=>NULL(), XT_NUDGING=>NULL(), XT_CHEM=>NULL()
REAL, DIMENSION(:,:,:), POINTER, contiguous :: XWT_ACT_NUC=>NULL()
LOGICAL, DIMENSION(:,:), POINTER :: GMASKkids=>NULL()
-LOGICAL, POINTER :: GCLOSE_OUT=>NULL()
CONTAINS
@@ -117,8 +119,8 @@ TLSHALO2_ll=>SUB_MODEL_MODEL(KTO)%TLSHALO2_ll
THALO2T_ll=>SUB_MODEL_MODEL(KTO)%THALO2T_ll
THALO2MT_ll=>SUB_MODEL_MODEL(KTO)%THALO2MT_ll
THALO2SC_ll=>SUB_MODEL_MODEL(KTO)%THALO2SC_ll
-IBAK=>SUB_MODEL_MODEL(KTO)%IBAK
-IOUT=>SUB_MODEL_MODEL(KTO)%IOUT
+nfile_backup_current => sub_model_model(kto)%nfile_backup_current
+nfile_output_current => sub_model_model(kto)%nfile_output_current
XT_START=>SUB_MODEL_MODEL(KTO)%XT_START
XT_STORE=>SUB_MODEL_MODEL(KTO)%XT_STORE
XT_BOUND=>SUB_MODEL_MODEL(KTO)%XT_BOUND
@@ -128,6 +130,7 @@ XT_ADVUVW=>SUB_MODEL_MODEL(KTO)%XT_ADVUVW
XT_GRAV=>SUB_MODEL_MODEL(KTO)%XT_GRAV
XT_SOURCES=>SUB_MODEL_MODEL(KTO)%XT_SOURCES
XT_DRAG=>SUB_MODEL_MODEL(KTO)%XT_DRAG
+XT_EOL=>SUB_MODEL_MODEL(KTO)%XT_EOL
XT_DIFF=>SUB_MODEL_MODEL(KTO)%XT_DIFF
XT_RELAX=>SUB_MODEL_MODEL(KTO)%XT_RELAX
XT_PARAM=>SUB_MODEL_MODEL(KTO)%XT_PARAM
@@ -138,6 +141,9 @@ XT_RAD_BOUND=>SUB_MODEL_MODEL(KTO)%XT_RAD_BOUND
XT_PRESS=>SUB_MODEL_MODEL(KTO)%XT_PRESS
XT_CLOUD=>SUB_MODEL_MODEL(KTO)%XT_CLOUD
XT_ELEC=>SUB_MODEL_MODEL(KTO)%XT_ELEC
+XT_IBM_FORC=>SUB_MODEL_MODEL(KTO)%XT_IBM_FORC
+XT_IBM_DETE=>SUB_MODEL_MODEL(KTO)%XT_IBM_DETE
+XT_IBM_PREP=>SUB_MODEL_MODEL(KTO)%XT_IBM_PREP
XT_STEP_SWA=>SUB_MODEL_MODEL(KTO)%XT_STEP_SWA
XT_STEP_MISC=>SUB_MODEL_MODEL(KTO)%XT_STEP_MISC
XT_COUPL=>SUB_MODEL_MODEL(KTO)%XT_COUPL
@@ -156,7 +162,6 @@ XT_NUDGING=>SUB_MODEL_MODEL(KTO)%XT_NUDGING
XT_CHEM=>SUB_MODEL_MODEL(KTO)%XT_CHEM
XWT_ACT_NUC=>SUB_MODEL_MODEL(KTO)%XWT_ACT_NUC
GMASKkids=>SUB_MODEL_MODEL(KTO)%GMASKkids
-GCLOSE_OUT=>SUB_MODEL_MODEL(KTO)%GCLOSE_OUT
END SUBROUTINE SUB_MODEL_GOTO_MODEL
diff --git a/src/MNH/modd_turbn.f90 b/src/MNH/modd_turbn.f90
index 8dc0cb5e140998ad83f86d6771a45d213ae16f5f..8c35fd9d4be7bd61167ee2e6aba4a4fb40e521a5 100644
--- a/src/MNH/modd_turbn.f90
+++ b/src/MNH/modd_turbn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 1994-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##################
@@ -39,6 +39,8 @@
!! May 2006 Remove KEPS
!! C.Lac Nov 2014 add terms of TKE production for LES diag
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! D. Ricard May 2021 add the switches for Leonard terms
+!! JL Redelsperger 03/2021 Add O-A flux for auto-coupled LES case
!!
!-------------------------------------------------------------------------------
!
@@ -55,6 +57,7 @@ TYPE TURB_t
! the turbulence scheme
REAL :: XKEMIN ! mimimum value for the TKE
REAL :: XCEDIS ! Constant for dissipation of Tke
+ REAL :: XCADAP ! Coefficient for ADAPtative mixing length
CHARACTER (LEN=4) :: CTURBLEN ! type of length used for the closure
! 'BL89' Bougeault and Lacarrere scheme
! 'DELT' length = ( volum) ** 1/3
@@ -77,7 +80,12 @@ TYPE TURB_t
CHARACTER(LEN=4) :: CTOM ! type of Third Order Moments
! 'NONE' none
! 'TM06' Tomas Masson 2006
- CHARACTER(LEN=4) :: CSUBG_AUCV ! type of subgrid autoconv. method
+ CHARACTER(LEN=4) :: CSUBG_AUCV ! type of subgrid rc->rr autoconv. method
+ CHARACTER(LEN=80) :: CSUBG_AUCV_RI ! type of subgrid ri->rs autoconv. method
+ CHARACTER(LEN=80) :: CCONDENS ! subrgrid condensation PDF
+ CHARACTER(LEN=4) :: CLAMBDA3 ! lambda3 choice for subgrid cloud scheme
+ CHARACTER(LEN=80) :: CSUBG_MF_PDF ! PDF to use for MF cloud autoconversions
+
! REAL, DIMENSION(:,:), POINTER :: XBL_DEPTH=>NULL() ! BL depth for TOMS computations
! REAL, DIMENSION(:,:), POINTER :: XSBL_DEPTH=>NULL()! SurfaceBL depth for RMC01 computations
! REAL, DIMENSION(:,:,:), POINTER :: XWTHVMF=>NULL()! Mass Flux vert. transport of buoyancy
@@ -87,6 +95,17 @@ TYPE TURB_t
REAL, DIMENSION(:,:,:), POINTER :: XTR=>NULL() ! Transport production of Kinetic energy
REAL, DIMENSION(:,:,:), POINTER :: XDISS=>NULL() ! Dissipation of Kinetic energy
REAL, DIMENSION(:,:,:), POINTER :: XLEM=>NULL() ! Mixing length
+ REAL, DIMENSION(:,:,:), POINTER :: XSSUFL_C=>NULL() ! O-A interface flux for u
+ REAL, DIMENSION(:,:,:), POINTER :: XSSVFL_C=>NULL() ! O-A interface flux for v
+ REAL, DIMENSION(:,:,:), POINTER :: XSSTFL_C=>NULL() ! O-A interface flux for theta
+ REAL, DIMENSION(:,:,:), POINTER :: XSSRFL_C=>NULL() ! O-A interface flux for vapor
+ LOGICAL :: LHGRAD ! logical switch for the computation of the Leornard Terms
+ REAL :: XCOEFHGRADTHL ! coeff applied to thl contribution
+ REAL :: XCOEFHGRADRM ! coeff applied to mixing ratio contribution
+ REAL :: XALTHGRAD ! altitude from which to apply the Leonard terms
+ REAL :: XCLDTHOLD ! cloud threshold to apply the Leonard terms
+ ! negative value : applied everywhere
+ ! 0.000001 applied only inside the clouds ri+rc > 10**-6 kg/kg
!
END TYPE TURB_t
@@ -95,6 +114,7 @@ TYPE(TURB_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: TURB_MODEL
REAL, POINTER :: XIMPL=>NULL()
REAL, POINTER :: XKEMIN=>NULL()
REAL, POINTER :: XCEDIS=>NULL()
+REAL, POINTER :: XCADAP=>NULL()
CHARACTER (LEN=4), POINTER :: CTURBLEN=>NULL()
CHARACTER (LEN=4), POINTER :: CTURBDIM=>NULL()
LOGICAL, POINTER :: LTURB_FLX=>NULL()
@@ -105,6 +125,10 @@ LOGICAL, POINTER :: LSIG_CONV=>NULL()
LOGICAL, POINTER :: LRMC01=>NULL()
CHARACTER(LEN=4),POINTER :: CTOM=>NULL()
CHARACTER(LEN=4),POINTER :: CSUBG_AUCV=>NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_AUCV_RI=>NULL()
+CHARACTER(LEN=80),POINTER :: CCONDENS=>NULL()
+CHARACTER(LEN=4),POINTER :: CLAMBDA3=>NULL()
+CHARACTER(LEN=80),POINTER :: CSUBG_MF_PDF=>NULL()
REAL, DIMENSION(:,:), POINTER :: XBL_DEPTH=>NULL()
REAL, DIMENSION(:,:), POINTER :: XSBL_DEPTH=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XWTHVMF=>NULL()
@@ -114,6 +138,15 @@ REAL, DIMENSION(:,:,:), POINTER :: XTHP=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XTR=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XDISS=>NULL()
REAL, DIMENSION(:,:,:), POINTER :: XLEM=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSUFL_C=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSVFL_C=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSTFL_C=>NULL()
+REAL, DIMENSION(:,:,:), POINTER :: XSSRFL_C=>NULL()
+LOGICAL, POINTER :: LHGRAD=>NULL()
+REAL, POINTER :: XCOEFHGRADTHL=>NULL()
+REAL, POINTER :: XCOEFHGRADRM=>NULL()
+REAL, POINTER :: XALTHGRAD=>NULL()
+REAL, POINTER :: XCLDTHOLD=>NULL()
CONTAINS
@@ -130,11 +163,16 @@ TURB_MODEL(KFROM)%XTHP=>XTHP
TURB_MODEL(KFROM)%XTR=>XTR
TURB_MODEL(KFROM)%XDISS=>XDISS
TURB_MODEL(KFROM)%XLEM=>XLEM
+TURB_MODEL(KFROM)%XSSUFL_C=>XSSUFL_C
+TURB_MODEL(KFROM)%XSSVFL_C=>XSSVFL_C
+TURB_MODEL(KFROM)%XSSTFL_C=>XSSTFL_C
+TURB_MODEL(KFROM)%XSSRFL_C=>XSSRFL_C
!
! Current model is set to model KTO
XIMPL=>TURB_MODEL(KTO)%XIMPL
XKEMIN=>TURB_MODEL(KTO)%XKEMIN
XCEDIS=>TURB_MODEL(KTO)%XCEDIS
+XCADAP=>TURB_MODEL(KTO)%XCADAP
CTURBLEN=>TURB_MODEL(KTO)%CTURBLEN
CTURBDIM=>TURB_MODEL(KTO)%CTURBDIM
LTURB_FLX=>TURB_MODEL(KTO)%LTURB_FLX
@@ -145,6 +183,10 @@ LSIG_CONV=>TURB_MODEL(KTO)%LSIG_CONV
LRMC01=>TURB_MODEL(KTO)%LRMC01
CTOM=>TURB_MODEL(KTO)%CTOM
CSUBG_AUCV=>TURB_MODEL(KTO)%CSUBG_AUCV
+CSUBG_AUCV_RI=>TURB_MODEL(KTO)%CSUBG_AUCV_RI
+CCONDENS=>TURB_MODEL(KTO)%CCONDENS
+CLAMBDA3=>TURB_MODEL(KTO)%CLAMBDA3
+CSUBG_MF_PDF=>TURB_MODEL(KTO)%CSUBG_MF_PDF
!XBL_DEPTH=>TURB_MODEL(KTO)%XBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
!XSBL_DEPTH=>TURB_MODEL(KTO)%XSBL_DEPTH !Done in FIELDLIST_GOTO_MODEL
!XWTHVMF=>TURB_MODEL(KTO)%XWTHVMF !Done in FIELDLIST_GOTO_MODEL
@@ -154,6 +196,15 @@ XTHP=>TURB_MODEL(KTO)%XTHP
XTR=>TURB_MODEL(KTO)%XTR
XDISS=>TURB_MODEL(KTO)%XDISS
XLEM=>TURB_MODEL(KTO)%XLEM
+XSSUFL_C=>TURB_MODEL(KTO)%XSSUFL_C
+XSSVFL_C=>TURB_MODEL(KTO)%XSSVFL_C
+XSSTFL_C=>TURB_MODEL(KTO)%XSSTFL_C
+XSSRFL_C=>TURB_MODEL(KTO)%XSSRFL_C
+LHGRAD=>TURB_MODEL(KTO)%LHGRAD
+XCOEFHGRADTHL=>TURB_MODEL(KTO)%XCOEFHGRADTHL
+XCOEFHGRADRM=>TURB_MODEL(KTO)%XCOEFHGRADRM
+XALTHGRAD=>TURB_MODEL(KTO)%XALTHGRAD
+XCLDTHOLD=>TURB_MODEL(KTO)%XCLDTHOLD
END SUBROUTINE TURB_GOTO_MODEL
diff --git a/src/MNH/modd_type_allvar.f90 b/src/MNH/modd_type_allvar.f90
deleted file mode 100644
index b9c3b187ceb93839af38db79627c5164530c6558..0000000000000000000000000000000000000000
--- a/src/MNH/modd_type_allvar.f90
+++ /dev/null
@@ -1,73 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modd 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! ###################
- MODULE MODD_TYPE_ALLVAR
-! ###################
-!
-!!**** *MODD_TYPE_ALLVAR* - Declaration des types de variables 3D, 2D, 1D,
-!!
-!! PURPOSE
-!! -------
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! P Jabouille
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 11/08/97
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-IMPLICIT NONE
-!
-TYPE X_Y_Z_
- CHARACTER(LEN=16) :: NAME
- INTEGER :: IGRID
- CHARACTER(LEN=16) :: UNITS
-END TYPE X_Y_Z_
-!
-TYPE X_Y_
- CHARACTER(LEN=16) :: NAME
- INTEGER :: IGRID
- CHARACTER(LEN=16) :: UNITS
-END TYPE X_Y_
-!
-TYPE VX_VY_VZ_
- CHARACTER(LEN=16),DIMENSION(3) :: NAME
- INTEGER,DIMENSION(3) :: IGRID
- CHARACTER(LEN=16),DIMENSION(3) :: UNITS
-END TYPE VX_VY_VZ_
-!
-TYPE VX_VY_
- CHARACTER(LEN=16),DIMENSION(3) :: NAME
- INTEGER,DIMENSION(3) :: IGRID
- CHARACTER(LEN=16),DIMENSION(3) :: UNITS
-END TYPE VX_VY_
-!
-TYPE Z_
- CHARACTER(LEN=16) :: NAME
- INTEGER :: IGRID
- CHARACTER(LEN=16) :: UNITS
-END TYPE Z_
-!
-END MODULE MODD_TYPE_ALLVAR
diff --git a/src/MNH/modd_type_date.f90 b/src/MNH/modd_type_date.f90
index 1d492991a6ab7a8c4adb6eda7cec3c6b36b9f695..e9717d3217f8f2e43f1f56877fd1b8eb0c24df64 100644
--- a/src/MNH/modd_type_date.f90
+++ b/src/MNH/modd_type_date.f90
@@ -1,23 +1,18 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modd 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! #################
- MODULE MODD_TYPE_DATE
-! #################
+!####################
+module modd_type_date
+!####################
!
!!**** *MODD_TYPE_DATE* - declaration of temporal types
!!
!! PURPOSE
!! -------
! The purpose of this declarative module is to define
-! the time types.
+! the time types
!
!!
!!** IMPLICIT ARGUMENTS
@@ -27,31 +22,33 @@
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (module MODD_TYPE_DATE)
-!!
+!!
!! AUTHOR
!! ------
!! P. Jabouille *Meteo France*
!!
!! MODIFICATIONS
!! -------------
-!! Original 11/08/97
+!! Original 11/08/97
+! P. Wautelet 24/07/2019: set default values
+! P. Wautelet 17/12/2020: restructure type date_time
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-!
-!
-IMPLICIT NONE
-!
-TYPE DATE
-INTEGER :: YEAR
-INTEGER :: MONTH
-INTEGER :: DAY
-END TYPE DATE
-!
-TYPE DATE_TIME
-TYPE (DATE) :: TDATE
-REAL :: TIME
-END TYPE DATE_TIME
-!
-END MODULE MODD_TYPE_DATE
+
+use modd_parameters, only: NNEGUNDEF, XNEGUNDEF
+
+implicit none
+
+type date
+ integer :: nyear = NNEGUNDEF
+ integer :: nmonth = 0
+ integer :: nday = 0
+end type date
+!
+type, extends( date ) :: date_time
+ real :: xtime = XNEGUNDEF
+end type date_time
+!
+end module modd_type_date
diff --git a/src/MNH/modd_type_profiler.f90 b/src/MNH/modd_type_profiler.f90
index 944e44307e28dfd270eca6ca185cee5c28c5676b..b5fedbf60ab7d849a2d04fc98d3047daa34cad64 100644
--- a/src/MNH/modd_type_profiler.f90
+++ b/src/MNH/modd_type_profiler.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: /home/cvsroot/MNH-VX-Y-Z/src/MNH/modd_type_profiler.f90,v $ $Revision: 1.2.4.1.2.1.10.2.2.1 $
-! MASDEV4_7 modd 2006/06/27 12:27:06
-!-----------------------------------------------------------------
! ############################
MODULE MODD_TYPE_PROFILER
! ############################
@@ -22,9 +17,7 @@
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
-!! NONE
!!
-IMPLICIT NONE
!!
!! REFERENCE
!! ---------
@@ -37,13 +30,17 @@ IMPLICIT NONE
!! -------------
!! 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 05/07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-!
-!
+use modd_type_date, only: date_time
+
+implicit none
+
TYPE PROFILER
!
!
@@ -61,8 +58,8 @@ REAL :: STEP ! storage time step
CHARACTER(LEN=8),DIMENSION(:), POINTER :: NAME=>NULL() ! station name
CHARACTER(LEN=8),DIMENSION(:), POINTER :: TYPE=>NULL() ! station type
!
-REAL, DIMENSION(:), POINTER :: TIME=>NULL() ! t(n) (n: recording instants)
-LOGICAL, DIMENSION(:), POINTER :: ERROR=>NULL()
+type(date_time), dimension(:), pointer :: tpdates => NULL() ! dates(n) (n: recording instants)
+LOGICAL, DIMENSION(:), POINTER :: ERROR=>NULL()
REAL, DIMENSION(:), POINTER :: X=>NULL() ! X(n)
REAL, DIMENSION(:), POINTER :: Y=>NULL() ! Y(n)
REAL, DIMENSION(:), POINTER :: LON=>NULL() ! longitude(n)
@@ -70,7 +67,7 @@ REAL, DIMENSION(:), POINTER :: LAT=>NULL() ! latitude (n)
REAL, DIMENSION(:), POINTER :: ALT=>NULL() ! altitude (n)
REAL, DIMENSION(:,:,:), POINTER :: ZON=>NULL() ! zonal wind(n)
REAL, DIMENSION(:,:,:), POINTER :: MER=>NULL() ! meridian wind(n)
-REAL, DIMENSION(:,:,:), POINTER :: FF=>NULL() ! wind intensity
+REAL, DIMENSION(:,:,:), POINTER :: FF=>NULL() ! wind intensity
REAL, DIMENSION(:,:,:), POINTER :: DD=>NULL() ! wind direction
REAL, DIMENSION(:,:,:), POINTER :: W=>NULL() ! w(n) (air vertical speed)
REAL, DIMENSION(:,:,:), POINTER :: P=>NULL() ! p(n)
@@ -80,12 +77,15 @@ 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)
REAL, DIMENSION(:,:,:,:), POINTER :: AER=>NULL() ! AER*(n) aerosol extinction
-REAL, DIMENSION(:,:), POINTER :: DATIME=>NULL() ! record for diachro
!
REAL, DIMENSION(:,:), POINTER :: T2M=>NULL() ! 2 m air temperature (°C)
REAL, DIMENSION(:,:), POINTER :: Q2M=>NULL() ! 2 m humidity (kg/kg)
diff --git a/src/MNH/modd_type_station.f90 b/src/MNH/modd_type_station.f90
index 462358f2dd38cf66d8f8f52337baa5d89ba95a49..3456ac2d272e30cd9ce2e85fbd58f6d4dd4019a3 100644
--- a/src/MNH/modd_type_station.f90
+++ b/src/MNH/modd_type_station.f90
@@ -1,8 +1,9 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-! ######spl
+!-----------------------------------------------------------------
+! ############################
MODULE MODD_TYPE_STATION
! ############################
!
@@ -28,12 +29,17 @@
!! MODIFICATIONS
!! -------------
!! Original 15/01/02
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!
+use modd_type_date, only: date_time
+
+implicit none
+
TYPE STATION
!
!
@@ -50,8 +56,8 @@ REAL :: STEP ! storage time step
!
CHARACTER(LEN=8),DIMENSION(:), POINTER :: NAME=>NULL() ! station name
CHARACTER(LEN=8),DIMENSION(:), POINTER :: TYPE=>NULL() ! station type
-REAL, DIMENSION(:), POINTER :: TIME=>NULL() ! t(n) (n: recording instants)
-LOGICAL, DIMENSION(:), POINTER :: ERROR=>NULL() !
+type(date_time), dimension(:), pointer :: tpdates => NULL() ! dates(n) (n: recording instants)
+LOGICAL, DIMENSION(:), POINTER :: ERROR=>NULL() !
REAL, DIMENSION(:), POINTER :: X=>NULL() ! X(n)
REAL, DIMENSION(:), POINTER :: Y=>NULL() ! Y(n)
REAL, DIMENSION(:), POINTER :: Z=>NULL() ! Z(n)
@@ -67,7 +73,6 @@ REAL, DIMENSION(:,:,:), POINTER :: R=>NULL() ! r*(n)
REAL, DIMENSION(:,:,:), POINTER :: SV=>NULL() ! Sv*(n)
REAL, DIMENSION(:), POINTER :: ZS=>NULL() ! zs(n)
REAL, DIMENSION(:,:), POINTER :: TSRAD=>NULL() ! Ts(n)
-REAL, DIMENSION(:,:), POINTER :: DATIME=>NULL() ! record for diachro
!
REAL, DIMENSION(:,:), POINTER :: T2M=>NULL() !
REAL, DIMENSION(:,:), POINTER :: Q2M=>NULL() !
diff --git a/src/MNH/mode_datetime.f90 b/src/MNH/mode_datetime.f90
index b6547cfa9cb7714be3b7c73a5d0f12d9b1398777..fc9f68267d6cca9e7d770dc7b3cfd86ba067ad52 100644
--- a/src/MNH/mode_datetime.f90
+++ b/src/MNH/mode_datetime.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.
@@ -6,6 +6,7 @@
! Modifications:
! P. Wautelet 22/02/2019: use MOD intrinsics with same kind for all arguments (to respect Fortran standard)
! P. Wautelet 19/04/2019: use modd_precision kinds
+! P. Wautelet 20/07/2021: modify DATETIME_TIME2REFERENCE and DATETIME_DISTANCE to allow correct computation with 32-bit floats
!-----------------------------------------------------------------
MODULE MODE_DATETIME
!
@@ -23,7 +24,7 @@ PUBLIC :: OPERATOR(>=)
!
!Reference date (do not change it)
!To work with DATETIME_TIME2REFERENCE, we assume the year is a multiple of 400 + 1 and the date is January 1st (and time=0.)
-TYPE(DATE_TIME),PARAMETER :: TPREFERENCE_DATE = DATE_TIME( TDATE=DATE(1601,1,1), TIME=0. )
+TYPE(DATE_TIME),PARAMETER :: TPREFERENCE_DATE = DATE_TIME( nyear = 1601, nmonth = 1, nday =1 , xtime = 0. )
!
INTERFACE OPERATOR(<)
MODULE PROCEDURE DATETIME_LT
@@ -35,14 +36,17 @@ END INTERFACE
!
CONTAINS
!
-SUBROUTINE DATETIME_TIME2REFERENCE(TPDATE,PDIST)
+SUBROUTINE DATETIME_TIME2REFERENCE( TPDATE, KDAYS, PSEC )
!
-!Compute number of seconds since reference date (and time)
+!Compute number of days and seconds since reference date (and time)
+!Days and seconds are separated to allow correct computation of differences even
+!with reduced precision (mantissa is too small for 32-bit floats)
!
use modd_precision, only: MNHINT64
TYPE(DATE_TIME), INTENT(IN) :: TPDATE
-REAL, INTENT(OUT) :: PDIST
+INTEGER, INTENT(OUT) :: KDAYS
+REAL, INTENT(OUT) :: PSEC
!
INTEGER(KIND=MNHINT64) :: ILEAPS !Number of leap days
INTEGER(KIND=MNHINT64) :: IDAYS !Number of days since reference date
@@ -57,10 +61,10 @@ IDAYS = 0_MNHINT64
TZDATE = TPDATE
CALL DATETIME_CORRECTDATE(TZDATE)
!
-IYEAR_CUR = int( TZDATE%TDATE%YEAR, kind=MNHINT64 )
-IMONTH_CUR = int( TZDATE%TDATE%MONTH, kind=MNHINT64 )
-IDAY_CUR = int( TZDATE%TDATE%DAY, kind=MNHINT64 )
-ZSEC = TZDATE%TIME
+IYEAR_CUR = int( TZDATE%nyear, kind=MNHINT64 )
+IMONTH_CUR = int( TZDATE%nmonth, kind=MNHINT64 )
+IDAY_CUR = int( TZDATE%nday, kind=MNHINT64 )
+ZSEC = TZDATE%xtime
!
!Compute number of days since beginning of the year
IF ( ((MOD(IYEAR_CUR,4_MNHINT64)==0).AND.(MOD(IYEAR_CUR,100_MNHINT64)/=0)) .OR. (MOD(IYEAR_CUR,400_MNHINT64)==0)) ILEAPS=1
@@ -91,7 +95,7 @@ SELECT CASE(IMONTH_CUR)
IDAYS = IDAY_CUR-1+31+28+ILEAPS+31+30+31+30+31+31+30+31+30
END SELECT
!
-IYEARS = IYEAR_CUR - int( TPREFERENCE_DATE%TDATE%YEAR, kind=MNHINT64 )
+IYEARS = IYEAR_CUR - int( TPREFERENCE_DATE%nyear, kind=MNHINT64 )
IF ( IYEARS < 0_MNHINT64 ) THEN
CALL PRINT_MSG(NVERB_WARNING,'GEN','DATETIME_TIME2REFERENCE', &
'input year is smaller than reference year => result could be invalid')
@@ -105,7 +109,8 @@ ILEAPS = ILEAPS+(IYEARS/400) ! multiple of 400 are leap years
!Compute number of days since reference date
IDAYS = IDAYS + 365*IYEARS + ILEAPS
!
-PDIST = REAL(IDAYS*(60*60*24))+ZSEC
+KDAYS = IDAYS
+PSEC = ZSEC
!
END SUBROUTINE DATETIME_TIME2REFERENCE
!
@@ -118,12 +123,20 @@ TYPE(DATE_TIME), INTENT(IN) :: TPDATEBEG
TYPE(DATE_TIME), INTENT(IN) :: TPDATEEND
REAL, INTENT(OUT) :: PDIST
!
-REAL :: ZDISTBEG, ZDISTEND
+INTEGER :: IDAYSBEG, IDAYSEND
+REAL :: ZSECBEG, ZSECEND
+!
+CALL DATETIME_TIME2REFERENCE( TPDATEBEG, IDAYSBEG, ZSECBEG )
+CALL DATETIME_TIME2REFERENCE( TPDATEEND, IDAYSEND, ZSECEND )
!
-CALL DATETIME_TIME2REFERENCE(TPDATEBEG,ZDISTBEG)
-CALL DATETIME_TIME2REFERENCE(TPDATEEND,ZDISTEND)
+IF ( ZSECEND < ZSECBEG ) THEN
+ !Add 1 day to ZSECEND and remove it from IDAYSEND
+ ZSECEND = ZSECEND + REAL( 24 * 60 * 60 )
+ IDAYSEND = IDAYSEND - 1
+ IF ( ZSECEND < ZSECBEG ) CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'DATETIME_DISTANCE', 'unexpected: ZSECEND is too small' )
+END IF
!
-PDIST = ZDISTEND-ZDISTBEG
+PDIST = REAL( ( IDAYSEND - IDAYSBEG ) * (24*60*60) ) + ZSECEND - ZSECBEG
!
END SUBROUTINE DATETIME_DISTANCE
!
@@ -142,14 +155,14 @@ INTEGER :: IMONTH_LGT !Number of days in a month
LOGICAL :: GKO
REAL :: ZSEC !Current time of the day (in seconds)
!
-IYEAR_CUR = TPDATE%TDATE%YEAR
-IMONTH_CUR = TPDATE%TDATE%MONTH
-IDAY_CUR = TPDATE%TDATE%DAY
-ZSEC = TPDATE%TIME
+IYEAR_CUR = TPDATE%nyear
+IMONTH_CUR = TPDATE%nmonth
+IDAY_CUR = TPDATE%nday
+ZSEC = TPDATE%xtime
! print *,'DATETIME_CORRECTDATE in: ',IYEAR_CUR,IMONTH_CUR,IDAY_CUR,ZSEC
!
CALL DATETIME_GETMONTHLGT(IYEAR_CUR,IMONTH_CUR,IMONTH_LGT)
-IF (TPDATE%TIME<0. .OR. TPDATE%TIME>=86400. .OR. &
+IF (TPDATE%xtime<0. .OR. TPDATE%xtime>=86400. .OR. &
IDAY_CUR<1 .OR. IDAY_CUR>IMONTH_LGT .OR. &
IMONTH_CUR<1 .OR. IMONTH_CUR>12 ) THEN
GKO = .TRUE.
@@ -157,12 +170,12 @@ ELSE
GKO = .FALSE.
END IF
!
-IF (TPDATE%TIME<0.) THEN
+IF (TPDATE%xtime<0.) THEN
!Number of days to remove
- IDAYS = INT(TPDATE%TIME/86400.)-1
-ELSE IF (TPDATE%TIME>=86400.) THEN
+ IDAYS = INT(TPDATE%xtime/86400.)-1
+ELSE IF (TPDATE%xtime>=86400.) THEN
!Number of days to add
- IDAYS = INT(TPDATE%TIME/86400.)
+ IDAYS = INT(TPDATE%xtime/86400.)
ELSE
IDAYS = 0
END IF
@@ -211,10 +224,10 @@ DO WHILE (GKO)
END DO
! print *,'DATETIME_CORRECTDATE out:',IYEAR_CUR,IMONTH_CUR,IDAY_CUR,ZSEC
!
-TPDATE%TDATE%YEAR = IYEAR_CUR
-TPDATE%TDATE%MONTH = IMONTH_CUR
-TPDATE%TDATE%DAY = IDAY_CUR
-TPDATE%TIME = ZSEC
+TPDATE%nyear = IYEAR_CUR
+TPDATE%nmonth = IMONTH_CUR
+TPDATE%nday = IDAY_CUR
+TPDATE%xtime = ZSEC
!
END SUBROUTINE DATETIME_CORRECTDATE
!
@@ -251,18 +264,18 @@ TYPE(DATE_TIME), INTENT(IN) :: TPT1, TPT2
! TRUE if TPT1 .LT. TPT2
!
!
-IF ( TPT1%TDATE%YEAR .EQ. TPT2%TDATE%YEAR ) THEN
- IF ( TPT1%TDATE%MONTH .EQ. TPT2%TDATE%MONTH ) THEN
- IF ( TPT1%TDATE%DAY .EQ. TPT2%TDATE%DAY ) THEN
- OLT = TPT1%TIME .LT. TPT2%TIME
+IF ( TPT1%nyear .EQ. TPT2%nyear ) THEN
+ IF ( TPT1%nmonth .EQ. TPT2%nmonth ) THEN
+ IF ( TPT1%nday .EQ. TPT2%nday ) THEN
+ OLT = TPT1%xtime .LT. TPT2%xtime
ELSE
- OLT = TPT1%TDATE%DAY .LT. TPT2%TDATE%DAY
+ OLT = TPT1%nday .LT. TPT2%nday
END IF
ELSE
- OLT = TPT1%TDATE%MONTH .LT. TPT2%TDATE%MONTH
+ OLT = TPT1%nmonth .LT. TPT2%nmonth
END IF
ELSE
- OLT = TPT1%TDATE%YEAR .LT. TPT2%TDATE%YEAR
+ OLT = TPT1%nyear .LT. TPT2%nyear
ENDIF
!
END FUNCTION DATETIME_LT
diff --git a/src/MNH/mode_gridcart.f90 b/src/MNH/mode_gridcart.f90
index 65981a6f6eb076380e362e241ec34fa4e67bf774..552bc71ce484536a039674bb294be02b7b5f1106 100644
--- a/src/MNH/mode_gridcart.f90
+++ b/src/MNH/mode_gridcart.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -35,6 +35,7 @@
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 07/12/2020: bugfix: deallocate correctly TZHALO1_ll
!--------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -106,6 +107,7 @@ CONTAINS
!
USE MODE_ll
USE MODD_ARGSLIST_ll, ONLY : LIST1D_ll
+USE MODE_ARGSLIST_ll, ONLY : CLEANLIST1D_ll
USE MODD_LUNIT_n, ONLY : TLUOUT
!
USE MODD_PARAMETERS
@@ -204,7 +206,7 @@ PDYHAT(:) = EOSHIFT(PYHAT(:) ,1,ZBOUNDY) - PYHAT(:)
CALL ADD1DFIELD_ll( 'X', TZHALO1_ll, PDXHAT, 'SM_GRIDCART::PDXHAT')
CALL ADD1DFIELD_ll( 'Y', TZHALO1_ll, PDYHAT, 'SM_GRIDCART::PDYHAT')
CALL UPDATE_1DHALO_ll(TZHALO1_ll,IINFO_ll)
-DEALLOCATE(TZHALO1_ll)
+CALL CLEANLIST1D_ll( TZHALO1_ll )
!
ZDZ(:,:,1:IKU-1) = PZZ(:,:,2:IKU) - PZZ(:,:,1:IKU-1)
ZDZ(:,:,IKU) = ZBOUNDZ(:,:) - PZZ(:,:,IKU)
diff --git a/src/MNH/mode_gridproj.f90 b/src/MNH/mode_gridproj.f90
index 30abee4f32a98a2fc65fe6d379354a90c9d25daf..d907e68015248c67d0c3c1bcbc229c7a3cf6d1c5 100644
--- a/src/MNH/mode_gridproj.f90
+++ b/src/MNH/mode_gridproj.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -39,7 +39,7 @@
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!
+! P. Wautelet 07/12/2020: bugfix: deallocate correctly TZHALO1_ll
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -370,7 +370,7 @@ ZDZ(:,:,IKU) = ZDZ(:,:,IKU-1)
CALL ADD1DFIELD_ll( 'X', TZHALO1_ll, PDXHAT, 'SM_GRIDPROJ::PDXHAT' )
CALL ADD1DFIELD_ll( 'Y', TZHALO1_ll, PDYHAT, 'SM_GRIDPROJ::PDYHAT' )
CALL UPDATE_1DHALO_ll(TZHALO1_ll,IINFO_ll)
-DEALLOCATE(TZHALO1_ll)
+call CLEANLIST1D_ll( TZHALO1_ll )
CALL MPPDB_CHECK3D(ZDZ,"GRIDPROJ:ZDZ",PRECISION)
!
!-----------------------------------------------------------------------------
diff --git a/src/MNH/mode_les_diachro.f90 b/src/MNH/mode_les_diachro.f90
index 3e07a46f665fb20d945376b4a07c3b6aeee3a35c..f56b2ce0f607015dde207609bd257cbdcf1050da 100644
--- a/src/MNH/mode_les_diachro.f90
+++ b/src/MNH/mode_les_diachro.f90
@@ -1,215 +1,117 @@
-!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.
!-----------------------------------------------------------------
! Modifications
-! G. TANGUY 19/05/2014 : correctoin DATIME in case of time average
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! G. Tanguy 19/05/2014: correct DATIME in case of time average
+! 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
+! P. Wautelet 20/09/2019: rewrite normalization of LES budgets
+! P. Wautelet 14/08/2020: deduplicate LES_DIACHRO* subroutines
+! P. Wautelet 10/2020: restructure subroutines to use tfield_metadata_base type
+! P. Wautelet 03/03/2021: budgets: add tbudiachrometadata type (useful to pass more information to Write_diachro)
+! P. Wautelet 11/03/2021: budgets: remove ptrajx/y/z optional dummy arguments of Write_diachro
!-----------------------------------------------------------------
!#######################
MODULE MODE_LES_DIACHRO
!#######################
-!
-USE MODD_LUNIT
-!
+
+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
+
+use mode_msg
+
+implicit none
+
+private
+
+public :: Les_diachro, Les_diachro_2pt, Les_diachro_spec
+
+interface Les_diachro
+ module procedure Les_diachro_1D, Les_diachro_2D, Les_diachro_3D, Les_diachro_4D
+end interface
+
+
CONTAINS
!
!---------------------------------------------------------------------
!
!########################################################
-SUBROUTINE MAKE_NORM(HUNIT, KC, ODIV, PA_NORM, PLES_NORM)
+subroutine Make_norm( pa_norm, ples_norm, kpower )
!########################################################
-!
-USE MODD_PARAMETERS
-USE MODD_LES
-IMPLICIT NONE
-!
-CHARACTER(LEN=50), INTENT(IN) :: HUNIT ! physical unit of field
-INTEGER, INTENT(IN) :: KC ! character counter
-LOGICAL, INTENT(INOUT) :: ODIV ! flag to make a division
-REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PA_NORM ! normalized field
-REAL, DIMENSION(:), INTENT(IN) :: PLES_NORM ! normalization coefficient
-INTEGER :: JK ! z counter
-INTEGER :: JT ! time counter
-INTEGER :: JP ! process counter
-INTEGER :: JN ! variable number counter (larger than 1 only for scalar var.)
-CHARACTER(LEN=50) :: YUNIT
-!
-!------------------------------------------------------------------------
-!
-YUNIT=HUNIT
-!
-IF ( ANY(PLES_NORM(:)==0.) ) THEN
- PA_NORM(:,:,:,:)=XUNDEF
- ODIV=.FALSE.
- RETURN
-END IF
+use modd_les, only: nles_current_times, nles_k
+use modd_parameters, only: XUNDEF
-DO JN=1,SIZE(PA_NORM,4)
- IF (YUNIT(KC+1:KC+1)=='3') THEN
- IF (ODIV) THEN
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JN)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JN) = PA_NORM(JK,JT,JP,JN) * PLES_NORM(JT)**3
- END DO
- END DO
- END DO
- ELSE
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JN)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JN) = PA_NORM(JK,JT,JP,JN) / PLES_NORM(JT)**3
- END DO
- END DO
- END DO
- END IF
- ELSE IF (YUNIT(KC+1:KC+1)=='2') THEN
- IF (ODIV) THEN
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JN)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JN) = PA_NORM(JK,JT,JP,JN) * PLES_NORM(JT)**2
- END DO
- END DO
- END DO
- ELSE
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JN)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JN) = PA_NORM(JK,JT,JP,JN) / PLES_NORM(JT)**2
- END DO
- END DO
- END DO
- END IF
- ELSE
- IF (ODIV) THEN
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JN)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JN) = PA_NORM(JK,JT,JP,JN) * PLES_NORM(JT)
- END DO
- END DO
- END DO
- ELSE
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JN)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JN) = PA_NORM(JK,JT,JP,JN) / PLES_NORM(JT)
- END DO
- END DO
- END DO
- END IF
- END IF
-END DO
-!
-ODIV=.FALSE.
-!
-END SUBROUTINE MAKE_NORM
-!
-!###########################################################
-SUBROUTINE MAKE_NORM_SV(HUNIT, KC, ODIV, PA_NORM, PLES_NORM)
-!###########################################################
-!
-USE MODD_PARAMETERS
-USE MODD_LES
-IMPLICIT NONE
-!
-CHARACTER(LEN=50), INTENT(IN) :: HUNIT ! physical unit of field
-INTEGER, INTENT(IN) :: KC ! character counter
-LOGICAL, INTENT(INOUT) :: ODIV ! flag to make a division
-REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PA_NORM ! normalized field
-REAL, DIMENSION(:,:), INTENT(IN) :: PLES_NORM ! normalization coefficient
+real, dimension(:,:,:,:), intent(inout) :: pa_norm ! normalized field
+real, dimension(:), intent(in) :: ples_norm ! normalization coefficient
+integer, intent(in) :: kpower ! normalization power
-INTEGER :: JK ! z counter
-INTEGER :: JT ! time counter
-INTEGER :: JP ! process counter
-INTEGER :: JSV! scalar variables counter
-CHARACTER(LEN=50) :: YUNIT
-!
-!-------------------------------------------------------------------
-!
-YUNIT=HUNIT
-!
-DO JSV=1,SIZE(PLES_NORM,2)
- IF (ANY(PLES_NORM(:,JSV)==0.)) THEN
- PA_NORM(:,:,:,JSV)=XUNDEF
- CYCLE
- END IF
- IF (YUNIT(KC+1:KC+1)=='3') THEN
- IF (ODIV) THEN
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JSV)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JSV) = PA_NORM(JK,JT,JP,JSV) * PLES_NORM(JT,JSV)**3
- END DO
- END DO
- END DO
- ELSE
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JSV)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JSV) = PA_NORM(JK,JT,JP,JSV) / PLES_NORM(JT,JSV)**3
- END DO
- END DO
- END DO
- END IF
- ELSE IF (YUNIT(KC+1:KC+1)=='2') THEN
- IF (ODIV) THEN
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JSV)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JSV) = PA_NORM(JK,JT,JP,JSV) * PLES_NORM(JT,JSV)**2
- END DO
- END DO
- END DO
- ELSE
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JSV)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JSV) = PA_NORM(JK,JT,JP,JSV) / PLES_NORM(JT,JSV)**2
- END DO
- END DO
- END DO
- END IF
- ELSE
- IF (ODIV) THEN
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JSV)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JSV) = PA_NORM(JK,JT,JP,JSV) * PLES_NORM(JT,JSV)
- END DO
- END DO
- END DO
- ELSE
- DO JP=1,SIZE(PA_NORM,3)
- DO JT=1,NLES_CURRENT_TIMES
- DO JK=1,NLES_K
- IF (PA_NORM(JK,JT,JP,JSV)/=XUNDEF) &
- PA_NORM(JK,JT,JP,JSV) = PA_NORM(JK,JT,JP,JSV) / PLES_NORM(JT,JSV)
- END DO
- END DO
- END DO
- END IF
- END IF
-END DO
-!
-ODIV=.FALSE.
-!
-END SUBROUTINE MAKE_NORM_SV
+integer :: jk ! z counter
+integer :: jt ! time counter
+integer :: jp ! process counter
+integer :: jn ! variable number counter (larger than 1 only for scalar var.)
+
+if ( kpower == 0 ) return
+
+!normalization is not possible if some values are zero
+if ( any( ples_norm(: ) == 0. ) ) then
+ pa_norm(:, :, :, : ) = XUNDEF
+ return
+end if
+
+do jn = 1, size( pa_norm, 4 )
+ do jp = 1, size( pa_norm, 3 )
+ do jt = 1, nles_current_times
+ do jk = 1, nles_k
+ if ( pa_norm(jk, jt, jp, jn ) /= XUNDEF ) &
+ pa_norm(jk, jt, jp, jn ) = pa_norm(jk, jt, jp, jn ) * ples_norm(jt )**( -kpower )
+ end do
+ end do
+ end do
+end do
+
+end subroutine Make_norm
+
+!########################################################
+subroutine Make_norm_sv( pa_norm, ples_norm, kpower )
+!########################################################
+
+use modd_les, only: nles_current_times, nles_k
+use modd_parameters, only: XUNDEF
+
+real, dimension(:,:,:,:), intent(inout) :: pa_norm ! normalized field
+real, dimension(:,:), intent(in) :: ples_norm ! normalization coefficient
+integer, intent(in) :: kpower ! normalization power
+
+integer :: jk ! z counter
+integer :: jt ! time counter
+integer :: jp ! process counter
+integer :: jsv! scalar variables counter
+
+if ( kpower == 0 ) return
+
+!normalization is not possible if some values are zero
+do jsv = 1, size( ples_norm, 2 )
+ if ( any( ples_norm(:, jsv ) == 0. ) ) then
+ pa_norm(:, :, :, jsv) = XUNDEF
+ cycle
+ end if
+
+ do jp = 1, size( pa_norm, 3 )
+ do jt = 1, nles_current_times
+ do jk = 1, nles_k
+ if ( pa_norm(jk, jt, jp, jsv) /= XUNDEF ) &
+ pa_norm(jk, jt,jp, jsv ) = pa_norm(jk, jt, jp, jsv ) * ples_norm(jt, jsv )**( -kpower )
+ end do
+ end do
+ end do
+end do
+
+end subroutine Make_norm_sv
!
! ###################################################
SUBROUTINE LES_NORM_4D(HUNIT, PA_LES, PA_NORM, OSV)
@@ -258,227 +160,142 @@ LOGICAL, OPTIONAL, INTENT(IN) :: OSV ! flag for scalar variables
!
! 0.2 declaration of local variables
!
-INTEGER :: JC ! character counter
-LOGICAL :: GDIV ! flag to make a division
-INTEGER :: IKG ! number of 'kg' in the field unit
-!
-CHARACTER(LEN=50) :: YUNIT
-!
+integer, parameter :: NMAXUNITS = 10
+
+integer, parameter :: NNORM_K = 1
+integer, parameter :: NNORM_KG = 2
+integer, parameter :: NNORM_M = 3
+integer, parameter :: NNORM_PA = 4
+integer, parameter :: NNORM_S = 5
+integer, parameter :: NNORM_RV = 6
+integer, parameter :: NNORM_SV = 7
+integer, parameter :: NNORMS = 7
+
+integer :: idx, ispace
+integer :: ikg ! number of 'kg' in the field unit
+integer :: inunits
+integer :: ipower
+integer :: ipower_kg_1st
+integer :: ji
+integer, dimension ( NNORMS ) :: ipowers
+character( len = 8 ) :: yun, yname, ypower
+character( len = : ), allocatable :: yunit
+character( len = 8 ), dimension( NMAXUNITS ) :: yunits
+logical :: gsv
!------------------------------------------------------------------------------
-YUNIT=HUNIT//' '
-!
-PA_NORM = PA_LES
-!
-IKG=0
-!
-DO JC=1,50
- IF (YUNIT(JC:JC)=='g') THEN
- IKG=IKG+1
- ELSE IF (YUNIT(JC:JC)==' ') THEN
- EXIT
- END IF
-END DO
-!
-GDIV=.FALSE.
-!
-DO JC=1,49
- !
- SELECT CASE (YUNIT(JC:JC))
- CASE('m')
- CALL MAKE_NORM(YUNIT, JC, GDIV, PA_NORM, XLES_NORM_M)
- CASE('g')
- IF (IKG==1) THEN
- CALL MAKE_NORM(YUNIT, JC, GDIV, PA_NORM, XLES_NORM_RHO)
- ELSE
- IF (PRESENT(OSV)) THEN
- IF (OSV) THEN
- IF (.NOT. GDIV) &
- CALL MAKE_NORM_SV(YUNIT, JC, GDIV, PA_NORM, XLES_NORM_SV)
- GDIV=.FALSE.
- ELSE
- IF (.NOT. GDIV) &
- CALL MAKE_NORM(YUNIT, JC, GDIV, PA_NORM, XLES_NORM_RV)
- GDIV=.FALSE.
- END IF
- ELSE
- IF (.NOT. GDIV) &
- CALL MAKE_NORM(YUNIT, JC, GDIV, PA_NORM, XLES_NORM_RV)
- GDIV=.FALSE.
- END IF
- END IF
- CASE('K')
- CALL MAKE_NORM(YUNIT, JC, GDIV, PA_NORM, XLES_NORM_K)
- CASE('s')
- CALL MAKE_NORM(YUNIT, JC, GDIV, PA_NORM, XLES_NORM_S)
- CASE('a')
- CALL MAKE_NORM(YUNIT, JC, GDIV, PA_NORM, XLES_NORM_P)
- CASE('/')
- GDIV=.TRUE.
- CASE(' ')
- EXIT
- END SELECT
-END DO
-!
-WHERE(PA_NORM==XUNDEF) PA_NORM = PA_LES
-!
+
+gsv = .false.
+if ( present( osv ) ) gsv = osv
+
+pa_norm(:, :, :, : ) = pa_les(:, :, :, : )
+
+!Parse units
+!Each unit is separated by blanks
+!First part: unit, second part: power (and sign of it)
+ipowers(: ) = 0
+inunits = 0
+ikg = 0
+idx = 1
+
+yunit = trim( hunit )
+
+!Separate units
+do
+ ispace = scan( yunit(idx: ), ' ' )
+ if ( ispace == 0 ) then
+ inunits = inunits + 1
+ if (inunits > NMAXUNITS ) call Print_msg( NVERB_FATAL, 'GEN', 'LES_NORM_4D', 'inunits > NMAXUNITS' )
+ yunits(inunits ) = yunit(idx:)
+ exit
+ else if ( ispace == len(yunit(idx: )) ) then
+ exit
+ else
+ inunits = inunits + 1
+ if (inunits > NMAXUNITS ) call Print_msg( NVERB_FATAL, 'GEN', 'LES_NORM_4D', 'inunits > NMAXUNITS' )
+ yunits(inunits ) = yunit( idx : idx+ispace-1 )
+ idx = idx + ispace
+ end if
+end do
+
+!Treat units and their power
+!kg are special: they can appear twice with opposite power signs (kg kg-1)
+!In that case, they are normalized with xles_norm_rv or xles_norm_sv
+do ji = 1, inunits
+ yun = yunits(ji )
+
+ !Non dimensional unit
+ if ( trim( yun ) == '-' .or. trim( yun ) == '1' .or. trim( yun ) == 'percent') then
+ cycle
+ end if
+
+ !Separate unit and its power
+ idx = scan( yun, '-1234567890' )
+ if ( idx == 0 ) then
+ yname = trim( yun )
+ ypower = ''
+ ipower = 1
+ else
+ yname = yun( 1 : idx - 1 )
+ ypower = yun( idx : )
+ read (ypower,'(I8)') ipower
+ end if
+
+ select case( trim( yname ) )
+ case ( 'K' )
+ ipowers(NNORM_K ) = ipowers(NNORM_K ) + ipower
+ case ( 'kg' )
+ ikg = ikg + 1
+ if ( ikg == 1 ) ipower_kg_1st = ipower
+ ipowers(NNORM_KG ) = ipowers(NNORM_KG ) + ipower
+ case ( 'm' )
+ ipowers(NNORM_M ) = ipowers(NNORM_M ) + ipower
+ case ( 'Pa' )
+ ipowers(NNORM_PA ) = ipowers(NNORM_PA ) + ipower
+ case ( 's' )
+ ipowers(NNORM_S ) = ipowers(NNORM_S ) + ipower
+ case default
+ call Print_msg( NVERB_WARNING, 'IO', 'LES_NORM_4D', 'unknown unit: '//trim(yname)//'. Conversion could be wrong.' )
+ end select
+end do
+
+if ( ikg > 1 .and. ipowers(NNORM_KG ) /= 0 ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'LES_NORM_4D', 'if kg appears more than one time, it should be adimensional' )
+
+if ( ikg > 2 ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'LES_NORM_4D', 'kg should not appear more than 2 times' )
+
+if ( ikg == 2 ) then
+ if ( gsv ) then
+ ipowers(NNORM_SV ) = ipower_kg_1st
+ else
+ ipowers(NNORM_RV ) = ipower_kg_1st
+ end if
+end if
+
+if (ipowers(NNORM_K ) /= 0 ) call Make_norm ( pa_norm, xles_norm_k, ipowers(NNORM_K ) )
+if (ipowers(NNORM_KG ) /= 0 ) call Make_norm ( pa_norm, xles_norm_rho, ipowers(NNORM_KG ) )
+if (ipowers(NNORM_M ) /= 0 ) call Make_norm ( pa_norm, xles_norm_m, ipowers(NNORM_M ) )
+if (ipowers(NNORM_PA ) /= 0 ) call Make_norm ( pa_norm, xles_norm_p, ipowers(NNORM_PA ) )
+if (ipowers(NNORM_S ) /= 0 ) call Make_norm ( pa_norm, xles_norm_s, ipowers(NNORM_S ) )
+if (ipowers(NNORM_RV ) /= 0 ) call Make_norm ( pa_norm, xles_norm_rv, ipowers(NNORM_RV ) )
+if (ipowers(NNORM_SV ) /= 0 ) call Make_norm_sv( pa_norm, xles_norm_sv, ipowers(NNORM_SV ) )
+
+where( pa_norm == XUNDEF ) pa_norm = pa_les
+
END SUBROUTINE LES_NORM_4D
!
!------------------------------------------------------------------------------
!
-! ###################################################
- SUBROUTINE LES_NORM_3D(HUNIT, PA_LES, PA_NORM, OSV)
-! ###################################################
-!
-!
-!!**** *LES_NORM* normalizes a field according to the chosen normalization
-!!
-!! PURPOSE
-!! -------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/10/00
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) :: HUNIT ! physical unit of field
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PA_LES ! field
-!
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PA_NORM ! normalized field
-LOGICAL, OPTIONAL, INTENT(IN) :: OSV ! flag for scalar variables
-!
-! 0.2 declaration of local variables
-!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZA_LES
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZA_NORM
-!
-INTEGER :: JSV
-!------------------------------------------------------------------------------
-!
-IF (PRESENT(OSV)) THEN
- IF (OSV) THEN
- ALLOCATE(ZA_LES (SIZE(PA_LES,1),SIZE(PA_LES,2),1,SIZE(PA_LES,3)))
- ALLOCATE(ZA_NORM(SIZE(PA_LES,1),SIZE(PA_LES,2),1,SIZE(PA_LES,3)))
- DO JSV=1,SIZE(PA_LES,3)
- ZA_LES (:,:,1,JSV) = PA_LES(:,:,JSV)
- END DO
- CALL LES_NORM_4D(HUNIT, ZA_LES, ZA_NORM, OSV)
- DO JSV=1,SIZE(PA_LES,3)
- PA_NORM(:,:,JSV) = ZA_NORM(:,:,1,JSV)
- END DO
- ELSE
- ALLOCATE(ZA_LES (SIZE(PA_LES,1),SIZE(PA_LES,2),SIZE(PA_LES,3),1))
- ALLOCATE(ZA_NORM(SIZE(PA_LES,1),SIZE(PA_LES,2),SIZE(PA_LES,3),1))
- ZA_LES (:,:,:,1) = PA_LES(:,:,:)
- CALL LES_NORM_4D(HUNIT, ZA_LES, ZA_NORM, OSV)
- PA_NORM(:,:,:) = ZA_NORM(:,:,:,1)
- END IF
-ELSE
- ALLOCATE(ZA_LES (SIZE(PA_LES,1),SIZE(PA_LES,2),SIZE(PA_LES,3),1))
- ALLOCATE(ZA_NORM(SIZE(PA_LES,1),SIZE(PA_LES,2),SIZE(PA_LES,3),1))
- ZA_LES (:,:,:,1) = PA_LES(:,:,:)
- CALL LES_NORM_4D(HUNIT, ZA_LES, ZA_NORM)
- PA_NORM(:,:,:) = ZA_NORM(:,:,:,1)
-END IF
-!
-DEALLOCATE(ZA_LES)
-DEALLOCATE(ZA_NORM)
-!
-END SUBROUTINE LES_NORM_3D
-!
-! ##############################################
- SUBROUTINE LES_NORM_2D(HUNIT, PA_LES, PA_NORM)
-! ##############################################
-!
-!
-!!**** *LES_NORM* normalizes a field according to the chosen normalization
-!!
-!! PURPOSE
-!! -------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/10/00
-!!
-!! --------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER(LEN=*), INTENT(IN) :: HUNIT ! physical unit of field
-REAL, DIMENSION(:,:), INTENT(IN) :: PA_LES ! field
-!
-REAL, DIMENSION(:,:), INTENT(OUT) :: PA_NORM ! normalized field
-!
-! 0.2 declaration of local variables
-!
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZA_LES
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZA_NORM
-!
-!------------------------------------------------------------------------------
-!
-ALLOCATE(ZA_LES (SIZE(PA_LES,1),SIZE(PA_LES,2),1,1))
-ALLOCATE(ZA_NORM (SIZE(PA_LES,1),SIZE(PA_LES,2),1,1))
-!
-ZA_LES (:,:,1,1) = PA_LES(:,:)
-CALL LES_NORM_4D(HUNIT, ZA_LES, ZA_NORM)
-PA_NORM(:,:) = ZA_NORM(:,:,1,1)
-!
-DEALLOCATE(ZA_LES)
-DEALLOCATE(ZA_NORM)
-!
-END SUBROUTINE LES_NORM_2D
-!
-!------------------------------------------------------------------------------
-!
!###################################
-SUBROUTINE LES_Z_NORM(OAVG,PTRAJZ,PWORK6)
+SUBROUTINE LES_Z_NORM(OAVG,PTRAJZ,PWORK4)
!###################################
!
-!* this subroutine interpolates the normalized field PWORK6 to the
+!* this subroutine interpolates the normalized field PWORK4 to the
! vertical normalized coordinate.
!
-USE MODD_PARAMETERS, ONLY : XUNDEF, JPVEXT
USE MODD_LES
+USE MODD_PARAMETERS, ONLY: XUNDEF, JPVEXT
+use modd_time, only: tdtseg
!
USE MODI_COEF_VER_INTERP_LIN
USE MODI_VER_INTERP_LIN
@@ -487,24 +304,21 @@ IMPLICIT NONE
!
LOGICAL, INTENT(IN) :: OAVG ! time average ?
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTRAJZ ! vertical grid
-REAL, DIMENSION(:,:,:,:,:,:), INTENT(INOUT) :: PWORK6 ! field data array
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PWORK4 ! field data array
!
-REAL, DIMENSION(SIZE(PWORK6,4),SIZE(PWORK6,5),SIZE(PWORK6,3)) :: ZTRAJZ
! initial grid
-REAL, DIMENSION(SIZE(PWORK6,4),SIZE(PWORK6,5),SIZE(PWORK6,3), &
- SIZE(PWORK6,1),SIZE(PWORK6,2),SIZE(PWORK6,6) ) :: ZWORK6
+REAL, DIMENSION(SIZE(PWORK4,2),SIZE(PWORK4,4),SIZE(PWORK4,1),SIZE(PWORK4,3) ) :: ZWORK4
! initial data
-REAL, DIMENSION(SIZE(PWORK6,4),SIZE(PWORK6,5),SIZE(PWORK6,3)) :: ZNORMZ
+REAL, DIMENSION(SIZE(PWORK4,2),SIZE(PWORK4,4),SIZE(PWORK4,1)) :: ZNORMZ
! grid in normalized coordinates
!
-REAL, DIMENSION(SIZE(PWORK6,4),SIZE(PWORK6,5),SIZE(PWORK6,3), &
- SIZE(PWORK6,1),SIZE(PWORK6,2),SIZE(PWORK6,6) ) :: ZNORM6
+REAL, DIMENSION(SIZE(PWORK4,2),SIZE(PWORK4,4),SIZE(PWORK4,1),SIZE(PWORK4,3) ) :: ZNORM4
! data interpolated on normalized vertical grid
!
-REAL, DIMENSION(SIZE(PWORK6,4),SIZE(PWORK6,5),SIZE(PWORK6,3)+2*JPVEXT) :: ZZ
-REAL, DIMENSION(SIZE(PWORK6,4),SIZE(PWORK6,5),SIZE(PWORK6,3)+2*JPVEXT) :: ZW
-INTEGER, DIMENSION(SIZE(PWORK6,4),SIZE(PWORK6,5),SIZE(PWORK6,3)) :: IKLIN
-REAL, DIMENSION(SIZE(PWORK6,4),SIZE(PWORK6,5),SIZE(PWORK6,3)) :: ZCOEFLIN
+REAL, DIMENSION(SIZE(PWORK4,2),SIZE(PWORK4,4),SIZE(PWORK4,1)+2*JPVEXT) :: ZZ
+REAL, DIMENSION(SIZE(PWORK4,2),SIZE(PWORK4,4),SIZE(PWORK4,1)+2*JPVEXT) :: ZW
+INTEGER, DIMENSION(SIZE(PWORK4,2),SIZE(PWORK4,4),SIZE(PWORK4,1)) :: IKLIN
+REAL, DIMENSION(SIZE(PWORK4,2),SIZE(PWORK4,4),SIZE(PWORK4,1)) :: ZCOEFLIN
!
INTEGER :: JK, JT, JN, JP
INTEGER :: ITEMP_MEAN_START, ITEMP_MEAN_END
@@ -515,8 +329,9 @@ REAL :: ZMAX_NORM_M
!* normalization height (usually maximum BL height)
!
IF (OAVG) THEN
- ITEMP_MEAN_START = COUNT( XLES_CURRENT_TRAJT(:,1)<=XLES_TEMP_MEAN_START ) + 1
- ITEMP_MEAN_END = COUNT( XLES_CURRENT_TRAJT(:,1)<=XLES_TEMP_MEAN_END )
+ ITEMP_MEAN_START = COUNT( xles_times(:)<=XLES_TEMP_MEAN_START ) + 1
+ ITEMP_MEAN_END = COUNT( xles_times(:)<=XLES_TEMP_MEAN_END )
+
IF (ITEMP_MEAN_START > ITEMP_MEAN_END) THEN
ITEMP_MEAN_START = 1
ITEMP_MEAN_END = NLES_CURRENT_TIMES
@@ -529,17 +344,16 @@ END IF
ZMAX_NORM_M = MAXVAL(ABS(XLES_NORM_M(ITEMP_MEAN_START:ITEMP_MEAN_END)))
!
IF (ZMAX_NORM_M<=0.) THEN
- PWORK6(:,:,:,:,:,:) = XUNDEF
+ PWORK4(:,:,:,:) = XUNDEF
RETURN
END IF
!
!* moves K index in third position
!
DO JK=1,NLES_K
- DO JN=1,SIZE(PWORK6,5)
- DO JT=1,SIZE(PWORK6,4)
- ZTRAJZ(JT,JN,JK) = PTRAJZ(JK,1,JN)
- ZWORK6(JT,JN,JK,1,1,:) = PWORK6(1,1,JK,JT,JN,:)
+ DO JN=1,SIZE(PWORK4,4)
+ DO JT=1,SIZE(PWORK4,2)
+ ZWORK4(JT,JN,JK,:) = PWORK4(JK,JT,:,JN)
END DO
END DO
END DO
@@ -547,9 +361,9 @@ END DO
!* computes the stretching due to the use of a normalized grid
!
DO JK=1,NLES_K
- DO JN=1,SIZE(PWORK6,5)
- DO JT=1,SIZE(PWORK6,4)
- ZNORMZ(JT,JN,JK) = (ZTRAJZ(JT,JN,JK)-XLES_CURRENT_ZS)/ZMAX_NORM_M * XLES_NORM_M(JT) &
+ DO JN=1,SIZE(PWORK4,4)
+ DO JT=1,SIZE(PWORK4,2)
+ ZNORMZ(JT,JN,JK) = (xles_current_z(JK)-XLES_CURRENT_ZS)/ZMAX_NORM_M * XLES_NORM_M(JT) &
+ XLES_CURRENT_ZS
END DO
END DO
@@ -560,34 +374,38 @@ IF (NLES_K>1) THEN
!
!* computes the interpolation coefficients
!
- ZZ(:,:,JPVEXT+1:JPVEXT+NLES_K) = ZTRAJZ(:,:,:)
+ DO JN=1,SIZE(PWORK4,4)
+ DO JT=1,SIZE(PWORK4,2)
+ ZZ(JT,JN,JPVEXT+1:JPVEXT+NLES_K) = xles_current_z(:)
+ END DO
+ END DO
DO JK=1,JPVEXT
- ZZ(:,:, JK) = ZTRAJZ(:,:,1) - (ZTRAJZ(:,:,2) -ZTRAJZ(:,:,1) )*(JPVEXT+1-JK)
- ZZ(:,:,NLES_K+JPVEXT+JK) = ZTRAJZ(:,:,NLES_K) + (ZTRAJZ(:,:,NLES_K)-ZTRAJZ(:,:,NLES_K-1))* JK
+ ZZ(:,:, JK) = xles_current_z(1) - (xles_current_z(2) -xles_current_z(1) )*(JPVEXT+1-JK)
+ ZZ(:,:,NLES_K+JPVEXT+JK) = xles_current_z(NLES_K) + (xles_current_z(NLES_K)-xles_current_z(NLES_K-1))* JK
END DO
CALL COEF_VER_INTERP_LIN(ZZ,ZNORMZ,IKLIN,ZCOEFLIN)
!
!* performs the interpolation
!
- DO JP=1,SIZE(PWORK6,6)
+ DO JP=1,SIZE(PWORK4,3)
ZW = XUNDEF
- ZW(:,:,JPVEXT+1:JPVEXT+NLES_K) = ZWORK6(:,:,:,1,1,JP)
- ZNORM6(:,:,:,1,1,JP) = VER_INTERP_LIN(ZW,IKLIN,ZCOEFLIN)
+ ZW(:,:,JPVEXT+1:JPVEXT+NLES_K) = ZWORK4(:,:,:,JP)
+ ZNORM4(:,:,:,JP) = VER_INTERP_LIN(ZW,IKLIN,ZCOEFLIN)
END DO
!
ELSE
- ZNORM6 = ZWORK6
+ ZNORM4 = ZWORK4
END IF
!
!* puts the normalized grid and data in diachro arrays
!
PTRAJZ(:,:,:) = (PTRAJZ(:,:,:)-XLES_CURRENT_ZS)/ZMAX_NORM_M
!
-DO JN=1,SIZE(PWORK6,5)
- DO JT=1,SIZE(PWORK6,4)
+DO JN=1,SIZE(PWORK4,4)
+ DO JT=1,SIZE(PWORK4,2)
DO JK=1,NLES_K
- PWORK6(1,1,JK,JT,JN,:) = ZNORM6(JT,JN,JK,1,1,:)
+ PWORK4(JK,JT,:,JN) = ZNORM4(JT,JN,JK,:)
END DO
END DO
END DO
@@ -596,24 +414,26 @@ END SUBROUTINE LES_Z_NORM
!------------------------------------------------------------------------------
!
!########################################################
-SUBROUTINE LES_TIME_AVG(PTRAJT,PWORK6,KRESP,PDATIME_AVG)
+SUBROUTINE LES_TIME_AVG(PWORK6,tpdates,KRESP)
!########################################################
!
! this routine computes time averaging
!
! Modifications:
-! 03/2018 (P.Wautelet) replace ADD_FORECAST_TO_DATE by DATETIME_CORRECTDATE
+! P. Wautelet 03/2018: replace ADD_FORECAST_TO_DATE by DATETIME_CORRECTDATE
+! P. Wautelet 28/08/2020: bugfix: allocate ZWORK6 at the correct dimension (3rd one)
!
-USE MODD_LES
-USE MODD_TYPE_DATE
+use modd_les, only: nles_current_times, xles_temp_mean_start, xles_temp_mean_end, xles_temp_mean_step
+use modd_parameters, only: XUNDEF
+use modd_time, only: tdtseg
+use modd_type_date, only: date_time
!
-USE MODE_DATETIME
+use mode_datetime, only: Datetime_correctdate
!
IMPLICIT NONE
!
-REAL, DIMENSION(:,:), POINTER :: PTRAJT ! time
-REAL, DIMENSION(:,:), POINTER :: PDATIME_AVG ! date
-REAL, DIMENSION(:,:,:,:,:,:), POINTER :: PWORK6 ! contains physical field
+REAL, DIMENSION(:,:,:,:,:,:), allocatable :: PWORK6 ! contains physical field
+type(date_time), dimension(:), allocatable, intent(inout) :: tpdates
INTEGER, INTENT(OUT) :: KRESP ! return code (0 is OK)
!------------------------------------------------------------------------------
INTEGER :: JT ! time counter
@@ -628,8 +448,7 @@ INTEGER :: JP ! process loop counter
INTEGER :: JSV ! scalar loop counter
INTEGER :: JX ! first spatial or spectral coordinate loop counter
INTEGER :: JY ! second spatial or spectral coordinate loop counter
-REAL, DIMENSION(16) :: ZDATIME_SAVE ! date
-TYPE(DATE_TIME) :: TZDATE
+integer :: jtb, jte
!------------------------------------------------------------------------------
!
IF ( XLES_TEMP_MEAN_END==XUNDEF &
@@ -645,75 +464,54 @@ IF (IAVG<=0) THEN
RETURN
END IF
!
-ZDATIME_SAVE(:)=PDATIME_AVG(:,1)
-DEALLOCATE(PTRAJT)
-DEALLOCATE(PDATIME_AVG)
+deallocate( tpdates )
!
-ALLOCATE (PTRAJT(IAVG,1))
-ALLOCATE (PDATIME_AVG(16,IAVG))
-ALLOCATE (ZWORK6(SIZE(PWORK6,1),SIZE(PWORK6,2),NLES_K,IAVG,SIZE(PWORK6,5),SIZE(PWORK6,6)))
+allocate( tpdates( iavg ) )
+ALLOCATE (ZWORK6(SIZE(PWORK6,1),SIZE(PWORK6,2),SIZE(PWORK6,3),IAVG,SIZE(PWORK6,5),SIZE(PWORK6,6)))
!
ZWORK6(:,:,:,:,:,:) = 0.
!
-PDATIME_AVG(1,:)=ZDATIME_SAVE(1)
-PDATIME_AVG(2,:)=ZDATIME_SAVE(2)
-PDATIME_AVG(3,:)=ZDATIME_SAVE(3)
-PDATIME_AVG(4,:)=ZDATIME_SAVE(4)
-PDATIME_AVG(5,:)=ZDATIME_SAVE(5)
-PDATIME_AVG(6,:)=ZDATIME_SAVE(6)
-PDATIME_AVG(7,:)=ZDATIME_SAVE(7)
-PDATIME_AVG(8,:)=ZDATIME_SAVE(8)
-PDATIME_AVG(9,:)=ZDATIME_SAVE(9)
-PDATIME_AVG(10,:)=ZDATIME_SAVE(10)
-PDATIME_AVG(11,:)=ZDATIME_SAVE(11)
-PDATIME_AVG(12,:)=ZDATIME_SAVE(12)
-!
DO JAVG=1,IAVG
ZLES_TEMP_MEAN_START=XLES_TEMP_MEAN_START + (JAVG-1) * XLES_TEMP_MEAN_STEP
ZLES_TEMP_MEAN_END =MIN(XLES_TEMP_MEAN_END, ZLES_TEMP_MEAN_START + XLES_TEMP_MEAN_STEP)
- !
+
+ jtb = -1
+ jte = -2
+ do jt = 1, nles_current_times
+ if ( xles_times(jt) >= zles_temp_mean_start ) then
+ jtb = jt
+ exit
+ end if
+ end do
+ do jt = jtb, nles_current_times
+ if ( xles_times(jt) <= zles_temp_mean_end ) then
+ jte = jt
+ else
+ exit
+ end if
+ end do
+
DO JP=1,SIZE(PWORK6,6)
DO JSV=1,SIZE(PWORK6,5)
DO JK=1,SIZE(PWORK6,3)
DO JY=1,SIZE(PWORK6,2)
DO JX=1,SIZE(PWORK6,1)
- ITIME=0
- DO JT=1,NLES_CURRENT_TIMES
- IF ( XLES_CURRENT_TRAJT(JT,1) >= ZLES_TEMP_MEAN_START .AND. &
- XLES_CURRENT_TRAJT(JT,1) <= ZLES_TEMP_MEAN_END) THEN
- IF (PWORK6(JX,JY,JK,JT,JSV,JP) /= XUNDEF) THEN
- ZWORK6(JX,JY,JK,JAVG,JSV,JP) = ZWORK6(JX,JY,JK,JAVG,JSV,JP) &
- + PWORK6(JX,JY,JK,JT,JSV,JP)
- ITIME=ITIME+1
- END IF
- END IF
- END DO
- IF (ITIME >= 1) THEN
- ZWORK6(JX,JY,JK,JAVG,JSV,JP)= &
- ZWORK6(JX,JY,JK,JAVG,JSV,JP) / ITIME
- END IF
- IF (ITIME == 0) THEN
- ZWORK6(JX,JY,JK,JAVG,JSV,JP)= XUNDEF
- END IF
+ zwork6(jx, jy, jk, javg, jsv, jp) = Les_time_avg_1pt( pwork6(jx, jy, jk, :, jsv, jp), jtb, jte )
END DO
END DO
END DO
END DO
END DO
- PTRAJT(JAVG,1)=(ZLES_TEMP_MEAN_START+ZLES_TEMP_MEAN_END)/2.
- TZDATE%TDATE%YEAR = PDATIME_AVG(5,JAVG)
- TZDATE%TDATE%MONTH = PDATIME_AVG(6,JAVG)
- TZDATE%TDATE%DAY = PDATIME_AVG(7,JAVG)
- TZDATE%TIME = PDATIME_AVG(8,JAVG)+PTRAJT(JAVG,1)
- CALL DATETIME_CORRECTDATE(TZDATE)
- PDATIME_AVG(13,JAVG) = TZDATE%TDATE%YEAR
- PDATIME_AVG(14,JAVG) = TZDATE%TDATE%MONTH
- PDATIME_AVG(15,JAVG) = TZDATE%TDATE%DAY
- PDATIME_AVG(16,JAVG) = TZDATE%TIME
+
+ tpdates(javg)%nyear = tdtseg%nyear
+ tpdates(javg)%nmonth = tdtseg%nmonth
+ tpdates(javg)%nday = tdtseg%nday
+ tpdates(javg)%xtime = tdtseg%xtime + ( zles_temp_mean_start + zles_temp_mean_end ) / 2.
+ call Datetime_correctdate( tpdates(javg ) )
END DO
!
DEALLOCATE(PWORK6)
-ALLOCATE(PWORK6(SIZE(ZWORK6,1),SIZE(ZWORK6,2),NLES_K,IAVG,SIZE(ZWORK6,5),SIZE(ZWORK6,6)))
+ALLOCATE(PWORK6(SIZE(ZWORK6,1),SIZE(ZWORK6,2),SIZE(ZWORK6,3),IAVG,SIZE(ZWORK6,5),SIZE(ZWORK6,6)))
PWORK6 = ZWORK6
DEALLOCATE(ZWORK6)
@@ -721,1075 +519,1173 @@ KRESP = 0
END SUBROUTINE LES_TIME_AVG
!------------------------------------------------------------------------------
-!
+
!########################################################
-SUBROUTINE LES_DIACHRO(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PFIELD,HAVG)
+subroutine Les_time_avg_4D( pwork4, tpdates, kresp )
!########################################################
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_GRID
-USE MODI_WRITE_DIACHRO
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP ! group title
-CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT ! comment string
-CHARACTER(LEN=*), INTENT(IN) :: HUNIT ! physical unit
-REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD
-CHARACTER(LEN=1), INTENT(IN) :: HAVG ! flag to compute avg.
-!
-!* 0.2 declaration of local variables for diachro
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJX ! localization of the temporal
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJY ! series in x,y and z. remark:
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJZ ! x and y are not used for LES
-REAL, DIMENSION(:,:), POINTER :: ZTRAJT ! time
-REAL, DIMENSION(:,:), POINTER :: ZDATIME ! date
-!
-INTEGER, DIMENSION(1) :: IGRID ! grid indicator
-CHARACTER(LEN= 10) :: YGROUP ! group title
-CHARACTER(LEN=100), DIMENSION(1) :: YCOMMENT ! comment string
-CHARACTER(LEN=100), DIMENSION(1) :: YTITLE ! title
-CHARACTER(LEN=100), DIMENSION(1) :: YUNIT ! physical unit
-!
-REAL, DIMENSION(SIZE(PFIELD,1),SIZE(PFIELD,2)) &
- :: ZFIELD ! normalized field
-INTEGER :: IRESP ! return code
-!
-REAL, DIMENSION(:,:,:,:,:,:), POINTER :: ZWORK6 ! contains physical field
-!
-INTEGER :: IIL, IIH, IJL, IJH, IKL, IKH ! cartesian area relatively to the
-! ! entire domain
-INTEGER :: JK ! vertical loop counter
-!
-LOGICAL :: GAVG ! flag to compute time averagings
-LOGICAL :: GNORM ! flag to compute normalizations
-!
-!-------------------------------------------------------------------------------
-!
-GAVG =(HAVG=='A' .OR. HAVG=='H')
-GNORM=(HAVG=='E' .OR. HAVG=='H')
-!
-IF (GAVG .AND. (XLES_TEMP_MEAN_START==XUNDEF .OR. XLES_TEMP_MEAN_END==XUNDEF)) RETURN
-!
-ZFIELD=PFIELD
-IF (GNORM) CALL LES_NORM_2D(HUNIT, PFIELD, ZFIELD)
-!
-!* 1.0 Initialization of diachro variables for LES (z,t) profiles
-! ----------------------------------------------------------
-!
-ALLOCATE (ZTRAJX(1,1,1))
-ALLOCATE (ZTRAJY(1,1,1))
-ALLOCATE (ZTRAJZ(NLES_K,1,1))
-!
-ALLOCATE(ZWORK6(1,1,NLES_K,NLES_CURRENT_TIMES,1,1))
-ALLOCATE(ZTRAJT(NLES_CURRENT_TIMES,1))
-ALLOCATE(ZDATIME(16,NLES_CURRENT_TIMES))
-!
-IIL = NLES_CURRENT_IINF
-IIH = NLES_CURRENT_ISUP
-IJL = NLES_CURRENT_JINF
-IJH = NLES_CURRENT_JSUP
-ZTRAJX(:,:,:) = (IIL+IIH)/2
-ZTRAJY(:,:,:) = (IJL+IJH)/2
-IKL=NLES_LEVELS(1)
-IKH=NLES_LEVELS(NLES_K)
-DO JK=1,NLES_K
- ZTRAJZ(JK,1,1) = XLES_CURRENT_Z(JK)
-END DO
-IGRID(1)=1
-YCOMMENT(1) = HCOMMENT
-!
-YUNIT (1) = HUNIT
-YGROUP = HGROUP
-!
-ZWORK6(1,1,:,:,1,1) = ZFIELD (:,:)
-ZTRAJT(:,:) = XLES_CURRENT_TRAJT(:,:)
-ZDATIME(:,:)=XLES_CURRENT_DATIME(:,:)
-!
-!* normalization of vertical dimension
-!
-IF (GNORM) THEN
- IF (HUNIT(1:1)/=' ') YUNIT='-'
- CALL LES_Z_NORM(GAVG,ZTRAJZ,ZWORK6)
-END IF
-!
-!* time average
-!
-IRESP = 0
-IF (GAVG) CALL LES_TIME_AVG(ZTRAJT,ZWORK6,IRESP,ZDATIME)
-!
-IF (HAVG/=' ') YGROUP=HAVG//'_'//YGROUP
-YTITLE(1) = YGROUP
-!
-!* 2.0 Writing of the profile
-! ----------------------
-!
-IF (IRESP==0 .AND. ANY(ZWORK6/=XUNDEF)) &
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SSOL",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH, &
- PTRAJX=ZTRAJX,PTRAJY=ZTRAJY,PTRAJZ=ZTRAJZ )
-!
-!
-!* 3.0 Deallocations
-! -------------
-!
-DEALLOCATE (ZTRAJX)
-DEALLOCATE (ZTRAJY)
-DEALLOCATE (ZTRAJZ)
-DEALLOCATE (ZTRAJT)
-DEALLOCATE (ZWORK6)
-DEALLOCATE (ZDATIME)
-!
-!-------------------------------------------------------------------------------
-END SUBROUTINE LES_DIACHRO
-!-------------------------------------------------------------------------------
-!###########################################################
-SUBROUTINE LES_DIACHRO_SV(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PFIELD,HAVG)
-!###########################################################
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_GRID
-USE MODI_WRITE_DIACHRO
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP ! group title
-CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT ! comment string
-CHARACTER(LEN=*), INTENT(IN) :: HUNIT ! physical unit
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD
-CHARACTER(LEN=1), INTENT(IN) :: HAVG ! flag to compute avg.
-!
-!* 0.2 declaration of local variables for diachro
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJX ! localization of the temporal
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJY ! series in x,y and z. remark:
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJZ ! x and y are not used for LES
-REAL, DIMENSION(:,:), POINTER :: ZTRAJT ! time
-REAL, DIMENSION(:,:), POINTER :: ZDATIME ! date
-!
-INTEGER, DIMENSION(1) :: IGRID ! grid indicator
-CHARACTER(LEN= 10) :: YGROUP ! group title
-CHARACTER(LEN=100), DIMENSION(1) :: YCOMMENT ! comment string
-CHARACTER(LEN=100), DIMENSION(1) :: YTITLE ! title
-CHARACTER(LEN=100), DIMENSION(1) :: YUNIT ! physical unit
-REAL, DIMENSION(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)) &
- :: ZFIELD ! normalized field
-INTEGER :: IRESP ! return code
-!
-REAL, DIMENSION(:,:,:,:,:,:), POINTER :: ZWORK6 ! contains physical field
-!
-INTEGER :: IIL, IIH, IJL, IJH, IKL, IKH ! cartesian area relatively to the
-! ! entire domain
-INTEGER :: JK ! vertical loop counter
-INTEGER :: JSV ! scalar loop counter
-!
-LOGICAL :: GAVG ! flag to compute time averagings
-LOGICAL :: GNORM ! flag to compute normalizations
-!
-!-------------------------------------------------------------------------------
-!
-GAVG =(HAVG=='A' .OR. HAVG=='H')
-GNORM=(HAVG=='E' .OR. HAVG=='H')
-!
-IF (GAVG .AND. (XLES_TEMP_MEAN_START==XUNDEF .OR. XLES_TEMP_MEAN_END==XUNDEF)) RETURN
-!
-ZFIELD=PFIELD
-IF (GNORM) CALL LES_NORM_3D(HUNIT, PFIELD, ZFIELD, .TRUE.)
-!
-!* 1.0 Initialization of diachro variables for LES (z,t) profiles
-! ----------------------------------------------------------
-!
-ALLOCATE (ZTRAJX(1,1,SIZE(PFIELD,3)))
-ALLOCATE (ZTRAJY(1,1,SIZE(PFIELD,3)))
-ALLOCATE (ZTRAJZ(NLES_K,1,SIZE(PFIELD,3)))
-ALLOCATE(ZWORK6(1,1,NLES_K,NLES_CURRENT_TIMES,SIZE(PFIELD,3),1))
-ALLOCATE(ZTRAJT(NLES_CURRENT_TIMES,1))
-ALLOCATE(ZDATIME(16,NLES_CURRENT_TIMES))
-!
-IIL = NLES_CURRENT_IINF
-IIH = NLES_CURRENT_ISUP
-IJL = NLES_CURRENT_JINF
-IJH = NLES_CURRENT_JSUP
-ZTRAJX(:,:,:) = (IIL+IIH)/2
-ZTRAJY(:,:,:) = (IJL+IJH)/2
-IKL=NLES_LEVELS(1)
-IKH=NLES_LEVELS(NLES_K)
-DO JK=1,NLES_K
- ZTRAJZ(JK,:,:) = XLES_CURRENT_Z(JK)
-END DO
-IGRID(1)=1
-YCOMMENT(1) = HCOMMENT
-!
-YUNIT (1) = HUNIT
-YGROUP = HGROUP
-!
-ZWORK6(1,1,:,:,:,1) = ZFIELD (:,:,:)
-ZTRAJT(:,:) = XLES_CURRENT_TRAJT(:,:)
-ZDATIME(:,:)=XLES_CURRENT_DATIME(:,:)
-!
-IF (GNORM) THEN
- IF (HUNIT(1:1)/=' ') YUNIT='-'
- CALL LES_Z_NORM(GAVG,ZTRAJZ,ZWORK6)
-END IF
-!
-!* time average
-!
-IRESP = 0
-IF (GAVG) CALL LES_TIME_AVG(ZTRAJT,ZWORK6,IRESP,ZDATIME)
-!
-IF (HAVG/=' ') YGROUP=HAVG//'_'//YGROUP
-YTITLE(1) = YGROUP
-!
-!* 2.0 Writing of the profile
-! ----------------------
-!
-!
-IF (IRESP==0 .AND. ANY(ZWORK6/=XUNDEF)) &
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SSOL",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH, &
- PTRAJX=ZTRAJX,PTRAJY=ZTRAJY,PTRAJZ=ZTRAJZ )
-!
-!
-!* 3.0 Deallocations
-! -------------
-!
-DEALLOCATE (ZTRAJX)
-DEALLOCATE (ZTRAJY)
-DEALLOCATE (ZTRAJZ)
-DEALLOCATE (ZTRAJT)
-DEALLOCATE(ZWORK6)
-DEALLOCATE(ZDATIME)
-!
-!-------------------------------------------------------------------------------
-END SUBROUTINE LES_DIACHRO_SV
-!-------------------------------------------------------------------------------
-!#####################################################################
-SUBROUTINE LES_DIACHRO_MASKS(TPDIAFILE,HGROUP,HTITLE,HCOMMENT,HUNIT,PFIELD,HAVG)
-!#####################################################################
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_GRID
-USE MODI_WRITE_DIACHRO
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP ! group title
-CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HTITLE ! title
-CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HCOMMENT ! comment string
-CHARACTER(LEN=*), INTENT(IN) :: HUNIT ! physical unit
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD
-CHARACTER(LEN=1), INTENT(IN) :: HAVG ! flag to compute avg.
-!
-!* 0.2 declaration of local variables for diachro
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJX ! localization of the temporal
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJY ! series in x,y and z. remark:
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJZ ! x and y are not used for LES
-REAL, DIMENSION(:,:), POINTER :: ZTRAJT ! time
-REAL, DIMENSION(:,:), POINTER :: ZDATIME ! date
-!
-INTEGER, DIMENSION(SIZE(PFIELD,3)) :: IGRID ! grid indicator
-CHARACTER(LEN= 10) :: YGROUP ! group title
-CHARACTER(LEN=100), DIMENSION(SIZE(PFIELD,3)) :: YCOMMENT ! comment string
-CHARACTER(LEN=100), DIMENSION(SIZE(PFIELD,3)) :: YTITLE ! title
-CHARACTER(LEN=100), DIMENSION(SIZE(PFIELD,3)) :: YUNIT ! physical unit
-REAL, DIMENSION(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3)) &
- :: ZFIELD ! normalized field
-INTEGER :: IRESP ! return code
-!
-REAL, DIMENSION(:,:,:,:,:,:), POINTER :: ZWORK6 ! contains physical field
-!
-INTEGER :: IIL, IIH, IJL, IJH, IKL, IKH ! cartesian area relatively to the
-! ! entire domain
-INTEGER :: JK ! vertical loop counter
-INTEGER :: JMASK ! Mask loop counter
-!
-LOGICAL :: GAVG ! flag to compute time averagings
-LOGICAL :: GNORM ! flag to compute normalizations
-!
-!-------------------------------------------------------------------------------
-!
-GAVG =(HAVG=='A' .OR. HAVG=='H')
-GNORM=(HAVG=='E' .OR. HAVG=='H')
-!
-IF (GAVG .AND. (XLES_TEMP_MEAN_START==XUNDEF .OR. XLES_TEMP_MEAN_END==XUNDEF)) RETURN
-!
-ZFIELD=PFIELD
-IF (GNORM) CALL LES_NORM_3D(HUNIT, PFIELD, ZFIELD)
-!
-!* 1.0 Initialization of diachro variables for LES (z,t) profiles
-! ----------------------------------------------------------
-!
-ALLOCATE (ZTRAJX(1,1,1))
-ALLOCATE (ZTRAJY(1,1,1))
-ALLOCATE (ZTRAJZ(NLES_K,1,1))
-ALLOCATE(ZWORK6(1,1,NLES_K,NLES_CURRENT_TIMES,1,SIZE(PFIELD,3)))
-ALLOCATE(ZTRAJT(NLES_CURRENT_TIMES,1))
-ALLOCATE(ZDATIME(16,NLES_CURRENT_TIMES))
-
-!
-IIL = NLES_CURRENT_IINF
-IIH = NLES_CURRENT_ISUP
-IJL = NLES_CURRENT_JINF
-IJH = NLES_CURRENT_JSUP
-ZTRAJX(:,:,:) = (IIL+IIH)/2
-ZTRAJY(:,:,:) = (IJL+IJH)/2
-IKL=NLES_LEVELS(1)
-IKH=NLES_LEVELS(NLES_K)
-DO JK=1,NLES_K
- ZTRAJZ(JK,:,1) = XLES_CURRENT_Z(JK)
-END DO
-!
-IGRID(:)=1
-!
-YCOMMENT(:) = HCOMMENT(:)
-YUNIT (:) = HUNIT
-YGROUP = HGROUP
-!
-ZWORK6(1,1,:,:,1,:) = ZFIELD (:,:,:)
-ZTRAJT(:,:) = XLES_CURRENT_TRAJT(:,:)
-ZDATIME(:,:)= XLES_CURRENT_DATIME(:,:)
-!
-IF (GNORM) THEN
- IF (HUNIT(1:1)/=' ') YUNIT='-'
- CALL LES_Z_NORM(GAVG,ZTRAJZ,ZWORK6)
-END IF
-!
-!
-!* time average
-!
-IRESP = 0
-IF (GAVG) CALL LES_TIME_AVG(ZTRAJT,ZWORK6,IRESP,ZDATIME)
-!
-IF (HAVG/=' ') YGROUP=HAVG//'_'//YGROUP
-YTITLE (:) = YGROUP//HTITLE(:)
-!
-!
-!* 2.0 Writing of the profile
-! ----------------------
-!
-IF (IRESP==0 .AND. ANY(ZWORK6/=XUNDEF)) &
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SSOL",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH, &
- PTRAJX=ZTRAJX,PTRAJY=ZTRAJY,PTRAJZ=ZTRAJZ )
-!
-!
-!* 3.0 Deallocations
-! -------------
-!
-DEALLOCATE (ZTRAJX)
-DEALLOCATE (ZTRAJY)
-DEALLOCATE (ZTRAJZ)
-DEALLOCATE (ZTRAJT)
-DEALLOCATE(ZWORK6)
-DEALLOCATE(ZDATIME)
-!
-!-------------------------------------------------------------------------------
-END SUBROUTINE LES_DIACHRO_MASKS
-!-------------------------------------------------------------------------------
-!########################################################################
-SUBROUTINE LES_DIACHRO_SV_MASKS(TPDIAFILE,HGROUP,HTITLE,HCOMMENT,HUNIT,PFIELD,HAVG)
-!########################################################################
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_GRID
-USE MODI_WRITE_DIACHRO
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP ! group title
-CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HTITLE ! title
-CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HCOMMENT ! comment string
-CHARACTER(LEN=*), INTENT(IN) :: HUNIT ! physical unit
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PFIELD
-CHARACTER(LEN=1), INTENT(IN) :: HAVG ! flag to compute avg.
-!
-!* 0.2 declaration of local variables for diachro
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJX ! localization of the temporal
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJY ! series in x,y and z. remark:
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJZ ! x and y are not used for LES
-REAL, DIMENSION(:,:), POINTER :: ZTRAJT ! time
-REAL, DIMENSION(:,:), POINTER :: ZDATIME! date
-!
-INTEGER, DIMENSION(SIZE(PFIELD,3)) :: IGRID ! grid indicator
-CHARACTER(LEN= 10) :: YGROUP ! group title
-CHARACTER(LEN=100), DIMENSION(SIZE(PFIELD,3)) :: YCOMMENT ! comment string
-CHARACTER(LEN=100), DIMENSION(SIZE(PFIELD,3)) :: YTITLE ! title
-CHARACTER(LEN=100), DIMENSION(SIZE(PFIELD,3)) :: YUNIT ! physical unit
-REAL, DIMENSION(SIZE(PFIELD,1),SIZE(PFIELD,2),SIZE(PFIELD,3),SIZE(PFIELD,4))&
- :: ZFIELD ! normalized field
-INTEGER :: IRESP ! return code
-!
-REAL, DIMENSION(:,:,:,:,:,:), POINTER :: ZWORK6 ! contains physical field
-!
-INTEGER :: IIL, IIH, IJL, IJH, IKL, IKH ! cartesian area relatively to the
-! ! entire domain
-INTEGER :: JK ! vertical loop counter
-INTEGER :: JP ! process loop counter
-INTEGER :: JSV ! scalar loop counter
-INTEGER :: JMASK ! mask loop counter
-!
-LOGICAL :: GAVG ! flag to compute time averagings
-LOGICAL :: GNORM ! flag to compute normalizations
-!
-!-------------------------------------------------------------------------------
-!
-GAVG =(HAVG=='A' .OR. HAVG=='H')
-GNORM=(HAVG=='E' .OR. HAVG=='H')
-!
-IF (GAVG .AND. (XLES_TEMP_MEAN_START==XUNDEF .OR. XLES_TEMP_MEAN_END==XUNDEF)) RETURN
-!
-ZFIELD=PFIELD
-IF (GNORM) CALL LES_NORM_4D(HUNIT, PFIELD, ZFIELD, .TRUE.)
-!
-!* 1.0 Initialization of diachro variables for LES (z,t) profiles
-! ----------------------------------------------------------
-!
-ALLOCATE (ZTRAJX(1,1,SIZE(PFIELD,4)))
-ALLOCATE (ZTRAJY(1,1,SIZE(PFIELD,4)))
-ALLOCATE (ZTRAJZ(NLES_K,1,SIZE(PFIELD,4)))
-ALLOCATE(ZWORK6(1,1,NLES_K,NLES_CURRENT_TIMES,SIZE(PFIELD,4),SIZE(PFIELD,3)))
-ALLOCATE(ZTRAJT(NLES_CURRENT_TIMES,1))
-ALLOCATE(ZDATIME(16,NLES_CURRENT_TIMES))
-!
-IIL = NLES_CURRENT_IINF
-IIH = NLES_CURRENT_ISUP
-IJL = NLES_CURRENT_JINF
-IJH = NLES_CURRENT_JSUP
-ZTRAJX(:,:,:) = (IIL+IIH)/2
-ZTRAJY(:,:,:) = (IJL+IJH)/2
-IKL=NLES_LEVELS(1)
-IKH=NLES_LEVELS(NLES_K)
-DO JK=1,NLES_K
- ZTRAJZ(JK,:,:) = XLES_CURRENT_Z(JK)
-END DO
-IGRID(:)=1
-!
-YCOMMENT(:) = HCOMMENT(:)
-YUNIT (:) = HUNIT
-YGROUP = HGROUP
-!
-!
-DO JSV=1,SIZE(PFIELD,4)
- DO JP=1,SIZE(PFIELD,3)
- ZWORK6(1,1,:,:,JSV,JP) = ZFIELD (:,:,JP,JSV)
- END DO
-END DO
-ZTRAJT(:,:) = XLES_CURRENT_TRAJT(:,:)
-ZDATIME(:,:)= XLES_CURRENT_DATIME(:,:)
-!
-IF (GNORM) THEN
- IF (HUNIT(1:1)/=' ') YUNIT='-'
- CALL LES_Z_NORM(GAVG,ZTRAJZ,ZWORK6)
-END IF
-!n
-!
-!* time average
-!
-IRESP = 0
-IF (GAVG) CALL LES_TIME_AVG(ZTRAJT,ZWORK6,IRESP,ZDATIME)
-!
-IF (HAVG/=' ') YGROUP=HAVG//'_'//YGROUP
-YTITLE (:) = YGROUP//HTITLE(:)
-!
-!* 2.0 Writing of the profile
-! ----------------------
-!
-!
-IF (IRESP==0 .AND. ANY(ZWORK6/=XUNDEF)) &
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SSOL",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH, &
- PTRAJX=ZTRAJX,PTRAJY=ZTRAJY,PTRAJZ=ZTRAJZ )
-!
-!
-!* 3.0 Deallocations
-! -------------
-!
-DEALLOCATE (ZTRAJX)
-DEALLOCATE (ZTRAJY)
-DEALLOCATE (ZTRAJZ)
-DEALLOCATE (ZTRAJT)
-DEALLOCATE(ZWORK6)
-DEALLOCATE(ZDATIME)
-!
+use modd_les, only: nles_current_times, xles_temp_mean_start, xles_temp_mean_end, xles_temp_mean_step
+use modd_parameters, only: XUNDEF
+use modd_time, only: tdtseg
+use modd_type_date, only: date_time
+
+use mode_datetime, only: Datetime_correctdate
+
+implicit none
+
+real, dimension(:,:,:,:), allocatable, intent(inout) :: pwork4 ! contains physical field
+type(date_time), dimension(:), allocatable, intent(inout) :: tpdates
+integer, intent(out) :: kresp ! return code (0 is ok)
+!------------------------------------------------------------------------------
+integer :: jt ! time counter
+integer :: itime ! nb of avg. points
+integer :: iavg ! nb of avg. periods
+integer :: javg ! loop counter on avg. periods
+integer :: jk ! vertical loop counter
+integer :: jp ! process loop counter
+integer :: jsv ! scalar loop counter
+integer :: jx ! first spatial or spectral coordinate loop counter
+integer :: jy ! second spatial or spectral coordinate loop counter
+integer :: jtb, jte
+real :: zles_temp_mean_start ! initial and end times
+real :: zles_temp_mean_end ! of one avergaing preiod
+real, dimension(:,:,:,:), allocatable :: zwork4 ! contains averaged physical field
+!------------------------------------------------------------------------------
+
+if ( xles_temp_mean_end == XUNDEF &
+ .or. xles_temp_mean_start == XUNDEF &
+ .or. xles_temp_mean_step == XUNDEF ) then
+ kresp = -1
+ return
+end if
+
+iavg = Int( xles_temp_mean_end - 1.e-10 - xles_temp_mean_start ) / xles_temp_mean_step + 1
+if ( iavg <= 0 ) then
+ kresp = -1
+ return
+end if
+
+Deallocate( tpdates )
+
+Allocate( tpdates(iavg) )
+Allocate( zwork4(Size( pwork4, 1 ), iavg, Size( pwork4, 3 ), Size( pwork4, 4 )) )
+
+zwork4(:, :, :, :) = 0.
+
+do javg = 1, iavg
+ zles_temp_mean_start = xles_temp_mean_start + (javg - 1) * xles_temp_mean_step
+ zles_temp_mean_end = Min( xles_temp_mean_end, zles_temp_mean_start + xles_temp_mean_step )
+
+ jtb = -1
+ jte = -2
+ do jt = 1, nles_current_times
+ if ( xles_times(jt) >= zles_temp_mean_start ) then
+ jtb = jt
+ exit
+ end if
+ end do
+ do jt = jtb, nles_current_times
+ if ( xles_times(jt) <= zles_temp_mean_end ) then
+ jte = jt
+ else
+ exit
+ end if
+ end do
+
+ do jp = 1, Size( pwork4, 4 )
+ do jsv = 1, Size( pwork4, 3 )
+ do jk = 1, Size( pwork4, 1 )
+ zwork4(jk, javg, jsv, jp) = Les_time_avg_1pt( pwork4(jk, :, jsv, jp), jtb, jte )
+ end do
+ end do
+ end do
+
+ tpdates(javg)%nyear = tdtseg%nyear
+ tpdates(javg)%nmonth = tdtseg%nmonth
+ tpdates(javg)%nday = tdtseg%nday
+ tpdates(javg)%xtime = tdtseg%xtime + ( zles_temp_mean_start + zles_temp_mean_end ) / 2.
+ call Datetime_correctdate( tpdates(javg) )
+end do
+
+Deallocate( pwork4 )
+Allocate( pwork4(Size( zwork4, 1 ), iavg, Size( zwork4, 3 ), Size( zwork4, 4 )) )
+
+pwork4 = zwork4
+
+Deallocate( zwork4 )
+
+kresp = 0
+
+end subroutine Les_time_avg_4D
+!------------------------------------------------------------------------------
+
+!#######################################################################
+pure function Les_time_avg_1pt( pfieldin, ktb, kte ) result( pfieldout )
+!#######################################################################
+! This routine computes time averaging for 1 point
+use modd_parameters, only: XUNDEF
+
+implicit none
+
+real, dimension(:), intent(in) :: pfieldin
+integer, intent(in) :: ktb
+integer, intent(in) :: kte
+
+real :: pfieldout
+
+integer :: itime, jt
+
+itime = 0
+
+pfieldout = 0.
+
+do jt = ktb, kte
+ if ( pfieldin(jt) /= XUNDEF ) then
+ pfieldout = pfieldout + pfieldin(jt)
+ itime = itime + 1
+ end if
+end do
+
+if (itime == 0) then
+ pfieldout = XUNDEF
+else
+ pfieldout = pfieldout / itime
+end if
+
+end function Les_time_avg_1pt
+
+!##############################################################################################
+subroutine Les_diachro_1D( tpdiafile, tpfield, hgroup, hgroupcomment, odoavg, odonorm, pfield )
+!##############################################################################################
+
+use modd_field, only: NMNHDIM_BUDGET_LES_TIME, NMNHDIM_UNUSED, tfield_metadata_base
+use modd_io, only: tfiledata
+
+type(tfiledata), intent(in) :: tpdiafile ! File to write
+type(tfield_metadata_base), intent(in) :: tpfield ! Metadata of field
+character(len=*), intent(in) :: hgroup ! Group of the field
+character(len=*), intent(in) :: hgroupcomment
+logical, intent(in) :: odoavg ! Compute and store time average
+logical, intent(in) :: odonorm ! Compute and store normalized field
+real, dimension(:), intent(in) :: pfield ! Data array
+
+type(tfield_metadata_base) :: tzfield
+
+tzfield = tpfield
+
+if ( tzfield%ndims /= 1 ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_1D', 'ndims /= 1 for ' // Trim( tzfield%cmnhname ) )
+ tzfield%ndims = 1
+end if
+
+if ( Any( tzfield%ndimlist(2:) /= NMNHDIM_UNUSED ) ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_1D', 'unexpected type for some dimensions of ' &
+ // Trim( tzfield%cmnhname ) )
+ tzfield%ndimlist(2:) = NMNHDIM_UNUSED
+end if
+
+if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_TIME ) then
+ tzfield%ndimlist(2) = tzfield%ndimlist(1)
+ tzfield%ndimlist(1) = NMNHDIM_UNUSED
+ tzfield%ndimlist(3) = NMNHDIM_UNUSED
+ tzfield%ndimlist(4) = NMNHDIM_UNUSED
+ call Les_diachro_common( tpdiafile, tzfield, hgroup, hgroupcomment, reshape( pfield, [ 1, size( pfield, 1 ), 1, 1 ] ), &
+ odoavg, odonorm )
+else
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_1D', &
+ 'ndimlist configuration not yet implemented for ' // Trim( tzfield%cmnhname ) )
+end if
+
+end subroutine Les_diachro_1D
+
+!##############################################################################################
+subroutine Les_diachro_2D( tpdiafile, tpfield, hgroup, hgroupcomment, odoavg, odonorm, pfield )
+!##############################################################################################
+
+use modd_field, only: NMNHDIM_BUDGET_LES_LEVEL, NMNHDIM_BUDGET_LES_SV, NMNHDIM_BUDGET_LES_TIME, NMNHDIM_UNUSED, &
+ tfield_metadata_base
+use modd_io, only: tfiledata
+
+type(tfiledata), intent(in) :: tpdiafile ! File to write
+type(tfield_metadata_base), intent(in) :: tpfield ! Metadata of field
+character(len=*), intent(in) :: hgroup ! Group of the field
+character(len=*), intent(in) :: hgroupcomment
+logical, intent(in) :: odoavg ! Compute and store time average
+logical, intent(in) :: odonorm ! Compute and store normalized field
+real, dimension(:,:), intent(in) :: pfield ! Data array
+
+type(tfield_metadata_base) :: tzfield
+
+tzfield = tpfield
+
+if ( tzfield%ndims /= 2 ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_2D', 'ndims /= 2 for ' // Trim( tzfield%cmnhname ) )
+ tzfield%ndims = 2
+end if
+
+if ( Any( tzfield%ndimlist(3:) /= NMNHDIM_UNUSED ) ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_2D', 'unexpected type for some dimensions of ' &
+ // Trim( tzfield%cmnhname ) )
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+end if
+
+if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_LEVEL &
+ .and. tzfield%ndimlist(2) == NMNHDIM_BUDGET_LES_TIME ) then
+ tzfield%ndimlist(3) = NMNHDIM_UNUSED
+ tzfield%ndimlist(4) = NMNHDIM_UNUSED
+ call Les_diachro_common( tpdiafile, tzfield, hgroup, hgroupcomment, &
+ reshape( pfield, [ size( pfield, 1 ), size( pfield, 2 ), 1, 1 ] ), &
+ odoavg, odonorm )
+else if ( tzfield%ndimlist(1) == NMNHDIM_BUDGET_LES_TIME &
+ .and. tzfield%ndimlist(2) == NMNHDIM_BUDGET_LES_SV ) then
+ tzfield%ndimlist(4) = tzfield%ndimlist(2)
+ tzfield%ndimlist(2) = tzfield%ndimlist(1)
+ tzfield%ndimlist(1) = NMNHDIM_UNUSED
+ tzfield%ndimlist(3) = NMNHDIM_UNUSED
+ call Les_diachro_common( tpdiafile, tzfield, hgroup, hgroupcomment, &
+ reshape( pfield, [ 1, size( pfield, 1 ), 1, size( pfield, 2 ) ] ), &
+ odoavg, odonorm )
+else
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_2D', &
+ 'ndimlist configuration not yet implemented for ' // Trim( tzfield%cmnhname ) )
+
+end if
+
+end subroutine Les_diachro_2D
+
+!###############################################################################################
+subroutine Les_diachro_3D( tpdiafile, tpfield, hgroup, hgroupcomment, odoavg, odonorm, pfield, &
+ hfieldnames, hfieldcomments, 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, &
+ tfield_metadata_base
+use modd_io, only: tfiledata
+
+type(tfiledata), intent(in) :: tpdiafile ! File to write
+type(tfield_metadata_base), intent(in) :: tpfield ! Metadata of field
+character(len=*), intent(in) :: hgroup ! Group of the field
+character(len=*), intent(in) :: hgroupcomment
+logical, intent(in) :: odoavg ! Compute and store time average
+logical, intent(in) :: odonorm ! Compute and store normalized field
+real, dimension(:,:,:), intent(in) :: pfield ! Data array
+character(len=*), dimension(:), optional, intent(in) :: hfieldnames
+character(len=*), dimension(:), optional, intent(in) :: hfieldcomments
+character(len=*), dimension(:), optional, intent(in) :: hmasks
+
+type(tfield_metadata_base) :: tzfield
+
+tzfield = tpfield
+
+if ( tzfield%ndims /= 3 ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_3D', 'ndims /= 3 for ' // Trim( tzfield%cmnhname ) )
+ tzfield%ndims = 3
+end if
+
+if ( Any( tzfield%ndimlist(4:) /= NMNHDIM_UNUSED ) ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_3D', 'unexpected type for some dimensions of ' &
+ // Trim( tzfield%cmnhname ) )
+ 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 ) 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, hgroup, hgroupcomment, &
+ 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( hfieldnames ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_3D', &
+ 'optional dummy argument hfieldnames is needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( .not. Present( hfieldcomments ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_3D', &
+ 'optional dummy argument hfieldcomments is needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( Size( hfieldnames ) /= Size( pfield, 3) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_3D', 'wrong size for hfieldnames (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( Size( hfieldcomments ) /= Size( pfield, 3) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_3D', 'wrong size for hfieldcomments (' // Trim( tzfield%cmnhname ) // ')' )
+
+ tzfield%ndimlist(4) = NMNHDIM_UNUSED
+ call Les_diachro_common( tpdiafile, tzfield, hgroup, hgroupcomment, &
+ reshape( pfield, [ size( pfield, 1 ), size( pfield, 2 ), size( pfield, 3 ), 1 ] ), &
+ odoavg, odonorm, hfieldnames = hfieldnames, hfieldcomments = hfieldcomments )
+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
+ if ( Present( hfieldnames ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_3D', &
+ 'optional dummy argument hfieldnames is not needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( Present( hfieldcomments ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_3D', &
+ 'optional dummy argument hfieldcomments 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, hgroup, hgroupcomment, &
+ reshape( pfield, [ size( pfield, 1 ), size( pfield, 2 ), 1, size( pfield, 3 ) ] ), &
+ odoavg, odonorm )
+else
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_3D', &
+ 'ndimlist configuration not yet implemented for ' // Trim( tzfield%cmnhname ) )
+end if
+
+end subroutine Les_diachro_3D
+
+!###############################################################################################
+subroutine Les_diachro_4D( tpdiafile, tpfield, hgroup, hgroupcomment, odoavg, odonorm, pfield, &
+ hfieldnames, hfieldcomments, hmasks )
+!###############################################################################################
+
+use modd_field, only: NMNHDIM_BUDGET_LES_LEVEL, NMNHDIM_BUDGET_LES_MASK, NMNHDIM_BUDGET_LES_PDF, NMNHDIM_BUDGET_LES_SV, &
+ NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_TERM, NMNHDIM_UNUSED, &
+ tfield_metadata_base
+use modd_io, only: tfiledata
+
+type(tfiledata), intent(in) :: tpdiafile ! File to write
+type(tfield_metadata_base), intent(in) :: tpfield ! Metadata of field
+character(len=*), intent(in) :: hgroup ! Group of the field
+character(len=*), intent(in) :: hgroupcomment
+logical, intent(in) :: odoavg ! Compute and store time average
+logical, intent(in) :: odonorm ! Compute and store normalized field
+real, dimension(:,:,:,:), intent(in) :: pfield ! Data array
+character(len=*), dimension(:), optional, intent(in) :: hfieldnames
+character(len=*), dimension(:), optional, intent(in) :: hfieldcomments
+character(len=*), dimension(:), optional, intent(in) :: hmasks
+
+type(tfield_metadata_base) :: tzfield
+
+tzfield = tpfield
+
+if ( tzfield%ndims /= 4 ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', 'ndims /= 4 for ' // Trim( tzfield%cmnhname ) )
+ tzfield%ndims = 4
+end if
+
+if ( Any( tzfield%ndimlist(5:) /= NMNHDIM_UNUSED ) ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', 'unexpected type for some dimensions of ' &
+ // Trim( tzfield%cmnhname ) )
+ 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 &
+ .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 ( Present( hfieldnames ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', &
+ 'optional dummy argument hfieldnames is not needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( Present( hfieldcomments ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', &
+ 'optional dummy argument hfieldcomments is not 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 ) // ')' )
+
+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( hfieldnames ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', &
+ 'optional dummy argument hfieldnames is needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( .not. Present( hfieldcomments ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', &
+ 'optional dummy argument hfieldcomments is needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( Present( hmasks ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', &
+ 'optional dummy argument hmasks is not needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( Size( hfieldnames ) /= Size( pfield, 3) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_4D', 'wrong size for hfieldnames (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( Size( hfieldcomments ) /= Size( pfield, 3) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_4D', 'wrong size for hfieldcomments (' // Trim( tzfield%cmnhname ) // ')' )
+
+else 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_PDF ) 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 ( Present( hfieldnames ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', &
+ 'optional dummy argument hfieldnames is not needed for tpfield (' // Trim( tzfield%cmnhname ) // ')' )
+
+ if ( Present( hfieldcomments ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', &
+ 'optional dummy argument hfieldcomments is not 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 ) // ')' )
+
+else
+ call Print_msg( NVERB_ERROR, 'IO', 'Les_diachro_4D', &
+ 'ndimlist configuration not yet implemented for ' // Trim( tzfield%cmnhname ) )
+end if
+
+call Les_diachro_common( tpdiafile, tzfield, hgroup, hgroupcomment, pfield, odoavg, odonorm, &
+ hfieldnames = hfieldnames, hfieldcomments = hfieldcomments, hmasks = hmasks )
+
+end subroutine Les_diachro_4D
+
+!###################################################################################################
+subroutine Les_diachro_common( tpdiafile, tpfield, hgroup, hgroupcomment, pfield, odoavg, odonorm, &
+ hfieldnames, hfieldcomments, hmasks )
+!###################################################################################################
+
+use modd_field, only: tfield_metadata_base
+use modd_io, only: tfiledata
+use modd_les, only: nles_current_iinf, nles_current_isup, nles_current_jinf, nles_current_jsup, &
+ nles_levels, xles_current_z
+use modd_parameters, only: XUNDEF
+use modd_type_date, only: date_time
+
+implicit none
+
+type(tfiledata), intent(in) :: tpdiafile ! File to write
+type(tfield_metadata_base), intent(in) :: tpfield
+character(len=*), intent(in) :: hgroup ! Group of the field
+character(len=*), intent(in) :: hgroupcomment
+real, dimension(:,:,:,:), intent(in) :: pfield ! Data array
+logical, intent(in) :: odoavg ! Compute and store time average
+logical, intent(in) :: odonorm ! Compute and store normalized field
+character(len=*), dimension(:), optional, intent(in) :: hfieldnames
+character(len=*), dimension(:), optional, intent(in) :: hfieldcomments
+character(len=*), dimension(:), optional, intent(in) :: hmasks
+
+character(len=100), dimension(:), allocatable :: ycomment ! Comment string
+character(len=100), dimension(:), allocatable :: ytitle ! Title
+integer :: iles_k ! Number of vertical levels
+integer :: iil, iih, ijl, ijh, ikl, ikh ! Cartesian area relatively to the
+ ! entire domain
+integer :: jp ! Process loop counter
+real, dimension(:,:,:), allocatable :: ztrajz ! x and y are not used for LES
+type(tfield_metadata_base), dimension(:), allocatable :: tzfields
+!------------------------------------------------------------------------------
+
+iles_k = Size( pfield, 1 )
+
+! Initialization of diachro variables for les (z,t) profiles
+Allocate( ztrajz(iles_k, 1, Size( pfield, 4 )) )
+Allocate( ycomment(Size( pfield, 3 )) )
+Allocate( ytitle (Size( pfield, 3 )) )
+Allocate( tzfields(Size( pfield, 3 )) )
+
+iil = nles_current_iinf
+iih = nles_current_isup
+ijl = nles_current_jinf
+ijh = nles_current_jsup
+ikl = nles_levels(1)
+ikh = nles_levels(iles_k)
+
+if ( Present( hfieldcomments ) ) then
+ if ( Present( hmasks ) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_common', 'hfieldcomments and hmasks optional arguments may not be present ' // &
+ 'at the same time (' // Trim( tpfield%cmnhname ) // ')' )
+ if ( Size( hfieldcomments ) /= Size( pfield, 3) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Les_diachro_common', 'wrong size for hfieldcomments (' // Trim( tpfield%cmnhname ) // ')' )
+ ycomment(:) = Trim( tpfield%ccomment(:) ) // ': ' // hfieldcomments(:)
+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
+ call Les_diachro_common_intern( .false., .false. )
+if ( odoavg ) call Les_diachro_common_intern( .true., .false. )
+if ( odonorm ) call Les_diachro_common_intern( .false., .true. )
+if ( odoavg .and. odonorm ) call Les_diachro_common_intern( .true., .true. )
+
+
+contains
+
+!##################################################
+subroutine Les_diachro_common_intern( oavg, onorm )
+!##################################################
+
+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
+
+logical, intent(in) :: oavg
+logical, intent(in) :: onorm
+
+integer :: iresp ! Return code
+integer :: ji
+integer :: jk ! Vertical loop counter
+integer :: jp ! Process loop counter
+integer :: jsv ! Scalar loop counter
+logical :: gsv
+real, dimension(:,:,:,:), allocatable :: zfield ! Normalized field
+real, dimension(:,:,:,:,:,:), allocatable :: zwork6 ! Contains physical field
+type(tbudiachrometadata) :: tzbudiachro
+type(date_time), dimension(:), allocatable :: tzdates
+type(tfiledata) :: tzfile
+
+!Reallocate each time necessary because can be reallocated to an other size in Les_time_avg
+Allocate( zfield(Size( pfield, 1 ), Size( pfield, 2 ), Size( pfield, 3 ), Size( pfield, 4 )) )
+Allocate( tzdates( nles_current_times ) )
+
+tzdates(:) = tles_dates(:)
+
+do jk = 1, iles_k
+ ztrajz(jk, :, :) = xles_current_z(jk)
+end do
+
+!Copy all fields from tpfield
+tzfields(:) = tpfield
+
+if ( onorm ) then
+ gsv = tzfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_SV
+ call Les_norm_4d( tzfields(1)%cunits, pfield, zfield, gsv )
+
+ ! Normalization of vertical dimension
+ tzfields(:)%cunits = '1'
+ call Les_z_norm( oavg, ztrajz, zfield(:,:,:,:) )
+else
+ zfield(:, :, :, :) = pfield(:, :, :, :)
+end if
+
+! Time average (physical units remain unchanged)
+iresp = 0
+if ( oavg ) call Les_time_avg_4d( zfield, tzdates, iresp )
+
+if ( Present( hfieldnames ) ) then
+ !ytitle(:) = Trim( tpfield%cmnhname ) // '_' // hfieldnames(:)
+ ytitle(:) = hfieldnames(:)
+else
+ ytitle(:) = tpfield%cmnhname
+endif
+
+! Write the profile
+if ( iresp == 0 .and. any( zfield /= XUNDEF ) ) then
+ allocate(zwork6(1,1,size(zfield,1),size(zfield,2),size(zfield,4),size(zfield,3)))
+ do jsv = 1, size( zfield, 4 )
+ do jp = 1, size( zfield, 3 )
+ zwork6(1, 1, :, :, jsv, jp) = zfield (:, :, jp, jsv)
+ end do
+ end do
+
+ tzfields(:)%ndimlist(6) = tpfield%ndimlist(3)
+ tzfields(:)%ndimlist(5) = tpfield%ndimlist(4)
+ tzfields(:)%ndimlist(4) = tpfield%ndimlist(2)
+ tzfields(:)%ndimlist(3) = tpfield%ndimlist(1)
+ tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+ tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+
+ if ( oavg ) then
+ do ji = 1, 6
+ if ( tzfields(1)%ndimlist(ji) == NMNHDIM_BUDGET_LES_TIME ) tzfields(:)%ndimlist(ji) = NMNHDIM_BUDGET_LES_AVG_TIME
+ end do
+ end if
+
+ tzfields(:)%cmnhname = ytitle(:)
+ tzfields(:)%clongname = ytitle(:)
+ tzfields(:)%ccomment = ycomment(:)
+
+ 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) = .true.
+ tzbudiachro%clevels (NLVL_GROUP) = Trim( hgroup )
+ tzbudiachro%ccomments(NLVL_GROUP) = Trim( hgroupcomment )
+
+ 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 = .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
+
+ if ( tzfields(1)%ndimlist(6) == NMNHDIM_BUDGET_LES_MASK ) then
+ tzfile = tpdiafile
+
+ if ( Trim( tpdiafile%cformat ) == 'LFI' .or. Trim( tpdiafile%cformat ) == 'LFICDF4' ) then
+ !For LFI files, it is necessary to write all the 'processes' (source terms) of the different masks in one pass
+ !to ensure that they are grouped together and not overwritten
+ tzfile%cformat = 'LFI'
+
+ do jp = 1, Size( hmasks )
+ tzfields(jp)%cmnhname = Trim( ytitle(jp) ) // ' (' // Trim( hmasks(jp) ) // ')'
+ tzfields(jp)%clongname = Trim( ytitle(jp) ) // ' (' // Trim( hmasks(jp) ) // ')'
+ end do
+
+ call Write_diachro( tzfile, tzbudiachro, tzfields, tzdates, zwork6 )
+ end if
+
+ if ( Trim( tpdiafile%cformat ) /= 'LFI' ) then
+ tzfile%cformat = 'NETCDF4'
+
+ 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 )
+ !Keep the following line (about cmnhname, necessary especially if LFI files before (cmnhname was modified previously)
+ tzfields(jp)%cmnhname = Trim( ytitle(jp) )
+ tzfields(jp)%clongname = Trim( ytitle(jp) ) // ' (' // Trim( hmasks(jp) ) // ')'
+ tzfields(jp)%ndims = tzfields(jp)%ndims - 1
+
+ tzbudiachro%clevels(NLVL_MASK) = hmasks(jp)
+!PW:TODO? necessite le transfert d'info depuis les routines appelantes ou via des structures dans les modd
+ tzbudiachro%ccomments(NLVL_MASK) = ''
+
+ call Write_diachro( tzfile, tzbudiachro, [ tzfields(jp) ], tzdates, zwork6(:,:,:,:,:,jp:jp) )
+ end do
+ end if
+ 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
+
!-------------------------------------------------------------------------------
-END SUBROUTINE LES_DIACHRO_SV_MASKS
+end subroutine Les_diachro_common_intern
!-------------------------------------------------------------------------------
-!#############################################################
-SUBROUTINE LES_DIACHRO_SURF(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PFIELD,HAVG)
-!#############################################################
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_GRID
-USE MODI_WRITE_DIACHRO
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP ! group title
-CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT ! comment string
-CHARACTER(LEN=*), INTENT(IN) :: HUNIT ! physical unit
-REAL, DIMENSION(:), INTENT(IN) :: PFIELD
-CHARACTER(LEN=1), INTENT(IN) :: HAVG ! flag to compute avg.
-!
-!
-!* 0.2 declaration of local variables for diachro
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJX ! localization of the temporal
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJY ! series in x,y and z. remark:
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJZ ! x and y are not used for LES
-REAL, DIMENSION(:,:), POINTER :: ZTRAJT ! time
-REAL, DIMENSION(:,:), POINTER :: ZDATIME ! DATE
-!
-INTEGER, DIMENSION(1) :: IGRID ! grid indicator
-CHARACTER(LEN= 10) :: YGROUP ! group title
-CHARACTER(LEN=100), DIMENSION(1) :: YCOMMENT ! comment string
-CHARACTER(LEN=100), DIMENSION(1) :: YTITLE ! title
-CHARACTER(LEN=100), DIMENSION(1) :: YUNIT ! physical unit
-INTEGER :: IRESP ! return code
-!
-REAL, DIMENSION(:,:,:,:,:,:), POINTER :: ZWORK6 ! contains physical field
-!
-INTEGER :: IIL, IIH, IJL, IJH, IKL, IKH ! cartesian area relatively to the
-! ! entire domain
-!
-LOGICAL :: GAVG ! flag to compute time averagings
-LOGICAL :: GNORM ! flag to compute normalizations
!-------------------------------------------------------------------------------
-!
-GAVG =(HAVG=='A' .OR. HAVG=='H')
-GNORM=(HAVG=='E' .OR. HAVG=='H')
-!
+end subroutine Les_diachro_common
+!------------------------------------------------------------------------------
-IF (GAVG .AND. (XLES_TEMP_MEAN_START==XUNDEF .OR. XLES_TEMP_MEAN_END==XUNDEF)) RETURN
-!
-IF (GNORM) RETURN
-!
-!* 1.0 Initialization of diachro variables for LES (z,t) profiles
-! ----------------------------------------------------------
-!
-ALLOCATE (ZTRAJX(1,1,1))
-ALLOCATE (ZTRAJY(1,1,1))
-ALLOCATE (ZTRAJZ(1,1,1))
-ALLOCATE(ZWORK6(1,1,1,NLES_CURRENT_TIMES,1,1))
-ALLOCATE(ZTRAJT(NLES_CURRENT_TIMES,1))
-ALLOCATE(ZDATIME(16,NLES_CURRENT_TIMES))
-!
-IIL = NLES_CURRENT_IINF
-IIH = NLES_CURRENT_ISUP
-IJL = NLES_CURRENT_JINF
-IJH = NLES_CURRENT_JSUP
-ZTRAJX(:,:,:) = (IIL+IIH)/2
-ZTRAJY(:,:,:) = (IJL+IJH)/2
-IKL=NLES_LEVELS(1)
-IKH=NLES_LEVELS(1)
-ZTRAJZ(1,1,1) = XLES_CURRENT_Z(1)
-IGRID(1)=1
-YCOMMENT(1) = HCOMMENT
-!
-YUNIT (1) = HUNIT
-YGROUP = HGROUP
-!
-ZWORK6(1,1,1,:,1,1) = PFIELD (:)
-ZTRAJT(:,:) = XLES_CURRENT_TRAJT(:,:)
-ZDATIME(:,:)=XLES_CURRENT_DATIME(:,:)
-!
-!* time average
-!
-IRESP = 0
-IF (GAVG) CALL LES_TIME_AVG(ZTRAJT,ZWORK6,IRESP,ZDATIME)
-!
-IF (HAVG/=' ') YGROUP=HAVG//'_'//YGROUP
-YTITLE(1) = HGROUP
-!
-!* 2.0 Writing of the profile
-! ----------------------
-!
-IF (IRESP==0) &
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SSOL",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH, &
- PTRAJX=ZTRAJX,PTRAJY=ZTRAJY,PTRAJZ=ZTRAJZ )
-!
+!############################################################################
+subroutine Les_diachro_2pt( tpdiafile, tpfieldx, tpfieldy, pfieldx, pfieldy )
+!############################################################################
!
-!* 3.0 Deallocations
-! -------------
-!
-DEALLOCATE (ZTRAJX)
-DEALLOCATE (ZTRAJY)
-DEALLOCATE (ZTRAJZ)
-DEALLOCATE (ZTRAJT)
-DEALLOCATE(ZWORK6)
-DEALLOCATE(ZDATIME)
+!* Modification 01/04/03 (V. Masson) safer use of ZWORK6 with loops
!
-!-------------------------------------------------------------------------------
-END SUBROUTINE LES_DIACHRO_SURF
-!-------------------------------------------------------------------------------
-!################################################################
-SUBROUTINE LES_DIACHRO_SURF_SV(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PFIELD,HAVG)
-!################################################################
!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_GRID
-USE MODI_WRITE_DIACHRO
+use modd_conf, only: l2d
+use modd_field, only: tfield_metadata_base
+use modd_io, only: tfiledata
+use modd_les, only: xles_temp_mean_start, xles_temp_mean_end
+use modd_parameters, only: XUNDEF
!
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP ! group title
-CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT ! comment string
-CHARACTER(LEN=*), INTENT(IN) :: HUNIT ! physical unit
-REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD
-CHARACTER(LEN=1), INTENT(IN) :: HAVG ! flag to compute avg.
-!
-!* 0.2 declaration of local variables for diachro
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJX ! localization of the temporal
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJY ! series in x,y and z. remark:
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJZ ! x and y are not used for LES
-REAL, DIMENSION(:,:), POINTER :: ZTRAJT ! time
-REAL, DIMENSION(:,:), POINTER :: ZDATIME ! date
-INTEGER, DIMENSION(1) :: IGRID ! grid indicator
-CHARACTER(LEN= 10) :: YGROUP ! group title
-CHARACTER(LEN=100), DIMENSION(1) :: YCOMMENT ! comment string
-CHARACTER(LEN=100), DIMENSION(1) :: YTITLE ! title
-CHARACTER(LEN=100), DIMENSION(1) :: YUNIT ! physical unit
-INTEGER :: IRESP ! return code
-!
-REAL, DIMENSION(:,:,:,:,:,:), POINTER :: ZWORK6 ! contains physical field
-!
-INTEGER :: IIL, IIH, IJL, IJH, IKL, IKH ! cartesian area relatively to the
-! ! entire domain
-!
-LOGICAL :: GAVG ! flag to compute time averagings
-LOGICAL :: GNORM ! flag to compute normalizations
+type(tfiledata), intent(in) :: tpdiafile! file to write
+type(tfield_metadata_base), intent(in) :: tpfieldx ! Metadata of field pfieldx
+type(tfield_metadata_base), intent(in) :: tpfieldy ! Metadata of field pfieldy
+real, dimension(:,:,:), intent(in) :: pfieldx
+real, dimension(:,:,:), intent(in) :: pfieldy
!-------------------------------------------------------------------------------
-!
-GAVG =(HAVG=='A' .OR. HAVG=='H')
-GNORM=(HAVG=='E' .OR. HAVG=='H')
-!
-IF (GAVG .AND. (XLES_TEMP_MEAN_START==XUNDEF .OR. XLES_TEMP_MEAN_END==XUNDEF)) RETURN
-!
-IF (GNORM) RETURN
-!
-!* 1.0 Initialization of diachro variables for LES (z,t) profiles
-! ----------------------------------------------------------
-!
-ALLOCATE (ZTRAJX(1,1,SIZE(PFIELD,2)))
-ALLOCATE (ZTRAJY(1,1,SIZE(PFIELD,2)))
-ALLOCATE (ZTRAJZ(1,1,SIZE(PFIELD,2)))
-ALLOCATE(ZWORK6(1,1,1,NLES_CURRENT_TIMES,SIZE(PFIELD,2),1))
-ALLOCATE(ZTRAJT(NLES_CURRENT_TIMES,1))
-ALLOCATE(ZDATIME(16,NLES_CURRENT_TIMES))
-!
-IIL = NLES_CURRENT_IINF
-IIH = NLES_CURRENT_ISUP
-IJL = NLES_CURRENT_JINF
-IJH = NLES_CURRENT_JSUP
-ZTRAJX(:,:,:) = (IIL+IIH)/2
-ZTRAJY(:,:,:) = (IJL+IJH)/2
-IKL=NLES_LEVELS(1)
-IKH=NLES_LEVELS(1)
-ZTRAJZ(1,1,:) = XLES_CURRENT_Z(1)
-IGRID(1)=1
-YCOMMENT(1) = HCOMMENT
-!
-YUNIT (1) = HUNIT
-YGROUP = HGROUP
-!
-IRESP = 0
-ZWORK6(1,1,1,:,:,1) = PFIELD (:,:)
-ZTRAJT(:,:) = XLES_CURRENT_TRAJT(:,:)
-ZDATIME(:,:)=XLES_CURRENT_DATIME(:,:)
-!
+ call Les_diachro_2pt_1d_intern( tpdiafile, tpfieldx, .false., pfieldx )
+if ( .not.l2d ) call Les_diachro_2pt_1d_intern( tpdiafile, tpfieldy, .false., pfieldy )
-!
-!* time average
-!
-IF (GAVG) CALL LES_TIME_AVG(ZTRAJT,ZWORK6,IRESP,ZDATIME)
-!
-!
-IF (HAVG/=' ') YGROUP=HAVG//'_'//YGROUP
-YTITLE(1) = HGROUP
-!
-!* 2.0 Writing of the profile
-! ----------------------
-!
-IF (IRESP==0) &
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SSOL",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH, &
- PTRAJX=ZTRAJX,PTRAJY=ZTRAJY,PTRAJZ=ZTRAJZ )
-!
-!
-!* 3.0 Deallocations
-! -------------
-!
-DEALLOCATE (ZTRAJX)
-DEALLOCATE (ZTRAJY)
-DEALLOCATE (ZTRAJZ)
-DEALLOCATE (ZTRAJT)
-DEALLOCATE(ZWORK6)
-DEALLOCATE(ZDATIME)
-!
-!-------------------------------------------------------------------------------
-END SUBROUTINE LES_DIACHRO_SURF_SV
-!-------------------------------------------------------------------------------
-!#####################################################################
-SUBROUTINE LES_DIACHRO_2PT(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PFIELDX,PFIELDY,HAVG)
-!#####################################################################
-!
-!* Modification 01/04/03 (V. Masson) safer use of ZWORK6 with loops
-!
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_GRID
-USE MODD_CONF
-USE MODI_WRITE_DIACHRO
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP ! group title
-CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT ! comment string
-CHARACTER(LEN=*), INTENT(IN) :: HUNIT ! physical unit
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDX
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELDY
-CHARACTER(LEN=1), INTENT(IN) :: HAVG ! flag to compute avg.
-!
-!* 0.2 declaration of local variables for diachro
-!
-!
-INTEGER, DIMENSION(1) :: IGRID ! grid indicator
-CHARACTER(LEN= 10) :: YGROUP ! group title
-CHARACTER(LEN=100), DIMENSION(1) :: YCOMMENT ! comment string
-CHARACTER(LEN=100), DIMENSION(1) :: YTITLE ! title
-CHARACTER(LEN=100), DIMENSION(1) :: YUNIT ! physical unit
-REAL, DIMENSION(SIZE(PFIELDX,1),SIZE(PFIELDX,2)) :: ZAVG_FIELDX
-REAL, DIMENSION(SIZE(PFIELDY,1),SIZE(PFIELDY,2)) :: ZAVG_FIELDY
-INTEGER :: JT ! time counter
-INTEGER :: JK ! level counter
-INTEGER :: IRESP ! return code
-REAL, DIMENSION(:,:),POINTER :: ZTRAJT ! time
-REAL, DIMENSION(:,:),POINTER :: ZDATIME ! date
+! With time average
+if ( xles_temp_mean_start /= xundef .and. xles_temp_mean_end /= XUNDEF ) then
+ call Les_diachro_2pt_1d_intern( tpdiafile, tpfieldx, .true., pfieldx )
+ if ( .not.l2d ) call Les_diachro_2pt_1d_intern( tpdiafile, tpfieldy, .true., pfieldy )
+end if
-!
-REAL, DIMENSION(:,:,:,:,:,:), POINTER :: ZWORK6 ! contains physical field
-!
-INTEGER :: IIL, IIH, IJL, IJH, IKL, IKH ! cartesian area relatively to the
-! ! entire domain
-!
-CHARACTER(len=6) :: YSTRING
-!
-LOGICAL :: GAVG ! flag to compute time averagings
+end subroutine Les_diachro_2pt
!-------------------------------------------------------------------------------
-!
-IF (HAVG/=' '.AND. HAVG/='A') RETURN
-!
-GAVG=(HAVG=='A')
-!
-IF (GAVG .AND. (XLES_TEMP_MEAN_START==XUNDEF .OR. XLES_TEMP_MEAN_END==XUNDEF)) RETURN
-!
+
+!#######################################################################
+subroutine Les_diachro_2pt_1d_intern( tpdiafile, tpfield, gavg, pfield )
+!#######################################################################
+
+use modd_field, only: NMNHDIM_BUDGET_LES_AVG_TIME, NMNHDIM_BUDGET_LES_TIME, NMNHDIM_UNUSED, &
+ NMNHDIM_SPECTRA_2PTS_NI, NMNHDIM_SPECTRA_2PTS_NJ, &
+ NMNHMAXDIMS, tfield_metadata_base
+use modd_io, only: tfiledata
+use modd_les, only: nles_current_iinf, nles_current_isup, nles_current_jinf, nles_current_jsup, &
+ nles_current_times, nspectra_k, xles_current_domegax, xles_current_domegay
+use modd_type_date, only: date_time
+
+use mode_write_diachro, only: Write_diachro
+
+type(tfiledata), intent(in) :: tpdiafile! file to write
+type(tfield_metadata_base), intent(in) :: tpfield ! Metadata of field pfield
+logical, intent(in) :: gavg
+real, dimension(:,:,:), intent(in) :: pfield
+
+character(len=6) :: ystring
+character(len= 10) :: ygroup ! group title
+character(len=100) :: ycomment ! comment string
+integer :: iil, iih, ijl, ijh, ikl, ikh ! cartesian area relatively to the
+integer :: iresp ! return code
+integer :: ji
+integer :: jt ! time counter
+integer :: jk ! level counter
+real, dimension(:,:,:,:,:,:), allocatable :: zwork6 ! contains physical field
+type(date_time), dimension(:), allocatable :: tzdates
+type(tbudiachrometadata) :: tzbudiachro
+type(tfield_metadata_base) :: tzfield
+
!* 1.0 Initialization of diachro variables for LES (z,t) profiles
! ----------------------------------------------------------
-!
-ALLOCATE(ZWORK6(SIZE(PFIELDX,1),1,NSPECTRA_K,NLES_CURRENT_TIMES,2,1))
-ALLOCATE(ZTRAJT(NLES_CURRENT_TIMES,1))
-ALLOCATE(ZDATIME(16,NLES_CURRENT_TIMES))
-!
-IGRID(:)=1
-!
-YUNIT (:) = HUNIT
-!
-IKL=1
-IKH=NSPECTRA_K
-!
-IIL = NLES_CURRENT_IINF
-IIH = NLES_CURRENT_ISUP
-IJL = 1
-IJH = 1
-!
-YGROUP = 'CI_'//HGROUP
-YTITLE(:) = YGROUP
-WRITE(YSTRING,FMT="(I6.6)") NINT( XLES_CURRENT_DOMEGAX )
-YCOMMENT(:) = " DOMEGAX="//YSTRING//' '//HCOMMENT
-!
-IRESP = 0
-DO JT=1,SIZE(PFIELDX,3)
- DO JK=1,SIZE(PFIELDX,2)
- ZWORK6(:,1,JK,JT,1,1) = PFIELDX (:,JK,JT)
- ZWORK6(:,1,JK,JT,2,1) = 0.
- END DO
-END DO
-ZTRAJT(:,:) = XLES_CURRENT_TRAJT(:,:)
-ZDATIME(:,:)= XLES_CURRENT_DATIME(:,:)
-!* time average
-!
-IF (GAVG) THEN
- CALL LES_TIME_AVG(ZTRAJT,ZWORK6,IRESP,ZDATIME)
- YGROUP = 'T_'//YGROUP
-END IF
-!
-!
+
+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
+
+!Copy all fields from tpfield
+tzfield = tpfield
+
+if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_2PTS_NI ) then
+ Allocate( zwork6(Size( pfield, 1 ), 1, nspectra_k, nles_current_times, 1, 1) )
+
+ do jt = 1, Size( pfield, 3 )
+ do jk = 1, Size( pfield, 2 )
+ zwork6(:, 1, jk, jt, 1, 1) = pfield (:, jk, jt)
+ end do
+ end do
+
+ tzfield%ndimlist(6) = NMNHDIM_UNUSED
+ tzfield%ndimlist(5) = NMNHDIM_UNUSED
+ tzfield%ndimlist(4) = tpfield%ndimlist(3)
+ tzfield%ndimlist(3) = tpfield%ndimlist(2)
+ tzfield%ndimlist(2) = NMNHDIM_UNUSED
+ tzfield%ndimlist(1) = tpfield%ndimlist(1)
+
+ ygroup = 'CI_' // tpfield%cmnhname
+ Write( ystring, fmt = "( i6.6 )" ) Nint( xles_current_domegax )
+ ycomment(:) = " DOMEGAX=" // ystring // ' ' // tpfield%ccomment
+else if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_2PTS_NJ ) then
+ Allocate( zwork6(1, Size( pfield, 1 ), nspectra_k, nles_current_times, 1, 1) )
+
+ do jt = 1, Size( pfield, 3 )
+ do jk = 1, Size( pfield, 2 )
+ zwork6(1, :, jk, jt, 1, 1) = pfield (:, jk, jt)
+ end do
+ end do
+
+ tzfield%ndimlist(6) = NMNHDIM_UNUSED
+ tzfield%ndimlist(5) = NMNHDIM_UNUSED
+ tzfield%ndimlist(4) = tpfield%ndimlist(3)
+ tzfield%ndimlist(3) = tpfield%ndimlist(2)
+ tzfield%ndimlist(2) = tpfield%ndimlist(1)
+ tzfield%ndimlist(1) = NMNHDIM_UNUSED
+
+ ygroup = 'CJ_' // tpfield%cmnhname
+ Write( ystring, fmt ="( i6.6 )" ) Nint( xles_current_domegay )
+ ycomment(:) = " DOMEGAY=" // ystring // ' ' // tpfield%ccomment
+else
+ call Print_msg( NVERB_FATAL, 'BUD', 'Les_diachro_2pt_1d_intern', 'invalid dimensions for' // Trim( tpfield%cmnhname ) )
+end if
+
+!Done here because ygroup is modified later
+tzfield%cmnhname = ygroup
+tzfield%clongname = ygroup
+tzfield%ccomment = ycomment(:)
+
+!* time average (physical units remain unchanged)
+iresp = 0
+if ( gavg ) then
+ 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
+end if
+
+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) = .true.
+tzbudiachro%clevels (NLVL_GROUP) = 'Two_point_correlation'
+tzbudiachro%ccomments(NLVL_GROUP) = ''
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .false.
+tzbudiachro%clevels (NLVL_SHAPE) = ''
+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%cdirection = 'J'
+end if
+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
+
!* 2.0 Writing of the profile
! ----------------------
-!
-IF (IRESP==0) &
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SPXY",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH )
-!
-!
-DEALLOCATE (ZTRAJT)
-DEALLOCATE(ZDATIME)
-DEALLOCATE(ZWORK6)
-!
-IF (L2D) RETURN
-!
-ALLOCATE(ZWORK6(1,SIZE(PFIELDY,1),NSPECTRA_K,NLES_CURRENT_TIMES,2,1))
-ALLOCATE(ZTRAJT(NLES_CURRENT_TIMES,1))
-ALLOCATE(ZDATIME(16,NLES_CURRENT_TIMES))
-!
-IIL = 1
-IIH = 1
-IJL = NLES_CURRENT_JINF
-IJH = NLES_CURRENT_JSUP
-!
-DO JT=1,SIZE(PFIELDY,3)
- DO JK=1,SIZE(PFIELDY,2)
- ZWORK6(1,:,JK,JT,1,1) = PFIELDY (:,JK,JT)
- ZWORK6(1,:,JK,JT,2,1) = 0.
- END DO
-END DO
-ZTRAJT(:,:) = XLES_CURRENT_TRAJT(:,:)
-ZDATIME(:,:)= XLES_CURRENT_DATIME(:,:)
-!
-YGROUP = 'CJ_'//HGROUP
-YTITLE(:) = YGROUP
-WRITE(YSTRING,FMT="(I6.6)") NINT( XLES_CURRENT_DOMEGAY )
-YCOMMENT(:) = " DOMEGAY="//YSTRING//' '//HCOMMENT
-!
-!
-!* time average
-!
-IF (GAVG) THEN
- CALL LES_TIME_AVG(ZTRAJT,ZWORK6,IRESP,ZDATIME)
- YGROUP = 'T_'//YGROUP
-END IF
-!
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SPXY",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH )
-!
-DEALLOCATE (ZTRAJT)
-DEALLOCATE(ZWORK6)
-DEALLOCATE(ZDATIME)
+if ( iresp == 0 ) call Write_diachro( tpdiafile, tzbudiachro, [ tzfield ], tzdates, zwork6 )
-!
-!-------------------------------------------------------------------------------
-END SUBROUTINE LES_DIACHRO_2PT
+end subroutine Les_diachro_2pt_1d_intern
!------------------------------------------------------------------------------
-!
-!#####################################################################
-SUBROUTINE LES_DIACHRO_SPEC(TPDIAFILE,HGROUP,HCOMMENT,HUNIT,PSPECTRAX,PSPECTRAY)
-!#####################################################################
+
+!#################################################################################
+subroutine Les_diachro_spec( tpdiafile, tpfieldx, tpfieldy, pspectrax, pspectray )
+!#################################################################################
!
!* Modification 01/04/03 (V. Masson) safer use of ZWORK6 with loops
!
!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_GRID
-USE MODD_CONF
-USE MODI_WRITE_DIACHRO
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP ! group title
-CHARACTER(LEN=*), INTENT(IN) :: HCOMMENT ! comment string
-CHARACTER(LEN=*), INTENT(IN) :: HUNIT ! physical unit
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSPECTRAX! spectra in x
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSPECTRAY! and y directions
-!
-!* 0.2 declaration of local variables for diachro
-!
-!
-INTEGER, DIMENSION(1) :: IGRID ! grid indicator
-CHARACTER(LEN= 10) :: YGROUP ! group title
-CHARACTER(LEN=100), DIMENSION(1) :: YCOMMENT ! comment string
-CHARACTER(LEN=100), DIMENSION(1) :: YTITLE ! title
-CHARACTER(LEN=100), DIMENSION(1) :: YUNIT ! physical unit
-INTEGER :: IRESP ! return code
-!
-REAL, DIMENSION(:,:,:,:,:,:), POINTER :: ZWORK6 ! contains physical field
-REAL, DIMENSION(:,:), POINTER :: ZTRAJT ! time
-REAL, DIMENSION(:,:), POINTER :: ZDATIME ! date
+use modd_conf, only: l2d
+use modd_field, only: tfield_metadata_base
+use modd_io, only: tfiledata
-!
-INTEGER :: IIL, IIH, IJL, IJH, IKL, IKH ! cartesian area relatively to the
-! ! entire domain
-!
-CHARACTER(len=6) :: YSTRING
-INTEGER :: JT ! time counter
-INTEGER :: JK ! level counter
-!
-!-------------------------------------------------------------------------------
+implicit none
+
+type(tfiledata), intent(in) :: tpdiafile! file to write
+type(tfield_metadata_base), intent(in) :: tpfieldx ! metadata of field pfieldx
+type(tfield_metadata_base), intent(in) :: tpfieldy ! metadata of field pfieldy
+real, dimension(:,:,:,:), intent(in) :: pspectrax! spectra in x
+real, dimension(:,:,:,:), intent(in) :: pspectray! and y directions
+
+ call Les_diachro_spec_1D_intern( tpdiafile, tpfieldx, pspectrax )
+if ( .not. l2d ) call Les_diachro_spec_1D_intern( tpdiafile, tpfieldy, pspectray )
+
+end subroutine Les_diachro_spec
+
+
+!####################################################################
+subroutine Les_diachro_spec_1D_intern( tpdiafile, tpfield, pspectra )
+!####################################################################
+
+use modd_field, only: NMNHDIM_BUDGET_LES_AVG_TIME, NMNHDIM_BUDGET_LES_TIME, NMNHDIM_UNUSED, &
+ NMNHDIM_SPECTRA_SPEC_NI, NMNHDIM_SPECTRA_SPEC_NJ, &
+ NMNHMAXDIMS, tfield_metadata_base
+use modd_io, only: tfiledata
+use modd_les, only: nles_current_iinf, nles_current_isup, nles_current_jinf, nles_current_jsup, &
+ nles_current_times, nspectra_k, &
+ xles_current_domegax, xles_current_domegay
+use modd_les_n, only: tles_dates
+use modd_type_date, only: date_time
+
+use mode_write_diachro, only: Write_diachro
+
+implicit none
+
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+type(tfield_metadata_base), intent(in) :: tpfield ! metadata of field pfield
+real, dimension(:,:,:,:), intent(in) :: pspectra
+
+character(len=10) :: ygroup ! group title
+character(len=100) :: ycomment ! comment string
+character(len=6) :: ystring
+integer :: iresp ! return code
+integer :: iil, iih, ijl, ijh, ikl, ikh !cartesian area relative to the entire domain
+integer :: ji
+integer :: jt ! time counter
+integer :: jk ! level counter
+real, dimension(:,:,:,:,:,:), allocatable :: zwork6 ! physical field
+type(date_time), dimension(:), allocatable :: tzdates
+type(tbudiachrometadata) :: tzbudiachro
+type(tfield_metadata_base) :: tzfield
!
!* 1.0 Initialization of diachro variables for LES (z,t) profiles
! ----------------------------------------------------------
-!
-IGRID(:)=1
-!
-YUNIT (:) = HUNIT
-!
-IKL=1
-IKH=NSPECTRA_K
+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
+
+!Copy all fields from tpfield
+tzfield = tpfield
!
!* 2.0 Writing of the profile
! ----------------------
-!* spectra in X direction
-!
-ALLOCATE(ZWORK6(SIZE(PSPECTRAX,1),1,NSPECTRA_K,NLES_CURRENT_TIMES,2,1))
-ALLOCATE(ZTRAJT(NLES_CURRENT_TIMES,1))
-ALLOCATE(ZDATIME(16,NLES_CURRENT_TIMES))
-!
-ZTRAJT(:,:) = XLES_CURRENT_TRAJT(:,:)
-ZDATIME(:,:)= XLES_CURRENT_DATIME(:,:)
-!
-IIL = NLES_CURRENT_IINF
-IIH = NLES_CURRENT_ISUP
-IJL = 1
-IJH = 1
-!
-DO JT=1,SIZE(PSPECTRAX,4)
- DO JK=1,SIZE(PSPECTRAX,3)
- ZWORK6(:,1,JK,JT,1,1) = PSPECTRAX (:,1,JK,JT)
- ZWORK6(:,1,JK,JT,2,1) = PSPECTRAX (:,2,JK,JT)
- END DO
-END DO
-!
-YGROUP = 'SI_'//HGROUP
-YTITLE(:) = YGROUP
-WRITE(YSTRING,FMT="(I6.6)") NINT( XLES_CURRENT_DOMEGAX )
-YCOMMENT(:) = " DOMEGAX="//YSTRING//' '//HCOMMENT
-!
-!
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SPXY",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH )
-!
-!
-!* time average
-!
-IRESP=0
-CALL LES_TIME_AVG(ZTRAJT,ZWORK6,IRESP,ZDATIME)
-YGROUP = 'T_'//YGROUP
-!
-IF (IRESP==0) &
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SPXY",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH )
-DEALLOCATE(ZWORK6)
-DEALLOCATE(ZTRAJT)
-DEALLOCATE(ZDATIME)
-!
-!* spectra in Y direction
-!
+if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_SPEC_NI ) then
+ Allocate( zwork6(Size( pspectra, 1 ), 1, nspectra_k, nles_current_times, 2, 1) )
-IF (L2D) RETURN
-!
-ALLOCATE(ZWORK6(1,SIZE(PSPECTRAY,1),NSPECTRA_K,NLES_CURRENT_TIMES,2,1))
-ALLOCATE(ZTRAJT(NLES_CURRENT_TIMES,1))
-ALLOCATE(ZDATIME(16,NLES_CURRENT_TIMES))
-!
-ZTRAJT(:,:) = XLES_CURRENT_TRAJT(:,:)
-ZDATIME(:,:)= XLES_CURRENT_DATIME(:,:)
-!
-IIL = 1
-IIH = 1
-IJL = NLES_CURRENT_JINF
-IJH = NLES_CURRENT_JSUP
-!
-DO JT=1,SIZE(PSPECTRAY,4)
- DO JK=1,SIZE(PSPECTRAY,3)
- ZWORK6(1,:,JK,JT,1,1) = PSPECTRAY (:,1,JK,JT)
- ZWORK6(1,:,JK,JT,2,1) = PSPECTRAY (:,2,JK,JT)
- END DO
-END DO
-!
-YGROUP = 'SJ_'//HGROUP
-YTITLE(:) = YGROUP
-WRITE(YSTRING,FMT="(I6.6)") NINT( XLES_CURRENT_DOMEGAY )
-YCOMMENT(:) = " DOMEGAY="//YSTRING//' '//HCOMMENT
-!
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SPXY",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH )
-!
-!
-!* time average
-!
-CALL LES_TIME_AVG(ZTRAJT,ZWORK6,IRESP,ZDATIME)
-YGROUP = 'T_'//YGROUP
+ do jt = 1, Size( pspectra, 4 )
+ do jk = 1, Size( pspectra, 3 )
+ zwork6(:, 1, jk, jt, 1, 1) = pspectra (:, 1, jk, jt)
+ zwork6(:, 1, jk, jt, 2, 1) = pspectra (:, 2, jk, jt)
+ end do
+ end do
+
+ tzfield%ndimlist(6:) = NMNHDIM_UNUSED
+ tzfield%ndimlist(5) = tpfield%ndimlist(2)
+ tzfield%ndimlist(4) = tpfield%ndimlist(4)
+ tzfield%ndimlist(3) = tpfield%ndimlist(3)
+ tzfield%ndimlist(2) = NMNHDIM_UNUSED
+ tzfield%ndimlist(1) = tpfield%ndimlist(1)
+
+ ygroup = 'SI_' // tpfield%cmnhname
+ Write( ystring, fmt = "( i6.6 )" ) Nint( xles_current_domegax )
+ ycomment(:) = " DOMEGAX=" // ystring // ' ' // tpfield%ccomment
+else if ( tzfield%ndimlist(1) == NMNHDIM_SPECTRA_SPEC_NJ ) then
+ Allocate( zwork6( 1, Size( pspectra, 1 ), nspectra_k, nles_current_times, 2, 1 ) )
+
+ do jt = 1, Size( pspectra, 4 )
+ do jk = 1, Size( pspectra, 3 )
+ zwork6(1, :, jk, jt, 1, 1) = pspectra (:, 1, jk, jt)
+ zwork6(1, :, jk, jt, 2, 1) = pspectra (:, 2, jk, jt)
+ end do
+ end do
+
+ tzfield%ndimlist(6:) = NMNHDIM_UNUSED
+ tzfield%ndimlist(5) = tpfield%ndimlist(2)
+ tzfield%ndimlist(4) = tpfield%ndimlist(4)
+ tzfield%ndimlist(3) = tpfield%ndimlist(3)
+ tzfield%ndimlist(2) = tpfield%ndimlist(1)
+ tzfield%ndimlist(1) = NMNHDIM_UNUSED
+
+ ygroup = 'SJ_' // tpfield%cmnhname
+ Write( ystring, fmt = "( i6.6 )" ) Nint( xles_current_domegay )
+ ycomment(:) = " DOMEGAY=" // ystring // ' ' // tpfield%ccomment
+else
+ call Print_msg( NVERB_FATAL, 'BUD', 'Les_diachro_spec_1D_intern', 'invalid dimensions for' // Trim( tpfield%cmnhname ) )
+end if
+
+tzfield%cmnhname = ygroup
+tzfield%clongname = ygroup
+tzfield%ccomment = ycomment(:)
+
+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) = .true.
+tzbudiachro%clevels (NLVL_GROUP) = 'Spectrum'
+tzbudiachro%ccomments(NLVL_GROUP) = ''
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .false.
+tzbudiachro%clevels (NLVL_SHAPE) = ''
+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 )
!
-IF (IRESP==0) &
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"SPXY",IGRID,ZDATIME, ZWORK6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT,.FALSE.,.FALSE.,.FALSE., &
- IIL,IIH,IJL,IJH,IKL,IKH )
+!* time average (physical units remain unchanged)
!
-DEALLOCATE(ZWORK6)
-DEALLOCATE(ZTRAJT)
-DEALLOCATE(ZDATIME)
+iresp = 0
+call Les_time_avg( zwork6, tzdates, iresp )
+do ji = 1, NMNHMAXDIMS
+ if ( tzfield%ndimlist(ji) == NMNHDIM_BUDGET_LES_TIME ) tzfield%ndimlist(ji) = NMNHDIM_BUDGET_LES_AVG_TIME
+end do
-!
-!-------------------------------------------------------------------------------
-END SUBROUTINE LES_DIACHRO_SPEC
+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) = .true.
+tzbudiachro%clevels (NLVL_GROUP) = 'Spectrum'
+tzbudiachro%ccomments(NLVL_GROUP) = ''
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .false.
+tzbudiachro%clevels (NLVL_SHAPE) = ''
+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
+
+if ( iresp == 0 ) call Write_diachro( tpdiafile, tzbudiachro, [ tzfield ], tzdates, zwork6 )
+
+end subroutine Les_diachro_spec_1D_intern
!-------------------------------------------------------------------------------
END MODULE MODE_LES_DIACHRO
diff --git a/src/MNH/mode_prandtl.f90 b/src/MNH/mode_prandtl.f90
index 04f03f419c4fd4531ee8c03d1cda74ae619591bf..941a47cb276c902d08a6dbe4a914b9a366a46556 100644
--- a/src/MNH/mode_prandtl.f90
+++ b/src/MNH/mode_prandtl.f90
@@ -9,6 +9,7 @@
!
!* modification 08/2010 V. Masson smoothing of the discontinuity in functions
! used for implicitation of exchange coefficients
+! 05/2020 V. Masson and C. Lac : bug in D_PHI3DTDZ2_O_DDTDZ
!
USE MODD_CTURB, ONLY : XCTV, XCSHF, XCTD, XPHI_LIM, XCPR3, XCPR4, XCPR5
USE MODD_PARAMETERS, ONLY : JPVEXT_TURB
@@ -416,32 +417,36 @@ IKE = SIZE(PREDTH1,3)-JPVEXT_TURB
!
!$acc kernels
IF (HTURBDIM=='3DIM') THEN
- !* 3DIM case
- IF (OUSERV) THEN
- WHERE (PPHI3(:,:,:)<=XPHI_LIM)
- PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
- * PDTDZ(:,:,:)*(2.-PREDTH1(:,:,:)*(3./2.+PREDTH1+PREDR1) &
- /((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))) &
- + (1.+PREDR1)*(PRED2THR3+PRED2TH3) &
- / (PREDTH1*(1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1))) &
- - (1./2.*PREDTH1+PREDR1 * (1.+PREDTH1+PREDR1)) &
- / ((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))
- ELSEWHERE
- PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
- ENDWHERE
-
-!
- ELSE
- WHERE (PPHI3(:,:,:)<=XPHI_LIM)
- PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
- * PDTDZ(:,:,:)*(2.-PREDTH1(:,:,:)*(3./2.+PREDTH1) &
- /((1.+PREDTH1)*(1.+1./2.*PREDTH1))) &
- + PRED2TH3 / (PREDTH1*(1.+PREDTH1)*(1.+1./2.*PREDTH1)) &
- - 1./2.*PREDTH1 / ((1.+PREDTH1)*(1.+1./2.*PREDTH1))
- ELSEWHERE
- PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
- ENDWHERE
- END IF
+ ! by derivation of (phi3 dtdz) * dtdz according to dtdz we obtain:
+ PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PDTDZ * (PPHI3 + &
+ D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,OUSERV) )
+
+! !* 3DIM case
+! IF (OUSERV) THEN
+! WHERE (PPHI3(:,:,:)<=XPHI_LIM)
+! PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+! * PDTDZ(:,:,:)*(2.-PREDTH1(:,:,:)*(3./2.+PREDTH1+PREDR1) &
+! /((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))) &
+! + (1.+PREDR1)*(PRED2THR3+PRED2TH3) &
+! / (PREDTH1*(1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1))) &
+! - (1./2.*PREDTH1+PREDR1 * (1.+PREDTH1+PREDR1)) &
+! / ((1.+PREDTH1+PREDR1)*(1.+1./2.*(PREDTH1+PREDR1)))
+! ELSEWHERE
+! PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
+! ENDWHERE
+!
+!!
+! ELSE
+! WHERE (PPHI3(:,:,:)<=XPHI_LIM)
+! PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) &
+! * PDTDZ(:,:,:)*(2.-PREDTH1(:,:,:)*(3./2.+PREDTH1) &
+! /((1.+PREDTH1)*(1.+1./2.*PREDTH1))) &
+! + PRED2TH3 / (PREDTH1*(1.+PREDTH1)*(1.+1./2.*PREDTH1)) &
+! - 1./2.*PREDTH1 / ((1.+PREDTH1)*(1.+1./2.*PREDTH1))
+! ELSEWHERE
+! PD_PHI3DTDZ2_O_DDTDZ(:,:,:) = PPHI3(:,:,:) * 2. * PDTDZ(:,:,:)
+! ENDWHERE
+! END IF
ELSE
!* 1DIM case
WHERE (PPHI3(:,:,:)<=XPHI_LIM)
diff --git a/src/MNH/mode_time.f90 b/src/MNH/mode_time.f90
index 0f71113f9732af5805bcaf076a82aab890f3862a..86b9dbadbc4e137a197ac5f20c53de237bd9926a 100644
--- a/src/MNH/mode_time.f90
+++ b/src/MNH/mode_time.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -113,8 +113,8 @@ INTEGER :: ILUOUT
!* 1. CONVERT TIME IN HOURS,MINUTES AND SECONDS :
! ------------------------------------------
!
-IHOUR = INT(TPDATETIME%TIME/3600.)
-ZREMAIN = MOD(TPDATETIME%TIME,3600.)
+IHOUR = INT(TPDATETIME%xtime/3600.)
+ZREMAIN = MOD(TPDATETIME%xtime,3600.)
IMINUTE = INT(ZREMAIN/60.)
ZSECOND = MOD(ZREMAIN,60.)
!
@@ -126,22 +126,22 @@ ZSECOND = MOD(ZREMAIN,60.)
ILUOUT = TPOUTFILE%NLU
!
IF (PRESENT(HTITLE)) THEN
- IF ((TPDATETIME%TDATE%YEAR < 0).OR.(TPDATETIME%TDATE%MONTH < 0).OR. &
- (TPDATETIME%TDATE%DAY < 0) ) THEN
+ IF ((TPDATETIME%nyear < 0).OR.(TPDATETIME%nmonth < 0).OR. &
+ (TPDATETIME%nday < 0) ) THEN
WRITE(UNIT=ILUOUT,FMT='(1X,A," :",2X,I2.2,"H",I2.2,"M", &
& F5.2,"S")') HTITLE, IHOUR,IMINUTE,ZSECOND
ELSE
WRITE(UNIT=ILUOUT,FMT='(1X,A," :",I4.4,I2.2,I2.2,2X,I2.2,"H",I2.2,"M", &
- & F5.2,"S")') HTITLE, TPDATETIME%TDATE, IHOUR,IMINUTE,ZSECOND
+ & F5.2,"S")') HTITLE, TPDATETIME%nyear, TPDATETIME%nmonth, TPDATETIME%nday, IHOUR,IMINUTE,ZSECOND
END IF
ELSE
- IF ((TPDATETIME%TDATE%YEAR < 0).OR.(TPDATETIME%TDATE%MONTH < 0).OR. &
- (TPDATETIME%TDATE%DAY < 0) ) THEN
+ IF ((TPDATETIME%nyear < 0).OR.(TPDATETIME%nmonth < 0).OR. &
+ (TPDATETIME%nday < 0) ) THEN
WRITE(UNIT=ILUOUT,FMT='(1X,2X,I2.2,"H",I2.2,"M", &
& F5.2,"S")') IHOUR,IMINUTE,ZSECOND
ELSE
WRITE(UNIT=ILUOUT,FMT='(1X,I4.4,I2.2,I2.2,2X,I2.2,"H",I2.2,"M", &
- & F5.2,"S")') TPDATETIME%TDATE, IHOUR,IMINUTE,ZSECOND
+ & F5.2,"S")') TPDATETIME%nyear, TPDATETIME%nmonth, TPDATETIME%nday, IHOUR,IMINUTE,ZSECOND
END IF
END IF
!-------------------------------------------------------------------------------
diff --git a/src/MNH/modeln.f90 b/src/MNH/modeln.f90
index e28be6ca8739ad56d00eba91d4c6d450e720db43..e885690fc5792bc75bcaff6ef88cd726fb4e7f03 100644
--- a/src/MNH/modeln.f90
+++ b/src/MNH/modeln.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -168,7 +168,7 @@ END MODULE MODI_MODEL_n
!! July 29,1996 (Lafore) nesting introduction
!! Aug. 1,1996 (Lafore) synchronization between models
!! Sept. 4,1996 (Lafore) modification of call to routine SET_COUPLING
-!! now splitted in 2 routines
+!! now split in 2 routines
!! (UVW_LS_COUPLING and SCALAR_LS_COUPLING)
!! Sept 5,1996 (V.Masson) print of loop index for debugging
!! purposes
@@ -265,7 +265,14 @@ END MODULE MODI_MODEL_n
! J. Escobar 09/07/2019: norme Doctor -> Rename Module Type variable TZ -> T
! J. Escobar 09/07/2019: for bug in management of XLSZWSM variable, add/use specific 2D TLSFIELD2D_ll pointer
! P. Wautelet 23/07/2019: OpenACC: move data creations from resolved_cloud to modeln and optimize updates
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
! J. Escobar 27/09/2019: add missing report timing of RESOLVED_ELEC
+! P. Wautelet 02-03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 12/10/2020: Write_les_n: remove HLES_AVG dummy argument and group all 4 calls
+! F. Auguste 01/02/2021: add IBM
+! T. Nagel 01/02/2021: add turbulence recycling
+! P. Wautelet 19/02/2021: add NEGA2 term for SV budgets
+! J.L. Redelsperger 03/2021: add Call NHOA_COUPLN (coupling O & A LES version)
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -274,34 +281,41 @@ END MODULE MODI_MODEL_n
USE MODD_2D_FRC
USE MODD_ADV_n
USE MODD_AIRCRAFT_BALLOON
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODD_BAKOUT
USE MODD_BIKHARDT_n
-USE MODD_BLANK
-USE MODD_BUDGET
+USE MODD_BLANK_n
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
+use modd_budget, only: cbutype, lbu_ru, lbu_rv, lbu_rw, lbudget_u, lbudget_v, lbudget_w, lbudget_sv, lbu_enable, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_SV1, nbumod, nbutime, &
+ tbudgets, tburhodj, &
+ xtime_bu, xtime_bu_process
USE MODD_CH_AERO_n, ONLY: XSOLORG, XMI
USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX,LUSECHAQ,LUSECHIC, &
LCH_INIT_FIELD
USE MODD_CLOUD_MF_n
-USE MODD_VISCOSITY
-USE MODD_DRAG_n
USE MODD_CLOUDPAR_n
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CURVCOR_n
USE MODD_DEEP_CONVECTION_n
USE MODD_DIM_n
+USE MODD_DRAG_n
USE MODD_DUST, ONLY: LDUST
USE MODD_DYN
USE MODD_DYN_n
USE MODD_DYNZD
USE MODD_DYNZD_n
USE MODD_ELEC_DESCR
+USE MODD_EOL_MAIN
USE MODD_FIELD_n
USE MODD_FRC
USE MODD_FRC_n
USE MODD_GET_n
USE MODD_GRID, ONLY: XLONORI,XLATORI
USE MODD_GRID_n
+USE MODD_IBM_PARAM_n, ONLY: CIBM_ADV, LIBM, LIBM_TROUBLE, XIBM_LS
USE MODD_ICE_C1R3_DESCR, ONLY: XRTMIN_C1R3=>XRTMIN
USE MODD_IO, ONLY: LIO_NO_WRITE, TFILEDATA, TFILE_SURFEX, TFILE_DUMMY
USE MODD_LBC_n
@@ -309,7 +323,7 @@ USE MODD_LES
USE MODD_LES_BUDGET
USE MODD_LIMA_PRECIP_SCAVENGING_n
USE MODD_LSFIELD_n
-USE MODD_LUNIT, ONLY: TLUOUT0,TOUTDATAFILE
+USE MODD_LUNIT, ONLY: TOUTDATAFILE
USE MODD_LUNIT_n, ONLY: TDIAFILE,TINIFILE,TINIFILEPGD,TLUOUT
USE MODD_MEAN_FIELD
USE MODD_MEAN_FIELD_n
@@ -327,8 +341,6 @@ USE MODD_PARAM_LIMA, ONLY: MSEDC => LSEDC, MWARM => LWARM, MRAIN => LRAIN, &
MACTIT => LACTIT, LSCAV, LCOLD, &
MSEDI => LSEDI, MHHONI => LHHONI, LHAIL, &
XRTMIN_LIMA=>XRTMIN, MACTTKE=>LACTTKE
-USE MODD_BLOWSNOW_n
-USE MODD_BLOWSNOW
USE MODD_PARAM_MFSHALL_n
USE MODD_PARAM_n
USE MODD_PAST_FIELD_n
@@ -337,6 +349,8 @@ use modd_precision, only: MNHTIME
USE MODD_PROFILER_n
USE MODD_RADIATIONS_n, ONLY: XTSRAD,XSCAFLASWD,XDIRFLASWD,XDIRSRFSWD, XAER, XDTHRAD
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
+USE MODD_RECYCL_PARAM_n, ONLY: LRECYCL
+USE MODD_REF, ONLY: LCOUPLES
USE MODD_REF_n
USE MODD_SALT, ONLY: LSALT
USE MODD_SERIES, ONLY: LSERIES
@@ -348,7 +362,9 @@ USE MODD_TIME_n
USE MODD_TIMEZ
USE MODD_TURB_CLOUD, ONLY: NMODEL_CLOUD,CTURBLEN_CLOUD,XCEI
USE MODD_TURB_n
+USE MODD_VISCOSITY
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_DATETIME
USE MODE_ELEC_ll
USE MODE_GRIDCART
@@ -357,11 +373,19 @@ USE MODE_IO_FIELD_WRITE, only: IO_Field_user_write, IO_Fieldlist_write, IO_Hea
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_ll
+#ifdef MNH_IOLFI
+use mode_menu_diachro, only: MENU_DIACHRO
+#endif
USE MODE_MNH_TIMING
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
+USE MODE_MSG
USE MODE_ONE_WAY_n
+use mode_write_les_n, only: Write_les_n
+use mode_write_lfifmn_fordiachro_n, only: WRITE_LFIFMN_FORDIACHRO_n
+USE MODE_WRITE_PROFILER_n, ONLY: WRITE_PROFILER_n
!
+USE MODI_ADDFLUCTUATIONS
USE MODI_ADVECTION_METSV
USE MODI_ADVECTION_UVW
USE MODI_ADVECTION_UVW_CEN
@@ -384,18 +408,20 @@ USE MODI_FORC_SQUALL_LINE
USE MODI_FORC_WIND
USE MODI_GET_HALO
USE MODI_GRAVITY_IMPL
+USE MODI_IBM_INIT
+USE MODI_IBM_FORCING
+USE MODI_IBM_FORCING_TR
+USE MODI_IBM_FORCING_ADV
USE MODI_INI_DIAG_IN_RUN
USE MODI_INI_LG
USE MODI_INI_MEAN_FIELD
USE MODI_INITIAL_GUESS
USE MODI_LES_INI_TIMESTEP_n
USE MODI_LES_N
-USE MODI_VISCOSITY
USE MODI_LIMA_PRECIP_SCAVENGING
USE MODI_LS_COUPLING
USE MODI_MASK_COMPRESS
USE MODI_MEAN_FIELD
-USE MODI_MENU_DIACHRO
USE MODI_MNHGET_SURF_PARAM_n
USE MODI_MNHWRITE_ZS_DUMMY_n
USE MODI_NUDGING
@@ -404,6 +430,7 @@ USE MODI_PHYS_PARAM_n
USE MODI_PRESSUREZ
USE MODI_PROFILER_n
USE MODI_RAD_BOUND
+USE MODI_RECYCLING
USE MODI_RELAX2FW_ION
USE MODI_RELAXATION
USE MODI_REL_FORCING_n
@@ -418,13 +445,11 @@ USE MODI_STATION_n
USE MODI_TURB_CLOUD_INDEX
USE MODI_TWO_WAY
USE MODI_UPDATE_NSV
+USE MODI_VISCOSITY
USE MODI_WRITE_AIRCRAFT_BALLOON
USE MODI_WRITE_DESFM_n
USE MODI_WRITE_DIAG_SURF_ATM_N
-USE MODI_WRITE_LES_n
USE MODI_WRITE_LFIFM_n
-USE MODI_WRITE_LFIFMN_FORDIACHRO_n
-USE MODI_WRITE_PROFILER_n
USE MODI_WRITE_SERIES_n
USE MODI_WRITE_STATION_n
USE MODI_WRITE_SURF_ATM_N
@@ -612,10 +637,6 @@ IF (KTCOUNT == 1) THEN
!
ALLOCATE(XWT_ACT_NUC(SIZE(XWT,1),SIZE(XWT,2),SIZE(XWT,3)))
ALLOCATE(GMASKkids(SIZE(XWT,1),SIZE(XWT,2)))
-!
-! initialization of the FM file backup/output number
- IBAK=0
- IOUT=0
!
IF ( .NOT. LIO_NO_WRITE ) THEN
CALL IO_File_open(TDIAFILE)
@@ -719,12 +740,15 @@ IF (KTCOUNT == 1) THEN
XT_TURB = 0.0_MNHTIME
XT_MAFL = 0.0_MNHTIME
XT_DRAG = 0.0_MNHTIME
+ XT_EOL = 0.0_MNHTIME
XT_TRACER = 0.0_MNHTIME
XT_SHADOWS = 0.0_MNHTIME
XT_ELEC = 0.0_MNHTIME
XT_CHEM = 0.0_MNHTIME
XT_2WAY = 0.0_MNHTIME
!
+ XT_IBM_FORC = 0.0_MNHTIME
+ !
END IF
!
!* 1.7 Allocation of arrays for observation diagnostics
@@ -744,11 +768,14 @@ CALL SECOND_MNH2(ZTIME1)
!
ISYNCHRO = MODULO (KTCOUNT, NDTRATIO(IMI) ) ! test of synchronisation
!
-
-
-IF (IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) THEN
-!
- ! Use dummy pointers to correct an ifort BUG
+!
+IF (LCOUPLES.AND.LOCEAN) THEN
+ CALL NHOA_COUPL_n(NDAD(IMI),XTSTEP,IMI,KTCOUNT,IKU)
+END IF
+! No Gridnest in coupled OA LES for now
+IF (.NOT. LCOUPLES .AND. IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) THEN
+!
+! Use dummy pointers to correct an ifort BUG
DPTR_XBMX1=>XBMX1
DPTR_XBMX2=>XBMX2
DPTR_XBMX3=>XBMX3
@@ -875,7 +902,28 @@ IF (IMI/=1 .AND. NDAD(IMI)/=IMI .AND. (ISYNCHRO==1 .OR. NDTRATIO(IMI) == 1) ) TH
END IF
!
CALL SECOND_MNH2(ZTIME2)
-XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1
+XT_1WAY = XT_1WAY + ZTIME2 - ZTIME1
+!
+!* 2.1 RECYCLING TURBULENCE
+! ----
+IF (CTURB /= 'NONE' .AND. LRECYCL) THEN
+ CALL RECYCLING(XFLUCTUNW,XFLUCTVNN,XFLUCTUTN,XFLUCTVTW,XFLUCTWTW,XFLUCTWTN, &
+ XFLUCTUNE,XFLUCTVNS,XFLUCTUTS,XFLUCTVTE,XFLUCTWTE,XFLUCTWTS, &
+ KTCOUNT)
+ENDIF
+!
+!* 2.2 IBM
+! ----
+!
+IF (LIBM .AND. KTCOUNT==1) THEN
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_INIT(XIBM_LS)
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!
@@ -895,7 +943,7 @@ CALL BOUNDARIES ( &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
- XRHODJ, &
+ XRHODJ,XRHODREF, &
XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
END IF
!
@@ -913,19 +961,18 @@ IF (CSURF=='EXTE') CALL GOTO_SURFEX(IMI)
!
ZTIME1 = ZTIME2
!
-IF (IBAK < NBAK_NUMB ) THEN
- IF (KTCOUNT == TBACKUPN(IBAK+1)%NSTEP) THEN
- IBAK=IBAK+1
- GCLOSE_OUT=.TRUE.
+IF ( nfile_backup_current < NBAK_NUMB ) THEN
+ IF ( KTCOUNT == TBACKUPN(nfile_backup_current + 1)%NSTEP ) THEN
+ nfile_backup_current = nfile_backup_current + 1
!
- TZBAKFILE => TBACKUPN(IBAK)%TFILE
+ TZBAKFILE => TBACKUPN(nfile_backup_current)%TFILE
IVERB = TZBAKFILE%NLFIVERB
!
CALL IO_File_open(TZBAKFILE)
!
CALL WRITE_DESFM_n(IMI,TZBAKFILE)
- CALL IO_Header_write(TBACKUPN(IBAK)%TFILE)
- CALL WRITE_LFIFM_n(TBACKUPN(IBAK)%TFILE,TBACKUPN(IBAK)%TFILE%TDADFILE%CNAME)
+ CALL IO_Header_write( TBACKUPN(nfile_backup_current)%TFILE )
+ CALL WRITE_LFIFM_n( TBACKUPN(nfile_backup_current)%TFILE, TBACKUPN(nfile_backup_current)%TFILE%TDADFILE%CNAME )
TOUTDATAFILE => TZBAKFILE
CALL MNHWRITE_ZS_DUMMY_n(TZBAKFILE)
IF (CSURF=='EXTE') THEN
@@ -958,17 +1005,17 @@ ELSE
TZBAKFILE => TFILE_DUMMY
END IF
!
-IF (IOUT < NOUT_NUMB ) THEN
- IF (KTCOUNT == TOUTPUTN(IOUT+1)%NSTEP) THEN
- IOUT=IOUT+1
+IF ( nfile_output_current < NOUT_NUMB ) THEN
+ IF ( KTCOUNT == TOUTPUTN(nfile_output_current + 1)%NSTEP ) THEN
+ nfile_output_current = nfile_output_current + 1
!
- TZOUTFILE => TOUTPUTN(IOUT)%TFILE
+ TZOUTFILE => TOUTPUTN(nfile_output_current)%TFILE
!
CALL IO_File_open(TZOUTFILE)
!
CALL IO_Header_write(TZOUTFILE)
- CALL IO_Fieldlist_write(TOUTPUTN(IOUT))
- CALL IO_Field_user_write(TOUTPUTN(IOUT))
+ CALL IO_Fieldlist_write( TOUTPUTN(nfile_output_current) )
+ CALL IO_Field_user_write( TOUTPUTN(nfile_output_current) )
!
CALL IO_File_close(TZOUTFILE)
!
@@ -981,6 +1028,42 @@ XT_STORE = XT_STORE + ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
+!* 4.BIS IBM and Fluctuations application
+! -----------------------------
+!
+!* 4.B1 Add fluctuations at the domain boundaries
+!
+IF (LRECYCL) THEN
+ CALL ADDFLUCTUATIONS ( &
+ CLBCX,CLBCY, &
+ XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT, &
+ XFLUCTUTN,XFLUCTVTW,XFLUCTUTS,XFLUCTVTE, &
+ XFLUCTWTW,XFLUCTWTN,XFLUCTWTS,XFLUCTWTE )
+ENDIF
+!
+!* 4.B2 Immersed boundaries
+!
+IF (LIBM) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL, 'GEN', 'MODELN', 'IBM can only be used in combination with cartesian coordinates')
+ ENDIF
+ !
+ CALL IBM_FORCING(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ !
+ IF (LIBM_TROUBLE) THEN
+ CALL IBM_FORCING_TR(XUT,XVT,XWT,XTHT,XRT,XSVT,XTKET)
+ ENDIF
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!-------------------------------------------------------------------------------
+!
!* 5. INITIALIZATION OF THE BUDGET VARIABLES
! --------------------------------------
!
@@ -991,28 +1074,34 @@ ELSE
END IF
!
IF (NBUMOD==IMI .AND. CBUTYPE=='MASK' ) THEN
- CALL SET_MASK
- IF (LBU_RU) XBURHODJU(:,NBUTIME,:) = XBURHODJU(:,NBUTIME,:) &
- + MASK_COMPRESS(MXM(XRHODJ))
- IF (LBU_RV) XBURHODJV(:,NBUTIME,:) = XBURHODJV(:,NBUTIME,:) &
- + MASK_COMPRESS(MYM(XRHODJ))
- IF (LBU_RW) XBURHODJW(:,NBUTIME,:) = XBURHODJW(:,NBUTIME,:) &
- + MASK_COMPRESS(MZM(XRHODJ))
- IF (ALLOCATED(XBURHODJ)) &
- XBURHODJ (:,NBUTIME,:) = XBURHODJ (:,NBUTIME,:) &
- + MASK_COMPRESS(XRHODJ)
+ CALL SET_MASK()
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rv ) then
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mym( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rw ) then
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, nbutime, :) &
+ + Mask_compress( Mzm( xrhodj(:, :, :) ) )
+ end if
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, nbutime, :) = tburhodj%xdata(:, nbutime, :) + Mask_compress( xrhodj(:, :, :) )
END IF
!
IF (NBUMOD==IMI .AND. CBUTYPE=='CART' ) THEN
- IF (LBU_RU) XBURHODJU(:,:,:) = XBURHODJU(:,:,:) &
- + CART_COMPRESS(MXM(XRHODJ))
- IF (LBU_RV) XBURHODJV(:,:,:) = XBURHODJV(:,:,:) &
- + CART_COMPRESS(MYM(XRHODJ))
- IF (LBU_RW) XBURHODJW(:,:,:) = XBURHODJW(:,:,:) &
- + CART_COMPRESS(MZM(XRHODJ))
- IF (ALLOCATED(XBURHODJ)) &
- XBURHODJ (:,:,:) = XBURHODJ (:,:,:) &
- + CART_COMPRESS(XRHODJ)
+ if ( lbu_ru ) then
+ tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_U)%trhodj%xdata(:, :, :) + Cart_compress( Mxm( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rv ) then
+ tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_V)%trhodj%xdata(:, :, :) + Cart_compress( Mym( xrhodj(:, :, :) ) )
+ end if
+ if ( lbu_rw ) then
+ tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) = tbudgets(NBUDGET_W)%trhodj%xdata(:, :, :) &
+ + Cart_compress( Mzm( xrhodj(:, :, :) ) )
+ end if
+ if ( associated( tburhodj ) ) tburhodj%xdata(:, :, :) = tburhodj%xdata(:, :, :) + Cart_compress( xrhodj(:, :, :) )
END IF
!
CALL BUDGET_FLAGS(LUSERV, LUSERC, LUSERR, &
@@ -1116,7 +1205,7 @@ END IF
!
IF ( LFORCING ) THEN
CALL FORCING(XTSTEP,LUSERV,XRHODJ,XCORIOZ,XZHAT,XZZ,TDTCUR,&
- XUFRC_PAST, XVFRC_PAST, &
+ XUFRC_PAST, XVFRC_PAST,XWTFRC, &
XUT,XVT,XWT,XTHT,XTKET,XRT,XSVT, &
XRUS,XRVS,XRWS,XRTHS,XRTKES,XRRS,XRSVS,IMI,ZJ)
END IF
@@ -1212,7 +1301,13 @@ IF ( LNUMDIFU .OR. LNUMDIFTH .OR. LNUMDIFSV ) THEN
LZDIFFU,LNUMDIFU, LNUMDIFTH, LNUMDIFSV, &
THALO2T_ll, TLSHALO2_ll,XZDIFFU_HALO2 )
END IF
-!
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) )
+ end do
+end if
+
DO JSV = NSV_CHEMBEG,NSV_CHEMEND
XRSVS(:,:,:,JSV) = MAX(XRSVS(:,:,:,JSV),0.)
END DO
@@ -1258,6 +1353,12 @@ IF (CELEC .NE. 'NONE') THEN
XRSVS(:,:,:,NSV_ELECBEG) = MAX(XRSVS(:,:,:,NSV_ELECBEG),0.)
XRSVS(:,:,:,NSV_ELECEND) = MAX(XRSVS(:,:,:,NSV_ELECEND),0.)
END IF
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEGA2', xrsvs(:, :, :, jsv) )
+ end do
+end if
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1319,10 +1420,10 @@ XT_RELAX = XT_RELAX + ZTIME2 - ZTIME1 &
!
ZTIME1 = ZTIME2
!
-CALL PHYS_PARAM_n(KTCOUNT,TZBAKFILE, GCLOSE_OUT, &
- XT_RAD,XT_SHADOWS,XT_DCONV,XT_GROUND,XT_MAFL, &
- XT_DRAG,XT_TURB,XT_TRACER, &
- ZTIME,ZWETDEPAER,GMASKkids,GCLOUD_ONLY)
+CALL PHYS_PARAM_n( KTCOUNT, TZBAKFILE, &
+ XT_RAD, XT_SHADOWS, XT_DCONV, XT_GROUND, &
+ XT_MAFL, XT_DRAG, XT_EOL, XT_TURB, XT_TRACER, &
+ ZTIME, ZWETDEPAER, GMASKkids, GCLOUD_ONLY )
!
IF (CDCONV/='NONE') THEN
XPACCONV = XPACCONV + XPRCONV * XTSTEP
@@ -1332,8 +1433,8 @@ IF (CDCONV/='NONE') THEN
END IF
END IF
!
-IF (IBAK>0 .AND. IBAK <= NBAK_NUMB ) THEN
- IF (KTCOUNT == TBACKUPN(IBAK)%NSTEP) THEN
+IF ( nfile_backup_current > 0 .AND. nfile_backup_current <= NBAK_NUMB ) THEN
+ IF ( KTCOUNT == TBACKUPN(nfile_backup_current)%NSTEP ) THEN
IF (CSURF=='EXTE') THEN
CALL GOTO_SURFEX(IMI)
CALL DIAG_SURF_ATM_n(YSURF_CUR,'MESONH')
@@ -1464,9 +1565,9 @@ XT_COUPL = XT_COUPL + ZTIME2 - ZTIME1
!* 8 Bis . Blowing snow scheme
! ---------
!
-IF(LBLOWSNOW) THEN
- CALL BLOWSNOW(CLBCX,CLBCY,XTSTEP,NRR,XPABST,XTHT,XRT,XZZ,XRHODREF, &
- XRHODJ,XEXNREF,XRRS,XRTHS,XSVT,XRSVS,XSNWSUBL3D )
+IF ( LBLOWSNOW ) THEN
+ CALL BLOWSNOW( XTSTEP, NRR, XPABST, XTHT, XRT, XZZ, XRHODREF, &
+ XRHODJ, XEXNREF, XRRS, XRTHS, XSVT, XRSVS, XSNWSUBL3D )
ENDIF
!
!-----------------------------------------------------------------------
@@ -1513,7 +1614,7 @@ XTIME_LES_BU_PROCESS = 0.
!$acc data copyin (XTKET, XRSVS_CLD) &
!$acc & copy (XRTKES, XRSVS) &
!$acc & copyout(XRTKEMS)
-CALL ADVECTION_METSV ( TZBAKFILE, GCLOSE_OUT,CUVW_ADV_SCHEME, &
+CALL ADVECTION_METSV ( TZBAKFILE, CUVW_ADV_SCHEME, &
CMET_ADV_SCHEME, CSV_ADV_SCHEME, CCLOUD, NSPLIT, &
LSPLIT_CFL, XSPLIT_CFL, LCFL_WRIT, &
CLBCX, CLBCY, NRR, NSV, TDTCUR, XTSTEP, &
@@ -1554,6 +1655,18 @@ CALL SECOND_MNH2(ZTIME2)
!
XT_GRAV = XT_GRAV + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
!
+IF ( LIBM .AND. CIBM_ADV=='FORCIN' ) THEN
+ !
+ ZTIME1=ZTIME2
+ !
+ CALL IBM_FORCING_ADV (XRUS,XRVS,XRWS)
+ !
+ CALL SECOND_MNH2(ZTIME2)
+ !
+ XT_IBM_FORC = XT_IBM_FORC + ZTIME2 - ZTIME1
+ !
+ENDIF
+!
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
@@ -1609,10 +1722,10 @@ XT_ADVUVW = XT_ADVUVW + ZTIME2 - ZTIME1 - XTIME_LES_BU_PROCESS - XTIME_BU_PROCES
!-------------------------------------------------------------------------------
!
IF (NMODEL_CLOUD==IMI .AND. CTURBLEN_CLOUD/='NONE') THEN
- CALL TURB_CLOUD_INDEX(XTSTEP,TZBAKFILE, &
- LTURB_DIAG,GCLOSE_OUT,NRRI, &
- XRRS,XRT,XRHODJ,XDXX,XDYY,XDZZ,XDZX,XDZY, &
- XCEI )
+ CALL TURB_CLOUD_INDEX( XTSTEP, TZBAKFILE, &
+ LTURB_DIAG, NRRI, &
+ XRRS, XRT, XRHODJ, XDXX, XDYY, XDZZ, XDZX, XDZY, &
+ XCEI )
END IF
!
!-------------------------------------------------------------------------------
@@ -1625,12 +1738,19 @@ ZTIME1 = ZTIME2
ZRUS=XRUS
ZRVS=XRVS
ZRWS=XRWS
-!
- CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
+
+if ( .not. l1d ) then
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', xrus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'PRES', xrvs(:, :, :) )
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'PRES', xrws(:, :, :) )
+end if
+
+CALL RAD_BOUND (CLBCX,CLBCY,CTURB,XCARPKMAX, &
XTSTEP, &
XDXHAT, XDYHAT, XZHAT, &
XUT, XVT, &
XLBXUM, XLBYVM, XLBXUS, XLBYVS, &
+ XFLUCTUNW,XFLUCTVNN,XFLUCTUNE,XFLUCTVNS, &
XCPHASE, XCPHASE_PBL, XRHODJ, &
XTKET,XRUS, XRVS, XRWS )
ZRUS=XRUS-ZRUS
@@ -1790,7 +1910,7 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
CLBCX,CLBCY,TZBAKFILE, CRAD, CTURBDIM, &
- GCLOSE_OUT, LSUBG_COND,LSIGMAS,CSUBG_AUCV,XTSTEP, &
+ LSUBG_COND,LSIGMAS,CSUBG_AUCV,XTSTEP, &
XZZ, XRHODJ, XRHODREF, XEXNREF, &
ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
XPABSM, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
@@ -1798,13 +1918,14 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XSRCT, XCLDFR,XCIT, &
LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
-! XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
+! XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
! XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
- XINPRC,XINPRR, XINPRR3D, XEVAP3D, &
- XINPRS, XINPRG,XINPRH, &
! XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
+ XINPRC,XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS, XINPRG, XINPRH, &
XSOLORG, XMI, &
XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF, &
ZSEA, ZTOWN )
!$acc end data
DEALLOCATE(ZTOWN)
@@ -1812,7 +1933,7 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
CALL RESOLVED_CLOUD ( CCLOUD, CACTCCN, CSCONV, CMF_CLOUD, NRR, NSPLITR, &
NSPLITG, IMI, KTCOUNT, &
CLBCX,CLBCY,TZBAKFILE, CRAD, CTURBDIM, &
- GCLOSE_OUT, LSUBG_COND,LSIGMAS,CSUBG_AUCV, &
+ LSUBG_COND,LSIGMAS,CSUBG_AUCV, &
XTSTEP,XZZ, XRHODJ, XRHODREF, XEXNREF, &
ZPABST, XTHT,XRT,XSIGS,VSIGQSAT,XMFCONV,XTHM,XRCM, &
XPABSM, XWT_ACT_NUC,XDTHRAD, XRTHS, XRRS, &
@@ -1820,13 +1941,14 @@ IF (CCLOUD /= 'NONE' .AND. CELEC == 'NONE') THEN
XSRCT, XCLDFR,XCIT, &
LSEDIC,KACTIT, KSEDC, KSEDI, KRAIN, KWARM, KHHONI, &
LCONVHG, XCF_MF,XRC_MF, XRI_MF, &
-! XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
+! XINPRC,ZINPRC3D,XINPRR, XINPRR3D, XEVAP3D, &
! XINPRS,ZINPRS3D, XINPRG,ZINPRG3D, XINPRH,ZINPRH3D, &
- XINPRC,XINPRR, XINPRR3D, XEVAP3D, &
- XINPRS, XINPRG,XINPRH, &
! XSOLORG, XMI,ZSPEEDC, ZSPEEDR, ZSPEEDS, ZSPEEDG, ZSPEEDH, &
+ XINPRC,XINPRR, XINPRR3D, XEVAP3D, &
+ XINPRS, XINPRG, XINPRH, &
XSOLORG, XMI, &
- XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR )
+ XINDEP, XSUPSAT, XNACT, XNPRO,XSSPRO, XRAINFR, &
+ XHLC_HRC, XHLC_HCF, XHLI_HRI, XHLI_HCF )
END IF
!$acc end data
XRTHS_CLD(:, :, : ) = XRTHS(:, :, : ) - XRTHS_CLD(:, :, : )
@@ -1954,7 +2076,7 @@ XT_SPECTRA = XT_SPECTRA + ZTIME2 - ZTIME1 + XTIME_LES_BU + XTIME_LES
! --------------------
!
IF (LMEAN_FIELD) THEN
- CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST)
+ CALL MEAN_FIELD(XUT, XVT, XWT, XTHT, XTKET, XPABST, XSVT(:,:,:,1))
END IF
!
!-------------------------------------------------------------------------------
@@ -2012,7 +2134,6 @@ ZTIME1 = ZTIME2
!
IF (LFLYER) &
CALL AIRCRAFT_BALLOON(XTSTEP, &
- TDTEXP, TDTMOD, TDTSEG, TDTCUR, &
XXHAT, XYHAT, XZZ, XMAP, XLONORI, XLATORI, &
XUT, XVT, XWT, XPABST, XTHT, XRT, XSVT, XTKET, XTSRAD, &
XRHODREF,XCIT,PSEA=ZSEA(:,:))
@@ -2025,7 +2146,6 @@ IF (LFLYER) &
!
IF (LSTATION) &
CALL STATION_n(XTSTEP, &
- TDTEXP, TDTMOD, TDTSEG, TDTCUR, &
XXHAT, XYHAT, XZZ, &
XUT, XVT, XWT, XTHT, XRT, XSVT, XTKET, XTSRAD, XPABST )
!
@@ -2036,10 +2156,9 @@ IF (LSTATION) &
!
IF (LPROFILER) &
CALL PROFILER_n(XTSTEP, &
- TDTEXP, TDTMOD, TDTSEG, TDTCUR, &
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)
@@ -2063,7 +2182,7 @@ ZTIME1 = ZTIME2
!
IF ( .NOT. LIO_NO_WRITE ) THEN
IF (NBUMOD==IMI .AND. CBUTYPE/='NONE') THEN
- CALL ENDSTEP_BUDGET(TDIAFILE,KTCOUNT,TDTCUR,TDTMOD,XTSTEP,NSV)
+ CALL ENDSTEP_BUDGET(TDIAFILE,KTCOUNT,TDTCUR,XTSTEP,NSV)
END IF
END IF
!
@@ -2076,8 +2195,7 @@ XT_STEP_BUD = XT_STEP_BUD + ZTIME2 - ZTIME1 + XTIME_BU
!* 26. FM FILE CLOSURE
! ---------------
!
-IF (GCLOSE_OUT) THEN
- GCLOSE_OUT=.FALSE.
+IF ( tzbakfile%lopened ) THEN
CALL IO_File_close(TZBAKFILE)
END IF
!
@@ -2086,7 +2204,7 @@ END IF
!* 27. CURRENT TIME REFRESH
! --------------------
!
-TDTCUR%TIME=TDTCUR%TIME + XTSTEP
+TDTCUR%xtime=TDTCUR%xtime + XTSTEP
CALL DATETIME_CORRECTDATE(TDTCUR)
!
!-------------------------------------------------------------------------------
@@ -2109,11 +2227,10 @@ IF (OEXIT) THEN
CALL WRITE_AIRCRAFT_BALLOON(TDIAFILE)
CALL WRITE_STATION_n(TDIAFILE)
CALL WRITE_PROFILER_n(TDIAFILE)
- CALL WRITE_LES_n(TDIAFILE,' ')
- CALL WRITE_LES_n(TDIAFILE,'A')
- CALL WRITE_LES_n(TDIAFILE,'E')
- CALL WRITE_LES_n(TDIAFILE,'H')
+ call Write_les_n( tdiafile )
+#ifdef MNH_IOLFI
CALL MENU_DIACHRO(TDIAFILE,'END')
+#endif
CALL IO_File_close(TDIAFILE)
END IF
!
@@ -2149,6 +2266,7 @@ IF (OEXIT) THEN
CALL TIME_STAT_ll(XT_ADVUVW,ZTOT, ' ADVECTION UVW','=')
CALL TIME_STAT_ll(XT_GRAV,ZTOT, ' GRAVITY','=')
CALL TIME_STAT_ll(XT_FORCING,ZTOT, ' FORCING','=')
+ CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT, ' IBM','=')
CALL TIME_STAT_ll(XT_NUDGING,ZTOT, ' NUDGING','=')
CALL TIME_STAT_ll(XT_SOURCES,ZTOT, ' DYN_SOURCES','=')
CALL TIME_STAT_ll(XT_DIFF,ZTOT, ' NUM_DIFF','=')
@@ -2164,6 +2282,7 @@ IF (OEXIT) THEN
CALL TIME_STAT_ll(XT_TURB,ZTOT, ' TURB = '//CTURB ,'-')
CALL TIME_STAT_ll(XT_MAFL,ZTOT, ' MAFL = '//CSCONV,'-')
CALL TIME_STAT_ll(XT_CHEM,ZTOT, ' CHIMIE' ,'-')
+ CALL TIME_STAT_ll(XT_EOL,ZTOT, ' WIND TURBINE' ,'-')
CALL TIMING_LEGEND()
CALL TIME_STAT_ll(XT_COUPL,ZTOT, ' SET_COUPLING','=')
CALL TIME_STAT_ll(XT_RAD_BOUND,ZTOT, ' RAD_BOUND','=')
@@ -2188,12 +2307,13 @@ IF (OEXIT) THEN
CALL TIME_STAT_ll(XT_STEP_BUD,ZTOT, ' BUDGETS','=')
CALL TIME_STAT_ll(XT_SPECTRA,ZTOT, ' LES','=')
CALL TIME_STAT_ll(XT_STEP_MISC,ZTOT, ' MISCELLANEOUS','=')
+ IF (LIBM) CALL TIME_STAT_ll(XT_IBM_FORC,ZTOT,' IBM FORCING','=')
!
! sum of call subroutine
!
ZALL = XT_1WAY + XT_BOUND + XT_STORE + XT_GUESS + XT_2WAY + &
XT_ADV + XT_FORCING + XT_NUDGING + XT_SOURCES + XT_DIFF + &
- XT_ADVUVW + XT_GRAV + &
+ XT_ADVUVW + XT_GRAV + XT_IBM_FORC + &
XT_RELAX+ XT_PARAM + XT_COUPL + XT_RAD_BOUND+XT_PRESS + &
XT_CLOUD+ XT_ELEC + XT_HALO + XT_SPECTRA + XT_STEP_SWA + &
XT_STEP_MISC+ XT_STEP_BUD
@@ -2232,10 +2352,6 @@ IF (OEXIT) THEN
!
CALL TIMING_SEPARATOR('=')
!
- !
- !
- CALL IO_File_close(TLUOUT)
- IF (IMI==NMODEL) CALL IO_File_close(TLUOUT0)
END IF
!$acc end data
diff --git a/src/MNH/modn_blank.f90 b/src/MNH/modn_blank.f90
deleted file mode 100644
index d80e6894fd99b9be4c81efe21f8185ac4667307d..0000000000000000000000000000000000000000
--- a/src/MNH/modn_blank.f90
+++ /dev/null
@@ -1,61 +0,0 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modn 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! #################
- MODULE MODN_BLANK
-! #################
-!
-!!**** *MODN_BLANK* - Namelist module for MesoNH developpers namelist
-!!
-!! PURPOSE
-!! -------
-!!
-!! The purpose of this module is to specify the namelist NAM_BLANK
-!! which offer dummy real, integer, logical and character variables for
-!! test and debugging purposes.
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_BLANK : contains declaration of dummy variables
-!!
-!! REFERENCE
-!! ---------
-!! None
-!!
-!! AUTHOR
-!! ------
-!! K. Suhre *Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!!
-!! Original 25/04/96
-!! Modification 14/12/00 (P.Jabouille) add dummy arrays
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_BLANK
-!
-IMPLICIT NONE
-!
-NAMELIST /NAM_BLANK/ XDUMMY1, XDUMMY2, XDUMMY3, XDUMMY4, &
- XDUMMY5, XDUMMY6, XDUMMY7, XDUMMY8, &
- NDUMMY1, NDUMMY2, NDUMMY3, NDUMMY4, &
- NDUMMY5, NDUMMY6, NDUMMY7, NDUMMY8, &
- LDUMMY1, LDUMMY2, LDUMMY3, LDUMMY4, &
- LDUMMY5, LDUMMY6, LDUMMY7, LDUMMY8, &
- CDUMMY1, CDUMMY2, CDUMMY3, CDUMMY4, &
- CDUMMY5, CDUMMY6, CDUMMY7, CDUMMY8, &
- XDUMMY,NDUMMY,LDUMMY,CDUMMY
-!
-END MODULE MODN_BLANK
diff --git a/src/MNH/modn_blankn.f90 b/src/MNH/modn_blankn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2825372c2e01dbc839105c6391cb7e107d9a7ff8
--- /dev/null
+++ b/src/MNH/modn_blankn.f90
@@ -0,0 +1,176 @@
+!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.
+!-----------------------------------------------------------------
+! #################
+ MODULE MODN_BLANK_n
+! #################
+!
+!!**** *MODN_BLANK$n* - Namelist module for MesoNH developpers namelist
+!!
+!! PURPOSE
+!! -------
+!!
+!! The purpose of this module is to specify the namelist NAM_BLANKn
+!! which offer dummy real, integer, logical and character variables for
+!! test and debugging purposes.
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_BLANKn : contains declaration of dummy variables
+!!
+!! REFERENCE
+!! ---------
+!! None
+!!
+!! AUTHOR
+!! ------
+!! K. Suhre *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! Original 25/04/96
+!! Modification 14/12/00 (P.Jabouille) add dummy arrays
+!! Modification 26/10/21 (Q.Rodier) Use for n model (grid-nesting)
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BLANK_n, ONLY:&
+ LDUMMY1_n => LDUMMY1, &
+ LDUMMY2_n => LDUMMY2, &
+ LDUMMY3_n => LDUMMY3, &
+ LDUMMY4_n => LDUMMY4, &
+ LDUMMY5_n => LDUMMY5, &
+ LDUMMY6_n => LDUMMY6, &
+ LDUMMY7_n => LDUMMY7, &
+ LDUMMY8_n => LDUMMY8, &
+ XDUMMY1_n => XDUMMY1, &
+ XDUMMY2_n => XDUMMY2, &
+ XDUMMY3_n => XDUMMY3, &
+ XDUMMY4_n => XDUMMY4, &
+ XDUMMY5_n => XDUMMY5, &
+ XDUMMY6_n => XDUMMY6, &
+ XDUMMY7_n => XDUMMY7, &
+ XDUMMY8_n => XDUMMY8, &
+ CDUMMY1_n => CDUMMY1, &
+ CDUMMY2_n => CDUMMY2, &
+ CDUMMY3_n => CDUMMY3, &
+ CDUMMY4_n => CDUMMY4, &
+ CDUMMY5_n => CDUMMY5, &
+ CDUMMY6_n => CDUMMY6, &
+ CDUMMY7_n => CDUMMY7, &
+ CDUMMY8_n => CDUMMY8, &
+ NDUMMY1_n => NDUMMY1, &
+ NDUMMY2_n => NDUMMY2, &
+ NDUMMY3_n => NDUMMY3, &
+ NDUMMY4_n => NDUMMY4, &
+ NDUMMY5_n => NDUMMY5, &
+ NDUMMY6_n => NDUMMY6, &
+ NDUMMY7_n => NDUMMY7, &
+ NDUMMY8_n => NDUMMY8
+
+!
+IMPLICIT NONE
+LOGICAL, SAVE :: LDUMMY1, LDUMMY2, LDUMMY3, LDUMMY4,&
+ LDUMMY5, LDUMMY6, LDUMMY7, LDUMMY8
+CHARACTER(LEN=80), SAVE :: CDUMMY1, CDUMMY2, CDUMMY3, CDUMMY4,&
+ CDUMMY5, CDUMMY6, CDUMMY7, CDUMMY8
+INTEGER, SAVE :: NDUMMY1, NDUMMY2, NDUMMY3, NDUMMY4,&
+ NDUMMY5, NDUMMY6, NDUMMY7, NDUMMY8
+REAL, SAVE :: XDUMMY1, XDUMMY2, XDUMMY3, XDUMMY4,&
+ XDUMMY5, XDUMMY6, XDUMMY7, XDUMMY8
+
+!
+NAMELIST/NAM_BLANKn/XDUMMY1,XDUMMY2,XDUMMY3,XDUMMY4,&
+ XDUMMY5,XDUMMY6,XDUMMY7,XDUMMY8,&
+ NDUMMY1,NDUMMY2,NDUMMY3,NDUMMY4,&
+ NDUMMY5,NDUMMY6,NDUMMY7,NDUMMY8,&
+ LDUMMY1,LDUMMY2,LDUMMY3,LDUMMY4,&
+ LDUMMY5,LDUMMY6,LDUMMY7,LDUMMY8,&
+ CDUMMY1,CDUMMY2,CDUMMY3,CDUMMY4,&
+ CDUMMY5,CDUMMY6,CDUMMY7,CDUMMY8
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_BLANKn
+ XDUMMY1 = XDUMMY1_n
+ XDUMMY2 = XDUMMY2_n
+ XDUMMY3 = XDUMMY3_n
+ XDUMMY4 = XDUMMY4_n
+ XDUMMY5 = XDUMMY5_n
+ XDUMMY6 = XDUMMY6_n
+ XDUMMY7 = XDUMMY7_n
+ XDUMMY8 = XDUMMY8_n
+!
+ NDUMMY1 = NDUMMY1_n
+ NDUMMY2 = NDUMMY2_n
+ NDUMMY3 = NDUMMY3_n
+ NDUMMY4 = NDUMMY4_n
+ NDUMMY5 = NDUMMY5_n
+ NDUMMY6 = NDUMMY6_n
+ NDUMMY7 = NDUMMY7_n
+ NDUMMY8 = NDUMMY8_n
+!
+ CDUMMY1 = CDUMMY1_n
+ CDUMMY2 = CDUMMY2_n
+ CDUMMY3 = CDUMMY3_n
+ CDUMMY4 = CDUMMY4_n
+ CDUMMY5 = CDUMMY5_n
+ CDUMMY6 = CDUMMY6_n
+ CDUMMY7 = CDUMMY7_n
+ CDUMMY8 = CDUMMY8_n
+!
+ LDUMMY1 = LDUMMY1_n
+ LDUMMY2 = LDUMMY2_n
+ LDUMMY3 = LDUMMY3_n
+ LDUMMY4 = LDUMMY4_n
+ LDUMMY5 = LDUMMY5_n
+ LDUMMY6 = LDUMMY6_n
+ LDUMMY7 = LDUMMY7_n
+ LDUMMY8 = LDUMMY8_n
+END SUBROUTINE INIT_NAM_BLANKn
+!
+SUBROUTINE UPDATE_NAM_BLANKn
+ XDUMMY1_n = XDUMMY1
+ XDUMMY2_n = XDUMMY2
+ XDUMMY3_n = XDUMMY3
+ XDUMMY4_n = XDUMMY4
+ XDUMMY5_n = XDUMMY5
+ XDUMMY6_n = XDUMMY6
+ XDUMMY7_n = XDUMMY7
+ XDUMMY8_n = XDUMMY8
+!
+ NDUMMY1_n = NDUMMY1
+ NDUMMY2_n = NDUMMY2
+ NDUMMY3_n = NDUMMY3
+ NDUMMY4_n = NDUMMY4
+ NDUMMY5_n = NDUMMY5
+ NDUMMY6_n = NDUMMY6
+ NDUMMY7_n = NDUMMY7
+ NDUMMY8_n = NDUMMY8
+!
+ CDUMMY1_n = CDUMMY1
+ CDUMMY2_n = CDUMMY2
+ CDUMMY3_n = CDUMMY3
+ CDUMMY4_n = CDUMMY4
+ CDUMMY5_n = CDUMMY5
+ CDUMMY6_n = CDUMMY6
+ CDUMMY7_n = CDUMMY7
+ CDUMMY8_n = CDUMMY8
+!
+ LDUMMY1_n = LDUMMY1
+ LDUMMY2_n = LDUMMY2
+ LDUMMY3_n = LDUMMY3
+ LDUMMY4_n = LDUMMY4
+ LDUMMY5_n = LDUMMY5
+ LDUMMY6_n = LDUMMY6
+ LDUMMY7_n = LDUMMY7
+ LDUMMY8_n = LDUMMY8
+END SUBROUTINE UPDATE_NAM_BLANKn
+
+END MODULE MODN_BLANK_n
diff --git a/src/MNH/modn_budget.f90 b/src/MNH/modn_budget.f90
index 8d83765590a09f58a926aa1ed985a733951cc0ce..1cfc6d39117b4f0a1a1647dea57a35204cfaceec 100644
--- a/src/MNH/modn_budget.f90
+++ b/src/MNH/modn_budget.f90
@@ -1,12 +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: /srv/cvsroot/MNH-VX-Y-Z/src/MNH/modn_budget.f90,v $ $Revision: 1.2.2.1.2.1.2.1.10.1.2.3 $ $Date: 2014/01/09 15:01:56 $
-!-----------------------------------------------------------------
! ##################
MODULE MODN_BUDGET
! ##################
@@ -96,8 +92,7 @@
!!
!!
!! Variables specific to a budget
-!! Their values are integer from 0 to JPBUPROMAX (max. of possible
-!! processes). The mechanism for activating a given process is detailled
+!! The mechanism for activating a given process is detailled
!! in Book 3. Each variable name is related to the location of the
!! process in the run and may be decomposed in 2 parts: the first part
!! gives the name of the process implicated and the second part gives
@@ -219,16 +214,8 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original 01/03/95
-!! J. Stein 29/06/95 new processes' list
-!! J.-P. Pinty 11/01/97 add several SVx
-!! J.-P. Pinty 18/02/97 add forcing and ice
-!! J.-P. Pinty 25/09/00 add budget terms for C2R2
-!! D. Gazen 22/01/01 add NCHEMSV
-!! C.Lac 04/2016 negative contribution to the budget splitted between advection, turbulence and microphysics for KHKO/C2R2
-!! C. Barthe /16 add budget terms for LIMA
-!! C.Lac 10/2016 Add droplet deposition
-!! S. Riette 11/2016 New budgets for ICE3/ICE4
+!! Original 01/03/95
+! P. Wautelet 17/03/2021: choose source terms for budgets with character strings instead of multiple integer variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -241,79 +228,30 @@ IMPLICIT NONE
NAMELIST/NAM_BUDGET/CBUTYPE, NBUMOD, XBULEN, NBUKL, NBUKH, LBU_KCP, XBUWRI, &
NBUIL, NBUIH, NBUJL, NBUJH, LBU_ICP, LBU_JCP, NBUMASK
!
-NAMELIST/NAM_BU_RU/LBU_RU, NASSEU, NNESTU, NADVU, NFRCU, NNUDU, &
- NCURVU, NCORU, NDIFU, NRELU, NDRAGU, NHTURBU, NVTURBU, NMAFLU, NPRESU
+NAMELIST/NAM_BU_RU/LBU_RU, CBULIST_RU
!
-NAMELIST/NAM_BU_RV/LBU_RV, NASSEV, NNESTV, NADVV, NFRCV, NNUDV, &
- NCURVV, NCORV, NDIFV, NRELV, NDRAGV, NHTURBV, NVTURBV, NMAFLV, NPRESV
+NAMELIST/NAM_BU_RV/LBU_RV, CBULIST_RV
-NAMELIST/NAM_BU_RW/LBU_RW, NASSEW, NNESTW, NADVW, NFRCW, NNUDW, &
- NCURVW, NCORW, NGRAVW, NDIFW, NRELW, NHTURBW, NVTURBW, NPRESW
+NAMELIST/NAM_BU_RW/LBU_RW, CBULIST_RW
!
-NAMELIST/NAM_BU_RTH/LBU_RTH, NASSETH, NNESTTH, NADVTH, NFRCTH, &
- NNUDTH, NPREFTH, NDIFTH, NRELTH, NRADTH, NDCONVTH, NHTURBTH, &
- NVTURBTH, NDISSHTH, NNEGATH, NREVATH, NCONDTH, NHENUTH, NHONTH, &
- NSFRTH, NDEPSTH, NDEPGTH,NRIMTH, NACCTH, NCFRZTH, NWETGTH, &
- NDRYGTH, NGMLTTH, NIMLTTH, NBERFITH, NCDEPITH, NWETHTH, NHMLTTH, &
- NMAFLTH, NNETURTH, NNEADVTH,NNECONTH, NDRYHTH, NADJUTH, NCORRTH, &
- NHINDTH, NHINCTH, NHONHTH, NHONCTH, NHONRTH, NCEDSTH, NSEDITH
+NAMELIST/NAM_BU_RTH/LBU_RTH, CBULIST_RTH
!
-NAMELIST/NAM_BU_RTKE/LBU_RTKE, NASSETKE, NADVTKE, &
- NFRCTKE, NDIFTKE, NRELTKE, NDRAGTKE, &
- NDPTKE, NTPTKE, NDISSTKE, NTRTKE
+NAMELIST/NAM_BU_RTKE/LBU_RTKE, CBULIST_RTKE
!
-NAMELIST/NAM_BU_RRV/LBU_RRV, NASSERV, NNESTRV, NADVRV, NFRCRV, &
- NNUDRV, NDIFRV, NRELRV, NDCONVRV, NHTURBRV, NVTURBRV, NNEGARV, &
- NREVARV, NCONDRV, NHENURV, NDEPSRV, NDEPGRV, NCDEPIRV, NMAFLRV, &
- NNETURRV, NNEADVRV,NNECONRV, NADJURV, NCORRRV, NHINDRV, NHONHRV, NCEDSRV
+NAMELIST/NAM_BU_RRV/LBU_RRV, CBULIST_RRV
!
-NAMELIST/NAM_BU_RRC/LBU_RRC, NASSERC, NNESTRC, NADVRC, NFRCRC, &
- NDIFRC, NRELRC, NDCONVRC, NHTURBRC, NVTURBRC, NNEGARC, NACCRRC, &
- NAUTORC, NCONDRC, NHONRC, NRIMRC, NWETGRC, NDRYGRC, NIMLTRC, &
- NBERFIRC, NCDEPIRC, NHENURC, NSEDIRC, NWETHRC, NNETURRC, &
- NNEADVRC,NNECONRC, NDRYHRC, NADJURC, NCORRRC, NCMELRC, &
- NHINCRC, NHONCRC, NCEDSRC, NREVARC, NDEPORC,NDEPOTRRC, &
- NCORRRC, NR2C1RC, NCVRCRC
+NAMELIST/NAM_BU_RRC/LBU_RRC, CBULIST_RRC
!
-NAMELIST/NAM_BU_RRR/LBU_RRR, NASSERR, NNESTRR, NADVRR, NFRCRR, &
- NDIFRR, NRELRR, NNEGARR, NACCRRR, NAUTORR, NREVARR, NSEDIRR, &
- NSFRRR, NACCRR, NCFRZRR, NWETGRR, NDRYGRR, NGMLTRR, NWETHRR, &
- NHMLTRR, NDRYHRR, NCORRRR, NCMELRR,NHONRRR, NCORRRR, NR2C1RR, NCVRCRR
+NAMELIST/NAM_BU_RRR/LBU_RRR, CBULIST_RRR
!
-NAMELIST/NAM_BU_RRI/LBU_RRI, NASSERI, NNESTRI, NADVRI, NFRCRI, &
- NDIFRI, NRELRI, NDCONVRI, NHTURBRI, NVTURBRI, NNEGARI, NSEDIRI, &
- NHENURI, NHONRI, NAGGSRI, NAUTSRI, NCFRZRI, NWETGRI, NDRYGRI, &
- NIMLTRI, NBERFIRI, NCDEPIRI, NWETHRI, NDRYHRI, NADJURI, NCORRRI, &
- NHINDRI, NHINCRI, NHONHRI, NHONCRI, NCNVIRI, NCNVSRI, &
- NHMSRI, NHMGRI, NCEDSRI, NCORRRI
+NAMELIST/NAM_BU_RRI/LBU_RRI, CBULIST_RRI
!
-NAMELIST/NAM_BU_RRS/LBU_RRS, NASSERS, NNESTRS, NADVRS, NFRCRS, &
- NDIFRS, NRELRS, NNEGARS, NSEDIRS, NDEPSRS, NAGGSRS, NAUTSRS, &
- NRIMRS, NACCRS, NCMELRS, NWETGRS, NDRYGRS, NWETHRS, NDRYHRS, &
- NCORRRS, NCNVIRS, NCNVSRS, NHMSRS, NCORRRS
+NAMELIST/NAM_BU_RRS/LBU_RRS, CBULIST_RRS
!
-NAMELIST/NAM_BU_RRG/LBU_RRG, NASSERG, NNESTRG, NADVRG, NFRCRG, &
- NDIFRG, NRELRG, NNEGARG, NSEDIRG, NSFRRG, NDEPGRG, NRIMRG, NACCRG, &
- NCMELRG, NCFRZRG, NWETGRG, NDRYGRG, NGMLTRG, NWETHRG, &
- NDRYHRG, NCORRRG, NHGCVRG, NGHCVRG,NHONRRG, NHMGRG, NCOHGRG
+NAMELIST/NAM_BU_RRG/LBU_RRG, CBULIST_RRG
!
-NAMELIST/NAM_BU_RRH/LBU_RRH, NASSERH, NNESTRH, NADVRH, NFRCRH, &
- NDIFRH, NRELRH, NNEGARH, NSEDIRH, NWETGRH, NWETHRH, NDRYHRH, NHMLTRH, &
- NCORRRH, NHGCVRH, NGHCVRH, NCOHGRH, NHMLTRH
-!
-NAMELIST/NAM_BU_RSV/ LBU_RSV, NASSESV, NNESTSV, NADVSV, NFRCSV, &
- NDIFSV, NRELSV, NDCONVSV, NVTURBSV, NHTURBSV, NCHEMSV, NMAFLSV, &
- NNEGASV, &
- NAUTOQC, NACCRQC, NRIMQC, NWETGQC, NDRYGQC, NIMLTQC, NBERFIQC, &
- NDEPIQC, NINDQC, NSEDIQC, NNEUTQC, &
- NAUTOQR, NACCRQR, NREVAQR, NACCQR, NCFRZQR, NWETGQR, NDRYGQR, &
- NGMLTQR, NSEDIQR, NNEUTQR, &
- NAGGSQI, NAUTSQI, NCFRZQI, NWETGQI, NDRYGQI, NIMLTQI, NBERFIQI, &
- NDEPIQI, NNIISQI, NSEDIQI, NNEUTQI, &
- NDEPSQS, NAGGSQS, NAUTSQS, NRIMQS, NACCQS, NCMELQS, NWETGQS, &
- NDRYGQS, NNIISQS, NSEDIQS, NNEUTQS, &
- NDEPGQG, NRIMQG, NACCQG, NCMELQG, NCFRZQG, NWETGQG, NDRYGQG, &
- NGMLTQG, NINDQG, NSEDIQG, NNEUTQG, NDEPOTRSV
-! must add budget for hail
+NAMELIST/NAM_BU_RRH/LBU_RRH, CBULIST_RRH
+!
+NAMELIST/NAM_BU_RSV/ LBU_RSV, CBULIST_RSV
!
END MODULE MODN_BUDGET
diff --git a/src/MNH/modn_dragbldgn.f90 b/src/MNH/modn_dragbldgn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bf2a7c7458fb91bbd436c5a17c39e9e6b63e8dcc
--- /dev/null
+++ b/src/MNH/modn_dragbldgn.f90
@@ -0,0 +1,52 @@
+!MNH_LIC Copyright 2019-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODN_DRAGBLDG_n
+!! #####################
+!!
+!!*** *MODN_DRAGBLDG*
+!!
+!! PURPOSE
+!! -------
+! Namelist to take into account building drag in the atmospheric model
+! instead of SURFEX.
+!!
+!!** AUTHOR
+!! ------
+!! R.Schoetter *CNRM*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 09/2019
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!
+USE MODD_DRAGBLDG_n, ONLY : &
+ LDRAGBLDG_n => LDRAGBLDG
+!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+!
+LOGICAL, SAVE :: LDRAGBLDG
+!
+NAMELIST /NAM_DRAGBLDGn/LDRAGBLDG
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_DRAGBLDGn
+ LDRAGBLDG = LDRAGBLDG_n
+END SUBROUTINE INIT_NAM_DRAGBLDGn
+!
+SUBROUTINE UPDATE_NAM_DRAGBLDGn
+ LDRAGBLDG_n = LDRAGBLDG
+END SUBROUTINE UPDATE_NAM_DRAGBLDGn
+!
+END MODULE MODN_DRAGBLDG_n
diff --git a/src/MNH/modn_dragtreen.f90 b/src/MNH/modn_dragtreen.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6f9fe1af4098ea854d6eff9adc735d1a9c8eca86
--- /dev/null
+++ b/src/MNH/modn_dragtreen.f90
@@ -0,0 +1,62 @@
+!MNH_LIC Copyright 2011-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODN_DRAGTREE_n
+!! #####################
+!!
+!!*** *MODN_DRAGTREE*
+!!
+!! PURPOSE
+!! -------
+! Namelist to take into account tree drag in the atmospheric model
+! instead of SURFEX.
+!!
+!!** AUTHOR
+!! ------
+!! C.Lac *CNRM*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 30/06/11
+!!
+!! 10/2016 : (C.Lac) Add droplet deposition on trees
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!
+USE MODD_DRAGTREE_n, ONLY : &
+ LDRAGTREE_n => LDRAGTREE, &
+ LDEPOTREE_n => LDEPOTREE, &
+ XVDEPOTREE_n => XVDEPOTREE
+!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+!
+LOGICAL, SAVE :: LDRAGTREE
+LOGICAL, SAVE :: LDEPOTREE
+REAL, SAVE :: XVDEPOTREE
+!
+NAMELIST /NAM_DRAGTREEn/LDRAGTREE,LDEPOTREE,XVDEPOTREE
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_DRAGTREEn
+ LDRAGTREE = LDRAGTREE_n
+ LDEPOTREE = LDEPOTREE_n
+ XVDEPOTREE = XVDEPOTREE_n
+END SUBROUTINE INIT_NAM_DRAGTREEn
+!
+SUBROUTINE UPDATE_NAM_DRAGTREEn
+ LDRAGTREE_n = LDRAGTREE
+ LDEPOTREE_n = LDEPOTREE
+ XVDEPOTREE_n = XVDEPOTREE
+END SUBROUTINE UPDATE_NAM_DRAGTREEn
+!
+END MODULE MODN_DRAGTREE_n
diff --git a/src/MNH/modn_dynn.f90 b/src/MNH/modn_dynn.f90
index 0f6585f99f5adf5dd4cd7466946cd2b1cd1a2711..b943d5202086aedabbdb4adbbc9a0f0e22134bba 100644
--- a/src/MNH/modn_dynn.f90
+++ b/src/MNH/modn_dynn.f90
@@ -1,9 +1,7 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
-! $Source$ $Revision$ $Date$
-!-----------------------------------------------------------------
!-----------------------------------------------------------------
! #################
MODULE MODN_DYN_n
@@ -55,6 +53,7 @@
!! Modifications 09/06/11 (Barthe) add LHORELAX_SVELEC in namelist
!! Modifications 15/06/11 (Lac) add LHORELAX for conditional sampling
!! Modifications 12/02/12 (Pialat/Tulet) add LHORELAX_SVFF for ForeFire scalar variables
+!! Modification 03/2021 (JL Redelsperger) add logical LOCEAN for ocean LES version
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -62,6 +61,7 @@
!
USE MODD_PARAMETERS, ONLY : JPSVMAX
USE MODD_DYN_n, ONLY : &
+ LOCEAN_n => LOCEAN, &
XTSTEP_n => XTSTEP, &
CPRESOPT_n => CPRESOPT, &
NITR_n => NITR, &
@@ -109,7 +109,8 @@ REAL ,SAVE :: XTSTEP
CHARACTER(LEN=5),SAVE :: CPRESOPT
INTEGER ,SAVE :: NITR
LOGICAL ,SAVE :: LITRADJ
-LOGICAL ,SAVE :: LRES
+LOGICAL ,SAVE :: LRES
+LOGICAL ,SAVE :: LOCEAN
REAL ,SAVE :: XRES
REAL ,SAVE :: XRELAX
LOGICAL, SAVE :: LHORELAX_UVWTH
@@ -156,12 +157,14 @@ NAMELIST/NAM_DYNn/XTSTEP,CPRESOPT,NITR,LITRADJ,LRES,XRES,XRELAX,LHORELAX_UVWTH,
#ifdef MNH_FOREFIRE
LHORELAX_SVFF, &
#endif
+ LOCEAN,&
NRIMX,NRIMY,XRIMKMAX,XT4DIFU, &
XT4DIFTH,XT4DIFSV
!
CONTAINS
!
SUBROUTINE INIT_NAM_DYNn
+ LOCEAN = LOCEAN_n
XTSTEP = XTSTEP_n
CPRESOPT = CPRESOPT_n
NITR = NITR_n
@@ -205,6 +208,7 @@ SUBROUTINE INIT_NAM_DYNn
END SUBROUTINE INIT_NAM_DYNn
SUBROUTINE UPDATE_NAM_DYNn
+ LOCEAN_n = LOCEAN
XTSTEP_n = XTSTEP
CPRESOPT_n = CPRESOPT
NITR_n = NITR
diff --git a/src/MNH/modn_dragtree.f90 b/src/MNH/modn_eol.f90
similarity index 50%
rename from src/MNH/modn_dragtree.f90
rename to src/MNH/modn_eol.f90
index 58703b7a9474db24073b6248cd2d714eef0ffe21..c232ce3baf7cedf3a0e8fffa4204b7a46a8a3dca 100644
--- a/src/MNH/modn_dragtree.f90
+++ b/src/MNH/modn_eol.f90
@@ -1,31 +1,32 @@
-!MNH_LIC Copyright 1994-2014 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_DRAGTREE
+ MODULE MODN_EOL
!! #####################
!!
-!!*** *MODN_DRAGTREE*
+!!*** *MODN_EOL*
!!
!! PURPOSE
!! -------
-! Namelist to take into account tree drag in the atmospheric model
-! instead of SURFEX.
+!! NAM_EOL activate the parameterization of wind turbines, and allows
+!! the selection of the aerodynamic method.
!!
!!** AUTHOR
!! ------
-!! C.Lac *CNRM*
+!! PA. Joulin *CNRM & IFPEN*
!
!! MODIFICATIONS
!! -------------
-!! Original 30/06/11
+!! Original 24/01/17
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
!!
-!! 10/2016 : (C.Lac) Add droplet deposition on trees
!! IMPLICIT ARGUMENTS
!! ------------------
-USE MODD_DRAGTREE
+USE MODD_EOL_MAIN
!!
!-----------------------------------------------------------------------------
!
@@ -33,8 +34,7 @@ USE MODD_DRAGTREE
! -----------------
IMPLICIT NONE
SAVE
-NAMELIST /NAM_DRAGTREE/ &
- LDRAGTREE,LDEPOTREE,XVDEPOTREE
-
+NAMELIST /NAM_EOL/ &
+ LMAIN_EOL,CMETH_EOL,CSMEAR,NMODEL_EOL
!
-END MODULE MODN_DRAGTREE
+END MODULE MODN_EOL
diff --git a/src/MNH/modn_eol_adnr.f90 b/src/MNH/modn_eol_adnr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3e3c77cec046bd2bf1754362f815d0b06df362d4
--- /dev/null
+++ b/src/MNH/modn_eol_adnr.f90
@@ -0,0 +1,44 @@
+!MNH_LIC Copyright 2016-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODN_EOL_ADNR
+!! #####################
+!!
+!!*** *MODN_EOL_ADNR*
+!!
+!! PURPOSE
+!! -------
+!! NAM_EOL activate the parameterization of wind turbines, and several
+!! models are available. One of the models is the Non-Rotating Actuator
+!! Disk Non Rotating (ADNR).
+!! The aim of NAM_EOL_ADNR is to specify ADNR parameters.
+!!
+!!** AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 04/16
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+USE MODD_EOL_ADNR
+USE MODD_EOL_SHARED_IO
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+SAVE
+NAMELIST /NAM_EOL_ADNR/ &
+ CFARM_CSVDATA, CTURBINE_CSVDATA, &
+ CINTERP
+!
+END MODULE MODN_EOL_ADNR
diff --git a/src/MNH/modn_eol_alm.f90 b/src/MNH/modn_eol_alm.f90
new file mode 100644
index 0000000000000000000000000000000000000000..54f7a389bda529ce0ea80fac0fd6ff62124d4b18
--- /dev/null
+++ b/src/MNH/modn_eol_alm.f90
@@ -0,0 +1,46 @@
+!MNH_LIC Copyright 2017-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODN_EOL_ALM
+!! #####################
+!!
+!!*** *MODN_EOL_ALM*
+!!
+!! PURPOSE
+!! -------
+!! NAM_EOL activate the parameterization of wind turbines, and several
+!! models are available. One of the models is the Actuator Line
+!! Method (ALM).
+!! The aim of NAM_EOL_ALM is to specify ALM parameters.
+!!
+!!** AUTHOR
+!! ------
+!! PA. Joulin *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/01/17
+!! Modification 14/10/20 (PA. Joulin) Updated for a main version
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+USE MODD_EOL_ALM
+USE MODD_EOL_SHARED_IO
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+SAVE
+NAMELIST /NAM_EOL_ALM/ &
+ CFARM_CSVDATA, CTURBINE_CSVDATA, CBLADE_CSVDATA, CAIRFOIL_CSVDATA, &
+ NNB_BLAELT, &
+ CINTERP, LTIMESPLIT, LTIPLOSSG, &
+ LTECOUTPTS
+!
+END MODULE MODN_EOL_ALM
diff --git a/src/MNH/modn_frc.f90 b/src/MNH/modn_frc.f90
index 685ee4f243d5c526fed26540b16b1cabf6259430..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,12 +56,18 @@ 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 , &
LTRANS , &
XUTRANS , &
XVTRANS , &
- LPGROUND_FRC
+ LPGROUND_FRC ,&
+ LDEEPOC ,&
+ XCENTX_OC ,&
+ XCENTY_OC ,&
+ XRADX_OC ,&
+ XRADY_OC
!
END MODULE MODN_FRC
diff --git a/src/MNH/modn_ibm_paramn.f90 b/src/MNH/modn_ibm_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a17e89362b9ae1945f9f5a7670ab7f7af82e9b28
--- /dev/null
+++ b/src/MNH/modn_ibm_paramn.f90
@@ -0,0 +1,374 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+ MODULE MODN_IBM_PARAM_n
+! #######################
+!
+!**** *MODN_IBM_PARAM$n* - declaration of namelist NAM_IBM_PARAMn
+!
+! PURPOSE
+! -------
+!**** The purpose of this declarative module is to declare the constants
+! which allow to initialize the embedded surface
+!
+!
+! IMPLICIT ARGUMENTS
+! ------------------
+! Module MODD_IBM_PARAM$n : contains declaration of IBM parameters
+!
+!
+! REFERENCE
+! ---------
+!
+! AUTHOR
+! ------
+! Franck Auguste (CERFACS-AE)
+!
+! MODIFICATIONS
+! -------------
+! Original 01/01/2019
+!
+USE MODD_IBM_PARAM_n, ONLY: &
+ LIBM_n => LIBM, &
+ NIBM_ITR_n => NIBM_ITR, &
+ CIBM_ADV_n => CIBM_ADV, &
+ LIBM_TROUBLE_n => LIBM_TROUBLE, &
+ XIBM_EPSI_n => XIBM_EPSI, &
+ XIBM_IEPS_n => XIBM_IEPS, &
+ XIBM_RUG_n => XIBM_RUG, &
+ XIBM_VISC_n => XIBM_VISC, &
+ XIBM_CNU_n => XIBM_CNU, &
+
+ NIBM_LAYER_P_n => NIBM_LAYER_P ,&
+ XIBM_RADIUS_P_n => XIBM_RADIUS_P ,&
+ XIBM_POWERS_P_n => XIBM_POWERS_P ,&
+ CIBM_MODE_INTE1_P_n => CIBM_MODE_INTE1_P ,&
+ CIBM_MODE_INTE3_P_n => CIBM_MODE_INTE3_P ,&
+ CIBM_MODE_BOUND_P_n => CIBM_MODE_BOUND_P ,&
+ CIBM_TYPE_BOUND_P_n => CIBM_TYPE_BOUND_P ,&
+ CIBM_FORC_BOUND_P_n => CIBM_FORC_BOUND_P ,&
+ XIBM_FORC_BOUND_P_n => XIBM_FORC_BOUND_P ,&
+
+ NIBM_LAYER_Q_n => NIBM_LAYER_Q ,&
+ XIBM_RADIUS_Q_n => XIBM_RADIUS_Q ,&
+ XIBM_POWERS_Q_n => XIBM_POWERS_Q ,&
+ CIBM_MODE_INTE1_Q_n => CIBM_MODE_INTE1_Q ,&
+ CIBM_MODE_INTE3_Q_n => CIBM_MODE_INTE3_Q ,&
+ CIBM_MODE_BOUND_Q_n => CIBM_MODE_BOUND_Q ,&
+ CIBM_TYPE_BOUND_Q_n => CIBM_TYPE_BOUND_Q ,&
+ CIBM_FORC_BOUND_Q_n => CIBM_FORC_BOUND_Q ,&
+ XIBM_FORC_BOUND_Q_n => XIBM_FORC_BOUND_Q ,&
+
+ NIBM_LAYER_R_n => NIBM_LAYER_R ,&
+ XIBM_RADIUS_R_n => XIBM_RADIUS_R ,&
+ XIBM_POWERS_R_n => XIBM_POWERS_R ,&
+ CIBM_MODE_INTE1_R_n => CIBM_MODE_INTE1_R ,&
+ CIBM_MODE_INTE3_R_n => CIBM_MODE_INTE3_R ,&
+ CIBM_MODE_BOUND_R_n => CIBM_MODE_BOUND_R ,&
+ CIBM_TYPE_BOUND_R_n => CIBM_TYPE_BOUND_R ,&
+ CIBM_FORC_BOUND_R_n => CIBM_FORC_BOUND_R ,&
+ XIBM_FORC_BOUND_R_n => XIBM_FORC_BOUND_R ,&
+
+ NIBM_LAYER_S_n => NIBM_LAYER_S ,&
+ XIBM_RADIUS_S_n => XIBM_RADIUS_S ,&
+ XIBM_POWERS_S_n => XIBM_POWERS_S ,&
+ CIBM_MODE_INTE1_S_n => CIBM_MODE_INTE1_S ,&
+ CIBM_MODE_INTE3_S_n => CIBM_MODE_INTE3_S ,&
+ CIBM_MODE_BOUND_S_n => CIBM_MODE_BOUND_S ,&
+ CIBM_TYPE_BOUND_S_n => CIBM_TYPE_BOUND_S ,&
+ CIBM_FORC_BOUND_S_n => CIBM_FORC_BOUND_S ,&
+ XIBM_FORC_BOUND_S_n => XIBM_FORC_BOUND_S ,&
+
+ NIBM_LAYER_T_n => NIBM_LAYER_T ,&
+ XIBM_RADIUS_T_n => XIBM_RADIUS_T ,&
+ XIBM_POWERS_T_n => XIBM_POWERS_T ,&
+ CIBM_MODE_INTE1_T_n => CIBM_MODE_INTE1_T ,&
+ CIBM_MODE_INTE3_T_n => CIBM_MODE_INTE3_T ,&
+ CIBM_MODE_BOUND_T_n => CIBM_MODE_BOUND_T ,&
+ CIBM_TYPE_BOUND_T_n => CIBM_TYPE_BOUND_T ,&
+ CIBM_FORC_BOUND_T_n => CIBM_FORC_BOUND_T ,&
+ XIBM_FORC_BOUND_T_n => XIBM_FORC_BOUND_T ,&
+
+ NIBM_LAYER_E_n => NIBM_LAYER_E ,&
+ XIBM_RADIUS_E_n => XIBM_RADIUS_E ,&
+ XIBM_POWERS_E_n => XIBM_POWERS_E ,&
+ CIBM_MODE_INTE1_E_n => CIBM_MODE_INTE1_E ,&
+ CIBM_MODE_INTE3_E_n => CIBM_MODE_INTE3_E ,&
+ CIBM_MODE_BOUND_E_n => CIBM_MODE_BOUND_E ,&
+ CIBM_TYPE_BOUND_E_n => CIBM_TYPE_BOUND_E ,&
+ CIBM_FORC_BOUND_E_n => CIBM_FORC_BOUND_E ,&
+ XIBM_FORC_BOUND_E_n => XIBM_FORC_BOUND_E ,&
+
+ NIBM_LAYER_V_n => NIBM_LAYER_V ,&
+ XIBM_RADIUS_V_n => XIBM_RADIUS_V ,&
+ XIBM_POWERS_V_n => XIBM_POWERS_V ,&
+ CIBM_MODE_INTE1NV_n => CIBM_MODE_INTE1NV ,&
+ CIBM_MODE_INTE1TV_n => CIBM_MODE_INTE1TV ,&
+ CIBM_MODE_INTE1CV_n => CIBM_MODE_INTE1CV ,&
+ CIBM_MODE_INTE3_V_n => CIBM_MODE_INTE3_V ,&
+ CIBM_MODE_BOUNN_V_n => CIBM_MODE_BOUNN_V ,&
+ CIBM_TYPE_BOUNN_V_n => CIBM_TYPE_BOUNN_V ,&
+ CIBM_MODE_BOUNT_V_n => CIBM_MODE_BOUNT_V ,&
+ CIBM_TYPE_BOUNT_V_n => CIBM_TYPE_BOUNT_V ,&
+ CIBM_MODE_BOUNC_V_n => CIBM_MODE_BOUNC_V ,&
+ CIBM_TYPE_BOUNC_V_n => CIBM_TYPE_BOUNC_V ,&
+ CIBM_FORC_BOUNN_V_n => CIBM_FORC_BOUNN_V ,&
+ CIBM_FORC_BOUNR_V_n => CIBM_FORC_BOUNR_V ,&
+ CIBM_FORC_BOUNT_V_n => CIBM_FORC_BOUNT_V ,&
+ CIBM_FORC_BOUNC_V_n => CIBM_FORC_BOUNC_V ,&
+ XIBM_FORC_BOUNN_V_n => XIBM_FORC_BOUNN_V ,&
+ XIBM_FORC_BOUNT_V_n => XIBM_FORC_BOUNT_V ,&
+ XIBM_FORC_BOUNC_V_n => XIBM_FORC_BOUNC_V
+!
+IMPLICIT NONE
+!
+LOGICAL,SAVE :: LIBM,LIBM_TROUBLE
+REAL,SAVE :: XIBM_EPSI
+REAL,SAVE :: XIBM_IEPS
+REAL,SAVE :: XIBM_RUG,XIBM_VISC,XIBM_CNU
+INTEGER,SAVE :: NIBM_ITR
+INTEGER,SAVE :: NIBM_LAYER_P,NIBM_LAYER_Q,NIBM_LAYER_R,NIBM_LAYER_S,NIBM_LAYER_T,NIBM_LAYER_E,NIBM_LAYER_V
+CHARACTER (LEN=6),SAVE :: CIBM_ADV
+CHARACTER (LEN=3),SAVE :: CIBM_MODE_INTE1_P,CIBM_MODE_INTE1_Q,CIBM_MODE_INTE1_R,CIBM_MODE_INTE1_S,&
+ CIBM_MODE_INTE1_T,CIBM_MODE_INTE1_E,&
+ CIBM_MODE_INTE1NV,CIBM_MODE_INTE1TV,CIBM_MODE_INTE1CV,&
+ CIBM_MODE_INTE3_P,CIBM_MODE_INTE3_Q,CIBM_MODE_INTE3_R,CIBM_MODE_INTE3_S,&
+ CIBM_MODE_INTE3_T,CIBM_MODE_INTE3_E,CIBM_MODE_INTE3_V
+CHARACTER (LEN=3),SAVE :: CIBM_MODE_BOUND_P,CIBM_MODE_BOUND_Q,CIBM_MODE_BOUND_R,CIBM_MODE_BOUND_S,&
+ CIBM_MODE_BOUND_T,CIBM_MODE_BOUND_E,&
+ CIBM_TYPE_BOUND_P,CIBM_TYPE_BOUND_Q,CIBM_TYPE_BOUND_R,CIBM_TYPE_BOUND_S,&
+ CIBM_TYPE_BOUND_T,CIBM_TYPE_BOUND_E,&
+ CIBM_FORC_BOUND_P,CIBM_FORC_BOUND_Q,CIBM_FORC_BOUND_R,CIBM_FORC_BOUND_S,&
+ CIBM_FORC_BOUND_T,CIBM_FORC_BOUND_E,&
+ CIBM_MODE_BOUNN_V,CIBM_MODE_BOUNT_V,CIBM_MODE_BOUNC_V,&
+ CIBM_TYPE_BOUNN_V,CIBM_TYPE_BOUNT_V,CIBM_TYPE_BOUNC_V,&
+ CIBM_FORC_BOUNN_V,CIBM_FORC_BOUNT_V,CIBM_FORC_BOUNC_V,CIBM_FORC_BOUNR_V
+REAL,SAVE :: XIBM_FORC_BOUNN_V,XIBM_FORC_BOUNT_V,XIBM_FORC_BOUNC_V,&
+ XIBM_FORC_BOUND_P,XIBM_FORC_BOUND_Q,XIBM_FORC_BOUND_R,XIBM_FORC_BOUND_S,&
+ XIBM_FORC_BOUND_T,XIBM_FORC_BOUND_E
+REAL,SAVE :: XIBM_RADIUS_P,XIBM_RADIUS_Q,XIBM_RADIUS_R,XIBM_RADIUS_S,&
+ XIBM_RADIUS_T,XIBM_RADIUS_E,XIBM_RADIUS_V,&
+ XIBM_POWERS_P,XIBM_POWERS_Q,XIBM_POWERS_R,XIBM_POWERS_S,&
+ XIBM_POWERS_T,XIBM_POWERS_E,XIBM_POWERS_V
+!
+NAMELIST /NAM_IBM_PARAMn/ LIBM, LIBM_TROUBLE, CIBM_ADV, NIBM_ITR, &
+ XIBM_VISC, XIBM_EPSI, XIBM_IEPS, XIBM_RUG, XIBM_CNU, &
+ NIBM_LAYER_P,NIBM_LAYER_Q,NIBM_LAYER_R,NIBM_LAYER_S,&
+ NIBM_LAYER_T,NIBM_LAYER_E,NIBM_LAYER_V,&
+ CIBM_MODE_INTE1_P,CIBM_MODE_INTE1_Q,CIBM_MODE_INTE1_R,CIBM_MODE_INTE1_S,&
+ CIBM_MODE_INTE1_T,CIBM_MODE_INTE1_E,&
+ CIBM_MODE_INTE1NV,CIBM_MODE_INTE1TV,CIBM_MODE_INTE1CV,&
+ CIBM_MODE_INTE3_P,CIBM_MODE_INTE3_Q,CIBM_MODE_INTE3_R,CIBM_MODE_INTE3_S,&
+ CIBM_MODE_INTE3_T,CIBM_MODE_INTE3_E,CIBM_MODE_INTE3_V,&
+ CIBM_MODE_BOUND_P,CIBM_MODE_BOUND_Q,CIBM_MODE_BOUND_R,CIBM_MODE_BOUND_S,&
+ CIBM_MODE_BOUND_T,CIBM_MODE_BOUND_E,&
+ CIBM_TYPE_BOUND_P,CIBM_TYPE_BOUND_Q,CIBM_TYPE_BOUND_R,CIBM_TYPE_BOUND_S,&
+ CIBM_TYPE_BOUND_T,CIBM_TYPE_BOUND_E,&
+ CIBM_FORC_BOUND_P,CIBM_FORC_BOUND_Q,CIBM_FORC_BOUND_R,CIBM_FORC_BOUND_S,&
+ CIBM_FORC_BOUND_T,CIBM_FORC_BOUND_E,&
+ XIBM_FORC_BOUND_P,XIBM_FORC_BOUND_Q,XIBM_FORC_BOUND_R,XIBM_FORC_BOUND_S,&
+ XIBM_FORC_BOUND_T,XIBM_FORC_BOUND_E,&
+ CIBM_MODE_BOUNN_V,CIBM_MODE_BOUNT_V,CIBM_MODE_BOUNC_V,&
+ CIBM_TYPE_BOUNN_V,CIBM_TYPE_BOUNT_V,CIBM_TYPE_BOUNC_V,&
+ CIBM_FORC_BOUNN_V,CIBM_FORC_BOUNT_V,CIBM_FORC_BOUNC_V,CIBM_FORC_BOUNR_V,&
+ XIBM_FORC_BOUNN_V,XIBM_FORC_BOUNT_V,XIBM_FORC_BOUNC_V,&
+ XIBM_RADIUS_P,XIBM_RADIUS_Q,XIBM_RADIUS_R,XIBM_RADIUS_S,&
+ XIBM_RADIUS_T,XIBM_RADIUS_E,XIBM_RADIUS_V,&
+ XIBM_POWERS_P,XIBM_POWERS_Q,XIBM_POWERS_R,XIBM_POWERS_S,&
+ XIBM_POWERS_T,XIBM_POWERS_E,XIBM_POWERS_V
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_IBM_PARAMn
+ LIBM = LIBM_n
+ CIBM_ADV = CIBM_ADV_n
+ NIBM_ITR = NIBM_ITR_n
+ LIBM_TROUBLE = LIBM_TROUBLE_n
+ XIBM_EPSI = XIBM_EPSI_n
+ XIBM_IEPS = XIBM_IEPS_n
+ XIBM_RUG = XIBM_RUG_n
+ XIBM_VISC = XIBM_VISC_n
+ XIBM_CNU = XIBM_CNU_n
+
+ NIBM_LAYER_P = NIBM_LAYER_P_n
+ XIBM_RADIUS_P = XIBM_RADIUS_P_n
+ XIBM_POWERS_P = XIBM_POWERS_P_n
+ CIBM_MODE_INTE1_P = CIBM_MODE_INTE1_P_n
+ CIBM_MODE_INTE3_P = CIBM_MODE_INTE3_P_n
+ CIBM_MODE_BOUND_P = CIBM_MODE_BOUND_P_n
+ CIBM_TYPE_BOUND_P = CIBM_TYPE_BOUND_P_n
+ CIBM_FORC_BOUND_P = CIBM_FORC_BOUND_P_n
+ XIBM_FORC_BOUND_P = XIBM_FORC_BOUND_P_n
+
+ NIBM_LAYER_Q = NIBM_LAYER_Q_n
+ XIBM_RADIUS_Q = XIBM_RADIUS_Q_n
+ XIBM_POWERS_Q = XIBM_POWERS_Q_n
+ CIBM_MODE_INTE1_Q = CIBM_MODE_INTE1_Q_n
+ CIBM_MODE_INTE3_Q = CIBM_MODE_INTE3_Q_n
+ CIBM_MODE_BOUND_Q = CIBM_MODE_BOUND_Q_n
+ CIBM_TYPE_BOUND_Q = CIBM_TYPE_BOUND_Q_n
+ CIBM_FORC_BOUND_Q = CIBM_FORC_BOUND_Q_n
+ XIBM_FORC_BOUND_Q = XIBM_FORC_BOUND_Q_n
+
+ NIBM_LAYER_R = NIBM_LAYER_R_n
+ XIBM_RADIUS_R = XIBM_RADIUS_R_n
+ XIBM_POWERS_R = XIBM_POWERS_R_n
+ CIBM_MODE_INTE1_R = CIBM_MODE_INTE1_R_n
+ CIBM_MODE_INTE3_R = CIBM_MODE_INTE3_R_n
+ CIBM_MODE_BOUND_R = CIBM_MODE_BOUND_R_n
+ CIBM_TYPE_BOUND_R = CIBM_TYPE_BOUND_R_n
+ CIBM_FORC_BOUND_R = CIBM_FORC_BOUND_R_n
+ XIBM_FORC_BOUND_R = XIBM_FORC_BOUND_R_n
+
+ NIBM_LAYER_S = NIBM_LAYER_S_n
+ XIBM_RADIUS_S = XIBM_RADIUS_S_n
+ XIBM_POWERS_S = XIBM_POWERS_S_n
+ CIBM_MODE_INTE1_S = CIBM_MODE_INTE1_S_n
+ CIBM_MODE_INTE3_S = CIBM_MODE_INTE3_S_n
+ CIBM_MODE_BOUND_S = CIBM_MODE_BOUND_S_n
+ CIBM_TYPE_BOUND_S = CIBM_TYPE_BOUND_S_n
+ CIBM_FORC_BOUND_S = CIBM_FORC_BOUND_S_n
+ XIBM_FORC_BOUND_S = XIBM_FORC_BOUND_S_n
+
+ NIBM_LAYER_T = NIBM_LAYER_T_n
+ XIBM_RADIUS_T = XIBM_RADIUS_T_n
+ XIBM_POWERS_T = XIBM_POWERS_T_n
+ CIBM_MODE_INTE1_T = CIBM_MODE_INTE1_T_n
+ CIBM_MODE_INTE3_T = CIBM_MODE_INTE3_T_n
+ CIBM_MODE_BOUND_T = CIBM_MODE_BOUND_T_n
+ CIBM_TYPE_BOUND_T = CIBM_TYPE_BOUND_T_n
+ CIBM_FORC_BOUND_T = CIBM_FORC_BOUND_T_n
+ XIBM_FORC_BOUND_T = XIBM_FORC_BOUND_T_n
+
+ NIBM_LAYER_E = NIBM_LAYER_E_n
+ XIBM_RADIUS_E = XIBM_RADIUS_E_n
+ XIBM_POWERS_E = XIBM_POWERS_E_n
+ CIBM_MODE_INTE1_E = CIBM_MODE_INTE1_E_n
+ CIBM_MODE_INTE3_E = CIBM_MODE_INTE3_E_n
+ CIBM_MODE_BOUND_E = CIBM_MODE_BOUND_E_n
+ CIBM_TYPE_BOUND_E = CIBM_TYPE_BOUND_E_n
+ CIBM_FORC_BOUND_E = CIBM_FORC_BOUND_E_n
+ XIBM_FORC_BOUND_E = XIBM_FORC_BOUND_E_n
+
+ NIBM_LAYER_V = NIBM_LAYER_V_n
+ XIBM_RADIUS_V = XIBM_RADIUS_V_n
+ XIBM_POWERS_V = XIBM_POWERS_V_n
+ CIBM_MODE_INTE1NV = CIBM_MODE_INTE1NV_n
+ CIBM_MODE_INTE1TV = CIBM_MODE_INTE1TV_n
+ CIBM_MODE_INTE1CV = CIBM_MODE_INTE1CV_n
+ CIBM_MODE_INTE3_V = CIBM_MODE_INTE3_V_n
+ CIBM_MODE_BOUNN_V = CIBM_MODE_BOUNN_V_n
+ CIBM_TYPE_BOUNN_V = CIBM_TYPE_BOUNN_V_n
+ CIBM_MODE_BOUNT_V = CIBM_MODE_BOUNT_V_n
+ CIBM_TYPE_BOUNT_V = CIBM_TYPE_BOUNT_V_n
+ CIBM_MODE_BOUNC_V = CIBM_MODE_BOUNC_V_n
+ CIBM_TYPE_BOUNC_V = CIBM_TYPE_BOUNC_V_n
+ CIBM_FORC_BOUNN_V = CIBM_FORC_BOUNN_V_n
+ CIBM_FORC_BOUNR_V = CIBM_FORC_BOUNR_V_n
+ CIBM_FORC_BOUNT_V = CIBM_FORC_BOUNT_V_n
+ CIBM_FORC_BOUNC_v = CIBM_FORC_BOUNC_V_n
+ XIBM_FORC_BOUNN_V = XIBM_FORC_BOUNN_V_n
+ XIBM_FORC_BOUNT_V = XIBM_FORC_BOUNT_V_n
+ XIBM_FORC_BOUNC_v = XIBM_FORC_BOUNC_V_n
+
+END SUBROUTINE INIT_NAM_IBM_PARAMn
+
+SUBROUTINE UPDATE_NAM_IBM_PARAMn
+ LIBM_n = LIBM
+ CIBM_ADV_n = CIBM_ADV
+ NIBM_ITR_n = NIBM_ITR
+ LIBM_TROUBLE_n = LIBM_TROUBLE
+ XIBM_EPSI_n = XIBM_EPSI
+ XIBM_IEPS_n = XIBM_IEPS
+ XIBM_RUG_n = XIBM_RUG
+ XIBM_VISC_n = XIBM_VISC
+ XIBM_CNU_n = XIBM_CNU
+
+ NIBM_LAYER_P_n = NIBM_LAYER_P
+ XIBM_RADIUS_P_n = XIBM_RADIUS_P
+ XIBM_POWERS_P_n = XIBM_POWERS_P
+ CIBM_MODE_INTE1_P_n = CIBM_MODE_INTE1_P
+ CIBM_MODE_INTE3_P_n = CIBM_MODE_INTE3_P
+ CIBM_MODE_BOUND_P_n = CIBM_MODE_BOUND_P
+ CIBM_TYPE_BOUND_P_n = CIBM_TYPE_BOUND_P
+ CIBM_FORC_BOUND_P_n = CIBM_FORC_BOUND_P
+ XIBM_FORC_BOUND_P_n = XIBM_FORC_BOUND_P
+
+ NIBM_LAYER_Q_n = NIBM_LAYER_Q
+ XIBM_RADIUS_Q_n = XIBM_RADIUS_Q
+ XIBM_POWERS_Q_n = XIBM_POWERS_Q
+ CIBM_MODE_INTE1_Q_n = CIBM_MODE_INTE1_Q
+ CIBM_MODE_INTE3_Q_n = CIBM_MODE_INTE3_Q
+ CIBM_MODE_BOUND_Q_n = CIBM_MODE_BOUND_Q
+ CIBM_TYPE_BOUND_Q_n = CIBM_TYPE_BOUND_Q
+ CIBM_FORC_BOUND_Q_n = CIBM_FORC_BOUND_Q
+ XIBM_FORC_BOUND_Q_n = XIBM_FORC_BOUND_Q
+
+ NIBM_LAYER_R_n = NIBM_LAYER_R
+ XIBM_RADIUS_R_n = XIBM_RADIUS_R
+ XIBM_POWERS_R_n = XIBM_POWERS_R
+ CIBM_MODE_INTE1_R_n = CIBM_MODE_INTE1_R
+ CIBM_MODE_INTE3_R_n = CIBM_MODE_INTE3_R
+ CIBM_MODE_BOUND_R_n = CIBM_MODE_BOUND_R
+ CIBM_TYPE_BOUND_R_n = CIBM_TYPE_BOUND_R
+ CIBM_FORC_BOUND_R_n = CIBM_FORC_BOUND_R
+ XIBM_FORC_BOUND_R_n = XIBM_FORC_BOUND_R
+
+ NIBM_LAYER_S_n = NIBM_LAYER_S
+ XIBM_RADIUS_S_n = XIBM_RADIUS_S
+ XIBM_POWERS_S_n = XIBM_POWERS_S
+ CIBM_MODE_INTE1_S_n = CIBM_MODE_INTE1_S
+ CIBM_MODE_INTE3_S_n = CIBM_MODE_INTE3_S
+ CIBM_MODE_BOUND_S_n = CIBM_MODE_BOUND_S
+ CIBM_TYPE_BOUND_S_n = CIBM_TYPE_BOUND_S
+ CIBM_FORC_BOUND_S_n = CIBM_FORC_BOUND_S
+ XIBM_FORC_BOUND_S_n = XIBM_FORC_BOUND_S
+
+ NIBM_LAYER_T_n = NIBM_LAYER_T
+ XIBM_RADIUS_T_n = XIBM_RADIUS_T
+ XIBM_POWERS_T_n = XIBM_POWERS_T
+ CIBM_MODE_INTE1_T_n = CIBM_MODE_INTE1_T
+ CIBM_MODE_INTE3_T_n = CIBM_MODE_INTE3_T
+ CIBM_MODE_BOUND_T_n = CIBM_MODE_BOUND_T
+ CIBM_TYPE_BOUND_T_n = CIBM_TYPE_BOUND_T
+ CIBM_FORC_BOUND_T_n = CIBM_FORC_BOUND_T
+ XIBM_FORC_BOUND_T_n = XIBM_FORC_BOUND_T
+
+ NIBM_LAYER_E_n = NIBM_LAYER_E
+ XIBM_RADIUS_E_n = XIBM_RADIUS_E
+ XIBM_POWERS_E_n = XIBM_POWERS_E
+ CIBM_MODE_INTE1_E_n = CIBM_MODE_INTE1_E
+ CIBM_MODE_INTE3_E_n = CIBM_MODE_INTE3_E
+ CIBM_MODE_BOUND_E_n = CIBM_MODE_BOUND_E
+ CIBM_TYPE_BOUND_E_n = CIBM_TYPE_BOUND_E
+ CIBM_FORC_BOUND_E_n = CIBM_FORC_BOUND_E
+ XIBM_FORC_BOUND_E_n = XIBM_FORC_BOUND_E
+
+ NIBM_LAYER_V_n = NIBM_LAYER_V
+ XIBM_RADIUS_V_n = XIBM_RADIUS_V
+ XIBM_POWERS_V_n = XIBM_POWERS_V
+ CIBM_MODE_INTE1NV_n = CIBM_MODE_INTE1NV
+ CIBM_MODE_INTE1TV_n = CIBM_MODE_INTE1TV
+ CIBM_MODE_INTE1CV_n = CIBM_MODE_INTE1CV
+ CIBM_MODE_INTE3_V_n = CIBM_MODE_INTE3_V
+ CIBM_MODE_BOUNN_V_n = CIBM_MODE_BOUNN_V
+ CIBM_TYPE_BOUNN_V_n = CIBM_TYPE_BOUNN_V
+ CIBM_MODE_BOUNT_V_n = CIBM_MODE_BOUNT_V
+ CIBM_TYPE_BOUNT_V_n = CIBM_TYPE_BOUNT_V
+ CIBM_MODE_BOUNC_V_n = CIBM_MODE_BOUNC_V
+ CIBM_TYPE_BOUNC_V_n = CIBM_TYPE_BOUNC_V
+ XIBM_FORC_BOUNN_V_n = XIBM_FORC_BOUNN_V
+ CIBM_FORC_BOUNN_V_n = CIBM_FORC_BOUNN_V
+ CIBM_FORC_BOUNR_V_n = CIBM_FORC_BOUNR_V
+ XIBM_FORC_BOUNT_V_n = XIBM_FORC_BOUNT_V
+ CIBM_FORC_BOUNT_V_n = CIBM_FORC_BOUNT_V
+ XIBM_FORC_BOUNC_V_n = XIBM_FORC_BOUNC_V
+ CIBM_FORC_BOUNC_V_n = CIBM_FORC_BOUNC_V
+
+END SUBROUTINE UPDATE_NAM_IBM_PARAMn
+!------------------------------------------------------------------------------
+END MODULE MODN_IBM_PARAM_n
diff --git a/src/MNH/modn_nesting.f90 b/src/MNH/modn_nesting.f90
index 90a3f00212fc22a1a5b535a9353b1bb736c5571e..6ed5dda136fccf1b1983c8c072cb7ef51fa3b5a4 100644
--- a/src/MNH/modn_nesting.f90
+++ b/src/MNH/modn_nesting.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modn 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###################
MODULE MODN_NESTING
! ###################
@@ -43,16 +38,18 @@
!!
!! MODIFICATIONS
!! -------------
-!! Original 16/08/95
+!! Original 16/08/95
+!! JL Redelsperger 03/2021 : Add Auto-coupled O-A LES case
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_NESTING
+USE MODD_REF, ONLY: LCOUPLES
!
IMPLICIT NONE
!
-NAMELIST/NAM_NESTING/NDAD,NDTRATIO,XWAY
+NAMELIST/NAM_NESTING/NDAD,NDTRATIO,XWAY,LCOUPLES
!
END MODULE MODN_NESTING
diff --git a/src/MNH/modn_param_ecradn.f90 b/src/MNH/modn_param_ecradn.f90
index 096bf9520c4244010342d0ce36ce2377f5aa8a29..9d168f330b41adc2e54531345f39fd3320d79f92 100644
--- a/src/MNH/modn_param_ecradn.f90
+++ b/src/MNH/modn_param_ecradn.f90
@@ -1,20 +1,19 @@
-!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 modn 2006/11/23 17:22:54
-!-----------------------------------------------------------------
! ########################
MODULE MODN_PARAM_ECRAD_n
! ########################
!
!-------------------------------------------------------------------------------
USE PARKIND1 , ONLY : JPIM,JPRB
-
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+USE MODD_RADIATIONS_n , ONLY : NSWB_MNH, NLWB_MNH
+#endif
+#endif
!* 0. DECLARATIONS
! ------------
!
@@ -30,7 +29,18 @@ USE MODD_PARAM_ECRAD_n, ONLY: &
NREG_n => NREG, &
XCLOUD_FRAC_STD_n => XCLOUD_FRAC_STD, &
NLWSCATTERING_n => NLWSCATTERING, &
- NAERMACC_n => NAERMACC
+ NAERMACC_n => NAERMACC
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+USE MODD_PARAM_ECRAD_n, ONLY: &
+ LSPEC_ALB_n => LSPEC_ALB, &
+ LSPEC_EMISS_n => LSPEC_EMISS, &
+ ! USER_ALB_DIFF_n => USER_ALB_DIFF, &
+ ! USER_ALB_DIR_n => USER_ALB_DIR, &
+ ! USER_EMISS_n => USER_EMISS
+ SURF_TYPE_n => SURF_TYPE
+#endif
+#endif
! EFF3D_n => EFF3D, &
! SIDEM_n => SIDEM, &
! LWCSCA_n => LWCSCA, &
@@ -54,6 +64,16 @@ INTEGER(KIND=JPIM), SAVE :: NREG
REAL(KIND=JPRB), SAVE :: XCLOUD_FRAC_STD
INTEGER(KIND=JPIM), SAVE :: NLWSCATTERING
INTEGER(KIND=JPIM), SAVE :: NAERMACC
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+LOGICAL, SAVE :: LSPEC_ALB
+LOGICAL, SAVE :: LSPEC_EMISS
+!REAL(KIND=JPRB), ALLOCATABLE, SAVE :: USER_ALB_DIFF(:)
+!REAL(KIND=JPRB), ALLOCATABLE, SAVE :: USER_ALB_DIR(:)
+!REAL(KIND=JPRB), ALLOCATABLE, SAVE :: USER_EMISS(:)
+CHARACTER(LEN=4), SAVE :: SURF_TYPE
+#endif
+#endif
! LOGICAL, SAVE :: EFF3D
! LOGICAL, SAVE :: SIDEM
! LOGICAL, SAVE :: LWCSCA
@@ -64,7 +84,18 @@ INTEGER(KIND=JPIM), SAVE :: NAERMACC
!
NAMELIST/NAM_PARAM_ECRADn/NSWSOLVER,NLWSOLVER,NRADLP,NRADIP,&
NLIQOPT,NICEOPT,NOVLP,NGAS,NREG,XCLOUD_FRAC_STD,&
- NLWSCATTERING, NAERMACC
+ NLWSCATTERING, NAERMACC &
+#ifndef MNH_ECRAD
+ &
+#else
+#if ( VER_ECRAD == 140 )
+ , LSPEC_ALB, LSPEC_EMISS, &
+! USER_ALB_DIFF, USER_ALB_DIR, USER_EMISS, &
+ SURF_TYPE
+#else
+ &
+#endif
+#endif
!
CONTAINS
!
@@ -81,6 +112,16 @@ SUBROUTINE INIT_NAM_PARAM_ECRADn
XCLOUD_FRAC_STD = XCLOUD_FRAC_STD_n
NLWSCATTERING = NLWSCATTERING_n
NAERMACC = NAERMACC_n
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ LSPEC_ALB = LSPEC_ALB_n
+ LSPEC_EMISS = LSPEC_EMISS_n
+! USER_ALB_DIFF = USER_ALB_DIFF_n
+! USER_ALB_DIR = USER_ALB_DIR_n
+! USER_EMISS = USER_EMISS_n
+ SURF_TYPE = SURF_TYPE_n
+#endif
+#endif
END SUBROUTINE INIT_NAM_PARAM_ECRADn
SUBROUTINE UPDATE_NAM_PARAM_ECRADn
@@ -96,6 +137,16 @@ SUBROUTINE UPDATE_NAM_PARAM_ECRADn
XCLOUD_FRAC_STD_n = XCLOUD_FRAC_STD
NLWSCATTERING_n = NLWSCATTERING
NAERMACC_n = NAERMACC
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+ LSPEC_ALB_n = LSPEC_ALB
+ LSPEC_EMISS_n = LSPEC_EMISS
+! USER_ALB_DIFF_n = USER_ALB_DIFF
+! USER_ALB_DIR_n = USER_ALB_DIR
+! USER_EMISS_n = USER_EMISS
+ SURF_TYPE_n = SURF_TYPE
+#endif
+#endif
END SUBROUTINE UPDATE_NAM_PARAM_ECRADn
END MODULE MODN_PARAM_ECRAD_n
diff --git a/src/MNH/modn_param_lima.f90 b/src/MNH/modn_param_lima.f90
index 0b3c41d5e4495c8839490c3f29dea7521ef67ef9..f86b1add06cd8ac04da64b6bac6556d924bbc223 100644
--- a/src/MNH/modn_param_lima.f90
+++ b/src/MNH/modn_param_lima.f90
@@ -1,4 +1,9 @@
-! ######################
+!MNH_LIC Copyright 2001-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-------------------------------------------------------------------------------
+! ######################
MODULE MODN_PARAM_LIMA
! ######################
!
@@ -19,7 +24,8 @@ NAMELIST/NAM_PARAM_LIMA/LCOLD, LNUCL, LSEDI, LSNOW, LHAIL, LHHONI, LMEYERS,&
XALPHAI, XNUI, XALPHAS, XNUS, XALPHAG, XNUG, &
XFACTNUC_DEP, XFACTNUC_CON, NPHILLIPS, &
!
- LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, &
+ LWARM, LACTI, LRAIN, LSEDC, LACTIT, LBOUND, LSPRO, &
+ LADJ, &
NMOD_CCN, XCCN_CONC, &
LCCN_HOM, CCCN_MODES, HINI_CCN, HTYPE_CCN, &
XALPHAC, XNUC, XALPHAR, XNUR, &
diff --git a/src/MNH/modn_recycl_paramn.f90 b/src/MNH/modn_recycl_paramn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fbe4cf57671ac025b45799a14c88e53458838c80
--- /dev/null
+++ b/src/MNH/modn_recycl_paramn.f90
@@ -0,0 +1,118 @@
+!MNH_LIC Copyright 2019-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!
+! #######################
+ MODULE MODN_RECYCL_PARAM_n
+! #######################
+!
+!**** *MODN_RECYCL_PARAM$n* - declaration of namelist NAM_RECYCL_PARAMn
+!
+! PURPOSE
+! -------
+!**** The purpose of this declarative module is to declare the constants
+! allowing to initialize the turbulence recycling method
+!
+!
+! IMPLICIT ARGUMENTS
+! ------------------
+! Module MODD_RECYCL_PARAM$n : contains declaration of RECYCLING parameters
+!
+!
+! REFERENCE
+! ---------
+!
+! AUTHOR
+! ------
+! Tim Nagel (Meteo-France)
+!
+! MODIFICATIONS
+! -------------
+! Original 01/02/2021
+!
+USE MODD_RECYCL_PARAM_n, ONLY: &
+ LRECYCL_n => LRECYCL, &
+ LRECYCLN_n => LRECYCLN, &
+ LRECYCLW_n => LRECYCLW, &
+ LRECYCLE_n => LRECYCLE, &
+ LRECYCLS_n => LRECYCLS, &
+ XDRECYCLN_n => XDRECYCLN , &
+ XARECYCLN_n => XARECYCLN , &
+ XDRECYCLW_n => XDRECYCLW , &
+ XARECYCLW_n => XARECYCLW , &
+ XDRECYCLE_n => XDRECYCLE , &
+ XARECYCLE_n => XARECYCLE , &
+ XDRECYCLS_n => XDRECYCLS , &
+ XARECYCLS_n => XARECYCLS , &
+ XTMOY_n => XTMOY, &
+ XTMOYCOUNT_n => XTMOYCOUNT , &
+ XNUMBELT_n => XNUMBELT, &
+ XRCOEFF_n => XRCOEFF, &
+ XTBVTOP_n => XTBVTOP, &
+ XTBVBOT_n => XTBVBOT
+!
+IMPLICIT NONE
+!
+LOGICAL,SAVE :: LRECYCL,LRECYCLN,LRECYCLW,LRECYCLE,LRECYCLS
+REAL,SAVE :: XDRECYCLN,XARECYCLN,XDRECYCLW,XARECYCLW,XDRECYCLE,XARECYCLE,XDRECYCLS,&
+ XARECYCLS,XTMOY,XTMOYCOUNT,XNUMBELT,XRCOEFF,XTBVTOP,XTBVBOT
+
+!
+NAMELIST /NAM_RECYCL_PARAMn/ LRECYCL,LRECYCLN,LRECYCLW,LRECYCLE,LRECYCLS,XDRECYCLW, &
+ XARECYCLW,XDRECYCLN,XARECYCLN,XDRECYCLE,XARECYCLE,XDRECYCLS,&
+ XARECYCLS,XTMOY,XTMOYCOUNT,XNUMBELT,XRCOEFF,XTBVTOP,XTBVBOT
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_RECYCL_PARAMn
+ LRECYCL = LRECYCL_n
+ LRECYCLN = LRECYCLN_n
+ LRECYCLW = LRECYCLW_n
+ LRECYCLE = LRECYCLE_n
+ LRECYCLS = LRECYCLS_n
+ XDRECYCLN = XDRECYCLN_n
+ XARECYCLN = XARECYCLN_n
+ XDRECYCLW = XDRECYCLW_n
+ XARECYCLW = XARECYCLW_n
+ XDRECYCLE = XDRECYCLE_n
+ XARECYCLE = XARECYCLE_n
+ XDRECYCLS = XDRECYCLS_n
+ XARECYCLS = XARECYCLS_n
+ XTMOY = XTMOY_n
+ XTMOYCOUNT = XTMOYCOUNT_n
+ XNUMBELT = XNUMBELT_n
+ XRCOEFF = XRCOEFF_n
+ XTBVTOP = XTBVTOP_n
+ XTBVBOT = XTBVBOT_n
+
+
+END SUBROUTINE INIT_NAM_RECYCL_PARAMn
+
+SUBROUTINE UPDATE_NAM_RECYCL_PARAMn
+ LRECYCL_n = LRECYCL
+ LRECYCLN_n = LRECYCLN
+ LRECYCLW_n = LRECYCLW
+ LRECYCLE_n = LRECYCLE
+ LRECYCLS_n = LRECYCLS
+ XDRECYCLN_n = XDRECYCLN
+ XARECYCLN_n = XARECYCLN
+ XDRECYCLW_n = XDRECYCLW
+ XARECYCLW_n = XARECYCLW
+ XDRECYCLE_n = XDRECYCLE
+ XARECYCLE_n = XARECYCLE
+ XDRECYCLS_n = XDRECYCLS
+ XARECYCLS_n = XARECYCLS
+ XTMOY_n = XTMOY
+ XTMOYCOUNT_n = XTMOYCOUNT
+ XNUMBELT_n = XNUMBELT
+ XRCOEFF_n = XRCOEFF
+ XTBVTOP_n = XTBVTOP
+ XTBVBOT_n = XTBVBOT
+
+
+END SUBROUTINE UPDATE_NAM_RECYCL_PARAMn
+!------------------------------------------------------------------------------
+END MODULE MODN_RECYCL_PARAM_n
+!
diff --git a/src/MNH/modn_stationn.f90 b/src/MNH/modn_stationn.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f388061e72fd7fc36bf3abc91db723843803f80d
--- /dev/null
+++ b/src/MNH/modn_stationn.f90
@@ -0,0 +1,90 @@
+!MNH_LIC Copyright 2020-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!!
+!! #####################
+ MODULE MODN_STATION_n
+!! #####################
+!!
+!!*** *MODN_STATION*
+!!
+!! PURPOSE
+!! -------
+! Namelist to define the stations
+!!
+!!** AUTHOR
+!! ------
+!! E. Jézéquel *CNRM & IFPEN*
+!
+!! MODIFICATIONS
+!! -------------
+!! Original 10/03/20
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+USE MODD_STATION_n
+USE MODD_ALLSTATION_n, ONLY:&
+ NNUMB_STAT_n =>NNUMB_STAT ,&
+ XSTEP_STAT_n =>XSTEP_STAT ,&
+ XX_STAT_n =>XX_STAT ,&
+ XY_STAT_n =>XY_STAT ,&
+ XLAT_STAT_n =>XLAT_STAT ,&
+ XLON_STAT_n =>XLON_STAT ,&
+ XZ_STAT_n =>XZ_STAT ,&
+ CNAME_STAT_n =>CNAME_STAT ,&
+ CTYPE_STAT_n =>CTYPE_STAT ,&
+ CFILE_STAT_n =>CFILE_STAT ,&
+ LDIAG_SURFRAD_n =>LDIAG_SURFRAD
+!!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+IMPLICIT NONE
+INTEGER ,SAVE:: NNUMB_STAT
+REAL ,SAVE:: XSTEP_STAT
+REAL, DIMENSION(100) ,SAVE:: XX_STAT, XY_STAT, XZ_STAT, XLAT_STAT, XLON_STAT
+CHARACTER (LEN=7), DIMENSION(100),SAVE:: CNAME_STAT, CTYPE_STAT
+CHARACTER (LEN=20) ,SAVE:: CFILE_STAT !filename
+LOGICAL ,SAVE:: LDIAG_SURFRAD
+
+NAMELIST /NAM_STATIONn/ &
+ NNUMB_STAT, XSTEP_STAT, &
+ XX_STAT,XY_STAT,XZ_STAT,&
+ XLON_STAT,XLAT_STAT,&
+ CNAME_STAT,CTYPE_STAT,&
+ CFILE_STAT,LDIAG_SURFRAD
+
+!
+CONTAINS
+!
+SUBROUTINE INIT_NAM_STATIONn
+ NNUMB_STAT = NNUMB_STAT_n
+ XSTEP_STAT = XSTEP_STAT_n
+ XX_STAT = XX_STAT_n
+ XY_STAT = XY_STAT_n
+ XLAT_STAT = XLAT_STAT_n
+ XLON_STAT = XLON_STAT_n
+ XZ_STAT = XZ_STAT_n
+ CNAME_STAT = CNAME_STAT_n
+ CTYPE_STAT = CTYPE_STAT_n
+ CFILE_STAT = CFILE_STAT_n
+ LDIAG_SURFRAD= LDIAG_SURFRAD_n
+END SUBROUTINE INIT_NAM_STATIONn
+
+SUBROUTINE UPDATE_NAM_STATIONn
+ NNUMB_STAT_n = NNUMB_STAT
+ XSTEP_STAT_n = XSTEP_STAT
+ XX_STAT_n = XX_STAT
+ XY_STAT_n = XY_STAT
+ XLAT_STAT_n = XLAT_STAT
+ XLON_STAT_n = XLON_STAT
+ XZ_STAT_n = XZ_STAT
+ CNAME_STAT_n = CNAME_STAT
+ CTYPE_STAT_n = CTYPE_STAT
+ CFILE_STAT_n = CFILE_STAT
+ LDIAG_SURFRAD_n= LDIAG_SURFRAD
+END SUBROUTINE UPDATE_NAM_STATIONn
+END MODULE MODN_STATION_n
diff --git a/src/MNH/modn_turbn.f90 b/src/MNH/modn_turbn.f90
index a91112bee27e5a13e81436142becc9f120a120ca..3e777d2da81815862ba89818f858227e14421550 100644
--- a/src/MNH/modn_turbn.f90
+++ b/src/MNH/modn_turbn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 modn 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ###################
MODULE MODN_TURB_n
! ###################
@@ -47,6 +42,7 @@
!! P. Bechtold Feb 11, 2002 add switch for Sigma_s computation
!! P. Jabouille Apr 4, 2002 add switch for Sigma_s convection
!! V. Masson Nov 13 2002 add switch for SBL lengths
+!! D. Ricard May, 2021 add switch for Leonard Terms
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -56,6 +52,7 @@ USE MODD_TURB_n, ONLY: &
XIMPL_n => XIMPL, &
XKEMIN_n => XKEMIN, &
XCEDIS_n => XCEDIS, &
+ XCADAP_n => XCADAP, &
CTURBLEN_n => CTURBLEN, &
CTURBDIM_n => CTURBDIM, &
LTURB_FLX_n => LTURB_FLX, &
@@ -66,13 +63,23 @@ USE MODD_TURB_n, ONLY: &
LRMC01_n => LRMC01, &
CTOM_n => CTOM, &
CSUBG_AUCV_n => CSUBG_AUCV, &
- VSIGQSAT_n => VSIGQSAT
+ VSIGQSAT_n => VSIGQSAT, &
+ CSUBG_AUCV_RI_n => CSUBG_AUCV_RI, &
+ CCONDENS_n => CCONDENS, &
+ CLAMBDA3_n => CLAMBDA3, &
+ CSUBG_MF_PDF_n => CSUBG_MF_PDF, &
+ LHGRAD_n => LHGRAD, &
+ XCOEFHGRADTHL_n => XCOEFHGRADTHL, &
+ XCOEFHGRADRM_n => XCOEFHGRADRM, &
+ XALTHGRAD_n => XALTHGRAD, &
+ XCLDTHOLD_n => XCLDTHOLD
!
IMPLICIT NONE
!
REAL,SAVE :: XIMPL
REAL,SAVE :: XKEMIN
REAL,SAVE :: XCEDIS
+REAL,SAVE :: XCADAP
CHARACTER (LEN=4),SAVE :: CTURBLEN
CHARACTER (LEN=4),SAVE :: CTURBDIM
LOGICAL,SAVE :: LTURB_FLX
@@ -83,11 +90,22 @@ LOGICAL,SAVE :: LSIG_CONV
LOGICAL,SAVE :: LRMC01
CHARACTER (LEN=4),SAVE :: CTOM
CHARACTER (LEN=4),SAVE :: CSUBG_AUCV
+CHARACTER (LEN=80),SAVE :: CSUBG_AUCV_RI
+CHARACTER (LEN=80),SAVE :: CCONDENS
+CHARACTER (LEN=4),SAVE :: CLAMBDA3
+CHARACTER (LEN=80),SAVE :: CSUBG_MF_PDF
REAL,SAVE :: VSIGQSAT
+LOGICAL,SAVE :: LHGRAD
+REAL,SAVE :: XCOEFHGRADTHL
+REAL,SAVE :: XCOEFHGRADRM
+REAL,SAVE :: XALTHGRAD
+REAL,SAVE :: XCLDTHOLD
!
NAMELIST/NAM_TURBn/XIMPL,CTURBLEN,CTURBDIM,LTURB_FLX,LTURB_DIAG, &
LSUBG_COND,LSIGMAS,LSIG_CONV,LRMC01,CTOM,CSUBG_AUCV,&
- XKEMIN,VSIGQSAT,XCEDIS
+ XKEMIN,VSIGQSAT,XCEDIS,XCADAP,CSUBG_AUCV_RI,CCONDENS,&
+ CLAMBDA3,CSUBG_MF_PDF,LHGRAD,XCOEFHGRADTHL, XCOEFHGRADRM, &
+ XALTHGRAD, XCLDTHOLD
!
CONTAINS
@@ -96,6 +114,7 @@ SUBROUTINE INIT_NAM_TURBn
XIMPL = XIMPL_n
XKEMIN = XKEMIN_n
XCEDIS = XCEDIS_n
+ XCADAP = XCADAP_n
CTURBLEN = CTURBLEN_n
CTURBDIM = CTURBDIM_n
LTURB_FLX = LTURB_FLX_n
@@ -107,12 +126,22 @@ SUBROUTINE INIT_NAM_TURBn
CTOM = CTOM_n
CSUBG_AUCV = CSUBG_AUCV_n
VSIGQSAT = VSIGQSAT_n
+ CSUBG_AUCV_RI = CSUBG_AUCV_RI_n
+ CCONDENS = CCONDENS_n
+ CLAMBDA3 = CLAMBDA3_n
+ CSUBG_MF_PDF = CSUBG_MF_PDF_n
+ LHGRAD = LHGRAD_n
+ XCOEFHGRADTHL = XCOEFHGRADTHL_n
+ XCOEFHGRADRM = XCOEFHGRADRM_n
+ XALTHGRAD = XALTHGRAD_n
+ XCLDTHOLD = XCLDTHOLD_n
END SUBROUTINE INIT_NAM_TURBn
SUBROUTINE UPDATE_NAM_TURBn
XIMPL_n = XIMPL
XKEMIN_n = XKEMIN
XCEDIS_n = XCEDIS
+ XCADAP_n = XCADAP
CTURBLEN_n = CTURBLEN
CTURBDIM_n = CTURBDIM
LTURB_FLX_n = LTURB_FLX
@@ -124,6 +153,15 @@ SUBROUTINE UPDATE_NAM_TURBn
CTOM_n = CTOM
CSUBG_AUCV_n = CSUBG_AUCV
VSIGQSAT_n = VSIGQSAT
+ CSUBG_AUCV_RI_n = CSUBG_AUCV_RI
+ CCONDENS_n = CCONDENS
+ CLAMBDA3_n = CLAMBDA3
+ CSUBG_MF_PDF_n = CSUBG_MF_PDF
+ LHGRAD_n = LHGRAD
+ XCOEFHGRADTHL_n = XCOEFHGRADTHL
+ XCOEFHGRADRM_n = XCOEFHGRADRM
+ XALTHGRAD_n = XALTHGRAD
+ XCLDTHOLD_n = XCLDTHOLD
END SUBROUTINE UPDATE_NAM_TURBn
END MODULE MODN_TURB_n
diff --git a/src/MNH/modules_diachro.f90 b/src/MNH/modules_diachro.f90
deleted file mode 100644
index 75fafa132219d983fa372f4ae47eb849c86a4d92..0000000000000000000000000000000000000000
--- a/src/MNH/modules_diachro.f90
+++ /dev/null
@@ -1,75 +0,0 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! Modifications:
-! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-----------------------------------------------------------------
-! #########################
- MODULE MODI_MENU_DIACHRO
-! #########################
-!
-INTERFACE
-!
-SUBROUTINE MENU_DIACHRO(TPDIAFILE,HGROUP)
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP
-!
-END SUBROUTINE MENU_DIACHRO
-!
-END INTERFACE
-!
-END MODULE MODI_MENU_DIACHRO
-!-----------------------------------------------------------------
-! #####################################
- MODULE MODI_WRITE_LFIFMN_FORDIACHRO_n
-! #####################################
-!
-INTERFACE
-!
-SUBROUTINE WRITE_LFIFMN_FORDIACHRO_n(TPFILE)
-USE MODD_IO, ONLY: TFILEDATA
-TYPE(TFILEDATA),INTENT(IN) :: TPFILE
-END SUBROUTINE WRITE_LFIFMN_FORDIACHRO_n
-!
-END INTERFACE
-!
-END MODULE MODI_WRITE_LFIFMN_FORDIACHRO_n
-! #########################
- MODULE MODI_WRITE_DIACHRO
-! #########################
-!
-INTERFACE
-!
-SUBROUTINE WRITE_DIACHRO(TPDIAFILE,TPLUOUTDIA,HGROUP,HTYPE, &
- KGRID,PDATIME,PVAR,PTRAJT, &
- HTITRE,HUNITE,HCOMMENT,OICP,OJCP,OKCP,KIL,KIH,KJL,KJH,KKL,KKH, &
- PTRAJX,PTRAJY,PTRAJZ,PMASK)
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
-TYPE(TFILEDATA), INTENT(IN) :: TPLUOUTDIA
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP, HTYPE
-INTEGER,DIMENSION(:), INTENT(IN) :: KGRID
-REAL,DIMENSION(:,:), INTENT(IN) :: PDATIME
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PVAR
-REAL,DIMENSION(:,:), INTENT(IN) :: PTRAJT
-CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: HTITRE, HUNITE, HCOMMENT
-LOGICAL, INTENT(IN),OPTIONAL :: OICP, OJCP, OKCP
-INTEGER, INTENT(IN),OPTIONAL :: KIL, KIH
-INTEGER, INTENT(IN),OPTIONAL :: KJL, KJH
-INTEGER, INTENT(IN),OPTIONAL :: KKL, KKH
-REAL,DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PTRAJX
-REAL,DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PTRAJY
-REAL,DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PTRAJZ
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN),OPTIONAL :: PMASK
-!
-END SUBROUTINE WRITE_DIACHRO
-!
-END INTERFACE
-!
-END MODULE MODI_WRITE_DIACHRO
diff --git a/src/MNH/mpdata.f90 b/src/MNH/mpdata.f90
deleted file mode 100644
index 8b676d70dcca23c6a87f0c71302a11fe1d91b856..0000000000000000000000000000000000000000
--- a/src/MNH/mpdata.f90
+++ /dev/null
@@ -1,405 +0,0 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ##################
- MODULE MODI_MPDATA
-! ##################
-INTERFACE
- SUBROUTINE MPDATA (KLITER, HLBCX, HLBCY, KRR, &
- PTSTEP, PRHODJ, PTHM, PRM, PTKEM, &
- PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-!
-INTEGER, INTENT(IN) :: KLITER ! Number of iterations MPDATA
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT ! Contravariants
- ! components of the momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-END SUBROUTINE MPDATA
-!
-END INTERFACE
-!
-END MODULE MODI_MPDATA
-!
-!
-! ########################################################################
- SUBROUTINE MPDATA (KLITER, HLBCX, HLBCY, KRR, &
- PTSTEP, PRHODJ, PTHM, PRM, PTKEM, &
- PTHT, PRT, PTKET, &
- PRUCT, PRVCT, PRWCT, &
- PRTHS, PRRS, PRTKES )
-! ########################################################################
-!
-!!**** *MPDATA* - routine to compute the advection tendancies of the scalar
-!! fields using an upstream scheme. The excesive numerical
-!! correction of the scheme is corrected by means of an
-!! antidiffusive velocity.
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the total advection
-!! tendencies of all the scalar fields using the MPDATA scheme.
-!!
-!!** METHOD
-!! ------
-!! MPDATA solves the advection of a quantity in the following way
-!! 1.- 1st iteration. Upstream scheme.
-!! The quantity is advected by the contravariant
-!! velocities using an upstream scheme.
-!! 2.- 2nd and next iterations. The excessive diffusion
-!! of the upstream scheme is corrected by defining
-!! the antidiffusive velocities (ANTI_DIFF routine)
-!! and using for each iteration the upstream scheme.
-!! EXTERNAL
-!! --------
-!! ADD3DFIELD_ll : add a field to 3D-list
-!! CLEANLIST_ll : deallocate a list
-!! UPDATE_HALO_ll : update internal halos
-!! DXF,DYF,DZF : Shuman operators
-!! FXM,FYM,FZM : Flux operators
-!! ANTI_DIFF : antidiffusion
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book1 of documentation ( MPDATA scheme )
-!!
-!! AUTHOR
-!! ------
-!! J. Vila-Guerau * Meteo France*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/10/95
-!! J.-P. Pinty & J.-M. Cohard *LA* Add the budget calls
-!! J. Stein include the cyclic case
-!! P. Jabouille parallelization
-!! V. Masson 06/11/02 updates the budget calls
-!! 05/2006 Remove EPS
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-!
-USE MODD_BUDGET
-USE MODD_PARAMETERS
-!
-USE MODI_SHUMAN
-USE MODI_FLUX
-USE MODI_ANTI_DIFF
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KLITER ! Number of iterations MPDATA
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KRR ! Number of moist variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHM, PTKEM
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariants components momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PTKET, PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS, PRTKES
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS
- ! Sources terms
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JLITER ! Loop index for MPDATA iterations
-INTEGER :: JRR ! Loop index for moist variables
-!
-INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
-INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-!
-REAL, DIMENSION(SIZE(PTHM,1),SIZE(PTHM,2),SIZE(PTHM,3)) :: ZGUESS ! Guess
- ! variable (to be removed in the future !)
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAUCT
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAVCT
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAWCT
- ! Antidiffusive contravariant component of the
- ! momentum
-!
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADV ! used
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVU ! for
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVV ! budget
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVW ! purpose
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRVARS ! only
-!
-CHARACTER (LEN=3) , DIMENSION(7) :: YRX
-CHARACTER (LEN=20) :: YBURX
-LOGICAL , DIMENSION(7) :: LBUDGET_R
-!
-INTEGER :: IINFO_ll ! return code of parallel routine
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-!-------------------------------------------------------------------------------
-!
-!-------------------------------------------------------------------------------
-!JUAN : init of TZFIELDS_ll
-NULLIFY(TZFIELDS_ll)
-!
-!* 0.3 PROLOGUE
-!
-CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
-!
-YRX(1) = 'RRV'
-YRX(2) = 'RRC'
-YRX(3) = 'RRR'
-YRX(4) = 'RRI'
-YRX(5) = 'RRS'
-YRX(6) = 'RRG'
-YRX(7) = 'RRH'
-!
-LBUDGET_R(1) = LBUDGET_RV
-LBUDGET_R(2) = LBUDGET_RC
-LBUDGET_R(3) = LBUDGET_RR
-LBUDGET_R(4) = LBUDGET_RI
-LBUDGET_R(5) = LBUDGET_RS
-LBUDGET_R(6) = LBUDGET_RG
-LBUDGET_R(7) = LBUDGET_RH
-!
-!
-!-------------------------------------------------------------------------------
-!
-!
-!
-!* 1. Thermodynamical variable
-! -----------------------
-!
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PRTHS, 'MPDATA::PRTHS' )
-!
-!* 1st iteration (upstream scheme)
-!
- ZRVARS(:,:,:) = PRTHS(:,:,:)
- ZFADVU(:,:,:) = -DXF(FXM( PTHM(:,:,:),PRUCT(:,:,:) ) )
- ZFADVV(:,:,:) = -DYF(FYM( PTHM(:,:,:),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(FZM( PTHM(:,:,:),PRWCT(:,:,:) ) )
-!
- PRTHS(:,:,:) = PRTHS(:,:,:) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + ZFADVW(:,:,:)
-!
-!
-!* Iterations greater than 1
-!
- ZRAUCT(:,:,:)=PRUCT(:,:,:)
- ZRAVCT(:,:,:)=PRVCT(:,:,:)
- ZRAWCT(:,:,:)=PRWCT(:,:,:)
-!
- DO JLITER=2,KLITER
-!
-! update halo (and possibly periodize) the guess of the future time
-!
- CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-!
- CALL ANTI_DIFF(HLBCX,HLBCY,PTSTEP,PRHODJ,PRTHS,ZRAUCT,ZRAVCT,ZRAWCT)
-!
- ZGUESS(:,:,:)=PTSTEP*PRTHS/PRHODJ(:,:,:)
-!
- ZFADV(:,:,:) = -DXF(FXM( ZGUESS(:,:,:),ZRAUCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVU(:,:,:) = ZFADVU(:,:,:) + ZFADV(:,:,:)
- PRTHS(:,:,:) = PRTHS(:,:,:) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DYF(FYM( ZGUESS(:,:,:),ZRAVCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
- PRTHS(:,:,:) = PRTHS(:,:,:) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVW(:,:,:) = ZFADVW(:,:,:) + ZFADV(:,:,:)
- PRTHS(:,:,:) = PRTHS(:,:,:) + ZFADV(:,:,:)
-!
- END DO
-!
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!
- IF (LBUDGET_TH) THEN
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVU(:,:,:)
- CALL BUDGET (ZRVARS,4,'ADVX_BU_RTH')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVV(:,:,:)
- CALL BUDGET (ZRVARS,4,'ADVY_BU_RTH')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVW(:,:,:)
- CALL BUDGET (ZRVARS,4,'ADVZ_BU_RTH')
- END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Case with KRR water variables
-! -----------------------------
-!
- DO JRR=1,KRR
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PRRS(:,:,:,JRR), 'MPDATA::PRRS(:,:,:,JRR)' )
- ZRVARS(:,:,:) = PRRS(:,:,:,JRR)
- ZFADVU(:,:,:) = -DXF(FXM( PRM(:,:,:,JRR),PRUCT(:,:,:) ) )
- ZFADVV(:,:,:) = -DYF(FYM( PRM(:,:,:,JRR),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(FZM( PRM(:,:,:,JRR),PRWCT(:,:,:) ) )
-!
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + &
- ZFADVW(:,:,:)
-!
- ZRAUCT(:,:,:)=PRUCT(:,:,:)
- ZRAVCT(:,:,:)=PRVCT(:,:,:)
- ZRAWCT(:,:,:)=PRWCT(:,:,:)
-!
- DO JLITER=2,KLITER
- CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-!
- CALL ANTI_DIFF(HLBCX,HLBCY,PTSTEP,PRHODJ,PRRS(:,:,:,JRR),ZRAUCT,ZRAVCT,ZRAWCT)
-!
- ZGUESS(:,:,:)=PTSTEP*PRRS(:,:,:,JRR)/PRHODJ(:,:,:)
-!
-!
- ZFADV(:,:,:) = -DXF(FXM( ZGUESS(:,:,:),ZRAUCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVU(:,:,:) = ZFADVU(:,:,:) + ZFADV(:,:,:)
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DYF(FYM( ZGUESS(:,:,:),ZRAVCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVW(:,:,:) = ZFADVW(:,:,:) + ZFADV(:,:,:)
- PRRS(:,:,:,JRR) = PRRS(:,:,:,JRR) + ZFADV(:,:,:)
- END DO
-!
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!
- IF (LBUDGET_R(JRR)) THEN
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVU(:,:,:)
- YBURX = 'ADVX_BU_'//YRX(JRR)
- CALL BUDGET (ZRVARS(:,:,:),JRR+5 ,YBURX)
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVV(:,:,:)
- YBURX = 'ADVY_BU_'//YRX(JRR)
- CALL BUDGET (ZRVARS(:,:,:),JRR+5 ,YBURX)
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVW(:,:,:)
- YBURX = 'ADVZ_BU_'//YRX(JRR)
- CALL BUDGET (ZRVARS(:,:,:),JRR+5 ,YBURX)
- END IF
- END DO
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. TKE variable
-! -------------
- IF (SIZE(PTKET,1) /= 0) THEN
-!
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PRTKES, 'MPDATA::PRTKES' )
- ZRVARS(:,:,:) = PRTKES(:,:,:)
- ZFADVU(:,:,:) = -DXF(FXM( PTKEM(:,:,:),PRUCT(:,:,:) ) )
- ZFADVV(:,:,:) = -DYF(FYM( PTKEM(:,:,:),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(FZM( PTKEM(:,:,:),PRWCT(:,:,:) ) )
-!
- PRTKES(:,:,:) = PRTKES(:,:,:) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + ZFADVW(:,:,:)
-!
- ZRAUCT(:,:,:)=PRUCT(:,:,:)
- ZRAVCT(:,:,:)=PRVCT(:,:,:)
- ZRAWCT(:,:,:)=PRWCT(:,:,:)
-!
- DO JLITER=2,KLITER
- CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-!
- CALL ANTI_DIFF(HLBCX,HLBCY,PTSTEP,PRHODJ,PRTKES,ZRAUCT,ZRAVCT,ZRAWCT)
-!
- ZGUESS(:,:,:)=PTSTEP*PRTKES/PRHODJ(:,:,:)
-!
-!
- ZFADV(:,:,:) = -DXF(FXM( ZGUESS(:,:,:),ZRAUCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVU(:,:,:) = ZFADVU(:,:,:) + ZFADV(:,:,:)
- PRTKES(:,:,:) = PRTKES(:,:,:) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DYF(FYM( ZGUESS(:,:,:),ZRAVCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
- PRTKES(:,:,:) = PRTKES(:,:,:) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVW(:,:,:) = ZFADVW(:,:,:) + ZFADV(:,:,:)
- PRTKES(:,:,:) = PRTKES(:,:,:) + ZFADV(:,:,:)
- END DO
-!
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!
- IF (LBUDGET_TKE) THEN
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVU(:,:,:)
- CALL BUDGET (ZRVARS,5,'ADVX_BU_RTKE')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVV(:,:,:)
- CALL BUDGET (ZRVARS,5,'ADVY_BU_RTKE')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVW(:,:,:)
- CALL BUDGET (ZRVARS,5,'ADVZ_BU_RTKE')
- END IF
- END IF
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE MPDATA
diff --git a/src/MNH/mpdata_scalar.f90 b/src/MNH/mpdata_scalar.f90
deleted file mode 100644
index 48b6e121507328e3e59777682667c05d8cf4b3a2..0000000000000000000000000000000000000000
--- a/src/MNH/mpdata_scalar.f90
+++ /dev/null
@@ -1,250 +0,0 @@
-!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #########################
- MODULE MODI_MPDATA_SCALAR
-! #########################
-INTERFACE
- SUBROUTINE MPDATA_SCALAR ( KLITER, HLBCX, HLBCY, KSV, &
- PTSTEP, PRHODJ, PSVM, PSVT, &
- PRUCT, PRVCT, PRWCT, PRSVS )
-!
-INTEGER, INTENT(IN) :: KLITER ! Number of iterations MPDATA
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT ! Contravariants
- ! components of the momentum
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-END SUBROUTINE MPDATA_SCALAR
-!
-END INTERFACE
-!
-END MODULE MODI_MPDATA_SCALAR
-!
-!
-! ########################################################################
- SUBROUTINE MPDATA_SCALAR ( KLITER, HLBCX, HLBCY, KSV, &
- PTSTEP, PRHODJ, PSVM, PSVT, &
- PRUCT, PRVCT, PRWCT, PRSVS )
-! ########################################################################
-!
-!!**** *MPDATA_SCALAR* - routine to compute the advection tendancies of the scalar
-!! fields using an upstream scheme. The excesive numerical
-!! correction of the scheme is corrected by means of an
-!! antidiffusive velocity.
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the total advection
-!! tendencies of all the scalar fields using the MPDATA scheme.
-!!
-!!** METHOD
-!! ------
-!! MPDATA solves the advection of a quantity in the following way
-!! 1.- 1st iteration. Upstream scheme.
-!! The quantity is advected by the contravariant
-!! velocities using an upstream scheme.
-!! 2.- 2nd and next iterations. The excessive diffusion
-!! of the upstream scheme is corrected by defining
-!! the antidiffusive velocities (ANTI_DIFF routine)
-!! and using for each iteration the upstream scheme.
-!! EXTERNAL
-!! --------
-!! ADD3DFIELD_ll : add a field to 3D-list
-!! CLEANLIST_ll : deallocate a list
-!! UPDATE_HALO_ll : update internal halos
-!! DXF,DYF,DZF : Shuman operators
-!! FXM,FYM,FZM : Flux operators
-!! ANTI_DIFF : antidiffusion
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book1 of documentation ( MPDATA scheme )
-!!
-!! AUTHOR
-!! ------
-!! J. Vila-Guerau * Meteo France*
-!! J.-P. Lafore * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/10/95
-!! J.-P. Pinty & J.-M. Cohard *LA* Add the budget calls
-!! J. Stein include the cyclic case
-!! P. Jabouille parallelization
-!! V. Masson 06/11/02 updates the budget calls
-!! C.Lac Split meteorological scalar and tracer
-!! variables routines
-!! P.Tulet Upstream condition for aerosols
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-!
-USE MODD_BUDGET
-USE MODD_PARAMETERS
-USE MODD_NSV, ONLY : NSV_DSTBEG, NSV_DSTEND, NSV_AERBEG, NSV_AEREND,&
- NSV_SLTBEG, NSV_SLTEND
-!
-USE MODI_SHUMAN
-USE MODI_FLUX
-USE MODI_ANTI_DIFF
-USE MODI_BUDGET
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-INTEGER, INTENT(IN) :: KLITER ! Number of iterations MPDATA
-!
-CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
-!
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVM
- ! Variables at t-dt
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRUCT,PRVCT,PRWCT
- ! Contravariants components momentum
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT
- ! Variables at t
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS
- ! Sources terms
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JLITER ! Loop index for MPDATA iterations
-INTEGER :: JSV ! Loop index for Scalar Variables
-!
-INTEGER:: IIB,IJB ! Begining useful area in x,y,z directions
-INTEGER:: IIE,IJE ! End useful area in x,y,z directions
-!
-REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2),SIZE(PSVM,3)) :: ZGUESS ! Guess
- ! variable (to be removed in the future !)
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAUCT
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAVCT
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRAWCT
- ! Antidiffusive contravariant component of the
- ! momentum
-!
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADV ! used
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVU ! for
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVV ! budget
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZFADVW ! purpose
-REAL, DIMENSION(SIZE(PRUCT,1),SIZE(PRUCT,2),SIZE(PRUCT,3)):: ZRVARS ! only
-!
-INTEGER :: IINFO_ll ! return code of parallel routine
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-!-------------------------------------------------------------------------------
-!
-!-------------------------------------------------------------------------------
-NULLIFY(TZFIELDS_ll)
-!
-!* 0. PROLOGUE
-!
-CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 1.- case with KSV Scalar Variables
-! --------------------------------
- DO JSV=1,KSV
-!
- CALL ADD3DFIELD_ll( TZFIELDS_ll, PRSVS(:,:,:,JSV), 'MPDATA_SCALAR::PRSVS(:,:,:,JSV)' )
- ZRVARS(:,:,:) = PRSVS(:,:,:,JSV)
- ZFADVU(:,:,:) = -DXF(FXM( PSVM(:,:,:,JSV),PRUCT(:,:,:) ) )
- ZFADVV(:,:,:) = -DYF(FYM( PSVM(:,:,:,JSV),PRVCT(:,:,:) ) )
- ZFADVW(:,:,:) = -DZF(FZM( PSVM(:,:,:,JSV),PRWCT(:,:,:) ) )
-!
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + ZFADVU(:,:,:) + ZFADVV(:,:,:) + &
- ZFADVW(:,:,:)
-!
- ZRAUCT(:,:,:)=PRUCT(:,:,:)
- ZRAVCT(:,:,:)=PRVCT(:,:,:)
- ZRAWCT(:,:,:)=PRWCT(:,:,:)
-!
-
-! ANTI_DIFF of MPDATA not suported by aerosols variables
- IF ((.NOT.((JSV .GE. NSV_AERBEG).AND.(JSV .LE. NSV_AEREND))).AND.&
- (.NOT.((JSV .GE. NSV_DSTBEG).AND.(JSV .LE. NSV_DSTEND))).AND.&
- (.NOT.((JSV .GE. NSV_SLTBEG).AND.(JSV .LE. NSV_SLTEND)))) THEN
-
- DO JLITER=2,KLITER
- CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
-!
- CALL ANTI_DIFF(HLBCX,HLBCY,PTSTEP,PRHODJ,PRSVS(:,:,:,JSV),ZRAUCT,ZRAVCT,ZRAWCT)
-!
- ZGUESS(:,:,:)=PTSTEP*PRSVS(:,:,:,JSV)/PRHODJ(:,:,:)
-!
-!
- ZFADV(:,:,:) = -DXF(FXM( ZGUESS(:,:,:),ZRAUCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVU(:,:,:) = ZFADVU(:,:,:) + ZFADV(:,:,:)
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DYF(FYM( ZGUESS(:,:,:),ZRAVCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVV(:,:,:) = ZFADVV(:,:,:) + ZFADV(:,:,:)
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + ZFADV(:,:,:)
-!
- ZFADV(:,:,:) = -DZF(FZM( ZGUESS(:,:,:),ZRAWCT(:,:,:) ) )
- IF(LWEST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIB,:,:)=0.
- IF(LEAST_ll() .AND. HLBCX(1) /= 'CYCL') ZFADV(IIE,:,:)=0.
- IF(LSOUTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJB,:)=0.
- IF(LNORTH_ll() .AND. HLBCY(1) /= 'CYCL') ZFADV(:,IJE,:)=0.
- ZFADVW(:,:,:) = ZFADVW(:,:,:) + ZFADV(:,:,:)
- PRSVS(:,:,:,JSV) = PRSVS(:,:,:,JSV) + ZFADV(:,:,:)
- END DO
- END IF
-!
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!
- IF (LBUDGET_SV) THEN
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVU(:,:,:)
- CALL BUDGET (ZRVARS,JSV+12,'ADVX_BU_RSV')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVV(:,:,:)
- CALL BUDGET (ZRVARS,JSV+12,'ADVY_BU_RSV')
- ZRVARS(:,:,:) = ZRVARS(:,:,:) + ZFADVW(:,:,:)
- CALL BUDGET (ZRVARS,JSV+12,'ADVZ_BU_RSV')
- END IF
-!
- END DO
-
-!
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE MPDATA_SCALAR
diff --git a/src/MNH/nhoa_coupln.f90 b/src/MNH/nhoa_coupln.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f8ea30639b021065de23652e151303524f0644f4
--- /dev/null
+++ b/src/MNH/nhoa_coupln.f90
@@ -0,0 +1,155 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ###################
+ MODULE MODI_NHOA_COUPL_n
+! ###################
+!
+INTERFACE
+!
+ SUBROUTINE NHOA_COUPL_n(KDAD,PTSTEP,KMI,KTCOUNT,KKU)
+!
+INTEGER, INTENT(IN) :: KDAD ! Number of the DAD model
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! model number
+INTEGER, INTENT(IN) :: KKU
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+ ! (=1 at the segment beginning)
+!
+END SUBROUTINE NHOA_COUPL_n
+END INTERFACE
+END MODULE MODI_NHOA_COUPL_n
+!
+! ####################################################################
+SUBROUTINE NHOA_COUPL_n(KDAD,PTSTEP,KMI,KTCOUNT,KKU)
+! ####################################################################
+!!
+!! PURPOSE
+!! -------
+! To compute the flux at the O-A interface in the auto-coupling O-A LES case
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! Module MODD_PARAMETERS: JPHEXT,JPVEXT
+!! Module MODD_FIELD$n : XUT,XVT,XWT,XRT,XTHT,XPABST
+!! Module MODD_REF$n : XRHODJ, XRVREF,XTHVREF, XRHODREF
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! JL Redelsperger 03/2021 Version 0
+!! MODIFICATIONS
+!! -------------
+!!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+!
+USE MODD_PARAMETERS
+USE MODD_NESTING
+USE MODD_CST
+USE MODD_REF_n ! modules relative to the outer model $n
+USE MODD_FIELD_n
+USE MODD_CONF
+USE MODD_PARAM_n
+USE MODD_TURB_n
+USE MODD_DYN_n, ONLY : LOCEAN
+USE MODD_REF, ONLY: LCOUPLES
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER, INTENT(IN) :: KDAD ! Number of the DAD model
+REAL, INTENT(IN) :: PTSTEP ! Time step
+INTEGER, INTENT(IN) :: KMI ! model number
+INTEGER, INTENT(IN) :: KKU !
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IIB,IIE,IJB,IJE,IIU,IJU
+INTEGER :: IKE
+INTEGER :: ILBX,ILBY,ILBX2,ILBY2
+INTEGER, INTENT(IN) :: KTCOUNT ! Temporal loop COUNTer
+ ! (=1 at the segment beginning)
+!
+INTEGER :: JRR,JSV ! Loop index
+!
+INTEGER :: IINFO_ll, IDIMX, IDIMY
+! surface variables: wind, current, Temp
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOUPUA,ZCOUPVA,ZCOUPTA
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOUPUO,ZCOUPVO,ZCOUPTO
+!surf flux local work space
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOUPTFL,ZCOUPUFL,ZCOUPVFL
+CHARACTER(LEN=4) :: ZINIT_TYPE
+!
+!---Coupled OA MesoNH----------------------------------------------------------------------------
+!* 0. INITIALISATION
+! --------------
+! allocate flux local array
+ALLOCATE(ZCOUPTFL(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPUFL(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPVFL(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+! allocate sfc variable local array
+ALLOCATE(ZCOUPUA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPVA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPTA(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPUO(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPVO(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+ALLOCATE(ZCOUPTO(SIZE(XRHODJ,1),SIZE(XRHODJ,2)))
+! values in ocean sfc
+IKE=KKU-JPVEXT
+ZCOUPUO(:,:)= XUT(:,:,IKE)
+ZCOUPVO(:,:)= XVT(:,:,IKE)
+ZCOUPTO(:,:)= XTHT(:,:,IKE)
+!
+! we are going to the atmos model i.e. Model 1
+CALL GOTO_MODEL(KDAD)
+IIB=1
+IIE=IIU
+IJB=1
+IJE=IJU
+!
+! compute gradient between ocean & atmosphere
+ZCOUPUA(:,:)= XUT(:,:,2)-ZCOUPUO(:,:)
+ZCOUPVA(:,:)= XVT(:,:,2)-ZCOUPVO(:,:)
+ZCOUPTA(:,:)= XTHT(:,:,2)-ZCOUPTO(:,:)
+!
+! sfc flux computation * RHO AIR !!!!
+! flux vu atmosp
+!
+ZCOUPTFL(:,:) = -1.2*1.E-3* SQRT(ZCOUPUA(:,:)**2 +ZCOUPVA(:,:)**2) * ZCOUPTA(:,:)
+ZCOUPUFL(:,:) = -1.2*1.E-3* SQRT(ZCOUPUA(:,:)**2 +ZCOUPVA(:,:)**2) * ZCOUPUA(:,:)
+ZCOUPVFL(:,:) = -1.2*1.E-3* SQRT(ZCOUPUA(:,:)**2 +ZCOUPVA(:,:)**2) * ZCOUPVA(:,:)
+!
+XSSUFL_C(:,:,1)= ZCOUPUFL(:,:)
+XSSVFL_C(:,:,1)= ZCOUPVFL(:,:)
+XSSTFL_C(:,:,1)= ZCOUPTFL(:,:)
+!
+!
+! We are going back in the ocean model
+! same sign & unit at the top of ocean model and the bottom of atmospheric model
+! rho_atmos * (w'u')_atmos = rho_ocean * (u'w')_ocean
+! rho_atmos *Cp_atmos* (u'w')_atmos = rho_ocean * CP_ocean * (u'w')_ocean
+!
+CALL GOTO_MODEL(KMI)
+XSSUFL_C(:,:,1)= ZCOUPUFL(:,:)/XRH00OCEAN
+XSSVFL_C(:,:,1)= ZCOUPVFL(:,:)/XRH00OCEAN
+XSSTFL_C(:,:,1)= ZCOUPTFL(:,:)*1004./(3900.*XRH00OCEAN)
+DEALLOCATE(ZCOUPUA,ZCOUPVA,ZCOUPUO,ZCOUPVO,ZCOUPTA,ZCOUPTO)
+DEALLOCATE(ZCOUPTFL)
+!
+END SUBROUTINE NHOA_COUPL_n
+
diff --git a/src/MNH/nudging.f90 b/src/MNH/nudging.f90
index 78f0d7894095029980f9e470d7e751ac753acfd9..943a4f10355c4e2b20d1e4eb90982d0967d0be66 100644
--- a/src/MNH/nudging.f90
+++ b/src/MNH/nudging.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2006-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 newsrc 2006/05/24 18:05:52
-!-----------------------------------------------------------------
! ###################
MODULE MODI_NUDGING
! ###################
@@ -79,15 +74,18 @@ END MODULE MODI_NUDGING
!! MODIFICATIONS
!! -------------
!! Original 15/05/06
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
-!
-USE MODI_BUDGET
-!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, &
+ tbudgets
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -114,6 +112,12 @@ REAL :: ZINVTAU ! inverse of nudging time scale
!
!
ZINVTAU=1./PTNUDGING
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'NUD', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'NUD', prvs (:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'NUD', prws (:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NUD', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NUD', prrs (:, :, :, 1) )
!
!* 1. NUGDGING TOWARDS LS FIELDS
! --------------------------
@@ -129,10 +133,10 @@ IF (OUSERV) &
!* 2. BUDGET CALLS
! ------------
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'NUD_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'NUD_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'NUD_BU_RW')
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'NUD_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'NUD_BU_RRV')
-!
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'NUD', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'NUD', prvs (:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'NUD', prws (:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NUD', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NUD', prrs (:, :, :, 1) )
+
END SUBROUTINE NUDGING
diff --git a/src/MNH/num_diff.f90 b/src/MNH/num_diff.f90
index 46ac17c1410d9be1a2e627e77451d1a763bc63f8..65c221c739d179b1116501ac1ce8fe9700be733a 100644
--- a/src/MNH/num_diff.f90
+++ b/src/MNH/num_diff.f90
@@ -129,7 +129,6 @@ END MODULE MODI_NUM_DIFF
!! 'CART' for cartesian box configuration
!! 'MASK' for budget zone defined by a mask
!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
!! Switches for budgets activations:
!!
!! LBU_RU : logical for budget of RU (wind component along x)
@@ -212,24 +211,29 @@ END MODULE MODI_NUM_DIFF
!! J.Escobar : 05/12/2017 : Pb SegFault , correct IF(ONUMDIFTH/OZDIFFU) nesting
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! J. Escobar 09/07/2019: add TTZHALO2*LIST structure, to match all cases of diffusion/U/TH activation T/F
-!!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
!
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_BUDGET
USE MODD_ARGSLIST_ll, ONLY : HALO2LIST_ll
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ 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, &
+ tbudgets
+USE MODD_CONF
+USE MODD_PARAMETERS
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_ll
USE MODE_TYPE_ZDIFFU
-!
+
+USE MODI_SHUMAN
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -295,7 +299,25 @@ INTEGER :: IGRID ! localisation on the model grid
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
GTKEALLOC = SIZE(PTKEM,1) /= 0
-!
+
+if ( lbudget_u .and. onumdifu ) call Budget_store_init( tbudgets(NBUDGET_U ), 'DIF', prus (:, :, :) )
+if ( lbudget_v .and. onumdifu ) call Budget_store_init( tbudgets(NBUDGET_V ), 'DIF', prvs (:, :, :) )
+if ( lbudget_w .and. onumdifu ) call Budget_store_init( tbudgets(NBUDGET_W ), 'DIF', prws (:, :, :) )
+if ( lbudget_th .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'DIF', prths (:, :, :) )
+if ( lbudget_tke .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'DIF', prtkes(:, :, :) )
+if ( lbudget_rv .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'DIF', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RC ), 'DIF', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RR ), 'DIF', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RI ), 'DIF', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RS ), 'DIF', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RG ), 'DIF', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. onumdifth ) call Budget_store_init( tbudgets(NBUDGET_RH ), 'DIF', prrs (:, :, :, 7) )
+if ( lbudget_sv .and. onumdifsv ) then
+ do jsv = 1, ksv
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'DIF', prsvs(:, :, :, jsv) )
+ end do
+end if
+
!-------------------------------------------------------------------------------
!
!* 2. CALL THE NUM_DIFF_ALGO ROUTINE FOR EACH FIELD
@@ -438,23 +460,24 @@ END IF
!* 3. STORES FIELDS IN BUDGET ARRAYS
! ------------------------------
!
-IF (LBUDGET_U .AND. ONUMDIFU ) CALL BUDGET (PRUS,1,'DIF_BU_RU')
-IF (LBUDGET_V .AND. ONUMDIFU ) CALL BUDGET (PRVS,2,'DIF_BU_RV')
-IF (LBUDGET_W .AND. ONUMDIFU ) CALL BUDGET (PRWS,3,'DIF_BU_RW')
-IF (LBUDGET_TH .AND. ONUMDIFTH ) CALL BUDGET (PRTHS,4,'DIF_BU_RTH')
-IF (LBUDGET_TKE .AND. ONUMDIFTH ) CALL BUDGET (PRTKES,5,'DIF_BU_RTKE')
-IF (LBUDGET_RV .AND. ONUMDIFTH ) CALL BUDGET (PRRS(:,:,:,1),6,'DIF_BU_RRV')
-IF (LBUDGET_RC .AND. ONUMDIFTH ) CALL BUDGET (PRRS(:,:,:,2),7,'DIF_BU_RRC')
-IF (LBUDGET_RR .AND. ONUMDIFTH ) CALL BUDGET (PRRS(:,:,:,3),8,'DIF_BU_RRR')
-IF (LBUDGET_RI .AND. ONUMDIFTH ) CALL BUDGET (PRRS(:,:,:,4),9,'DIF_BU_RRI')
-IF (LBUDGET_RS .AND. ONUMDIFTH ) CALL BUDGET (PRRS(:,:,:,5),10,'DIF_BU_RRS')
-IF (LBUDGET_RG .AND. ONUMDIFTH ) CALL BUDGET (PRRS(:,:,:,6),11,'DIF_BU_RRG')
-IF (LBUDGET_RH .AND. ONUMDIFTH ) CALL BUDGET (PRRS(:,:,:,7),12,'DIF_BU_RRH')
-IF (LBUDGET_SV .AND. ONUMDIFSV ) THEN
- DO JSV=1,KSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'DIF_BU_RSV')
- END DO
-END IF
+if ( lbudget_u .and. onumdifu ) call Budget_store_end( tbudgets(NBUDGET_U ), 'DIF', prus (:, :, :) )
+if ( lbudget_v .and. onumdifu ) call Budget_store_end( tbudgets(NBUDGET_V ), 'DIF', prvs (:, :, :) )
+if ( lbudget_w .and. onumdifu ) call Budget_store_end( tbudgets(NBUDGET_W ), 'DIF', prws (:, :, :) )
+if ( lbudget_th .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'DIF', prths (:, :, :) )
+if ( lbudget_tke .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'DIF', prtkes(:, :, :) )
+if ( lbudget_rv .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'DIF', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'DIF', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'DIF', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'DIF', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'DIF', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'DIF', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. onumdifth ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'DIF', prrs (:, :, :, 7) )
+if ( lbudget_sv .and. onumdifsv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'DIF', prsvs(:, :, :, jsv) )
+ end do
+end if
+
!-------------------------------------------------------------------------------
!
!
diff --git a/src/MNH/one_wayn.f90 b/src/MNH/one_wayn.f90
index 8f922a418ec4e95d2703056d878e542c90953261..035f9498615835453bd56cbdf1462d6dabeeeb5c 100644
--- a/src/MNH/one_wayn.f90
+++ b/src/MNH/one_wayn.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.
@@ -117,9 +117,10 @@ SUBROUTINE ONE_WAY_n(KDAD,PTSTEP,KMI,KTCOUNT, &
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! J.Escobar : 18/12/2015 : Correction of bug in bound in // for NHALO <>1
!! Modification 01/2016 (JP Pinty) Add LIMA
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 03/05/2019: restructuration of one_wayn and ini_one_wayn
+! P. Wautelet 04/06/2020: correct call to Set_conc_lima + initialize ZCONCT
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -127,6 +128,7 @@ SUBROUTINE ONE_WAY_n(KDAD,PTSTEP,KMI,KTCOUNT, &
USE MODD_CH_MNHC_n, only: LUSECHAQ, LUSECHIC
USE MODD_CONF, only: CEQNSYS
USE MODD_CST, only: XCPD, XP00, XRD, XRV, XTH00
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_FIELD_n, only: XPABST, XRT, XSVT, XUT, XVT, XWT, XTHT, XTKET
USE MODD_NESTING, only: NXOR_ALL, NXEND_ALL, NYOR_ALL, NYEND_ALL
USE MODD_NSV, only: NSV_A, NSV_C1R3BEG_A, NSV_C1R3_A, NSV_C2R2BEG_A, NSV_C2R2_A, NSV_CHEMBEG_A, NSV_CHEMEND_A, &
@@ -138,6 +140,7 @@ USE MODD_NSV, only: NSV_A, NSV_C1R3BEG_A, NSV_C1R3_A, NSV_C2R2BEG_A,
USE MODD_PARAMETERS, only: JPHEXT, JPVEXT
USE MODD_PARAM_n, only: CCLOUD
+USE MODD_REF, ONLY: LCOUPLES
USE MODD_REF_n, only: XRHODJ, XRHODREF, XRVREF, XTHVREF
!
use mode_bikhardt
@@ -145,12 +148,12 @@ use mode_ll, only: GET_CHILD_DIM_ll, GO_TOMODEL_ll,
LS_FORCING_ll, LWEST_ll, LEAST_ll, LNORTH_ll, LSOUTH_ll, &
SET_LSFIELD_1WAY_ll, UNSET_LSFIELD_1WAY_ll
USE MODE_MODELN_HANDLER, only: GOTO_MODEL
+use mode_set_conc_lima
use mode_sum_ll, only: SUM3D_ll
use mode_tools_ll, only: GET_DIM_EXT_ll
!
USE MODI_SET_CHEMAQ_1WAY
USE MODI_SET_CONC_ICE_C1R3
-USE MODI_SET_CONC_LIMA
USE MODI_SET_CONC_RAIN_C2R2
!
IMPLICIT NONE
@@ -238,6 +241,21 @@ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZCHEMTI
!
integer :: igrid
!
+IF (LCOUPLES) THEN
+ PDRYMASST=0.
+ PDRYMASSS=0.
+ PLBXUS=0.
+ PLBXVS=0.
+ PLBXWS=0.
+ PLBXTHS=0.
+ PLBYTHS=0.
+ PLBXTKES=0.
+ PLBYTKES =0.
+ PLBXRS =0.
+ PLBYRS=0.
+ PLBXSVS =0.
+ PLBYSVS=0.
+ELSE
!-------------------------------------------------------------------------------
!
!* 0. INITIALISATION
@@ -421,12 +439,13 @@ ENDIF
IF (HCLOUD=="LIMA" ) THEN
IF (CCLOUD/="LIMA") THEN
ALLOCATE(ZCONCT(SIZE(XRHODJ,1),SIZE(XRHODJ,2),SIZE(XRHODJ,3),NSV_LIMA_A(KMI)))
+ ZCONCT(:, :, :, :) = 0.
IF (CCLOUD == "REVE") THEN
ZINIT_TYPE = "INI1"
ELSE
ZINIT_TYPE = "NONE"
END IF
- CALL SET_CONC_LIMA (ZINIT_TYPE,XRHODREF,XRT,ZCONCT)
+ CALL SET_CONC_LIMA (KMI,ZINIT_TYPE,XRHODREF,XRT,ZCONCT)
DO JSV=1,NSV_LIMA_A(KMI)
CALL SET_LSFIELD_1WAY_ll(ZCONCT(:,:,:,JSV),&
&ZTSVT(:,:,:,JSV-1+NSV_LIMA_BEG_A(KMI)),KMI)
@@ -765,7 +784,6 @@ END IF
! ------------------------------------------------
!
IF (NSV_A(KMI) > 0) THEN
- ! Users scalar variables
DO JSV = 1,NSV_A(KMI)
IGRID = 1
CALL Compute_LB( PLBXSVM(:,:,:,JSV), PLBYSVM(:,:,:,JSV), PLBXSVS(:,:,:,JSV), PLBYSVS(:,:,:,JSV), &
@@ -789,6 +807,8 @@ DEALLOCATE(ZWORK)
DEALLOCATE(ZCOEFLIN_LBXM_RED,ZCOEFLIN_LBYM_RED,IKLIN_LBXM_RED,IKLIN_LBYM_RED)
!
!------------------------------------------------------------------------------
+ENDIF ! END LCOUPLES coupling
+!
CALL GOTO_MODEL(KMI)
!
END SUBROUTINE ONE_WAY_n
diff --git a/src/MNH/open_prc_files.f90 b/src/MNH/open_prc_files.f90
index bb02f6951579522024fcc1b29da9240a08de5a83..ecf98378f07cd1712e1d68cb4c51bcd853324bd5 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='NETCDF'
!
!-------------------------------------------------------------------------------
!
@@ -211,23 +220,9 @@ CALL POSNAM(IPRE_REAL1,'NAM_FILE_NAMES',GFOUND,ILUOUT0)
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_FILE_NAMES)
CINIFILE_n = CINIFILE
!
-ILEN = LEN_TRIM(HATMFILE)
-IF (ILEN>0) THEN
- YFILE=' '
- YFILE(1:ILEN) = HATMFILE(1:ILEN)
- HATMFILE = ' '
- HATMFILE(1:ILEN) = YFILE(1:ILEN)
-END IF
WRITE(ILUOUT0,*) 'HATMFILE= ', HATMFILE
!
-ILEN = LEN_TRIM(HCHEMFILE)
-IF (ILEN>0) THEN
- YFILE=' '
- YFILE(1:ILEN) = HCHEMFILE(1:ILEN)
- HCHEMFILE = ' '
- HCHEMFILE(1:ILEN) = YFILE(1:ILEN)
- IF (HCHEMFILE==HATMFILE) HCHEMFILE=''
-END IF
+IF (HCHEMFILE==HATMFILE) HCHEMFILE=''
IF (LEN_TRIM(HCHEMFILE)>0 .AND. HATMFILETYPE/='GRIBEX') THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','OPEN_PRC_FILES',&
@@ -235,26 +230,14 @@ IF (LEN_TRIM(HCHEMFILE)>0 .AND. HATMFILETYPE/='GRIBEX') THEN
END IF
WRITE(ILUOUT0,*) 'HCHEMFILE=', HCHEMFILE
!
-ILEN = LEN_TRIM(HSURFFILE)
-IF (ILEN>0) THEN
- YFILE=' '
- YFILE(1:ILEN) = HSURFFILE(1:ILEN)
- HSURFFILE = ' '
- HSURFFILE(1:ILEN) = YFILE(1:ILEN)
-ELSE
- HSURFFILE = HATMFILE
+WRITE(ILUOUT0,*) 'HCAMSFILE=', HCAMSFILE
+!
+IF ( LEN_TRIM( HSURFFILE ) == 0 ) THEN
+ HSURFFILE = HATMFILE
HSURFFILETYPE = HATMFILETYPE
END IF
WRITE(ILUOUT0,*) 'HSURFFILE=', HSURFFILE
!
-ILEN = LEN_TRIM(HPGDFILE)
-IF (ILEN>0) THEN
- YFILE=' '
- YFILE(1:ILEN) = HPGDFILE(1:ILEN)
- HPGDFILE = ' '
- HPGDFILE(1:ILEN) = YFILE(1:ILEN)
-END IF
-!
CINIFILEPGD_n = HPGDFILE
IF (LEN_TRIM(HPGDFILE)==0) THEN
! IF (HATMFILETYPE=='MESONH') THEN
diff --git a/src/MNH/p_abs.f90 b/src/MNH/p_abs.f90
index f00d38d387a7aac873872ace9711472125d33845..1d3e2d6e86e530869ab21319107d62bc45641b79 100644
--- a/src/MNH/p_abs.f90
+++ b/src/MNH/p_abs.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 solver 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! #################
MODULE MODI_P_ABS
! #################
@@ -16,7 +11,7 @@ INTERFACE
!
SUBROUTINE P_ABS (KRR, KRRL, KRRI, PDRYMASST, PREFMASS, PMASS_O_PHI0, &
PTHT, PRT, PRHODJ, PRHODREF, PTHETAV, PTHVREF, &
- PRVREF, PEXNREF, PPHIT )
+ PRVREF, PEXNREF, PPHIT, PPHI0)
!
IMPLICIT NONE
!
@@ -44,7 +39,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF! Exner function of the
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPHIT ! Perturbation of
! either the Exner function Pi or Pi * Cpd * THvref
-!
+REAL, INTENT(INOUT) :: PPHI0 ! Phi0 at time t !
!
END SUBROUTINE P_ABS
!
@@ -54,7 +49,7 @@ END MODULE MODI_P_ABS
! #######################################################################
SUBROUTINE P_ABS (KRR, KRRL, KRRI, PDRYMASST, PREFMASS, PMASS_O_PHI0, &
PTHT, PRT, PRHODJ, PRHODREF, PTHETAV, PTHVREF, &
- PRVREF, PEXNREF, PPHIT )
+ PRVREF, PEXNREF, PPHIT, PPHI0 )
! #######################################################################
!
!!**** *P_ABS * - routine to compute the absolute Exner pressure deviation PHI
@@ -108,6 +103,8 @@ END MODULE MODI_P_ABS
!! from Durran (1989), MAE and DUR respectively
!! 15/06/98 (D.Lugato, R.Guivarch) Parallelisation
!! J. Colin 07/13 Add LBOUSS
+!! J.L Redelsperger 03/2021 Change of one step to pressure computation
+!! in order to perform Ocean runs (equivalent to LHE shallow convection)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -115,14 +112,14 @@ END MODULE MODI_P_ABS
!
USE MODD_CST
USE MODD_CONF
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS, LIBM, XIBM_EPSI
USE MODD_PARAMETERS
-USE MODD_REF, ONLY : LBOUSS
+USE MODD_REF, ONLY: LBOUSS
!
USE MODE_ll
-!JUAN
USE MODE_REPRO_SUM
-!JUAN
-!
+!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -150,6 +147,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVREF ! vapor mixing ratio
REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF! Exner function of the
! reference state
!
+REAL, INTENT(INOUT) :: PPHI0 ! PHI0 at t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PPHIT ! Perturbation of
! either the Exner function Pi or Pi * Cpd * THvref
!
@@ -350,8 +348,13 @@ ELSEIF( CEQNSYS == 'LHE' ) THEN
ZRTOT(:,:,:) = 0.
END IF
!
+ IF (LIBM) THEN
+ WHERE (XIBM_LS(:,:,:,1).GT.-XIBM_EPSI)
+ ZWORK(:,:,:) = PTHVREF(:,:,:)
+ ENDWHERE
+ ENDIF
!
- ! compute the absolute pressure function
+ ! compute the absolute pressure function (LHE equation system case)
!
!
!
@@ -373,8 +376,16 @@ ELSEIF( CEQNSYS == 'LHE' ) THEN
ZMASSGUESS = SUM_DD_R2_ll(ZMASSGUESS_2D)
ZWATERMASST = SUM_DD_R2_ll(ZWATERMASST_2D)
!
- ZPHI0 = (PDRYMASST + ZWATERMASST - 2. * PREFMASS + ZMASSGUESS ) / PMASS_O_PHI0
- PPHIT(:,:,:) = PPHIT(:,:,:) + ZPHI0
+ ! case shallow bouss : to get the real pressure fluctuation
+ ! Eq 2.40 p15 : constant not resolved in poisson equation
+ IF (.NOT. LOCEAN) THEN
+ PPHI0 = (PDRYMASST + ZWATERMASST - 2. * PREFMASS + ZMASSGUESS ) / PMASS_O_PHI0
+ ELSE
+ ! PPHI0 = 0. => to be possibly modified for ocean LES case
+ PPHI0=0.
+ END IF
+ ! following computation moved in PRESSURE routine (Eq 2.40 bis p15: Phi_total)
+ ! PPHIT(:,:,:) = PPHIT(:,:,:) + ZPHI0
!
END IF
!
diff --git a/src/MNH/paspol.f90 b/src/MNH/paspol.f90
index 1a2146b66e5f3b71efebaed0305508bf6888b345..b3043a864dd8f4d66b9f7bae9e3d5d3ded8f1a1a 100644
--- a/src/MNH/paspol.f90
+++ b/src/MNH/paspol.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.
@@ -9,7 +9,7 @@
!
INTERFACE
!
- SUBROUTINE PASPOL (PTSTEP, PSFSV, KLUOUT, KVERB, OCLOSE_OUT, TPFILE)
+ SUBROUTINE PASPOL (PTSTEP, PSFSV, KLUOUT, KVERB, TPFILE)
!
USE MODD_IO, ONLY: TFILEDATA
!
@@ -20,7 +20,6 @@ REAL, INTENT(IN) :: PTSTEP ! Double timestep except
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSFSV ! surface flux of scalars
INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing count
INTEGER, INTENT(IN) :: KVERB ! verbosity level
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! conditional closure of the OUTPUT FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
END SUBROUTINE PASPOL
@@ -29,7 +28,7 @@ END INTERFACE
!
END MODULE MODI_PASPOL
! ######spl
- SUBROUTINE PASPOL (PTSTEP, PSFSV, KLUOUT, KVERB, OCLOSE_OUT, TPFILE)
+ SUBROUTINE PASPOL (PTSTEP, PSFSV, KLUOUT, KVERB, TPFILE)
! ############################################################
!
!
@@ -70,6 +69,7 @@ END MODULE MODI_PASPOL
USE MODD_PARAMETERS
USE MODD_NSV
USE MODD_CST
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODE_GRIDPROJ
USE MODD_PASPOL
@@ -95,7 +95,6 @@ USE MODD_SUB_PASPOL_n
USE MODD_TYPE_DATE
!
USE MODE_DATETIME
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
!
!* 0. DECLARATIONS
! ------------
@@ -110,7 +109,6 @@ REAL, INTENT(IN) :: PTSTEP ! Double timestep except
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSFSV ! surface flux of scalars
INTEGER, INTENT(IN) :: KLUOUT ! unit for output listing count
INTEGER, INTENT(IN) :: KVERB ! verbosity level
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! conditional closure of the OUTPUT FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
!
!* 0.2 declarations of local variables
@@ -217,7 +215,12 @@ IF (GPPFIRSTCALL) THEN
! puis les indices fractionnaires (ZSRCI,ZSRCJ) et entiers
! (IPIGI,IPIGJ) du point de rejet dans le domaine de travail global.
!
- CALL SM_XYHAT(XLATORI,XLONORI,XPPLAT(JSV),XPPLON(JSV),ZSRCX,ZSRCY)
+ IF (LCARTESIAN) THEN !En cartesien ecriture dans la namelist des coordonnees X,Y et non LAT,LON
+ ZSRCX = XPPLAT(JSV)
+ ZSRCY = XPPLON(JSV)
+ ELSE
+ CALL SM_XYHAT(XLATORI,XLONORI,XPPLAT(JSV),XPPLON(JSV),ZSRCX,ZSRCY)
+ END IF
II=MAX(MIN(COUNT(XXHAT(:)<ZSRCX),IIU-1),1)
IJ=MAX(MIN(COUNT(XYHAT(:)<ZSRCY),IJU-1),1)
ZSRCI=(ZSRCX-XXHAT(II))/(XXHAT(II+1)-XXHAT(II))+REAL(II)
@@ -311,7 +314,7 @@ IF (GPPFIRSTCALL) THEN
!* 1.3 Chronologie du rejet.
!
! Eclatement des dates caracteristiques et calcul du
- ! nombre de secondes depuis 0UTC (equiv. TDTCUR%TIME).
+ ! nombre de secondes depuis 0UTC (equiv. TDTCUR%xtime).
!
READ(CPPT1(JSV),'(I4,5I2)') I1YY,I1MM,I1DD,I1HH,I1MN,I1SS
READ(CPPT2(JSV),'(I4,5I2)') I2YY,I2MM,I2DD,I2HH,I2MN,I2SS
@@ -325,10 +328,10 @@ IF (GPPFIRSTCALL) THEN
! Chrono relative au debut du rejet en secondes.
!
ZT1=0.
- TZDATE1%TDATE%YEAR=I1YY;TZDATE1%TDATE%MONTH=I1MM;TZDATE1%TDATE%DAY=I1DD;TZDATE1%TIME=Z1SEC
- TZDATE2%TDATE%YEAR=I2YY;TZDATE2%TDATE%MONTH=I2MM;TZDATE2%TDATE%DAY=I2DD;TZDATE2%TIME=Z2SEC
- TZDATE3%TDATE%YEAR=I3YY;TZDATE3%TDATE%MONTH=I3MM;TZDATE3%TDATE%DAY=I3DD;TZDATE3%TIME=Z3SEC
- TZDATE4%TDATE%YEAR=I4YY;TZDATE4%TDATE%MONTH=I4MM;TZDATE4%TDATE%DAY=I4DD;TZDATE4%TIME=Z4SEC
+ TZDATE1%nyear=I1YY;TZDATE1%nmonth=I1MM;TZDATE1%nday=I1DD;TZDATE1%xtime=Z1SEC
+ TZDATE2%nyear=I2YY;TZDATE2%nmonth=I2MM;TZDATE2%nday=I2DD;TZDATE2%xtime=Z2SEC
+ TZDATE3%nyear=I3YY;TZDATE3%nmonth=I3MM;TZDATE3%nday=I3DD;TZDATE3%xtime=Z3SEC
+ TZDATE4%nyear=I4YY;TZDATE4%nmonth=I4MM;TZDATE4%nday=I4DD;TZDATE4%xtime=Z4SEC
CALL DATETIME_DISTANCE(TZDATE1,TZDATE2,ZT2)
CALL DATETIME_DISTANCE(TZDATE1,TZDATE3,ZT3)
CALL DATETIME_DISTANCE(TZDATE1,TZDATE4,ZT4)
@@ -470,7 +473,7 @@ DO JSV=1,NSV_PP
!
!* 2.2 Distance temporelle DEPUIS le debut de rejet.
!
- TZDATE%TDATE%YEAR=IDEBYY(JSV);TZDATE%TDATE%MONTH=IDEBMM(JSV);TZDATE%TDATE%DAY=IDEBDD(JSV);TZDATE%TIME=ZDEBSS(JSV)
+ TZDATE%nyear=IDEBYY(JSV);TZDATE%nmonth=IDEBMM(JSV);TZDATE%nday=IDEBDD(JSV);TZDATE%xtime=ZDEBSS(JSV)
CALL DATETIME_DISTANCE(TZDATE,TDTCUR,ZDEPUIS)
!
!
@@ -575,7 +578,7 @@ END DO
!
!* 3.4 Ecriture conditionnelle.
!
-IF (OCLOSE_OUT) THEN
+IF ( tpfile%lopened ) THEN
ALLOCATE( ZTEMPO(IIU,IJU,IKU) )
!
TZFIELD%CSTDNAME = ''
diff --git a/src/MNH/phys_paramn.f90 b/src/MNH/phys_paramn.f90
index 24083d0b06fbae3eab309e91a3ac5ac4ff964e31..e0c34e06bd4afba87dd5a3a1fce26ca0d86add68 100644
--- a/src/MNH/phys_paramn.f90
+++ b/src/MNH/phys_paramn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -10,19 +10,17 @@
!
INTERFACE
!
- SUBROUTINE PHYS_PARAM_n(KTCOUNT,TPFILE,OCLOSE_OUT, &
- PRAD,PSHADOWS,PKAFR,PGROUND,PMAFL,PDRAG,PTURB,PTRACER, &
- PTIME_BU, PWETDEPAER, OMASKkids,OCLOUD_ONLY )
+ SUBROUTINE PHYS_PARAM_n( KTCOUNT, TPFILE, &
+ PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PDRAG,PEOL, PTURB, &
+ PTRACER, PTIME_BU, PWETDEPAER, OMASKkids, OCLOUD_ONLY )
!
USE MODD_IO, ONLY: TFILEDATA
use modd_precision, only: MNHTIME
!
INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT! conditional closure of the
- ! OUTPUT FM-file
! advection schemes
-REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER,PEOL ! to store CPU
! time for computing time
REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets statistics
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PWETDEPAER
@@ -36,11 +34,11 @@ END INTERFACE
!
END MODULE MODI_PHYS_PARAM_n
!
-! ######################################################################
- SUBROUTINE PHYS_PARAM_n(KTCOUNT,TPFILE,OCLOSE_OUT, &
- PRAD,PSHADOWS,PKAFR,PGROUND,PMAFL,PDRAG,PTURB,PTRACER, &
- PTIME_BU, PWETDEPAER, OMASKkids,OCLOUD_ONLY )
-! ######################################################################
+! ########################################################################################
+ SUBROUTINE PHYS_PARAM_n( KTCOUNT, TPFILE, &
+ PRAD, PSHADOWS, PKAFR, PGROUND, PMAFL, PEOL, PDRAG, PTURB, &
+ PTRACER, PTIME_BU, PWETDEPAER, OMASKkids, OCLOUD_ONLY )
+! ########################################################################################
!
!!**** *PHYS_PARAM_n * -monitor of the parameterizations used by model _n
!!
@@ -236,122 +234,125 @@ 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
+! 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
! ------------
-!
-USE MODE_DATETIME
-USE MODE_ll
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
-USE MODD_BLANK
-USE MODD_CST
-USE MODD_DYN
+USE MODD_ADV_n, ONLY : XRTKEMS
+USE MODD_ARGSLIST_ll, ONLY : LIST_ll
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_ri, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RI, NBUDGET_SV1, &
+ tbudgets, xtime_bu_process
+USE MODD_CH_AEROSOL
+USE MODD_CH_MNHC_n, ONLY : LUSECHEM, &! indicates if chemistry is used
+ LCH_CONV_SCAV, &
+ LCH_CONV_LINOX
+USE MODD_CLOUD_MF_n
+USE MODD_CONDSAMP
USE MODD_CONF
-USE MODD_FRC
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_GRID
-USE MODD_NSV
-USE MODD_LES
-USE MODD_LES_BUDGET
-!
USE MODD_CONF_n
+USE MODD_CST
USE MODD_CURVCOR_n
+USE MODD_DEEP_CONVECTION_n
+USE MODD_DEF_EDDY_FLUX_n ! Ajout PP
+USE MODD_DEF_EDDYUV_FLUX_n ! Ajout PP
+USE MODD_DRAGBLDG_n
+USE MODD_DRAGTREE_n
+USE MODD_DUST
+USE MODD_DYN
USE MODD_DYN_n
+USE MODD_EOL_MAIN, ONLY: LMAIN_EOL, CMETH_EOL, NMODEL_EOL
USE MODD_FIELD_n
-USE MODD_LSFIELD_n
+USE MODD_FRC
+USE MODD_FRC_n
+USE MODD_GRID
USE MODD_GRID_n
-USE MODD_METRICS_n
+USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_EPSI, XIBM_LS
+USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN_C1R3=>XRTMIN
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LATZ_EDFLX
USE MODD_LBC_n
-USE MODD_REF_n
+USE MODD_LES
+USE MODD_LES_BUDGET
+USE MODD_LSFIELD_n
USE MODD_LUNIT_n
+USE MODD_METRICS_n
+USE MODD_MNH_SURFEX_n
+USE MODD_NESTING, ONLY : XWAY,NDAD, NDXRATIO_ALL, NDYRATIO_ALL
+USE MODD_NSV
+USE MODD_OCEANH
USE MODD_OUT_n
+USE MODD_PARAM_C2R2, ONLY : LSEDC
+USE MODD_PARAMETERS
+USE MODD_PARAM_ICE, ONLY : LSEDIC
+USE MODD_PARAM_KAFR_n
+USE MODD_PARAM_LIMA, ONLY : MSEDC => LSEDC, XRTMIN_LIMA=>XRTMIN
+USE MODD_PARAM_MFSHALL_n
USE MODD_PARAM_n
USE MODD_PARAM_RAD_n
-USE MODD_PARAM_KAFR_n
+USE MODD_PASPOL
+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_REF_n
+USE MODD_SALT
USE MODD_SHADOWS_n
-USE MODD_DEEP_CONVECTION_n
+USE MODD_SUB_PHYS_PARAM_n
USE MODD_TIME_n
-USE MODD_TURB_n
-USE MODD_CH_MNHC_n, ONLY : LUSECHEM, &! indicates if chemistry is used
- LCH_CONV_SCAV, &
- LCH_CONV_LINOX
-USE MODD_PRECIP_n
-USE MODD_PASPOL_n
-USE MODD_BUDGET
-USE MODD_RAIN_ICE_DESCR, ONLY : XRTMIN
-USE MODD_ICE_C1R3_DESCR, ONLY : XRTMIN_C1R3=>XRTMIN
+USE MODD_TIME, ONLY : TDTEXP ! Ajout PP
USE MODD_TURB_CLOUD, ONLY : CTURBLEN_CLOUD,NMODEL_CLOUD, &
XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT
-USE MODD_NESTING, ONLY : XWAY,NDAD, NDXRATIO_ALL, NDYRATIO_ALL
-USE MODD_PARAM_ICE, ONLY : LSEDIC
-USE MODD_PARAM_C2R2, ONLY : LSEDC
-USE MODD_SUB_PHYS_PARAM_n
-!
-USE MODD_PARAM_MFSHALL_n
-USE MODI_SHALLOW_MF_PACK
-USE MODD_CLOUD_MF_n
-USE MODD_ADV_n, ONLY : XRTKEMS
-use modd_precision, only: MNHTIME
-!
-USE MODI_SURF_RAD_MODIF
-USE MODI_GROUND_PARAM_n
-USE MODI_SUNPOS_n
-USE MODI_RADIATIONS
-USE MODI_CONVECTION
-USE MODI_BUDGET
-USE MODI_PASPOL
-USE MODI_CONDSAMP
-USE MODE_MODELN_HANDLER
-USE MODI_SEDIM_DUST
-USE MODI_SEDIM_SALT
-USE MODI_DUST_FILTER
-USE MODI_SALT_FILTER
-USE MODI_DRAG_VEG
-USE MODD_DUST
-USE MODD_SALT
-USE MODD_PASPOL
-USE MODD_CONDSAMP
-USE MODD_CH_AEROSOL
-USE MODE_DUST_PSD
-USE MODE_SALT_PSD
+USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY : XTHW_FLUX, XRCW_FLUX, XSVW_FLUX
+USE MODD_TURB_n
+
USE MODE_AERO_PSD
+use mode_budget, only: Budget_store_end, Budget_store_init
+USE MODE_DATETIME
+USE MODE_DUST_PSD
+USE MODE_ll
USE MODE_MNH_TIMING
-USE MODD_TURB_FLUX_AIRCRAFT_BALLOON, ONLY : XTHW_FLUX, XRCW_FLUX, XSVW_FLUX
-USE MODD_DRAGTREE
-!
-USE MODD_TIME, ONLY : TDTEXP ! Ajout PP
+USE MODE_MODELN_HANDLER
+USE MODE_MPPDB
+USE MODE_SALT_PSD
+USE MODE_TURB
+
USE MODI_AEROZON ! Ajout PP
-!
+USE MODI_CONDSAMP
+USE MODI_CONVECTION
+USE MODI_DRAG_BLD
+USE MODI_DRAG_VEG
+USE MODI_DUST_FILTER
USE MODI_EDDY_FLUX_n ! Ajout PP
-USE MODI_EDDYUV_FLUX_n ! Ajout PP
USE MODI_EDDY_FLUX_ONE_WAY_n ! Ajout PP
+USE MODI_EDDYUV_FLUX_n ! Ajout PP
USE MODI_EDDYUV_FLUX_ONE_WAY_n ! Ajout PP
-USE MODD_DEF_EDDY_FLUX_n ! Ajout PP
-USE MODD_DEF_EDDYUV_FLUX_n ! Ajout PP
-USE MODD_LATZ_EDFLX
-USE MODD_MNH_SURFEX_n
+USE MODI_EOL_MAIN
+USE MODI_GROUND_PARAM_n
+USE MODI_PASPOL
+USE MODI_RADIATIONS
+USE MODI_SALT_FILTER
+USE MODI_SEDIM_DUST
+USE MODI_SEDIM_SALT
+USE MODI_SHALLOW_MF_PACK
+USE MODI_SUNPOS_n
+USE MODI_SURF_RAD_MODIF
USE MODI_SWITCH_SBG_LES_N
-USE MODD_TIME_n
-!
-USE MODD_PARAM_LIMA, ONLY : MSEDC => LSEDC, XRTMIN_LIMA=>XRTMIN
-!
-USE MODE_MPPDB
-USE MODE_TURB
-!
+
IMPLICIT NONE
!
!* 0.1 declarations of arguments
!
INTEGER, INTENT(IN) :: KTCOUNT ! temporal iteration count
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Synchronous output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT! conditional closure of the
- ! OUTPUT FM-file
! advection schemes
-REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER ! to store CPU
+REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PRAD,PSHADOWS,PKAFR,PGROUND,PTURB,PMAFL,PDRAG,PTRACER,PEOL ! to store CPU
! time for computing time
REAL(kind=MNHTIME), DIMENSION(2), INTENT(INOUT) :: PTIME_BU ! time used in budget&LES budgets statistics
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PWETDEPAER
@@ -445,9 +446,14 @@ INTEGER :: IKIDM ! index loop
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSAVE_INPRR,ZSAVE_INPRS,ZSAVE_INPRG,ZSAVE_INPRH
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZSAVE_INPRC,ZSAVE_PRCONV,ZSAVE_PRSCONV
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSAVE_DIRFLASWD, ZSAVE_SCAFLASWD,ZSAVE_DIRSRFSWD
+! for ocean model
+INTEGER :: JKM , JSW ! vertical index loop
+REAL :: ZSWA,TINTSW ! index for SW interpolation and int time betwenn forcings (ocean model)
+REAL, DIMENSION(:), ALLOCATABLE :: ZIZOCE(:) ! Solar flux penetrating in ocean
+REAL, DIMENSION(:), ALLOCATABLE :: ZPROSOL1(:),ZPROSOL2(:) ! Funtions for penetrating solar flux
!
!-----------------------------------------------------------------------------
-!
+
NULLIFY(TZFIELDS_ll)
IMI=GET_CURRENT_MODEL_INDEX()
!
@@ -699,7 +705,7 @@ CALL SUNPOS_n ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL )
! ------------------------------
!
CASE('FIXE')
- ZTIME = MOD(TDTCUR%TIME +XLON0*240., XDAY)
+ ZTIME = MOD(TDTCUR%xtime +XLON0*240., XDAY)
IHOUR = INT( ZTIME/3600. )
IF (IHOUR < 0) IHOUR=IHOUR + 24
ZDT = ZTIME/3600. - REAL(IHOUR)
@@ -726,20 +732,37 @@ CALL SUNPOS_n ( XZENITH, ZCOSZEN, ZSINZEN, ZAZIMSOL )
XLWD(:,:,:)=0.0
XDTHRADSW(:,:,:)=0.0
XDTHRADLW(:,:,:)=0.0
- CALL RADIATIONS ( OCLOSE_OUT, TPFILE, &
- LCLEAR_SKY,OCLOUD_ONLY, NCLEARCOL_TM1,CEFRADL, CEFRADI,COPWSW,COPISW,&
- COPWLW,COPILW, XFUDG, &
- NDLON, NFLEV, NRAD_DIAG, NFLUX, NRAD,NAER,NSWB_OLD,NSWB_MNH,NLWB_MNH, &
- NSTATM, NRAD_COLNBR, ZCOSZEN, XSEA, XCORSOL, &
- XDIR_ALB, XSCA_ALB, XEMIS, XCLDFR, XCCO2, XTSRAD, XSTATM, XTHT, XRT, &
- XPABST,XOZON, XAER,XDST_WL, XAER_CLIM, XSVT, &
- XDTHRAD, XFLALWD, XDIRFLASWD, XSCAFLASWD, XRHODREF, XZZ , &
- XRADEFF, XSWU, XSWD, XLWU, XLWD, XDTHRADSW, XDTHRADLW )
+ CALL RADIATIONS( TPFILE, &
+ LCLEAR_SKY, OCLOUD_ONLY, NCLEARCOL_TM1, CEFRADL, CEFRADI, COPWSW, COPISW, &
+ COPWLW, COPILW, XFUDG, &
+ NDLON, NFLEV, NRAD_DIAG, NFLUX, NRAD, NAER, NSWB_OLD, NSWB_MNH, NLWB_MNH, &
+ NSTATM, NRAD_COLNBR, ZCOSZEN, XSEA, XCORSOL, &
+ XDIR_ALB, XSCA_ALB, XEMIS, XCLDFR, XCCO2, XTSRAD, XSTATM, XTHT, XRT, &
+ XPABST, XOZON, XAER,XDST_WL, XAER_CLIM, XSVT, &
+ XDTHRAD, XFLALWD, XDIRFLASWD, XSCAFLASWD, XRHODREF, XZZ , &
+ XRADEFF, XSWU, XSWD, XLWU, XLWD, XDTHRADSW, XDTHRADLW )
!
WRITE(UNIT=ILUOUT,FMT='(" RADIATIONS called for KTCOUNT=",I6, &
& "with the CLOUD_ONLY option set ",L2)') KTCOUNT,OCLOUD_ONLY
!
+ !
+ WHERE (XDIRFLASWD.LT.0.0)
+ XDIRFLASWD=0.0
+ ENDWHERE
+ !
+ WHERE (XDIRFLASWD.GT.1500.0)
+ XDIRFLASWD=1500.0
+ ENDWHERE
+ !
+ WHERE (XSCAFLASWD.LT.0.0)
+ XSCAFLASWD=0.0
+ ENDWHERE
+ !
+ WHERE (XSCAFLASWD.GT.1500.0)
+ XSCAFLASWD=1500.0
+ ENDWHERE
+ !
WHERE( XDIRFLASWD(:,:,1) + XSCAFLASWD(:,:,1) >0. )
XALBUV(:,:) = ( XDIR_ALB(:,:,1) * XDIRFLASWD(:,:,1) &
+ XSCA_ALB(:,:,1) * XSCAFLASWD(:,:,1) ) &
@@ -785,13 +808,52 @@ END IF
! ------------------------------
!
IF (CRAD /='NONE') THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'RAD', xrths(:, :, :) )
XRTHS(:,:,:) = XRTHS(:,:,:) + XRHODJ(:,:,:)*XDTHRAD(:,:,:)
+ if ( lbudget_th ) call Budget_store_end ( tbudgets(NBUDGET_TH), 'RAD', xrths(:, :, :) )
END IF
!
-!* 1.6 budget storage
-! --------------
!
-IF (CRAD/='NONE' .AND. LBUDGET_TH) CALL BUDGET (XRTHS,4,'RAD_BU_RTH')
+!* 1.6 Ocean case:
+! Sfc turbulent fluxes & Radiative tendency due to SW penetrating ocean
+!
+IF (LOCEAN .AND. (.NOT.LCOUPLES)) THEN
+!
+ ALLOCATE( ZIZOCE(IKU)); ZIZOCE(:)=0.
+ ALLOCATE( ZPROSOL1(IKU))
+ ALLOCATE( ZPROSOL2(IKU))
+ ALLOCATE(XSSUFL(IIU,IJU))
+ ALLOCATE(XSSVFL(IIU,IJU))
+ ALLOCATE(XSSTFL(IIU,IJU))
+ ALLOCATE(XSSOLA(IIU,IJU))
+ ! Time interpolation
+ JSW = INT(TDTCUR%xtime/REAL(NINFRT))
+ ZSWA = TDTCUR%xtime/REAL(NINFRT)-REAL(JSW)
+ XSSTFL = (XSSTFL_T(JSW+1)*(1.-ZSWA)+XSSTFL_T(JSW+2)*ZSWA)
+ XSSUFL = (XSSUFL_T(JSW+1)*(1.-ZSWA)+XSSUFL_T(JSW+2)*ZSWA)
+ XSSVFL = (XSSVFL_T(JSW+1)*(1.-ZSWA)+XSSVFL_T(JSW+2)*ZSWA)
+!
+ ZIZOCE(IKU) = XSSOLA_T(JSW+1)*(1.-ZSWA)+XSSOLA_T(JSW+2)*ZSWA
+ ZPROSOL1(IKU) = XROC*ZIZOCE(IKU)
+ ZPROSOL2(IKU) = (1.-XROC)*ZIZOCE(IKU)
+ IF(NVERB >= 5 ) THEN
+ WRITE(ILUOUT,*)'ZSWA JSW TDTCUR XTSTEP FT FU FV SolarR(IKU)', NINFRT, ZSWA,JSW,&
+ TDTCUR%xtime, XTSTEP, XSSTFL(2,2), XSSUFL(2,2),XSSVFL(2,2),ZIZOCE(IKU)
+ END IF
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'OCEAN', xrths(:, :, :) )
+ DO JKM=IKU-1,2,-1
+ ZPROSOL1(JKM) = ZPROSOL1(JKM+1)* exp(-XDZZ(2,2,JKM)/XD1)
+ ZPROSOL2(JKM) = ZPROSOL2(JKM+1)* exp(-XDZZ(2,2,JKM)/XD2)
+ ZIZOCE(JKM) = (ZPROSOL1(JKM+1)-ZPROSOL1(JKM) + ZPROSOL2(JKM+1)-ZPROSOL2(JKM))/XDZZ(2,2,JKM)
+ ! Adding to temperature tendency, the solar radiation penetrating in ocean
+ XRTHS(:,:,JKM) = XRTHS(:,:,JKM) + XRHODJ(:,:,JKM)*ZIZOCE(JKM)
+ END DO
+ if ( lbudget_th ) call Budget_store_end ( tbudgets(NBUDGET_TH), 'OCEAN', xrths(:, :, :) )
+ DEALLOCATE( ZIZOCE)
+ DEALLOCATE (ZPROSOL1)
+ DEALLOCATE (ZPROSOL2)
+END IF
+!
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -812,7 +874,17 @@ XTIME_LES_BU_PROCESS = 0.
!
CALL SECOND_MNH2(ZTIME1)
!
-IF( CDCONV /= 'NONE' .OR. CSCONV == 'KAFR' ) THEN
+IF( CDCONV == 'KAFR' .OR. CSCONV == 'KAFR' ) THEN
+
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DCONV', xrths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'DCONV', xrrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DCONV', xrrs (:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DCONV', xrrs (:, :, :, 4) )
+ if ( lbudget_sv .and. lchtrans ) then
+ do jsv = 1, size( xrsvs, 4 )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'DCONV', xrsvs (:, :, :, jsv) )
+ end do
+ end if
!
! test to see if the deep convection scheme should be called
!
@@ -1046,21 +1118,17 @@ END IF
XRTHS(:,:,:) = XRTHS(:,:,:) - XRHODJ(:,:,:) / XCPD * ( &
XLVTT * XDRCCONV(:,:,:) + XLSTT * XDRICONV(:,:,:) ) *&
( XP00 / XPABST(:,:,:) ) ** ( XRD / XCPD )
- END IF
-END IF
-!
-! budget storage
-!
-IF (CDCONV == 'KAFR' .OR. CSCONV == 'KAFR' ) THEN
- IF (LBUDGET_TH) CALL BUDGET (XRTHS,4,'DCONV_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (XRRS(:,:,:,1),6,'DCONV_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (XRRS(:,:,:,2),7,'DCONV_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (XRRS(:,:,:,4),9,'DCONV_BU_RRI')
- IF (LCHTRANS .AND. LBUDGET_SV) THEN
- DO JSV = 1, SIZE(XRSVS,4)
- CALL BUDGET (XRSVS(:,:,:,JSV),JSV+12,'DCONV_BU_RSV')
- END DO
END IF
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DCONV', xrths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'DCONV', xrrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DCONV', xrrs (:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DCONV', xrrs (:, :, :, 4) )
+ if ( lbudget_sv .and. lchtrans ) then
+ do jsv = 1, size( xrsvs, 4 )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'DCONV', xrsvs (:, :, :, jsv) )
+ end do
+ end if
END IF
!
CALL SECOND_MNH2(ZTIME2)
@@ -1155,6 +1223,20 @@ IF (CSURF=='EXTE') THEN
CALL GROUND_PARAM_n(ZSFTH, ZSFRV, ZSFSV, ZSFCO2, ZSFU, ZSFV, &
ZDIR_ALB, ZSCA_ALB, ZEMIS, ZTSRAD )
!
+ IF (LIBM) THEN
+ WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI)
+ ZSFTH(:,:)=0.
+ ZSFRV(:,:)=0.
+ ZSFU (:,:)=0.
+ ZSFV (:,:)=0.
+ ENDWHERE
+ IF (NSV>0) THEN
+ DO JSV = 1 , NSV
+ WHERE(XIBM_LS(:,:,IKB,1).GT.-XIBM_EPSI) ZSFSV(:,:,JSV)=0.
+ ENDDO
+ ENDIF
+ ENDIF
+ !
IF (SIZE(XEMIS)>0) THEN
XDIR_ALB = ZDIR_ALB
XSCA_ALB = ZSCA_ALB
@@ -1217,7 +1299,7 @@ END IF
!
ZTIME1 = ZTIME2
!
-IF (LPASPOL) CALL PASPOL(XTSTEP, ZSFSV, ILUOUT, NVERB, OCLOSE_OUT, TPFILE)
+IF (LPASPOL) CALL PASPOL(XTSTEP, ZSFSV, ILUOUT, NVERB, TPFILE)
!
!
!* 4b. PASSIVE POLLUTANTS FOR MASS-FLUX SCHEME DIAGNOSTICS
@@ -1230,17 +1312,18 @@ CALL SECOND_MNH2(ZTIME2)
PTRACER = PTRACER + ZTIME2 - ZTIME1
!-----------------------------------------------------------------------------
!
-!* 5. Drag force
+!* 5a. Drag force
! ----------
!
ZTIME1 = ZTIME2
XTIME_BU_PROCESS = 0.
XTIME_LES_BU_PROCESS = 0.
!
-IF (LDRAGTREE) CALL DRAG_VEG(XTSTEP,XUT,XVT,XTKET,LDEPOTREE,XVDEPOTREE, &
- CCLOUD, XPABST,XTHT,XRT,XSVT, &
- XRHODJ,XZZ,XRUS, XRVS, &
- XRTKES,XRTHS, XRRS,XRSVS)
+IF (LDRAGTREE) CALL DRAG_VEG( XTSTEP, XUT, XVT, XTKET, LDEPOTREE, XVDEPOTREE, &
+ CCLOUD, XPABST, XTHT, XRT, XSVT, XRHODJ, XZZ, &
+ XRUS, XRVS, XRTKES, XRRS, XRSVS )
+!
+IF (LDRAGBLDG) CALL DRAG_BLD( XTSTEP, XUT, XVT, XTKET, XRHODJ, XZZ, XRUS, XRVS, XRTKES )
!
CALL SECOND_MNH2(ZTIME2)
!
@@ -1249,6 +1332,29 @@ PDRAG = PDRAG + ZTIME2 - ZTIME1 &
!
PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
!
+!* 5b. Drag force from wind turbines
+! -----------------------
+!
+ZTIME1 = ZTIME2
+XTIME_BU_PROCESS = 0.
+XTIME_LES_BU_PROCESS = 0.
+!
+IF (LMAIN_EOL .AND. IMI == NMODEL_EOL) THEN
+ CALL EOL_MAIN(KTCOUNT,XTSTEP, &
+ XDXX,XDYY,XDZZ, &
+ XRHODJ, &
+ XUT,XVT,XWT, &
+ XRUS, XRVS, XRWS )
+END IF
+!
+CALL SECOND_MNH2(ZTIME2)
+!
+PEOL = PEOL + ZTIME2 - ZTIME1 &
+ - XTIME_LES_BU_PROCESS - XTIME_BU_PROCESS
+!
+PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
+!
+!*
!-----------------------------------------------------------------------------
!
!* 6. TURBULENCE SCHEME
@@ -1303,6 +1409,7 @@ IF ( CTURB == 'TKEL' ) THEN
ENDIF
ZSFCO2(IIB-1,:)=ZSFCO2(IIB,:)
END IF
+ !
IF ( CLBCX(2) /= "CYCL" .AND. LEAST_ll()) THEN
ZSFTH(IIE+1,:)=ZSFTH(IIE,:)
ZSFRV(IIE+1,:)=ZSFRV(IIE,:)
@@ -1316,6 +1423,7 @@ IF ( CTURB == 'TKEL' ) THEN
ENDIF
ZSFCO2(IIE+1,:)=ZSFCO2(IIE,:)
END IF
+ !
IF ( CLBCY(1) /= "CYCL" .AND. LSOUTH_ll()) THEN
ZSFTH(:,IJB-1)=ZSFTH(:,IJB)
ZSFRV(:,IJB-1)=ZSFRV(:,IJB)
@@ -1329,6 +1437,7 @@ IF ( CTURB == 'TKEL' ) THEN
ENDIF
ZSFCO2(:,IJB-1)=ZSFCO2(:,IJB)
END IF
+ !
IF ( CLBCY(2) /= "CYCL" .AND. LNORTH_ll()) THEN
ZSFTH(:,IJE+1)=ZSFTH(:,IJE)
ZSFRV(:,IJE+1)=ZSFRV(:,IJE)
@@ -1370,19 +1479,19 @@ ELSE
ALLOCATE(XSVW_FLUX(SIZE(XSVT,1),SIZE(XSVT,2),SIZE(XSVT,3),SIZE(XSVT,4)))
END IF
!
- CALL TURB(1,IKU,1,IMI,NRR, NRRL, NRRI, CLBCX, CLBCY, 1,NMODEL_CLOUD, &
- OCLOSE_OUT,LTURB_FLX,LTURB_DIAG,LSUBG_COND,LRMC01, &
- CTURBDIM,CTURBLEN,CTOM,CTURBLEN_CLOUD,CCLOUD,XIMPL, &
- XTSTEP,TPFILE, &
- XDXX,XDYY,XDZZ,XDZX,XDZY,XZZ, &
- XDIRCOSXW,XDIRCOSYW,XDIRCOSZW,XCOSSLOPE,XSINSLOPE, &
- XRHODJ,XTHVREF, &
- ZSFTH,ZSFRV,ZSFSV,ZSFU,ZSFV, &
- XPABST,XUT,XVT,XWT,XTKET,XSVT,XSRCT,XBL_DEPTH,XSBL_DEPTH, &
- XCEI,XCEI_MIN,XCEI_MAX,XCOEF_AMPL_SAT, &
- XTHT,XRT, &
- XRUS,XRVS,XRWS,XRTHS,XRRS,XRSVS,XRTKES,XRTKEMS, XSIGS, XWTHVMF, &
- XTHW_FLUX, XRCW_FLUX, XSVW_FLUX,XDYP, XTHP, XTR, XDISS, XLEM )
+ CALL TURB( 1, IKU, 1, IMI, NRR, NRRL, NRRI, CLBCX, CLBCY, 1, NMODEL_CLOUD, &
+ LTURB_FLX, LTURB_DIAG, LSUBG_COND, LRMC01, &
+ CTURBDIM, CTURBLEN, CTOM, CTURBLEN_CLOUD, CCLOUD,XIMPL, &
+ XTSTEP, TPFILE, &
+ XDXX, XDYY, XDZZ, XDZX, XDZY, XZZ, &
+ XDIRCOSXW, XDIRCOSYW, XDIRCOSZW, XCOSSLOPE, XSINSLOPE, &
+ XRHODJ, XTHVREF, &
+ ZSFTH, ZSFRV, ZSFSV, ZSFU, ZSFV, &
+ XPABST, XUT, XVT, XWT, XTKET, XSVT, XSRCT, XBL_DEPTH, XSBL_DEPTH, &
+ XCEI, XCEI_MIN, XCEI_MAX, XCOEF_AMPL_SAT, &
+ XTHT, XRT, &
+ XRUS, XRVS, XRWS, XRTHS, XRRS, XRSVS, XRTKES, XRTKEMS, XSIGS, XWTHVMF, &
+ XTHW_FLUX, XRCW_FLUX, XSVW_FLUX,XDYP, XTHP, XTR, XDISS, XLEM )
!
IF (LRMC01) THEN
CALL ADD2DFIELD_ll( TZFIELDS_ll, XSBL_DEPTH, 'PHYS_PARAM_n::XSBL_DEPTH' )
@@ -1423,7 +1532,7 @@ IF (CSCONV == 'EDKF') THEN
CALL MPPDB_CHECK3D(ZEXN,"physparam.7::ZEXN",PRECISION)
!
CALL SHALLOW_MF_PACK(NRR,NRRL,NRRI, CMF_UPDRAFT, CMF_CLOUD, LMIXUV, &
- OCLOSE_OUT,LMF_FLX,TPFILE,ZTIME_LES_MF, &
+ LMF_FLX,TPFILE,ZTIME_LES_MF, &
XIMPL_MF, XTSTEP, &
XDZZ, XZZ, &
XRHODJ, XRHODREF, XPABST, ZEXN, ZSFTH, ZSFRV, &
@@ -1466,7 +1575,14 @@ PMAFL = PMAFL + ZTIME4 - ZTIME3 - ZTIME_LES_MF
PTIME_BU = PTIME_BU + XTIME_LES_BU_PROCESS + XTIME_BU_PROCESS
!
!
+!* deallocate sf flux array for ocean model (in grid nesting, dimensions can vary)
!
+IF (LOCEAN .AND. (.NOT. LCOUPLES)) THEN
+ DEALLOCATE(XSSUFL)
+ DEALLOCATE(XSSVFL)
+ DEALLOCATE(XSSTFL)
+ DEALLOCATE(XSSOLA)
+END IF
!-------------------------------------------------------------------------------
!
!* deallocation of variables used in more than one parameterization
diff --git a/src/MNH/prandtl.f90 b/src/MNH/prandtl.f90
index 89a3542ca3a579a12a19d0189fc302e783d9cbdb..9442f71eb20b9b0ecad3ac894793d7dd0d7c80ed 100644
--- a/src/MNH/prandtl.f90
+++ b/src/MNH/prandtl.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.
@@ -9,7 +9,7 @@
!
INTERFACE
!
- SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OCLOSE_OUT,OTURB_DIAG,&
+ SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_DIAG, &
HTURBDIM, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -30,8 +30,6 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRI ! number of ice var.
!
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
! diagnostic fields in the syncronous FM-file
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
@@ -78,7 +76,7 @@ END MODULE MODI_PRANDTL
!
!
! ###########################################################
- SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OCLOSE_OUT,OTURB_DIAG,&
+ SUBROUTINE PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_DIAG, &
HTURBDIM, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -190,6 +188,7 @@ END MODULE MODI_PRANDTL
!! M.Moge 04/2016 Use openACC directives to port the TURB part of Meso-NH on GPU
!! 2017-09 J.Escobar, use epsilon XMNH_TINY_12 for R*4
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! JL Redelsperger 03/2021 : adding Ocean case for temperature only
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -198,16 +197,17 @@ END MODULE MODI_PRANDTL
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
-!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
#ifdef MNH_OPENACC
use mode_msg
#endif
-!
+
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
@@ -232,8 +232,6 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRI ! number of ice var.
!
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
! diagnostic fields in the syncronous FM-file
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Kind of turbulence param.
@@ -362,37 +360,56 @@ PEMOIST(:,:,KKA) = 2.*PEMOIST(:,:,IKB) - PEMOIST(:,:,IKB+KKL)
! 1.3 1D Redelsperger numbers
!
#ifndef MNH_OPENACC
-PBLL_O_E(:,:,:) = MZM( XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
-IF (KRR /= 0) THEN ! moist case
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
- & GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
- PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * &
- & GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)
-ELSE ! dry case
+IF (LOCEAN) THEN
+ PBLL_O_E(:,:,:) = MZM(XG *XALPHAOC* PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
PREDR1(:,:,:) = 0.
+ELSE
+ PBLL_O_E(:,:,:) = MZM(XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:) )
+ IF (KRR /= 0) THEN ! moist case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * &
+ & GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * &
+ & GZ_M_W(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ)
+ ELSE ! dry case
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * GZ_M_W(KKA,KKU,KKL,PTHLM,PDZZ)
+ PREDR1(:,:,:) = 0.
+ END IF
+!
END IF
#else
+IF (LOCEAN) THEN
!$acc kernels
-ZTMP1_DEVICE(:,:,:) = XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:)
+ ZTMP1_DEVICE(:,:,:) = XG * XALPHAOC * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:)
!$acc end kernels
-CALL MZM_DEVICE(ZTMP1_DEVICE,PBLL_O_E)
-IF (KRR /= 0) THEN ! moist case
+ CALL MZM_DEVICE(ZTMP1_DEVICE,PBLL_O_E)
CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PTHLM,PDZZ,ZTMP1_DEVICE)
+!$acc kernels
+ PREDTH1(:,:,:) = XCTV * PBLL_O_E(:,:,:) * ZTMP1_DEVICE
+ PREDR1(:,:,:) = 0.
+!$acc end kernels
+ELSE
+!$acc kernels
+ ZTMP1_DEVICE(:,:,:) = XG / PTHVREF(:,:,:) * PLM(:,:,:) * PLEPS(:,:,:) / PTKEM(:,:,:)
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,PBLL_O_E)
+ IF (KRR /= 0) THEN ! moist case
+ CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PTHLM,PDZZ,ZTMP1_DEVICE)
!$acc kernels async
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * ZTMP1_DEVICE
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * PETHETA(:,:,:) * ZTMP1_DEVICE
!$acc end kernels
- CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ,ZTMP2_DEVICE)
+ CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1),PDZZ,ZTMP2_DEVICE)
!$acc kernels async
- PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * ZTMP2_DEVICE
+ PREDR1(:,:,:) = XCTV*PBLL_O_E(:,:,:) * PEMOIST(:,:,:) * ZTMP2_DEVICE
!$acc end kernels
!$acc wait
-ELSE ! dry case
- CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PTHLM,PDZZ,ZTMP1_DEVICE)
+ ELSE ! dry case
+ CALL GZ_M_W_DEVICE(KKA,KKU,KKL,PTHLM,PDZZ,ZTMP1_DEVICE)
!$acc kernels
- PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * ZTMP1_DEVICE
- PREDR1(:,:,:) = 0.
+ PREDTH1(:,:,:)= XCTV*PBLL_O_E(:,:,:) * ZTMP1_DEVICE
+ PREDR1(:,:,:) = 0.
!$acc end kernels
+ END IF
END IF
#endif
!
@@ -434,9 +451,11 @@ PREDR1 (:,:,:) = PREDR1 (:,:,:) * ZW1(:,:,:)
ZW2=SIGN(1.,PREDTH1(:,:,:))
PREDTH1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDTH1(:,:,:))
!
-IF (KRR /= 0) THEN ! dry case
- ZW2=SIGN(1.,PREDR1(:,:,:))
- PREDR1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDR1(:,:,:))
+IF (.NOT.LOCEAN) THEN
+ IF (KRR /= 0) THEN ! dry case
+ ZW2=SIGN(1.,PREDR1(:,:,:))
+ PREDR1(:,:,:)= ZW2(:,:,:) * MAX(XMNH_TINY_12, ZW2(:,:,:)*PREDR1(:,:,:))
+ END IF
END IF
!$acc end kernels
!
@@ -805,80 +824,111 @@ IF(HTURBDIM=='1DIM') THEN
ELSE IF (L2D) THEN ! 3D case in a 2D model
!
#ifndef MNH_OPENACC
- DO JSV=1,ISV
+ IF (LOCEAN) THEN
#ifndef MNH_BITREP
IF (KRR /= 0) THEN
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2 ) *PETHETA
ELSE
- ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
- END IF
+ ZW1 = MZM((XG *XALPHAOC * PLM * PLEPS / PTKEM)**2)
+ END IF
#else
IF (KRR /= 0) THEN
- ZW1 = MZM( BR_P2(XG / PTHVREF * PLM * PLEPS / PTKEM) ) *PETHETA
+ ZW1 = MZM( BR_P2(XG *XALPHAOC * PLM * PLEPS / PTKEM) ) *PETHETA
ELSE
- ZW1 = MZM( BR_P2(XG / PTHVREF * PLM * PLEPS / PTKEM))
- END IF
+ ZW1 = MZM( BR_P2(XG *XALPHAOC * PLM * PLEPS / PTKEM) )
+ END IF
#endif
+ ELSE
+ DO JSV=1,ISV
+#ifndef MNH_BITREP
+ IF (KRR /= 0) THEN
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2 ) *PETHETA
+ ELSE
+ ZW1 = MZM( (XG / PTHVREF * PLM * PLEPS / PTKEM)**2)
+ END IF
#else
- DO JSV=1,ISV
+ IF (KRR /= 0) THEN
+ ZW1 = MZM( BR_P2(XG / PTHVREF * PLM * PLEPS / PTKEM) ) *PETHETA
+ ELSE
+ ZW1 = MZM( BR_P2(XG / PTHVREF * PLM * PLEPS / PTKEM))
+ END IF
+#endif
+#else
+ IF (LOCEAN) THEN
!$acc kernels
#ifndef MNH_BITREP
- ZTMP1_DEVICE = (XG / PTHVREF * PLM * PLEPS / PTKEM)**2
+ ZTMP1_DEVICE = (XG * XALPHAOC *PLM * PLEPS / PTKEM)**2
#else
- ZTMP1_DEVICE = BR_P2(XG / PTHVREF * PLM * PLEPS / PTKEM)
+ ZTMP1_DEVICE = BR_P2(XG * XALPHAOC *PLM * PLEPS / PTKEM)
#endif
!$acc end kernels
CALL MZM_DEVICE(ZTMP1_DEVICE,ZW1)
IF (KRR /= 0) THEN
!$acc kernels
- ZW1 = ZW1*PETHETA
+ ZW1 = ZW1 * PETHETA
!$acc end kernels
END IF
+ ELSE
+ DO JSV=1,ISV
+!$acc kernels
+#ifndef MNH_BITREP
+ ZTMP1_DEVICE = (XG / PTHVREF * PLM * PLEPS / PTKEM)**2
+#else
+ ZTMP1_DEVICE = BR_P2(XG / PTHVREF * PLM * PLEPS / PTKEM)
+#endif
+!$acc end kernels
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZW1)
+ IF (KRR /= 0) THEN
+!$acc kernels
+ ZW1 = ZW1*PETHETA
+!$acc end kernels
+ END IF
#endif
!
#ifndef MNH_OPENACC
- PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1* &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1* &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PTHLM,PDXX,PDZZ,PDZX) &
)
#else
- CALL GX_M_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
- CALL GX_M_M_DEVICE(KKA,KKU,KKL,PTHLM ,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PTHLM ,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
!$acc kernels
ZTMP1_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
!$acc end kernels
- CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
!$acc kernels
- PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + ZW1 * ZTMP2_DEVICE
+ PRED2THS3(:,:,:,JSV) = PREDTH1(:,:,:) * PREDS1(:,:,:,JSV) + ZW1 * ZTMP2_DEVICE
!$acc end kernels
#endif
!
- IF (KRR /= 0) THEN
+ IF (KRR /= 0) THEN
#ifndef MNH_OPENACC
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1 * PEMOIST * &
- MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
- GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * &
+ MZM(GX_M_M(PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX)* &
+ GX_M_M(PRM(:,:,:,1),PDXX,PDZZ,PDZX) &
)
#else
- CALL GX_M_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
- CALL GX_M_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1) ,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PSVM(:,:,:,JSV),PDXX,PDZZ,PDZX,ZTMP1_DEVICE)
+ CALL GX_M_M_DEVICE(KKA,KKU,KKL,PRM(:,:,:,1) ,PDXX,PDZZ,PDZX,ZTMP2_DEVICE)
!$acc kernels
- ZTMP1_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
+ ZTMP1_DEVICE = ZTMP1_DEVICE*ZTMP2_DEVICE
!$acc end kernels
- CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
+ CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
!$acc kernels
- PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
- ZW1 * PEMOIST * ZTMP2_DEVICE
+ PRED2RS3(:,:,:,JSV) = PREDR1(:,:,:) * PREDS1(:,:,:,JSV) + &
+ ZW1 * PEMOIST * ZTMP2_DEVICE
!$acc end kernels
#endif
- ELSE
+ ELSE
!$acc kernels
- PRED2RS3(:,:,:,JSV) = 0.
+ PRED2RS3(:,:,:,JSV) = 0.
!$acc end kernels
- END IF
- ENDDO
+ END IF
+ ENDDO
+ END IF
!
ELSE ! 3D case in a 3D model
!
@@ -973,7 +1023,7 @@ END IF ! end of HTURBDIM if-block
!* 6. SAVES THE REDELSPERGER NUMBERS
! ------------------------------
!
-IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
!$acc update self(PREDTH1,PREDR1,PRED2TH3,PRED2R3,PRED2THR3)
!
! stores the RED_TH1
diff --git a/src/MNH/prep_ideal_case.f90 b/src/MNH/prep_ideal_case.f90
index 14b2b23d9656a02d21026556004155021b827b07..370e214120d671ca8fd809fd3b69ee93a26c2e6b 100644
--- a/src/MNH/prep_ideal_case.f90
+++ b/src/MNH/prep_ideal_case.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.
@@ -318,6 +318,10 @@
! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! F. Auguste 02/2021: add IBM
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! Jean-Luc Redelsperger 03/2021: ocean LES case
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -330,6 +334,8 @@ USE MODD_CONF
USE MODD_CST
USE MODD_GRID
USE MODD_GRID_n
+USE MODD_IBM_LSF, ONLY: CIBM_TYPE, LIBM_LSF, NIBM_SMOOTH, XIBM_SMOOTH
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS
USE MODD_METRICS_n
USE MODD_PGDDIM
USE MODD_PGDGRID
@@ -351,13 +357,14 @@ USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIRADIUS_S
USE MODD_VAR_ll, ONLY: NPROC
USE MODD_LUNIT, ONLY: TLUOUT0, TOUTDATAFILE
USE MODD_LUNIT_n
-USE MODD_IO, ONLY: NIO_VERB, NVERB_DEBUG, TFILE_DUMMY, TFILE_OUTPUTLISTING
+USE MODD_IO, ONLY: TFILE_DUMMY, TFILE_OUTPUTLISTING
USE MODD_CONF_n
-USE MODD_NSV, ONLY: NSV
+USE MODD_NSV, ONLY: NSV
use modd_precision, only: LFIINT, MNHREAL_MPI, MNHTIME
!
-USE MODN_BLANK
+USE MODN_BLANK_n
!
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_THERMO
USE MODE_POS
USE MODE_GRIDCART ! Executive modules
@@ -367,14 +374,15 @@ USE MODE_IO, only: IO_Config_set, IO_Init, IO_Pack_set
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list,IO_Filelist_print
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_ll
USE MODE_MODELN_HANDLER
-USE MODE_FIELD
+use mode_field, only: Alloc_field_scalars, Ini_field_list, Ini_field_scalars
USE MODE_MSG
!
USE MODI_DEFAULT_DESFM_n ! Interface modules
USE MODI_DEFAULT_EXPRE
+USE MODI_IBM_INIT_LS
USE MODI_READ_HGRID
USE MODI_SHUMAN
USE MODI_SET_RSOU
@@ -388,12 +396,9 @@ USE MODI_UPDATE_METRICS
USE MODI_SET_REF
USE MODI_SET_PERTURB
USE MODI_TOTAL_DMASS
-USE MODI_WGUESS
-USE MODI_CH_INIT_SCHEME_n
USE MODI_CH_INIT_FIELD_n
USE MODI_INI_NSV
USE MODI_READ_PRE_IDEA_NAM_n
-USE MODI_CH_AER_INIT_SOA
USE MODI_ZSMT_PIC
USE MODI_ZSMT_PGD
USE MODI_READ_VER_GRID
@@ -574,7 +579,7 @@ TYPE(TFILEDATA),POINTER :: TZEXPREFILE => NULL()
NAMELIST/NAM_CONF_PRE/ LTHINSHELL,LCARTESIAN, &! Declarations in MODD_CONF
LPACK, &!
NVERB,CIDEAL,CZS, &!+global variables initialized
- LBOUSS,LPERTURB, &! at their declarations
+ LBOUSS,LOCEAN,LPERTURB, &! at their declarations
LFORCING,CEQNSYS, &! at their declarations
LSHIFT,L2D_ADV_FRC,L2D_REL_FRC, &
NHALO , JPHEXT
@@ -604,6 +609,8 @@ NAMELIST/NAM_AERO_PRE/ LORILAM, LINITPM, XINIRADIUSI, XINIRADIUSJ, &
XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, &
NMODE_SLT
!
+NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
+!
!-------------------------------------------------------------------------------
!
!* 0. PROLOGUE
@@ -693,11 +700,17 @@ CALL POSNAM(NLUPRE,'NAM_GRIDH_PRE',GFOUND,NLUOUT)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_GRIDH_PRE)
CALL POSNAM(NLUPRE,'NAM_VPROF_PRE',GFOUND,NLUOUT)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_VPROF_PRE)
-CALL POSNAM(NLUPRE,'NAM_BLANK',GFOUND,NLUOUT)
-IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_BLANK)
+CALL POSNAM(NLUPRE,'NAM_BLANKN',GFOUND,NLUOUT)
+CALL INIT_NAM_BLANKn
+IF (GFOUND) THEN
+ READ(UNIT=NLUPRE,NML=NAM_BLANKn)
+ CALL UPDATE_NAM_BLANKn
+END IF
CALL READ_PRE_IDEA_NAM_n(NLUPRE,NLUOUT)
CALL POSNAM(NLUPRE,'NAM_AERO_PRE',GFOUND,NLUOUT)
IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_AERO_PRE)
+CALL POSNAM(NLUPRE,'NAM_IBM_LSF' ,GFOUND,NLUOUT)
+IF (GFOUND) READ(UNIT=NLUPRE,NML=NAM_IBM_LSF )
!
CALL INI_FIELD_LIST(1)
!
@@ -871,14 +884,11 @@ IF (CIDEAL == 'RSOU' .AND. NRR < 4 ) NRR=4
!* 3.5 Chemistry
!
IF (LORILAM .OR. LCH_INIT_FIELD) THEN
- ! Always initialize chemical scheme variables before INI_NSV call !
- CALL CH_INIT_SCHEME_n(1,LUSECHAQ,LUSECHIC,LCH_PH,NLUOUT,NVERB)
LUSECHEM = .TRUE.
IF (LORILAM) THEN
CORGANIC = "MPMPO"
LVARSIGI = .TRUE.
LVARSIGJ = .TRUE.
- CALL CH_AER_INIT_SOA(NLUOUT, NVERB)
END IF
END IF
! initialise NSV_* variables
@@ -969,6 +979,11 @@ ALLOCATE(XDZZ(NIU,NJU,NKU))
!
ALLOCATE(XRHODREFZ(NKU),XTHVREFZ(NKU))
XTHVREFZ(:)=0.0
+IF (LCOUPLES) THEN
+ ! Arrays for reference state different in ocean and atmosphere
+ ALLOCATE(XRHODREFZO(NKU),XTHVREFZO(NKU))
+ XTHVREFZO(:)=0.0
+END IF
IF(CEQNSYS == 'DUR') THEN
ALLOCATE(XRVREF(NIU,NJU,NKU))
ELSE
@@ -983,7 +998,11 @@ ALLOCATE(XLSUM(NIU,NJU,NKU))
ALLOCATE(XLSVM(NIU,NJU,NKU))
ALLOCATE(XLSWM(NIU,NJU,NKU))
ALLOCATE(XLSTHM(NIU,NJU,NKU))
-ALLOCATE(XLSRVM(NIU,NJU,NKU))
+IF ( NRR >= 1) THEN
+ ALLOCATE(XLSRVM(NIU,NJU,NKU))
+ELSE
+ ALLOCATE(XLSRVM(0,0,0))
+ENDIF
!
! allocate lateral boundary field used for coupling
!
@@ -1356,7 +1375,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' )
@@ -1628,9 +1647,11 @@ IF(LPERTURB) CALL SET_PERTURB(TZEXPREFILE)
!
!* 5.9 Anelastic correction and pressure:
!
-CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
-IF ( .NOT. L1D ) CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ)
-CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+IF (.NOT.LOCEAN) THEN
+ CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+ IF ( .NOT. L1D ) CALL PRESSURE_IN_PREP(XDXX,XDYY,XDZX,XDZY,XDZZ)
+ CALL ICE_ADJUST_BIS(XPABST,XTHT,XRT)
+END IF
!
!
!* 5.10 Compute THETA, vapor and cloud mixing ratio
@@ -1647,19 +1668,28 @@ IF (CIDEAL == 'RSOU') THEN
ALLOCATE(ZRSATW(NIU,NJU,NKU))
ALLOCATE(ZRSATI(NIU,NJU,NKU))
ZRT=XRT(:,:,:,1)+XRT(:,:,:,2)+XRT(:,:,:,4)
+IF (LOCEAN) THEN
+ ZEXN(:,:,:)= 1.
+ ZT=XTHT
+ ZTHL=XTHT
+ ZCPH=XCPD+ XCPV * XRT(:,:,:,1)
+ ZLVOCPEXN = XLVTT
+ ZLSOCPEXN = XLSTT
+ELSE
ZEXN=(XPABST/XP00) ** (XRD/XCPD)
ZT=XTHT*(XPABST/XP00)**(XRD/XCPD)
ZCPH=XCPD+ XCPV * XRT(:,:,:,1)+ XCL *XRT(:,:,:,2) + XCI * XRT(:,:,:,4)
ZLVOCPEXN = (XLVTT + (XCPV-XCL) * (ZT-XTT))/(ZCPH*ZEXN)
ZLSOCPEXN = (XLSTT + (XCPV-XCI) * (ZT-XTT))/(ZCPH*ZEXN)
ZTHL=XTHT-ZLVOCPEXN*XRT(:,:,:,2)-ZLSOCPEXN*XRT(:,:,:,4)
+ CALL TH_R_FROM_THL_RT_3D('T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
+ XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI)
+END IF
DEALLOCATE(ZEXN)
DEALLOCATE(ZT)
DEALLOCATE(ZCPH)
DEALLOCATE(ZLVOCPEXN)
DEALLOCATE(ZLSOCPEXN)
- CALL TH_R_FROM_THL_RT_3D('T',ZFRAC_ICE,XPABST,ZTHL,ZRT,XTHT,XRT(:,:,:,1), &
- XRT(:,:,:,2),XRT(:,:,:,4),ZRSATW, ZRSATI)
DEALLOCATE(ZTHL)
DEALLOCATE(ZRT)
! Coherence test
@@ -1702,7 +1732,27 @@ IF ( LCH_INIT_FIELD ) CALL CH_INIT_FIELD_n(1, NLUOUT, NVERB)
!
!-------------------------------------------------------------------------------
!
-!* 7. WRITE THE FMFILE
+!* 7. INITIALIZE LEVELSET FOR IBM
+! ---------------------------
+!
+IF (LIBM_LSF) THEN
+ !
+ ! In their current state, the IBM can only be used in
+ ! combination with cartesian coordinates and flat orography.
+ !
+ IF ((CZS.NE."FLAT").OR.(.NOT.LCARTESIAN)) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with flat ground')
+ ENDIF
+ !
+ ALLOCATE(XIBM_LS(NIU,NJU,NKU,4))
+ !
+ CALL IBM_INIT_LS(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 8. WRITE THE FMFILE
! ----------------
!
CALL SECOND_MNH2(ZTIME1)
@@ -1729,7 +1779,7 @@ XT_STORE = XT_STORE + ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
-!* 8. EXTERNALIZED SURFACE
+!* 9. EXTERNALIZED SURFACE
! --------------------
!
!
@@ -1758,10 +1808,10 @@ IF (CSURF =='EXTE') THEN
TPGDFILE => TINIFILEPGD
ELSE
! ... or read from file.
- CALL INIT_PGD_SURF_ATM(YSURF_CUR,'MESONH','PGD', &
- ' ',' ',&
- TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, &
- TDTCUR%TDATE%DAY, TDTCUR%TIME )
+ CALL INIT_PGD_SURF_ATM( YSURF_CUR, 'MESONH', 'PGD', &
+ ' ', ' ', &
+ TDTCUR%nyear, TDTCUR%nmonth, &
+ TDTCUR%nday, TDTCUR%xtime )
!
END IF
!
@@ -1797,14 +1847,13 @@ IF (CSURF =='EXTE') THEN
TFILE_SURFEX => TINIFILE
CALL PREP_SURF_MNH(' ',' ')
NULLIFY(TFILE_SURFEX)
- CALL SURFEX_DEALLO_LIST
ELSE
CSURF = "NONE"
END IF
!
!-------------------------------------------------------------------------------
!
-!* 9. CLOSES THE FILE
+!* 10. CLOSES THE FILE
! ---------------
!
IF (CSURF =='EXTE' .AND. (LEN_TRIM(CPGD_FILE)==0 .OR. .NOT. LREAD_GROUND_PARAM)) THEN
@@ -1818,7 +1867,7 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 10. PRINTS ON OUTPUT-LISTING
+!* 11. PRINTS ON OUTPUT-LISTING
! ------------------------
!
IF (NVERB >= 5) THEN
@@ -1879,10 +1928,6 @@ WRITE(NLUOUT,FMT=*) '****************************************************'
WRITE(NLUOUT,FMT=*) '* PREP_IDEAL_CASE: PREP_IDEAL_CASE ENDS CORRECTLY. *'
WRITE(NLUOUT,FMT=*) '****************************************************'
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
-!
-CALL IO_File_close(TLUOUT)
-!
-CALL END_PARA_ll(IINFO_ll)
+CALL FINALIZE_MNH()
!
END PROGRAM PREP_IDEAL_CASE
diff --git a/src/MNH/prep_nest_pgd.f90 b/src/MNH/prep_nest_pgd.f90
index 5f525bf935f0b31b2f263e957e3e42af5d598df8..80b493fbcd6bcd3d097efeb2ccc6380bbe6bef6e 100644
--- a/src/MNH/prep_nest_pgd.f90
+++ b/src/MNH/prep_nest_pgd.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -92,6 +92,7 @@
!! P.Wautelet : 08/07/2016 : removed MNH_NCWRIT define
!! 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 06/07/2021: use FINALIZE_MNH
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -101,7 +102,7 @@ USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
USE MODD_DIM_n
-USE MODD_IO, ONLY: NIO_VERB, NVERB_DEBUG, TFILE_SURFEX, TPTR2FILE
+USE MODD_IO, ONLY: TFILE_SURFEX, TPTR2FILE
USE MODD_GRID_n, ONLY: XZSMT
USE MODD_LUNIT, ONLY: TPGDFILE,TLUOUT0,TOUTDATAFILE
USE MODD_MNH_SURFEX_n
@@ -109,12 +110,13 @@ USE MODD_NESTING
USE MODD_PARAMETERS
USE MODD_VAR_ll, ONLY: NPROC, IP, NMNH_COMM_WORLD
!
-USE MODE_FIELD, ONLY: INI_FIELD_LIST
+use mode_field, only: Ini_field_list
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_IO, only: IO_Init, IO_Pack_set
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_Filelist_print
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_ll
USE MODE_MNH_WORLD, ONLY: INIT_NMNH_COMM_WORLD
USE MODE_MODELN_HANDLER
@@ -384,23 +386,21 @@ END DO
!* 12. EPILOGUE
! --------
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
-!
WRITE(ILUOUT0,FMT=*)
WRITE(ILUOUT0,FMT=*) '************************************************'
WRITE(ILUOUT0,FMT=*) '* PREP_NEST_PGD: PREP_NEST_PGD ends correctly. *'
WRITE(ILUOUT0,FMT=*) '************************************************'
!
-CALL IO_File_close(TLUOUT0)
-!
!-------------------------------------------------------------------------------
!
!* 10. FINALIZE THE PARALLEL SESSION
! -----------------------------
!
-CALL END_PARA_ll(IINFO_ll)
+CALL FINALIZE_MNH()
+
+! CALL END_PARA_ll(IINFO_ll)
!
-CALL SURFEX_DEALLO_LIST
+! CALL SURFEX_DEALLO_LIST
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/prep_pgd.f90 b/src/MNH/prep_pgd.f90
index 4303b30728ee131ad0d8d1f6cd5a0eb4aafacd69..046ddde7822141fefa4743338cfcb32469bca981 100644
--- a/src/MNH/prep_pgd.f90
+++ b/src/MNH/prep_pgd.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -78,7 +78,7 @@
! 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
-!
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
@@ -89,16 +89,17 @@ USE MODD_CONF_n,ONLY : CSTORAGE_TYPE
USE MODD_LUNIT, ONLY : TLUOUT0
USE MODD_LUNIT_n,ONLY : LUNIT_MODEL
USE MODD_PARAMETERS, ONLY : XUNDEF
-USE MODD_IO, ONLY : NIO_VERB,NVERB_DEBUG,TFILEDATA,TFILE_OUTPUTLISTING,TFILE_SURFEX
+USE MODD_IO, only: TFILEDATA, TFILE_OUTPUTLISTING, TFILE_SURFEX
use modd_precision, only: LFIINT
USE MODD_IO_SURF_MNH, ONLY : NHALO
USE MODD_SPAWN, ONLY : NDXRATIO,NDYRATIO,NXSIZE,NYSIZE,NXOR,NYOR
!
-USE MODE_FIELD
+use mode_field, only: Ini_field_list
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_IO, only: IO_Config_set, IO_Init
USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_Filelist_print
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
use mode_ll
USE MODE_MODELN_HANDLER
USE MODE_MSG
@@ -134,7 +135,6 @@ IMPLICIT NONE
INTEGER :: IRESP ! return code for I/O
INTEGER :: ILUOUT0
INTEGER :: ILUNAM
-INTEGER :: IINFO_LL
LOGICAL :: GFOUND
CHARACTER(LEN=28) :: YDAD =' ' ! name of dad of input FM file
CHARACTER(LEN=28) :: CPGDFILE ='PGDFILE' ! name of the output file
@@ -332,13 +332,7 @@ WRITE(ILUOUT0,*) '***************************'
!
CALL IO_File_close(TZFILE)
!
-CALL SURFEX_DEALLO_LIST
-!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
-!
-CALL IO_File_close(TLUOUT0)
-!
-CALL END_PARA_ll(IINFO_ll)
+CALL FINALIZE_MNH()
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/prep_real_case.f90 b/src/MNH/prep_real_case.f90
index 564611d776d47cec051614a4d4a8bd7d3a1535b7..2796da451deead2db67096d5ba9ddc2c5ffcb954 100644
--- a/src/MNH/prep_real_case.f90
+++ b/src/MNH/prep_real_case.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -374,15 +374,23 @@
!! 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
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -402,7 +410,9 @@ USE MODD_GR_FIELD_n
USE MODD_GRID
USE MODD_GRID_n
USE MODD_HURR_CONF
-USE MODD_IO, ONLY: TFILEDATA,NIO_VERB,NVERB_DEBUG,TFILE_SURFEX
+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, TFILE_SURFEX
USE MODD_LBC_n
USE MODD_LSFIELD_n
USE MODD_LUNIT, ONLY: TPGDFILE,TLUOUT0,TOUTDATAFILE
@@ -419,14 +429,15 @@ USE MODD_SALT, ONLY: LSALT, NMODE_SLT, CRGUNITS, XINISIG_SLT, XINIR
USE MODD_TURB_n
!
USE MODE_EXTRAPOL
-USE MODE_FIELD
+use mode_field, only: Alloc_field_scalars, Ini_field_list, Ini_field_scalars
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_GRIDCART
USE MODE_GRIDPROJ
USE MODE_IO, only: IO_Init
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FIELD_WRITE, only: IO_Header_write
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_File_find_byname,IO_Filelist_print
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_File_find_byname
USE MODE_ll
USE MODE_MODELN_HANDLER
USE MODE_MPPDB
@@ -440,8 +451,10 @@ USE MODI_DEALLOCATE_MODEL1
USE MODI_DEALLOC_PARA_LL
USE MODI_DEFAULT_DESFM_n
USE MODI_ERROR_ON_TEMPERATURE
+USE MODI_IBM_INIT_LS
USE MODI_INI_PROG_VAR
USE MODI_INIT_SALT
+USE MODI_LIMA_MIXRAT_TO_NCONC
USE MODI_METRICS
USE MODI_MNHREAD_ZS_DUMMY_n
USE MODI_MNHWRITE_ZS_DUMMY_n
@@ -451,6 +464,7 @@ USE MODI_PRESSURE_IN_PREP
USE MODI_READ_ALL_DATA_GRIB_CASE
USE MODI_READ_ALL_DATA_MESONH_CASE
USE MODI_READ_ALL_NAMELISTS
+USE MODI_READ_CAMS_DATA_NETCDF_CASE
USE MODI_READ_CHEM_DATA_NETCDF_CASE
USE MODI_READ_VER_GRID
USE MODI_SECOND_MNH
@@ -467,6 +481,7 @@ USE MODI_WRITE_LFIFM_n
!
USE MODN_CONF, ONLY: JPHEXT , NHALO
USE MODN_CONFZ
+USE MODN_PARAM_LIMA
!
IMPLICIT NONE
!
@@ -477,6 +492,8 @@ CHARACTER(LEN=28) :: YATMFILE ! name of the Atmospheric file
CHARACTER(LEN=6) :: YATMFILETYPE! type of the Atmospheric file
CHARACTER(LEN=28) :: YCHEMFILE ! name of the Chemical file
CHARACTER(LEN=6) :: YCHEMFILETYPE! type of the Chemical file
+CHARACTER(LEN=28) :: YCAMSFILE ! name of the input CAMS file
+CHARACTER(LEN=6) :: YCAMSFILETYPE! type of the input CAMS file
CHARACTER(LEN=28) :: YSURFFILE ! name of the Surface file
CHARACTER(LEN=6) :: YSURFFILETYPE! type of the Surface file
CHARACTER(LEN=28) :: YPGDFILE ! name of the physiographic data
@@ -494,6 +511,7 @@ INTEGER :: ILUOUT0 ! logical unit for listing file
INTEGER :: IPRE_REAL1 ! logical unit for namelist file
INTEGER :: IRESP ! return code in FM routines
LOGICAL :: GFOUND ! Return code when searching namelist
+INTEGER :: NIU,NJU,NKU ! Upper bounds in x,y,z directions
!
REAL :: ZSTART, ZEND, ZTIME1, ZTIME2, ZTOT, ZALL ! for computing time analysis
REAL :: ZMISC, ZREAD, ZHORI, ZPREP, ZSURF, ZTHERMO, ZDYN, ZDIAG, ZWRITE
@@ -534,6 +552,9 @@ XANGCONV0, XANGCONV1000, XANGCONV2000, &
LSALT, CRGUNITS, NMODE_DST, XINISIG, XINIRADIUS, XN0MIN,&
XINISIG_SLT, XINIRADIUS_SLT, XN0MIN_SLT, NMODE_SLT
NAMELIST/NAM_CH_CONF/ LUSECHAQ,LUSECHIC,LUSECHEM
+!
+NAMELIST/NAM_IBM_LSF/ LIBM_LSF, CIBM_TYPE, NIBM_SMOOTH, XIBM_SMOOTH
+!
! name of dad of input FM file
INTEGER :: II, IJ, IGRID, ILENGTH
CHARACTER (LEN=100) :: HCOMMENT
@@ -573,7 +594,8 @@ CALL IO_Init()
CALL OPEN_PRC_FILES(TZPRE_REAL1FILE,YATMFILE, YATMFILETYPE,TZATMFILE &
,YCHEMFILE,YCHEMFILETYPE &
,YSURFFILE,YSURFFILETYPE &
- ,YPGDFILE,TPGDFILE)
+ ,YPGDFILE,TPGDFILE &
+ ,YCAMSFILE,YCAMSFILETYPE)
ILUOUT0 = TLUOUT0%NLU
TLUOUT => TLUOUT0
!
@@ -613,6 +635,8 @@ IPRE_REAL1 = TZPRE_REAL1FILE%NLU
CALL INIT_NMLVAR
CALL POSNAM(IPRE_REAL1,'NAM_REAL_CONF',GFOUND,ILUOUT0)
IF (GFOUND) READ(IPRE_REAL1,NAM_REAL_CONF)
+CALL POSNAM(IPRE_REAL1,'NAM_PARAM_LIMA',GFOUND,ILUOUT0)
+IF (GFOUND) READ(IPRE_REAL1,NAM_PARAM_LIMA)
!
CALL INI_FIELD_LIST(1)
!
@@ -692,6 +716,8 @@ CALL POSNAM(IPRE_REAL1,'NAM_AERO_CONF',GFOUND,ILUOUT0)
IF (GFOUND) READ(IPRE_REAL1,NAM_AERO_CONF)
CALL POSNAM(IPRE_REAL1,'NAM_CONFZ',GFOUND,ILUOUT0)
IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_CONFZ)
+CALL POSNAM(IPRE_REAL1,'NAM_IBM_LSF' ,GFOUND,ILUOUT0)
+IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_IBM_LSF)
!
! Sea salt
CALL INIT_SALT
@@ -747,6 +773,16 @@ IF(LEN_TRIM(YCHEMFILE)>0)THEN
CALL READ_CHEM_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCHEMFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
END IF
!
+!* 5.2 reading the input CAMS data
+!
+IF(LEN_TRIM(YCAMSFILE)>0)THEN
+ IF(YCAMSFILETYPE=='NETCDF') THEN
+ CALL READ_CAMS_DATA_NETCDF_CASE(TZPRE_REAL1FILE,YCAMSFILE,TPGDFILE,ZHORI,NVERB,LDUMMY_REAL)
+ ELSE
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_REAL_CASE','CANNOT READ CAMS GRIB FILES YET')
+ END IF
+END IF
+!
CALL IO_File_close(TZPRE_REAL1FILE)
!
CALL SECOND_MNH(ZTIME2)
@@ -885,7 +921,8 @@ END IF
IF (LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='GRIBEX') THEN
CALL VER_PREP_GRIBEX_CASE('CHEM',ZDG)
END IF
-IF (LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='NETCDF') THEN
+IF ((LEN_TRIM(YCHEMFILE)>0 .AND. YCHEMFILETYPE=='NETCDF') .OR. &
+ (LEN_TRIM(YCAMSFILE)>0 .AND. YCAMSFILETYPE=='NETCDF')) THEN
CALL VER_PREP_NETCDF_CASE(ZDG)
END IF
!
@@ -973,6 +1010,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
!
@@ -985,7 +1027,7 @@ CALL BOUNDARIES ( &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
- XRHODJ, &
+ XRHODJ,XRHODREF, &
XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
!
CALL SECOND_MNH(ZTIME2)
@@ -1014,7 +1056,27 @@ CALL SECOND_MNH(ZTIME2)
ZDIAG = ZDIAG + ZTIME2 - ZTIME1
!-------------------------------------------------------------------------------
!
-!* 16. WRITING OF THE MESO-NH FM-FILE
+!* 16. INITIALIZE LEVELSET FOR IBM
+! ---------------------------
+!
+IF (LIBM_LSF) THEN
+ !
+ IF (.NOT.LCARTESIAN) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','PREP_IDEAL_CASE','IBM can only be used with cartesian coordinates')
+ ENDIF
+ !
+ CALL GET_DIM_EXT_ll('B',NIU,NJU)
+ NKU=NKMAX+2*JPVEXT
+ !
+ ALLOCATE(XIBM_LS(NIU,NJU,NKU,4))
+ !
+ CALL IBM_INIT_LS(XIBM_LS)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 17. WRITING OF THE MESO-NH FM-FILE
! ------------------------------
!
ZTIME1 = ZTIME2
@@ -1063,7 +1125,7 @@ ZWRITE = ZTIME2 - ZTIME1
!
!-------------------------------------------------------------------------------
!
-!* 17. OROGRAPHIC and DUMMY PHYSIOGRAPHIC FIELDS
+!* 18. OROGRAPHIC and DUMMY PHYSIOGRAPHIC FIELDS
! -----------------------------------------
!
!* reading in the PGD file
@@ -1083,7 +1145,7 @@ IF (YATMFILETYPE=='MESONH'.AND. YATMFILE/=YPGDFILE) THEN
END IF
!-------------------------------------------------------------------------------
!
-!* 18. INTERPOLATION OF SURFACE VARIABLES
+!* 19. INTERPOLATION OF SURFACE VARIABLES
! ----------------------------------
!
IF (.NOT. LCOUPLING ) THEN
@@ -1099,7 +1161,6 @@ IF (.NOT. LCOUPLING ) THEN
TFILE_SURFEX => TINIFILE
CALL PREP_SURF_MNH(YSURFFILE,YSURFFILETYPE)
NULLIFY(TFILE_SURFEX)
- CALL SURFEX_DEALLO_LIST
ENDIF
!
CALL SECOND_MNH(ZTIME2)
@@ -1108,7 +1169,7 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-!* 19. EPILOGUE
+!* 20. EPILOGUE
! --------
!
WRITE(ILUOUT0,*)
@@ -1188,12 +1249,8 @@ END IF
CALL IO_File_close(TINIFILE)
CALL IO_File_close(TPGDFILE)
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
-!
-CALL IO_File_close(TLUOUT0)
-!
+CALL FINALIZE_MNH()
!
-CALL END_PARA_ll(IINFO_ll)
!-------------------------------------------------------------------------------
!
CONTAINS
diff --git a/src/MNH/prep_surf_mnh.f90 b/src/MNH/prep_surf_mnh.f90
index 0e6c02cfbdaeba34678e247617addfc33b6a3605..ce8b407d2da8c781e5d9711324f971594fa9a102 100644
--- a/src/MNH/prep_surf_mnh.f90
+++ b/src/MNH/prep_surf_mnh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2004-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -94,9 +94,8 @@ YATMFILETYPE = HATMFILETYPE
IF(YATMFILETYPE=='GRIBEX') YATMFILETYPE='GRIB '
IF (LEN_TRIM(HATMFILE)==0) YATMFILETYPE=' '
!
-CALL INIT_PGD_SURF_ATM(YSURF_CUR,'MESONH','PRE',HATMFILE,YATMFILETYPE, &
- TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, &
- TDTCUR%TDATE%DAY, TDTCUR%TIME )
+CALL INIT_PGD_SURF_ATM( YSURF_CUR, 'MESONH', 'PRE', HATMFILE, YATMFILETYPE, &
+ TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime )
CALL PREP_SURF_ATM(YSURF_CUR,'MESONH',HATMFILE,YATMFILETYPE,HATMFILE,YATMFILETYPE,YLCTL)
IF (PRESENT(OINIFILEOPEN)) THEN
!This is done here because model dimensions were not known before this call (for PREP_SURFEX)
diff --git a/src/MNH/prep_surfex.f90 b/src/MNH/prep_surfex.f90
index c21d5caa82474b699b1cf1a0b27a23897f3160b1..68ec7b3a8779d70d45f174ab868a07192b9dc4c5 100644
--- a/src/MNH/prep_surfex.f90
+++ b/src/MNH/prep_surfex.f90
@@ -1,8 +1,8 @@
-!MNH_LIC Copyright 2004-2019 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
@@ -35,19 +36,20 @@
USE MODD_CONF, ONLY : CPROGRAM,&
L1D, L2D, LPACK
USE MODD_CONF_n, ONLY : CSTORAGE_TYPE
-USE MODD_IO, ONLY : TFILEDATA, NIO_VERB, NVERB_DEBUG, TFILE_SURFEX
+USE MODD_IO, ONLY : TFILEDATA, TFILE_SURFEX
USE MODD_LUNIT, ONLY : TPGDFILE, TLUOUT0
USE MODD_LUNIT_n, ONLY : CINIFILE, TINIFILE
USE MODD_MNH_SURFEX_n
USE MODD_PARAMETERS, ONLY : JPMODELMAX,JPHEXT,JPVEXT, NUNDEF, XUNDEF
USE MODD_TIME_n, ONLY : TDTCUR
!
-USE MODE_FIELD
+use mode_field, only: Ini_field_list, Ini_field_scalars
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_IO, only: IO_Init
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_Filelist_print
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_ll
USE MODE_MSG
USE MODE_MODELN_HANDLER
@@ -67,6 +69,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 +109,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
!
!-------------------------------------------------------------------------------
@@ -161,10 +166,10 @@ IF (YATMFILETYPE=='MESONH') THEN
CALL IO_Field_read(TZATMFILE,'DTCUR',TDTCUR)
CALL IO_File_close(TZATMFILE)
ELSE
- TDTCUR%TDATE%YEAR = NUNDEF
- TDTCUR%TDATE%MONTH= NUNDEF
- TDTCUR%TDATE%DAY = NUNDEF
- TDTCUR%TIME = XUNDEF
+ TDTCUR%nyear = NUNDEF
+ TDTCUR%nmonth = NUNDEF
+ TDTCUR%nday = NUNDEF
+ TDTCUR%xtime = XUNDEF
END IF
!
CALL SURFEX_ALLOC_LIST(1)
@@ -196,12 +201,7 @@ WRITE(ILUOUT0,*) '| |'
WRITE(ILUOUT0,*) '----------------------------------'
CALL IO_File_close(TINIFILE)
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
-!
-CALL IO_File_close(TLUOUT0)
-!
-CALL END_PARA_ll(IINFO_ll)
-CALL SURFEX_DEALLO_LIST
+CALL FINALIZE_MNH()
!-------------------------------------------------------------------------------
!
END PROGRAM PREP_SURFEX
diff --git a/src/MNH/pressure.f90 b/src/MNH/pressure.f90
deleted file mode 100644
index f06d79f0a5b295008267b2929473caa4db73f913..0000000000000000000000000000000000000000
--- a/src/MNH/pressure.f90
+++ /dev/null
@@ -1,687 +0,0 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!###################
-MODULE MODI_PRESSURE
-!###################
-!
-INTERFACE
-!
- SUBROUTINE PRESSURE( &
- HLBCX,HLBCY,HPRESOPT,KITR,OITRADJ,KTCOUNT,PRELAX,KMI, &
- PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY,PDXHATM,PDYHATM,PRHOM, &
- PAF,PBF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY,PPABSM, &
- KRR,KRRL,KRRI,PDRYMASST,PREFMASS,PMASS_O_PHI0, &
- PTHT,PRT,PRHODREF,PTHVREF,PRVREF,PEXNREF,PLINMASS, &
- PRUS,PRVS,PRWS,PPABST,PRESIDUAL)
-!
-IMPLICIT NONE
-!
-CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX ! x-direction LBC type
-CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-CHARACTER (LEN=5), INTENT(IN) :: HPRESOPT ! choice of the pressure solver
-!
-INTEGER, INTENT(INOUT) :: KITR ! number of iterations for the
- ! pressure solver
-LOGICAL, INTENT(IN) :: OITRADJ ! switch to adjust or not KITR
-INTEGER, INTENT(IN) :: KTCOUNT ! counter value of the
- ! model temporal loop
-INTEGER, INTENT(IN) :: KMI ! Model index
-REAL, INTENT(IN) :: PRELAX ! relaxation coefficient for
- ! the Richardson's method
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference state
- ! * J
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY ! metric coefficients
-!
-REAL, INTENT(IN) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(IN) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(IN) :: PRHOM ! mean of XRHODJ on the plane x y
- ! localized at a mass level
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBF ! elements of the tri-diag.
- ! matrix in the pressure eq.
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(IN) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(IN) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(IN) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(IN) :: KIFAXY ! - along y
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! pressure (t-dt)
-!
-INTEGER, INTENT(IN) :: KRR ! Total number of water var.
-INTEGER, INTENT(IN) :: KRRL ! Number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! Number of ice water var.
-!
-REAL, INTENT(IN) :: PDRYMASST ! Mass of dry air and of
-REAL, INTENT(IN) :: PREFMASS ! the ref. atmosphere
-REAL, INTENT(IN) :: PMASS_O_PHI0 ! Mass / Phi0
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Temperature and water
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! variables at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry Density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVREF ! mixing ratio of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Exner function
- ! of the reference state
-REAL, INTENT(IN) :: PLINMASS ! lineic mass through
- ! open boundaries
-!
-REAL, INTENT(INOUT) :: PRUS(:,:,:) ! source term along x
-REAL, INTENT(INOUT) :: PRVS(:,:,:) ! source term along y
-REAL, INTENT(INOUT) :: PRWS(:,:,:) ! source term along z
-!
-REAL, INTENT(INOUT) :: PPABST(:,:,:) ! pressure(t)
-!JUAN
-REAL, OPTIONAL :: PRESIDUAL
-!JUAN
-!
-END SUBROUTINE PRESSURE
-!
-END INTERFACE
-!
-END MODULE MODI_PRESSURE
-! ######################################################################
- SUBROUTINE PRESSURE( &
- HLBCX,HLBCY,HPRESOPT,KITR,OITRADJ,KTCOUNT,PRELAX,KMI, &
- PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY,PDXHATM,PDYHATM,PRHOM, &
- PAF,PBF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY,PPABSM, &
- KRR,KRRL,KRRI,PDRYMASST,PREFMASS,PMASS_O_PHI0, &
- PTHT,PRT,PRHODREF,PTHVREF,PRVREF,PEXNREF,PLINMASS, &
- PRUS,PRVS,PRWS,PPABST,PRESIDUAL)
-! ######################################################################
-!
-!!**** *PRESSURE * - solve the pressure equation and add the pressure term
-!! to the sources
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to solve the pressure equation:
-! with either the conjugate gradient method or the Richardson's method.
-! The pressure gradient is added to the sources in order
-! to nullify the divergence of the momentum* Thetavref*(1+Rvref)
-! at the time t+dt.
-!
-!!** METHOD
-!! ------
-!! The divergence of the sources ( RHS of the pressure equation ) is
-!! computed. The pressure equation is then solved by either CG method,
-!! either Richardson's method, or an exact method. Finally, the pressure
-!! gradient is added to the sources RUS, RVS, RWS.
-!! Finally, the absolute pressure is diagnozed from the total mass
-!! included in the simulation domain.
-!!
-!! EXTERNAL
-!! --------
-!! Subroutine MASS_LEAK : assures global non-divergence condition in the
-!! case of open boundaries
-!! Subroutine FLAT_INV : solve the pressure equation for the case
-!! without orography
-!! Subroutine RICHARDSON: solve the pressure equation with the
-!! Richardson's method
-!! Subroutine CONJGRAD : solve the pressure equation with the Conjugate
-!! Gradient algorithm
-!! Function GX_M_U : compute the gradient along x
-!! Function GY_M_V : compute the gradient along y
-!! Function GZ_M_W : compute the gradient along z
-!! Subroutine GDIV : compute J times the divergence of 1/J times a vector
-!! Function MXM: compute an average in the x direction for a variable
-!! at a mass localization
-!! Function MYM: compute an average in the y direction for a variable
-!! at a mass localization
-!! Function MZM: compute an average in the z direction for a variable
-!! at a mass localization
-!! Subroutine P_ABS : compute the constant for PABS and therefore, the
-!! absolute pressure function
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CONF: model configuration
-!! LFLAT: logical switch for zero orography
-!! L2D : logical switch for two-dimensional configuration
-!! LCARTESIAN : logical switch for cartesian geometry
-!! Module MODD_PARAMETERS: declaration of parameter variables
-!! JPHEXT, JPVEXT: define the number of marginal points out of the
-!! physical domain along horizontal and vertical directions respectively
-!! Module MODD_CST: physical constants
-!! XCPD
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation (subroutine PRESSURE) + Book1 ( )
-!!
-!! AUTHOR
-!! ------
-!! P. Hereil and J. Stein * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 05/07/94
-!! Modification 03/01/95 (Lafore) To add the absolute pressure diagnosis
-!! Modification 31/01/95 (Stein) Copy of the pressure function in the
-!! 2D case in the two outermost planes
-!! Modification 16/02/95 (Mallet) Add the call to MASS_LEAK
-!! Modification 16/03/95 (Stein) change the argument list of the
-!! gradient and remove R from the historical var.
-!! Modification 30/06/95 (Stein) Add a test not to compute the absolute
-!! pressure in the Boussinesq case
-!! 16/10/95 (J. Stein) change the budget calls
-!! 29/01/96 (J. Stein) call iterative resolution for
-!! non-cartessian geometry
-!! 19/12/96 (J.-P. Pinty) update the budget calls
-!! 14/01/97 (Stein,Lafore) New anelastic equations
-!! 17/12/97 ( Stein )include the case of non-vanishing
-!! orography at the lbc
-!! 26/03/98 (Stein,Jabouille) fix the value of the corner point
-!! 15/06/98 (D.Lugato, R.Guivarch) Parallelisation
-!! 25/08/99 (J.-P. Pinty) add CRESI option to CPRESOPT
-!! 06/11/02 (V. Masson) update the budget calls
-!! 24/08/2005 (J. escobar) BUG : remove IIE+1, IJE+1 out of bound
-!! references in parallel run
-!! 08/2010 (V.Masson, C.Lac) Add UPDATE_HALO
-!! 11/2010 (V.Masson, C.Lac) PPABST, must not be cyclic => add temp array
-!! to save it before UPDATE_HALO
-!! 06/2011 (J.escobar ) Bypass Bug with ifort11/12 on HLBCX,HLBCY
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_BUDGET
-USE MODD_CONF
-USE MODD_CST
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODI_MASS_LEAK
-USE MODI_GDIV
-USE MODI_FLAT_INV
-USE MODI_RICHARDSON
-USE MODI_CONJGRAD
-USE MODI_CONRESOL
-USE MODI_GRADIENT_M
-USE MODI_SHUMAN
-USE MODI_P_ABS
-USE MODI_BUDGET
-!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODE_ll
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
- CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX ! x-direction LBC type
- CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-CHARACTER (LEN=5), INTENT(IN) :: HPRESOPT ! choice of the pressure solver
-!
-INTEGER, INTENT(INOUT) :: KITR ! number of iterations for the
- ! pressure solver
-LOGICAL, INTENT(IN) :: OITRADJ ! switch to adjust or not KITR
-INTEGER, INTENT(IN) :: KTCOUNT ! counter value of the
- ! model temporal loop
-INTEGER, INTENT(IN) :: KMI ! Model index
-REAL, INTENT(IN) :: PRELAX ! relaxation coefficient for
- ! the Richardson's method
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference state
- ! * J
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX,PDYY,PDZZ,PDZX,PDZY ! metric coefficients
-!
-REAL, INTENT(IN) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(IN) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(IN) :: PRHOM ! mean of XRHODJ on the plane x y
- ! localized at a mass level
-!
-REAL, DIMENSION(:), INTENT(IN) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PBF ! elements of the tri-diag.
- ! matrix in the pressure eq.
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(IN) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(IN) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(IN) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(IN) :: KIFAXY ! - along y
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABSM ! pressure (t-dt)
-!
-INTEGER, INTENT(IN) :: KRR ! Total number of water var.
-INTEGER, INTENT(IN) :: KRRL ! Number of liquid water var.
-INTEGER, INTENT(IN) :: KRRI ! Number of ice water var.
-!
-REAL, INTENT(IN) :: PDRYMASST ! Mass of dry air and of
-REAL, INTENT(IN) :: PREFMASS ! the ref. atmosphere
-REAL, INTENT(IN) :: PMASS_O_PHI0 ! Mass / Phi0
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Temperature and water
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRT ! variables at time t
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! dry Density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Temperature
- ! of the reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVREF ! mixing ratio of the
- ! reference state
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PEXNREF ! Exner function
- ! of the reference state
-REAL, INTENT(IN) :: PLINMASS ! lineic mass through
- ! open boundaries
-!
-REAL, INTENT(INOUT) :: PRUS(:,:,:) ! source term along x
-REAL, INTENT(INOUT) :: PRVS(:,:,:) ! source term along y
-REAL, INTENT(INOUT) :: PRWS(:,:,:) ! source term along z
-!
-REAL, INTENT(INOUT) :: PPABST(:,:,:) ! pressure(t)
-!JUAN
-REAL, OPTIONAL :: PRESIDUAL
-!JUAN
-!
-!
-!* 0.2 declarations of local variables
-!
-! Metric coefficients:
-!
-REAL, DIMENSION(SIZE(PPABSM,1),SIZE(PPABSM,2),SIZE(PPABSM,3)) :: ZDV_SOURCE
-! ! divergence of the sources
-!
-INTEGER :: IIB ! indice I for the first inner mass point along x
-INTEGER :: IIE ! indice I for the last inner mass point along x
-INTEGER :: IJB ! indice J for the first inner mass point along y
-INTEGER :: IJE ! indice J for the last inner mass point along y
-INTEGER :: IKB ! indice K for the first inner mass point along z
-INTEGER :: IKE ! indice K for the last inner mass point along z
-INTEGER :: ILUOUT ! Logical unit of output listing
-!
-REAL, DIMENSION(SIZE(PPABSM,1),SIZE(PPABSM,2),SIZE(PPABSM,3)) :: ZTHETAV, &
- ! virtual potential temperature
- ZPHIT
- ! MAE + DUR => Exner function perturbation
- ! LHE => Exner function perturbation * CPD * THVREF
-!
-REAL :: ZRV_OV_RD ! XRV / XRD
-REAL :: ZMAXVAL, ZMAXRES ! for print
-INTEGER, DIMENSION(3) :: IMAXLOC ! purpose
-INTEGER :: JWATER ! loop index on water species
-INTEGER :: IIU,IJU,IKU ! array sizes in I,J,K
-INTEGER :: JK ! loop index on the vertical levels
-INTEGER :: JI,JJ
-!
-REAL, DIMENSION(SIZE(PDXX,1),SIZE(PDXX,3)) :: ZPABS_S ! local pressure on southern side
-REAL, DIMENSION(SIZE(PDXX,1),SIZE(PDXX,3)) :: ZPABS_N ! local pressure on northern side
-REAL, DIMENSION(SIZE(PDYY,2),SIZE(PDXX,3)) :: ZPABS_E ! local pressure on eastern side
-REAL, DIMENSION(SIZE(PDYY,2),SIZE(PDXX,3)) :: ZPABS_W ! local pressure on western side
-INTEGER :: IINFO_ll
-TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
-TYPE(LIST_ll), POINTER :: TZFIELDS_2_ll ! list of fields to exchange
-!
-!
-!------------------------------------------------------------------------------
-!-------------------------------------------------------------------------------
-NULLIFY(TZFIELDS_ll)
-NULLIFY(TZFIELDS_2_ll)
-!
-!* 1. PRELIMINARIES
-! -------------
-!
-ILUOUT = TLUOUT%NLU
-!
-CALL GET_PHYSICAL_ll(IIB,IJB,IIE,IJE)
-CALL GET_DIM_EXT_ll('B',IIU,IJU)
-!
-IKB= 1+JPVEXT
-IKU= SIZE(PPABSM,3)
-IKE= IKU - JPVEXT
-!
-ZPABS_S(:,:) = 0.
-ZPABS_N(:,:) = 0.
-ZPABS_E(:,:) = 0.
-ZPABS_W(:,:) = 0.
-!
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE LINEIC MASS
-! -----------------------
-!
-IF ( ANY(HLBCX(:)=='OPEN') .OR. ANY(HLBCY(:)=='OPEN') ) THEN
- CALL MASS_LEAK(PDXX,PDYY,HLBCX,HLBCY,PLINMASS,PRHODJ,PRUS,PRVS)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. COMPUTE THE FORCING TERM FOR THE PRESSURE EQUATION
-! --------------------------------------------------
-!
-!
-CALL ADD3DFIELD_ll( TZFIELDS_ll, PRUS, 'PRESSURE::PRUS' )
-CALL ADD3DFIELD_ll( TZFIELDS_ll, PRVS, 'PRESSURE::PRVS' )
-CALL ADD3DFIELD_ll( TZFIELDS_ll, PRWS, 'PRESSURE::PRWS' )
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-!
-CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRUS,PRVS,PRWS,ZDV_SOURCE)
-!
-! The non-homogenous Neuman problem is transformed in an homogenous Neuman
-! problem in the non-periodic cases
-IF (HLBCX(1) /= 'CYCL') THEN
- IF (LWEST_ll()) ZDV_SOURCE(IIB-1,:,:) = 0.
- IF (LEAST_ll()) ZDV_SOURCE(IIE+1,:,:) = 0.
-ENDIF
-!
-IF (.NOT. L2D .AND. HLBCY(1) /= 'CYCL') THEN
- IF (LSOUTH_ll()) ZDV_SOURCE(:,IJB-1,:) = 0.
- IF (LNORTH_ll()) ZDV_SOURCE(:,IJE+1,:) = 0.
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. SOLVE THE PRESSURE EQUATION
-! ---------------------------
-!
-!
-!* 5.1 Compute the virtual theta and the pressure perturbation
-! -------------------------------------------------------
-!
-IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
- IF(KRR > 0) THEN
- !
- ! compute the ratio : 1 + total water mass / dry air mass
- ZRV_OV_RD = XRV / XRD
- ZTHETAV(:,:,:) = 1. + PRT(:,:,:,1)
- DO JWATER = 2 , 1+KRRL+KRRI
- ZTHETAV(:,:,:) = ZTHETAV(:,:,:) + PRT(:,:,:,JWATER)
- END DO
- ! compute the virtual potential temperature when water is present in any
- ! form
- ZTHETAV(:,:,:) = PTHT(:,:,:) * (1. + PRT(:,:,:,1) * ZRV_OV_RD) / ZTHETAV(:,:,:)
- ELSE
- ! compute the virtual potential temperature when water is absent
- ZTHETAV(:,:,:) = PTHT(:,:,:)
- END IF
- !
- ZPHIT(:,:,:)=(PPABSM(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)
- !
-ELSEIF(CEQNSYS=='LHE') THEN
- ZPHIT(:,:,:)= ((PPABSM(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)) &
- * XCPD * PTHVREF(:,:,:)
- !
-END IF
-!
-IF(CEQNSYS=='LHE'.AND. LFLAT .AND. LCARTESIAN) THEN
- ! flat cartesian LHE case -> exact solution
- !
- CALL FLAT_INV(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF, &
- PTRIGSX,PTRIGSY,KIFAXX,KIFAXY,ZDV_SOURCE,ZPHIT)
-ELSE
- SELECT CASE(HPRESOPT)
- CASE('RICHA') ! Richardson's method
-!
- CALL RICHARDSON(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRHODJ,ZTHETAV, &
- PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF,PTRIGSX,PTRIGSY, &
- KIFAXX,KIFAXY,KITR,KTCOUNT,PRELAX,ZDV_SOURCE,ZPHIT)
-!
- CASE('CGRAD') ! Conjugate Gradient method
- CALL CONJGRAD(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRHODJ,ZTHETAV, &
- PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF,PTRIGSX,PTRIGSY, &
- KIFAXX,KIFAXY,KITR,ZDV_SOURCE,ZPHIT)
-!
- CASE('CRESI') ! Conjugate Residual method
- CALL CONRESOL(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRHODJ,ZTHETAV, &
- PDXHATM,PDYHATM,PRHOM,PAF,PBF,PCF,PTRIGSX,PTRIGSY, &
- KIFAXX,KIFAXY,KITR,ZDV_SOURCE,ZPHIT)
- END SELECT
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. ADD THE PRESSURE GRADIENT TO THE SOURCES
-! ----------------------------------------
-!
-IF ( HLBCX(1) /= 'CYCL' ) THEN
- IF(LWEST_ll()) ZPHIT(IIB-1,:,IKB-1) = ZPHIT(IIB,:,IKB-1)
- IF(LEAST_ll()) ZPHIT(IIE+1,:,IKB-1) = ZPHIT(IIE,:,IKB-1)
-ENDIF
-IF ( HLBCY(1) /= 'CYCL' ) THEN
- IF (LSOUTH_ll()) ZPHIT(:,IJB-1,IKB-1) = ZPHIT(:,IJB,IKB-1)
- IF (LNORTH_ll()) ZPHIT(:,IJE+1,IKB-1) = ZPHIT(:,IJE,IKB-1)
-ENDIF
-!
-IF ( L2D ) THEN
- IF (LSOUTH_ll()) ZPHIT(:,IJB-1,:) = ZPHIT(:,IJB,:)
- IF (LNORTH_ll()) ZPHIT(:,IJE+1,:) = ZPHIT(:,IJB,:)
-END IF
-!
-ZDV_SOURCE = GX_M_U(1,IKU,1,ZPHIT,PDXX,PDZZ,PDZX)
-!
-IF ( HLBCX(1) /= 'CYCL' ) THEN
- IF(LWEST_ll()) THEN
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
- DO JK=2,IKU-1
- ZDV_SOURCE(2,:,JK)= &
- (ZPHIT(2,:,JK) - ZPHIT(1,:,JK) - 0.5 * ( &
- PDZX(2,:,JK) * (ZPHIT(2,:,JK)-ZPHIT(2,:,JK-1)) / PDZZ(2,:,JK) &
- +PDZX(2,:,JK+1) * (ZPHIT(2,:,JK+1)-ZPHIT(2,:,JK)) / PDZZ(2,:,JK+1) &
- ) &
- ) / PDXX(2,:,JK)
- END DO
- ENDIF
- !
- IF(LEAST_ll()) THEN
- DO JK=2,IKU-1
- ZDV_SOURCE(IIU,:,JK)= &
- (ZPHIT(IIU,:,JK) - ZPHIT(IIU-1,:,JK) - 0.5 * ( &
- PDZX(IIU,:,JK) * (ZPHIT(IIU-1,:,JK)-ZPHIT(IIU-1,:,JK-1)) &
- / PDZZ(IIU-1,:,JK) &
- +PDZX(IIU,:,JK+1) * (ZPHIT(IIU-1,:,JK+1)-ZPHIT(IIU-1,:,JK)) &
- / PDZZ(IIU-1,:,JK+1) &
- ) &
- ) / PDXX(IIU,:,JK)
- END DO
- END IF
-END IF
-!
-IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
- PRUS = PRUS - MXM(PRHODJ * XCPD * ZTHETAV) * ZDV_SOURCE
- PRWS = PRWS - MZM(PRHODJ * XCPD * ZTHETAV) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
-ELSEIF(CEQNSYS=='LHE') THEN
- PRUS = PRUS - MXM(PRHODJ) * ZDV_SOURCE
- PRWS = PRWS - MZM(PRHODJ) * GZ_M_W(1,IKU,1,ZPHIT,PDZZ)
-END IF
-!
-IF(.NOT. L2D) THEN
-!
- ZDV_SOURCE = GY_M_V(1,IKU,1,ZPHIT,PDYY,PDZZ,PDZY)
-!
- IF ( HLBCY(1) /= 'CYCL' ) THEN
- IF (LSOUTH_ll()) THEN
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
- DO JK=2,IKU-1
- ZDV_SOURCE(:,2,JK)= &
- (ZPHIT(:,2,JK) - ZPHIT(:,1,JK) - 0.5 * ( &
- PDZY(:,2,JK) * (ZPHIT(:,2,JK)-ZPHIT(:,2,JK-1)) / PDZZ(:,2,JK) &
- +PDZY(:,2,JK+1) * (ZPHIT(:,2,JK+1)-ZPHIT(:,2,JK)) / PDZZ(:,2,JK+1) &
- ) &
- ) / PDYY(:,2,JK)
- END DO
- END IF
- !
- IF (LNORTH_ll()) THEN
- DO JK=2,IKU-1
- ZDV_SOURCE(:,IJU,JK)= &
- (ZPHIT(:,IJU,JK) - ZPHIT(:,IJU-1,JK) - 0.5 * ( &
- PDZY(:,IJU,JK) * (ZPHIT(:,IJU-1,JK)-ZPHIT(:,IJU-1,JK-1)) &
- / PDZZ(:,IJU-1,JK) &
- +PDZY(:,IJU,JK+1) * (ZPHIT(:,IJU-1,JK+1)-ZPHIT(:,IJU-1,JK)) &
- / PDZZ(:,IJU-1,JK+1) &
- ) &
- ) / PDYY(:,IJU,JK)
- END DO
- END IF
- END IF
-!
- IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
- PRVS = PRVS - MYM(PRHODJ * XCPD * ZTHETAV) * ZDV_SOURCE
- ELSEIF(CEQNSYS=='LHE') THEN
- PRVS = PRVS - MYM(PRHODJ) * ZDV_SOURCE
- END IF
-END IF
-!
-!! same boundary conditions as in gdiv ... !! (provisory coding)
-!! (necessary when NVERB=1)
-DO JJ = IJB,IJE ! copy the horizontal components under
- DO JI = IIB,IIE
- PRUS(JI,JJ,IKB-1)=PRUS(JI,JJ,IKB)
- PRUS(JI,JJ,IKE+1)=PRUS(JI,JJ,IKE)
- END DO
-END DO
-!
-DO JJ = IJB,IJE
- DO JI = IIB,IIE ! the ground and above the top
- PRVS(JI,JJ,IKB-1)=PRVS(JI,JJ,IKB)
- PRVS(JI,JJ,IKE+1)=PRVS(JI,JJ,IKE)
- END DO
-END DO
-!!
-!
-! compute the residual divergence
-CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRUS,PRVS,PRWS,ZDV_SOURCE)
-!
-IF ( CEQNSYS=='DUR' ) THEN
- IF ( SIZE(PRVREF,1) == 0 ) THEN
- ZDV_SOURCE=ZDV_SOURCE/PRHODJ/XTH00*PRHODREF*PTHVREF
- ELSE
- ZDV_SOURCE=ZDV_SOURCE/PRHODJ/XTH00*PRHODREF*PTHVREF*(1.+PRVREF)
- END IF
-ELSEIF( CEQNSYS=='MAE' .OR. CEQNSYS=='LHE' ) THEN
- ZDV_SOURCE=ZDV_SOURCE/PRHODJ*PRHODREF
-END IF
-!
-ZMAXVAL=MAX_ll(ABS(ZDV_SOURCE),IINFO_ll)
-IF (PRESENT(PRESIDUAL)) PRESIDUAL = ZMAXVAL
-IMAXLOC=MAXLOC( ABS(ZDV_SOURCE(IIB:IIE,IJB:IJE,IKB:IKE))) !provisory coding one one processor only
-!
-WRITE(ILUOUT,*) 'residual divergence / 2 DT', ZMAXVAL, &
- ' located at ', IMAXLOC
-! number of iterations adjusted
-IF (LFLAT .AND. LCARTESIAN) THEN
- ZMAXRES = 1.E-12
-ELSE
- ZMAXRES = 1.E-9
-END IF
-!
-IF (OITRADJ) THEN
- IF (ZMAXVAL>10.*ZMAXRES) THEN
- KITR=KITR+2
- WRITE(ILUOUT,*) 'NITR adjusted to ', KITR
- ELSE IF (ZMAXVAL<ZMAXRES) THEN
- KITR=MAX(KITR-1,1)
- WRITE(ILUOUT,*) 'NITR adjusted to ', KITR
- ENDIF
-ENDIF
-!
-!* 7. STORAGE OF THE FIELDS IN BUDGET ARRAYS
-! --------------------------------------
-!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'PRES_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'PRES_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'PRES_BU_RW')
-!
-!-------------------------------------------------------------------------------
-!
-!* 8. ABSOLUTE PRESSURE COMPUTATION
-! -----------------------------
-!
-!IF ( ABS(PRHODREF(IIB,IJB,IKB)-PRHODREF(IIB,IJB,IKE)) > 1.E-16 &
-IF ( ABS(PRHODREF(IIB,IJB,IKB)-PRHODREF(IIB,IJB,IKE)) > 1.E-12 &
- .AND. KTCOUNT >0 ) THEN
- CALL P_ABS ( KRR, KRRL, KRRI, PDRYMASST, PREFMASS, PMASS_O_PHI0, &
- PTHT, PRT, PRHODJ, PRHODREF, ZTHETAV, PTHVREF, &
- PRVREF, PEXNREF, ZPHIT )
-!
- IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
- PPABST(:,:,:)=XP00*(ZPHIT+PEXNREF)**(XCPD/XRD)
- ELSEIF(CEQNSYS=='LHE') THEN
- PPABST(:,:,:)=XP00*(ZPHIT/(XCPD*PTHVREF)+PEXNREF)**(XCPD/XRD)
- ENDIF
-!
- IF( HLBCX(1) == 'CYCL' ) THEN
- IF (LWEST_ll()) THEN
- ZPABS_W(:,:)= PPABST(IIB,:,:)
- END IF
-!
- IF (LEAST_ll()) THEN
- ZPABS_E(:,:)= PPABST(IIE+1,:,:)
- END IF
-!
- END IF
-!
- IF( HLBCY(1) == 'CYCL' ) THEN
- IF (LSOUTH_ll()) THEN
- ZPABS_S(:,:)= PPABST(:,IJB,:)
- END IF
-!
- IF (LNORTH_ll()) THEN
- ZPABS_N(:,:)= PPABST(:,IJE+1,:)
- END IF
-!
- END IF
-!
- CALL ADD3DFIELD_ll( TZFIELDS_2_ll, PPABST, 'PRESSURE::PPABST' )
- CALL UPDATE_HALO_ll(TZFIELDS_2_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_2_ll)
-!
- IF( HLBCX(1) == 'CYCL' ) THEN
- IF (LWEST_ll()) THEN
- PPABST(IIB,:,:) = ZPABS_W(:,:)
- END IF
-!
- IF (LEAST_ll()) THEN
- PPABST(IIE+1,:,:) = ZPABS_E(:,:)
- END IF
-!
- END IF
-!
- IF( HLBCY(1) == 'CYCL' ) THEN
- IF (LSOUTH_ll()) THEN
- PPABST(:,IJB,:) = ZPABS_S(:,:)
- END IF
-!
- IF (LNORTH_ll()) THEN
- PPABST(:,IJE+1,:) = ZPABS_N(:,:)
- END IF
-!
- END IF
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE PRESSURE
diff --git a/src/MNH/pressurez.f90 b/src/MNH/pressurez.f90
index 0b32958a21ea434d6412e3ee9630b5c626be1578..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.
@@ -219,16 +219,21 @@ END MODULE MODI_PRESSUREZ
!! Philippe Wautelet: 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 28/01/2020: use the new data structures and subroutines for budgets for U
+!! JL Redelsperger 03/2021 : Shallow convection case added in LHE case:
+!! working for both atmosphere and ocean cases
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_ARGSLIST_ll, ONLY: LIST_ll
-USE MODD_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, NBUDGET_U, NBUDGET_V, NBUDGET_W, tbudgets
USE MODD_CST
USE MODD_CONF
-USE MODD_DYN_n, ONLY: LRES, XRES
+USE MODD_DYN_n, ONLY: LRES, XRES,LOCEAN
+USE MODD_FIELD_n, ONLY: XPHIT
+USE MODD_IBM_PARAM_n, ONLY: LIBM, NIBM_ITR, XIBM_EPSI, XIBM_LS, XIBM_SU
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_MPIF
USE MODD_PARAMETERS
@@ -236,12 +241,12 @@ use modd_precision, only: MNHREAL_MPI
USE MODD_REF, ONLY: LBOUSS
USE MODD_VAR_ll, ONLY: NMNH_COMM_WORLD , NPROC
!
+use mode_budget, only: Budget_store_end
USE MODE_ll
USE MODE_MPPDB
USE MODE_MSG
USE MODE_SUM2_ll, ONLY: GMAXLOC_ll
!
-USE MODI_BUDGET
USE MODI_CONJGRAD
USE MODI_CONRESOL
USE MODI_CONRESOLZ
@@ -249,6 +254,7 @@ USE MODI_FLAT_INV
USE MODI_FLAT_INVZ
USE MODI_GDIV
USE MODI_GRADIENT_M
+USE MODI_IBM_BALANCE
USE MODI_MASS_LEAK
USE MODI_P_ABS
USE MODI_RICHARDSON
@@ -356,6 +362,7 @@ REAL, DIMENSION(SIZE(PPABST,1),SIZE(PPABST,2),SIZE(PPABST,3)) :: ZTHETAV, &
! MAE + DUR => Exner function perturbation
! LHE => Exner function perturbation * CPD * THVREF
!
+REAL :: ZPHI0
REAL :: ZRV_OV_RD ! XRV / XRD
REAL :: ZMAXVAL, ZMAXRES, ZMAX,ZMAX_ll ! for print
INTEGER, DIMENSION(3) :: IMAXLOC ! purpose
@@ -401,8 +408,12 @@ ZPABS_S(:,:) = 0.
ZPABS_N(:,:) = 0.
ZPABS_E(:,:) = 0.
ZPABS_W(:,:) = 0.
-!
-!
+
+! Done in model_n before call to Rad_bound
+! if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U), 'PRES', prus(:, :, :) )
+! if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V), 'PRES', prvs(:, :, :) )
+! if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W), 'PRES', prws(:, :, :) )
+
!-------------------------------------------------------------------------------
!
!* 3. COMPUTE THE LINEIC MASS
@@ -417,6 +428,11 @@ END IF
!* 4. COMPUTE THE FORCING TERM FOR THE PRESSURE EQUATION
! --------------------------------------------------
!
+IF (LIBM) THEN
+ WHERE(XIBM_LS(:,:,:,2).GT.-XIBM_EPSI) PRUS(:,:,:) = 0.
+ WHERE(XIBM_LS(:,:,:,3).GT.-XIBM_EPSI) PRVS(:,:,:) = 0.
+ WHERE(XIBM_LS(:,:,:,4).GT.-XIBM_EPSI) PRWS(:,:,:) = 0.
+ENDIF
!
CALL MPPDB_CHECK3D(PRUS,"pressurez 4-before update_halo_ll::PRUS",PRECISION)
CALL MPPDB_CHECK3D(PRVS,"pressurez 4-before update_halo_ll::PRVS",PRECISION)
@@ -433,6 +449,10 @@ CALL MPPDB_CHECK3D(PRWS,"pressurez 4-after update_halo_ll::PRWS",PRECISION)
!
CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRUS,PRVS,PRWS,ZDV_SOURCE)
!
+IF (LIBM) THEN
+ CALL IBM_BALANCE(XIBM_LS,XIBM_SU,PRUS,PRVS,PRWS,ZDV_SOURCE)
+ENDIF
+!
! The non-homogenous Neuman problem is transformed in an homogenous Neuman
! problem in the non-periodic cases
IF (HLBCX(1) /= 'CYCL') THEN
@@ -444,6 +464,23 @@ IF (.NOT. L2D .AND. HLBCY(1) /= 'CYCL') THEN
IF (LSOUTH_ll()) ZDV_SOURCE(:,IJB-1,:) = 0.
IF (LNORTH_ll()) ZDV_SOURCE(:,IJE+1,:) = 0.
ENDIF
+
+IF (LIBM) THEN
+ !
+ IF (HLBCX(1) == 'CYCL') THEN
+ IF (LWEST_ll()) ZDV_SOURCE(IIB-1,:,:) = ZDV_SOURCE(IIB-1,:,:)*XIBM_SU(IIB,:,:,1)
+ IF (LEAST_ll()) ZDV_SOURCE(IIE+1,:,:) = ZDV_SOURCE(IIE+1,:,:)*XIBM_SU(IIE,:,:,1)
+ ENDIF
+ !
+ IF (HLBCY(1) == 'CYCL') THEN
+ IF (LSOUTH_ll()) ZDV_SOURCE(:,IJB-1,:) = ZDV_SOURCE(:,IJB-1,:)*XIBM_SU(:,IJB,:,1)
+ IF (LNORTH_ll()) ZDV_SOURCE(:,IJE+1,:) = ZDV_SOURCE(:,IJE+1,:)*XIBM_SU(:,IJE,:,1)
+ ENDIF
+ !
+ ZDV_SOURCE(:,:,IKB-1) = ZDV_SOURCE(:,:,IKB-1)*XIBM_SU(:,:,IKB,1)
+ ZDV_SOURCE(:,:,IKE+1) = ZDV_SOURCE(:,:,IKE+1)*XIBM_SU(:,:,IKE,1)
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!
@@ -471,15 +508,27 @@ IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
ZTHETAV(:,:,:) = PTHT(:,:,:)
END IF
!
+ IF (LIBM) THEN
+ WHERE (XIBM_LS(:,:,:,1).GT.-XIBM_EPSI)
+ ZTHETAV(:,:,:) = PTHVREF(:,:,:)
+ ENDWHERE
+ ENDIF
+ !
ZPHIT(:,:,:)=(PPABST(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)
!
ELSEIF(CEQNSYS=='LHE') THEN
- ZPHIT(:,:,:)= ((PPABST(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)) &
- * XCPD * PTHVREF(:,:,:)
- !
+ IF ( .NOT. LOCEAN) THEN
+ ZPHIT(:,:,:)= ((PPABST(:,:,:)/XP00)**(XRD/XCPD)-PEXNREF(:,:,:)) &
+ * XCPD * PTHVREF(:,:,:)
+ ELSE
+ ! Field at T- DT for LHE anelastic approx
+ ! not used in ocean case (flat LHE)
+ ZPHIT(:,:,:)=0.
+ END IF
+!
END IF
!
-IF(CEQNSYS=='LHE'.AND. LFLAT .AND. LCARTESIAN) THEN
+IF(CEQNSYS=='LHE'.AND. LFLAT .AND. LCARTESIAN .AND. .NOT. LIBM) THEN
! flat cartesian LHE case -> exact solution
IF ( HPRESOPT /= "ZRESI" ) THEN
CALL FLAT_INV(HLBCX,HLBCY,PDXHATM,PDYHATM,PRHOT,PAF,PBF,PCF, &
@@ -523,18 +572,57 @@ END IF
! ----------------------------------------
!
IF ( HLBCX(1) /= 'CYCL' ) THEN
- IF(LWEST_ll()) ZPHIT(IIB-1,:,IKB-1) = ZPHIT(IIB,:,IKB-1)
- IF(LEAST_ll()) ZPHIT(IIE+1,:,IKB-1) = ZPHIT(IIE,:,IKB-1)
+ IF(LWEST_ll()) THEN
+ ZPHIT(IIB-1,:,IKB-1) = ZPHIT(IIB,:,IKB)
+ ZPHIT(IIB-1,:,IKE+1) = ZPHIT(IIB,:,IKE)
+ ENDIF
+ IF(LEAST_ll()) THEN
+ ZPHIT(IIE+1,:,IKB-1) = ZPHIT(IIE,:,IKB)
+ ZPHIT(IIE+1,:,IKE+1) = ZPHIT(IIE,:,IKE)
+ ENDIF
ENDIF
+!
IF ( HLBCY(1) /= 'CYCL' ) THEN
- IF (LSOUTH_ll()) ZPHIT(:,IJB-1,IKB-1) = ZPHIT(:,IJB,IKB-1)
- IF (LNORTH_ll()) ZPHIT(:,IJE+1,IKB-1) = ZPHIT(:,IJE,IKB-1)
+ IF (LSOUTH_ll()) THEN
+ ZPHIT(:,IJB-1,IKB-1) = ZPHIT(:,IJB,IKB)
+ ZPHIT(:,IJB-1,IKE+1) = ZPHIT(:,IJB,IKE)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ ZPHIT(:,IJE+1,IKB-1) = ZPHIT(:,IJE,IKB)
+ ZPHIT(:,IJE+1,IKE+1) = ZPHIT(:,IJE,IKE)
+ ENDIF
ENDIF
!
IF ( L2D ) THEN
IF (LSOUTH_ll()) ZPHIT(:,IJB-1,:) = ZPHIT(:,IJB,:)
IF (LNORTH_ll()) ZPHIT(:,IJE+1,:) = ZPHIT(:,IJB,:)
-END IF
+ENDIF
+!
+IF (LIBM) THEN
+ !
+ IF ( HLBCX(1) == 'CYCL' ) THEN
+ IF (LWEST_ll()) THEN
+ ZPHIT(IIB-1,:,:) = ZPHIT(IIB,:,:)*(1.-XIBM_SU(IIB,:,:,1))+XIBM_SU(IIB,:,:,1)*ZPHIT(IIB-1,:,:)
+ ENDIF
+ IF (LEAST_ll()) THEN
+ ZPHIT(IIE+1,:,:) = ZPHIT(IIE,:,:)*(1.-XIBM_SU(IIE,:,:,1))+XIBM_SU(IIE,:,:,1)*ZPHIT(IIE+1,:,:)
+ ENDIF
+ ENDIF
+ !
+ IF ( HLBCY(1) == 'CYCL' ) THEN
+ IF (LSOUTH_ll()) THEN
+ ZPHIT(:,IJB-1,:) = ZPHIT(:,IJB,:)*(1.-XIBM_SU(:,IJB,:,1))+XIBM_SU(:,IJB,:,1)*ZPHIT(:,IJB-1,:)
+ ENDIF
+ IF (LNORTH_ll()) THEN
+ ZPHIT(:,IJE+1,:) = ZPHIT(:,IJE,:)*(1.-XIBM_SU(:,IJE,:,1))+XIBM_SU(:,IJE,:,1)*ZPHIT(:,IJE+1,:)
+ ENDIF
+ ENDIF
+ !
+ !-------------Bottom Boundary conditions
+ ZPHIT(:,:,IKB-1) = ZPHIT(:,:,IKB-1)*XIBM_SU(:,:,IKB,1)+(1.-XIBM_SU(:,:,IKB,1))*ZPHIT(:,:,IKB)
+ ZPHIT(:,:,IKE+1) = ZPHIT(:,:,IKE+1)*XIBM_SU(:,:,IKE,1)+(1.-XIBM_SU(:,:,IKE,1))*ZPHIT(:,:,IKE)
+ !
+ENDIF
!
ZDV_SOURCE = GX_M_U(1,IKU,1,ZPHIT,PDXX,PDZZ,PDZX)
!
@@ -633,6 +721,10 @@ CALL CLEANLIST_ll(TZFIELDS2_ll)
! compute the residual divergence
CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,PRUS,PRVS,PRWS,ZDV_SOURCE)
!
+IF (LIBM) THEN
+ ZDV_SOURCE(:,:,:)=ZDV_SOURCE(:,:,:)*XIBM_SU(:,:,:,2)
+ENDIF
+!
IF ( CEQNSYS=='DUR' ) THEN
IF ( SIZE(PRVREF,1) == 0 ) THEN
ZDV_SOURCE=ZDV_SOURCE/PRHODJ/XTH00*PRHODREF*PTHVREF
@@ -674,12 +766,16 @@ IF (OITRADJ) THEN
ENDIF
ENDIF
!
+IF (LIBM) THEN
+ KITR=MIN(NIBM_ITR,KITR)
+ENDIF
+!
!* 7. STORAGE OF THE FIELDS IN BUDGET ARRAYS
! --------------------------------------
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'PRES_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'PRES_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'PRES_BU_RW')
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'PRES', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'PRES', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'PRES', prws(:, :, :) )
!
!-------------------------------------------------------------------------------
!
@@ -695,12 +791,23 @@ IF ((ZMAX_ll > 1.E-12) .AND. KTCOUNT >0 ) THEN
!IF ( KTCOUNT >0 .AND. .NOT.LBOUSS ) THEN
CALL P_ABS ( KRR, KRRL, KRRI, PDRYMASST, PREFMASS, PMASS_O_PHI0, &
PTHT, PRT, PRHODJ, PRHODREF, ZTHETAV, PTHVREF, &
- PRVREF, PEXNREF, ZPHIT )
+ PRVREF, PEXNREF, ZPHIT, ZPHI0 )
!
IF(CEQNSYS=='MAE' .OR. CEQNSYS=='DUR') THEN
PPABST(:,:,:)=XP00*(ZPHIT+PEXNREF)**(XCPD/XRD)
ELSEIF(CEQNSYS=='LHE') THEN
- PPABST(:,:,:)=XP00*(ZPHIT/(XCPD*PTHVREF)+PEXNREF)**(XCPD/XRD)
+ IF (.NOT. LOCEAN) THEN
+ ! Deep atmosphere case : computing of PI fluctuation ; ZPHI0 (computed in P_ABS routine) is added
+ XPHIT(:,:,:) = (ZPHIT+ZPHI0)/(XCPD*PTHVREF)
+ ! Absolute Pressure
+ PPABST(:,:,:)=XP00*(XPHIT(:,:,:)+PEXNREF)**(XCPD/XRD)
+ ! Computing press fluctuation
+ XPHIT(:,:,:) = PPABST(:,:,:) - XP00*PEXNREF**(XCPD/XRD)
+ ELSE
+! Shallow atmosphere ou ocean
+ XPHIT(:,:,:) = (ZPHIT+ZPHI0)*PRHODREF
+ PPABST(:,:,:)=XPHIT(:,:,:) + XP00*PEXNREF**(XCPD/XRD)
+ END IF
ENDIF
!
IF( HLBCX(1) == 'CYCL' ) THEN
diff --git a/src/MNH/profilern.f90 b/src/MNH/profilern.f90
index 5dd11eb7cd32600a396f73ede6404a4a511a52c3..433a5c6ef02ae8a1630718f497b1f602b536f7a5 100644
--- a/src/MNH/profilern.f90
+++ b/src/MNH/profilern.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2002-2018 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.
!-----------------------------------------------------------------
! ##########################
@@ -10,18 +10,11 @@ MODULE MODI_PROFILER_n
INTERFACE
!
SUBROUTINE PROFILER_n(PTSTEP, &
- TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
PXHAT, PYHAT, PZ,PRHODREF, &
PU, PV, PW, PTH, PR, PSV, PTKE, &
- PTS,PP, PAER, PCLDFR, PCIT)
-!
-USE MODD_TYPE_DATE
+ PTS, PP, PAER, PCLDFR, PCIT, PSEA)
!
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTEXP! experiment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTMOD! model start date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG! segment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTCUR! current date and time
REAL, DIMENSION(:), INTENT(IN) :: PXHAT ! x coordinate
REAL, DIMENSION(:), INTENT(IN) :: PYHAT ! y coordinate
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
@@ -38,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
!
!-------------------------------------------------------------------------------
!
@@ -49,10 +43,9 @@ END MODULE MODI_PROFILER_n
!
! ########################################################
SUBROUTINE PROFILER_n(PTSTEP, &
- TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
PXHAT, PYHAT, PZ,PRHODREF, &
PU, PV, PW, PTH, PR, PSV, PTKE, &
- PTS, PP, PAER, PCLDFR, PCIT)
+ PTS, PP, PAER, PCLDFR, PCIT, PSEA)
! ########################################################
!
!
@@ -90,32 +83,55 @@ END MODULE MODI_PROFILER_n
!! C.Lac 10/2016 Add visibility diagnostic
!! 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 05/07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_TYPE_DATE
-USE MODD_PROFILER_n
-USE MODD_SUB_PROFILER_n
-USE MODD_TIME
-USE MODD_PARAMETERS
+USE MODD_CONF
USE MODD_CST
-USE MODD_GRID
USE MODD_DIAG_IN_RUN
-USE MODD_CONF
+USE MODD_GRID
+USE MODD_SUB_PROFILER_n
USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_n, ONLY: CCLOUD, CRAD
+USE MODD_PROFILER_n
+USE MODD_TIME, only: tdtexp
+USE MODD_TIME_n, only: tdtcur
!
-USE MODE_DATETIME
USE MODE_ll
!
-USE MODI_WATER_SUM
-USE MODI_RADAR_RAIN_ICE
+USE MODI_GPS_ZENITH_GRID
USE MODI_LIDAR
+USE MODI_RADAR_RAIN_ICE
USE MODI_WATER_SUM
-USE MODI_GPS_ZENITH_GRID
-USE MODD_PARAM_n, ONLY : CCLOUD,CRAD
+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
@@ -125,10 +141,6 @@ IMPLICIT NONE
!
!
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTEXP! experiment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTMOD! model start date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG! segment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTCUR! current date and time
REAL, DIMENSION(:), INTENT(IN) :: PXHAT ! x coordinate
REAL, DIMENSION(:), INTENT(IN) :: PYHAT ! y coordinate
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
@@ -145,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
!
!-------------------------------------------------------------------------------
!
@@ -160,7 +173,6 @@ INTEGER :: IKE
INTEGER :: IIU
INTEGER :: IJU
INTEGER :: IKU
-REAL :: ZTIMEEXP
!
!
REAL, DIMENSION(SIZE(PXHAT)) :: ZXHATM ! mass point coordinates
@@ -210,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
@@ -226,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
! -------
!
@@ -257,7 +294,6 @@ IF ( TPROFILER%T_CUR == XUNDEF ) TPROFILER%T_CUR = TPROFILER%STEP - PTSTEP
!
TPROFILER%T_CUR = TPROFILER%T_CUR + PTSTEP
!
-CALL DATETIME_DISTANCE(TDTEXP,TDTSEG,ZTIMEEXP)
IF ( TPROFILER%T_CUR >= TPROFILER%STEP - 1.E-10 ) THEN
GSTORE = .TRUE.
TPROFILER%T_CUR = TPROFILER%T_CUR - TPROFILER%STEP
@@ -268,23 +304,14 @@ ELSE
END IF
!
IF (GSTORE) THEN
- TPROFILER%TIME(IN) = (IN-1) * TPROFILER%STEP + ZTIMEEXP
- TPROFILER%DATIME( 1,IN) = TPDTEXP%TDATE%YEAR
- TPROFILER%DATIME( 2,IN) = TPDTEXP%TDATE%MONTH
- TPROFILER%DATIME( 3,IN) = TPDTEXP%TDATE%DAY
- TPROFILER%DATIME( 4,IN) = TPDTEXP%TIME
- TPROFILER%DATIME( 5,IN) = TPDTSEG%TDATE%YEAR
- TPROFILER%DATIME( 6,IN) = TPDTSEG%TDATE%MONTH
- TPROFILER%DATIME( 7,IN) = TPDTSEG%TDATE%DAY
- TPROFILER%DATIME( 8,IN) = TPDTSEG%TIME
- TPROFILER%DATIME( 9,IN) = TPDTMOD%TDATE%YEAR
- TPROFILER%DATIME(10,IN) = TPDTMOD%TDATE%MONTH
- TPROFILER%DATIME(11,IN) = TPDTMOD%TDATE%DAY
- TPROFILER%DATIME(12,IN) = TPDTMOD%TIME
- TPROFILER%DATIME(13,IN) = TPDTCUR%TDATE%YEAR
- TPROFILER%DATIME(14,IN) = TPDTCUR%TDATE%MONTH
- TPROFILER%DATIME(15,IN) = TPDTCUR%TDATE%DAY
- TPROFILER%DATIME(16,IN) = TPDTCUR%TIME
+#if 0
+ tprofiler%tpdates(in)%date%year = tdtexp%date%year
+ tprofiler%tpdates(in)%date%month = tdtexp%date%month
+ tprofiler%tpdates(in)%date%day = tdtexp%date%day
+ tprofiler%tpdates(in)%xtime = tdtexp%xtime + ( in - 1 ) * tprofiler%step
+#else
+ tprofiler%tpdates(in) = tdtcur
+#endif
END IF
!
!
@@ -389,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
@@ -398,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
@@ -410,7 +436,6 @@ IF ((SIZE(PR,4) >= 2) .AND. NSV_C2R2END /= 0 ) THEN
END IF
!
IF (GSTORE) THEN
- IF (TPROFILER%TIME(IN) /= XUNDEF) THEN
DO I=1,NUMBPROFILER
IF ((ZTHIS_PROCS(I)==1.).AND.(.NOT. TPROFILER%ERROR(I))) THEN
!
@@ -502,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
@@ -592,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))
@@ -612,8 +900,6 @@ ENDDO
!
END IF
!
-END IF
-!
!----------------------------------------------------------------------------
!----------------------------------------------------------------------------
!
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 d4da491d97bc6c716267088375a88a11fbeac7cc..24c49ab38f58702aec4c40a6996f0575a3d2f8e5 100644
--- a/src/MNH/qlap.f90
+++ b/src/MNH/qlap.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -110,6 +110,7 @@ END MODULE MODI_QLAP
!! 06/12 V.Masson : update_halo due to CONTRAV changes
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! F. Auguste 02/21: add IBM
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -126,6 +127,9 @@ USE MODI_SHUMAN
!
USE MODE_MPPDB
!
+USE MODD_IBM_PARAM_n, ONLY: XIBM_LS, LIBM, XIBM_SU
+USE MODI_IBM_BALANCE
+!
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -160,7 +164,7 @@ INTEGER :: IIU,IJU,IKU ! I,J,K array sizes
INTEGER :: JK,JJ,JI ! vertical loop index
TYPE(LIST_ll), POINTER :: TZFIELDS_ll ! list of fields to exchange
INTEGER :: IINFO_ll
-INTEGER :: IIB,IIE,IJB,IJE
+INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE
!-------------------------------------------------------------------------------
!
!
@@ -170,6 +174,8 @@ INTEGER :: IIB,IIE,IJB,IJE
CALL GET_DIM_EXT_ll('B',IIU,IJU)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKU=SIZE(PY,3)
+IKE = IKU - JPVEXT
+IKB = 1 + JPVEXT
!
ZU = GX_M_U(1,IKU,1,PY,PDXX,PDZZ,PDZX)
CALL MPPDB_CHECK3D(ZU,'QLAP::ZU',PRECISION)
@@ -257,7 +263,26 @@ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZW, 'QLAP::ZW' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
!
-CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,ZU,ZV,ZW,PQLAP)
+CALL GDIV(HLBCX,HLBCY,PDXX,PDYY,PDZX,PDZY,PDZZ,ZU,ZV,ZW,PQLAP)
+!
+IF (LIBM) THEN
+ !
+ CALL IBM_BALANCE(XIBM_LS,XIBM_SU,ZU,ZV,ZW,PQLAP)
+ !
+ PQLAP(:,:,IKB-1) = PQLAP(:,:,IKB-1)*XIBM_SU(:,:,IKB,1)
+ PQLAP(:,:,IKE+1) = PQLAP(:,:,IKE+1)*XIBM_SU(:,:,IKE,1)
+ !
+ IF ( HLBCX(1) /= 'CYCL' ) THEN
+ IF(LWEST_ll()) PQLAP(IIB-1,:,:) = PQLAP(IIB-1,:,:)*XIBM_SU(IIB,:,:,1)
+ IF(LEAST_ll()) PQLAP(IIE+1,:,:) = PQLAP(IIE+1,:,:)*XIBM_SU(IIE,:,:,1)
+ ENDIF
+ !
+ IF ( HLBCY(1) /= 'CYCL' ) THEN
+ IF (LSOUTH_ll()) PQLAP(:,IJB-1,:) = PQLAP(:,IJB-1,:)*XIBM_SU(:,IJB,:,1)
+ IF (LNORTH_ll()) PQLAP(:,IJE+1,:) = PQLAP(:,IJE+1,:)*XIBM_SU(:,IJE,:,1)
+ ENDIF
+ !
+ENDIF
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/rad_bound.f90 b/src/MNH/rad_bound.f90
index 5c77800b0ba8a034eb63c69e1110d1f71367b3bc..296d476b44d32be4d2814e4614cfe0c7cfc1e1b2 100644
--- a/src/MNH/rad_bound.f90
+++ b/src/MNH/rad_bound.f90
@@ -1,12 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-!-----------------------------------------------------------------
!####################
MODULE MODI_RAD_BOUND
!####################
@@ -17,6 +13,7 @@ INTERFACE
PTSTEP,PDXHAT,PDYHAT,PZHAT, &
PUT,PVT, &
PLBXUM,PLBYVM,PLBXUS,PLBYVS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS, &
PCPHASE,PCPHASE_PBL,PRHODJ, &
PTKET,PRUS,PRVS,PRWS )
!
@@ -31,6 +28,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Y-direc. meshlength
REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT ! at t
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS
!
! Lateral Boundary fields at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBYVM
@@ -58,6 +56,7 @@ END MODULE MODI_RAD_BOUND
PTSTEP,PDXHAT,PDYHAT,PZHAT, &
PUT,PVT, &
PLBXUM,PLBYVM,PLBXUS,PLBYVS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS, &
PCPHASE,PCPHASE_PBL,PRHODJ, &
PTKET,PRUS,PRVS,PRWS )
! #################################################################
@@ -152,7 +151,8 @@ END MODULE MODI_RAD_BOUND
!! Lac.C. 2011 : Adaptation to FIT temporal scheme
!! Modification 06/13 (C.Lac) Introduction of cphase_pbl
!! Modification 03/14 (C.Lac) Replacement of XRIMKMAX by XCARPKMAX
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! Modification 02/2021 (T.Nagel) Add velocity fluctuations for turbulence recycling purpose
!!
!-------------------------------------------------------------------------------
!
@@ -160,13 +160,14 @@ END MODULE MODI_RAD_BOUND
! ------------
!
USE MODD_CONF
-USE MODD_PARAMETERS
USE MODD_CTURB
-!
-USE MODI_CPHASE_PROFILE
+USE MODD_PARAMETERS
+USE MODD_RECYCL_PARAM_n, ONLY: LRECYCL, XRCOEFF
!
USE MODE_ll
!
+USE MODI_CPHASE_PROFILE
+!
IMPLICIT NONE
!
!
@@ -185,6 +186,7 @@ REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Y-direc. meshlength
REAL, DIMENSION(:), INTENT(IN) :: PZHAT ! height level without orography
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PUT,PVT ! at t
+REAL, DIMENSION(:,:), INTENT(IN) :: PFLUCTUNW,PFLUCTVNN,PFLUCTUNE,PFLUCTVNS
!
! Lateral Boundary fields at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PLBXUM,PLBYVM
@@ -256,8 +258,8 @@ ZALPHA2 = 1.
!
!* 2. LBC FILLING IN THE X DIRECTION (LEFT WEST SIDE):
! ------------------------------
-! ====> It only concernes U component
-! -----------
+! ====> It only concerns U component
+! -----------
!
IF (LWEST_ll( )) THEN
!
@@ -289,12 +291,20 @@ SELECT CASE ( HLBCX(1) )
IF ( SIZE(PLBXUS,1) == 0 ) THEN
ZLBEU (:,:) = 0.
ZLBGU (:,:) = PLBXUM(JPHEXT+1,:,:) - PLBXUM(JPHEXT,:,:) ! 2 - 1
- ZLBXU(:,:) = PLBXUM(JPHEXT,:,:) ! 1
+ IF ( LRECYCL ) THEN
+ ZLBXU(:,:) = PLBXUM(JPHEXT,:,:) + PFLUCTUNW * XRCOEFF
+ ELSE
+ ZLBXU(:,:) = PLBXUM(JPHEXT,:,:)
+ END IF
ELSE
ZLBEU (:,:) = PLBXUS(JPHEXT,:,:) ! 1
ZLBGU (:,:) = PLBXUM(JPHEXT+1,:,:) - PLBXUM(JPHEXT,:,:) + & ! 2 - 1
PTSTEP * (PLBXUS(JPHEXT+1,:,:) - PLBXUS(JPHEXT,:,:)) ! 2 - 1
- ZLBXU(:,:) = PLBXUM(JPHEXT,:,:) + PTSTEP * PLBXUS(JPHEXT,:,:) ! 1 + 1
+ IF ( LRECYCL ) THEN
+ ZLBXU(:,:) = PLBXUM(JPHEXT,:,:)+ PTSTEP *PLBXUS(JPHEXT,:,:) + PFLUCTUNW * XRCOEFF ! 1 + 1
+ ELSE
+ ZLBXU(:,:) = PLBXUM(JPHEXT,:,:)+ PTSTEP *PLBXUS(JPHEXT,:,:) ! 1 + 1
+ END IF
END IF
!
! ============================================================
@@ -324,8 +334,8 @@ END IF
!
!* 3. LBC FILLING IN THE X DIRECTION (RIGHT EAST SIDE):
! ------------------------------
-! ====> It only concernes U component
-! -----------
+! ====> It only concerns U component
+! -----------
!
IF (LEAST_ll( )) THEN
!
@@ -358,12 +368,20 @@ SELECT CASE ( HLBCX(2) )
IF (SIZE(PLBXUS,1) == 0 ) THEN
ZLBEU (:,:) = 0.
ZLBGU (:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) - PLBXUM(ILBX-JPHEXT,:,:) ! ILBX / (ILBX-1
- ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:)
+ IF ( LRECYCL ) THEN
+ ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) + PFLUCTUNE * XRCOEFF
+ ELSE
+ ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:)
+ END IF
ELSE
ZLBEU (:,:) = PLBXUS(ILBX-JPHEXT+1,:,:)
ZLBGU (:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) - PLBXUM(ILBX-JPHEXT,:,:) + &
PTSTEP * (PLBXUS(ILBX-JPHEXT+1,:,:) - PLBXUS(ILBX-JPHEXT,:,:))
- ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) + PTSTEP * PLBXUS(ILBX-JPHEXT+1,:,:)
+ IF ( LRECYCL ) THEN
+ ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) + PTSTEP * PLBXUS(ILBX-JPHEXT+1,:,:) + PFLUCTUNE * XRCOEFF
+ ELSE
+ ZLBXU(:,:) = PLBXUM(ILBX-JPHEXT+1,:,:) + PTSTEP * PLBXUS(ILBX-JPHEXT+1,:,:)
+ END IF
END IF
!
! ============================================================
@@ -395,8 +413,8 @@ END IF
!
!* 4. LBC FILLING IN THE Y DIRECTION (BOTTOM SOUTH SIDE):
! ------------------------------
-! ====> It only concernes V component
-! -----------
+! ====> It only concerns V component
+! -----------
!
IF (LSOUTH_ll( )) THEN
!
@@ -426,12 +444,20 @@ SELECT CASE ( HLBCY(1) )
IF ( SIZE(PLBYVS,1) == 0 ) THEN
ZLBEV (:,:) = 0.
ZLBGV (:,:) = PLBYVM(:,JPHEXT+1,:) - PLBYVM(:,JPHEXT,:)
- ZLBYV(:,:) = PLBYVM(:,JPHEXT,:)
+ IF ( LRECYCL ) THEN
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PFLUCTVNS * XRCOEFF
+ ELSE
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:)
+ END IF
ELSE
ZLBEV (:,:) = PLBYVS(:,JPHEXT,:)
ZLBGV (:,:) = PLBYVM(:,JPHEXT+1,:) - PLBYVM(:,JPHEXT,:) + &
PTSTEP * (PLBYVS(:,JPHEXT+1,:) - PLBYVS(:,JPHEXT,:))
- ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PTSTEP * PLBYVS(:,JPHEXT,:)
+ IF ( LRECYCL ) THEN
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PTSTEP * PLBYVS(:,JPHEXT,:) + PFLUCTVNS * XRCOEFF
+ ELSE
+ ZLBYV(:,:) = PLBYVM(:,JPHEXT,:) + PTSTEP * PLBYVS(:,JPHEXT,:)
+ END IF
END IF
!
! ============================================================
@@ -461,8 +487,8 @@ END IF
!
!* 5. LBC FILLING IN THE Y DIRECTION (TOP NORTH SIDE):
! ------------------------------
-! ====> It only concernes V component
-! -----------
+! ====> It only concerns V component
+! -----------
!
IF (LNORTH_ll( )) THEN
!
@@ -494,12 +520,20 @@ SELECT CASE ( HLBCY(2) )
IF ( SIZE(PLBYVS,1) == 0 ) THEN
ZLBEV (:,:) = 0.
ZLBGV (:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) - PLBYVM(:,ILBY-JPHEXT,:)
- ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:)
+ IF ( LRECYCL ) THEN
+ ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) + PFLUCTVNN * XRCOEFF
+ ELSE
+ ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:)
+ END IF
ELSE
ZLBEV (:,:) = PLBYVS(:,ILBY-JPHEXT+1,:)
ZLBGV (:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) - PLBYVM(:,ILBY-JPHEXT,:) + &
PTSTEP * (PLBYVS(:,ILBY-JPHEXT+1,:) - PLBYVS(:,ILBY-JPHEXT,:))
- ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) + PTSTEP * PLBYVS(:,ILBY-JPHEXT+1,:)
+ IF ( LRECYCL ) THEN
+ ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) + PTSTEP *PLBYVS(:,ILBY-JPHEXT+1,:) + PFLUCTVNN * XRCOEFF
+ ELSE
+ ZLBYV(:,:) = PLBYVM(:,ILBY-JPHEXT+1,:) + PTSTEP *PLBYVS(:,ILBY-JPHEXT+1,:)
+ END IF
END IF
!
! ============================================================
diff --git a/src/MNH/radiations.f90 b/src/MNH/radiations.f90
index 8d47d4851fe307bbfa631489ad4fdbf10a128a7c..e0bda3fcab8d068a4574d5adb6c0baaf8d966406 100644
--- a/src/MNH/radiations.f90
+++ b/src/MNH/radiations.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -10,9 +10,9 @@
CONTAINS
!
! ############################################################################
- SUBROUTINE RADIATIONS (OCLOSE_OUT,TPFILE,OCLEAR_SKY,OCLOUD_ONLY, &
+ SUBROUTINE RADIATIONS (TPFILE,OCLEAR_SKY,OCLOUD_ONLY, &
KCLEARCOL_TM1,HEFRADL,HEFRADI,HOPWSW,HOPISW,HOPWLW,HOPILW, &
- PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB_OLD, &
+ PFUDG, KDLON, KFLEV, KRAD_DIAG, KFLUX, KRAD, KAER, KSWB_OLD, &
KSWB_MNH,KLWB_MNH, KSTATM,KRAD_COLNBR,PCOSZEN,PSEA, PCORSOL, &
PDIR_ALB, PSCA_ALB,PEMIS, PCLDFR, PCCO2, PTSRAD, PSTATM, &
PTHT, PRT, PPABST, POZON, PAER, PDST_WL, PAER_CLIM, PSVT, &
@@ -84,7 +84,7 @@ CONTAINS
!! -------------
!! Original 26/02/95
!! J.Stein 20/12/95 add the array splitting in order to save memory
-!! J.-P. Pinty 19/11/96 change the splitted arrays, specific humidity
+!! J.-P. Pinty 19/11/96 change the split arrays, specific humidity
!! and add the ice phase
!! J.Stein 22/06/97 use of the absolute pressure
!! P.Jabouille 31/07/97 impose a zero humidity for dry simulation
@@ -133,6 +133,7 @@ USE MODD_CH_AEROSOL, ONLY: LORILAM
USE MODD_CONF, ONLY: LCARTESIAN
USE MODD_CST
USE MODD_DUST, ONLY: LDUST
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_GRID , ONLY: XLAT0, XLON0
USE MODD_GRID_n , ONLY: XLAT, XLON
USE MODD_IO, ONLY: TFILEDATA
@@ -153,7 +154,6 @@ USE MODD_SALT, ONLY: LSALT
USE MODD_TIME
!
USE MODE_DUSTOPT
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
use mode_msg
@@ -176,9 +176,6 @@ IMPLICIT NONE
!
!* 0.1 DECLARATIONS OF DUMMY ARGUMENTS :
!
-LOGICAL, INTENT(IN) :: OCLOSE_OUT! flag indicating that a FM
- ! file is opened during this
- ! time-step
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
LOGICAL, INTENT(IN) :: OCLOUD_ONLY! flag for the cloud column
! computations only
@@ -204,7 +201,7 @@ INTEGER, INTENT(IN) :: KSTATM ! index of the standard
! atmosphere level just above
! the model top
INTEGER, INTENT(IN) :: KRAD_COLNBR ! factor by which the memory
- ! is splitted
+ ! is split
!
!Choice of :
CHARACTER (LEN=*), INTENT (IN) :: HEFRADL !
@@ -418,7 +415,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1, ZWORK2, ZWORK3, ZWORK
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK4, ZWORK1AER, ZWORK2AER, ZWORK_GRID
LOGICAL, DIMENSION(SIZE(PTHT,1),SIZE(PTHT,2)) :: ZWORKL
!
-! splitted arrays used to split the memory required by the ECMWF_radiation
+! split arrays used to split the memory required by the ECMWF_radiation
! subroutine, the fields have the same meaning as their complete counterpart
!
REAL(KIND=JPRB), DIMENSION(:,:), ALLOCATABLE :: ZALBP_SPLIT, ZALBD_SPLIT
@@ -514,7 +511,7 @@ REAL, DIMENSION(KFLEV,KSWB_OLD) :: ZTAUREL_EQ_CLEAR !tau/tau_{550}
INTEGER :: WVL_IDX !Counter for wavelength
!
-INTEGER :: JI_SPLIT ! loop on the splitted array
+INTEGER :: JI_SPLIT ! loop on the split array
INTEGER :: INUM_CALL ! number of CALL of the radiation scheme
INTEGER :: IDIM_EFF ! effective number of air-columns to compute
INTEGER :: IDIM_RESIDUE ! number of remaining air-columns to compute
@@ -1103,6 +1100,11 @@ DO JJ=IJB,IJE
ZO3AVE(IIJ,:) = POZON (JI,JJ,:)
END DO
END DO
+#ifdef MNH_ECRAD
+#if ( VER_ECRAD == 140 )
+POZON = POZON
+#endif
+#endif
!
!-------------------------------------------------------------------------------
!
@@ -1163,7 +1165,6 @@ ZEMIW(:,:)= ZEMIS(:,:)
ZRII0= PCORSOL*XI0 ! solar constant multiplied by seasonal variations due to Earth-Sun distance
!
!
-!
!* 5.2 ACCOUNTS FOR THE CLEAR-SKY APPROXIMATION
!
! Performs the horizontal average of the fields when no cloud
@@ -2181,7 +2182,7 @@ ELSE
END IF
END IF
!
-! fill the splitted arrays with their values taken from the full arrays
+! fill the split arrays with their values taken from the full arrays
!
IBEG = IDIM-IDIM_RESIDUE+1
IEND = IBEG+IDIM_EFF-1
@@ -2218,7 +2219,7 @@ ELSE
ZQSAVE_SPLIT (:,:) = ZQSAVE (IBEG:IEND ,:)
ZTS_SPLIT (:) = ZTS (IBEG:IEND)
!
-! CALL the ECMWF radiation with the splitted array
+! CALL the ECMWF radiation with the split array
!
IF (CCLOUD == 'LIMA') THEN
! LIMA concentrations
@@ -2320,7 +2321,7 @@ ELSE
END IF
END IF
!
-! fill the full output arrays with the splitted arrays
+! fill the full output arrays with the split arrays
!
ZDTLW( IBEG:IEND ,:) = ZDTLW_SPLIT(:,:)
ZDTSW( IBEG:IEND ,:) = ZDTSW_SPLIT(:,:)
@@ -2336,7 +2337,7 @@ ELSE
ZFLUX_SW_DOWN( IBEG:IEND ,:) = ZFLUX_SW_DOWN_SPLIT(:,:)
ZFLUX_SW_UP( IBEG:IEND ,:) = ZFLUX_SW_UP_SPLIT(:,:)
ZRADLP( IBEG:IEND ,:) = ZRADLP_SPLIT(:,:)
- IF( OCLOSE_OUT ) THEN
+ IF ( tpfile%lopened ) THEN
IF( KRAD_DIAG >= 1) THEN
ZNFLW(IBEG:IEND ,:)= ZNFLW_SPLIT(:,:)
ZNFSW(IBEG:IEND ,:)= ZNFSW_SPLIT(:,:)
@@ -2372,7 +2373,7 @@ ELSE
!
IDIM_RESIDUE = IDIM_RESIDUE - IDIM_EFF
!
-! desallocation of the splitted arrays
+! desallocation of the split arrays
!
IF( JI_SPLIT >= INUM_CALL-1 ) THEN
DEALLOCATE( ZALBP_SPLIT )
@@ -2678,7 +2679,7 @@ END IF
!* 7. STORE SOME ADDITIONNAL RADIATIVE FIELDS
! ---------------------------------------
!
-IF( OCLOSE_OUT .AND. (KRAD_DIAG >= 1) ) THEN
+IF( tpfile%lopened .AND. (KRAD_DIAG >= 1) ) THEN
ZSTORE_3D(:,:,:) = 0.0
ZSTORE_3D2(:,:,:) = 0.0
ZSTORE_2D(:,:) = 0.0
diff --git a/src/MNH/radtr_satel.f90 b/src/MNH/radtr_satel.f90
index 357b7941c06927cdbf7b1ed5e01627d7a97f3adc..ce4f86451ba3abeb5fa293ff5036fccfe8d9138e 100644
--- a/src/MNH/radtr_satel.f90
+++ b/src/MNH/radtr_satel.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2019 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.
@@ -25,7 +25,7 @@ INTEGER, INTENT(IN) :: KFLEV !number of vertical levels where the
!radiation calculations are performed
INTEGER, INTENT(IN) :: KSTATM !index of the standard atmosphere level
!just above the model top
-INTEGER, INTENT(IN) :: KRAD_COLNBR !factor by which the memory is splitted
+INTEGER, INTENT(IN) :: KRAD_COLNBR !factor by which the memory is split
!
REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
REAL, INTENT(IN) :: PCCO2 !CO2 content
@@ -136,7 +136,7 @@ INTEGER, INTENT(IN) :: KFLEV !number of vertical levels where the
! radiation calculations are performed
INTEGER, INTENT(IN) :: KSTATM !index of the standard atmosphere level
!just above the model top
-INTEGER, INTENT(IN) :: KRAD_COLNBR !factor by which the memory is splitted
+INTEGER, INTENT(IN) :: KRAD_COLNBR !factor by which the memory is split
!
REAL, DIMENSION(:,:), INTENT(IN) :: PEMIS !Surface IR EMISsivity
REAL, INTENT(IN) :: PCCO2 !CO2 content
@@ -226,7 +226,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZZRADFT
!
REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1, ZWORK3
!
-! splitted arrays used to split the memory required by the ECMWF_radiation
+! split arrays used to split the memory required by the ECMWF_radiation
! subroutine, the fields have the same meaning as their complete counterpart
REAL, DIMENSION(:), ALLOCATABLE :: ZREMIS_SPLIT
REAL, DIMENSION(:,:), ALLOCATABLE :: ZO3AVE_SPLIT
@@ -241,7 +241,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZDT0_SPLIT
REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADBT_SPLIT
REAL, DIMENSION(:,:), ALLOCATABLE :: ZRADBC_SPLIT
!
-INTEGER :: JI_SPLIT ! loop on the splitted array
+INTEGER :: JI_SPLIT ! loop on the split array
INTEGER :: INUM_CALL ! number of CALL of the radiation scheme
INTEGER :: IDIM_EFF ! effective number of air-columns to compute
INTEGER :: IDIM_RESIDUE ! number of remaining air-columns to compute
@@ -257,6 +257,7 @@ REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZNCLD ! grid scale cloud fraction
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRC ! grid scale r_c mixing ratio (kg/kg)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRI ! grid scale r_i (kg/kg)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRV ! grid scale r_v (kg/kg)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
!----------------------------------------------------------------------------
!
!* 1. INITIALIZATION OF CONSTANTS FOR TRANSFERT CODE
@@ -476,8 +477,10 @@ IF( SIZE(PRT(:,:,:,:),4) >= 2 ) THEN
ALLOCATE(ZSIGRC(IIU,IJU,IKU))
ALLOCATE(ZRV(IIU,IJU,IKU))
ZRV=PRT(:,:,:,1)
- CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'T',&
- PPABST, PZZ, ZTEMP, ZRV, ZRC, ZRI, PRT(:,:,:,5), PRT(:,:,:,6), PSIGS,&
+ ALLOCATE(ZRHO(IIU,IJU,IKU))
+ ZRHO=1. !unused
+ CALL CONDENSATION( IIU, IJU, IKU, IIB, IIE, IJB, IJE, IKB, IKE, 1, 'T', 'CB02', 'CB',&
+ PPABST, PZZ, ZRHO, ZTEMP, ZRV, ZRC, ZRI, PRT(:,:,:,5), PRT(:,:,:,6), PSIGS,&
PMFCONV, ZNCLD, ZSIGRC, OUSERI, OSIGMAS,PSIGQSAT )
DEALLOCATE(ZTEMP,ZSIGRC)
ELSE
@@ -642,7 +645,7 @@ ELSE
ALLOCATE( ZRADBC_SPLIT(IDIM_EFF,JPWVINT))
END IF
!
- ! fill the splitted arrays with their values
+ ! fill the split arrays with their values
! taken from the full arrays
!
IBEG = IDIM-IDIM_RESIDUE+1
@@ -658,7 +661,7 @@ ELSE
ZVIEW_SPLIT(:) = ZVIEW ( IBEG:IEND )
ZDT0_SPLIT(:) = ZDT0 ( IBEG:IEND )
!
- ! call ECMWF_radiation with the splitted arrays
+ ! call ECMWF_radiation with the split arrays
!
CALL NBMVEC( 1, IDIM_EFF, IDIM_EFF, KFLEV, IGL, ICABS, ING1, IUABS,&
IH2O, ICO2, IO3, ICNT, IN2O, ICH4, ICO, IC11, IC12, ICFC, &
@@ -668,14 +671,14 @@ ELSE
ZVIEW_SPLIT, ZCLDLD_SPLIT, ZCLDLU_SPLIT, ZDT0_SPLIT, &
ZREMIS_SPLIT, ZRADBC_SPLIT, ZRADBT_SPLIT)
!
- ! fill the full output arrays with the splitted arrays
+ ! fill the full output arrays with the split arrays
!
ZRADBT( IBEG:IEND ,:) = ZRADBT_SPLIT(:,:)
ZRADBC( IBEG:IEND ,:) = ZRADBC_SPLIT(:,:)
!
IDIM_RESIDUE = IDIM_RESIDUE - IDIM_EFF
!
- ! desallocation of the splitted arrays
+ ! desallocation of the split arrays
!
IF( JI_SPLIT >= INUM_CALL-1 ) THEN
DEALLOCATE(ZREMIS_SPLIT)
diff --git a/src/MNH/rain_c2r2_khko.f90 b/src/MNH/rain_c2r2_khko.f90
index 07060753098a0018b03b7cd6d72bfe9f2a1e8705..5708c0d4c4742afee013137bff42bc0fc1d51c48 100644
--- a/src/MNH/rain_c2r2_khko.f90
+++ b/src/MNH/rain_c2r2_khko.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.
@@ -9,7 +9,7 @@
!
INTERFACE
SUBROUTINE RAIN_C2R2_KHKO(HCLOUD,OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, &
- KMI,TPFILE, OCLOSE_OUT, &
+ KMI,TPFILE, &
PZZ, PRHODJ, &
PRHODREF, PEXNREF, &
PPABST, PTHT, PRVT, PRCT, &
@@ -36,8 +36,6 @@ INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
@@ -86,7 +84,7 @@ END INTERFACE
END MODULE MODI_RAIN_C2R2_KHKO
! ######################################################################
SUBROUTINE RAIN_C2R2_KHKO (HCLOUD,OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, &
- KMI, TPFILE, OCLOSE_OUT, PZZ, PRHODJ, &
+ KMI, TPFILE, PZZ, PRHODJ, &
PRHODREF, PEXNREF, &
PPABST, PTHT, PRVT, PRCT, &
PRRT, PTHM, PRCM, PPABSM, &
@@ -161,7 +159,6 @@ END MODULE MODI_RAIN_C2R2_KHKO
!! 'CART' for cartesian box configuration
!! 'MASK' for budget zone defined by a mask
!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
!! LBU_RTH : logical for budget of RTH (potential temperature)
!! .TRUE. = budget of RTH
!! .FALSE. = no budget of RTH
@@ -215,16 +212,20 @@ END MODULE MODI_RAIN_C2R2_KHKO
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_SV1, &
+ tbudgets
USE MODD_CH_AEROSOL
USE MODD_CONF
USE MODD_CST
USE MODD_DUST
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, ONLY : NSV_C2R2BEG
USE MODD_PARAM_C2R2
@@ -233,14 +234,13 @@ USE MODD_RAIN_C2R2_DESCR
USE MODD_RAIN_C2R2_KHKO_PARAM
USE MODD_SALT
-USE MODE_FIELD
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_GAMMA
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -262,8 +262,6 @@ INTEGER, INTENT(IN) :: KSPLITR ! Number of small time step
REAL, INTENT(IN) :: PTSTEP ! Time step :XTSTEP in namelist
INTEGER, INTENT(IN) :: KMI ! Model index
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the tput FM fileoutp
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
@@ -365,7 +363,7 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: ZMVRR,ZVRR,ZVCR
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: ZPRCT, ZPCCT, ZPRRT, ZPCRT
- ! For splitted sedimentation
+ ! For split sedimentation
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) &
:: ZMVRC !Cloud water mean volumic radius
REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
@@ -502,6 +500,8 @@ IF (ORAIN) THEN
! 5. SPONTANEOUS BREAK-UP (NUMERICAL FILTER)
! --------------------
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
+
ZWLBDR(:,:,:) = 1.E10
WHERE (PRRS(:,:,:)>0.0.AND.PCRS(:,:,:)>0.0 )
ZWLBDR3(:,:,:) = XLBR * PCRS(:,:,:) / (PRHODREF(:,:,:) * PRRS(:,:,:))
@@ -511,13 +511,9 @@ IF (ORAIN) THEN
PCRS(:,:,:) = PCRS(:,:,:)*MAX((1.+XSPONCOEF2*(XACCR1/ZWLBDR(:,:,:)-XSPONBUD1)**2),&
(XACCR1/ZWLBDR(:,:,:)/XSPONBUD3)**3)
END WHERE
-!
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'BRKU', pcrs(:, :, :) * prhodj(:, :, :) )
ENDIF
-!
-IF (LBUDGET_SV) &
- CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),15+(NSV_C2R2BEG-1),&
- &'BRKU_BU_RSV') ! RCR
-
!-------------------------------------------------------------------------------
!* 6. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
@@ -575,6 +571,15 @@ INTEGER :: JL ! and PACK intrinsics
INTEGER :: J1
!
!-------------------------------------------------------------------------------
+
+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(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
+
! Modification of XCHEN according to theta vertical gradient (J. Rangonio)
!ZZA(:,:,2) = 1.
!DO JK=IKB,IKE-1
@@ -589,7 +594,7 @@ INTEGER :: J1
!ZCHEN(:,:,IKE) = ZCHEN(:,:,IKE-1)
!!
!!
-! IF ( OCLOSE_OUT ) THEN
+! IF ( tpfile%lopened ) THEN
! TZFIELD%CMNHNAME = 'ZCHEN'
! TZFIELD%CSTDNAME = ''
! TZFIELD%CLONGNAME = 'ZCHEN'
@@ -872,11 +877,11 @@ INUCT = COUNTJV( GNUCT(:,:,:),I1(:),I2(:),I3(:))
!-------------------------------------------------------------------------------
! END IF
!
-IF ( OCLOSE_OUT ) THEN
+IF ( tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'SMAX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'SMAX'
- TZFIELD%CUNITS = ''
+ TZFIELD%CUNITS = '1'
TZFIELD%CDIR = 'XY'
TZFIELD%CCOMMENT = 'X_Y_Z_SMAX'
TZFIELD%NGRID = 1
@@ -888,14 +893,14 @@ END IF
!
!* 3.4 budget storage
!
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HENU_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HENU_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HENU_BU_RRC')
-IF (LBUDGET_SV) THEN
- CALL BUDGET (PCNS(:,:,:)*PRHODJ(:,:,:),13+(NSV_C2R2BEG-1),'HENU_BU_RSV') ! RCN
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),'HENU_BU_RSV') ! RCC
-END IF
-!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
+
END SUBROUTINE C2R2_KHKO_NUCLEATION
!
!-------------------------------------------------------------------------------
@@ -920,6 +925,14 @@ INTEGER :: J1
INTEGER :: JSV
!
!-------------------------------------------------------------------------------
+
+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(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
!
! compute the saturation vapor mixing ratio
! the radiative tendency
@@ -1088,13 +1101,13 @@ END IF
!* budget storage
!
!
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HENU_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HENU_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HENU_BU_RRC')
-IF (LBUDGET_SV) THEN
- CALL BUDGET (PCNS(:,:,:)*PRHODJ(:,:,:),13+(NSV_C2R2BEG-1),'HENU_BU_RSV') ! RCN
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),'HENU_BU_RSV') ! RCC
-END IF
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HENU', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg ), 'HENU', pcns(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'HENU', pccs(:, :, :) * prhodj(:, :, :) )
+end if
END SUBROUTINE AER_NUCLEATION
!
@@ -1163,6 +1176,8 @@ IF( IMICRO >= 1 ) THEN
!
!* 4.1 Self-collection of cloud droplets
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
GSELF(:) = ZCCT(:)>XCTMIN(2)
ISELF = COUNT(GSELF(:))
IF( ISELF>0 ) THEN
@@ -1171,15 +1186,17 @@ IF( IMICRO >= 1 ) THEN
ZCCS(:) = ZCCS(:) - MIN( ZCCS(:),ZZW1(:) )
END WHERE
END IF
-!
- ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:))&
- &*PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),'SELF_BU_RSV') ! RCC
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
!
!* 4.2 Autoconversion of cloud droplets
! using a Berry-Reinhardt parameterization
!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
+
ZZW2(:) = 0.0
ZZW1(:) = 0.0
WHERE( ZRCT(:)>XRTMIN(2) )
@@ -1199,25 +1216,23 @@ IF( IMICRO >= 1 ) THEN
ZZW3(:) = ZZW3(:) * ZRHODREF(:)**2 * MAX( 0.0,ZZW1(:) )**3 / XAC
ZCRS(:) = ZCRS(:) + ZZW3(:)
END WHERE
-!
- ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),7 ,'AUTO_BU_RRC')
-
- ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),8 ,'AUTO_BU_RRR')
- ZW(:,:,:) = PCRS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- &*PRHODJ(:,:,:),15+(NSV_C2R2BEG-1),'AUTO_BU_RSV') ! RCR
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
!
!
!* 4.3 Accretion sources
!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
!
!* 4.31 test the criterium Df>Dh or Nr>Nrm
!
@@ -1259,23 +1274,19 @@ IF( IMICRO >= 1 ) THEN
ZRRS(:) = ZRRS(:) + ZZW2(:)
END WHERE
END IF
-!
- ZW(:,:,:) = PRCS(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),7 ,'ACCR_BU_RRC')
- ZW(:,:,:) = PRRS(:,:,:)
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),8 ,'ACCR_BU_RRR')
- ZW(:,:,:) = PCCS(:,:,:)
- IF (LBUDGET_SV) CALL BUDGET ( &
- UNPACK(ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:)) &
- *PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),'ACCR_BU_RSV') ! RCC
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( zrcs(:), mask = gmicro(:, :, :), field = prcs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zrrs(:), mask = gmicro(:, :, :), field = prrs(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', &
+ Unpack( zccs(:), mask = gmicro(:, :, :), field = pccs(:, :, :) ) * prhodj(:, :, :) )
!
!* 4.4 Self collection - Coalescence/Break-up
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SCBU', &
+ Unpack( zcrs(:), mask = gmicro(:, :, :), field = pcrs(:, :, :) ) * prhodj(:, :, :) )
+
IF( IACCR>0 ) THEN
GSCBU(:) = ZCRT(:)>XCTMIN(3) .AND. GENABLE_ACCR_SCBU(:)
ISCBU = COUNT(GSCBU(:))
@@ -1321,10 +1332,9 @@ IF( IMICRO >= 1 ) THEN
PCCS(:,:,:) = UNPACK( ZCCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
ZW(:,:,:) = PCRS(:,:,:)
PCRS(:,:,:) = UNPACK( ZCRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
-!
- IF (LBUDGET_SV) CALL BUDGET(PCRS(:,:,:)*PRHODJ(:,:,:)&
- &,15+(NSV_C2R2BEG-1),'SCBU_BU_RSV') ! RCR
-!
+
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SCBU', pcrs(:, :, :) * prhodj(:, :, :) )
+
DEALLOCATE(ZRCT)
DEALLOCATE(ZRRT)
DEALLOCATE(ZCCT)
@@ -1350,25 +1360,6 @@ IF( IMICRO >= 1 ) THEN
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC1)
END IF
-ELSE
-!
-!* 4.5 Budgets are forwarded
-!
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),&
- &'SELF_BU_RSV') ! RCC
-!
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'AUTO_BU_RRR')
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),15+(NSV_C2R2BEG-1),&
- &'AUTO_BU_RSV') ! RCR
-!
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'ACCR_BU_RRR')
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),&
- &'ACCR_BU_RSV') ! RCC
-!
- IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),15+(NSV_C2R2BEG-1),&
- &'SCBU_BU_RSV') ! RCR
END IF
!
END SUBROUTINE C2R2_COALESCENCE
@@ -1421,6 +1412,12 @@ IF( IMICRO >= 1 ) THEN
!
!* 4.1.1 autoconversion
!
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
+
WHERE ( ZRCT(:) .GT. XRTMIN(2) .AND. ZCCT(:) .GT. XCTMIN(2) &
.AND. (ZRCS(:) .GT. 0.0) .AND. (ZCCS(:) .GT. 0.0))
!
@@ -1447,14 +1444,18 @@ IF( IMICRO >= 1 ) THEN
!
!* 4.1.2 budget storage
!
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),&
- &'SELF_BU_RSV') ! RCC
- IF (LBUDGET_RC) CALL BUDGET (PRCS*PRHODJ(:,:,:),7 ,'AUTO_BU_RRC')
- IF (LBUDGET_SV) CALL BUDGET (PCRS*PRHODJ(:,:,:),15+(NSV_C2R2BEG-1),'AUTO_BU_RSV')
- IF (LBUDGET_RR) CALL BUDGET (PRRS*PRHODJ(:,:,:),8 ,'AUTO_BU_RRR')
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SELF', pccs(:, :, :) * prhodj(:, :, :) )
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'AUTO', pcrs(:, :, :) * prhodj(:, :, :) )
!
!* 4.2.1 Accretion sources
!
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'ACCR', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', pccs(:, :, :) * prhodj(:, :, :) )
+
WHERE ( (ZRCT(:) .GT. XRTMIN(2)) .AND. (ZRRT(:) .GT. XRTMIN(3)) &
.AND. (ZRCS(:) .GT. 0.0) .AND. (ZCCS(:) .GT. 0.0))
@@ -1487,25 +1488,9 @@ IF( IMICRO >= 1 ) THEN
!
!* 4.2.2 budget storage
!
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),&
- &'ACCR_BU_RSV') ! RCC
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'ACCR_BU_RRR')
-!
-ELSE
-!
-!* 4.3 Budgets are forwarded
-!
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),&
- &'SELF_BU_RSV') ! RCC
- IF (LBUDGET_RC) CALL BUDGET (PRCS*PRHODJ(:,:,:),7 ,'AUTO_BU_RRC')
- IF (LBUDGET_SV) CALL BUDGET (PCRS*PRHODJ(:,:,:),15+(NSV_C2R2BEG-1),'AUTO_BU_RSV')
- IF (LBUDGET_RR) CALL BUDGET (PRRS*PRHODJ(:,:,:),8 ,'AUTO_BU_RRR')
- IF (LBUDGET_SV) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),&
- &'ACCR_BU_RSV') ! RCC
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'ACCR_BU_RRR')
-
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACCR', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'ACCR', pccs(:, :, :) * prhodj(:, :, :) )
END IF
!
END SUBROUTINE KHKO_COALESCENCE
@@ -1525,7 +1510,11 @@ INTEGER , DIMENSION(SIZE(GNUCT)) :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
!
!-------------------------------------------------------------------------------
-!
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
!
! optimization by looking for locations where
! the raindrop mixing ratio is non-zero
@@ -1714,12 +1703,12 @@ ELSE ! KHKO
PRRS(:,:,:) = 0.0
END WHERE
ENDIF
-!
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6 ,'REVA_BU_RRV')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'REVA_BU_RRR')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4 ,'REVA_BU_RTH')
-IF (LBUDGET_SV) CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),15+(NSV_C2R2BEG-1),'CEVA_BU_RSV')
-!
+
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'REVA', pcrs(:, :, :) * prhodj(:, :, :) )
+
END SUBROUTINE C2R2_KHKO_EVAPORATION
!
!-------------------------------------------------------------------------------
@@ -1738,6 +1727,13 @@ INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
!
!-------------------------------------------------------------------------------
+
+if ( lbudget_rc .and. osedc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
!
!* 2.1 compute the fluxes
!
@@ -1899,7 +1895,7 @@ DO JN = 1 , KSPLITR
PCRS(:,:,:) = ( PCRS(:,:,:) + ZPCRT(:,:,:) ) / PTSTEP
END IF
!
- IF (OSEDC .AND. OCLOSE_OUT) THEN
+ IF ( OSEDC .AND. tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'SEDFLUXC'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'SEDFLUXC'
@@ -1928,19 +1924,19 @@ END DO
!
!* 2.5 budget storage
!
-IF (LBUDGET_RC.AND.OSEDC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR')
-IF (LBUDGET_SV) THEN
- IF (OSEDC) CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),&
- &'SEDI_BU_RSV') ! RCC
- CALL BUDGET (PCRS(:,:,:)*PRHODJ(:,:,:),15+(NSV_C2R2BEG-1),&
- &'SEDI_BU_RSV') ! RCR
-END IF
+if ( lbudget_rc .and. osedc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ if ( osedc ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'SEDI', pccs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 2), 'SEDI', pcrs(:, :, :) * prhodj(:, :, :) )
+end if
!
!* 2.6 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
!
IF (LDEPOC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
+
GDEP(:,:) = .FALSE.
GDEP(IIB:IIE,IJB:IJE) = PRCS(IIB:IIE,IJB:IJE,2) >0 .AND. &
PCCS(IIB:IIE,IJB:IJE,2) >0
@@ -1950,15 +1946,11 @@ IF (LDEPOC) THEN
PINPRC(:,:) = PINPRC(:,:) + XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
PINDEP(:,:) = XVDEPOC * PRCT(:,:,2) * PRHODREF(:,:,2) /XRHOLW
END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_c2r2beg + 1), 'DEPO', pccs(:, :, :) * prhodj(:, :, :) )
END IF
-!
-!* 2.7 budget storage
-!
-IF ( LBUDGET_RC .AND. LDEPOC ) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
-IF ( LBUDGET_SV .AND. LDEPOC ) &
- CALL BUDGET (PCCS(:,:,:)*PRHODJ(:,:,:),14+(NSV_C2R2BEG-1),'DEPO_BU_RSV')
-!
+
END SUBROUTINE C2R2_KHKO_SEDIMENTATION
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/rain_ice.f90 b/src/MNH/rain_ice.f90
index af9bd4f0d4169dfd5fc7373d6999887a9979870e..457174c73ba646e4acc1b9c6beaeab930a171ebc 100644
--- a/src/MNH/rain_ice.f90
+++ b/src/MNH/rain_ice.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -135,34 +135,6 @@ END MODULE MODI_RAIN_ICE
!! function over liquid water
!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor pressure
!! function over solid ice
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RTH : logical for budget of RTH (potential temperature)
-!! .TRUE. = budget of RTH
-!! .FALSE. = no budget of RTH
-!! LBU_RRV : logical for budget of RRV (water vapor)
-!! .TRUE. = budget of RRV
-!! .FALSE. = no budget of RRV
-!! LBU_RRC : logical for budget of RRC (cloud water)
-!! .TRUE. = budget of RRC
-!! .FALSE. = no budget of RRC
-!! LBU_RRI : logical for budget of RRI (cloud ice)
-!! .TRUE. = budget of RRI
-!! .FALSE. = no budget of RRI
-!! LBU_RRR : logical for budget of RRR (rain water)
-!! .TRUE. = budget of RRR
-!! .FALSE. = no budget of RRR
-!! LBU_RRS : logical for budget of RRS (aggregates)
-!! .TRUE. = budget of RRS
-!! .FALSE. = no budget of RRS
-!! LBU_RRG : logical for budget of RRG (graupeln)
-!! .TRUE. = budget of RRG
-!! .FALSE. = no budget of RRG
!!
!! REFERENCE
!! ---------
@@ -244,12 +216,13 @@ END MODULE MODI_RAIN_ICE
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
! J. Escobar 09/07/2019: for reproductiblity MPPDB_CHECK, add missing LCHECK test in ZRHODJ de/allocate
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets (no more budget calls in this subroutine)
+!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBU_ENABLE, LBUDGET_RC, LBUDGET_RG, LBUDGET_RH, LBUDGET_RI, &
- LBUDGET_RR, LBUDGET_RS, LBUDGET_RV, LBUDGET_TH
+use modd_budget, only: lbu_enable
use MODD_CONF, only: LCHECK
use MODD_CST, only: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XTT, &
XALPI, XBETAI, XGAMI, XMD, XMV, XTT
@@ -280,7 +253,6 @@ use mode_tools_ll, only: GET_INDICE_ll
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
-use MODI_BUDGET
USE MODI_ICE4_RAINFR_VERT
IMPLICIT NONE
@@ -424,7 +396,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
! note that ZRC/CF = ZHLC_HRCLOCAL+ ZHLC_LRCLOCAL
! = ZHLC_HRC/HCF+ ZHLC_LRC/LCF
REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZW ! work array
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRR, ZRS, ZRG ! work arrays
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZT ! Temperature
!
! IN variables
@@ -489,10 +461,12 @@ END IF
ALLOCATE( I1(SIZE(PEXNREF)), I2(SIZE(PEXNREF)), I3(SIZE(PEXNREF)) )
ALLOCATE( GMICRO(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
-ALLOCATE( ZW (SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
+ALLOCATE( ZRR (SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
+ALLOCATE( ZRS (SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
+ALLOCATE( ZRG (SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
ALLOCATE( ZT (SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) )
-!$acc data create( I1, I2, I3, GMICRO, ZW, ZT )
+!$acc data create( I1, I2, I3, GMICRO, ZRR, ZRS, ZRG, ZT )
!-------------------------------------------------------------------------------
!
@@ -909,7 +883,9 @@ IF( IMICRO >= 0 ) THEN
PRAINFR(I1(JL),I2(JL),I3(JL)) = ZRF(JL)
END DO
!$acc end kernels
- CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRT(:,:,:))
+ CALL ICE4_RAINFR_VERT( IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRT(:,:,:), &
+ RESHAPE( SOURCE = [ ( 0., JL = 1, SIZE( PRSS ) ) ], SHAPE = SHAPE( PRSS ) ), &
+ RESHAPE( SOURCE = [ ( 0., JL = 1, SIZE( PRGS ) ) ], SHAPE = SHAPE( PRGS ) ) )
!$acc kernels
!$acc loop independent
DO JL=1,IMICRO
@@ -919,8 +895,7 @@ IF( IMICRO >= 0 ) THEN
!
CALL RAIN_ICE_SLOW(GMICRO, ZINVTSTEP, ZRHODREF, &
ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHODJ, ZZT, ZPRES, &
- ZLSFACT, ZLVFACT, &
- ZSSI, PRHODJ, PTHS, PRVS, &
+ ZLSFACT, ZLVFACT, ZSSI, &
ZRVS, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZTHS, &
ZAI, ZCJ, ZKA, ZDV, ZLBDAS, ZLBDAG)
!
@@ -966,7 +941,7 @@ IF( IMICRO >= 0 ) THEN
CALL RAIN_ICE_WARM(GMICRO, IMICRO, I1, I2, I3, &
ZRHODREF, ZRVT, ZRCT, ZRRT, ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
ZRHODJ, ZPRES, ZZT, ZLBDAR, ZLBDAR_RF, ZLVFACT, ZCJ, ZKA, ZDV, ZRF, ZCF, ZTHT, ZTHLT, &
- PRHODJ, PTHS, PRVS, ZRVS, ZRCS, ZRRS, ZTHS, ZUSW, PEVAP3D)
+ ZRVS, ZRCS, ZRRS, ZTHS, ZUSW, PEVAP3D)
END IF
!
!-------------------------------------------------------------------------------
@@ -976,7 +951,7 @@ IF( IMICRO >= 0 ) THEN
! ----------------------------------------------
!
CALL RAIN_ICE_FAST_RS(PTSTEP, GMICRO, ZRHODREF, ZRVT, ZRCT, ZRRT, ZRST, ZRHODJ, ZPRES, ZZT, &
- ZLBDAR, ZLBDAS, ZLSFACT, ZLVFACT, ZCJ, ZKA, ZDV, PRHODJ, PTHS, &
+ ZLBDAR, ZLBDAS, ZLSFACT, ZLVFACT, ZCJ, ZKA, ZDV, &
ZRCS, ZRRS, ZRSS, ZRGS, ZTHS)
!
!-------------------------------------------------------------------------------
@@ -987,7 +962,8 @@ IF( IMICRO >= 0 ) THEN
!
CALL RAIN_ICE_FAST_RG(KRR, GMICRO, ZRHODREF, ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZCIT, &
ZRHODJ, ZPRES, ZZT, ZLBDAR, ZLBDAS, ZLBDAG, ZLSFACT, ZLVFACT, &
- ZCJ, ZKA, ZDV, PRHODJ, PTHS, ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, &
+ ZCJ, ZKA, ZDV, &
+ ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, &
ZUSW, ZRDRYG, ZRWETG)
!
!-------------------------------------------------------------------------------
@@ -1001,7 +977,7 @@ IF( IMICRO >= 0 ) THEN
ZLBDAH(:) = 0.
!$acc end kernels
CALL RAIN_ICE_FAST_RH(GMICRO, ZRHODREF, ZRVT, ZRCT, ZRIT, ZRST, ZRGT, ZRHT, ZRHODJ, ZPRES, &
- ZZT, ZLBDAS, ZLBDAG, ZLBDAH, ZLSFACT, ZLVFACT, ZCJ, ZKA, ZDV, PRHODJ, PTHS, &
+ ZZT, ZLBDAS, ZLBDAG, ZLBDAH, ZLSFACT, ZLVFACT, ZCJ, ZKA, ZDV, &
ZRCS, ZRRS, ZRIS, ZRSS, ZRGS, ZRHS, ZTHS, ZUSW)
END IF
!
@@ -1012,7 +988,7 @@ IF( IMICRO >= 0 ) THEN
! -------------------------------------------------------------
!
CALL RAIN_ICE_FAST_RI(GMICRO, ZRHODREF, ZRIT, ZRHODJ, ZZT, ZSSI, ZLSFACT, ZLVFACT, &
- ZAI, ZCJ, PRHODJ, PTHS, ZCIT, ZRCS, ZRIS, ZTHS)
+ ZAI, ZCJ, ZCIT, ZRCS, ZRIS, ZTHS)
!
!
!-------------------------------------------------------------------------------
@@ -1098,96 +1074,6 @@ IF( IMICRO >= 0 ) THEN
DEALLOCATE(ZRCRAUTC)
DEALLOCATE(ZHLC_HRCLOCAL)
DEALLOCATE(ZHLC_LRCLOCAL)
-!
- ELSE
-!
-! Advance the budget calls
-!
-! Reordered for compability with flexible structures like in AROME
-
- ! rain_ice_slow
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HON_BU_RRI')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SFR_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'DEPS_BU_RRS')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'AGGS_BU_RRS')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'AUTS_BU_RRS')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DEPG_BU_RRG')
-
- IF (OWARM) THEN ! rain_ice_warm
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'AUTO_BU_RRR')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACCR_BU_RRR')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'REVA_BU_RRR')
- ENDIF
-
- !rain_ice_fast_rs
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'RIM_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'ACC_BU_RRG')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CMEL_BU_RRG')
-
- !rain_ice_fast_rg
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CFRZ_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETG_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETG_BU_RRH')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DRYG_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'GMLT_BU_RRG')
-
- IF(KRR==7) THEN ! rain_ice_fast_rh
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETH_BU_RRH')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'HMLT_BU_RRH')
- ENDIF
-
- !rain_ice_fast_ri
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'IMLT_BU_RRI')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'BERFI_BU_RRI')
-!
END IF
!
!-------------------------------------------------------------------------------
@@ -1213,11 +1099,14 @@ ELSEIF (HSEDIM == 'SPLI') THEN
ELSE
call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
+
!sedimentation of rain fraction
!$acc kernels
-ZW(:,:,:)=PRRS(:,:,:)*PTSTEP
+ZRR(:,:,:) = PRRS(:,:,:) * PTSTEP
+ZRS(:,:,:) = PRSS(:,:,:) * PTSTEP
+ZRG(:,:,:) = PRGS(:,:,:) * PTSTEP
!$acc end kernels
-CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, ZW)
+CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, ZRR, ZRS, ZRG)
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/rain_ice_elec.f90 b/src/MNH/rain_ice_elec.f90
index 37e0c3d04d21f1f9b59f0f52c58eb84633ad6d6f..69721492d16057037ea4d126ce6ce6801f23f372 100644
--- a/src/MNH/rain_ice_elec.f90
+++ b/src/MNH/rain_ice_elec.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.
@@ -157,37 +157,6 @@ END MODULE MODI_RAIN_ICE_ELEC
!! function over liquid water
!! XALPI,XBETAI,XGAMI ! Constants for saturation vapor pressure
!! function over solid ice
-!! Module MODD_BUDGET:
-!! NBUMOD : model in which budget is calculated
-!! CBUTYPE : type of desired budget
-!! 'CART' for cartesian box configuration
-!! 'MASK' for budget zone defined by a mask
-!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
-!! LBU_RTH : logical for budget of RTH (potential temperature)
-!! .TRUE. = budget of RTH
-!! .FALSE. = no budget of RTH
-!! LBU_RRV : logical for budget of RRV (water vapor)
-!! .TRUE. = budget of RRV
-!! .FALSE. = no budget of RRV
-!! LBU_RRC : logical for budget of RRC (cloud water)
-!! .TRUE. = budget of RRC
-!! .FALSE. = no budget of RRC
-!! LBU_RRI : logical for budget of RRI (cloud ice)
-!! .TRUE. = budget of RRI
-!! .FALSE. = no budget of RRI
-!! LBU_RRR : logical for budget of RRR (rain water)
-!! .TRUE. = budget of RRR
-!! .FALSE. = no budget of RRR
-!! LBU_RRS : logical for budget of RRS (aggregates)
-!! .TRUE. = budget of RRS
-!! .FALSE. = no budget of RRS
-!! LBU_RRG : logical for budget of RRG (graupeln)
-!! .TRUE. = budget of RRG
-!! .FALSE. = no budget of RRG
-!! LBU_RSV : logical for budget of RSV (scalar variables for charge)
-!! .TRUE. = budget of RSV
-!! .FALSE. = no budget of RSV
!!
!! REFERENCE
!! ---------
@@ -224,16 +193,22 @@ END MODULE MODI_RAIN_ICE_ELEC
!! J-P Pinty 25/04/14 Many bugs with ZWQ1(:,...) = 0.0
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! J.Escobar : 10/2017 : for real*4 , limit exp() in RAIN_ICE_ELEC_SLOW with XMNH_HUGE_12_LOG
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
-!
+! P. Wautelet 03/2020: use the new data structures and subroutines for budgets
+! P .Wautelet 09/03/2020: add missing budgets for electricity
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbu_enable, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
+ lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_ELEC_DESCR
@@ -248,12 +223,12 @@ USE MODD_RAIN_ICE_DESCR
USE MODD_RAIN_ICE_PARAM
USE MODD_REF, ONLY: XTHVREFZ
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
#ifdef MNH_PGI
USE MODE_PACK_PGI
#endif
use mode_tools, only: Countjv
-USE MODI_BUDGET
USE MODI_MOMG
IMPLICIT NONE
@@ -705,7 +680,9 @@ IF (IMICRO > 0) THEN
!
IF (LBU_ENABLE .OR. LLES_CALL) THEN
ALLOCATE(ZRHODJ(IMICRO))
- ZRHODJ(:) = PACK( PRHODJ(:,:,:),MASK=GMICRO(:,:,:) )
+ DO JL=1,IMICRO
+ ZRHODJ(JL) = PRHODJ(I1(JL),I2(JL),I3(JL))
+ END DO
END IF
!
ALLOCATE( ZECT(IMICRO) )
@@ -940,47 +917,38 @@ IF (IMICRO > 0) THEN
!
!* 8.1 Update the mixing ratio
!
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRCS(:,:,:)
- PRCS(:,:,:) = UNPACK( ZRCS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRRS(:,:,:)
- PRRS(:,:,:) = UNPACK( ZRRS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRIS(:,:,:)
- PRIS(:,:,:) = UNPACK( ZRIS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRSS(:,:,:)
- PRSS(:,:,:) = UNPACK( ZRSS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PRGS(:,:,:)
- PRGS(:,:,:) = UNPACK( ZRGS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ DO JL=1,IMICRO
+ PRVS(I1(JL),I2(JL),I3(JL)) = ZRVS(JL)
+ PRCS(I1(JL),I2(JL),I3(JL)) = ZRCS(JL)
+ PRRS(I1(JL),I2(JL),I3(JL)) = ZRRS(JL)
+ PRIS(I1(JL),I2(JL),I3(JL)) = ZRIS(JL)
+ PRSS(I1(JL),I2(JL),I3(JL)) = ZRSS(JL)
+ PRGS(I1(JL),I2(JL),I3(JL)) = ZRGS(JL)
+ PTHS(I1(JL),I2(JL),I3(JL)) = ZTHS(JL)
+ PCIT(I1(JL),I2(JL),I3(JL)) = ZCIT(JL)
+ END DO
IF ( KRR == 7 ) THEN
- ZW(:,:,:) = PRHS(:,:,:)
- PRHS(:,:,:) = UNPACK( ZRHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ DO JL=1,IMICRO
+ PRHS(I1(JL),I2(JL),I3(JL)) = ZRHS(JL)
+ END DO
END IF
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PCIT(:,:,:)
- PCIT(:,:,:) = UNPACK( ZCIT(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
!
!
!* 8.2 Compute the volumetric charge concentration
!
- ZW(:,:,:) = PQPIS(:,:,:)
- PQPIS(:,:,:) = UNPACK( ZQPIS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQNIS(:,:,:)
- PQNIS(:,:,:) = UNPACK( ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQCS(:,:,:)
- PQCS(:,:,:) = UNPACK( ZQCS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQRS(:,:,:)
- PQRS(:,:,:) = UNPACK( ZQRS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQIS(:,:,:)
- PQIS(:,:,:) = UNPACK( ZQIS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQSS(:,:,:)
- PQSS(:,:,:) = UNPACK( ZQSS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PQGS(:,:,:)
- PQGS(:,:,:) = UNPACK( ZQGS(:), MASK=GMICRO(:,:,:), FIELD=ZW(:,:,:) )
+ DO JL=1,IMICRO
+ PQPIS(I1(JL),I2(JL),I3(JL)) = ZQPIS(JL)
+ PQNIS(I1(JL),I2(JL),I3(JL)) = ZQNIS(JL)
+ PQCS (I1(JL),I2(JL),I3(JL)) = ZQCS(JL)
+ PQRS (I1(JL),I2(JL),I3(JL)) = ZQRS(JL)
+ PQIS (I1(JL),I2(JL),I3(JL)) = ZQIS(JL)
+ PQSS (I1(JL),I2(JL),I3(JL)) = ZQSS(JL)
+ PQGS (I1(JL),I2(JL),I3(JL)) = ZQGS(JL)
+ END DO
IF ( KRR == 7 ) THEN
- ZW(:,:,:) = PQHS(:,:,:)
- PQHS(:,:,:) = UNPACK( ZQHS(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:) )
+ DO JL=1,IMICRO
+ PQHS(I1(JL),I2(JL),I3(JL)) = ZQHS(JL)
+ END DO
END IF
!
!
@@ -1100,153 +1068,6 @@ IF (IMICRO > 0) THEN
IF (ALLOCATED( ZEFIELDV )) DEALLOCATE( ZEFIELDV )
DEALLOCATE( ZLATHAMIAGGS )
!
-ELSE
-!
-! Advance the budget calls
-!
-! Reordered for compability with flexible structures like in AROME
-
-! rain_ice_slow
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HON_BU_RRI')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SFR_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'DEPS_BU_RRS')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'AGGS_BU_RRS')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'AUTS_BU_RRS')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DEPG_BU_RRG')
-!
- IF (OWARM) THEN ! rain_ice_warm
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'AUTO_BU_RRR')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACCR_BU_RRR')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'REVA_BU_RRR')
- ENDIF
-!
-! rain_ice_fast_rs
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'RIM_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'ACC_BU_RRG')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CMEL_BU_RRG')
-
-! rain_ice_fast_rg
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'CFRZ_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETG_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETG_BU_RRH')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'DRYG_BU_RRG')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'GMLT_BU_RRG')
-
- IF(KRR==7) THEN ! rain_ice_fast_rh
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'WETH_BU_RRH')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'HMLT_BU_RRH')
- ENDIF
-
-! rain_ice_fast_ri
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'IMLT_BU_RRI')
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'BERFI_BU_RRI')
-!
- IF (LBUDGET_SV) THEN
-! rain_ice_slow
- CALL BUDGET (PQPIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG, 'DEPS_BU_RSV')
- CALL BUDGET (PQNIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECEND, 'DEPS_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+4,'DEPS_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+3,'AGGS_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+4,'AGGS_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+3,'AUTS_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+4,'AUTS_BU_RSV')
- CALL BUDGET (PQPIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG, 'DEPG_BU_RSV')
- CALL BUDGET (PQNIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECEND, 'DEPG_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+5,'DEPG_BU_RSV')
-!
-! rain_ice_warm
- IF (OWARM) THEN
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+1,'AUTO_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+2,'AUTO_BU_RSV')
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+1,'ACCR_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+2,'ACCR_BU_RSV')
- CALL BUDGET (PQPIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG, 'REVA_BU_RSV')
- CALL BUDGET (PQNIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECEND, 'REVA_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+2,'REVA_BU_RSV')
- END IF
-!
-! rain_ice_fast_rs
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+1,'RIM_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+4,'RIM_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECEND, 'RIM_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+2,'ACC_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+4,'ACC_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECEND, 'ACC_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+4,'CMEL_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECEND, 'CMEL_BU_RSV')
-!
-! rain_ice_fast_rg
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+2,'CFRZ_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+3,'CFRZ_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECEND, 'CFRZ_BU_RSV')
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+1,'WETG_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+2,'WETG_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+3,'WETG_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+4,'WETG_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECEND, 'WETG_BU_RSV')
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+1,'DRYG_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+2,'DRYG_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+3,'DRYG_BU_RSV')
- CALL BUDGET (PQSS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+4,'DRYG_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECEND, 'DRYG_BU_RSV')
- CALL BUDGET (PQRS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+2,'GMLT_BU_RSV')
- CALL BUDGET (PQGS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECEND, 'GMLT_BU_RSV')
-!
-! rain_ice_fast_ri
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+1,'IMLT_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+3,'IMLT_BU_RSV')
- CALL BUDGET (PQCS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+1,'BERFI_BU_RSV')
- CALL BUDGET (PQIS(:,:,:) * PRHODJ(:,:,:),12+NSV_ELECBEG+3,'BERFI_BU_RSV')
-!
- END IF
END IF
!
!-------------------------------------------------------------------------------
@@ -1318,6 +1139,24 @@ REAL :: ZVR, ZVI, ZVS, ZVG, ZETA0, ZK, ZRE0
!
! O. Initialization for sedimentation
!
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
+
IF (OSEDIC) PINPRC (:,:) = 0.
PINPRR (:,:) = 0.
PINPRR3D (:,:,:) = 0.
@@ -1973,22 +1812,23 @@ REAL :: ZVR, ZVI, ZVS, ZVG, ZETA0, ZK, ZRE0
!
!* 2.3 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'SEDI_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SEDI_BU_RRG')
- IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'SEDI_BU_RRH')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (PQCS(:,:,:)*PRHODJ(:,:,:),12+NSV_ELECBEG+1,'SEDI_BU_RSV')
- CALL BUDGET (PQRS(:,:,:)*PRHODJ(:,:,:),12+NSV_ELECBEG+2,'SEDI_BU_RSV')
- CALL BUDGET (PQIS(:,:,:)*PRHODJ(:,:,:),12+NSV_ELECBEG+3,'SEDI_BU_RSV')
- CALL BUDGET (PQSS(:,:,:)*PRHODJ(:,:,:),12+NSV_ELECBEG+4,'SEDI_BU_RSV')
- CALL BUDGET (PQGS(:,:,:)*PRHODJ(:,:,:),12+NSV_ELECBEG+5,'SEDI_BU_RSV')
- END IF
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
!
END SUBROUTINE RAIN_ICE_ELEC_SEDIMENTATION_SPLIT
!
@@ -2011,6 +1851,23 @@ INTEGER :: JI,JJ,JK
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D ! droplet condensation
!
!-------------------------------------------------------------------------------
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
!
!* 1. Parameters for cloud sedimentation
!
@@ -2368,15 +2225,23 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),SIZE(PRHODREF,3)) :: ZCONC3D !
!
!* 2.3 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'SEDI_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SEDI_BU_RRG')
- IF (KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'SEDI_BU_RRH')
-
+ if ( lbudget_rc .and. osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ if ( osedic ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'SEDI', pqcs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SEDI', pqrs(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'SEDI', pqis(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'SEDI', pqss(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SEDI', pqgs(:, :, :) * prhodj(:, :, :) )
+ if ( krr == 7 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'SEDI', pqhs(:, :, :) * prhodj(:, :, :) )
+ end if
!
END SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT
!
@@ -2397,7 +2262,6 @@ INTEGER :: JL ! and PACK intrinsics
!
!-------------------------------------------------------------------------------
!
-!
! compute the temperature and the pressure
!
ZT(:,:,:) = PTHT(:,:,:) * (PPABST(:,:,:) / XP00) ** (XRD / XCPD)
@@ -2410,7 +2274,11 @@ GNEGT(IIB:IIE,IJB:IJE,IKB:IKE) = ZT(IIB:IIE,IJB:IJE,IKB:IKE) < XTT
INEGT = COUNTJV( GNEGT(:,:,:),I1(:),I2(:),I3(:))
!
IF( INEGT >= 1 ) THEN
- ALLOCATE(ZRVT(INEGT))
+ 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_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+
+ ALLOCATE(ZRVT(INEGT))
ALLOCATE(ZCIT(INEGT))
ALLOCATE(ZZT(INEGT))
ALLOCATE(ZPRES(INEGT))
@@ -2481,14 +2349,13 @@ IF( INEGT >= 1 ) THEN
DEALLOCATE(ZZT)
DEALLOCATE(ZCIT)
DEALLOCATE(ZRVT)
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
+
END IF
-!
-!* 3.1.3 budget storage
-!
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HENU_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HENU_BU_RRV')
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HENU_BU_RRI')
-!
+
END SUBROUTINE RAIN_ICE_ELEC_NUCLEATION
!
!-------------------------------------------------------------------------------
@@ -2506,6 +2373,13 @@ IMPLICIT NONE
!
!* 3.5.1 compute the homogeneous nucleation source: RCHONI & QCHONI
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZWQ1(:,1:7) = 0.0
!
@@ -2529,23 +2403,19 @@ IMPLICIT NONE
ZQIS(:) = ZQIS(:) + ZWQ1(:,1)
ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
END WHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 9,'HON_BU_RRI')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0),&
- 12+NSV_ELECBEG+1,'HON_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'HON_BU_RSV')
- END IF
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'HON', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'HON', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 3.5.2 compute the spontaneous freezing source: RRHONG & QRHONG
!
@@ -2565,24 +2435,19 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) + ZWQ1(:,2)
ZQRS(:) = ZQRS(:) - ZWQ1(:,2)
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'SFR_BU_RRG')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0),&
- 12+NSV_ELECBEG+2,'HON_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECEND, 'HON_BU_RSV')
- END IF
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'SFR', &
+ Unpack( -zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'SFR', &
+ Unpack( zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 3.5.3 compute the deposition, aggregation and autoconversion sources
!
@@ -2599,6 +2464,15 @@ IMPLICIT NONE
!
!* 3.5.3.2 compute the riming-conversion of r_c for r_i production: RCAUTI
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
!
WHERE ((ZRST(:) > XRTMIN(5)) .AND. (ZRSS(:) > 0.0))
@@ -2620,28 +2494,31 @@ IMPLICIT NONE
ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,5)/XECHARGE )
ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,5)/XECHARGE )
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
- 6,'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 10,'DEPS_BU_RRS')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQPIS(:), MASK=GMICRO(:,:,:), FIELD=PQPIS) &
- *PRHODJ(:,:,:), 12+NSV_ELECBEG ,'DEPS_BU_RSV')
- CALL BUDGET (UNPACK(ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=PQNIS) &
- *PRHODJ(:,:,:), 12+NSV_ELECEND ,'DEPS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'DEPS_BU_RSV')
- END IF
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', Unpack( zzw(:) * zlsfact(:) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPS', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPS', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DEPS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 3.5.3.4 compute the aggregation on r_s: RIAGGS & QIAGGS
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZLATHAMIAGGS(:) = 1.0
IF (LIAGGS_LATHAM) THEN
@@ -2666,37 +2543,48 @@ IMPLICIT NONE
ZQSS(:) = ZQSS(:) + ZWQ1(:,3)
ZQIS(:) = ZQIS(:) - ZWQ1(:,3)
END WHERE
-!
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 9,'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 10,'AGGS_BU_RRS')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'AGGS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'AGGS_BU_RSV')
- END IF
-!
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AGGS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AGGS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
CALL ELEC_IAGGS_B() ! QIAGGS_boun
-!
+
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'NIIS', &
+ Unpack( zqis(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'NIIS', &
+ Unpack( zqss(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
! Save the NI charging rate for temporal series
XNI_IAGGS(:,:,:) = UNPACK(ZWQ1(:,7), MASK=GMICRO, FIELD=0.0)
XNI_IAGGS(:,:,:) = XNI_IAGGS(:,:,:) * PRHODREF(:,:,:) ! C/m3/s
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'NIIS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'NIIS_BU_RSV')
- END IF
!
!* 3.5.3.5 compute the autoconversion of r_i for r_s production:
! RIAUTS & QIAUTS
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ALLOCATE( ZCRIAUTI(IMICRO ))
ZCRIAUTI(:) = MIN(XCRIAUTI,10**(0.06*(ZZT(:)-XTT)-3.5))
ZZW(:) = 0.0
@@ -2717,22 +2605,29 @@ IMPLICIT NONE
END WHERE
!
DEALLOCATE(ZCRIAUTI)
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 9,'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 10,'AUTS_BU_RRS')
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'AUTS_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'AUTS_BU_RSV')
- END IF
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'AUTS', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'AUTS', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 3.5.3.6 compute the deposition on r_g: RVDEPG & QVDEPG
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
!
WHERE ((ZRGT(:) > XRTMIN(6)) .AND. (ZRGS(:) > 0.0))
@@ -2754,26 +2649,22 @@ IMPLICIT NONE
ZQPIS(:) = ZQPIS(:) + MAX( 0.0,ZWQ1(:,6)/XECHARGE )
ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,6)/XECHARGE )
END WHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
- 6,'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'DEPG_BU_RRG')
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQPIS(:), MASK=GMICRO(:,:,:), FIELD=PQPIS) &
- *PRHODJ(:,:,:), 12+NSV_ELECBEG ,'DEPG_BU_RSV')
- CALL BUDGET (UNPACK(ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=PQNIS) &
- *PRHODJ(:,:,:), 12+NSV_ELECEND ,'DEPG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECEND,'DEPG_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', Unpack( zzw(:) * zlsfact(:) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'DEPG', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'DEPG', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DEPG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
END SUBROUTINE RAIN_ICE_ELEC_SLOW
!
!-------------------------------------------------------------------------------
@@ -2793,6 +2684,13 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
!* 4.1 compute the autoconversion of r_c for r_r production:
! RCAUTR & QCAUTR
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZWQ1(:,1:3) = 0.0
!
@@ -2837,24 +2735,27 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
ZQRS(:) = ZQRS(:) + ZWQ1(:,1)
END WHERE
-!
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'AUTO_BU_RRR')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'AUTO_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'AUTO_BU_RSV')
- END IF
-!
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'AUTO', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'AUTO', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 4.2 compute the accretion of r_c for r_r production: RCACCR & QCACCR
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
WHERE ((ZRCT(:) > XRTMIN(2)) .AND. (ZRRT(:) > XRTMIN(3)) .AND. (ZRCS(:) > 0.0))
ZZW(:) = MIN( ZRCS(:),XFCACCR * ZRCT(:) &
@@ -2871,24 +2772,30 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
ZQCS(:) = ZQCS(:) - ZWQ1(:,2)
ZQRS(:) = ZQRS(:) + ZWQ1(:,2)
ENDWHERE
-!
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'ACCR_BU_RRR')
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'ACCR_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'ACCR_BU_RSV')
- END IF
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'ACCR', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACCR', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!
!* 4.3 compute the evaporation of r_r: RREVAV & QREVAV
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
WHERE ((ZRRT(:) > XRTMIN(3)) .AND. (ZRCT(:) <= XRTMIN(2)))
ZZW(:) = EXP( XALPW - XBETAW/ZZT(:) - XGAMW*ALOG(ZZT(:) ) ) ! es_w
@@ -2914,27 +2821,23 @@ REAL :: ZCRIAUTC ! Critical cloud mixing ratio
ZQNIS(:) = ZQNIS(:) - MIN( 0.0,ZWQ1(:,3)/XECHARGE )
ENDWHERE
!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET ( &
- UNPACK(ZRVS(:),MASK=GMICRO(:,:,:),FIELD=PRVS)*PRHODJ(:,:,:), &
- 6,'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'REVA_BU_RRR')
- ZW(:,:,:)=PEVAP3D(:,:,:)
- PEVAP3D(:,:,:)=UNPACK(ZZW(:),MASK=GMICRO(:,:,:),FIELD=ZW(:,:,:))
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQPIS(:), MASK=GMICRO(:,:,:), FIELD=PQPIS) &
- *PRHODJ(:,:,:), 12+NSV_ELECBEG ,'REVA_BU_RSV')
- CALL BUDGET (UNPACK(ZQNIS(:), MASK=GMICRO(:,:,:), FIELD=PQNIS) &
- *PRHODJ(:,:,:), 12+NSV_ELECEND ,'REVA_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'REVA_BU_RSV')
- END IF
-!
+ PEVAP3D(:,:,:)=UNPACK(ZZW(:),MASK=GMICRO(:,:,:),FIELD=PEVAP3D(:,:,:))
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', &
+ Unpack( -zzw(:) * zlvfact(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg ), 'REVA', &
+ Unpack( zqpis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend ), 'REVA', &
+ Unpack( zqnis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'REVA', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
END SUBROUTINE RAIN_ICE_ELEC_WARM
!
!-------------------------------------------------------------------------------
@@ -2950,7 +2853,6 @@ IMPLICIT NONE
!
!* 5.1 cloud droplet riming of the aggregates
!
- ZZW1(:,:) = 0.0
ZZW1(:,:) = 0.0
ZWQ1(:,1:7) = 0.0
!
@@ -2960,6 +2862,14 @@ IMPLICIT NONE
IGRIM = COUNT( GRIM(:) )
!
IF (IGRIM > 0) THEN
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
! 5.1.0 allocations
!
@@ -3065,29 +2975,23 @@ IMPLICIT NONE
DEALLOCATE(IVEC1)
DEALLOCATE(ZVEC2)
DEALLOCATE(ZVEC1)
- END IF
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 10,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'RIM_BU_RRG')
-!
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'RIM_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'RIM_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECEND,'RIM_BU_RSV')
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', Unpack( ( zzw1(:,1) + zzw1(:,2) ) &
+ * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', &
+ Unpack( ( -zzw1(:,1) - zzw1(:,2) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', &
+ Unpack( ( zzw1(:,1) - zzw1(:,3) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', &
+ Unpack( ( zzw1(:,2) + zzw1(:,3) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'RIM', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'RIM', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'RIM', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
END IF
!
DEALLOCATE(GRIM)
@@ -3104,6 +3008,22 @@ IMPLICIT NONE
IGACC = COUNT( GACC(:) )
!
IF( IGACC>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACC', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
! 5.2.0 allocations
!
@@ -3243,32 +3163,36 @@ IMPLICIT NONE
DEALLOCATE( ZVECQ4 )
DEALLOCATE( ZVECQ5 )
DEALLOCATE( ZVECQ6 )
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'ACC', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'ACC', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'ACC', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
END IF
+
DEALLOCATE(GACC)
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 10,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'ACC_BU_RRG')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'ACC_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'ACC_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECEND,'ACC_BU_RSV')
- END IF
!
!* 5.3 Conversion-Melting of the aggregates: RSMLT & QSMLT
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
WHERE ((ZRST(:) > XRTMIN(5)) .AND. (ZRSS(:) > 0.0) .AND. (ZZT(:) > XTT))
ZZW(:) = ZRVT(:) * ZPRES(:) / ((XMV / XMD) + ZRVT(:)) ! Vapor pressure
@@ -3300,21 +3224,18 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) + ZWQ1(:,7)
ZQSS(:) = ZQSS(:) - ZWQ1(:,7)
ENDWHERE
-!
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 10,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'CMEL_BU_RRG')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'CMEL_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECEND,'CMEL_BU_RSV')
- END IF
-!
+
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'CMEL', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CMEL', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
END SUBROUTINE RAIN_ICE_ELEC_FAST_RS
!
!-------------------------------------------------------------------------------
@@ -3331,6 +3252,15 @@ IMPLICIT NONE
!
!* 6.1 rain contact freezing: RICFRRG & QICFRRG and RRCFRIG & QRCFRIG
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW1(:,3:4) = 0.0
ZWQ1(:,3:4) = 0.0
WHERE ((ZRIT(:) > XRTMIN(4)) .AND. (ZRRT(:) > XRTMIN(3)) .AND. &
@@ -3365,32 +3295,56 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) + ZWQ1(:,3)
ZQIS(:) = ZQIS(:) - ZWQ1(:,3)
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 9,'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'CFRZ_BU_RRG')
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'CFRZ_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'CFRZ_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECEND,'CFRZ_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', Unpack( zzw1(:,4) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', &
+ Unpack( -zzw1(:, 4) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', &
+ Unpack( -zzw1(:, 3) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', &
+ Unpack( ( zzw1(:, 3) + zzw1(:, 4) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'CFRZ', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'CFRZ', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'CFRZ', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 6.2 compute the Dry growth case
!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( krr == 7 ) &
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW1(:,:) = 0.0
ZWQ1(:,1:10) = 0.0
ZWQ3(:) = 0.0
@@ -3748,44 +3702,62 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,9) + ZWQ1(:,7) + ZWQ1(:,8)
END WHERE
END IF
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 9,'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 10,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'WETG_BU_RRG')
- IF ( KRR == 7 ) THEN
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 12,'WETG_BU_RRH')
- END IF
-!
- IF (LBU_RSV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'WETG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECEND,'WETG_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( krr == 7 ) &
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETG', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
WHERE (ZRGT(:) > XRTMIN(6) .AND. ZZT(:) < XTT .AND. & ! Dry
ZRDRYG(:) < ZRWETG(:) .AND. ZRDRYG(:) > 0.0) ! case
ZRCS(:) = ZRCS(:) - ZZW1(:,1)
@@ -3803,43 +3775,42 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) + ZWQ1(:,1) + ZWQ1(:,2) + ZWQ1(:,3) + ZWQ1(:,4) &
+ ZWQ1(:,5) + ZWQ1(:,6)
END WHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 9,'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 10,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'DRYG_BU_RRG')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQSS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+4,'DRYG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECEND,'DRYG_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'DRYG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'DRYG', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'DRYG', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'DRYG', &
+ Unpack( zqss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'DRYG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
! Inductive mecanism
!
IF (LINDUCTIVE) THEN
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'INCG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZRATE_IND(:) = 0.
GIND(:) = ZRDRYG(:) > 0. .AND. ZRDRYG(:) < ZRWETG(:) .AND. ZZT(:) < XTT
IIND = COUNT(GIND(:))
@@ -3849,18 +3820,24 @@ IMPLICIT NONE
XIND_RATE(:,:,:) = 0.
XIND_RATE(:,:,:) = UNPACK(ZRATE_IND(:), MASK=GMICRO, FIELD=0.0)
XIND_RATE(:,:,:) = XIND_RATE(:,:,:) * PRHODREF(:,:,:) ! C/m3/s
+
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1), 'INCG', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'INCG', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
END IF
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'INCG_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECEND,'INCG_BU_RSV')
- END IF
-!
!
!* 6.5 Melting of the graupeln
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'GMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZWQ1(:,7) = 0.0
WHERE ((ZRGT(:) > XRTMIN(6)) .AND. (ZRGS(:) > 0.0) .AND. (ZZT(:) > XTT))
@@ -3889,24 +3866,20 @@ IMPLICIT NONE
ZQRS(:) = ZQRS(:) + ZWQ1(:,7)
ZQGS(:) = ZQGS(:) - ZWQ1(:,7)
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'GMLT_BU_RRG')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQRS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+2,'GMLT_BU_RSV')
- CALL BUDGET (UNPACK(ZQGS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECEND,'GMLT_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', Unpack( -zzw(:) * ( zlsfact(:) - zlvfact(:) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2), 'GMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'GMLT', &
+ Unpack( zqgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
END SUBROUTINE RAIN_ICE_ELEC_FAST_RG
!
!-------------------------------------------------------------------------------
@@ -3926,6 +3899,20 @@ IMPLICIT NONE
IHAIL = COUNT(GHAIL(:))
!
IF( IHAIL>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
!
!* 7.2 compute the Wet growth of hail
!
@@ -4129,34 +4116,49 @@ IMPLICIT NONE
ZQGS(:) = ZQGS(:) - ZWQ1(:,5)
ZQRS(:) = ZQRS(:) - ZWQ1(:,4)
ZQHS(:) = ZQHS(:) + ZWQ1(:,1) + ZWQ1(:,2) + ZWQ1(:,3) + ZWQ1(:,4) + ZWQ1(:,5)
- END IF
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 9,'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET ( &
- UNPACK(ZRSS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 10,'WETH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET ( &
- UNPACK(ZRGS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 11,'WETH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 12,'WETH_BU_RRH')
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', &
+ Unpack( zrrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', &
+ Unpack( zrss(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', &
+ Unpack( zrgs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', &
+ Unpack( zrhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'WETH', &
+ Unpack( -zwq1(:, 1) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'WETH', &
+ Unpack( -zwq1(:, 4) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'WETH', &
+ Unpack( -zwq1(:, 2) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 4 ), 'WETH', &
+ Unpack( -zwq1(:, 3) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 5 ), 'WETH', &
+ Unpack( -zwq1(:, 5) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'WETH', &
+ Unpack( ( zwq1(:, 1) + zwq1(:, 2) + zwq1(:, 3) + zwq1(:, 4) + zwq1(:, 5) ) &
+ * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+ END IF
!
IF (IHAIL > 0) THEN
!
!* 7.5 Melting of the hailstones
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'HMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'HMLT', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZWQ1(:,7) = 0.
!
@@ -4186,19 +4188,22 @@ IMPLICIT NONE
ZQRS(:) = ZQRS(:) + ZWQ1(:,7)
ZQHS(:) = ZQHS(:) - ZWQ1(:,7)
END WHERE
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', &
+ Unpack( -zzw(:) * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 2 ), 'HMLT', &
+ Unpack( zqrs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 6 ), 'HMLT', &
+ Unpack( zqhs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
END IF
!
DEALLOCATE(GHAIL)
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:),&
- 4,'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET ( &
- UNPACK(ZRRS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 8,'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET ( &
- UNPACK(ZRHS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 12,'HMLT_BU_RRH')
!
END SUBROUTINE RAIN_ICE_ELEC_FAST_RH
!
@@ -4216,6 +4221,19 @@ IMPLICIT NONE
!
!* 7.1 cloud ice melting
!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'IMLT', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'IMLT', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZWQ1(:,1) = 0.0
WHERE ((ZRIS(:) > 0.0) .AND. (ZZT(:) > XTT))
@@ -4227,26 +4245,29 @@ IMPLICIT NONE
ZQCS(:) = ZQCS(:) + ZQIS(:)
ZQIS(:) = 0.
END WHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 9,'IMLT_BU_RRI')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'IMLT_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'IMLT_BU_RSV')
- END IF
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'IMLT', &
+ Unpack( zths(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'IMLT', &
+ Unpack( zrcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'IMLT', &
+ Unpack( zris(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'IMLT', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'IMLT', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
+ if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
ZZW(:) = 0.0
ZWQ1(:,1) = 0.0
WHERE ((ZRCS(:) > 0.0) .AND. (ZSSI(:) > 0.0) .AND. &
@@ -4269,24 +4290,20 @@ IMPLICIT NONE
ZQIS(:) = ZQIS(:) + ZWQ1(:,1)
ZQCS(:) = ZQCS(:) - ZWQ1(:,1)
ENDWHERE
-!
- IF (LBUDGET_TH) CALL BUDGET ( &
- UNPACK(ZTHS(:),MASK=GMICRO(:,:,:),FIELD=PTHS)*PRHODJ(:,:,:), &
- 4,'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET ( &
- UNPACK(ZRCS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 7,'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET ( &
- UNPACK(ZRIS(:)*ZRHODJ(:),MASK=GMICRO(:,:,:),FIELD=0.0), &
- 9,'BERFI_BU_RRI')
-!
- IF (LBUDGET_SV) THEN
- CALL BUDGET (UNPACK(ZQCS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+1,'BERFI_BU_RSV')
- CALL BUDGET (UNPACK(ZQIS(:)*ZRHODJ(:), MASK=GMICRO(:,:,:), FIELD=0.0), &
- 12+NSV_ELECBEG+3,'BERFI_BU_RSV')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', &
+ Unpack( zzw(:) * ( zlsfact(:) - zlvfact(:) ) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', &
+ Unpack( -zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', &
+ Unpack( zzw(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 1 ), 'BERFI', &
+ Unpack( zqcs(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg + 3 ), 'BERFI', &
+ Unpack( zqis(:) * zrhodj(:), mask = gmicro(:, :, :), field = 0. ) )
+ end if
+
END SUBROUTINE RAIN_ICE_ELEC_FAST_RI
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/rain_ice_fast_rg.f90 b/src/MNH/rain_ice_fast_rg.f90
index e99e3adc567ed946244ddcd61f853f1b143d1974..fbba910e7cac15307712dfb2b976de78938f722d 100644
--- a/src/MNH/rain_ice_fast_rg.f90
+++ b/src/MNH/rain_ice_fast_rg.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -8,6 +8,7 @@
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RG
@@ -21,33 +22,36 @@ CONTAINS
SUBROUTINE RAIN_ICE_FAST_RG(KRR, OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCIT, &
PRHODJ, PPRES, PZT, PLBDAR, PLBDAS, PLBDAG, PLSFACT, PLVFACT, &
- PCJ, PKA, PDV, PRHODJ3D, PTHS3D, PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, PTHS, &
+ PCJ, PKA, PDV, &
+ PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, PTHS, &
PUSW, PRDRYG, PRWETG)
!
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RG, LBUDGET_RH, LBUDGET_RI, LBUDGET_RR, LBUDGET_RS, LBUDGET_TH
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
use MODD_CST, only: XCI, XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
use MODD_RAIN_ICE_DESCR, only: XBS, XCEXVT, XCXG, XCXS, XDG, XRTMIN
use MODD_RAIN_ICE_PARAM, only: NDRYLBDAG, NDRYLBDAR, NDRYLBDAS, X0DEPG, X1DEPG, XCOLEXIG, XCOLEXSG, XCOLIG, XCOLSG, XDRYINTP1G, &
XDRYINTP1R, XDRYINTP1S, XDRYINTP2G, XDRYINTP2R, XDRYINTP2S, XEX0DEPG, XEX1DEPG, XEXICFRR, &
XEXRCFRI, XFCDRYG, XFIDRYG, XFRDRYG, XFSDRYG, XICFRR, XKER_RDRYG, XKER_SDRYG, XLBRDRYG1, &
XLBRDRYG2, XLBRDRYG3, XLBSDRYG1, XLBSDRYG2, XLBSDRYG3, XRCFRI
-!
+
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
use mode_mppdb
#ifndef MNH_OPENACC
use mode_tools, only: Countjv
#else
use mode_tools, only: Countjv_device
#endif
-!
+
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
-use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -73,8 +77,6 @@ REAL, DIMENSION(:), intent(in) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(:), intent(in) :: PCJ ! Function to compute the ventilation coefficient
REAL, DIMENSION(:), intent(in) :: PKA ! Thermal conductivity of the air
REAL, DIMENSION(:), intent(in) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
@@ -104,7 +106,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
!
!$acc data present( OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRIT, PRST, PRGT, PCIT, &
!$acc & PRHODJ, PPRES, PZT, PLBDAR, PLBDAS, PLBDAG, PLSFACT, PLVFACT, &
-!$acc & PCJ, PKA, PDV, PRHODJ3D, PTHS3D, &
+!$acc & PCJ, PKA, PDV, &
!
! INOUT variables
!
@@ -136,8 +138,6 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PCJ,"RAIN_ICE_FAST_RG beg:PCJ")
CALL MPPDB_CHECK(PKA,"RAIN_ICE_FAST_RG beg:PKA")
CALL MPPDB_CHECK(PDV,"RAIN_ICE_FAST_RG beg:PDV")
- CALL MPPDB_CHECK(PRHODJ3D,"RAIN_ICE_FAST_RG beg:PRHODJ3D")
- CALL MPPDB_CHECK(PTHS3D,"RAIN_ICE_FAST_RG beg:PTHS3D")
!Check all INOUT arrays
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_FAST_RG beg:PRCS")
CALL MPPDB_CHECK(PRRS,"RAIN_ICE_FAST_RG beg:PRRS")
@@ -160,6 +160,7 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
!* 6.1 rain contact freezing
!
!$acc kernels
+ ZZW1(:,:) = 0.0
GWORK(:) = PRIT(:)>XRTMIN(4) .AND. PRRT(:)>XRTMIN(3) .AND. PRIS(:)>0.0 .AND. PRRS(:)>0.0
WHERE( GWORK(:) )
#ifndef MNH_BITREP
@@ -183,22 +184,32 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
PTHS(:) = PTHS(:) + ZZW1(:,4)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*RRCFRIG)
END WHERE
!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:), 4,'CFRZ_BU_RTH')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), 8,'CFRZ_BU_RRR')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(PRIS)
- CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), 9,'CFRZ_BU_RRI')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(PRGS)
- CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0), 11,'CFRZ_BU_RRG')
- END IF
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', Unpack ( zzw1(:, 4) * ( plsfact(:) - plvfact(:) ) &
+ * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', Unpack ( -zzw1(:, 4) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', Unpack ( -zzw1(:, 3) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', Unpack ( ( zzw1(:,3) + zzw1(:,4) ) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+!PW:used init/end instead of add because zzw1 is produced with a where(...) and is used with other where(...)
+! => can not use directly zzw1 in Budget_store_add
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETG', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
!
!* 6.2 compute the Dry growth case
!
@@ -504,40 +515,39 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
PTHS(:) = PTHS(:) + (PRWETG(:)-ZZW1(:,5)-ZZW1(:,6))*(PLSFACT(:)-PLVFACT(:))
! f(L_f*(RCWETG+RRWETG))
END WHERE
- END IF
-!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'WETG_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'WETG_BU_RRC')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'WETG_BU_RRR')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(PRIS)
- CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'WETG_BU_RRI')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(PRSS)
- CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'WETG_BU_RRS')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(PRGS)
- CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'WETG_BU_RRG')
- END IF
- IF ( KRR == 7 ) THEN
- IF (LBUDGET_RH) THEN
-!$acc update self(PRHS)
- CALL BUDGET (UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),12,'WETG_BU_RRH')
- END IF
END IF
+!$acc end kernels
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETG', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
+!PW:used init/end instead of add because zzw1 is produced with a where(...) and is used with other where(...)
+! => can not use directly zzw1 in Budget_store_add
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'DRYG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DRYG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'DRYG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'DRYG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'DRYG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'DRYG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
-!
!$acc kernels
GWORK(:) = PRGT(:)>XRTMIN(6) .AND. PZT(:)<XTT .AND. PRDRYG(:)<PRWETG(:) .AND. PRDRYG(:)>0.0 ! Dry case
WHERE( GWORK(:) )
@@ -550,30 +560,19 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
! f(L_f*(RCDRYG+RRDRYG))
END WHERE
!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'DRYG_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'DRYG_BU_RRC')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'DRYG_BU_RRR')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(PRIS)
- CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'DRYG_BU_RRI')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(PRSS)
- CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'DRYG_BU_RRS')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(PRGS)
- CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'DRYG_BU_RRG')
- END IF
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'DRYG', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DRYG', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'DRYG', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'DRYG', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'DRYG', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'DRYG', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
!
! WHERE ( PZT(:) > XTT ) ! RSWETG case only
! PRSS(:) = PRSS(:) - ZZW1(:,6)
@@ -583,8 +582,8 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
!* 6.5 Melting of the graupeln
!
!$acc kernels
- GWORK(:) = PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0 .AND. PZT(:)>XTT
- WHERE( GWORK(:) )
+ GWORK(:) = PRGT(:)>XRTMIN(6) .AND. PRGS(:)>0.0 .AND. PZT(:)>XTT
+ WHERE( GWORK(:) )
ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
ZZW(:) = PKA(:)*(XTT-PZT(:)) + &
( PDV(:)*(XLVTT + ( XCPV - XCL ) * ( PZT(:) - XTT )) &
@@ -608,19 +607,13 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
PTHS(:) = PTHS(:) - ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(-RGMLTR))
END WHERE
!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'GMLT_BU_RTH')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'GMLT_BU_RRR')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(PRGS)
- CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'GMLT_BU_RRG')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', Unpack ( -zzw(:) * ( plsfact(:) - plvfact(:) ) &
+ * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', Unpack ( zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', Unpack ( -zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_FAST_RG end:PRCS")
diff --git a/src/MNH/rain_ice_fast_rh.f90 b/src/MNH/rain_ice_fast_rh.f90
index b8abc187d718847fc959eb81c81407aed4e4ae84..aea0efcc1f0d3842575e220fd0d9b8b36ec143ad 100644
--- a/src/MNH/rain_ice_fast_rh.f90
+++ b/src/MNH/rain_ice_fast_rh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -8,6 +8,7 @@
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RH
@@ -20,20 +21,23 @@ MODULE MODE_RAIN_ICE_FAST_RH
CONTAINS
SUBROUTINE RAIN_ICE_FAST_RH(OMICRO, PRHODREF, PRVT, PRCT, PRIT, PRST, PRGT, PRHT, PRHODJ, PPRES, &
- PZT, PLBDAS, PLBDAG, PLBDAH, PLSFACT, PLVFACT, PCJ, PKA, PDV, PRHODJ3D, PTHS3D, &
+ PZT, PLBDAS, PLBDAG, PLBDAH, PLSFACT, PLVFACT, PCJ, PKA, PDV, &
PRCS, PRRS, PRIS, PRSS, PRGS, PRHS, PTHS, PUSW)
!
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RG, LBUDGET_RH, LBUDGET_RI, LBUDGET_RR, LBUDGET_RS, LBUDGET_TH
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
use MODD_CST, only: XCI, XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
use MODD_RAIN_ICE_DESCR, only: XBG, XBS, XCEXVT, XCXG, XCXH, XCXS, XDH, XLBEXH, XLBH, XRTMIN
use MODD_RAIN_ICE_PARAM, only: NWETLBDAG, NWETLBDAH, NWETLBDAS, X0DEPH, X1DEPH, &
XEX0DEPH, XEX1DEPH, XFGWETH, XFSWETH, XFWETH, XKER_GWETH, XKER_SWETH, &
XLBGWETH1, XLBGWETH2, XLBGWETH3, XLBSWETH1, XLBSWETH2, XLBSWETH3, &
XWETINTP1G, XWETINTP1H, XWETINTP1S, XWETINTP2G, XWETINTP2H, XWETINTP2S
-!
+
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
use mode_mppdb
use mode_msg
#ifndef MNH_OPENACC
@@ -41,12 +45,11 @@ use mode_tools, only: Countjv
#else
use mode_tools, only: Countjv_device
#endif
-!
+
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
-use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -70,8 +73,6 @@ REAL, DIMENSION(:), intent(in) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(:), intent(in) :: PCJ ! Function to compute the ventilation coefficient
REAL, DIMENSION(:), intent(in) :: PKA ! Thermal conductivity of the air
REAL, DIMENSION(:), intent(in) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
@@ -99,7 +100,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZZW1 ! Work arrays
!
!$acc data present( OMICRO, PRHODREF, PRVT, PRCT, PRIT, PRST, PRGT, PRHT, &
!$acc & PRHODJ, PPRES, PZT, PLBDAS, PLBDAG, PLSFACT, PLVFACT, &
-!$acc & PCJ, PKA, PDV, PRHODJ3D, PTHS3D, &
+!$acc & PCJ, PKA, PDV, &
!
! INOUT variables
!
@@ -133,8 +134,6 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PCJ,"RAIN_ICE_FAST_RH beg:PCJ")
CALL MPPDB_CHECK(PKA,"RAIN_ICE_FAST_RH beg:PKA")
CALL MPPDB_CHECK(PDV,"RAIN_ICE_FAST_RH beg:PDV")
- CALL MPPDB_CHECK(PRHODJ3D,"RAIN_ICE_FAST_RH beg:PRHODJ3D")
- CALL MPPDB_CHECK(PTHS3D,"RAIN_ICE_FAST_RH beg:PTHS3D")
!Check all INOUT arrays
CALL MPPDB_CHECK(PLBDAH,"RAIN_ICE_FAST_RH beg:PLBDAH")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_FAST_RH beg:PRCS")
@@ -165,6 +164,22 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
#endif
!
IF( IHAIL>0 ) THEN
+!PW:used init/end instead of add because zzw1 is produced and used with different conditions
+! => can not use directly zzw1 in Budget_store_add
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'WETH', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'WETH', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'WETH', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'WETH', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'WETH', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'WETH', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'WETH', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
!
!* 7.2 compute the Wet growth of hail
!
@@ -368,6 +383,7 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
( ZZW1(JL,2)+ZZW1(JL,3)+ZZW1(JL,5) ) * &
( PRHODREF(JL)*(XLMTT+(XCI-XCL)*(XTT-PZT(JL))) ) ) / &
( PRHODREF(JL)*(XLMTT-XCL*(XTT-PZT(JL))) ) )
+
!
ZZW1(JL,6) = MAX( ZZW(JL) - ZZW1(JL,2) - ZZW1(JL,3) - ZZW1(JL,5),0.) ! RCWETH+RRWETH
IF ( ZZW1(JL,6)/=0.) THEN
@@ -395,35 +411,21 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
END IF
END DO
!$acc end kernels
- END IF
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'WETH_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'WETH_BU_RRC')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'WETH_BU_RRR')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(PRIS)
- CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'WETH_BU_RRI')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(PRSS)
- CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'WETH_BU_RRS')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(PRGS)
- CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'WETH_BU_RRG')
- END IF
- IF (LBUDGET_RH) THEN
-!$acc update self(PRHS)
- CALL BUDGET (UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),12,'WETH_BU_RRH')
- END IF
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'WETH', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'WETH', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'WETH', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'WETH', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'WETH', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'WETH', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'WETH', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
!
!
! ici LRECONVH et un flag pour autoriser une reconversion partielle de
@@ -453,10 +455,16 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
- IF( IHAIL>0 ) THEN
!
!* 7.5 Melting of the hailstones
!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'HMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'HMLT', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'HMLT', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
!$acc kernels
!$acc loop independent
DO JJ = 1, IHAIL
@@ -479,20 +487,14 @@ ALLOCATE( ZZW1 (size(PRHODREF),7) )
END IF
END DO
!$acc end kernels
- END IF
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'HMLT_BU_RTH')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'HMLT_BU_RRR')
- END IF
- IF (LBUDGET_RH) THEN
-!$acc update self(PRHS)
- CALL BUDGET (UNPACK(PRHS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),12,'HMLT_BU_RRH')
- END IF
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'HMLT', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'HMLT', Unpack ( prhs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ END IF
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/rain_ice_fast_ri.f90 b/src/MNH/rain_ice_fast_ri.f90
index 5ebaf71d14355258b9ae0e92c0742a22e7204ec5..ab6247526371ac8e96a74774ab31155988fba7d2 100644
--- a/src/MNH/rain_ice_fast_ri.f90
+++ b/src/MNH/rain_ice_fast_ri.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -6,6 +6,7 @@
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RI
@@ -18,23 +19,25 @@ MODULE MODE_RAIN_ICE_FAST_RI
CONTAINS
SUBROUTINE RAIN_ICE_FAST_RI(OMICRO, PRHODREF, PRIT, PRHODJ, PZT, PSSI, PLSFACT, PLVFACT, &
- PAI, PCJ, PRHODJ3D, PTHS3D, PCIT, PRCS, PRIS, PTHS)
+ PAI, PCJ, PCIT, PRCS, PRIS, PTHS)
!
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RI, LBUDGET_TH
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_ri, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RI, &
+ tbudgets
use MODD_CST, only: XTT
use MODD_RAIN_ICE_DESCR, only: XDI, XLBEXI, XLBI, XRTMIN
use MODD_RAIN_ICE_PARAM, only: X0DEPI, X2DEPI
-!
+
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
use mode_mppdb
-!
+
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
-use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -49,8 +52,6 @@ REAL, DIMENSION(:), intent(in) :: PLSFACT ! L_s/(Pi_ref*C_ph)
REAL, DIMENSION(:), intent(in) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(:), intent(in) :: PAI ! Thermodynamical function
REAL, DIMENSION(:), intent(in) :: PCJ ! Function to compute the ventilation coefficient
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
REAL, DIMENSION(:), intent(inout) :: PCIT ! Pristine ice conc. at t
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRIS ! Pristine ice m.r. source
@@ -67,7 +68,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
!
!$acc data present( OMICRO, PRHODREF, PRIT, &
!$acc & PRHODJ, PZT, PSSI, PLSFACT, PLVFACT, &
-!$acc & PAI, PCJ, PRHODJ3D, PTHS3D, &
+!$acc & PAI, PCJ, &
!
! INOUT variables
!
@@ -89,8 +90,6 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PLVFACT,"RAIN_ICE_FAST_RI beg:PLVFACT")
CALL MPPDB_CHECK(PAI,"RAIN_ICE_FAST_RI beg:PAI")
CALL MPPDB_CHECK(PCJ,"RAIN_ICE_FAST_RI beg:PCJ")
- CALL MPPDB_CHECK(PRHODJ3D,"RAIN_ICE_FAST_RI beg:PRHODJ3D")
- CALL MPPDB_CHECK(PTHS3D,"RAIN_ICE_FAST_RI beg:PTHS3D")
!Check all INOUT arrays
CALL MPPDB_CHECK(PCIT,"RAIN_ICE_FAST_RI beg:PCIT")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_FAST_RI beg:PRCS")
@@ -106,6 +105,13 @@ ALLOCATE( ZZW (size(PRHODREF)) )
!
!* 7.1 cloud ice melting
!
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'IMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'IMLT', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'IMLT', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
!$acc kernels
GWORK(:) = PRIS(:)>0.0 .AND. PZT(:)>XTT
WHERE( GWORK(:) )
@@ -115,22 +121,18 @@ ALLOCATE( ZZW (size(PRHODREF)) )
PCIT(:) = 0.0
END WHERE
!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'IMLT_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'IMLT_BU_RRC')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(PRIS)
- CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'IMLT_BU_RRI')
- END IF
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'IMLT', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'IMLT', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'IMLT', Unpack ( pris(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
!
!* 7.2 Bergeron-Findeisen effect: RCBERI
!
!$acc kernels
+ zzw(:) = 0.
GWORK(:) = PRCS(:)>0.0 .AND. PSSI(:)>0.0 .AND. PRIT(:)>XRTMIN(4) .AND. PCIT(:)>0.0
WHERE( GWORK(:) )
#ifndef MNH_BITREP
@@ -147,19 +149,13 @@ ALLOCATE( ZZW (size(PRHODREF)) )
PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCBERI))
END WHERE
!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'BERFI_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'BERFI_BU_RRC')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(PRIS)
- CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'BERFI_BU_RRI')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', Unpack ( zzw(:) * ( plsfact(:) - plvfact(:) ) &
+ * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', Unpack ( -zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', Unpack ( zzw(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PCIT,"RAIN_ICE_FAST_RI end:PCIT")
diff --git a/src/MNH/rain_ice_fast_rs.f90 b/src/MNH/rain_ice_fast_rs.f90
index 1def1027634bf13f7163049cf6382796bbe85853..e12d8727eeb50f36a085f2289f1f753febfd6f7d 100644
--- a/src/MNH/rain_ice_fast_rs.f90
+++ b/src/MNH/rain_ice_fast_rs.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -8,6 +8,8 @@
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
! P. Wautelet 05/06/2019: optimisations
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 19/02/2021: bugfix: RIM and ACC terms for budgets are now correctly stored
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_FAST_RS
@@ -20,13 +22,15 @@ MODULE MODE_RAIN_ICE_FAST_RS
CONTAINS
SUBROUTINE RAIN_ICE_FAST_RS(PTSTEP, OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRST, PRHODJ, PPRES, PZT, &
- PLBDAR, PLBDAS, PLSFACT, PLVFACT, PCJ, PKA, PDV, PRHODJ3D, PTHS3D, &
+ PLBDAR, PLBDAS, PLSFACT, PLVFACT, PCJ, PKA, PDV, &
PRCS, PRRS, PRSS, PRGS, PTHS)
!
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RG, LBUDGET_RR, LBUDGET_RS, LBUDGET_TH
+use modd_budget, only: lbudget_th, lbudget_rc, lbudget_rr, lbudget_rs, lbudget_rg, &
+ NBUDGET_TH, NBUDGET_RC, NBUDGET_RR, NBUDGET_RS, NBUDGET_RG, &
+ tbudgets
use MODD_CST, only: XCL, XCPV, XESTT, XLMTT, XLVTT, XMD, XMV, XRV, XTT
use MODD_RAIN_ICE_DESCR, only: XBS, XCEXVT, XCXS, XRTMIN
use MODD_RAIN_ICE_PARAM, only: NACCLBDAR, NACCLBDAS, NGAMINC, X0DEPS, X1DEPS, XACCINTP1R, XACCINTP1S, XACCINTP2R, XACCINTP2S, &
@@ -34,19 +38,19 @@ use MODD_RAIN_ICE_PARAM, only: NACCLBDAR, NACCLBDAS, NGAMINC, X0DEPS, X1DEPS, XA
XFSACCRG, XFSCVMG, XGAMINC_RIM1, XGAMINC_RIM1, XGAMINC_RIM2, XKER_RACCS, &
XKER_RACCSS, XKER_SACCRG, XLBRACCS1, XLBRACCS2, XLBRACCS3, XLBSACCR1, XLBSACCR2, XLBSACCR3, &
XRIMINTP1, XRIMINTP2, XSRIMCG
-!
+
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
use mode_mppdb
#ifndef MNH_OPENACC
use mode_tools, only: Countjv
#else
use mode_tools, only: Countjv_device
#endif
-!
+
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
-use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -69,8 +73,6 @@ REAL, DIMENSION(:), intent(in) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(:), intent(in) :: PCJ ! Function to compute the ventilation coefficient
REAL, DIMENSION(:), intent(in) :: PKA ! Thermal conductivity of the air
REAL, DIMENSION(:), intent(in) :: PDV ! Diffusivity of water vapor in the air
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRSS ! Snow/aggregate m.r. source
@@ -95,7 +97,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW1, ZZW2, ZZW3, ZZW4 ! Work arrays
!
!$acc data present( OMICRO, PRHODREF, PRVT, PRCT, PRRT, PRST, PRHODJ, &
!$acc & PPRES, PZT, PLBDAR, PLBDAS, PLSFACT, PLVFACT, &
-!$acc & PCJ, PKA, PDV, PRHODJ3D, PTHS3D, &
+!$acc & PCJ, PKA, PDV, &
!
! INOUT variables
!
@@ -123,8 +125,6 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PCJ,"RAIN_ICE_FAST_RS beg:PCJ")
CALL MPPDB_CHECK(PKA,"RAIN_ICE_FAST_RS beg:PKA")
CALL MPPDB_CHECK(PDV,"RAIN_ICE_FAST_RS beg:PDV")
- CALL MPPDB_CHECK(PRHODJ3D,"RAIN_ICE_FAST_RS beg:PRHODJ3D")
- CALL MPPDB_CHECK(PTHS3D,"RAIN_ICE_FAST_RS beg:PTHS3D")
!Check all INOUT arrays
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_FAST_RS beg:PRCS")
CALL MPPDB_CHECK(PRRS,"RAIN_ICE_FAST_RS beg:PRRS")
@@ -151,6 +151,15 @@ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGRIM )
#endif
!
IF( IGRIM>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'RIM', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'RIM', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'RIM', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'RIM', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
!
! 5.1.0 allocations
!
@@ -249,6 +258,18 @@ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGRIM )
!$acc end kernels
!$acc end data
+
+ !Remark: not possible to use Budget_store_add here
+ ! because variables modified a second time but with a if on prss + jl/=jj
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'RIM', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'RIM', Unpack ( prcs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'RIM', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'RIM', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
DEALLOCATE(ZZW3)
DEALLOCATE(ZZW2)
DEALLOCATE(ZZW1)
@@ -257,22 +278,6 @@ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGRIM )
DEALLOCATE(ZVEC1)
DEALLOCATE(ZVECLBDAS)
END IF
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'RIM_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'RIM_BU_RRC')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(PRSS)
- CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'RIM_BU_RRS')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(PRGS)
- CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'RIM_BU_RRG')
- END IF
!
!* 5.2 rain accretion onto the aggregates
!
@@ -286,6 +291,14 @@ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGRIM )
#endif
!
IF( IGACC>0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'ACC', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACC', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'ACC', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'ACC', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
!
! 5.2.0 allocations
!
@@ -429,6 +442,18 @@ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGRIM )
!$acc end kernels
!$acc end data
+
+ !Remark: not possible to use Budget_store_add here
+ ! because variables modified a second time but with a if on prss + jl/=jj
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'ACC', Unpack ( pths(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACC', Unpack ( prrs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'ACC', Unpack ( prss(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'ACC', Unpack ( prgs(:) * prhodj(:), &
+ mask = omicro(:,:,:), field = 0. ) )
+
DEALLOCATE(ZZW4)
DEALLOCATE(ZZW3)
DEALLOCATE(ZZW2)
@@ -440,26 +465,11 @@ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGRIM )
DEALLOCATE(ZVECLBDAS)
DEALLOCATE(ZVECLBDAR)
END IF
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'ACC_BU_RTH')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'ACC_BU_RRR')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(PRSS)
- CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'ACC_BU_RRS')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(PRGS)
- CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'ACC_BU_RRG')
- END IF
!
!* 5.3 Conversion-Melting of the aggregates
!
!$acc kernels
+ zzw(:) = 0.
GWORK(:) = PRST(:)>XRTMIN(5) .AND. PRSS(:)>0.0 .AND. PZT(:)>XTT
WHERE( GWORK(:) )
ZZW(:) = PRVT(:)*PPRES(:)/((XMV/XMD)+PRVT(:)) ! Vapor pressure
@@ -488,15 +498,12 @@ CALL COUNTJV_DEVICE( GWORK(:), I1(:), IGRIM )
PRGS(:) = PRGS(:) + ZZW(:)
END WHERE
!$acc end kernels
- IF (LBUDGET_RS) THEN
-!$acc update self(PRSS)
- CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'CMEL_BU_RRS')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(PRGS)
- CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'CMEL_BU_RRG')
- END IF
-!
+
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', &
+ Unpack ( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', &
+ Unpack ( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0. ) )
+
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_FAST_RS end:PRCS")
diff --git a/src/MNH/rain_ice_nucleation.f90 b/src/MNH/rain_ice_nucleation.f90
index c5b38273f03ac6192aacb2aff0b53f8f9d240fbe..e98cbede16cfb6bb7033e9980efd1b3f258ffd00 100644
--- a/src/MNH/rain_ice_nucleation.f90
+++ b/src/MNH/rain_ice_nucleation.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -7,6 +7,7 @@
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_NUCLEATION
@@ -25,11 +26,14 @@ SUBROUTINE RAIN_ICE_NUCLEATION(KIB, KIE, KJB, KJE, KKTB, KKTE,KRR,PTSTEP,&
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RI, LBUDGET_RV, LBUDGET_TH
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_ri, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RI, &
+ tbudgets
use MODD_CST, only: XALPI, XALPW, XBETAI, XBETAW, XCI, XCL, XCPD, XCPV, XGAMI, XGAMW, &
XLSTT, XMD, XMV, XP00, XRD, XTT
use MODD_RAIN_ICE_PARAM, only: XALPHA1, XALPHA2, XBETA1, XBETA2, XMNU0, XNU10, XNU20
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_mppdb
#ifndef MNH_OPENACC
use mode_tools, only: Countjv
@@ -40,7 +44,6 @@ use mode_tools, only: Countjv_device
#ifdef MNH_BITREP
use modi_bitrep
#endif
-use MODI_BUDGET
IMPLICIT NONE
!
@@ -127,7 +130,10 @@ allocate( gnegt( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
allocate( zw ( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
!$acc data create( i1, i2, i3, gnegt, zw )
-!
+
+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_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
!
! compute the temperature and the pressure
!
@@ -253,9 +259,9 @@ END IF
!
!* 3.1.3 budget storage
!
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'HENU_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'HENU_BU_RRV')
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9,'HENU_BU_RRI')
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HENU', pris(:, :, :) * prhodj(:, :, :) )
!
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
diff --git a/src/MNH/rain_ice_red.f90 b/src/MNH/rain_ice_red.f90
index 88be385ab325a88c0ed84bf5603366b6aa7d13b5..c573e0dbc49101108e192483990a7bf2589d55c4 100644
--- a/src/MNH/rain_ice_red.f90
+++ b/src/MNH/rain_ice_red.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -8,20 +8,27 @@
! ########################
!
INTERFACE
- SUBROUTINE RAIN_ICE_RED ( OSEDIC,HSEDIM, HSUBG_AUCV_RC, OWARM, KKA, KKU, KKL, &
+ SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
+ OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM, KKA, KKU, KKL, &
PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC,PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
!
!
+INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
+INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Switch for rc->rr Subgrid autoconversion
! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Switch for ri->rs Subgrid autoconversion
+ ! Kind of Subgrid autoconversion method
LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
@@ -43,6 +50,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PHLI_HCF
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
@@ -52,8 +63,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
-!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
@@ -69,7 +78,8 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRR! Rain instant precip
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D! Rain evap profile
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS! Snow instant precip
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG! Graupel instant precip
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
+REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
@@ -81,13 +91,16 @@ END SUBROUTINE RAIN_ICE_RED
END INTERFACE
END MODULE MODI_RAIN_ICE_RED
! ######spl
- SUBROUTINE RAIN_ICE_RED ( OSEDIC,HSEDIM, HSUBG_AUCV_RC, OWARM, KKA, KKU, KKL, &
- PTSTEP, KRR, ODMICRO, PEXN, &
+ SUBROUTINE RAIN_ICE_RED ( KIT, KJT, KKT, KSIZE, &
+ OSEDIC, HSEDIM, HSUBG_AUCV_RC, HSUBG_AUCV_RI, &
+ OWARM,KKA,KKU,KKL,&
+ PTSTEP, KRR, ODMICRO, PEXN, &
PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRVT, PRCT, PRRT, PRIT, PRST, &
PRGT, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
PINPRC,PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
PRHT, PRHS, PINPRH, PFPR )
! ######################################################################
!
@@ -141,7 +154,6 @@ END MODULE MODI_RAIN_ICE_RED
!! 'CART' for cartesian box configuration
!! 'MASK' for budget zone defined by a mask
!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
!! LBU_RTH : logical for budget of RTH (potential temperature)
!! .TRUE. = budget of RTH
!! .FALSE. = no budget of RTH
@@ -241,11 +253,21 @@ END MODULE MODI_RAIN_ICE_RED
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! P. Wautelet 29/05/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 17/01/2020: move Quicksort to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 25/02/2020: bugfix: add missing budget: WETH_BU_RRG
+!-----------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET, ONLY: LBU_ENABLE,LBUDGET_RC,LBUDGET_RR,LBUDGET_RI,LBUDGET_RS,LBUDGET_RG,LBUDGET_RH,LBUDGET_RV,LBUDGET_TH
+USE PARKIND1, ONLY : JPRB
+USE YOMHOOK , ONLY : LHOOK, DR_HOOK
+
+use modd_budget, only: lbu_enable, &
+ lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
USE MODD_CST, ONLY: XCI,XCL,XCPD,XCPV,XLSTT,XLVTT,XTT
USE MODD_PARAMETERS, ONLY: JPVEXT,XUNDEF
USE MODD_PARAM_ICE, ONLY: CSUBG_PR_PDF,CSUBG_RC_RR_ACCR,CSUBG_RR_EVAP,LDEPOSC,LFEEDBACKT,LSEDIM_AFTER, &
@@ -253,6 +275,7 @@ USE MODD_PARAM_ICE, ONLY: CSUBG_PR_PDF,CSUBG_RC_RR_ACCR,CSUBG_RR_EVAP,LDEPO
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_VAR_ll, ONLY: IP
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
USE MODE_ll
USE MODE_MPPDB
USE MODE_MSG
@@ -261,7 +284,6 @@ use mode_tools, only: Countjv
use mode_tools, only: Countjv_device
#endif
-USE MODI_BUDGET
USE MODI_ICE4_NUCLEATION_WRAPPER
USE MODI_ICE4_RAINFR_VERT
USE MODI_ICE4_SEDIMENTATION_STAT
@@ -274,9 +296,12 @@ IMPLICIT NONE
!
!
!
+INTEGER, INTENT(IN) :: KIT, KJT, KKT ! arrays size
+INTEGER, INTENT(IN) :: KSIZE
LOGICAL, INTENT(IN) :: OSEDIC ! Switch for droplet sedim.
CHARACTER(LEN=4), INTENT(IN) :: HSEDIM ! Sedimentation scheme
CHARACTER(LEN=4), INTENT(IN) :: HSUBG_AUCV_RC ! Kind of Subgrid autoconversion method
+CHARACTER(LEN=80), INTENT(IN) :: HSUBG_AUCV_RI ! Kind of Subgrid autoconversion method
LOGICAL, INTENT(IN) :: OWARM ! .TRUE. allows raindrops to
! form by warm processes
! (Kessler scheme)
@@ -296,6 +321,10 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCIT ! Pristine ice n.c. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PCLDFR ! Convective Mass Flux Cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PHLC_HRC
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PHLC_HCF
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PHLI_HRI
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PHLI_HCF
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
@@ -303,7 +332,6 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
!
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHS ! Theta source
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
@@ -320,6 +348,7 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PEVAP3D! Rain evap profile
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRS! Snow instant precip
REAL, DIMENSION(:,:), INTENT(OUT) :: PINPRG! Graupel instant precip
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR! Rain fraction
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PSIGS ! Sigma_s at t
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Sea Mask
REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN! Fraction that is town
REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(IN) :: PRHT ! Hail m.r. at t
@@ -331,30 +360,37 @@ REAL, DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT) :: PFPR ! upper-air precipitati
!
INTEGER :: IIB ! Define the domain where is
INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IIT !
INTEGER :: IJB !
INTEGER :: IJE !
-INTEGER :: IJT !
-INTEGER :: IKB, IKTB, IKT!
+INTEGER :: IKB, IKTB !
INTEGER :: IKE, IKTE !
!
-!For packing
INTEGER :: IDX, JI, JJ, JK
INTEGER :: IMICRO ! Case r_x>0 locations
INTEGER, DIMENSION(:), allocatable :: I1,I2,I3 ! Used to replace the COUNT
INTEGER :: JL ! and PACK intrinsics
!
-LOGICAL, DIMENSION(:), allocatable :: GWORK
-!
!Arrays for nucleation call outisde of ODMICRO points
REAL, DIMENSION(:,:,:), allocatable :: ZW ! work array
REAL, DIMENSION(:,:,:), allocatable :: ZT ! Temperature
REAL, DIMENSION(:,:,:), allocatable :: &
& ZZ_RVHENI_MR, & ! heterogeneous nucleation mixing ratio change
& ZZ_RVHENI ! heterogeneous nucleation
+real, dimension(:,:,:), allocatable :: zw1, zw2, zw3, zw4, zw5, zw6 !Work arrays
+real, dimension(:,:,:), allocatable :: zz_diff
REAL, DIMENSION(:,:,:), allocatable :: ZZ_LVFACT, ZZ_LSFACT, ZLSFACT3D
!
!Diagnostics
+REAL, DIMENSION(:,:,:), allocatable :: &
+ & ZHLC_HCF3D,& ! HLCLOUDS cloud fraction in high water content part
+ & ZHLC_LCF3D,& ! HLCLOUDS cloud fraction in low water content part
+ & ZHLC_HRC3D,& ! HLCLOUDS cloud water content in high water content
+ & ZHLC_LRC3D,& ! HLCLOUDS cloud water content in low water content
+ & ZHLI_HCF3D,& ! HLCLOUDS cloud fraction in high ice content part
+ & ZHLI_LCF3D,& ! HLCLOUDS cloud fraction in low ice content part
+ & ZHLI_HRI3D,& ! HLCLOUDS cloud water content in high ice content
+ & ZHLI_LRI3D ! HLCLOUDS cloud water content in high ice content
+
REAL, DIMENSION(:,:), allocatable :: ZINPRI ! Pristine ice instant precip
!
!Packed variables
@@ -379,8 +415,12 @@ REAL, DIMENSION(:), allocatable :: ZRVT, & ! Water vapor m.r. at t
& ZHLC_LCF, & ! HLCLOUDS : fraction of Low Cloud Fraction in grid
! note that ZCF = ZHLC_HCF + ZHLC_LCF
& ZHLC_HRC, & ! HLCLOUDS : LWC that is High LWC in grid
- & ZHLC_LRC ! HLCLOUDS : LWC that is Low LWC in grid
+ & ZHLC_LRC, & ! HLCLOUDS : LWC that is Low LWC in grid
! note that ZRC = ZHLC_HRC + ZHLC_LRC
+ & ZHLI_HCF, &
+ & ZHLI_LCF, &
+ & ZHLI_HRI, &
+ & ZHLI_LRI
!
!Output packed tendencies (for budgets only)
REAL, DIMENSION(:), allocatable :: ZRVHENI_MR, & ! heterogeneous nucleation mixing ratio change
@@ -465,7 +505,8 @@ REAL, DIMENSION(:), allocatable :: ZTIME, & ! Current integration time (start
& ZMAXTIME, & ! Time on which we can apply the current tendencies
& ZTIME_THRESHOLD, & ! Time to reach threshold
& ZTIME_LASTCALL ! Integration time when last tendecies call has been done
-LOGICAL, DIMENSION(:), allocatable :: LLCOMPUTE ! Points where we must compute tendenceis
+REAL, DIMENSION(:), allocatable :: ZW1D
+REAL, DIMENSION(:), allocatable :: ZCOMPUTE ! Points where we must compute tendenceis
LOGICAL :: GSOFT ! Must we really compute tendencies or only adjust them to new T variables
LOGICAL, DIMENSION(:,:,:), allocatable :: GDNOTMICRO ! = .NOT.ODMICRO
REAL :: ZTSTEP ! length of sub-timestep in case of time splitting
@@ -473,15 +514,18 @@ REAL :: ZINV_TSTEP ! Inverse ov PTSTEP
REAL, DIMENSION(:,:), allocatable :: ZRS_TEND
REAL, DIMENSION(:,:), allocatable :: ZRG_TEND
REAL, DIMENSION(:,:), allocatable :: ZRH_TEND
+REAL, DIMENSION(:), allocatable :: ZSSI
!
!For total tendencies computation
REAL, DIMENSION(:,:,:), allocatable :: &
&ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS
!
-!$acc data present( ODMICRO, PEXN, PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, PTHT, PRVT, &
-!$acc & PRCT, PRRT, PRIT, PRST, PRGT, PSIGS, PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
-!$acc & PINPRC, PINDEP, PINPRR, PEVAP3D, PINPRS, PINPRG, PRAINFR, &
+!$acc data present( ODMICRO, PEXN, PDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR, &
+!$acc & PHLC_HRC, PTHT, PRVT, &
+!$acc & PRCT, PHLC_HCF, PHLI_HRI, PHLI_HCF, PRRT, PRIT, PRST, PRGT, PSIGS, &
+!$acc & PTHS, PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, &
+!$acc & PINPRC, PINDEP, PINPRR, PEVAP3D, PINPRS, PINPRG, PRAINFR, &
!$acc & PSEA, PTOWN, PRHT, PRHS, PINPRH, PFPR )
IF (MPPDB_INITIALIZED) THEN
@@ -494,6 +538,10 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PEXNREF,"RAIN_ICE_RED beg:PEXNREF")
CALL MPPDB_CHECK(PPABST,"RAIN_ICE_RED beg:PPABST")
CALL MPPDB_CHECK(PCLDFR,"RAIN_ICE_RED beg:PCLDFR")
+ CALL MPPDB_CHECK(PHLC_HRC,"RAIN_ICE_RED beg:PHLC_HRC")
+ CALL MPPDB_CHECK(PHLC_HCF,"RAIN_ICE_RED beg:PHLC_HCF")
+ CALL MPPDB_CHECK(PHLI_HRI,"RAIN_ICE_RED beg:PHLI_HRI")
+ CALL MPPDB_CHECK(PHLI_HCF,"RAIN_ICE_RED beg:PHLI_HCF")
CALL MPPDB_CHECK(PTHT,"RAIN_ICE_RED beg:PTHT")
CALL MPPDB_CHECK(PRVT,"RAIN_ICE_RED beg:PRVT")
CALL MPPDB_CHECK(PRCT,"RAIN_ICE_RED beg:PRCT")
@@ -526,8 +574,6 @@ allocate( i1(imicro ) )
allocate( i2(imicro ) )
allocate( i3(imicro ) )
-allocate( gwork(imicro ) )
-
allocate( zw(size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
allocate( zt(size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
@@ -537,6 +583,15 @@ allocate( zz_lvfact (size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zz_lsfact (size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zlsfact3d (size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+allocate( ZHLC_HCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+allocate( ZHLC_LCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+allocate( ZHLC_HRC3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+allocate( ZHLC_LRC3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+allocate( ZHLI_HCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+allocate( ZHLI_LCF3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+allocate( ZHLI_HRI3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+allocate( ZHLI_LRI3D(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
+
allocate( zinpri(size( ptht, 1 ), size( ptht, 2 ) ) )
allocate( zrvt (imicro ) )
@@ -560,6 +615,10 @@ allocate( zhlc_hcf (imicro ) )
allocate( zhlc_lcf (imicro ) )
allocate( zhlc_hrc (imicro ) )
allocate( zhlc_lrc (imicro ) )
+allocate( ZHLI_HCF (imicro ) )
+allocate( ZHLI_LCF (imicro ) )
+allocate( ZHLI_HRI (imicro ) )
+allocate( ZHLI_LRI (imicro ) )
allocate( zrvheni_mr (imicro ) )
allocate( zrchoni (imicro ) )
@@ -695,7 +754,8 @@ allocate( zmaxtime(imicro ) )
allocate( ztime_threshold(imicro ) )
allocate( ztime_lastcall(imicro ) )
-allocate( llcompute(imicro ) )
+allocate( zw1d (imicro ) )
+allocate( zcompute(imicro ) )
allocate( gdnotmicro(size( odmicro, 1 ), size( odmicro, 2 ), size( odmicro, 3 ) ) )
@@ -703,6 +763,8 @@ allocate( zrs_tend(imicro, 6 ) )
allocate( zrg_tend(imicro, 6 ) )
allocate( zrh_tend(imicro, 8 ) )
+allocate( zssi(imicro ) )
+
allocate( zw_rvs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_rcs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_rrs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
@@ -713,9 +775,11 @@ allocate( zw_rhs(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
allocate( zw_ths(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
!$acc data create( I1, I2, I3, &
-!$acc & gwork, ZW, ZT, ZZ_RVHENI_MR, ZZ_RVHENI, ZZ_LVFACT, ZZ_LSFACT, ZLSFACT3D, ZINPRI, &
+!$acc & ZW, ZT, ZZ_RVHENI_MR, ZZ_RVHENI, ZZ_LVFACT, ZZ_LSFACT, ZLSFACT3D, ZINPRI, &
!$acc & ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, ZCIT, ZTHT, ZRHODREF, ZZT, ZPRES, ZEXN, &
-!$acc & ZLSFACT, ZLVFACT, ZSIGMA_RC, ZCF, ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
+!$acc & ZLSFACT, ZLVFACT, &
+!$acc & ZHLC_HCF3D, ZHLC_LCF3D, ZHLC_HRC3D, ZHLC_LRC3D, ZHLI_HCF3D, ZHLI_LCF3D, ZHLI_HRI3D, ZHLI_LRI3D, &
+!$acc & ZSIGMA_RC, ZCF, ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, ZHLI_HCF, ZHLI_LCF, ZHLI_HRI, ZHLI_LRI, &
!$acc & ZRVHENI_MR, ZRCHONI, ZRRHONG_MR, ZRVDEPS, ZRIAGGS, ZRIAUTS, ZRVDEPG, ZRCAUTR, ZRCACCR, ZRREVAV, ZRIMLTC_MR, &
!$acc & ZRCBERI, ZRHMLTR, ZRSMLTG, ZRCMLTSR, ZRRACCSS, ZRRACCSG, ZRSACCRG, &
!$acc & ZRCRIMSS, ZRCRIMSG, ZRSRIMCG, ZRSRIMCG_MR, &
@@ -732,9 +796,14 @@ allocate( zw_ths(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
!$acc & ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
!$acc & ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH, &
!$acc & ZEXT_RV, ZEXT_RC, ZEXT_RR, ZEXT_RI, ZEXT_RS, ZEXT_RG, ZEXT_RH, ZEXT_TH, &
-!$acc & IITER, ZTIME, ZMAXTIME, ZTIME_THRESHOLD, ZTIME_LASTCALL, LLCOMPUTE, GDNOTMICRO, &
-!$acc & ZRS_TEND, ZRG_TEND, ZRH_TEND, ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS )
+!$acc & IITER, ZTIME, ZMAXTIME, ZTIME_THRESHOLD, ZTIME_LASTCALL, ZW1D, ZCOMPUTE, GDNOTMICRO, &
+!$acc & ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, ZW_RVS, ZW_RCS, ZW_RRS, ZW_RIS, ZW_RSS, ZW_RGS, ZW_RHS, ZW_THS )
+!-------------------------------------------------------------------------------
+if ( lbu_enable ) 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(:, :, :) )
+end if
!-------------------------------------------------------------------------------
!
!* 1. COMPUTE THE LOOP BOUNDS
@@ -742,13 +811,10 @@ allocate( zw_ths(size( ptht, 1 ), size( ptht, 2 ), size( ptht, 3 ) ) )
!
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
!$acc kernels
-IIT=SIZE(PDZZ,1)
-IJT=SIZE(PDZZ,2)
IKB=KKA+JPVEXT*KKL
IKE=KKU-JPVEXT*KKL
-IKT=SIZE(PDZZ,3)
IKTB=1+JPVEXT
-IKTE=IKT-JPVEXT
+IKTE=KKT-JPVEXT
!
ZINV_TSTEP=1./PTSTEP
GEXT_TEND=.TRUE.
@@ -775,22 +841,35 @@ ZRGMLTR(:) = 0.
ZRHMLTR(:) = 0.
ZRCBERI(:) = 0.
!
-ZT(:,:,:) = PTHT(:,:,:) * PEXN(:,:,:)
! LSFACT and LVFACT without exner
IF(KRR==7) THEN
- ZZ_LSFACT(:,:,:)=(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))
- ZZ_LVFACT(:,:,:)=(XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)+PRHT(:,:,:)))
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
+ ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
+ ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)+PRHT(JI,JJ,JK)))
+ ENDDO
+ ENDDO
+ ENDDO
ELSE
- ZZ_LSFACT(:,:,:)=(XLSTT+(XCPV-XCI)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))
- ZZ_LVFACT(:,:,:)=(XLVTT+(XCPV-XCL)*(ZT(:,:,:)-XTT)) &
- /( XCPD + XCPV*PRVT(:,:,:) + XCL*(PRCT(:,:,:)+PRRT(:,:,:)) &
- + XCI*(PRIT(:,:,:)+PRST(:,:,:)+PRGT(:,:,:)))
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZT(JI,JJ,JK) = PTHT(JI,JJ,JK) * PEXN(JI,JJ,JK)
+ ZZ_LSFACT(JI,JJ,JK)=(XLSTT+(XCPV-XCI)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
+ ZZ_LVFACT(JI,JJ,JK)=(XLVTT+(XCPV-XCL)*(ZT(JI,JJ,JK)-XTT)) &
+ /( XCPD + XCPV*PRVT(JI,JJ,JK) + XCL*(PRCT(JI,JJ,JK)+PRRT(JI,JJ,JK)) &
+ + XCI*(PRIT(JI,JJ,JK)+PRST(JI,JJ,JK)+PRGT(JI,JJ,JK)))
+ ENDDO
+ ENDDO
+ ENDDO
ENDIF
!$acc end kernels
!
@@ -803,28 +882,41 @@ IF(.NOT. LSEDIM_AFTER) THEN
!
!* 2.1 sedimentation
!
+ if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !Init only if not osedic (to prevent crash with double init)
+ !Remark: the 2 source terms SEDI and DEPO could be mixed and stored in the same source term (SEDI)
+ ! if osedic=T and ldeposc=T (a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
IF(HSEDIM=='STAT') THEN
#ifdef MNH_OPENACC
CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_RED','OpenACC: HSEDIM=STAT not yet implemented')
#endif
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
!$acc kernels
@@ -834,20 +926,20 @@ IF(.NOT. LSEDIM_AFTER) THEN
ELSEIF(HSEDIM=='SPLI') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC,XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
- &PTSTEP, KRR, OSEDIC, LDEPOSC,XVDEPOSC, PDZZ, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
+ &PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
!$acc kernels
@@ -863,25 +955,27 @@ IF(.NOT. LSEDIM_AFTER) THEN
! will be still active and will lead to negative values.
! We could prevent the algorithm to not consume too much a specie, instead we apply
! a correction here.
- CALL CORRECT_NEGATIVITIES(KRR, PRVS, PRCS, PRRS, &
+ CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
+ ELSEIF(HSEDIM=='NONE') THEN
ELSE
call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_RED', 'no sedimentation scheme for HSEDIM='//HSEDIM )
END IF
!
!* 2.2 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), 10, 'SEDI_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), 11, 'SEDI_BU_RRG')
- IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), 12, 'SEDI_BU_RRH')
- IF ( LBUDGET_RC .AND. LDEPOSC ) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
+ if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !If osedic=T and ldeposc=T, DEPO is in fact mixed and stored with the SEDI source term
+ !(a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
ENDIF
!
!-------------------------------------------------------------------------------
@@ -912,6 +1006,22 @@ IF(IMICRO>0) THEN
ZTHT(JL) = PTHT(I1(JL),I2(JL),I3(JL))
ZPRES(JL) = PPABST(I1(JL),I2(JL),I3(JL))
ZEXN(JL) = PEXN(I1(JL),I2(JL),I3(JL))
+ ZHLC_HCF(JL) = PHLC_HCF(I1(JL),I2(JL),I3(JL))
+ ZHLC_HRC(JL) = PHLC_HRC(I1(JL),I2(JL),I3(JL))
+ ZHLC_LRC(JL) = ZRCT(JL) - ZHLC_HRC(JL)
+ ZHLI_HCF(JL) = PHLI_HCF(I1(JL),I2(JL),I3(JL))
+ ZHLI_HRI(JL) = PHLI_HRI(I1(JL),I2(JL),I3(JL))
+ ZHLI_LRI(JL) = ZRIT(JL) - ZHLI_HRI(JL)
+ IF(ZRCT(JL)>0.) THEN
+ ZHLC_LCF(JL) = ZCF(JL)- ZHLC_HCF(JL)
+ ELSE
+ ZHLC_LCF(JL)=0.
+ ENDIF
+ IF(ZRIT(JL)>0.) THEN
+ ZHLI_LCF(JL) = ZCF(JL)- ZHLI_HCF(JL)
+ ELSE
+ ZHLI_LCF(JL)=0.
+ ENDIF
ENDDO
IF(GEXT_TEND) THEN
DO JL=1, IMICRO
@@ -928,7 +1038,6 @@ IF(IMICRO>0) THEN
IF(HSUBG_AUCV_RC=='PDF ' .AND. CSUBG_PR_PDF=='SIGM') THEN
DO JL=1, IMICRO
ZSIGMA_RC(JL) = PSIGS(I1(JL),I2(JL),I3(JL))*2.
-! ZSIGMA_RC(JL) = MAX(PSIGS(I1(JL),I2(JL),I3(JL)) * 2., 1.E-12)
ENDDO
ELSE !useful when doing calls to MPPDB_CHECK
ZSIGMA_RC(:) = XUNDEF
@@ -1037,44 +1146,47 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
!$acc end kernels
ENDIF
!$acc kernels
- LLCOMPUTE(:)=ZTIME(:)<PTSTEP ! Compuation only for points for which integration time has not reached the timestep
+ ZCOMPUTE(:)=MAX(0., -SIGN(1., ZTIME(:)-PTSTEP)) ! Compuation (1.) only for points for which integration time has not reached the timestep
GSOFT=.FALSE. ! We *really* compute the tendencies
- WHERE(LLCOMPUTE(:))
- IITER(:)=IITER(:)+1
- END WHERE
+ IITER(:)=IITER(:)+INT(ZCOMPUTE(:))
!$acc end kernels
-!$acc update self(LLCOMPUTE)
- DO WHILE(ANY(LLCOMPUTE(:))) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
-!$acc kernels
- ZZT(:) = ZTHT(:) * ZEXN(:)
+!$acc update self(ZCOMPUTE)
+ DO WHILE(SUM(ZCOMPUTE(:))>0.) ! Loop to adjust tendencies when we cross the 0°C or when a specie disappears
IF(KRR==7) THEN
- ZLSFACT(:)=(XLSTT+(XCPV-XCI)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)+ZRHT(:)))*ZEXN(:) )
- ZLVFACT(:)=(XLVTT+(XCPV-XCL)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)+ZRHT(:)))*ZEXN(:) )
+ DO JL=1, IMICRO
+ ZZT(JL) = ZTHT(JL) * ZEXN(JL)
+ ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
+ ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)+ZRHT(JL)))*ZEXN(JL) )
+ ENDDO
ELSE
- ZLSFACT(:)=(XLSTT+(XCPV-XCI)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)))*ZEXN(:) )
- ZLVFACT(:)=(XLVTT+(XCPV-XCL)*(ZZT(:)-XTT)) &
- /( (XCPD + XCPV*ZRVT(:) + XCL*(ZRCT(:)+ZRRT(:)) &
- + XCI*(ZRIT(:)+ZRST(:)+ZRGT(:)))*ZEXN(:) )
+ DO JL=1, IMICRO
+ ZZT(JL) = ZTHT(JL) * ZEXN(JL)
+ ZLSFACT(JL)=(XLSTT+(XCPV-XCI)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
+ ZLVFACT(JL)=(XLVTT+(XCPV-XCL)*(ZZT(JL)-XTT)) &
+ &/( (XCPD + XCPV*ZRVT(JL) + XCL*(ZRCT(JL)+ZRRT(JL)) &
+ &+ XCI*(ZRIT(JL)+ZRST(JL)+ZRGT(JL)))*ZEXN(JL) )
+ ENDDO
ENDIF
!$acc end kernels
!
!*** 4.1 Tendecies computation
!
! Tendencies are *really* computed when GSOFT==.FALSE. and only adjusted otherwise
- CALL ICE4_TENDENCIES(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, &
- &KRR, GSOFT, LLCOMPUTE, &
- &OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, HSUBG_AUCV_RC, CSUBG_PR_PDF, &
+ CALL ICE4_TENDENCIES(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, &
+ &KRR, GSOFT, ZCOMPUTE, &
+ &OWARM, CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP, &
+ &HSUBG_AUCV_RC, HSUBG_AUCV_RI, CSUBG_PR_PDF, &
&ZEXN, ZRHODREF, ZLVFACT, ZLSFACT, I1, I2, I3, &
- &ZPRES, ZCF, ZSIGMA_RC, &
+ &ZPRES, ZCF, ZSIGMA_RC,&
&ZCIT, &
&ZZT, ZTHT, &
- &ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, PRRT, &
+ &ZRVT, ZRCT, ZRRT, ZRIT, ZRST, ZRGT, ZRHT, &
&ZRVHENI_MR, ZRRHONG_MR, ZRIMLTC_MR, ZRSRIMCG_MR, &
&ZRCHONI, ZRVDEPS, ZRIAGGS, ZRIAUTS, ZRVDEPG, &
&ZRCAUTR, ZRCACCR, ZRREVAV, &
@@ -1084,209 +1196,227 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
&ZRCWETH, ZRIWETH, ZRSWETH, ZRGWETH, ZRRWETH, &
&ZRCDRYH, ZRIDRYH, ZRSDRYH, ZRRDRYH, ZRGDRYH, ZRDRYHG, ZRHMLTR, &
&ZRCBERI, &
- &ZRS_TEND, ZRG_TEND, ZRH_TEND, &
+ &ZRS_TEND, ZRG_TEND, ZRH_TEND, ZSSI, &
&ZA_TH, ZA_RV, ZA_RC, ZA_RR, ZA_RI, ZA_RS, ZA_RG, ZA_RH, &
&ZB_TH, ZB_RV, ZB_RC, ZB_RR, ZB_RI, ZB_RS, ZB_RG, ZB_RH, &
- &ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, PRAINFR)
+ &ZHLC_HCF, ZHLC_LCF, ZHLC_HRC, ZHLC_LRC, &
+ &ZHLI_HCF, ZHLI_LCF, ZHLI_HRI, ZHLI_LRI, PRAINFR)
! External tendencies
!$acc kernels
IF(GEXT_TEND) THEN
- ZA_TH(:) = ZA_TH(:) + ZEXT_TH(:)
- ZA_RV(:) = ZA_RV(:) + ZEXT_RV(:)
- ZA_RC(:) = ZA_RC(:) + ZEXT_RC(:)
- ZA_RR(:) = ZA_RR(:) + ZEXT_RR(:)
- ZA_RI(:) = ZA_RI(:) + ZEXT_RI(:)
- ZA_RS(:) = ZA_RS(:) + ZEXT_RS(:)
- ZA_RG(:) = ZA_RG(:) + ZEXT_RG(:)
- ZA_RH(:) = ZA_RH(:) + ZEXT_RH(:)
+ DO JL=1, IMICRO
+ ZA_TH(JL) = ZA_TH(JL) + ZEXT_TH(JL)
+ ZA_RV(JL) = ZA_RV(JL) + ZEXT_RV(JL)
+ ZA_RC(JL) = ZA_RC(JL) + ZEXT_RC(JL)
+ ZA_RR(JL) = ZA_RR(JL) + ZEXT_RR(JL)
+ ZA_RI(JL) = ZA_RI(JL) + ZEXT_RI(JL)
+ ZA_RS(JL) = ZA_RS(JL) + ZEXT_RS(JL)
+ ZA_RG(JL) = ZA_RG(JL) + ZEXT_RG(JL)
+ ZA_RH(JL) = ZA_RH(JL) + ZEXT_RH(JL)
+ ENDDO
ENDIF
!
!*** 4.2 Integration time
!
- ! If we can, we will use these tendecies until the end of the timestep
- ZMAXTIME(:)=0.
- WHERE(LLCOMPUTE(:))
- ZMAXTIME(:)=PTSTEP-ZTIME(:) ! Remaining time until the end of the timestep
- ENDWHERE
+ ! If we can, we will use these tendencies until the end of the timestep
+ ZMAXTIME(:)=ZCOMPUTE(:) * (PTSTEP-ZTIME(:)) ! Remaining time until the end of the timestep
+
!We need to adjust tendencies when temperature reaches 0
IF(LFEEDBACKT) THEN
- !Is ZB_TH enough to change temperature sign?
- GWORK(:) = (ZTHT(:) - XTT/ZEXN(:)) * (ZTHT(:) + ZB_TH(:) - XTT/ZEXN(:)) < 0.
- WHERE( GWORK(:) )
- ZMAXTIME(:)=0.
- ENDWHERE
- !Can ZA_TH make temperature change of sign?
- ZTIME_THRESHOLD(:)=-1.
- GWORK(:) = ABS(ZA_TH(:))>1.E-20
- WHERE( GWORK(:) )
- ZTIME_THRESHOLD(:)=(XTT/ZEXN(:) - ZB_TH(:) - ZTHT(:))/ZA_TH(:)
- ENDWHERE
- WHERE( ZTIME_THRESHOLD(:)>0. )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- ENDWHERE
+ DO JL=1, IMICRO
+ !Is ZB_TH enough to change temperature sign?
+ ZW1D(JL)=(ZTHT(JL) - XTT/ZEXN(JL)) * (ZTHT(JL) + ZB_TH(JL) - XTT/ZEXN(JL))
+ ZMAXTIME(JL)=ZMAXTIME(JL)*MAX(0., SIGN(1., ZW1D(JL)))
+ !Can ZA_TH make temperature change of sign?
+ ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ABS(ZA_TH(JL)))) ! WHERE(ABS(ZA_TH(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1. - ZW1D(JL))*(-1.) + &
+ ZW1D(JL) * &
+ (XTT/ZEXN(JL) - ZB_TH(JL) - ZTHT(JL))/ &
+ SIGN(MAX(ABS(ZA_TH(JL)), 1.E-20), ZA_TH(JL))
+ ZW1D(JL)=MAX(0., -SIGN(1., 1.E-20 - ZTIME_THRESHOLD(JL))) ! WHERE(ZTIME_THRESHOLD(:)>1.E-20)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ ZW1D(JL) * MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ENDDO
ENDIF
!We need to adjust tendencies when a specy disappears
!When a species is missing, only the external tendencies can be negative (and we must keep track of it)
- GWORK(:) = ZA_RV(:)<-1.E-20 .AND. ZRVT(:)>XRTMIN(1)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RV(:)+ZRVT(:))/ZA_RV(:))
- END WHERE
- GWORK(:) = ZA_RC(:)<-1.E-20 .AND. ZRCT(:)>XRTMIN(2)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RC(:)+ZRCT(:))/ZA_RC(:))
- END WHERE
- GWORK(:) = ZA_RR(:)<-1.E-20 .AND. ZRRT(:)>XRTMIN(3)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RR(:)+ZRRT(:))/ZA_RR(:))
- END WHERE
- GWORK(:) = ZA_RI(:)<-1.E-20 .AND. ZRIT(:)>XRTMIN(4)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RI(:)+ZRIT(:))/ZA_RI(:))
- END WHERE
- GWORK(:) = ZA_RS(:)<-1.E-20 .AND. ZRST(:)>XRTMIN(5)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RS(:)+ZRST(:))/ZA_RS(:))
- END WHERE
- GWORK(:) = ZA_RG(:)<-1.E-20 .AND. ZRGT(:)>XRTMIN(6)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RG(:)+ZRGT(:))/ZA_RG(:))
- END WHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RV(JL)+1.E-20)) * & ! WHERE(ZA_RV(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(1)-ZRVT(JL))) ! WHERE(ZRVT(:)>XRTMIN(1))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RV(JL)+ZRVT(JL))/MIN(ZA_RV(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RC(JL)+1.E-20)) * & ! WHERE(ZA_RC(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(2)-ZRCT(JL))) ! WHERE(ZRCT(:)>XRTMIN(2))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RC(JL)+ZRCT(JL))/MIN(ZA_RC(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RR(JL)+1.E-20)) * & ! WHERE(ZA_RR(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(3)-ZRRT(JL))) ! WHERE(ZRRT(:)>XRTMIN(3))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RR(JL)+ZRRT(JL))/MIN(ZA_RR(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RI(JL)+1.E-20)) * & ! WHERE(ZI_RV(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(4)-ZRIT(JL))) ! WHERE(ZRIT(:)>XRTMIN(4))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RI(JL)+ZRIT(JL))/MIN(ZA_RI(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RS(JL)+1.E-20)) * & ! WHERE(ZA_RS(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(5)-ZRST(JL))) ! WHERE(ZRST(:)>XRTMIN(5))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RS(JL)+ZRST(JL))/MIN(ZA_RS(JL), -1.E-20))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RG(JL)+1.E-20)) * & ! WHERE(ZA_RG(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) ! WHERE(ZRGT(:)>XRTMIN(6))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RG(JL)+ZRGT(JL))/MIN(ZA_RG(JL), -1.E-20))
+ ENDDO
+
IF(KRR==7) THEN
- GWORK(:) = ZA_RH(:)<-1.E-20 .AND. ZRHT(:)>XRTMIN(7)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), -(ZB_RH(:)+ZRHT(:))/ZA_RH(:))
- END WHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., ZA_RH(JL)+1.E-20)) * & ! WHERE(ZA_RH(:)<-1.E-20)
+ &MAX(0., -SIGN(1., XRTMIN(7)-ZRHT(JL))) ! WHERE(ZRHT(:)>XRTMIN(7))
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * MIN(ZMAXTIME(JL), -(ZB_RH(JL)+ZRHT(JL))/MIN(ZA_RH(JL), -1.E-20))
+ ENDDO
ENDIF
!We stop when the end of the timestep is reached
- GWORK(:) = PTSTEP-ZTIME(:)-ZMAXTIME(:)<=0.
- WHERE( GWORK(:) )
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-!$acc end kernels
+ ZCOMPUTE(:)=ZCOMPUTE(:) * MAX(0., -SIGN(1., ZTIME(:)+ZMAXTIME(:)-PTSTEP))
+
!We must recompute tendencies when the end of the sub-timestep is reached
IF(XTSTEP_TS/=0.) THEN
-!$acc kernels
- GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP
- WHERE( GWORK(:) )
- ZMAXTIME(:)=ZTIME_LASTCALL(:)-ZTIME(:)+ZTSTEP
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-!$acc end kernels
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., ZTIME_LASTCALL(JL)+ZTSTEP-ZTIME(JL)-ZMAXTIME(JL))) ! WHERE(ZTIME(:)+ZMAXTIME(:)>ZTIME_LASTCALL(:)+ZTSTEP)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL) * (ZTIME_LASTCALL(JL)-ZTIME(JL)+ZTSTEP)
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
ENDIF
!We must recompute tendencies when the maximum allowed change is reached
!When a specy is missing, only the external tendencies can be active and we do not want to recompute
!the microphysical tendencies when external tendencies are negative (results won't change because specy was already missing)
IF(XMRSTEP/=0.) THEN
-!$acc kernels
- ZTIME_THRESHOLD(:)=-1.
- GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RV(:))>1.E-20
- WHERE( GWORK(:) )
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RV(:))*XMRSTEP+Z0RVT(:)-ZRVT(:)-ZB_RV(:))/ZA_RV(:)
- ENDWHERE
- GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- (ZRVT(:)>XRTMIN(1) .OR. ZA_RV(:)>0.)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RC(:))>1.E-20
- WHERE( GWORK(:) )
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RC(:))*XMRSTEP+Z0RCT(:)-ZRCT(:)-ZB_RC(:))/ZA_RC(:)
- ENDWHERE
- GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- (ZRCT(:)>XRTMIN(2) .OR. ZA_RC(:)>0.)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RR(:))>1.E-20
- WHERE( GWORK(:) )
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RR(:))*XMRSTEP+Z0RRT(:)-ZRRT(:)-ZB_RR(:))/ZA_RR(:)
- ENDWHERE
- GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- (ZRRT(:)>XRTMIN(3) .OR. ZA_RR(:)>0.)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RI(:))>1.E-20
- WHERE( GWORK(:) )
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RI(:))*XMRSTEP+Z0RIT(:)-ZRIT(:)-ZB_RI(:))/ZA_RI(:)
- ENDWHERE
- GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- (ZRIT(:)>XRTMIN(4) .OR. ZA_RI(:)>0.)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RS(:))>1.E-20
- WHERE( GWORK(:) )
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RS(:))*XMRSTEP+Z0RST(:)-ZRST(:)-ZB_RS(:))/ZA_RS(:)
- ENDWHERE
- GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- (ZRST(:)>XRTMIN(5) .OR. ZA_RS(:)>0.)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-
- ZTIME_THRESHOLD(:)=-1.
- GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RG(:))>1.E-20
- WHERE( GWORK(:) )
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RG(:))*XMRSTEP+Z0RGT(:)-ZRGT(:)-ZB_RG(:))/ZA_RG(:)
- ENDWHERE
- GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- (ZRGT(:)>XRTMIN(6) .OR. ZA_RG(:)>0.)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RV(JL)))) ! WHERE(ABS(ZA_RV(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RV(JL))*XMRSTEP+Z0RVT(JL)-ZRVT(JL)-ZB_RV(JL))/ &
+ &SIGN(MAX(ABS(ZA_RV(JL)), 1.E-20), ZA_RV(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRVT(JL))) + & !WHERE(ZRVT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RV(JL)))) !WHERE(ZA_RV(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RC(JL)))) ! WHERE(ABS(ZA_RC(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RC(JL))*XMRSTEP+Z0RCT(JL)-ZRCT(JL)-ZB_RC(JL))/ &
+ &SIGN(MAX(ABS(ZA_RC(JL)), 1.E-20), ZA_RC(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRCT(JL))) + & !WHERE(ZRCT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RC(JL)))) !WHERE(ZA_RC(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RR(JL)))) ! WHERE(ABS(ZA_RR(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RR(JL))*XMRSTEP+Z0RRT(JL)-ZRRT(JL)-ZB_RR(JL))/ &
+ &SIGN(MAX(ABS(ZA_RR(JL)), 1.E-20), ZA_RR(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRRT(JL))) + & !WHERE(ZRRT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RR(JL)))) !WHERE(ZA_RR(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RI(JL)))) ! WHERE(ABS(ZA_RI(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RI(JL))*XMRSTEP+Z0RIT(JL)-ZRIT(JL)-ZB_RI(JL))/ &
+ &SIGN(MAX(ABS(ZA_RI(JL)), 1.E-20), ZA_RI(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRIT(JL))) + & !WHERE(ZRIT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RI(JL)))) !WHERE(ZA_RI(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RS(JL)))) ! WHERE(ABS(ZA_RS(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RS(JL))*XMRSTEP+Z0RST(JL)-ZRST(JL)-ZB_RS(JL))/ &
+ &SIGN(MAX(ABS(ZA_RS(JL)), 1.E-20), ZA_RS(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRST(JL))) + & !WHERE(ZRST(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RS(JL)))) !WHERE(ZA_RS(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RG(JL)))) ! WHERE(ABS(ZA_RG(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RG(JL))*XMRSTEP+Z0RGT(JL)-ZRGT(JL)-ZB_RG(JL))/ &
+ &SIGN(MAX(ABS(ZA_RG(JL)), 1.E-20), ZA_RG(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRGT(JL))) + & !WHERE(ZRGT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RG(JL)))) !WHERE(ZA_RG(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
IF(KRR==7) THEN
- ZTIME_THRESHOLD(:)=-1.
- GWORK(:) = IITER(:)<INB_ITER_MAX .AND. ABS(ZA_RH(:))>1.E-20
- WHERE( GWORK(:) )
- ZTIME_THRESHOLD(:)=(SIGN(1., ZA_RH(:))*XMRSTEP+Z0RHT(:)-ZRHT(:)-ZB_RH(:))/ZA_RH(:)
- ENDWHERE
- GWORK(:) = ZTIME_THRESHOLD(:)>=0. .AND. ZTIME_THRESHOLD(:)<ZMAXTIME(:) .AND. &
- (ZRHT(:)>XRTMIN(7) .OR. ZA_RH(:)>0.)
- WHERE( GWORK(:) )
- ZMAXTIME(:)=MIN(ZMAXTIME(:), ZTIME_THRESHOLD(:))
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & ! WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., 1.E-20-ABS(ZA_RH(JL)))) ! WHERE(ABS(ZA_RH(:))>1.E-20)
+ ZTIME_THRESHOLD(JL)=(1.-ZW1D(JL))*(-1.) + &
+ &ZW1D(JL)*(SIGN(1., ZA_RH(JL))*XMRSTEP+Z0RHT(JL)-ZRHT(JL)-ZB_RH(JL))/ &
+ &SIGN(MAX(ABS(ZA_RH(JL)), 1.E-20), ZA_RH(JL))
+ ZW1D(JL)=MAX(0., SIGN(1., ZTIME_THRESHOLD(JL))) * & !WHERE(ZTIME_THRESHOLD(:)>=0.)
+ &MAX(0., -SIGN(1., ZTIME_THRESHOLD(JL)-ZMAXTIME(JL))) * & !WHERE(ZTIME_THRESHOLD(:)<ZMAXTIME(:))
+ &MIN(1., MAX(0., -SIGN(1., XRTMIN(6)-ZRHT(JL))) + & !WHERE(ZRHT(:)>XRTMIN(6)) .OR.
+ &MAX(0., -SIGN(1., -ZA_RH(JL)))) !WHERE(ZA_RH(:)>0.)
+ ZMAXTIME(JL)=(1.-ZW1D(JL)) * ZMAXTIME(JL) + &
+ &ZW1D(JL)*MIN(ZMAXTIME(JL), ZTIME_THRESHOLD(JL))
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
ENDIF
- GWORK(:) = IITER(:)<INB_ITER_MAX .AND. MAX(ABS(ZB_RV(:)), ABS(ZB_RC(:)), ABS(ZB_RR(:)), ABS(ZB_RI(:)), &
- ABS(ZB_RS(:)), ABS(ZB_RG(:)), ABS(ZB_RH(:)))>XMRSTEP
- WHERE( GWORK(:) )
- ZMAXTIME(:)=0.
- LLCOMPUTE(:)=.FALSE.
- ENDWHERE
-!$acc end kernels
+ DO JL=1, IMICRO
+ ZW1D(JL)=MAX(ABS(ZB_RV(JL)), ABS(ZB_RC(JL)), ABS(ZB_RR(JL)), ABS(ZB_RI(JL)), &
+ &ABS(ZB_RS(JL)), ABS(ZB_RG(JL)), ABS(ZB_RH(JL)))
+ ZW1D(JL)=MAX(0., -SIGN(1., IITER(JL)-INB_ITER_MAX+0.)) * & !WHERE(IITER(:)<INB_ITER_MAX)
+ &MAX(0., -SIGN(1., XMRSTEP-ZW1D(JL))) !WHERE(ZW1D(:)>XMRSTEP)
+ ZMAXTIME(JL)=(1.-ZW1D(JL))*ZMAXTIME(JL)
+ ZCOMPUTE(JL)=ZCOMPUTE(JL) * (1. - ZW1D(JL))
+ ENDDO
ENDIF
-!$acc kernels
!
!*** 4.3 New values of variables for next iteration
!
- ZTHT(: ) = ZTHT(: ) + ZA_TH(: ) * ZMAXTIME(: ) + ZB_TH(: )
- ZRVT(: ) = ZRVT(: ) + ZA_RV(: ) * ZMAXTIME(: ) + ZB_RV(: )
- ZRCT(: ) = ZRCT(: ) + ZA_RC(: ) * ZMAXTIME(: ) + ZB_RC(: )
- ZRRT(: ) = ZRRT(: ) + ZA_RR(: ) * ZMAXTIME(: ) + ZB_RR(: )
- ZRIT(: ) = ZRIT(: ) + ZA_RI(: ) * ZMAXTIME(: ) + ZB_RI(: )
- ZRST(: ) = ZRST(: ) + ZA_RS(: ) * ZMAXTIME(: ) + ZB_RS(: )
- ZRGT(: ) = ZRGT(: ) + ZA_RG(: ) * ZMAXTIME(: ) + ZB_RG(: )
- IF(KRR==7) ZRHT(: ) = ZRHT(: ) + ZA_RH(: ) * ZMAXTIME(: ) + ZB_RH(: )
- WHERE(ZRIT(:)==0.)
- ZCIT(:) = 0.
- END WHERE
+ DO JL=1, IMICRO
+ ZTHT(JL)=ZTHT(JL)+ZA_TH(JL)*ZMAXTIME(JL)+ZB_TH(JL)
+ ZRVT(JL)=ZRVT(JL)+ZA_RV(JL)*ZMAXTIME(JL)+ZB_RV(JL)
+ ZRCT(JL)=ZRCT(JL)+ZA_RC(JL)*ZMAXTIME(JL)+ZB_RC(JL)
+ ZRRT(JL)=ZRRT(JL)+ZA_RR(JL)*ZMAXTIME(JL)+ZB_RR(JL)
+ ZRIT(JL)=ZRIT(JL)+ZA_RI(JL)*ZMAXTIME(JL)+ZB_RI(JL)
+ ZRST(JL)=ZRST(JL)+ZA_RS(JL)*ZMAXTIME(JL)+ZB_RS(JL)
+ ZRGT(JL)=ZRGT(JL)+ZA_RG(JL)*ZMAXTIME(JL)+ZB_RG(JL)
+ ZCIT(JL)=ZCIT(JL) * MAX(0., -SIGN(1., -ZRIT(JL))) ! WHERE(ZRIT(:)==0.) ZCIT(:) = 0.
+ ENDDO
+ IF(KRR==7) ZRHT(:)=ZRHT(:)+ZA_RH(:)*ZMAXTIME(:)+ZB_RH(:)
!
!*** 4.4 Mixing ratio change due to each process
!
@@ -1343,7 +1473,7 @@ DO WHILE(ANY(ZTIME(:)<PTSTEP)) ! Loop to *really* compute tendencies
GSOFT=.TRUE. ! We try to adjust tendencies (inner while loop)
ZTIME(:)=ZTIME(:)+ZMAXTIME(:)
!$acc end kernels
-!$acc update self(LLCOMPUTE)
+!$acc update self(ZCOMPUTE)
ENDDO
!$acc update self(ZTIME)
ENDDO
@@ -1355,14 +1485,38 @@ ENDDO
! !$acc kernels
IF(IMICRO>0) THEN
!$acc kernels
+ ZHLC_HCF3D(:,:,:)=0.
+ ZHLC_LCF3D(:,:,:)=0.
+ ZHLC_HRC3D(:,:,:)=0.
+ ZHLC_LRC3D(:,:,:)=0.
+ ZHLI_HCF3D(:,:,:)=0.
+ ZHLI_LCF3D(:,:,:)=0.
+ ZHLI_HRI3D(:,:,:)=0.
+ ZHLI_LRI3D(:,:,:)=0.
!$acc loop independent
DO JL=1,IMICRO
+ ZHLC_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HCF(JL)
+ ZHLC_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LCF(JL)
+ ZHLC_HRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_HRC(JL)
+ ZHLC_LRC3D(I1(JL), I2(JL), I3(JL)) = ZHLC_LRC(JL)
+ ZHLI_LCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LCF(JL)
+ ZHLI_HCF3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HCF(JL)
+ ZHLI_HRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_HRI(JL)
+ ZHLI_LRI3D(I1(JL), I2(JL), I3(JL)) = ZHLI_LRI(JL)
PCIT(I1(JL), I2(JL), I3(JL)) = ZCIT(JL)
END DO
!$acc end kernels
ELSE
!$acc kernels
PRAINFR(:,:,:)=0.
+ ZHLC_HCF3D(:,:,:)=0.
+ ZHLC_LCF3D(:,:,:)=0.
+ ZHLC_HRC3D(:,:,:)=0.
+ ZHLC_LRC3D(:,:,:)=0.
+ ZHLI_HCF3D(:,:,:)=0.
+ ZHLI_LCF3D(:,:,:)=0.
+ ZHLI_HRI3D(:,:,:)=0.
+ ZHLI_LRI3D(:,:,:)=0.
PCIT(:,:,:) = 0.
!$acc end kernels
ENDIF
@@ -1382,19 +1536,32 @@ ENDIF
GDNOTMICRO = .NOT.ODMICRO
ZLSFACT3D(:,:,:) = ZZ_LSFACT(:,:,:)/PEXN(:,:,:)
!$acc end kernels
-CALL ICE4_NUCLEATION_WRAPPER(IIT, IJT, IKT, GDNOTMICRO, &
+CALL ICE4_NUCLEATION_WRAPPER(KIT, KJT, KKT, GDNOTMICRO, &
PTHT, PPABST, PRHODREF, PEXN, ZLSFACT3D, ZT, &
PRVT, &
PCIT, ZZ_RVHENI_MR)
!$acc kernels
-ZZ_LSFACT(:,:,:)=ZZ_LSFACT(:,:,:)/PEXNREF(:,:,:)
-ZZ_LVFACT(:,:,:)=ZZ_LVFACT(:,:,:)/PEXNREF(:,:,:)
-ZZ_RVHENI(:,:,:) = MIN(PRVS(:,:,:), ZZ_RVHENI_MR(:,:,:)/PTSTEP)
-PRIS(:,:,:)=PRIS(:,:,:)+ZZ_RVHENI(:,:,:)
-PRVS(:,:,:)=PRVS(:,:,:)-ZZ_RVHENI(:,:,:)
-PTHS(:,:,:)=PTHS(:,:,:) + ZZ_RVHENI(:,:,:)*ZZ_LSFACT(:,:,:)
+DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZZ_LSFACT(JI,JJ,JK)=ZZ_LSFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
+ ZZ_LVFACT(JI,JJ,JK)=ZZ_LVFACT(JI,JJ,JK)/PEXNREF(JI,JJ,JK)
+ ZZ_RVHENI(JI,JJ,JK) = MIN(PRVS(JI,JJ,JK), ZZ_RVHENI_MR(JI,JJ,JK)/PTSTEP)
+ PRIS(JI,JJ,JK)=PRIS(JI,JJ,JK)+ZZ_RVHENI(JI,JJ,JK)
+ PRVS(JI,JJ,JK)=PRVS(JI,JJ,JK)-ZZ_RVHENI(JI,JJ,JK)
+ PTHS(JI,JJ,JK)=PTHS(JI,JJ,JK) + ZZ_RVHENI(JI,JJ,JK)*ZZ_LSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
!$acc end kernels
!$acc update self(PRIS,PRVS,PTHS)
+!
+if ( lbu_enable ) then
+ !Note: there is an other contribution for HENU later
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'HENU', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'HENU', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HENU', zz_rvheni(:, :, :) * prhodj(:, :, :) )
+end if
!-------------------------------------------------------------------------------
!
!* 7. UNPACKING AND TOTAL TENDENCIES
@@ -1408,14 +1575,16 @@ PTHS(:,:,:)=PTHS(:,:,:) + ZZ_RVHENI(:,:,:)*ZZ_LSFACT(:,:,:)
!$acc kernels
IF(GEXT_TEND) THEN
!Z..T variables contain the exeternal tendency, we substract it
- ZRVT(:) = ZRVT(:) - ZEXT_RV(:) * PTSTEP
- ZRCT(:) = ZRCT(:) - ZEXT_RC(:) * PTSTEP
- ZRRT(:) = ZRRT(:) - ZEXT_RR(:) * PTSTEP
- ZRIT(:) = ZRIT(:) - ZEXT_RI(:) * PTSTEP
- ZRST(:) = ZRST(:) - ZEXT_RS(:) * PTSTEP
- ZRGT(:) = ZRGT(:) - ZEXT_RG(:) * PTSTEP
+ DO JL=1, IMICRO
+ ZRVT(JL) = ZRVT(JL) - ZEXT_RV(JL) * PTSTEP
+ ZRCT(JL) = ZRCT(JL) - ZEXT_RC(JL) * PTSTEP
+ ZRRT(JL) = ZRRT(JL) - ZEXT_RR(JL) * PTSTEP
+ ZRIT(JL) = ZRIT(JL) - ZEXT_RI(JL) * PTSTEP
+ ZRST(JL) = ZRST(JL) - ZEXT_RS(JL) * PTSTEP
+ ZRGT(JL) = ZRGT(JL) - ZEXT_RG(JL) * PTSTEP
+ ZTHT(JL) = ZTHT(JL) - ZEXT_TH(JL) * PTSTEP
+ ENDDO
IF (KRR==7) ZRHT(:) = ZRHT(:) - ZEXT_RH(:) * PTSTEP
- ZTHT(:) = ZTHT(:) - ZEXT_TH(:) * PTSTEP
ENDIF
!$acc end kernels
!$acc update self(ZRVT)
@@ -1584,10 +1753,33 @@ ZW_RGS(:,:,:) = PRGS(:,:,:) + ZW_RGS(:,:,:)
IF(KRR==7) ZW_RHS(:,:,:) = PRHS(:,:,:) + ZW_RHS(:,:,:)
ZW_THS(:,:,:) = PTHS(:,:,:) + ZW_THS(:,:,:)
!$acc end kernels
+
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'CORR', zw_ths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'CORR', zw_rvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'CORR', zw_rcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'CORR', zw_rrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'CORR', zw_ris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'CORR', zw_rss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'CORR', zw_rgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'CORR', zw_rhs(:, :, :) * prhodj(:, :, :) )
+end if
+
!We correct negativities with conservation
-CALL CORRECT_NEGATIVITIES(KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
+CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, ZW_RVS, ZW_RCS, ZW_RRS, &
&ZW_RIS, ZW_RSS, ZW_RGS, &
&ZW_THS, ZZ_LVFACT, ZZ_LSFACT, ZW_RHS)
+
+if ( lbu_enable ) then
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'CORR', zw_ths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'CORR', zw_rvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'CORR', zw_rcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'CORR', zw_rrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'CORR', zw_ris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'CORR', zw_rss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'CORR', zw_rgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'CORR', zw_rhs(:, :, :) * prhodj(:, :, :) )
+end if
!
!*** 7.2 LBU_ENABLE case
!
@@ -1596,417 +1788,337 @@ IF(LBU_ENABLE) THEN
CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_RED','OpenACC: LBU_ENABLE=.true. not yet implemented')
#endif
!$acc update self(ZINV_TSTEP)
+
+ allocate( zw1( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw2( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw3( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw4( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ if ( krr == 7 ) then
+ allocate( zw5( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ allocate( zw6( size( pexnref, 1 ), size( pexnref, 2 ), size( pexnref, 3 ) ) )
+ end if
+
+ if ( lbudget_th ) then
+ allocate( zz_diff( size( zz_lsfact, 1 ), size( zz_lsfact, 2 ), size( zz_lsfact, 3 ) ) )
+ zz_diff(:, :, :) = zz_lsfact(:, :, :) - zz_lvfact(:, :, :)
+ end if
+
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVHENI(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
- PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'HENU_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'HENU_BU_RRV')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HENU_BU_RRI')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HENU', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'HENU', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HENU', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCHONI(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'HON_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'HON_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'HON_BU_RRI')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRHONG(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'SFR_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'SFR_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'SFR_BU_RRG')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPS(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
- PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DEPS_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'DEPS_BU_RRV')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DEPS_BU_RRS')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAGGS(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'AGGS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AGGS_BU_RRS')
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIAUTS(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'AUTS_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'AUTS_BU_RRS')
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RVDEPG(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PRVS(:,:,:) = PRVS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*ZZ_LSFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DEPG_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'DEPG_BU_RRV')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DEPG_BU_RRG')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', zw(:, :, :) * zz_lsfact(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', zw(:, :, :) * prhodj(:, :, :) )
IF(OWARM) THEN
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCAUTR(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'AUTO_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'AUTO_BU_RRR')
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCACCR(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'ACCR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'ACCR_BU_RRR')
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RREVAV(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRVS(:,:,:) = PRVS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*ZZ_LVFACT(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'REVA_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'REVA_BU_RRV')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'REVA_BU_RRR')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', -zw(:, :, :) * zz_lvfact(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', -zw(:, :, :) * prhodj(:, :, :) )
ENDIF
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSS(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RCRIMSG(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RSRIMCG(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'RIM_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'RIM_BU_RRC')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'RIM_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'RIM_BU_RRG')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'RIM', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'RIM', ( -zw1(:, :, :) - zw2(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'RIM', ( zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'RIM', ( zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSS(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRSS(:,:,:) = PRSS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRACCSG(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RSACCRG(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'ACC_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'ACC_BU_RRR')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'ACC_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'ACC_BU_RRG')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'ACC', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACC', ( -zw1(:, :, :) - zw2(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'ACC', ( zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'ACC', ( zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSMLTG(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'CMEL', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CMEL', zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCMLTSR(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'CMEL_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CMEL_BU_RRG')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'CMEL_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CMEL_BU_RRR')
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'CMEL', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CMEL', zw(:, :, :) * prhodj(:, :, :) )
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRRG(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRCFRIG(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RICFRR(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'CFRZ_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CFRZ_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'CFRZ_BU_RRI')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CFRZ_BU_RRG')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'CFRZ', zw2(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'CFRZ', ( -zw2(:, :, :) + zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'CFRZ', ( -zw1(:, :, :) - zw3(:, :, :) ) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'CFRZ', ( zw1(:, :, :) + zw2(:, :, :) ) * prhodj(:, :, :) )
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETG(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETG(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETG(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW4(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETG(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'WETG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'WETG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'WETG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'WETG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'WETG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'WETG_BU_RRG')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'WETG', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'WETG', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'WETG', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'WETG', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'WETG', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'WETG', ( zw1(:, :, :) + zw2(:, :, :) &
+ + zw3(:, :, :) + zw4(:, :, :) ) &
+ * prhodj(:, :, :) )
IF(KRR==7) THEN
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RWETGH(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'GHCV_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'GHCV_BU_RRH')
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GHCV', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'GHCV', zw(:, :, :) * prhodj(:, :, :) )
END IF
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYG(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYG(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYG(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW4(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYG(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DRYG_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'DRYG_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'DRYG_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'DRYG_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DRYG_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DRYG_BU_RRG')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYG', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYG', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYG', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYG', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYG', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYG', ( zw1(:, :, :) + zw2(:, :, :) &
+ + zw3(:, :, :) + zw4(:, :, :) ) &
+ * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGMLTR(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'GMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'GMLT_BU_RRR')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'GMLT_BU_RRG')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'GMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'GMLT', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'GMLT', -zw(:, :, :) * prhodj(:, :, :) )
IF(KRR==7) THEN
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCWETH(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRWETH(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIWETH(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW4(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSWETH(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW5(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
+ ZW5(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'WETH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'WETH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'WETH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'WETH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'WETH_BU_RRS')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'WETH_BU_RRH')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'WETH', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'WETH', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'WETH', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'WETH', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'WETH', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'WETH', -zw5(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'WETH', ( zw1(:, :, :) + zw2(:, :, :) + zw3(:, :, :) &
+ + zw4(:, :, :) + zw5(:, :, : ) ) &
+ * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGWETH(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'HGCV_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'HGCV_BU_RRH')
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'HGCV', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HGCV', zw(:, :, :) * prhodj(:, :, :) )
- ZW(:,:,:) = 0.
+ ZW1(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
+ ZW1(I1(JL), I2(JL), I3(JL)) = ZTOT_RCDRYH(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW2(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
+ ZW2(I1(JL), I2(JL), I3(JL)) = ZTOT_RRDRYH(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- ZW(:,:,:) = 0.
+ ZW3(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
+ ZW3(I1(JL), I2(JL), I3(JL)) = ZTOT_RIDRYH(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW4(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
+ ZW4(I1(JL), I2(JL), I3(JL)) = ZTOT_RSDRYH(JL) * ZINV_TSTEP
END DO
- PRSS(:,:,:) = PRSS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW5(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
+ ZW5(I1(JL), I2(JL), I3(JL)) = ZTOT_RGDRYH(JL) * ZINV_TSTEP
END DO
- PRGS(:,:,:) = PRGS(:,:,:) - ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) + ZW(:,:,:)
- ZW(:,:,:) = 0.
+ ZW6(:,:,:) = 0.
DO JL=1,IMICRO
- ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
+ ZW6(I1(JL), I2(JL), I3(JL)) = ZTOT_RDRYHG(JL) * ZINV_TSTEP
END DO
- PRHS(:,:,:) = PRHS(:,:,:) - ZW(:,:,:)
- PRGS(:,:,:) = PRGS(:,:,:) + ZW(:,:,:)
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'DRYH_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'DRYH_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'DRYH_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'DRYH_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'DRYH_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'DRYH_BU_RRG')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'DRYH_BU_RRH')
+ if ( lbudget_th ) &
+ call Budget_store_add( tbudgets(NBUDGET_TH), 'DRYH', ( zw1(:, :, :) + zw2(:, :, :) ) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'DRYH', -zw1(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'DRYH', -zw2(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'DRYH', -zw3(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DRYH', -zw4(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DRYH', ( -zw5(:, :, :) + zw6(:, :, : ) ) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'DRYH', ( zw1(:, :, :) + zw2(:, :, :) + zw3(:, :, :) &
+ + zw4(:, :, :) + zw5(:, :, : )- zw6(:, :, :) ) &
+ * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RHMLTR(JL) * ZINV_TSTEP
END DO
- PRRS(:,:,:) = PRRS(:,:,:) + ZW(:,:,:)
- PRHS(:,:,:) = PRHS(:,:,:) - ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'HMLT_BU_RTH')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'HMLT_BU_RRR')
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'HMLT_BU_RRH')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'HMLT', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_add( tbudgets(NBUDGET_RH), 'HMLT', -zw(:, :, :) * prhodj(:, :, :) )
ENDIF
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RIMLTC(JL) * ZINV_TSTEP
END DO
- PRIS(:,:,:) = PRIS(:,:,:) - ZW(:,:,:)
- PRCS(:,:,:) = PRCS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'IMLT_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'IMLT_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'IMLT_BU_RRI')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'IMLT', -zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'IMLT', zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'IMLT', -zw(:, :, :) * prhodj(:, :, :) )
ZW(:,:,:) = 0.
DO JL=1,IMICRO
ZW(I1(JL), I2(JL), I3(JL)) = ZTOT_RCBERI(JL) * ZINV_TSTEP
END DO
- PRCS(:,:,:) = PRCS(:,:,:) - ZW(:,:,:)
- PRIS(:,:,:) = PRIS(:,:,:) + ZW(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) + ZW(:,:,:)*(ZZ_LSFACT(:,:,:)-ZZ_LVFACT(:,:,:))
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'BERFI_BU_RTH')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'BERFI_BU_RRC')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'BERFI_BU_RRI')
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'BERFI', zw(:, :, :) * zz_diff(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'BERFI', -zw(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'BERFI', zw(:, :, :) * prhodj(:, :, :) )
+
+ deallocate( zw1, zw2, zw3, zw4 )
+ if ( krr == 7 ) deallocate( zw5, zw6 )
+ if ( lbudget_th ) deallocate( zz_diff )
ENDIF
!
!*** 7.3 Final tendencies
@@ -2023,18 +2135,6 @@ IF (KRR==7) THEN
ENDIF
PTHS(:,:,:) = ZW_THS(:,:,:)
!$acc end kernels
-IF(LBU_ENABLE) THEN
- IF (LBUDGET_TH) CALL BUDGET(PTHS(:,:,:)*PRHODJ(:,:,:), 4, 'CORR_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET(PRVS(:,:,:)*PRHODJ(:,:,:), 6, 'CORR_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET(PRCS(:,:,:)*PRHODJ(:,:,:), 7, 'CORR_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET(PRRS(:,:,:)*PRHODJ(:,:,:), 8, 'CORR_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET(PRIS(:,:,:)*PRHODJ(:,:,:), 9, 'CORR_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET(PRSS(:,:,:)*PRHODJ(:,:,:), 10,'CORR_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET(PRGS(:,:,:)*PRHODJ(:,:,:), 11,'CORR_BU_RRG')
- IF (KRR==7) THEN
- IF (LBUDGET_RH) CALL BUDGET(PRHS(:,:,:)*PRHODJ(:,:,:), 12,'CORR_BU_RRH')
- ENDIF
-ENDIF
!
!-------------------------------------------------------------------------------
!
@@ -2045,25 +2145,38 @@ IF(LSEDIM_AFTER) THEN
!
!* 8.1 sedimentation
!
+ if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !Init only if not osedic (to prevent crash with double init)
+ !Remark: the 2 source terms SEDI and DEPO could be mixed and stored in the same source term (SEDI)
+ ! if osedic=T and ldeposc=T (a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic ) &
+ call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
IF(HSEDIM=='STAT') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHS*PTSTEP, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_STAT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ,&
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCS*PTSTEP, PRRS, PRRS*PTSTEP, PRIS, PRIS*PTSTEP,&
&PRSS, PRSS*PTSTEP, PRGS, PRGS*PTSTEP,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
!$acc kernels
@@ -2073,20 +2186,20 @@ IF(LSEDIM_AFTER) THEN
ELSEIF(HSEDIM=='SPLI') THEN
!SR: It *seems* that we must have two separate calls for ifort
IF(KRR==7) THEN
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PINPRH=PINPRH, PRHT=PRHT, PRHS=PRHS, PFPR=PFPR)
ELSE
- CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKTB, IKTE, IKT, KKL, &
+ CALL ICE4_SEDIMENTATION_SPLIT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, IKTB, IKTE, KKT, KKL, &
&PTSTEP, KRR, OSEDIC, LDEPOSC, XVDEPOSC, PDZZ, &
&PRHODREF, PPABST, PTHT, PRHODJ, &
&PRCS, PRCT, PRRS, PRRT, PRIS, PRIT, PRSS, PRST, PRGS, PRGT,&
&PINPRC, PINDEP, PINPRR, ZINPRI, PINPRS, PINPRG, &
- &PSEA, PTOWN, &
+ &PSEA=PSEA, PTOWN=PTOWN, &
&PFPR=PFPR)
ENDIF
!$acc kernels
@@ -2102,7 +2215,7 @@ IF(LSEDIM_AFTER) THEN
! will be still active and will lead to negative values.
! We could prevent the algorithm to not consume too much a specie, instead we apply
! a correction here.
- CALL CORRECT_NEGATIVITIES(KRR, PRVS, PRCS, PRRS, &
+ CALL CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRVS, PRCS, PRRS, &
&PRIS, PRSS, PRGS, &
&PTHS, ZZ_LVFACT, ZZ_LSFACT, PRHS)
ELSE
@@ -2111,17 +2224,26 @@ IF(LSEDIM_AFTER) THEN
!
!* 8.2 budget storage
!
- IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:), 7 , 'SEDI_BU_RRC')
- IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:), 8 , 'SEDI_BU_RRR')
- IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:), 9 , 'SEDI_BU_RRI')
- IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:), 10, 'SEDI_BU_RRS')
- IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:), 11, 'SEDI_BU_RRG')
- IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:), 12, 'SEDI_BU_RRH')
- !
+ if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
+ !If osedic=T and ldeposc=T, DEPO is in fact mixed and stored with the SEDI source term
+ !(a warning is printed in ini_budget in that case)
+ if ( lbudget_rc .and. ldeposc .and. .not.osedic) &
+ call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
!sedimentation of rain fraction
- CALL ICE4_RAINFR_VERT(IIB, IIE, IIT, IJB, IJE, IJT, IKB, IKE, IKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP)
+ IF (PRESENT(PRHS)) THEN
+ CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP, PRHS(:,:,:)*PTSTEP)
+ ELSE
+ CALL ICE4_RAINFR_VERT(IIB, IIE, KIT, IJB, IJE, KJT, IKB, IKE, KKT, KKL, PRAINFR, PRRS(:,:,:)*PTSTEP, &
+ &PRSS(:,:,:)*PTSTEP, PRGS(:,:,:)*PTSTEP)
+ ENDIF
ENDIF
!
!
@@ -2153,16 +2275,18 @@ END IF
CONTAINS
!
- SUBROUTINE CORRECT_NEGATIVITIES(KRR, PRV, PRC, PRR, &
+ SUBROUTINE CORRECT_NEGATIVITIES(KIT, KJT, KKT, KRR, PRV, PRC, PRR, &
&PRI, PRS, PRG, &
&PTH, PLVFACT, PLSFACT, PRH)
!
IMPLICIT NONE
!
- INTEGER, INTENT(IN) :: KRR
- REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
- REAL, DIMENSION(:,:,:), INTENT(IN) :: PLVFACT, PLSFACT
- REAL, DIMENSION(:,:,:), OPTIONAL, INTENT(INOUT) :: PRH
+ INTEGER, INTENT(IN) :: KIT, KJT, KKT, KRR
+ REAL, DIMENSION(KIT, KJT, KKT), INTENT(INOUT) :: PRV, PRC, PRR, PRI, PRS, PRG, PTH
+ REAL, DIMENSION(KIT, KJT, KKT), INTENT(IN) :: PLVFACT, PLSFACT
+ REAL, DIMENSION(KIT, KJT, KKT), OPTIONAL, INTENT(INOUT) :: PRH
+ !
+ INTEGER :: JI, JJ, JK
!
!
LOGICAL, DIMENSION(:,:,:), allocatable :: GW
@@ -2193,83 +2317,96 @@ CONTAINS
!$acc kernels
!We correct negativities with conservation
! 1) deal with negative values for mixing ratio, except for vapor
- GW(:,:,:) = PRC(:,:,:)<0.
- WHERE(GW(:,:,:))
- PRV(:,:,:)=PRV(:,:,:)+PRC(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRC(:,:,:)*PLVFACT(:,:,:)
- PRC(:,:,:)=0.
- ENDWHERE
- GW(:,:,:) = PRR(:,:,:)<0.
- WHERE(GW(:,:,:))
- PRV(:,:,:)=PRV(:,:,:)+PRR(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRR(:,:,:)*PLVFACT(:,:,:)
- PRR(:,:,:)=0.
- ENDWHERE
- GW(:,:,:) = PRI(:,:,:)<0.
- WHERE(GW(:,:,:))
- PRV(:,:,:)=PRV(:,:,:)+PRI(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRI(:,:,:)*PLSFACT(:,:,:)
- PRI(:,:,:)=0.
- ENDWHERE
- GW(:,:,:) = PRS(:,:,:)<0.
- WHERE(GW(:,:,:))
- PRV(:,:,:)=PRV(:,:,:)+PRS(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRS(:,:,:)*PLSFACT(:,:,:)
- PRS(:,:,:)=0.
- ENDWHERE
- GW(:,:,:) = PRG(:,:,:)<0.
- WHERE(GW(:,:,:))
- PRV(:,:,:)=PRV(:,:,:)+PRG(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRG(:,:,:)*PLSFACT(:,:,:)
- PRG(:,:,:)=0.
- ENDWHERE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK) =PRC(JI,JJ,JK)-MAX(PRC(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+ PRC(JI,JJ,JK)=PRC(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRR(JI,JJ,JK)-MAX(PRR(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+ PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRI(JI,JJ,JK)-MAX(PRI(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRI(JI,JJ,JK)=PRI(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRS(JI,JJ,JK)-MAX(PRS(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
+
+ ZW(JI,JJ,JK) =PRG(JI,JJ,JK)-MAX(PRG(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+
IF(KRR==7) THEN
- GW(:,:,:) = PRH(:,:,:)<0.
- WHERE(GW(:,:,:))
- PRV(:,:,:)=PRV(:,:,:)+PRH(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-PRH(:,:,:)*PLSFACT(:,:,:)
- PRH(:,:,:)=0.
- ENDWHERE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK) =PRH(JI,JJ,JK)-MAX(PRH(JI,JJ,JK), 0.)
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
ENDIF
+
! 2) deal with negative vapor mixing ratio
- GW(:,:,:) = PRV(:,:,:)<0. .AND. PRC(:,:,:)+PRI(:,:,:)>0.
- WHERE(GW(:,:,:))
- ! for rc and ri, we keep ice fraction constant
- ZW(:,:,:)=MIN(1., -PRV(:,:,:)/(PRC(:,:,:)+PRI(:,:,:))) ! Proportion of rc+ri to convert into rv
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*(PRC(:,:,:)*PLVFACT(:,:,:)+PRI(:,:,:)*PLSFACT(:,:,:))
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)*(PRC(:,:,:)+PRI(:,:,:))
- PRC(:,:,:)=(1.-ZW(:,:,:))*PRC(:,:,:)
- PRI(:,:,:)=(1.-ZW(:,:,:))*PRI(:,:,:)
- ENDWHERE
- GW(:,:,:) = PRV(:,:,:)<0. .AND. PRR(:,:,:)>0.
- WHERE(GW(:,:,:))
- ZW(:,:,:)=MIN(PRR(:,:,:), -PRV(:,:,:)) ! Quantity of rr to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRR(:,:,:)=PRR(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLVFACT(:,:,:)
- ENDWHERE
- GW(:,:,:) = PRV(:,:,:)<0. .AND. PRS(:,:,:)>0.
- WHERE(GW(:,:,:))
- ZW(:,:,:)=MIN(PRS(:,:,:), -PRV(:,:,:)) ! Quantity of rs to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRS(:,:,:)=PRS(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLSFACT(:,:,:)
- ENDWHERE
- GW(:,:,:) = PRV(:,:,:)<0. .AND. PRG(:,:,:)>0.
- WHERE(GW(:,:,:))
- ZW(:,:,:)=MIN(PRG(:,:,:), -PRV(:,:,:)) ! Quantity of rg to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRG(:,:,:)=PRG(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLSFACT(:,:,:)
- ENDWHERE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ! for rc and ri, we keep ice fraction constant
+ ZW(JI,JJ,JK)=MIN(1., MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.) / &
+ &MAX(PRC(JI,JJ,JK)+PRI(JI,JJ,JK), 1.E-20)) ! Proportion of rc+ri to convert into rv
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)* &
+ &(PRC(JI,JJ,JK)*PLVFACT(JI,JJ,JK)+PRI(JI,JJ,JK)*PLSFACT(JI,JJ,JK))
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)*(PRC(JI,JJ,JK)+PRI(JI,JJ,JK))
+ PRC(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRC(JI,JJ,JK)
+ PRI(JI,JJ,JK)=(1.-ZW(JI,JJ,JK))*PRI(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRR(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rr to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRR(JI,JJ,JK)=PRR(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLVFACT(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRS(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rs to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRS(JI,JJ,JK)=PRS(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+
+ ZW(JI,JJ,JK)=MIN(MAX(PRG(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rg to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRG(JI,JJ,JK)=PRG(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
+
IF(KRR==7) THEN
- GW(:,:,:) = PRV(:,:,:)<0. .AND. PRH(:,:,:)>0.
- WHERE(GW(:,:,:))
- ZW(:,:,:)=MIN(PRH(:,:,:), -PRV(:,:,:)) ! Quantity of rh to convert into rv
- PRV(:,:,:)=PRV(:,:,:)+ZW(:,:,:)
- PRH(:,:,:)=PRH(:,:,:)-ZW(:,:,:)
- PTH(:,:,:)=PTH(:,:,:)-ZW(:,:,:)*PLSFACT(:,:,:)
- ENDWHERE
+ DO JK = 1, KKT
+ DO JJ = 1, KJT
+ DO JI = 1, KIT
+ ZW(JI,JJ,JK)=MIN(MAX(PRH(JI,JJ,JK), 0.), &
+ &MAX(XRTMIN(1)-PRV(JI,JJ,JK), 0.)) ! Quantity of rh to convert into rv
+ PRV(JI,JJ,JK)=PRV(JI,JJ,JK)+ZW(JI,JJ,JK)
+ PRH(JI,JJ,JK)=PRH(JI,JJ,JK)-ZW(JI,JJ,JK)
+ PTH(JI,JJ,JK)=PTH(JI,JJ,JK)-ZW(JI,JJ,JK)*PLSFACT(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ ENDDO
ENDIF
!$acc end kernels
!
@@ -2290,30 +2427,6 @@ CONTAINS
!$acc end data
!
END SUBROUTINE CORRECT_NEGATIVITIES
-!
- recursive subroutine quicksort(a, first, last)
- implicit none
- integer a(*), x, t
- integer first, last
- integer i, j
-
- x = a( (first+last) / 2 )
- i = first
- j = last
- do
- do while (a(i) < x)
- i=i+1
- end do
- do while (x < a(j))
- j=j-1
- end do
- if (i >= j) exit
- t = a(i); a(i) = a(j); a(j) = t
- i=i+1
- j=j-1
- end do
- if (first < i-1) call quicksort(a, first, i-1)
- if (j+1 < last) call quicksort(a, j+1, last)
- end subroutine quicksort
+!
END SUBROUTINE RAIN_ICE_RED
diff --git a/src/MNH/rain_ice_sedimentation_split.f90 b/src/MNH/rain_ice_sedimentation_split.f90
index f926782c10b0ee9c53d46502a5d047beb2c893f6..b826e9f75fa1bd0f5a6e983b4bd02ff2a4a8ed21 100644
--- a/src/MNH/rain_ice_sedimentation_split.f90
+++ b/src/MNH/rain_ice_sedimentation_split.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -8,6 +8,7 @@
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! P. Wautelet 25/06/2019: OpenACC: optimisation of rain_ice_sedimentation_split
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_SEDIMENTATION_SPLIT
@@ -28,7 +29,9 @@ SUBROUTINE RAIN_ICE_SEDIMENTATION_SPLIT( KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKT
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RG, LBUDGET_RH, LBUDGET_RI, LBUDGET_RR, LBUDGET_RS
+use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
use MODD_CST, only: XCPD, XP00, XRD, XRHOLW
use MODD_PARAM_ICE, only: XVDEPOSC
use MODD_RAIN_ICE_DESCR, only: XCC, XCONC_LAND, xconc_sea, xconc_urban, XDC, XCEXVT, &
@@ -36,6 +39,7 @@ use MODD_RAIN_ICE_DESCR, only: XCC, XCONC_LAND, xconc_sea, xconc_urban, XDC, XCE
use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
XFSEDG, XFSEDH, XFSEDI, XFSEDR, XFSEDS, XFSEDC
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_mppdb
#ifndef MNH_OPENACC
use mode_tools, only: Countjv
@@ -46,7 +50,6 @@ use mode_tools, only: Countjv_device
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
-use MODI_BUDGET
IMPLICIT NONE
!
@@ -223,6 +226,13 @@ IF ( PRESENT( PSEA ) ) THEN
ELSE
GPRESENT_PSEA = .FALSE.
END IF
+
+if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
!
! O. Initialization of for sedimentation
!
@@ -617,37 +627,19 @@ END DO
!
!* 2.3 budget storage
!
-IF (LBUDGET_RC .AND. OSEDIC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC')
-END IF
-IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR')
-END IF
-IF (LBUDGET_RI) THEN
-!$acc update self(PRIS)
- CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI')
-END IF
-IF (LBUDGET_RS) THEN
-!$acc update self(PRSS)
- CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'SEDI_BU_RRS')
-END IF
-IF (LBUDGET_RG) THEN
-!$acc update self(PRGS)
- CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SEDI_BU_RRG')
-END IF
-IF ( KRR == 7 .AND. LBUDGET_RH) THEN
-!$acc update self(PRHS)
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'SEDI_BU_RRH')
-END IF
-!
-!
+if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
!
!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
!
-!$acc kernels
IF (ODEPOSC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
+!$acc kernels
GDEP(:,:) = .FALSE.
GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
WHERE (GDEP)
@@ -655,16 +647,11 @@ IF (ODEPOSC) THEN
PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
PINDEP(:,:) = XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
END WHERE
-END IF
!$acc end kernels
-!
-!* 2.5 budget storage
-!
-IF ( LBUDGET_RC .AND. ODEPOSC ) THEN
-!$acc update self(PRCS)
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
END IF
-!
+
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PINPRC,"RAIN_ICE_SEDIMENTATION_SPLIT end:PINPRC")
diff --git a/src/MNH/rain_ice_sedimentation_stat.f90 b/src/MNH/rain_ice_sedimentation_stat.f90
index ea8159805050ffbdd8517812747d09d87eb9fbaa..b892b004d030aa3bf0e57c4ffecece42ca21f670 100644
--- a/src/MNH/rain_ice_sedimentation_stat.f90
+++ b/src/MNH/rain_ice_sedimentation_stat.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -6,6 +6,7 @@
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_SEDIMENTATION_STAT
@@ -26,7 +27,9 @@ SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT( KIB, KIE, KJB, KJE, KKB, KKE, KKTB, KKTE
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RG, LBUDGET_RH, LBUDGET_RI, LBUDGET_RR, LBUDGET_RS
+use modd_budget, only: lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ tbudgets
use MODD_CST, only: XRHOLW
use MODD_PARAM_ICE, only: LDEPOSC, XVDEPOSC
use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
@@ -34,11 +37,10 @@ use MODD_RAIN_ICE_PARAM, only: XEXSEDG, XEXSEDH, XEXCSEDI, XEXSEDR, XEXSEDS, &
use MODD_RAIN_ICE_DESCR, only: XALPHAC, XALPHAC2, XCC, XCEXVT, XCONC_LAND, XCONC_SEA, XCONC_URBAN, &
XDC, XLBC, XLBEXC, XNUC, XNUC2, XRTMIN
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_msg
use mode_tools, only: Countjv
-use MODI_BUDGET
-
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -106,11 +108,18 @@ REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
REAL, DIMENSION(SIZE(PRHODREF,1),SIZE(PRHODREF,2),0:SIZE(PRHODREF,3)+1) &
:: ZWSEDW2 ! sedimentation speed
!-------------------------------------------------------------------------------
-!
+
#ifdef MNH_OPENACC
CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_SEDIMENTATION_STAT','OPENACC: not yet implemented')
#endif
-!
+
+if ( lbudget_rc .and. osedic ) call Budget_store_init( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
+
ZINVTSTEP=1./PTSTEP
!
!* 1. Parameters for cloud sedimentation
@@ -547,23 +556,21 @@ PINPRR3D (:,:,:) = 0.
ENDIF
!
-
-!
!* 2.3 budget storage
!
-IF (LBUDGET_RC .AND. OSEDIC) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'SEDI_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8 ,'SEDI_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRIS(:,:,:)*PRHODJ(:,:,:),9 ,'SEDI_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRSS(:,:,:)*PRHODJ(:,:,:),10,'SEDI_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRGS(:,:,:)*PRHODJ(:,:,:),11,'SEDI_BU_RRG')
-IF ( KRR == 7 .AND. LBUDGET_RH) &
- CALL BUDGET (PRHS(:,:,:)*PRHODJ(:,:,:),12,'SEDI_BU_RRH')
+if ( lbudget_rc .and. osedic ) call Budget_store_end( tbudgets(NBUDGET_RC), 'SEDI', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'SEDI', pris(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'SEDI', prss(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'SEDI', prgs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'SEDI', prhs(:, :, :) * prhodj(:, :, :) )
!
!
!* 2.4 DROPLET DEPOSITION AT THE 1ST LEVEL ABOVE GROUND
!
IF (LDEPOSC) THEN
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
+
GDEP(:,:) = .FALSE.
GDEP(KIB:KIE,KJB:KJE) = PRCS(KIB:KIE,KJB:KJE,KKB) >0
WHERE (GDEP)
@@ -571,13 +578,10 @@ IF (LDEPOSC) THEN
PINPRC(:,:) = PINPRC(:,:) + XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
PINDEP(:,:) = XVDEPOSC * PRCT(:,:,KKB) * PRHODREF(:,:,KKB) /XRHOLW
END WHERE
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'DEPO', prcs(:, :, :) * prhodj(:, :, :) )
END IF
-!
-!* 2.5 budget storage
-!
-IF ( LBUDGET_RC .AND. LDEPOSC ) &
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7 ,'DEPO_BU_RRC')
-!
+
END SUBROUTINE RAIN_ICE_SEDIMENTATION_STAT
END MODULE MODE_RAIN_ICE_SEDIMENTATION_STAT
diff --git a/src/MNH/rain_ice_slow.f90 b/src/MNH/rain_ice_slow.f90
index 7b325a112072c05d1f839231b8f868dd1e37f87a..2e4375102be35f9325762b62c581de6d8dbb34ed 100644
--- a/src/MNH/rain_ice_slow.f90
+++ b/src/MNH/rain_ice_slow.f90
@@ -1,10 +1,11 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_SLOW
@@ -16,29 +17,30 @@ MODULE MODE_RAIN_ICE_SLOW
CONTAINS
-SUBROUTINE RAIN_ICE_SLOW(OMICRO, PINVTSTEP, PRHODREF, &
- PRCT, PRRT, PRIT, PRST, PRGT, PRHODJ, PZT, PPRES, &
- PLSFACT, PLVFACT, &
- PSSI, PRHODJ3D, PTHS3D, PRVS3D, &
- PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, PTHS, &
+SUBROUTINE RAIN_ICE_SLOW(OMICRO, PINVTSTEP, PRHODREF, &
+ PRCT, PRRT, PRIT, PRST, PRGT, PRHODJ, PZT, PPRES, &
+ PLSFACT, PLVFACT, PSSI, &
+ PRVS, PRCS, PRRS, PRIS, PRSS, PRGS, PTHS, &
PAI, PCJ, PKA, PDV, PLBDAS, PLBDAG)
!
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RG, LBUDGET_RI, LBUDGET_RR, LBUDGET_RS, LBUDGET_RV, LBUDGET_TH
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, &
+ tbudgets
use MODD_CST, only: XALPI, XBETAI, XCI, XCPV, XGAMI, XLSTT, XMNH_HUGE_12_LOG, XP00, XRV, XTT
use MODD_RAIN_ICE_DESCR, only: XCEXVT, XLBDAS_MAX, XLBEXG, XLBEXS, XLBG, XLBS, XRTMIN
use MODD_RAIN_ICE_PARAM, only: X0DEPG, X0DEPS, X1DEPG, X1DEPS, XACRIAUTI, XALPHA3, XBCRIAUTI, XBETA3, XCOLEXIS, XCRIAUTI, &
XEX0DEPG, XEX0DEPS, XEX1DEPG, XEX1DEPS, XEXIAGGS, XFIAGGS, XHON, XSCFAC, XTEXAUTI, XTIMAUTI
-!
+
+use mode_budget, only: Budget_store_add
use mode_mppdb
-!
+
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
-use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -57,9 +59,6 @@ REAL, DIMENSION(:), intent(in) :: PPRES ! Pressure
REAL, DIMENSION(:), intent(in) :: PLSFACT ! L_s/(Pi_ref*C_ph)
REAL, DIMENSION(:), intent(in) :: PLVFACT ! L_v/(Pi_ref*C_ph)
REAL, DIMENSION(:), intent(in) :: PSSI ! Supersaturation over ice
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVS3D ! Water vapor m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
@@ -79,6 +78,7 @@ REAL, DIMENSION(:), intent(OUT) :: PLBDAG ! Slope parameter of the g
LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK
REAL, DIMENSION(:), ALLOCATABLE :: ZCRIAUTI ! Snow-to-ice autoconversion thres.
REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
+real, dimension(:), ALLOCATABLE :: zz_diff
!
!-------------------------------------------------------------------------------
!
@@ -86,7 +86,6 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW ! Work array
!
!$acc data present( OMICRO, PRHODREF, PRCT, PRRT, PRIT, PRST, PRGT, &
!$acc & PRHODJ, PZT, PPRES, PLSFACT, PLVFACT, PSSI, &
-!$acc & PRHODJ3D, PTHS3D, PRVS3D, &
!
! INOUT variables
!
@@ -111,9 +110,6 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PLSFACT,"RAIN_ICE_SLOW beg:PLSFACT")
CALL MPPDB_CHECK(PLVFACT,"RAIN_ICE_SLOW beg:PLVFACT")
CALL MPPDB_CHECK(PSSI,"RAIN_ICE_SLOW beg:PSSI")
- CALL MPPDB_CHECK(PRHODJ3D,"RAIN_ICE_SLOW beg:PRHODJ3D")
- CALL MPPDB_CHECK(PTHS3D,"RAIN_ICE_SLOW beg:PTHS3D")
- CALL MPPDB_CHECK(PRVS3D,"RAIN_ICE_SLOW beg:PRVS3D")
!Check all INOUT arrays
CALL MPPDB_CHECK(PRVS,"RAIN_ICE_SLOW beg:PRVS")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_SLOW beg:PRCS")
@@ -126,11 +122,14 @@ END IF
ALLOCATE( GWORK (size(PRHODREF)) )
ALLOCATE( ZZW (size(PRHODREF)) )
ALLOCATE( ZCRIAUTI(size(PRHODREF)) )
-!$acc data create( gwork, zzw, zcriauti )
+ALLOCATE( zz_diff (size(PLSFACT)) )
+!$acc data create( gwork, zzw, zcriauti, zz_diff )
!
!* 3.2 compute the homogeneous nucleation source: RCHONI
!
!$acc kernels
+ zz_diff(:) = plsfact(:) - plvfact(:)
+
ZZW(:) = 0.0
GWORK(:) = PZT(:)<XTT-35.0 .AND. PRCT(:)>XRTMIN(2) .AND. PRCS(:)>0.
WHERE( GWORK(:) )
@@ -142,22 +141,16 @@ ALLOCATE( ZCRIAUTI(size(PRHODREF)) )
#endif
PRIS(:) = PRIS(:) + ZZW(:)
PRCS(:) = PRCS(:) - ZZW(:)
- PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCHONI))
+ PTHS(:) = PTHS(:) + ZZW(:) * zz_diff(:) ! f(L_f*(RCHONI))
ENDWHERE
!$acc end kernels
-!
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'HON_BU_RTH')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'HON_BU_RRC')
- END IF
- IF (LBUDGET_RI) THEN
-!$acc update self(PRIS)
- CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'HON_BU_RRI')
- END IF
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'HON', &
+ Unpack( zzw(:) * zz_diff(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'HON', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'HON', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 3.3 compute the spontaneous freezing source: RRHONG
!
@@ -168,22 +161,16 @@ ALLOCATE( ZCRIAUTI(size(PRHODREF)) )
ZZW(:) = MIN( PRRS(:),PRRT(:)* PINVTSTEP )
PRGS(:) = PRGS(:) + ZZW(:)
PRRS(:) = PRRS(:) - ZZW(:)
- PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RRHONG))
+ PTHS(:) = PTHS(:) + ZZW(:) * zz_diff(:) ! f(L_f*(RRHONG))
ENDWHERE
!$acc end kernels
-!
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'SFR_BU_RTH')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'SFR_BU_RRR')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(PRGS)
- CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'SFR_BU_RRG')
- END IF
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'SFR', &
+ Unpack( zzw(:) * zz_diff(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'SFR', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'SFR', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 3.4 compute the deposition, aggregation and autoconversion sources
!
@@ -219,7 +206,7 @@ ALLOCATE( ZCRIAUTI(size(PRHODREF)) )
! ZZW(:) = MIN( PRCS(:),ZTIMAUTIC * MAX( SQRT( PRIT(:)*PRCT(:) ),0.0 ) )
! PRIS(:) = PRIS(:) + ZZW(:)
! PRCS(:) = PRCS(:) - ZZW(:)
-! PTHS(:) = PTHS(:) + ZZW(:)*(PLSFACT(:)-PLVFACT(:)) ! f(L_f*(RCAUTI))
+! PTHS(:) = PTHS(:) + ZZW(:) * zz_diff(:) ! f(L_f*(RCAUTI))
! END WHERE
!
!* 3.4.3 compute the deposition on r_s: RVDEPS
@@ -253,18 +240,13 @@ ALLOCATE( ZCRIAUTI(size(PRHODREF)) )
PTHS(:) = PTHS(:) + ZZW(:)*PLSFACT(:)
END WHERE
!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'DEPS_BU_RTH')
- END IF
- IF (LBUDGET_RV) THEN
-!$acc update self(PRVS)
- CALL BUDGET (UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:),6,'DEPS_BU_RRV')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(PRSS)
- CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'DEPS_BU_RRS')
- END IF
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPS', &
+ Unpack( zzw(:) * plsfact(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPS', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'DEPS', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 3.4.4 compute the aggregation on r_s: RIAGGS
!
@@ -287,14 +269,11 @@ ALLOCATE( ZCRIAUTI(size(PRHODREF)) )
PRIS(:) = PRIS(:) - ZZW(:)
END WHERE
!$acc end kernels
- IF (LBUDGET_RI) THEN
-!$acc update self(PRIS)
- CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'AGGS_BU_RRI')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(PRSS)
- CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'AGGS_BU_RRS')
- END IF
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AGGS', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AGGS', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 3.4.5 compute the autoconversion of r_i for r_s production: RIAUTS
!
@@ -318,14 +297,11 @@ ALLOCATE( ZCRIAUTI(size(PRHODREF)) )
PRIS(:) = PRIS(:) - ZZW(:)
END WHERE
!$acc end kernels
- IF (LBUDGET_RI) THEN
-!$acc update self(PRIS)
- CALL BUDGET (UNPACK(PRIS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),9,'AUTS_BU_RRI')
- END IF
- IF (LBUDGET_RS) THEN
-!$acc update self(PRSS)
- CALL BUDGET (UNPACK(PRSS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),10,'AUTS_BU_RRS')
- END IF
+
+ if ( lbudget_ri ) call Budget_store_add( tbudgets(NBUDGET_RI), 'AUTS', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rs ) call Budget_store_add( tbudgets(NBUDGET_RS), 'AUTS', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 3.4.6 compute the deposition on r_g: RVDEPG
!
@@ -358,19 +334,13 @@ ALLOCATE( ZCRIAUTI(size(PRHODREF)) )
PTHS(:) = PTHS(:) + ZZW(:)*PLSFACT(:)
END WHERE
!$acc end kernels
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'DEPG_BU_RTH')
- END IF
- IF (LBUDGET_RV) THEN
-!$acc update self(PRVS)
- CALL BUDGET (UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:),6,'DEPG_BU_RRV')
- END IF
- IF (LBUDGET_RG) THEN
-!$acc update self(PRGS)
- CALL BUDGET (UNPACK(PRGS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),11,'DEPG_BU_RRG')
- END IF
-!
+
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'DEPG', &
+ Unpack( zzw(:) * plsfact(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'DEPG', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rg ) call Budget_store_add( tbudgets(NBUDGET_RG), 'DEPG', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
IF (MPPDB_INITIALIZED) THEN
!Check all INOUT arrays
CALL MPPDB_CHECK(PRVS,"RAIN_ICE_SLOW end:PRVS")
diff --git a/src/MNH/rain_ice_warm.f90 b/src/MNH/rain_ice_warm.f90
index 6c5a6ad90cb06d458af51c14d4bc80395ea46ca2..714d6a9659894772ced2711f5cb1543de290b2ba 100644
--- a/src/MNH/rain_ice_warm.f90
+++ b/src/MNH/rain_ice_warm.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -6,6 +6,7 @@
! Modifications:
! P. Wautelet 25/02/2019: split rain_ice (cleaner and easier to maintain/debug)
! P. Wautelet 03/06/2019: remove PACK/UNPACK intrinsics (to get more performance and better OpenACC support)
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-----------------------------------------------------------------
MODULE MODE_RAIN_ICE_WARM
@@ -20,25 +21,27 @@ CONTAINS
SUBROUTINE RAIN_ICE_WARM(OMICRO, KMICRO, K1, K2, K3, &
PRHODREF, PRVT, PRCT, PRRT, PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
PRHODJ, PPRES, PZT, PLBDAR, PLBDAR_RF, PLVFACT, PCJ, PKA, PDV, PRF, PCF, PTHT, PTHLT, &
- PRHODJ3D, PTHS3D, PRVS3D, PRVS, PRCS, PRRS, PTHS, PUSW, PEVAP3D)
+ PRVS, PRCS, PRRS, PTHS, PUSW, PEVAP3D)
!
!* 0. DECLARATIONS
! ------------
!
-use MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RR, LBUDGET_RV, LBUDGET_TH
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, &
+ tbudgets
use MODD_CST, only: XALPW, XBETAW, XCL, XCPV, XGAMW, XLVTT, XMD, XMV, XRV, XTT
use MODD_PARAM_ICE, only: CSUBG_RC_RR_ACCR, CSUBG_RR_EVAP
use MODD_RAIN_ICE_DESCR, only: XCEXVT, XRTMIN
use MODD_RAIN_ICE_PARAM, only: X0EVAR, X1EVAR, XCRIAUTC, XEX0EVAR, XEX1EVAR, XEXCACCR, XFCACCR, XTIMAUTC
-!
+
+use mode_budget, only: Budget_store_add
use mode_mppdb
use MODE_MSG
-!
+
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
-use MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -70,9 +73,6 @@ REAL, DIMENSION(:), intent(in) :: PRF ! Rain fraction
REAL, DIMENSION(:), intent(in) :: PCF ! Cloud fraction
REAL, DIMENSION(:), intent(in) :: PTHT ! Potential temperature
REAL, DIMENSION(:), intent(in) :: PTHLT ! Liquid potential temperature
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ3D ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHS3D ! Theta source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVS3D ! Water vapor m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRVS ! Water vapor m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRCS ! Cloud water m.r. source
REAL, DIMENSION(:), INTENT(INOUT) :: PRRS ! Rain water m.r. source
@@ -98,7 +98,6 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZZW4 ! Work array
!$acc & PHLC_HCF, PHLC_LCF, PHLC_HRC, PHLC_LRC, &
!$acc & PRHODJ, PPRES, PZT, PLBDAR, PLBDAR_RF, PLVFACT, &
!$acc & PCJ, PKA, PDV, PRF, PCF, PTHT,PTHLT, &
-!$acc & PRHODJ3D, PTHS3D, PRVS3D, &
!
! INOUT variables
!
@@ -132,9 +131,6 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PCF,"RAIN_ICE_WARM beg:PCF")
CALL MPPDB_CHECK(PTHT,"RAIN_ICE_WARM beg:PTHT")
CALL MPPDB_CHECK(PTHLT,"RAIN_ICE_WARM beg:PTHLT")
- CALL MPPDB_CHECK(PRHODJ3D,"RAIN_ICE_WARM beg:PRHODJ3D")
- CALL MPPDB_CHECK(PTHS3D,"RAIN_ICE_WARM beg:PTHS3D")
- CALL MPPDB_CHECK(PRVS3D,"RAIN_ICE_WARM beg:PRVS3D")
!Check all INOUT arrays
CALL MPPDB_CHECK(PRVS,"RAIN_ICE_WARM beg:PRVS")
CALL MPPDB_CHECK(PRCS,"RAIN_ICE_WARM beg:PRCS")
@@ -155,6 +151,7 @@ ALLOCATE( ZZW4 (size(PRHODREF)) )
!* 4.2 compute the autoconversion of r_c for r_r production: RCAUTR
!
!$acc kernels
+ zzw(:) = 0.
GWORK(:) = PRCS(:)>0.0 .AND. PHLC_HCF(:)>0.0
WHERE( GWORK(:) )
ZZW(:) = XTIMAUTC*MAX( PHLC_HRC(:)/PHLC_HCF(:) - XCRIAUTC/PRHODREF(:),0.0)
@@ -163,18 +160,15 @@ ALLOCATE( ZZW4 (size(PRHODREF)) )
PRRS(:) = PRRS(:) + ZZW(:)
END WHERE
!$acc end kernels
-!
- IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'AUTO_BU_RRC')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'AUTO_BU_RRR')
- END IF
+
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'AUTO', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'AUTO', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 4.3 compute the accretion of r_c for r_r production: RCACCR
!
+ zzw(:) = 0.
IF (CSUBG_RC_RR_ACCR=='NONE') THEN
!$acc kernels
!CLoud water and rain are diluted over the grid box
@@ -244,19 +238,13 @@ ALLOCATE( ZZW4 (size(PRHODREF)) )
!$acc end kernels
ELSE
- !wrong CSUBG_RC_RR_ACCR case
- WRITE(*,*) 'wrong CSUBG_RC_RR_ACCR case'
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','')
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_WARM', 'invalid CSUBG_RC_RR_ACCR value: '//Trim(csubg_rc_rr_accr) )
ENDIF
- IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (UNPACK(PRCS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),7,'ACCR_BU_RRC')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'ACCR_BU_RRR')
- END IF
+ if ( lbudget_rc ) call Budget_store_add( tbudgets(NBUDGET_RC), 'ACCR', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'ACCR', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!
!* 4.4 compute the evaporation of r_r: RREVAV
!
@@ -356,21 +344,15 @@ ALLOCATE( ZZW4 (size(PRHODREF)) )
!$acc end kernels
ELSE
- CALL PRINT_MSG(NVERB_FATAL,'GEN','RAIN_ICE_WARM','wrong CSUBG_RR_EVAP case')
+ call Print_msg( NVERB_FATAL, 'GEN', 'RAIN_ICE_WARM', 'invalid CSUBG_RR_EVAP value: '//Trim( csubg_rr_evap ) )
END IF
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (UNPACK(PTHS(:),MASK=OMICRO(:,:,:),FIELD=PTHS3D)*PRHODJ3D(:,:,:),4,'REVA_BU_RTH')
- END IF
- IF (LBUDGET_RV) THEN
-!$acc update self(PRVS)
- CALL BUDGET (UNPACK(PRVS(:),MASK=OMICRO(:,:,:),FIELD=PRVS3D)*PRHODJ3D(:,:,:),6,'REVA_BU_RRV')
- END IF
- IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (UNPACK(PRRS(:)*PRHODJ(:),MASK=OMICRO(:,:,:),FIELD=0.0),8,'REVA_BU_RRR')
- END IF
+ if ( lbudget_th ) call Budget_store_add( tbudgets(NBUDGET_TH), 'REVA', &
+ Unpack( -zzw(:) * plvfact(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rv ) call Budget_store_add( tbudgets(NBUDGET_RV), 'REVA', &
+ Unpack( zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
+ if ( lbudget_rr ) call Budget_store_add( tbudgets(NBUDGET_RR), 'REVA', &
+ Unpack( -zzw(:) * prhodj(:), mask = omicro(:,:,:), field = 0.) )
!$acc kernels
!$acc loop independent
diff --git a/src/MNH/read_albedo_data.f90 b/src/MNH/read_albedo_data.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0409608c8960b5284a0b7a3932e157f624980203
--- /dev/null
+++ b/src/MNH/read_albedo_data.f90
@@ -0,0 +1,64 @@
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_READ_ALBEDO_DATA
+! ######################
+!
+
+
+USE MODD_PARAM_ECRAD_n, ONLY : USER_ALB_DIFF, USER_ALB_DIR
+
+implicit none
+
+CONTAINS
+
+ SUBROUTINE READ_ALBEDO_DATA(SURF_TYPE)
+
+use easy_netcdf, only : netcdf_file
+use radiation_config, only: get_enum_code
+
+character(len=*), intent(in) :: SURF_TYPE
+
+!enum, bind(c)
+ ! enumerator IAlbedoSnow, &
+ ! & IAlbedoGrass
+ !end enum
+character(len=*), parameter :: AlbedoModelName(0:5) = (/ 'OCEA', &
+ & 'VEGE',&
+ & 'DESE',&
+ & 'SNOW',&
+ & 'ZERO',&
+ & 'UNIT' /)
+
+type(netcdf_file) :: file
+character(len=255) :: albedo_data_name
+integer :: NALB
+real, allocatable :: ALL_ALB_DIFF(:,:)
+real, allocatable :: ALL_ALB_DIR(:,:)
+
+albedo_data_name = '/home/liboisq/MesoNH/MNH-V5-4-4/src/QUENTIN/ecrad-1.4.0/data/spectral_albedo.nc'
+
+! Determine albedo model
+call get_enum_code(SURF_TYPE, AlbedoModelName, &
+ & ' ', NALB)
+
+! Open the file and configure the way it is read
+call file%open(trim(albedo_data_name), iverbose=1)
+call file%transpose_matrices()
+
+! Read the albedos
+call file%get_real_matrix('albedo_diff', ALL_ALB_DIFF)
+call file%get_real_matrix('albedo_dir', ALL_ALB_DIR)
+USER_ALB_DIFF(:) = ALL_ALB_DIFF(NALB+1,:) ! because index starts at 0
+USER_ALB_DIR(:) = ALL_ALB_DIR(NALB+1,:)
+
+call file%close()
+
+
+END SUBROUTINE READ_ALBEDO_DATA
+
+END MODULE MODI_READ_ALBEDO_DATA
+
diff --git a/src/MNH/read_all_data_grib_case.f90 b/src/MNH/read_all_data_grib_case.f90
index a8178a0be6fb189500b2977c055ecec45d8db4fe..84c13799185ffe6e85d837934b7348cf51c022f6 100644
--- a/src/MNH/read_all_data_grib_case.f90
+++ b/src/MNH/read_all_data_grib_case.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.
@@ -131,7 +131,11 @@ END MODULE MODI_READ_ALL_DATA_GRIB_CASE
!! 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
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-! Q. Rodier 16/09/2019: switch of GRIB number ID for Orograpgy in ARPEGE/AROME in EPyGrAM
+! Q. Rodier 16/09/2019: switch of GRIB number ID for orography in ARPEGE/AROME in EPyGrAM
+! Q. Rodier 27/01/2020: switch of GRIB number ID for orography and hydrometeors in ARPEGE/AROME in EPyGrAM v1.3.7
+! Q. Rodier 21/04/2020: correction GFS u and v wind component written in the right vertical order
+! Q. Rodier 02/09/2020: Read and interpol geopotential height for interpolation on isobaric surface Grid of NCEP
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -150,10 +154,7 @@ USE MODI_READ_VER_GRID
USE MODI_XYTOLATLON
USE MODI_HORIBL
USE MODI_INI_NSV
-USE MODI_CH_INIT_SCHEME_n
USE MODI_REMOVAL_VORTEX
-USE MODI_CH_INIT_CCS
-USE MODI_CH_AER_INIT_SOA
USE MODI_INI_CTURB
USE MODI_CH_OPEN_INPUT
!
@@ -204,7 +205,7 @@ INTEGER :: ILUOUT0 ! Unit used for output msg.
INTEGER :: IRESP ! Return code of FM-routines
INTEGER :: IRET ! Return code from subroutines
INTEGER(KIND=kindOfInt) :: IRET_GRIB ! Return code from subroutines
-INTEGER, PARAMETER :: JP_GFS=26 ! number of pressure levels for GFS model
+INTEGER, PARAMETER :: JP_GFS=31 ! number of pressure levels for GFS model
REAL :: ZA,ZB,ZC ! Dummy variables
REAL :: ZD,ZE,ZF ! |
REAL :: ZTEMP ! |
@@ -312,6 +313,7 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZPF_G ! Pressure (flux point)
REAL, DIMENSION(:,:), ALLOCATABLE :: ZPM_G ! Pressure (mass point)
REAL, DIMENSION(:,:), ALLOCATABLE :: ZEXNF_G ! Exner fct. (flux point)
REAL, DIMENSION(:,:), ALLOCATABLE :: ZEXNM_G ! Exner fct. (mass point)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZGH_G ! Geopotential Height
REAL, DIMENSION(:,:), ALLOCATABLE :: ZT_G ! Temperature
REAL, DIMENSION(:,:), ALLOCATABLE :: ZQ_G ! Specific humidity
REAL, DIMENSION(:), ALLOCATABLE :: ZH_G ! Relative humidity
@@ -335,7 +337,7 @@ INTEGER :: IVERSION,ILEVTYPE
LOGICAL :: GFIND ! to test if sea wave height is found
!---------------------------------------------------------------------------------------
IP_GFS=(/1000,975,950,925,900,850,800,750,700,650,600,550,500,450,400,350,300,&
- 250,200,150,100,70,50,30,20,10/)!
+ 250,200,150,100,70,50,30,20,10,7,5,3,2,1/)!
!
TZFILE => NULL()
!
@@ -519,18 +521,16 @@ SELECT CASE (IMODEL)
CASE(6,7) ! arpege and arome GRIB2
CALL SEARCH_FIELD(IGRIB,INUM_ZS,KDIS=0,KCAT=3,KNUMBER=4)
IF(INUM_ZS < 0) THEN
- WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
+ CALL SEARCH_FIELD(IGRIB,INUM_ZS,KDIS=0,KCAT=193,KNUMBER=5)
+ IF(INUM_ZS < 0) THEN
+ WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
+ END IF
ENDIF
CASE(10) ! NCEP
- DO IVAR=0,222
- CALL SEARCH_FIELD(IGRIB,INUM_ZS,KPARAM=IVAR)
+ CALL SEARCH_FIELD(IGRIB,INUM_ZS,KDIS=0,KCAT=3,KNUMBER=5,KTFFS=1)
IF(INUM_ZS < 0) THEN
- WRITE (ILUOUT0,'(A)')'Orography is missing'
- ENDIF
- END DO
- INUM_ZS=218
- WRITE (ILUOUT0,*) 'lsm ',IGRIB(350)
- WRITE (ILUOUT0,*) 'orog ',IGRIB(INUM_ZS)
+ WRITE (ILUOUT0,'(A)')'Orography is missing - abort'
+ ENDIF
END SELECT
ZPARAM(:)=-999.
CALL GRIB_GET(IGRIB(INUM_ZS),'Nj',INJ,IRET_GRIB)
@@ -631,7 +631,7 @@ SELECT CASE (IMODEL)
CASE(1,2,3,4,5) ! arpege mocage aladin et aladin reunion
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=1)
CASE(6,7) ! NEW AROME,ARPEGE
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=3,KNUMBER=25)
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=3,KNUMBER=0)
CASE(10) ! NCEP
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=134)
END SELECT
@@ -733,7 +733,7 @@ IF (IMODEL/=10) THEN
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IQ,KLEV1=ISTARTLEVEL)
IF(INUM < 0) call Print_msg( NVERB_FATAL, 'IO', 'READ_ALL_DATA_GRIB_CASE', 'atmospheric specific humidity is missing' )
ELSE ! NCEP
- ISTARTLEVEL=10
+ ISTARTLEVEL=1000
IT=130
IQ=157
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ISTARTLEVEL)
@@ -780,7 +780,7 @@ ELSE ! NCEP
END IF
CALL GRIB_GET(IGRIB(INUM),'values',ZQ_G(:,JLOOP1),IRET_GRIB)
WRITE (ILUOUT0,*) 'Q ',ILEV1,IRET_GRIB
- CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IT,KLEV1=ILEV1)
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=0,KNUMBER=0,KLEV1=ILEV1,KTFFS=100)
IF (INUM< 0) THEN
WRITE(YMSG,*) 'atmospheric temperature level ',JLOOP1,' is missing'
CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
@@ -921,6 +921,10 @@ IF (IMODEL==6) THEN ! GRIB2 AROME
ISTARTLEVEL = 0
CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=6,KNUMBER=6,KLEV1=ISTARTLEVEL)
END IF
+ IF (INUM < 0) THEN
+ ISTARTLEVEL = 1
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=0,KLEV1=ISTARTLEVEL)
+ END IF
IF (INUM > 0) THEN
WRITE (ILUOUT0,'(A)') ' | Grib file from French Weather Service - Arome model (forecast)'
LCPL_AROME=.TRUE.
@@ -1015,6 +1019,43 @@ ELSE !NCEP
END IF
DEALLOCATE (ZOUT)
+
+
+!---------------------------------------------------------------------------------------
+!* 2.5.4.2 Read and interpol geopotential height for interpolation on isobaric surface Grid of NCEP
+!---------------------------------------------------------------------------------------
+!
+ALLOCATE (ZGH_G(ISIZE,INLEVEL))
+!
+IF(IMODEL==10) THEN !NCEP with pressure grid only
+ DO JLOOP1=1, INLEVEL
+ ILEV1 = IP_GFS(JLOOP1)
+ WRITE (ILUOUT0,'(A)') ' | Searching geopotential height'
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=3,KNUMBER=5,KLEV1=ILEV1)
+ IF (INUM< 0) THEN
+ !callabortstop
+ WRITE(YMSG,*) 'Geopoential height level ',JLOOP1,' is missing'
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_ALL_DATA_GRIB_CASE',YMSG)
+ END IF
+ !
+ CALL GRIB_GET(IGRIB(INUM),'values',ZGH_G(:,JLOOP1),IRET_GRIB)
+ CALL GRIB_GET(IGRIB(INUM),'Nj',INJ,IRET_GRIB)
+ !
+ END DO
+ !
+ CALL COORDINATE_CONVERSION(IMODEL,IGRIB(INUM_ZS),IIU,IJU,ZLONOUT,ZLATOUT,&
+ ZXOUT,ZYOUT,INI,ZPARAM,IINLO)
+ !
+ ALLOCATE(ZOUT(INO))
+ ALLOCATE(XGH_LS(IIU,IJU,INLEVEL))
+ !
+ DO JLOOP1=1, INLEVEL
+ CALL HORIBL(ZPARAM(3),ZPARAM(4),ZPARAM(5),ZPARAM(6),INT(ZPARAM(2)),IINLO,INI, &
+ ZGH_G(:,JLOOP1),INO,ZXOUT,ZYOUT,ZOUT,.FALSE.,PTIME_HORI,.FALSE.)
+ CALL ARRAY_1D_TO_2D (INO,ZOUT,IIU,IJU,XGH_LS(:,:,JLOOP1))
+ END DO
+ DEALLOCATE(ZOUT)
+END IF
!
!* 2.5.5 Compute atmospheric pressure on MESO-NH grid
!
@@ -1116,7 +1157,7 @@ IF (NRR >1) THEN
WRITE (ILUOUT0,'(A)') ' | Reading Q fields (except humidity)'
DO JLOOP1=1, INLEVEL
ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=6,KNUMBER=6,KLEV1=ILEV1)
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=83,KLEV1=ILEV1)
IF (INUM < 0) THEN
WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
@@ -1155,7 +1196,7 @@ IF (NRR >1) THEN
DO JLOOP1=1, INLEVEL
ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=82,KLEV1=ILEV1)
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=84,KLEV1=ILEV1)
IF (INUM < 0) THEN
WRITE(YMSG,*) 'Specific ratio for ICE at level ',JLOOP1,' is missing'
CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
@@ -1193,7 +1234,7 @@ IF (NRR >1) THEN
DO JLOOP1=1, INLEVEL
ILEV1 = JLOOP1-1+ISTARTLEVEL
- CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=32,KLEV1=ILEV1)
+ CALL SEARCH_FIELD(IGRIB,INUM,KDIS=0,KCAT=1,KNUMBER=201,KLEV1=ILEV1)
IF (INUM < 0) THEN
WRITE(YMSG,*) 'Specific ratio ',IPAR,' at level ',JLOOP1,' is missing'
CALL PRINT_MSG(NVERB_FATAL,'IO','READ_ALL_DATA_GRIB_CASE',YMSG)
@@ -1242,17 +1283,14 @@ DEALLOCATE(IINLO)
!---------------------------------------------------------------------------------------
IF (IMODEL==5) THEN
- ! 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
! initialise NSV_* variables
- CALL INI_NSV(1)
+ CALL INI_NSV(IMI)
IF( HFILE=='ATM0' ) THEN
ALLOCATE (XSV_LS(IIU,IJU,INLEVEL,NSV))
ELSE IF (HFILE=='CHEM' ) THEN
@@ -1416,7 +1454,7 @@ DO JLOOP1 = ISTARTLEVEL, ISTARTLEVEL+INLEVEL-1
IF (IMODEL/=10) THEN ! others than NCEP
ILEV1 = JLOOP1
ELSE
- ILEV1 = IP_GFS(JLOOP1)
+ ILEV1 = IP_GFS(INLEVEL+ISTARTLEVEL-JLOOP1)
END IF
! read component u
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR,KLEV1=ILEV1)
@@ -1448,7 +1486,7 @@ DO JLOOP1 = ISTARTLEVEL, ISTARTLEVEL+INLEVEL-1
IF (IMODEL/=10) THEN ! others than NCEP
ILEV1 = JLOOP1
ELSE
- ILEV1 = IP_GFS(JLOOP1)
+ ILEV1 = IP_GFS(INLEVEL+ISTARTLEVEL-JLOOP1)
END IF
CALL SEARCH_FIELD(IGRIB,INUM,KPARAM=IPAR+1,KLEV1=ILEV1)
IF (INUM < 0) THEN
@@ -1617,24 +1655,24 @@ END IF
WRITE (ILUOUT0,'(A)') ' | Reading date'
CALL GRIB_GET(IGRIB(INUM),'dataDate',IDATE,IRET_GRIB)
CALL GRIB_GET(IGRIB(INUM),'dataTime',ITIME,IRET_GRIB)
-TPTCUR%TIME=ITIME/100*3600+(ITIME-(ITIME/100)*100)*60
-TPTCUR%TDATE%YEAR=IDATE/10000
-TPTCUR%TDATE%MONTH=INT((IDATE-TPTCUR%TDATE%YEAR*10000)/100)
-TPTCUR%TDATE%DAY=IDATE-TPTCUR%TDATE%YEAR*10000-TPTCUR%TDATE%MONTH*100
+TPTCUR%xtime=ITIME/100*3600+(ITIME-(ITIME/100)*100)*60
+TPTCUR%nyear=IDATE/10000
+TPTCUR%nmonth=INT((IDATE-TPTCUR%nyear*10000)/100)
+TPTCUR%nday=IDATE-TPTCUR%nyear*10000-TPTCUR%nmonth*100
CALL GRIB_GET(IGRIB(INUM),'startStep',ITIMESTEP,IRET_GRIB)
CALL GRIB_GET(IGRIB(INUM),'stepUnits',CSTEPUNIT,IRET_GRIB)
IF (IMODEL==0) THEN
ITWOZS=0
- IF ((TPTCUR%TDATE%YEAR ==2000).AND.(TPTCUR%TDATE%MONTH >11)) ITWOZS=1
- IF ((TPTCUR%TDATE%YEAR ==2000).AND.(TPTCUR%TDATE%MONTH ==11)) THEN
- IF ( (TPTCUR%TDATE%DAY >20 ) .OR. &
- ((TPTCUR%TDATE%DAY ==20 ).AND.(TPTCUR%TIME >=64800 ))) ITWOZS=1
+ IF ((TPTCUR%nyear ==2000).AND.(TPTCUR%nmonth >11)) ITWOZS=1
+ IF ((TPTCUR%nyear ==2000).AND.(TPTCUR%nmonth ==11)) THEN
+ IF ( (TPTCUR%nday >20 ) .OR. &
+ ((TPTCUR%nday ==20 ).AND.(TPTCUR%xtime >=64800 ))) ITWOZS=1
END IF
- IF ( TPTCUR%TDATE%YEAR ==2001 ) ITWOZS=1
- IF ((TPTCUR%TDATE%YEAR ==2002).AND.(TPTCUR%TDATE%MONTH <11)) ITWOZS=1
- IF ((TPTCUR%TDATE%YEAR ==2002).AND.(TPTCUR%TDATE%MONTH ==11)) THEN
- IF ( (TPTCUR%TDATE%DAY <24 ) .OR. &
- ((TPTCUR%TDATE%DAY ==25 ).AND.(TPTCUR%TIME <64800 ))) ITWOZS=1
+ IF ( TPTCUR%nyear ==2001 ) ITWOZS=1
+ IF ((TPTCUR%nyear ==2002).AND.(TPTCUR%nmonth <11)) ITWOZS=1
+ IF ((TPTCUR%nyear ==2002).AND.(TPTCUR%nmonth ==11)) THEN
+ IF ( (TPTCUR%nday <24 ) .OR. &
+ ((TPTCUR%nday ==25 ).AND.(TPTCUR%xtime <64800 ))) ITWOZS=1
END IF
IF (ITWOZS==1) &
WRITE(ILUOUT0,*) ' Check that both orography fields on 1st model level and on surface are used.'
@@ -1645,11 +1683,11 @@ CALL MPPDB_CHECK3D(XV_LS,"XV_LS",PRECISION)
SELECT CASE (CSTEPUNIT) ! Time unit indicator
CASE ('h') !hour
- TPTCUR%TIME = TPTCUR%TIME + ITIMESTEP*3600.
+ TPTCUR%xtime = TPTCUR%xtime + ITIMESTEP*3600.
CASE ('m') !minute
- TPTCUR%TIME = TPTCUR%TIME + ITIMESTEP*60.
+ TPTCUR%xtime = TPTCUR%xtime + ITIMESTEP*60.
CASE ('s') !minute
- TPTCUR%TIME = TPTCUR%TIME + ITIMESTEP
+ TPTCUR%xtime = TPTCUR%xtime + ITIMESTEP
CASE DEFAULT
WRITE (ILUOUT0,'(A,A,A)') ' | error CSTEPUNIT=',CSTEPUNIT, ' is different of s,m or h'
END SELECT
@@ -1857,7 +1895,7 @@ END SUBROUTINE ARRAY_1D_TO_2D
!---------------------------------------------------------------------------------------
!---------------------------------------------------------------------------------------
!#################################################################################
-SUBROUTINE SEARCH_FIELD(KGRIB,KNUM,KPARAM,KDIS,KCAT,KNUMBER,KLEV1)
+SUBROUTINE SEARCH_FIELD(KGRIB,KNUM,KPARAM,KDIS,KCAT,KNUMBER,KLEV1,KTFFS)
!#################################################################################
! search the grib message corresponding to KPARAM,KLTYPE,KLEV1,KLEV2 in all
! the KGIRB messages
@@ -1875,13 +1913,14 @@ INTEGER,INTENT(IN),OPTIONAL :: KDIS ! Discipline (GRIB2)
INTEGER,INTENT(IN),OPTIONAL :: KCAT ! Catégorie (GRIB2)
INTEGER,INTENT(IN),OPTIONAL :: KNUMBER ! parameterNumber (GRIB2)
INTEGER,INTENT(IN),OPTIONAL :: KLEV1 ! Level
+INTEGER,INTENT(IN),OPTIONAL :: KTFFS ! TypeOfFirstFixedSurface
!
! Declaration of local variables
!
INTEGER :: IFOUND ! Number of correct parameters
INTEGER :: ISEARCH ! Number of correct parameters to find
INTEGER :: IRET ! error code
-INTEGER :: IPARAM,IDIS,ICAT,INUMBER
+INTEGER :: IPARAM,IDIS,ICAT,INUMBER,ITFFS
INTEGER :: ILEV1 ! Level parameter 1
INTEGER :: JLOOP ! Dummy counter
INTEGER :: IVERSION
@@ -1899,6 +1938,7 @@ IF (PRESENT(KDIS)) ISEARCH=ISEARCH+1
IF (PRESENT(KCAT)) ISEARCH=ISEARCH+1
IF (PRESENT(KNUMBER)) ISEARCH=ISEARCH+1
IF (PRESENT(KLEV1)) ISEARCH=ISEARCH+1
+IF(PRESENT(KTFFS)) ISEARCH=ISEARCH+1
!
DO JLOOP=1,SIZE(KGRIB)
IFOUND = 0
@@ -1911,6 +1951,23 @@ DO JLOOP=1,SIZE(KGRIB)
WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
CYCLE
ENDIF
+ !
+ IF (PRESENT(KTFFS)) THEN
+ CALL GRIB_GET(KGRIB(JLOOP),'typeOfFirstFixedSurface',ITFFS,IRET_GRIB)
+ IF (IRET_GRIB > 0) THEN
+ WRITE (ILUOUT0,'(A)')' | Error encountered in the Grib file, skipping field'
+ CYCLE
+ ELSE IF (IRET_GRIB == -6) THEN
+ WRITE (ILUOUT0,'(A)')' | ECMWF pseudo-Grib data encountered, skipping field'
+ CYCLE
+ ENDIF
+ IF (ITFFS==KTFFS) THEN
+ IFOUND = IFOUND + 1
+ ELSE
+ CYCLE
+ ENDIF
+ ENDIF
+
IF (PRESENT(KPARAM)) THEN
IF (IVERSION == 2) THEN
CALL GRIB_GET(KGRIB(JLOOP),'paramId',IPARAM,IRET_GRIB)
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..89ab3518c9bb0b4ad0152fdc980b49cd1d630355
--- /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
+integer :: ilatlen, ilonlen, ilevlen
+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) :: 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 :: 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))
+! 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)
+! 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, INTENT(OUT) :: output
+!
+INTEGER(kind=CDFINT) :: ilen
+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=ilen)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+!
+output = ilen
+!
+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, 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, INTENT(IN) :: size_lon
+INTEGER, 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, INTENT(IN) :: size_lon
+INTEGER, INTENT(IN) :: size_lat
+INTEGER, INTENT(IN) :: size_lev
+REAL, DIMENSION(size_lon,size_lat,size_lev), INTENT(INOUT) :: output
+!
+INTEGER(kind=CDFINT) :: istatus, index
+REAL :: scale, offset
+INTEGER(kind=CDFINT),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 dcfe7b1e65ffd3fe804e74db710c50fa29b2b7a1..547a55b535791a53149ef6e20f232706ddfbff71 100644
--- a/src/MNH/read_chem_data_netcdf_case.f90
+++ b/src/MNH/read_chem_data_netcdf_case.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2012-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -86,12 +86,13 @@ END MODULE MODI_READ_CHEM_DATA_NETCDF_CASE
!! J.Pianezzej 13/02/2019 : correction for use of MEGAN
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 18/09/2019: correct support of 64bit integers (MNH_INT=8)
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
!------------
!
-USE MODD_BLANK
+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
@@ -120,8 +121,6 @@ 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
@@ -192,25 +191,26 @@ TYPE(TFILEDATA),POINTER :: TZFILE
!
! For netcdf
!
-integer(kind=CDFINT) :: status, ncid, varid
-integer(kind=CDFINT) :: lat_varid, lon_varid, lev_varid, time_varid
-integer(kind=CDFINT) :: hyam_varid, hybm_varid, p0_varid, t_varid, q_varid, ps_varid
-integer(kind=CDFINT) :: recid, latid, lonid, levid, timeid
-integer(kind=CDFINT) :: latlen, lonlen, levlen, nrecs, timelen
-integer(kind=CDFINT) :: itimeindex, KILEN
-CHARACTER(LEN=40) :: recname
-REAL, DIMENSION(:), ALLOCATABLE :: lats
-REAL, DIMENSION(:), ALLOCATABLE :: lons
-REAL, DIMENSION(:), ALLOCATABLE :: levs
-INTEGER(kind=CDFINT), DIMENSION(:), ALLOCATABLE :: count3d, start3d
-INTEGER(kind=CDFINT), DIMENSION(:), ALLOCATABLE :: count2d, start2d
-REAL, DIMENSION(:), ALLOCATABLE :: time, hyam, hybm
-REAL :: p0
-INTEGER, DIMENSION(:), ALLOCATABLE :: kinlo
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3d,vartemp3dbis,vartemp3dter
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3dquater
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCHEMMOZ, TMOZ, QMOZ
-REAL, DIMENSION(:,:), ALLOCATABLE :: PSMOZ
+CHARACTER(LEN=40) :: yrecname
+integer :: IKILEN
+integer(kind=CDFINT) :: istatus, incid, ivarid
+integer(kind=CDFINT) :: ilat_varid, ilon_varid, ilev_varid, itime_varid
+integer(kind=CDFINT) :: ihyam_varid, ihybm_varid, ip0_varid, it_varid, iq_varid, ips_varid
+integer(kind=CDFINT) :: irecid, ilatid, ilonid, ilevid, itimeid
+integer(kind=CDFINT) :: ilatlen, ilonlen, ilevlen, inrecs, itimelen
+integer(kind=CDFINT) :: itimeindex
+INTEGER, DIMENSION(:), ALLOCATABLE :: ikinlo
+INTEGER(kind=CDFINT), DIMENSION(:), ALLOCATABLE :: icount3d, istart3d
+INTEGER(kind=CDFINT), DIMENSION(:), ALLOCATABLE :: icount2d, istart2d
+REAL :: zp0
+REAL, DIMENSION(:), ALLOCATABLE :: zlats
+REAL, DIMENSION(:), ALLOCATABLE :: zlons
+REAL, DIMENSION(:), ALLOCATABLE :: zlevs
+REAL, DIMENSION(:), ALLOCATABLE :: ztime, zhyam, zhybm
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPSMOZ
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: zvartemp3d, zvartemp3dbis, zvartemp3dter
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: zvartemp3dquater
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCHEMMOZ, ZTMOZ, ZQMOZ
real ::a,b
@@ -263,87 +263,87 @@ DEALLOCATE (ZXM)
! 2.1 Open netcdf files
!print*,'Open netcdf files:',HFILE
!
-status = nf90_open(HFILE, nf90_nowrite, ncid)
-if (status /= nf90_noerr) call handle_err(status)
+istatus = nf90_open(HFILE, nf90_nowrite, incid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
!
! 2.2 Read netcdf files
!
! get dimension IDs
!
!* get dimension ID of unlimited variable in netcdf file
-status = nf90_inquire(ncid, unlimitedDimId = recid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_dimid(ncid, "lat", latid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_dimid(ncid, "lon", lonid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_dimid(ncid, "lev", levid)
-if (status /= nf90_noerr) call handle_err(status)
+istatus = nf90_inquire(incid, unlimitedDimId = irecid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_dimid(incid, "lat", ilatid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_dimid(incid, "lon", ilonid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_dimid(incid, "lev", ilevid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
!
! get dimensions
!
!* get dimension and name of unlimited variable in netcdf file
-status = nf90_inquire_dimension(ncid, recid, name=recname, len=nrecs)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inquire_dimension(ncid, latid, len=latlen)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inquire_dimension(ncid, lonid, len=lonlen)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inquire_dimension(ncid, levid, len=levlen)
-if (status /= nf90_noerr) call handle_err(status)
-!print*, latlen, lonlen, levlen, nrecs
+istatus = nf90_inquire_dimension(incid, irecid, name=yrecname, len=inrecs)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inquire_dimension(incid, ilatid, len=ilatlen)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inquire_dimension(incid, ilonid, len=ilonlen)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inquire_dimension(incid, ilevid, len=ilevlen)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+!print*, ilatlen, ilonlen, ilevlen, inrecs
!
! get variable IDs
!
-status = nf90_inq_varid(ncid, "lat", lat_varid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_varid(ncid, "lon", lon_varid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_varid(ncid, "lev", lev_varid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_varid(ncid, "time", time_varid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_varid(ncid, "P0", p0_varid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_varid(ncid, "hyam", hyam_varid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_varid(ncid, "hybm", hybm_varid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_varid(ncid, "T", t_varid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_varid(ncid, "Q", q_varid)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_inq_varid(ncid, "PS", ps_varid)
-if (status /= nf90_noerr) call handle_err(status)
-!
-KILEN = latlen * lonlen
+istatus = nf90_inq_varid(incid, "lat", ilat_varid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_varid(incid, "lon", ilon_varid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_varid(incid, "lev", ilev_varid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_varid(incid, "time", itime_varid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_varid(incid, "P0", ip0_varid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_varid(incid, "hyam", ihyam_varid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_varid(incid, "hybm", ihybm_varid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_varid(incid, "T", it_varid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_varid(incid, "Q", iq_varid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_inq_varid(incid, "PS", ips_varid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+!
+IKILEN = ilatlen * ilonlen
!
! 2.3 Read data.
!
-ALLOCATE (count3d(4))
-ALLOCATE (start3d(4))
-ALLOCATE (count2d(3))
-ALLOCATE (start2d(3))
-ALLOCATE (lats(latlen))
-ALLOCATE (lons(lonlen))
-ALLOCATE (levs(levlen))
-ALLOCATE (time(nrecs))
-ALLOCATE (kinlo(latlen))
-kinlo(:) = lonlen
-ALLOCATE (vartemp3d(lonlen,latlen,levlen))
-ALLOCATE (vartemp3dbis(lonlen,latlen,levlen))
-ALLOCATE (vartemp3dter(lonlen,latlen,levlen))
-ALLOCATE (vartemp3dquater(lonlen,latlen,levlen))
-ALLOCATE (ZCHEMMOZ(lonlen,latlen,levlen))
-ALLOCATE (TMOZ(lonlen,latlen,levlen))
-ALLOCATE (QMOZ(lonlen,latlen,levlen))
-ALLOCATE (PSMOZ(lonlen,latlen))
-ALLOCATE (XA_SV_LS(levlen))
-ALLOCATE (hyam(levlen))
-ALLOCATE (XB_SV_LS(levlen))
-ALLOCATE (hybm(levlen))
-ALLOCATE (XT_SV_LS(IIU,IJU,levlen))
-ALLOCATE (XQ_SV_LS(IIU,IJU,levlen,1))
+ALLOCATE (icount3d(4))
+ALLOCATE (istart3d(4))
+ALLOCATE (icount2d(3))
+ALLOCATE (istart2d(3))
+ALLOCATE (zlats(ilatlen))
+ALLOCATE (zlons(ilonlen))
+ALLOCATE (zlevs(ilevlen))
+ALLOCATE (ztime(inrecs))
+ALLOCATE (ikinlo(ilatlen))
+ikinlo(:) = ilonlen
+ALLOCATE (zvartemp3d(ilonlen,ilatlen,ilevlen))
+ALLOCATE (zvartemp3dbis(ilonlen,ilatlen,ilevlen))
+ALLOCATE (zvartemp3dter(ilonlen,ilatlen,ilevlen))
+ALLOCATE (zvartemp3dquater(ilonlen,ilatlen,ilevlen))
+ALLOCATE (ZCHEMMOZ(ilonlen,ilatlen,ilevlen))
+ALLOCATE (ZTMOZ(ilonlen,ilatlen,ilevlen))
+ALLOCATE (ZQMOZ(ilonlen,ilatlen,ilevlen))
+ALLOCATE (ZPSMOZ(ilonlen,ilatlen))
+ALLOCATE (XA_SV_LS(ilevlen))
+ALLOCATE (zhyam(ilevlen))
+ALLOCATE (XB_SV_LS(ilevlen))
+ALLOCATE (zhybm(ilevlen))
+ALLOCATE (XT_SV_LS(IIU,IJU,ilevlen))
+ALLOCATE (XQ_SV_LS(IIU,IJU,ilevlen,1))
ALLOCATE (XPS_SV_LS(IIU,IJU))
ALLOCATE (XZS_SV_LS(IIU,IJU))
! take the orography from ECMWF
@@ -351,40 +351,40 @@ XZS_SV_LS(:,:) = XZS_LS(:,:)
!
! get values of variables
!
-status = nf90_get_var(ncid, lat_varid, lats(:))
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_get_var(ncid, lon_varid, lons(:))
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_get_var(ncid, lev_varid, levs(:))
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_get_var(ncid, time_varid, time(:))
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_get_var(ncid, hyam_varid, hyam)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_get_var(ncid, hybm_varid, hybm)
-if (status /= nf90_noerr) call handle_err(status)
-status = nf90_get_var(ncid, p0_varid, p0)
-if (status /= nf90_noerr) call handle_err(status)
-XP00_SV_LS = p0
+istatus = nf90_get_var(incid, ilat_varid, zlats(:))
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_get_var(incid, ilon_varid, zlons(:))
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_get_var(incid, ilev_varid, zlevs(:))
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_get_var(incid, itime_varid, ztime(:))
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_get_var(incid, ihyam_varid, zhyam)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_get_var(incid, ihybm_varid, zhybm)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+istatus = nf90_get_var(incid, ip0_varid, zp0)
+if (istatus /= nf90_noerr) call handle_err(istatus)
+XP00_SV_LS = zp0
!
! hyam and hybm coefficients for pressure calculations have to be reversed
! from top-bottom to bottom-up direction
-do JJ = 1, levlen
- XA_SV_LS(JJ) = hyam(levlen+1-JJ)
- XB_SV_LS(JJ) = hybm(levlen+1-JJ)
+do JJ = 1, ilevlen
+ XA_SV_LS(JJ) = zhyam(ilevlen+1-JJ)
+ XB_SV_LS(JJ) = zhybm(ilevlen+1-JJ)
end do
!
!
! Read 1 record of lon*lat*lev values, starting at the
! beginning of the record (the (1, 1, 1, rec) element in the netCDF
! file).
- count3d(1) = lonlen
- count3d(2) = latlen
- count3d(3) = levlen
- count3d(4) = 1
- start3d(1) = 1
- start3d(2) = 1
- start3d(3) = 1
+ icount3d(1) = ilonlen
+ icount3d(2) = ilatlen
+ icount3d(3) = ilevlen
+ icount3d(4) = 1
+ istart3d(1) = 1
+ istart3d(2) = 1
+ istart3d(3) = 1
! Choose time index according to the chosen time in namelist
! 1 for 06h - 2 for 12h - 3 for 18h - 4 for 24h
IF (CDUMMY1=="06") THEN
@@ -396,59 +396,56 @@ ELSEIF (CDUMMY1=="18") THEN
ELSEIF ((CDUMMY1=="24").OR.(CDUMMY1=="00")) THEN
itimeindex=4
ENDIF
- start3d(4) = itimeindex
+ istart3d(4) = itimeindex
!
- status = nf90_get_var(ncid, t_varid, vartemp3d, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
+ istatus = nf90_get_var(incid, it_varid, zvartemp3d, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
!
-do JJ=1,levlen
+do JJ=1,ilevlen
! lev, lat, lon
- TMOZ(:,:,JJ) = vartemp3d(:,:,levlen+1-JJ)
+ ZTMOZ(:,:,JJ) = zvartemp3d(:,:,ilevlen+1-JJ)
enddo
!
- status = nf90_get_var(ncid, q_varid, vartemp3d, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
+ istatus = nf90_get_var(incid, iq_varid, zvartemp3d, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
!
-do JJ=1,levlen
+do JJ=1,ilevlen
! lev, lat, lon
- QMOZ(:,:,JJ) = vartemp3d(:,:,levlen+1-JJ)
+ ZQMOZ(:,:,JJ) = zvartemp3d(:,:,ilevlen+1-JJ)
enddo
!
- count2d(1) = lonlen
- count2d(2) = latlen
- count2d(3) = 1
- start2d(1) = 1
- start2d(2) = 1
- start2d(3) = itimeindex
- status = nf90_get_var(ncid, ps_varid, PSMOZ(:,:), start=start2d, count=count2d)
- if (status /= nf90_noerr) call handle_err(status)
+ icount2d(1) = ilonlen
+ icount2d(2) = ilatlen
+ icount2d(3) = 1
+ istart2d(1) = 1
+ istart2d(2) = 1
+ istart2d(3) = itimeindex
+ istatus = nf90_get_var(incid, ips_varid, ZPSMOZ(:,:), start=istart2d, count=icount2d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
!------------------------------------------------------------------------
!* 3 Interpolation of MOZART variable
!---------------------------------------------------------------------
- ! 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
! initialise NSV_* variables
- CALL INI_NSV(1)
+ CALL INI_NSV(IMI)
DEALLOCATE(XSV_LS)
- ALLOCATE (XSV_LS(IIU,IJU,levlen,NSV))
+ ALLOCATE (XSV_LS(IIU,IJU,ilevlen,NSV))
XSV_LS(:,:,:,:) = 0.
!
WRITE (ILUOUT0,'(A,A4,A)') ' | Reading MOZART species (ppp) from ',HFILE,' file'
where (ZLONOUT(:) < 0.) ZLONOUT(:) = ZLONOUT(:) + 360.
!
-ALLOCATE(ZVALUE(levlen,KILEN))
-ALLOCATE(ZOUT(levlen,INO))
-ALLOCATE(ZVALUE1D(KILEN))
+ALLOCATE(ZVALUE(ilevlen,IKILEN))
+ALLOCATE(ZOUT(ilevlen,INO))
+ALLOCATE(ZVALUE1D(IKILEN))
ALLOCATE(ZOUT1D(INO))
!
@@ -505,162 +502,162 @@ DO JI = 1,IMOZ !for every MNH species existing in MOZ1.nam
DO JNCHEM = NSV_CHEMBEG, NSV_CHEMEND !loop on all MNH species
IF (trim(CNAMES(JNCHEM-NSV_CHEMBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species
IF (ISPCMOZ(JI)==1) THEN
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- DO JJ=1,levlen ! lev, lat, lon
- ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3d, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ DO JJ=1,ilevlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*zvartemp3d(:,:,ilevlen+1-JJ)
ENDDO
ELSE IF (ISPCMOZ(JI)==2) THEN
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- DO JJ=1,levlen ! lev, lat, lon
- ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ) + &
- ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3d, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dbis, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ DO JJ=1,ilevlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*zvartemp3d(:,:,ilevlen+1-JJ) + &
+ ZCOEFMOZART(JI,2)*zvartemp3dbis(:,:,ilevlen+1-JJ)
ENDDO
ELSE IF (ISPCMOZ(JI)==3) THEN
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- DO JJ=1,levlen ! lev, lat, lon
- ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
- ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
- ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3d, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dbis, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dter, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ DO JJ=1,ilevlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*zvartemp3d(:,:,ilevlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*zvartemp3dbis(:,:,ilevlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*zvartemp3dter(:,:,ilevlen+1-JJ)
ENDDO
ELSE IF (ISPCMOZ(JI)==4) THEN
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,4)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dquater, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- DO JJ=1,levlen ! lev, lat, lon
- ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
- ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
- ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)+&
- ZCOEFMOZART(JI,4)*vartemp3dquater(:,:,levlen+1-JJ)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3d, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dbis, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dter, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,4)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dquater, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ DO JJ=1,ilevlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*zvartemp3d(:,:,ilevlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*zvartemp3dbis(:,:,ilevlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*zvartemp3dter(:,:,ilevlen+1-JJ)+&
+ ZCOEFMOZART(JI,4)*zvartemp3dquater(:,:,ilevlen+1-JJ)
ENDDO
ENDIF
- DO JK = 1, levlen
+ DO JK = 1, ilevlen
JLOOP1 = 0
- DO JJ = 1, latlen
- ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMMOZ(1:lonlen,JJ,JK)
- JLOOP1 = JLOOP1+lonlen
+ DO JJ = 1, ilatlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+ilonlen) = ZCHEMMOZ(1:ilonlen,JJ,JK)
+ JLOOP1 = JLOOP1+ilonlen
ENDDO
- CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
- int(latlen,kind=kind(1)),kinlo,KILEN, &
+ CALL HORIBL(zlats(1),zlons(1),zlats(ilatlen),zlons(ilonlen), &
+ int(ilatlen,kind=kind(1)),ikinlo,IKILEN, &
ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.)
CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
XSV_LS(:,:,JK,JNCHEM) )
- ENDDO ! levlen
+ ENDDO ! ilevlen
ENDIF
ENDDO ! JNCHEM
DO JNAER = NSV_AERBEG, NSV_AEREND
IF (trim(CAERONAMES(JNAER-NSV_AERBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species
IF (ISPCMOZ(JI)==1) THEN
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- DO JJ=1,levlen ! lev, lat, lon
- ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3d, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ DO JJ=1,ilevlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*zvartemp3d(:,:,ilevlen+1-JJ)
ENDDO
ELSE IF (ISPCMOZ(JI)==2) THEN
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- DO JJ=1,levlen ! lev, lat, lon
- ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ) + &
- ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3d, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dbis, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ DO JJ=1,ilevlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*zvartemp3d(:,:,ilevlen+1-JJ) + &
+ ZCOEFMOZART(JI,2)*zvartemp3dbis(:,:,ilevlen+1-JJ)
ENDDO
ELSE IF (ISPCMOZ(JI)==3) THEN
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- DO JJ=1,levlen ! lev, lat, lon
- ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
- ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
- ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3d, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dbis, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dter, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ DO JJ=1,ilevlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*zvartemp3d(:,:,ilevlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*zvartemp3dbis(:,:,ilevlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*zvartemp3dter(:,:,ilevlen+1-JJ)
ENDDO
ELSE IF (ISPCMOZ(JI)==4) THEN
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_inq_varid(ncid, trim(YCHANGE(JI,4)), ind_netcdf)
- if (status /= nf90_noerr) call handle_err(status)
- status = nf90_get_var(ncid, ind_netcdf, vartemp3dquater, start=start3d, count=count3d)
- if (status /= nf90_noerr) call handle_err(status)
- DO JJ=1,levlen ! lev, lat, lon
- ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
- ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
- ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)+&
- ZCOEFMOZART(JI,4)*vartemp3dquater(:,:,levlen+1-JJ)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3d, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dbis, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dter, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_inq_varid(incid, trim(YCHANGE(JI,4)), ind_netcdf)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ istatus = nf90_get_var(incid, ind_netcdf, zvartemp3dquater, start=istart3d, count=icount3d)
+ if (istatus /= nf90_noerr) call handle_err(istatus)
+ DO JJ=1,ilevlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*zvartemp3d(:,:,ilevlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*zvartemp3dbis(:,:,ilevlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*zvartemp3dter(:,:,ilevlen+1-JJ)+&
+ ZCOEFMOZART(JI,4)*zvartemp3dquater(:,:,ilevlen+1-JJ)
ENDDO
ENDIF
- DO JK = 1, levlen
+ DO JK = 1, ilevlen
JLOOP1 = 0
- DO JJ = 1, latlen
- ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMMOZ(1:lonlen,JJ,JK)
- JLOOP1 = JLOOP1+lonlen
+ DO JJ = 1, ilatlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+ilonlen) = ZCHEMMOZ(1:ilonlen,JJ,JK)
+ JLOOP1 = JLOOP1+ilonlen
ENDDO
- CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
- int(latlen,kind=kind(1)),kinlo,KILEN, &
+ CALL HORIBL(zlats(1),zlons(1),zlats(ilatlen),zlons(ilonlen), &
+ int(ilatlen,kind=kind(1)),ikinlo,IKILEN, &
ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.)
CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
XSV_LS(:,:,JK,JNAER) )
- ENDDO ! levlen
+ ENDDO ! ilevlen
ENDIF
ENDDO ! JNAER
ENDDO ! JIDO JNCHEM = NSV_CHEMBEG, NSV_CHEMEND !loop on all MNH species
@@ -672,14 +669,14 @@ DEALLOCATE(YCHANGE)
!
XSV_LS(:,:,:,:) = MAX(XSV_LS(:,:,:,:),0.)
!
-DO JK = 1, levlen
+DO JK = 1, ilevlen
JLOOP1 = 0
- DO JJ = 1, latlen
- ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = TMOZ(1:lonlen,JJ,JK)
- JLOOP1 = JLOOP1 + lonlen
+ DO JJ = 1, ilatlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+ilonlen) = ZTMOZ(1:ilonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + ilonlen
ENDDO
- CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
- int(latlen,kind=kind(1)),kinlo,KILEN, &
+ CALL HORIBL(zlats(1),zlons(1),zlats(ilatlen),zlons(ilonlen), &
+ int(ilatlen,kind=kind(1)),ikinlo,IKILEN, &
ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.)
!
@@ -688,14 +685,14 @@ DO JK = 1, levlen
ENDDO
XT_SV_LS(:,:,:) = MAX(XT_SV_LS(:,:,:),0.)
!
-DO JK = 1, levlen
+DO JK = 1, ilevlen
JLOOP1 = 0
- DO JJ = 1, latlen
- ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = QMOZ(1:lonlen,JJ,JK)
- JLOOP1 = JLOOP1 + lonlen
+ DO JJ = 1, ilatlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+ilonlen) = ZQMOZ(1:ilonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + ilonlen
ENDDO
- CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
- int(latlen,kind=kind(1)),kinlo,KILEN, &
+ CALL HORIBL(zlats(1),zlons(1),zlats(ilatlen),zlons(ilonlen), &
+ int(ilatlen,kind=kind(1)),ikinlo,IKILEN, &
ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.)
!
@@ -705,12 +702,12 @@ ENDDO
XQ_SV_LS(:,:,:,1) = MAX(XQ_SV_LS(:,:,:,1),0.)
!
JLOOP1 = 0
-DO JJ = 1, latlen
- ZVALUE1D(JLOOP1+1:JLOOP1+lonlen) = PSMOZ(1:lonlen,JJ)
- JLOOP1 = JLOOP1 + lonlen
+DO JJ = 1, ilatlen
+ ZVALUE1D(JLOOP1+1:JLOOP1+ilonlen) = ZPSMOZ(1:ilonlen,JJ)
+ JLOOP1 = JLOOP1 + ilonlen
ENDDO
-CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
- int(latlen,kind=kind(1)),kinlo,KILEN, &
+CALL HORIBL(zlats(1),zlons(1),zlats(ilatlen),zlons(ilonlen), &
+ int(ilatlen,kind=kind(1)),ikinlo,IKILEN, &
ZVALUE1D(:),INO,ZLONOUT,ZLATOUT, &
ZOUT1D(:),.FALSE.,PTIME_HORI,.FALSE.)
!
@@ -721,8 +718,8 @@ XPS_SV_LS(:,:) = MAX(XPS_SV_LS(:,:),0.)
!
!
! close the netcdf file
-status = nf90_close(ncid)
-if (status /= nf90_noerr) call handle_err(status)
+istatus = nf90_close(incid)
+if (istatus /= nf90_noerr) call handle_err(istatus)
!
DEALLOCATE (ZVALUE)
DEALLOCATE (ZOUT)
@@ -752,12 +749,12 @@ CALL READ_VER_GRID(TPPRE_REAL1)
!
DEALLOCATE (ZLATOUT)
DEALLOCATE (ZLONOUT)
-DEALLOCATE (hyam)
-DEALLOCATE (hybm)
-DEALLOCATE (vartemp3d)
-DEALLOCATE (vartemp3dbis)
-DEALLOCATE (vartemp3dter)
-DEALLOCATE (vartemp3dquater)
+DEALLOCATE (zhyam)
+DEALLOCATE (zhybm)
+DEALLOCATE (zvartemp3d)
+DEALLOCATE (zvartemp3dbis)
+DEALLOCATE (zvartemp3dter)
+DEALLOCATE (zvartemp3dquater)
!
WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successfully'
!
@@ -765,14 +762,14 @@ WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successf
CONTAINS
!
! #############################
- subroutine handle_err(status)
+ subroutine handle_err(istatus)
! #############################
use mode_msg
- integer(kind=CDFINT) status
+ integer(kind=CDFINT) istatus
- if ( status /= NF90_NOERR ) then
- call Print_msg( NVERB_FATAL, 'IO', 'HANDLE_ERR', NF90_STRERROR(status) )
+ if ( istatus /= NF90_NOERR ) then
+ call Print_msg( NVERB_FATAL, 'IO', 'HANDLE_ERR', NF90_STRERROR(istatus) )
end if
end subroutine handle_err
diff --git a/src/MNH/read_desfmn.f90 b/src/MNH/read_desfmn.f90
index 294bafd4550f4587cd8e8d6d913b82d3aee35b64..2f781f8e7c208bd4bbc9d2bdc0461fa767033a95 100644
--- a/src/MNH/read_desfmn.f90
+++ b/src/MNH/read_desfmn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -192,6 +192,9 @@ END MODULE MODI_READ_DESFM_n
!! Modification 02/2018 (Q.Libois) ECRAD
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Modification 07/2017 (V. Vionnet) Add blowing snow scheme
+!! Modification 02/2021 (F.Auguste) add IBM
+!! (T.Nagel) add turbulence recycling
+!! (E.Jezequel) add stations read from CSV file
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -222,7 +225,7 @@ USE MODN_LBC_n
USE MODN_NUDGING_n
USE MODN_TURB_n
USE MODN_FRC
-USE MODN_BLANK
+USE MODN_BLANK_n
USE MODN_CH_SOLVER_n
USE MODN_CH_MNHC_n
USE MODN_PARAM_C2R2, ONLY : HPARAM_CCN_C2R2=>HPARAM_CCN,HINI_CCN_C2R2=>HINI_CCN, &
@@ -260,11 +263,15 @@ USE MODN_LATZ_EDFLX
USE MODN_2D_FRC
USE MODN_BLOWSNOW_n
USE MODN_BLOWSNOW
+USE MODN_STATION_n
!
USE MODN_PARAM_LIMA
!
USE MODE_MSG
USE MODE_POS
+USE MODN_RECYCL_PARAM_n
+USE MODN_IBM_PARAM_n
+USE MODD_IBM_LSF, ONLY: LIBM_LSF
!
IMPLICIT NONE
!
@@ -434,20 +441,42 @@ IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_DRAGn)
CALL UPDATE_NAM_DRAGn
END IF
-
+CALL POSNAM(ILUDES,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+CALL INIT_NAM_IBM_PARAMn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_IBM_PARAMn)
+ CALL UPDATE_NAM_IBM_PARAMn
+END IF
+CALL POSNAM(ILUDES,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+CALL INIT_NAM_RECYCL_PARAMn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_RECYCL_PARAMn)
+ CALL UPDATE_NAM_RECYCL_PARAMn
+END IF
CALL POSNAM(ILUDES,'NAM_SERIESN',GFOUND,ILUOUT)
CALL INIT_NAM_SERIESn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_SERIESn)
CALL UPDATE_NAM_SERIESn
END IF
-
CALL POSNAM(ILUDES,'NAM_BLOWSNOWn',GFOUND,ILUOUT)
CALL INIT_NAM_BLOWSNOWn
IF (GFOUND) THEN
READ(UNIT=ILUDES,NML=NAM_BLOWSNOWn)
CALL UPDATE_NAM_BLOWSNOWn
END IF
+CALL POSNAM(ILUDES,'NAM_BLANKN',GFOUND,ILUOUT)
+CALL INIT_NAM_BLANKn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_BLANKn)
+ CALL UPDATE_NAM_BLANKn
+END IF
+CALL POSNAM(ILUDES,'NAM_STATIONN',GFOUND,ILUOUT)
+CALL INIT_NAM_STATIONn
+IF (GFOUND) THEN
+ READ(UNIT=ILUDES,NML=NAM_STATIONn)
+ CALL UPDATE_NAM_STATIONn
+END IF
!
!
IF (KMI == 1) THEN
@@ -508,40 +537,40 @@ IF (KMI == 1) THEN
END IF
READ(UNIT=ILUDES,NML=NAM_OUTPUT)
END IF
- CALL POSNAM(ILUDES,'NAM_BUDGET',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BUDGET)
- CALL POSNAM(ILUDES,'NAM_BU_RU',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RU)
- CALL POSNAM(ILUDES,'NAM_BU_RV',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RV)
- CALL POSNAM(ILUDES,'NAM_BU_RW',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RW)
- CALL POSNAM(ILUDES,'NAM_BU_RTH',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTH)
- CALL POSNAM(ILUDES,'NAM_BU_RTKE',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTKE)
- CALL POSNAM(ILUDES,'NAM_BU_RRV',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRV)
- CALL POSNAM(ILUDES,'NAM_BU_RRC',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRC)
- CALL POSNAM(ILUDES,'NAM_BU_RRR',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRR)
- CALL POSNAM(ILUDES,'NAM_BU_RRI',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRI)
- CALL POSNAM(ILUDES,'NAM_BU_RRS',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRS)
- CALL POSNAM(ILUDES,'NAM_BU_RRG',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRG)
- CALL POSNAM(ILUDES,'NAM_BU_RRH',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRH)
- CALL POSNAM(ILUDES,'NAM_BU_RSV',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RSV)
+! Note: it is not useful to read the budget namelists in the .des files
+! The value here (if present in file) don't need to be compared with the ones in the EXSEGn files
+! CALL POSNAM(ILUDES,'NAM_BUDGET',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BUDGET)
+! CALL POSNAM(ILUDES,'NAM_BU_RU',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RU)
+! CALL POSNAM(ILUDES,'NAM_BU_RV',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RV)
+! CALL POSNAM(ILUDES,'NAM_BU_RW',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RW)
+! CALL POSNAM(ILUDES,'NAM_BU_RTH',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTH)
+! CALL POSNAM(ILUDES,'NAM_BU_RTKE',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RTKE)
+! CALL POSNAM(ILUDES,'NAM_BU_RRV',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRV)
+! CALL POSNAM(ILUDES,'NAM_BU_RRC',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRC)
+! CALL POSNAM(ILUDES,'NAM_BU_RRR',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRR)
+! CALL POSNAM(ILUDES,'NAM_BU_RRI',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRI)
+! CALL POSNAM(ILUDES,'NAM_BU_RRS',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRS)
+! CALL POSNAM(ILUDES,'NAM_BU_RRG',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRG)
+! CALL POSNAM(ILUDES,'NAM_BU_RRH',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RRH)
+! CALL POSNAM(ILUDES,'NAM_BU_RSV',GFOUND)
+! IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BU_RSV)
CALL POSNAM(ILUDES,'NAM_LES',GFOUND)
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_LES)
CALL POSNAM(ILUDES,'NAM_PDF',GFOUND)
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_PDF)
- CALL POSNAM(ILUDES,'NAM_BLANK',GFOUND)
- IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_BLANK)
CALL POSNAM(ILUDES,'NAM_FRC',GFOUND)
IF (GFOUND) READ(UNIT=ILUDES,NML=NAM_FRC)
CALL POSNAM(ILUDES,'NAM_PARAM_ICE',GFOUND)
@@ -682,6 +711,12 @@ IF (NVERB >= 10) THEN
!
WRITE(UNIT=ILUOUT,FMT="('********** DRAGn *******************')")
WRITE(UNIT=ILUOUT,NML=NAM_DRAGn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** IBM FORCING *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_IBM_PARAMn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** RECYLING *************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_RECYCL_PARAMn)
!
WRITE(UNIT=ILUOUT,FMT="('********** NUDGINGn ****************')")
WRITE(UNIT=ILUOUT,NML=NAM_NUDGINGn)
@@ -689,12 +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,NML=NAM_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="('********** 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="( '---------------------------------------------')")
@@ -705,56 +746,54 @@ IF (NVERB >= 10) THEN
WRITE(UNIT=ILUOUT,FMT="('************ DYNAMIC **************************')")
WRITE(UNIT=ILUOUT,NML=NAM_DYN)
!
- WRITE(UNIT=ILUOUT,FMT="('************ BUDGET ***************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BUDGET)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ U BUDGET *************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RU)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ V BUDGET *************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RV)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ W BUDGET *************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RW)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ TH BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RTH)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ TKE BUDGET ***********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RTKE)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ RV BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRV)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ RC BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRC)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ RR BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRR)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ RI BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRI)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ RS BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRS)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ RG BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRG)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ RH BUDGET ************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RRH)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ SVx BUDGET ***********************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BU_RSV)
+! Budget namelists not read anymore in READ_DESFM_n
+! WRITE(UNIT=ILUOUT,FMT="('************ BUDGET ***************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BUDGET)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ U BUDGET *************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RU)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ V BUDGET *************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RV)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ W BUDGET *************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RW)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ TH BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RTH)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ TKE BUDGET ***********************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RTKE)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RV BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRV)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RC BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRC)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RR BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRR)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RI BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRI)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RS BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRS)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RG BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRG)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ RH BUDGET ************************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RRH)
+! !
+! WRITE(UNIT=ILUOUT,FMT="('************ SVx BUDGET ***********************')")
+! WRITE(UNIT=ILUOUT,NML=NAM_BU_RSV)
!
WRITE(UNIT=ILUOUT,FMT="('************ LES ******************************')")
WRITE(UNIT=ILUOUT,NML=NAM_LES)
!
WRITE(UNIT=ILUOUT,FMT="('************ PDF ******************************')")
WRITE(UNIT=ILUOUT,NML=NAM_PDF)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ BLANK ****************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BLANK)
!
WRITE(UNIT=ILUOUT,FMT="('************ FORCING **************************')")
WRITE(UNIT=ILUOUT,NML=NAM_FRC)
diff --git a/src/MNH/read_dummy_gr_fieldn.f90 b/src/MNH/read_dummy_gr_fieldn.f90
index cd3e1b1570fff1d8f23d33a82dc91a0a92efe3e4..80f9ceefd4eb572e8c9f69a5eace441a7a0d2da6 100644
--- a/src/MNH/read_dummy_gr_fieldn.f90
+++ b/src/MNH/read_dummy_gr_fieldn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -74,7 +74,7 @@ END MODULE MODI_READ_DUMMY_GR_FIELD_n
!* 0. DECLARATIONS
!
USE MODD_DUMMY_GR_FIELD_n
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEINT, TYPEREAL
+use modd_field, only: tfielddata, TYPEINT, TYPEREAL
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS, ONLY: JPHEXT, NMNHNAMELGTMAX
diff --git a/src/MNH/read_emiss_data.f90 b/src/MNH/read_emiss_data.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ba95430aa53fe1c8ecd0a6d7aeffe6e2db0ba4c2
--- /dev/null
+++ b/src/MNH/read_emiss_data.f90
@@ -0,0 +1,63 @@
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_READ_EMISS_DATA
+! ######################
+!
+
+
+USE MODD_PARAM_ECRAD_n, ONLY : USER_EMISS
+
+implicit none
+
+CONTAINS
+
+
+!
+ SUBROUTINE READ_EMISS_DATA(SURF_TYPE)
+!
+use easy_netcdf, only : netcdf_file
+use radiation_config, only: get_enum_code
+
+
+character(len=*), intent(in) :: SURF_TYPE
+
+
+character(len=*), parameter :: EmissModelName(0:5) = (/ 'OCEA', &
+ & 'VEGE',&
+ & 'DESE',&
+ & 'SNOW',&
+ & 'ZERO',&
+ & 'UNIT' /)
+
+type(netcdf_file) :: file
+character(len=255) :: emiss_data_name
+integer :: NEMISS
+real, allocatable :: ALL_EMISS(:,:)
+
+emiss_data_name = '/home/liboisq/MesoNH/MNH-V5-4-4/src/QUENTIN/ecrad-1.4.0/data/spectral_emissivity.nc'
+
+! Determine emissivity model
+call get_enum_code(SURF_TYPE, EmissModelName, &
+ & ' ', NEMISS)
+
+
+! Open the file and configure the way it is read
+call file%open(trim(emiss_data_name), iverbose=1)
+call file%transpose_matrices()
+
+! Read the emissivities
+call file%get_real_matrix('emissivity', ALL_EMISS)
+
+USER_EMISS(:) = ALL_EMISS(NEMISS+1,:)
+
+call file%close()
+
+
+END SUBROUTINE READ_EMISS_DATA
+
+END MODULE MODI_READ_EMISS_DATA
+
diff --git a/src/MNH/read_exsegn.f90 b/src/MNH/read_exsegn.f90
index 075e87d75cd8d9fa54a8e620bd48956803a021dd..a8c847c3f280ae1e4f7e1a27561252b676a3c574 100644
--- a/src/MNH/read_exsegn.f90
+++ b/src/MNH/read_exsegn.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.
@@ -293,95 +293,114 @@ END MODULE MODI_READ_EXSEG_n
!! Modification 01/2019 (R. Honnert) remove SURF in CMF_UPDRAFT
!! Bielli S. 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
-!!------------------------------------------------------------------------------
+! C. Lac 11/2019: correction in the drag formula and application to building in addition to tree
+! Q. Rodier 03/2020: add abort if use of any LHORELAX and cyclic conditions
+! F.Auguste 02/2021: add IBM
+! T.Nagel 02/2021: add turbulence recycling
+! E.Jezequel 02/2021: add stations read from CSV file
+! P. Wautelet 09/03/2021: simplify allocation of scalar variable names
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! P. Wautelet 10/03/2021: move scalar variable name initializations to ini_nsv
+! R. Honnert 23/04/2021: add ADAP mixing length and delete HRIO and BOUT from CMF_UPDRAFT
+! S. Riette 11/05/2021 HighLow cloud
+!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-USE MODD_PARAMETERS
+USE MODD_BLOWSNOW
+USE MODD_BUDGET
+USE MODD_CH_AEROSOL
+USE MODD_CH_M9_n, ONLY : NEQ
+USE MODD_CONDSAMP
USE MODD_CONF
-USE MODD_CONFZ
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+USE MODD_CONFZ
+! USE MODD_DRAG_n
+USE MODD_DUST
+USE MODD_DYN
+USE MODD_DYN_n, ONLY : LHORELAX_SVLIMA
+#ifdef MNH_FOREFIRE
+USE MODD_FOREFIRE
+#endif
+USE MODD_GET_n
+USE MODD_GR_FIELD_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_SALT
USE MODD_VAR_ll, ONLY: NPROC
-!
+USE MODD_VISCOSITY
+
+USE MODE_MSG
+USE MODE_POS
+
+USE MODI_INI_NSV
+USE MODI_TEST_NAM_VAR
+
+USE MODN_2D_FRC
+USE MODN_ADV_n ! The final filling of these modules for the model n is
USE MODN_BACKUP
+USE MODN_BLANK_n
+USE MODN_BLOWSNOW
+USE MODN_BLOWSNOW_n
USE MODN_BUDGET
-USE MODN_LES
+USE MODN_CH_MNHC_n
+USE MODN_CH_ORILAM
+USE MODN_CH_SOLVER_n
+USE MODN_CONDSAMP
USE MODN_CONF
+USE MODN_CONF_n
USE MODN_CONFZ
-USE MODN_FRC
+USE MODN_DRAGBLDG_n
+USE MODN_DRAG_n
+USE MODN_DRAGTREE_n
+USE MODN_DUST
USE MODN_DYN
-USE MODN_NESTING
-USE MODN_OUTPUT
-USE MODN_CONF_n
-USE MODN_LBC_n ! routine is used for each nested model. This has been done
USE MODN_DYN_n ! to avoid the duplication of this routine for each model.
-USE MODN_ADV_n ! The final filling of these modules for the model n is
-USE MODN_PARAM_n ! realized in subroutine ini_model n
-USE MODN_PARAM_RAD_n
-USE MODN_PARAM_ECRAD_n
-USE MODN_PARAM_KAFR_n
-USE MODN_PARAM_MFSHALL_n
-USE MODN_PARAM_ICE
+USE MODN_ELEC
+USE MODN_EOL
+USE MODN_EOL_ADNR
+USE MODN_EOL_ALM
+#ifdef MNH_FOREFIRE
+USE MODN_FOREFIRE
+#endif
+USE MODN_FRC
+USE MODN_IBM_PARAM_n
+USE MODN_LATZ_EDFLX
+USE MODN_LBC_n ! routine is used for each nested model. This has been done
+USE MODN_LES
USE MODN_LUNIT_n
+USE MODN_MEAN
+USE MODN_NESTING
USE MODN_NUDGING_n
-USE MODN_TURB_n
-USE MODN_DRAG_n
-USE MODN_BLANK
-USE MODN_CH_MNHC_n
-USE MODN_CH_SOLVER_n
-USE MODN_PARAM_C2R2, ONLY : EPARAM_CCN=>HPARAM_CCN, EINI_CCN=>HINI_CCN, &
- WNUC=>XNUC, WALPHAC=>XALPHAC, NAM_PARAM_C2R2
+USE MODN_OUTPUT
USE MODN_PARAM_C1R3, ONLY : NAM_PARAM_C1R3, CPRISTINE_ICE_C1R3, &
CHEVRIMED_ICE_C1R3
+USE MODN_PARAM_C2R2, ONLY : EPARAM_CCN=>HPARAM_CCN, EINI_CCN=>HINI_CCN, &
+ WNUC=>XNUC, WALPHAC=>XALPHAC, NAM_PARAM_C2R2
+USE MODN_PARAM_ECRAD_n
+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
-USE MODN_ELEC
+ LCOLD, LACTI, LNUCL, XALPHAC, XNUC, LMEYERS, LHAIL,&
+ LPTSPLIT
+USE MODN_PARAM_MFSHALL_n
+USE MODN_PARAM_n ! realized in subroutine ini_model n
+USE MODN_PARAM_RAD_n
+USE MODN_PASPOL
+USE MODN_RECYCL_PARAM_n
+USE MODN_SALT
USE MODN_SERIES
-USE MODN_SERIES_n
-USE MODN_TURB_CLOUD
+USE MODN_SERIES_n
+USE MODN_STATION_n
USE MODN_TURB
-USE MODN_MEAN
-USE MODN_DRAGTREE
-USE MODN_LATZ_EDFLX
-!
-USE MODD_NSV,NSV_USER_n=>NSV_USER
-USE MODD_DYN
-USE MODD_DYN_n, ONLY : LHORELAX_SVLIMA
-USE MODD_GET_n
-USE MODD_GR_FIELD_n
-!
-USE MODE_POS
-USE MODE_MSG
-!
-USE MODI_TEST_NAM_VAR
-USE MODI_INI_NSV
-USE MODI_CH_INIT_SCHEME_n
-USE MODN_CH_ORILAM
-USE MODD_CH_AEROSOL
-USE MODD_DUST
-USE MODD_SALT
-USE MODD_PASPOL
-#ifdef MNH_FOREFIRE
-USE MODD_FOREFIRE
-USE MODN_FOREFIRE
-#endif
-USE MODD_CONDSAMP
-USE MODD_BLOWSNOW
-USE MODN_DUST
-USE MODN_SALT
-USE MODD_CH_M9_n, ONLY : NEQ
-USE MODN_PASPOL
-USE MODN_CONDSAMP
-USE MODN_BLOWSNOW
-USE MODN_BLOWSNOW_n
-USE MODN_2D_FRC
+USE MODN_TURB_CLOUD
+USE MODN_TURB_n
USE MODN_VISCOSITY
-USE MODD_VISCOSITY
-USE MODD_DRAG_n
-!
+
IMPLICIT NONE
!
!* 0.1 declarations of arguments
@@ -444,8 +463,6 @@ INTEGER :: JS,JCI,JI,JSV ! Loop indexes
LOGICAL :: GRELAX
LOGICAL :: GFOUND ! Return code when searching namelist
!
-INTEGER :: IMOMENTS, JMODE, IMODEIDX, JMOM, JSV_NAME, JMOD, I
-!
!-------------------------------------------------------------------------------
!
!* 1. READ EXSEG FILE
@@ -461,6 +478,8 @@ CCPLFILE(:)=" "
CALL INIT_NAM_CONFN
CALL INIT_NAM_DYNN
CALL INIT_NAM_ADVN
+CALL INIT_NAM_DRAGTREEN
+CALL INIT_NAM_DRAGBLDGN
CALL INIT_NAM_PARAMN
CALL INIT_NAM_PARAM_RADN
#ifdef MNH_ECRAD
@@ -471,11 +490,15 @@ CALL INIT_NAM_PARAM_MFSHALLN
CALL INIT_NAM_LBCN
CALL INIT_NAM_NUDGINGN
CALL INIT_NAM_TURBN
+CALL INIT_NAM_BLANKN
CALL INIT_NAM_DRAGN
+CALL INIT_NAM_IBM_PARAMN
+CALL INIT_NAM_RECYCL_PARAMN
CALL INIT_NAM_CH_MNHCN
CALL INIT_NAM_CH_SOLVERN
CALL INIT_NAM_SERIESN
CALL INIT_NAM_BLOWSNOWN
+CALL INIT_NAM_STATIONn
!
WRITE(UNIT=ILUOUT,FMT="(/,'READING THE EXSEG.NAM FILE')")
CALL POSNAM(ILUSEG,'NAM_LUNITN',GFOUND,ILUOUT)
@@ -506,14 +529,32 @@ CALL POSNAM(ILUSEG,'NAM_TURBN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_TURBn)
CALL POSNAM(ILUSEG,'NAM_DRAGN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGn)
+CALL POSNAM(ILUSEG,'NAM_IBM_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
+CALL POSNAM(ILUSEG,'NAM_RECYCL_PARAMN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_RECYCL_PARAMn)
CALL POSNAM(ILUSEG,'NAM_CH_MNHCN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_MNHCn)
CALL POSNAM(ILUSEG,'NAM_CH_SOLVERN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CH_SOLVERn)
CALL POSNAM(ILUSEG,'NAM_SERIESN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_SERIESn)
+CALL POSNAM(ILUSEG,'NAM_BLANKN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLANKn)
CALL POSNAM(ILUSEG,'NAM_BLOWSNOWN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
+CALL POSNAM(ILUSEG,'NAM_DRAGTREEN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREEn)
+CALL POSNAM(ILUSEG,'NAM_DRAGBLDGN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGBLDGn)
+CALL POSNAM(ILUSEG,'NAM_EOL',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL)
+CALL POSNAM(ILUSEG,'NAM_EOL_ADNR',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ADNR)
+CALL POSNAM(ILUSEG,'NAM_EOL_ALM',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_EOL_ALM)
+CALL POSNAM(ILUSEG,'NAM_STATIONN',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_STATIONn)
!
IF (KMI == 1) THEN
WRITE(UNIT=ILUOUT,FMT="(' namelists common to all the models ')")
@@ -584,40 +625,182 @@ IF (KMI == 1) THEN
END IF
CALL POSNAM(ILUSEG,'NAM_BUDGET',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BUDGET)
+
CALL POSNAM(ILUSEG,'NAM_BU_RU',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RU)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RU ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RU was already allocated' )
+ DEALLOCATE( CBULIST_RU )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(NBULISTMAXLINES) )
+ CBULIST_RU(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RU)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RV',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RV)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RV was already allocated' )
+ DEALLOCATE( CBULIST_RV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(NBULISTMAXLINES) )
+ CBULIST_RV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RW',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RW)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RW ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RW was already allocated' )
+ DEALLOCATE( CBULIST_RW )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(NBULISTMAXLINES) )
+ CBULIST_RW(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RW)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RTH',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RTH)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RTH ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTH was already allocated' )
+ DEALLOCATE( CBULIST_RTH )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(NBULISTMAXLINES) )
+ CBULIST_RTH(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RTH)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RTKE',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RTKE)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RTKE ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RTKE was already allocated' )
+ DEALLOCATE( CBULIST_RTKE )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(NBULISTMAXLINES) )
+ CBULIST_RTKE(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RTKE)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RRV',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RRV)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRV was already allocated' )
+ DEALLOCATE( CBULIST_RRV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(NBULISTMAXLINES) )
+ CBULIST_RRV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RRC',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RRC)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRC ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRC was already allocated' )
+ DEALLOCATE( CBULIST_RRC )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(NBULISTMAXLINES) )
+ CBULIST_RRC(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRC)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RRR',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RRR)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRR ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRR was already allocated' )
+ DEALLOCATE( CBULIST_RRR )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(NBULISTMAXLINES) )
+ CBULIST_RRR(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRR)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RRI',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RRI)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRI ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRI was already allocated' )
+ DEALLOCATE( CBULIST_RRI )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(NBULISTMAXLINES) )
+ CBULIST_RRI(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRI)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RRS',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RRS)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRS ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRS was already allocated' )
+ DEALLOCATE( CBULIST_RRS )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(NBULISTMAXLINES) )
+ CBULIST_RRS(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRS)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RRG',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RRG)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRG ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRG was already allocated' )
+ DEALLOCATE( CBULIST_RRG )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(NBULISTMAXLINES) )
+ CBULIST_RRG(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRG)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RRH',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RRH)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RRH ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RRH was already allocated' )
+ DEALLOCATE( CBULIST_RRH )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(NBULISTMAXLINES) )
+ CBULIST_RRH(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RRH)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_BU_RSV',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BU_RSV)
+ IF (GFOUND) THEN
+ IF ( ALLOCATED( CBULIST_RSV ) ) THEN
+ CALL Print_msg( NVERB_WARNING, 'IO', 'READ_EXSEG_n', 'unexpected: CBULIST_RSV was already allocated' )
+ DEALLOCATE( CBULIST_RSV )
+ END IF
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(NBULISTMAXLINES) )
+ CBULIST_RSV(:) = ''
+ READ(UNIT=ILUSEG,NML=NAM_BU_RSV)
+ ELSE
+ ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(0) )
+ END IF
+
CALL POSNAM(ILUSEG,'NAM_LES',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_LES)
CALL POSNAM(ILUSEG,'NAM_MEAN',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_MEAN)
CALL POSNAM(ILUSEG,'NAM_PDF',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_PDF)
- CALL POSNAM(ILUSEG,'NAM_BLANK',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_BLANK)
CALL POSNAM(ILUSEG,'NAM_FRC',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_FRC)
CALL POSNAM(ILUSEG,'NAM_PARAM_ICE',GFOUND,ILUOUT)
@@ -650,8 +833,6 @@ IF (KMI == 1) THEN
#endif
CALL POSNAM(ILUSEG,'NAM_CONDSAMP',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_CONDSAMP)
- CALL POSNAM(ILUSEG,'NAM_DRAGTREE',GFOUND,ILUOUT)
- IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_DRAGTREE)
CALL POSNAM(ILUSEG,'NAM_2D_FRC',GFOUND,ILUOUT)
IF (GFOUND) READ(UNIT=ILUSEG,NML=NAM_2D_FRC)
CALL POSNAM(ILUSEG,'NAM_LATZ_EDFLX',GFOUND)
@@ -703,9 +884,13 @@ CALL TEST_NAM_VAR(ILUOUT,'CLBCY(1)',CLBCY(1),'CYCL','WALL','OPEN')
CALL TEST_NAM_VAR(ILUOUT,'CLBCY(2)',CLBCY(2),'CYCL','WALL','OPEN')
!
CALL TEST_NAM_VAR(ILUOUT,'CTURBDIM',CTURBDIM,'1DIM','3DIM')
-CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN',CTURBLEN,'DELT','BL89','RM17','DEAR','BLKR')
+CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN',CTURBLEN,'DELT','BL89','RM17','DEAR','BLKR','ADAP')
CALL TEST_NAM_VAR(ILUOUT,'CTOM',CTOM,'NONE','TM06')
-CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV',CSUBG_AUCV,'NONE','CLFR','SIGM','PDF')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV',CSUBG_AUCV,'NONE','CLFR','SIGM','PDF','ADJU')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_AUCV_RI',CSUBG_AUCV_RI,'NONE','CLFR','ADJU')
+CALL TEST_NAM_VAR(ILUOUT,'CCONDENS',CCONDENS,'CB02','GAUS')
+CALL TEST_NAM_VAR(ILUOUT,'CLAMBDA3',CLAMBDA3,'CB','NONE')
+CALL TEST_NAM_VAR(ILUOUT,'CSUBG_MF_PDF',CSUBG_MF_PDF,'NONE','TRIANGLE')
!
CALL TEST_NAM_VAR(ILUOUT,'CCH_TDISCRETIZATION',CCH_TDISCRETIZATION, &
'SPLIT ','CENTER ','LAGGED ')
@@ -724,8 +909,7 @@ CALL TEST_NAM_VAR(ILUOUT,'CTURBLEN_CLOUD',CTURBLEN_CLOUD,'NONE','DEAR','DELT','B
!
! The test on the mass flux scheme for shallow convection
!
-CALL TEST_NAM_VAR(ILUOUT,'CMF_UPDRAFT',CMF_UPDRAFT,'NONE','EDKF','RHCJ',&
- 'HRIO','BOUT')
+CALL TEST_NAM_VAR(ILUOUT,'CMF_UPDRAFT',CMF_UPDRAFT,'NONE','EDKF','RHCJ')
CALL TEST_NAM_VAR(ILUOUT,'CMF_CLOUD',CMF_CLOUD,'NONE','STAT','DIRE')
!
! The test on the CSOLVER name is made elsewhere
@@ -1072,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.'
@@ -1132,6 +1323,8 @@ LUSETKE(KMI) = (CTURB /= 'NONE')
!
!* 2.3 Chemical and NSV_* variables initializations
!
+CALL UPDATE_NAM_IBM_PARAMN
+CALL UPDATE_NAM_RECYCL_PARAMN
CALL UPDATE_NAM_PARAMN
CALL UPDATE_NAM_DYNN
CALL UPDATE_NAM_CONFN
@@ -1208,12 +1401,6 @@ IF ((LUSECHIC).AND.(LCH_RET_ICE)) THEN
WRITE(UNIT=ILUOUT,FMT=*) 'TO FALSE IE NO CHEMICAL SPECIES IN ICE'
ENDIF
!
-IF (LUSECHEM) THEN
- CALL CH_INIT_SCHEME_n(KMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT,NVERB)
- IF (LORILAM) CALL CH_AER_INIT_SOA(ILUOUT, NVERB)
-END IF
-!
-
CALL UPDATE_NAM_CH_MNHCN
CALL INI_NSV(KMI)
!
@@ -1419,7 +1606,7 @@ ELSE
END IF
END IF
!
-IF(CTURBLEN=='RM17') THEN
+IF(CTURBLEN=='RM17' .OR. CTURBLEN=='ADAP') THEN
XCEDIS=0.34
ELSE
XCEDIS=0.84
@@ -1702,44 +1889,7 @@ IF (LDUST) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
END IF
- IF(.NOT.ALLOCATED(CDUSTNAMES)) THEN
- IMOMENTS = (NSV_DSTEND - NSV_DSTBEG +1 )/NMODE_DST
- ALLOCATE(CDUSTNAMES(IMOMENTS*NMODE_DST))
- !Loop on all dust modes
- IF (IMOMENTS == 1) THEN
- DO JMODE=1,NMODE_DST
- IMODEIDX=JPDUSTORDER(JMODE)
- JSV_NAME = (IMODEIDX - 1)*3 + 2
- CDUSTNAMES(JMODE) = YPDUST_INI(JSV_NAME)
- END DO
- ELSE
- DO JMODE=1,NMODE_DST
- !Find which mode we are dealing with
- IMODEIDX=JPDUSTORDER(JMODE)
- DO JMOM=1,IMOMENTS
- !Find which number this is of the list of scalars
- JSV = (JMODE-1)*IMOMENTS + JMOM
- !Find what name this corresponds to, always 3 moments assumed in YPDUST_INI
- JSV_NAME = (IMODEIDX - 1)*3 + JMOM
- !Get the right CDUSTNAMES which should follow the list of scalars transported in XSVM/XSVT
- CDUSTNAMES(JSV) = YPDUST_INI(JSV_NAME)
- ENDDO ! Loop on moments
- ENDDO ! Loop on dust modes
- END IF
- END IF
- ! Initialization of deposition scheme
- IF (LDEPOS_DST(KMI)) THEN
- IF(.NOT.ALLOCATED(CDEDSTNAMES)) THEN
- ALLOCATE(CDEDSTNAMES(NMODE_DST*2))
- DO JMODE=1,NMODE_DST
- IMODEIDX=JPDUSTORDER(JMODE)
- CDEDSTNAMES(JMODE) = YPDEDST_INI(IMODEIDX)
- CDEDSTNAMES(NMODE_DST+JMODE) = YPDEDST_INI(NMODE_DST+IMODEIDX)
- ENDDO
- ENDIF
- ENDIF
-
-END IF
+END IF
!
! Sea Salt case
!
@@ -1785,42 +1935,6 @@ IF (LSALT) THEN
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
END IF
- IF(.NOT.ALLOCATED(CSALTNAMES)) THEN
- IMOMENTS = (NSV_SLTEND - NSV_SLTBEG +1 )/NMODE_SLT
- ALLOCATE(CSALTNAMES(IMOMENTS*NMODE_SLT))
- !Loop on all dust modes
- IF (IMOMENTS == 1) THEN
- DO JMODE=1,NMODE_SLT
- IMODEIDX=JPSALTORDER(JMODE)
- JSV_NAME = (IMODEIDX - 1)*3 + 2
- CSALTNAMES(JMODE) = YPSALT_INI(JSV_NAME)
- END DO
- ELSE
- DO JMODE=1,NMODE_SLT
- !Find which mode we are dealing with
- IMODEIDX=JPSALTORDER(JMODE)
- DO JMOM=1,IMOMENTS
- !Find which number this is of the list of scalars
- JSV = (JMODE-1)*IMOMENTS + JMOM
- !Find what name this corresponds to, always 3 moments assumed in YPSALT_INI
- JSV_NAME = (IMODEIDX - 1)*3 + JMOM
- !Get the right CSALTNAMES which should follow the list of scalars transported in XSVM/XSVT
- CSALTNAMES(JSV) = YPSALT_INI(JSV_NAME)
- ENDDO ! Loop on moments
- ENDDO ! Loop on dust modes
- END IF
- END IF
- ! Initialization of deposition scheme
- IF (LDEPOS_SLT(KMI)) THEN
- IF(.NOT.ALLOCATED(CDESLTNAMES)) THEN
- ALLOCATE(CDESLTNAMES(NMODE_SLT*2))
- DO JMODE=1,NMODE_SLT
- IMODEIDX=JPSALTORDER(JMODE)
- CDESLTNAMES(JMODE) = YPDESLT_INI(IMODEIDX)
- CDESLTNAMES(NMODE_SLT+JMODE) = YPDESLT_INI(NMODE_SLT+IMODEIDX)
- ENDDO
- ENDIF
- ENDIF
END IF
!
! Orilam SV case
@@ -1859,13 +1973,6 @@ IF (LORILAM) THEN
CGETSVT(NSV_AERDEPBEG:NSV_AERDEPEND)='INIT'
END IF
END IF
-! Initialization of deposition scheme
- IF (LDEPOS_AER(KMI)) THEN
- IF(.NOT.ALLOCATED(CDEAERNAMES)) THEN
- ALLOCATE(CDEAERNAMES(JPMODE*2))
- CDEAERNAMES(:) = YPDEAER_INI(:)
- ENDIF
- ENDIF
END IF
!
! Lagrangian variables
@@ -1963,13 +2070,6 @@ IF (LBLOWSNOW) THEN
& "THE BLOWING SNOW VARIABLES HAVE BEEN INITIALIZED TO ZERO ")')
CGETSVT(NSV_SNWBEG:NSV_SNWEND)='INIT'
END IF
- IF(.NOT.ALLOCATED(CSNOWNAMES)) THEN
- IMOMENTS = (NSV_SNWEND - NSV_SNWBEG +1 )
- ALLOCATE(CSNOWNAMES(IMOMENTS))
- DO JMOM=1,IMOMENTS
- CSNOWNAMES(JMOM) = YPSNOW_INI(JMOM)
- ENDDO ! Loop on moments
- END IF
END IF
!
!
@@ -2263,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
@@ -2583,7 +2692,31 @@ IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
END IF
-!
+!
+IF ((LHORELAX_UVWTH .OR. LHORELAX_SVPP .OR. &
+ LHORELAX_SVCS .OR. &
+#ifdef MNH_FOREFIRE
+ LHORELAX_SVFF .OR. &
+#endif
+ LHORELAX_SVC2R2 .OR. LHORELAX_SVC1R3 .OR. &
+ LHORELAX_SVLIMA .OR. &
+ LHORELAX_SVELEC .OR. LHORELAX_SVCHEM .OR. &
+ LHORELAX_SVLG .OR. ANY(LHORELAX_SV) .OR. &
+ LHORELAX_RV .OR. LHORELAX_RC .OR. &
+ LHORELAX_RR .OR. LHORELAX_RI .OR. &
+ LHORELAX_RG .OR. LHORELAX_RS .OR. &
+ LHORELAX_RH .OR. LHORELAX_TKE.OR. &
+ LHORELAX_SVCHIC ) &
+ .AND. (CLBCX(1)=='CYCL'.OR.CLBCX(2)=='CYCL' &
+ .OR.CLBCY(1)=='CYCL'.OR.CLBCY(2)=='CYCL')) THEN
+ WRITE(UNIT=ILUOUT,FMT=9003) KMI
+ WRITE(ILUOUT,FMT=*) 'YOU WANT TO USE THE HORIZONTAL RELAXATION '
+ WRITE(ILUOUT,FMT=*) 'FOR CYCLIC CLBCX OR CLBCY VALUES'
+ WRITE(ILUOUT,FMT=*) 'CHANGE LHORELAX TO FALSE'
+ !callabortstop
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','READ_EXSEG_n','')
+END IF
+!
IF (KMI==1) THEN
GRELAX = .NOT.(OUSERV) .AND. LUSERV .AND. LHORELAX_RV
ELSE
@@ -2815,6 +2948,8 @@ END IF
!
CALL UPDATE_NAM_LUNITN
CALL UPDATE_NAM_CONFN
+CALL UPDATE_NAM_DRAGTREEN
+CALL UPDATE_NAM_DRAGBLDGN
CALL UPDATE_NAM_DYNN
CALL UPDATE_NAM_ADVN
CALL UPDATE_NAM_PARAMN
@@ -2827,10 +2962,12 @@ CALL UPDATE_NAM_PARAM_MFSHALLN
CALL UPDATE_NAM_LBCN
CALL UPDATE_NAM_NUDGINGN
CALL UPDATE_NAM_TURBN
+CALL UPDATE_NAM_BLANKN
CALL UPDATE_NAM_CH_MNHCN
CALL UPDATE_NAM_CH_SOLVERN
CALL UPDATE_NAM_SERIESN
CALL UPDATE_NAM_BLOWSNOWN
+CALL UPDATE_NAM_STATIONn
!-------------------------------------------------------------------------------
WRITE(UNIT=ILUOUT,FMT='(/)')
!-------------------------------------------------------------------------------
diff --git a/src/MNH/read_field.f90 b/src/MNH/read_field.f90
index a6523b5d5916d74be0ba7dc13a90343ac83cae1e..1f8d4b3cab8e98abd0698ec2c34249c956ec75ba 100644
--- a/src/MNH/read_field.f90
+++ b/src/MNH/read_field.f90
@@ -1,14 +1,15 @@
-!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_READ_FIELD
! ######################
!
INTERFACE
!
- SUBROUTINE READ_FIELD(TPINIFILE,KIU,KJU,KKU, &
+ SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, &
HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, &
HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR, &
HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, &
@@ -28,14 +29,17 @@ INTERFACE
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
- PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD )
+ PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
+ PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
+ PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS )
!
USE MODD_IO, ONLY : TFILEDATA
USE MODD_TIME ! for type DATE_TIME
!
!
+INTEGER, INTENT(IN) :: KOCEMI !Ocan model index
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
-INTEGER, INTENT(IN) :: KIU, KJU, KKU
+INTEGER, INTENT(IN) :: KIU, KJU, KKU
! array sizes in x, y and z directions
!
CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
@@ -114,6 +118,11 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLU
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF,PIBM_XMUT
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS
!
!
END SUBROUTINE READ_FIELD
@@ -123,7 +132,7 @@ END INTERFACE
END MODULE MODI_READ_FIELD
!
! ########################################################################
- SUBROUTINE READ_FIELD(TPINIFILE,KIU,KJU,KKU, &
+ SUBROUTINE READ_FIELD(KOCEMI,TPINIFILE,KIU,KJU,KKU, &
HGETTKET,HGETRVT,HGETRCT,HGETRRT,HGETRIT,HGETCIT,HGETZWS, &
HGETRST,HGETRGT,HGETRHT,HGETSVT,HGETSRCT,HGETSIGS,HGETCLDFR, &
HGETBL_DEPTH,HGETSBL_DEPTH,HGETPHC,HGETPHR,HUVW_ADV_SCHEME, &
@@ -143,7 +152,9 @@ END MODULE MODI_READ_FIELD
KADVFRC,TPDTADVFRC,PDTHFRC,PDRVFRC, &
KRELFRC,TPDTRELFRC, PTHREL, PRVREL, &
PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLUX_M, &
- PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD )
+ PRUS_PRES,PRVS_PRES,PRWS_PRES,PRTHS_CLD,PRRS_CLD,PRSVS_CLD, &
+ PIBM_LSF,PIBM_XMUT,PUMEANW,PVMEANW,PWMEANW,PUMEANN,PVMEANN, &
+ PWMEANN,PUMEANE,PVMEANE,PWMEANE,PUMEANS,PVMEANS,PWMEANS )
! ########################################################################
!
!!**** *READ_FIELD* - routine to read prognostic and surface fields
@@ -240,12 +251,20 @@ END MODULE MODI_READ_FIELD
! P. Wautelet 13/02/2019: removed PPABSM and PTSTEP dummy arguments (bugfix: PPABSM was intent(OUT))
!! 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
!!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_2D_FRC
+USE MODD_ADV_n
+USE MODD_BLOWSNOW
+USE MODD_BLOWSNOW_n
USE MODD_CH_AEROSOL
USE MODD_CH_M9_n, ONLY: CNAMES, CICNAMES
USE MODD_CONF
@@ -253,34 +272,36 @@ USE MODD_CONF_n
USE MODD_CST
USE MODD_CTURB
USE MODD_DUST
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+use modd_field, only: tfielddata, tfieldlist, TYPEDATE, TYPEREAL,TYPELOG,TYPEINT
USE MODD_FIELD_n, only: XZWS_DEFAULT
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
#endif
-USE MODD_BLOWSNOW
-USE MODD_BLOWSNOW_n
-
+USE MODD_IBM_PARAM_n, ONLY: LIBM
USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LATZ_EDFLX
USE MODD_LG, ONLY: CLGNAMES
USE MODD_LUNIT_N, ONLY: TLUOUT
USE MODD_NSV
+USE MODD_OCEANH
USE MODD_PARAM_C2R2, ONLY: LSUPSAT
!
USE MODD_PARAM_LIMA , ONLY: NMOD_CCN, LSCAV, LAERO_MASS, &
NMOD_IFN, NMOD_IMM, NINDICE_CCN_IMM, LHHONI
USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES, CAERO_MASS
-USE MODD_PARAM_n, ONLY: CSCONV
-USE MODD_ADV_n
+USE MODD_PARAM_n, ONLY: CSCONV
USE MODD_PASPOL
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
+USE MODD_RECYCL_PARAM_n
+USE MODD_REF, ONLY: LCOUPLES
USE MODD_SALT
USE MODD_TIME ! for type DATE_TIME
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME, TYPEDATE, TYPEREAL
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
USE MODE_TOOLS, ONLY: UPCASE
@@ -294,8 +315,9 @@ IMPLICIT NONE
!
!
!
+INTEGER, INTENT(IN) :: KOCEMI !Ocan model index
TYPE(TFILEDATA), INTENT(IN) :: TPINIFILE !Initial file
-INTEGER, INTENT(IN) :: KIU, KJU, KKU
+INTEGER, INTENT(IN) :: KIU, KJU, KKU
! array sizes in x, y and z directions
!
CHARACTER (LEN=*), INTENT(IN) :: HGETTKET, &
@@ -379,10 +401,16 @@ REAL, DIMENSION(:,:,:), INTENT(OUT) :: PVTH_FLUX_M,PWTH_FLUX_M,PVU_FLU
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS_PRES, PRVS_PRES, PRWS_PRES
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRTHS_CLD
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS_CLD, PRSVS_CLD
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_LSF ! LSF for IBM
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PIBM_XMUT ! Turbulent viscosity
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANW,PVMEANW,PWMEANW ! Velocity average at West boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANN,PVMEANN,PWMEANN ! Velocity average at North boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANE,PVMEANE,PWMEANE ! Velocity average at East boundary
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PUMEANS,PVMEANS,PWMEANS ! Velocity average at South boundary
!
!* 0.2 declarations of local variables
!
-INTEGER :: I, IID
+INTEGER :: IID
INTEGER :: ILUOUT ! Unit number for prints
INTEGER :: IRESP
INTEGER :: ISV ! total number of scalar variables
@@ -391,6 +419,7 @@ INTEGER :: JKLOOP,JRR ! Loop indexes
INTEGER :: IIUP,IJUP ! size of working window arrays
INTEGER :: JT ! loop index
LOGICAL :: GLSOURCE ! switch for the source term (for ini_ls and ini_lb)
+LOGICAL :: ZLRECYCL ! switch if turbulence recycling is activated
CHARACTER(LEN=2) :: INDICE
CHARACTER(LEN=3) :: YFRC ! To mark the different forcing dates
CHARACTER(LEN=15) :: YVAL
@@ -584,6 +613,203 @@ SELECT CASE(HGETCIT) ! ice concentration
PCIT(:,:,:)=0.
END SELECT
!
+IF (LIBM .AND. CPROGRAM=='MESONH') THEN
+ !
+ TZFIELD%CMNHNAME = 'LSFP'
+ TZFIELD%CLONGNAME = 'LSFP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_LSF)
+ !
+ TZFIELD%CMNHNAME = 'XMUT'
+ TZFIELD%CLONGNAME = 'XMUT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm2 s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PIBM_XMUT)
+ !
+ENDIF
+!
+TZFIELD%CMNHNAME = 'RECYCLING'
+TZFIELD%CLONGNAME = 'RECYCLING'
+TZFIELD%CSTDNAME = ''
+TZFIELD%CUNITS = ''
+TZFIELD%CDIR = '--'
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPELOG
+TZFIELD%NDIMS = 0
+TZFIELD%LTIMEDEP = .FALSE.
+CALL IO_Field_read(TPINIFILE,TZFIELD,ZLRECYCL,IRESP)
+!If field not found (file from older version of MesoNH) => set ZLRECYCL to false
+IF ( IRESP /= 0 ) ZLRECYCL = .FALSE.
+
+IF (ZLRECYCL) THEN
+ !
+ TZFIELD%CMNHNAME = 'RCOUNT'
+ TZFIELD%CLONGNAME = 'RCOUNT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = '--'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEINT
+ TZFIELD%NDIMS = 0
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,NR_COUNT)
+ !
+ IF (NR_COUNT .NE. 0) THEN
+ IF (LRECYCLW) THEN
+ TZFIELD%CMNHNAME = 'URECYCLW'
+ TZFIELD%CLONGNAME = 'URECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANW)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLW'
+ TZFIELD%CLONGNAME = 'VRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANW)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLW'
+ TZFIELD%CLONGNAME = 'WRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANW)
+ !
+ ENDIF
+ IF (LRECYCLN) THEN
+ TZFIELD%CMNHNAME = 'URECYCLN'
+ TZFIELD%CLONGNAME = 'URECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANN)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLN'
+ TZFIELD%CLONGNAME = 'VRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANN)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLN'
+ TZFIELD%CLONGNAME = 'WRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANN)
+ !
+ ENDIF
+ IF (LRECYCLE) THEN
+ TZFIELD%CMNHNAME = 'URECYCLE'
+ TZFIELD%CLONGNAME = 'URECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANE)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLE'
+ TZFIELD%CLONGNAME = 'VRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANE)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLE'
+ TZFIELD%CLONGNAME = 'WRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANE)
+ !
+ ENDIF
+ IF (LRECYCLS) THEN
+ TZFIELD%CMNHNAME = 'URECYCLS'
+ TZFIELD%CLONGNAME = 'URECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PUMEANS)
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLS'
+ TZFIELD%CLONGNAME = 'VRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PVMEANS)
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLS'
+ TZFIELD%CLONGNAME = 'WRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_read(TPINIFILE,TZFIELD,PWMEANS)
+ ENDIF
+ ENDIF
+ENDIF
+!
! Scalar Variables Reading : Users, C2R2, C1R3, LIMA, ELEC, Chemical SV
!
ISV= SIZE(PSVT,4)
@@ -714,16 +940,19 @@ DO JSV = NSV_LIMA_BEG,NSV_LIMA_END
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(3))//INDICE//'T'
END IF
! N IMM nucl
- I = 0
IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN
- I = I + 1
- WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(I))
+ WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(JSV - NSV_LIMA_IMM_NUCL + 1))
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(4))//INDICE//'T'
END IF
! Hom. freez. of CCN
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))
@@ -796,7 +1025,7 @@ IF (NSV_CHACEND>=NSV_CHACBEG) THEN
CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1) = UPCASE(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))
SELECT CASE(HGETSVT(JSV))
CASE ('READ')
- TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))//'M'
+ TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3,A4)')'X_Y_Z_','CHAQ',JSV,' (M)'
CALL IO_Field_read(TPINIFILE,TZFIELD,PSVT(:,:,:,JSV))
@@ -1317,6 +1546,66 @@ END SELECT
!* 2.4 READ FORCING VARIABLES
! ----------------------
!
+! READ FIELD ONLY FOR MODEL1 (identical for all model in GN)
+IF (LOCEAN .AND. (.NOT.LCOUPLES) .AND. (KOCEMI==1)) THEN
+!
+ CALL IO_Field_read(TPINIFILE,'NFRCLT',NFRCLT)
+ CALL IO_Field_read(TPINIFILE,'NINFRT',NINFRT)
+!
+ TZFIELD%CMNHNAME = 'SSUFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSUFL'
+ TZFIELD%CUNITS = 'kg m-1 s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc stress along U to force ocean LES '
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ ALLOCATE(XSSUFL_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSUFL_T(:))
+!
+ TZFIELD%CMNHNAME = 'SSVFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSVFL'
+ TZFIELD%CUNITS = 'kg m-1 s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc stress along V to force ocean LES '
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ALLOCATE(XSSVFL_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSVFL_T(:))
+!
+ TZFIELD%CMNHNAME = 'SSTFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSTFL'
+ TZFIELD%CUNITS = 'kg m3 K m s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc total heat flux to force ocean LES '
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ ALLOCATE(XSSTFL_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSTFL_T(:))
+!
+ TZFIELD%CMNHNAME = 'SSOLA_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSOLA'
+ TZFIELD%CUNITS = 'kg m3 K m s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc solar flux at sfc to force ocean LES '
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ ALLOCATE(XSSOLA_T(NFRCLT))
+ CALL IO_Field_read(TPINIFILE,TZFIELD,XSSOLA_T(:))
+!
+END IF ! ocean sfc forcing end
+
!
IF ( LFORCING ) THEN
DO JT=1,KFRC
diff --git a/src/MNH/read_grid_time_mesonh_case.f90 b/src/MNH/read_grid_time_mesonh_case.f90
index 58599b38386dd2225254c6590127c93be7efdf97..fba1ea9e956b21a5e3ff451c4a86b8d9b2bce6aa 100644
--- a/src/MNH/read_grid_time_mesonh_case.f90
+++ b/src/MNH/read_grid_time_mesonh_case.f90
@@ -174,23 +174,27 @@ CALL IO_Field_read(TZFMFILE,'RPK', ZRPK_LS)
CALL IO_Field_read(TZFMFILE,'LAT0',ZLAT0_LS)
CALL IO_Field_read(TZFMFILE,'BETA',ZBETA_LS)
!
-IF ( (ABS(ZLAT0_LS-XLAT0)>ZEPS*MAX(1.,ABS(XLAT0))) &
- .OR. (ABS(ZLON0_LS-XLON0)>ZEPS*MAX(1.,ABS(XLON0))) &
- .OR. (ABS(ABS(ZRPK_LS)-ABS(XRPK))>ZEPS*MAX(1.,ABS(XRPK))) &
- .OR. (ABS(ZBETA_LS-XBETA)>ZEPS*MAX(1.,ABS(XBETA))) ) THEN
-!
- WRITE(ILUOUT0,FMT=*) ' '
- WRITE(ILUOUT0,FMT=*) '***************************************************************'
- WRITE(ILUOUT0,FMT=*) 'Projection are different between MESONH input file and PGD file'
- WRITE(ILUOUT0,FMT=*) 'You must recompute a PGD file with PREP_PGD,'
- WRITE(ILUOUT0,FMT=*) 'using the input MESONH file to define its domain.'
- WRITE(ILUOUT0,FMT=*) '***************************************************************'
- WRITE(ILUOUT0,FMT=*) ' '
- WRITE(ILUOUT0,FMT=*) ' input file physiographic data'
- WRITE(ILUOUT0,1) 'LAT0 ',ZLAT0_LS, ' ',XLAT0
- WRITE(ILUOUT0,1) 'LON0 ',ZLON0_LS, ' ',XLON0
- WRITE(ILUOUT0,1) 'RPK ',ZRPK_LS, ' ',XRPK
- WRITE(ILUOUT0,1) 'BETA ',ZBETA_LS, ' ',XBETA
+IF(.NOT.LCARTESIAN) THEN
+ !
+ IF ( (ABS(ZLAT0_LS-XLAT0)>ZEPS*MAX(1.,ABS(XLAT0))) &
+ .OR. (ABS(ZLON0_LS-XLON0)>ZEPS*MAX(1.,ABS(XLON0))) &
+ .OR. (ABS(ABS(ZRPK_LS)-ABS(XRPK))>ZEPS*MAX(1.,ABS(XRPK))) &
+ .OR. (ABS(ZBETA_LS-XBETA)>ZEPS*MAX(1.,ABS(XBETA))) ) THEN
+ !
+ WRITE(ILUOUT0,FMT=*) ' '
+ WRITE(ILUOUT0,FMT=*) '***************************************************************'
+ WRITE(ILUOUT0,FMT=*) 'Projection are different between MESONH input file and PGD file'
+ WRITE(ILUOUT0,FMT=*) 'You must recompute a PGD file with PREP_PGD,'
+ WRITE(ILUOUT0,FMT=*) 'using the input MESONH file to define its domain.'
+ WRITE(ILUOUT0,FMT=*) '***************************************************************'
+ WRITE(ILUOUT0,FMT=*) ' '
+ WRITE(ILUOUT0,FMT=*) ' input file physiographic data'
+ WRITE(ILUOUT0,1) 'LAT0 ',ZLAT0_LS, ' ',XLAT0
+ WRITE(ILUOUT0,1) 'LON0 ',ZLON0_LS, ' ',XLON0
+ WRITE(ILUOUT0,1) 'RPK ',ZRPK_LS, ' ',XRPK
+ WRITE(ILUOUT0,1) 'BETA ',ZBETA_LS, ' ',XBETA
+ END IF
+ !
END IF
!
!* 2.2 Horizontal grid:
diff --git a/src/MNH/read_hgrid.f90 b/src/MNH/read_hgrid.f90
index ec9c7cd44834781c72dda2a054b4dbc66f2868d4..c695be83b8a5a090518995350f0966ca72c00e2f 100644
--- a/src/MNH/read_hgrid.f90
+++ b/src/MNH/read_hgrid.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -81,13 +81,14 @@ END MODULE MODI_READ_HGRID
!* 0. DECLARATIONS
!
USE MODD_CONF, ONLY: CPROGRAM
+use modd_field, only: tfielddata, tfieldlist
USE MODD_GRID
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_PGDDIM
USE MODD_PGDGRID
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO, ONLY: IO_Pack_set
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_GRIDPROJ
diff --git a/src/MNH/read_hgridn.f90 b/src/MNH/read_hgridn.f90
index 04cf40b18a5e061db9bf11b1b3159d2dbe311ce9..41385f588e3808e85c1438f8f4eb9ee7fc763edc 100644
--- a/src/MNH/read_hgridn.f90
+++ b/src/MNH/read_hgridn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -80,13 +80,14 @@ END MODULE MODI_READ_HGRID_n
!
USE MODD_CONF
USE MODD_DIM_n
+use modd_field, only: tfielddata, tfieldlist
USE MODD_GRID
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n
USE MODD_PARAMETERS, ONLY: JPHEXT, JPVEXT, JPMODELMAX
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_GRIDPROJ
USE MODE_IO, only: IO_Pack_set
USE MODE_IO_FIELD_READ, only: IO_Field_read
diff --git a/src/MNH/read_prc_fmfile.f90 b/src/MNH/read_prc_fmfile.f90
index e65d36357bb6261985143735798d9da9145d1215..915c2d970d622b936a4d23e0e15040bcb66fdc83 100644
--- a/src/MNH/read_prc_fmfile.f90
+++ b/src/MNH/read_prc_fmfile.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -101,6 +101,7 @@ END MODULE MODI_READ_PRC_FMFILE
USE MODD_CST
USE MODD_CONF
USE MODD_CONF_n
+use modd_field, only: tfieldlist
USE MODD_PARAM_n
USE MODD_LUNIT
USE MODD_REF
@@ -114,7 +115,7 @@ USE MODD_GRID_n
USE MODD_TIME_n
USE MODD_PREP_REAL
!
-USE MODE_FIELD
+use mode_field, only: Find_field_id_from_mnhname
!
USE MODI_TRUNC_FIELD
USE MODI_DEALLOCATE_MODEL1
diff --git a/src/MNH/read_precip_field.f90 b/src/MNH/read_precip_field.f90
index c8251ed16cbbccf986e54766818b98ac79ff38bd..b8181b6d34e99287c1569e7c0265bb73d4d0904c 100644
--- a/src/MNH/read_precip_field.f90
+++ b/src/MNH/read_precip_field.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -97,12 +97,14 @@ END MODULE MODI_READ_PRECIP_FIELD
!-----------------------------------------------------------------------------
!
!* 0. DECLARATIONS
+
+use modd_field, only: tfielddata, tfieldlist
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAM_ICE, ONLY: LDEPOSC
USE MODD_PARAM_C2R2, ONLY: LDEPOC
USE MODD_PARAM_LIMA, ONLY: MDEPOC=>LDEPOC
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_READ, only: IO_Field_read
!
IMPLICIT NONE
diff --git a/src/MNH/read_surf_mnh.f90 b/src/MNH/read_surf_mnh.f90
index e274f4d85c008a739630af86561798170bc3d9fb..f051ed7393a5eb3042200c278fb0c6af3ebcbf0a 100644
--- a/src/MNH/read_surf_mnh.f90
+++ b/src/MNH/read_surf_mnh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2003-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2003-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -18,7 +18,8 @@ CONTAINS
SUBROUTINE PREPARE_METADATA_READ_SURF(HREC,HDIR,KGRID,KTYPE,KDIMS,HSUBR,TPFIELD)
!
-USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME, TFIELDDATA, TFIELDLIST, TYPECHAR, TYPEDATE, TYPELOG
+use modd_field, only: tfielddata, tfieldlist, TYPECHAR, TYPEDATE, TYPELOG
+use mode_field, only: Find_field_id_from_mnhname
!
CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to write
CHARACTER(LEN=2), INTENT(IN) :: HDIR ! Expected type of the data field (XX,XY,--...)
@@ -140,13 +141,14 @@ END MODULE MODE_READ_SURF_MNH_TOOLS
! ------------
!
USE MODD_CONF, ONLY: CPROGRAM
+use modd_field, only: tfielddata, tfieldlist, TYPEREAL
USE MODD_GRID, ONLY: XRPK,XBETA,XLAT0,XLON0
USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
USE MODD_PARAMETERS, ONLY: JPHEXT, XUNDEF
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TFIELDLIST,FIND_FIELD_ID_FROM_MNHNAME,TYPEREAL
-USE MODE_IO_FIELD_READ, only: IO_Field_read
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_GRIDPROJ
+USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
USE MODE_READ_SURF_MNH_TOOLS
!
@@ -288,24 +290,23 @@ END SUBROUTINE READ_SURFX0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME,TFIELDDATA,TFIELDLIST,TYPEREAL
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_ll
-USE MODE_MSG
-USE MODE_READ_SURF_MNH_TOOLS
-!
USE MODD_CST, ONLY: XPI
-!
+use modd_field, only: tfielddata, tfieldlist, TYPEREAL
USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, &
NIU, NJU, NIB, NJB, NIE, NJE, &
NIU_ALL, NJU_ALL, NIB_ALL, &
NJB_ALL, NIE_ALL, NJE_ALL, &
NMASK_ALL
USE MODD_PARAMETERS, ONLY: XUNDEF
-!
-USE MODI_PACK_2D_1D
+
+use mode_field, only: Find_field_id_from_mnhname
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_ll
+USE MODE_MSG
+USE MODE_READ_SURF_MNH_TOOLS
!
USE MODI_GET_SURF_UNDEF
+USE MODI_PACK_2D_1D
!
IMPLICIT NONE
!
@@ -580,19 +581,18 @@ END SUBROUTINE READ_SURFX1_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_MSG
-USE MODE_READ_SURF_MNH_TOOLS
-!
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, NIU, NJU, NIB, NJB, NIE, NJE, &
NIU_ALL, NJU_ALL, NIB_ALL, NJB_ALL, NIE_ALL, NJE_ALL, NMASK_ALL
USE MODD_PARAMETERS, ONLY: XUNDEF
-!
-USE MODI_PACK_2D_1D
+
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_ll
+USE MODE_MSG
+USE MODE_READ_SURF_MNH_TOOLS
!
USE MODI_GET_SURF_UNDEF
+USE MODI_PACK_2D_1D
!
IMPLICIT NONE
!
@@ -715,21 +715,20 @@ END SUBROUTINE READ_SURFX2_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_ll
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_MSG
-USE MODE_READ_SURF_MNH_TOOLS
-!
-USE MODD_DATA_COVER_PAR, ONLY: JPCOVER
USE MODD_CST, ONLY: XPI
-!
+USE MODD_DATA_COVER_PAR, ONLY: JPCOVER
+use modd_field, only: tfielddata, TYPELOG, TYPEREAL
USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, &
NIU, NJU, NIB, NJB, NIE, NJE, &
NIU_ALL, NJU_ALL, NIB_ALL, &
NJB_ALL, NIE_ALL, NJE_ALL, &
NMASK_ALL
!
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_ll
+USE MODE_MSG
+USE MODE_READ_SURF_MNH_TOOLS
+!
USE MODI_PACK_2D_1D
!
IMPLICIT NONE
@@ -911,19 +910,18 @@ END SUBROUTINE READ_SURFX2COV_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
-USE MODE_IO_FIELD_READ, only: IO_Field_read
-USE MODE_ll
-USE MODE_MSG
-!
USE MODD_CST, ONLY: XPI
-!
+use modd_field, only: tfielddata, TYPELOG, TYPEREAL
USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, &
NIU, NJU, NIB, NJB, NIE, NJE, &
NIU_ALL, NJU_ALL, NIB_ALL, &
NJB_ALL, NIE_ALL, NJE_ALL, &
NMASK_ALL
!
+USE MODE_IO_FIELD_READ, only: IO_Field_read
+USE MODE_ll
+USE MODE_MSG
+!
USE MODI_PACK_2D_1D
!
IMPLICIT NONE
@@ -1095,18 +1093,16 @@ END SUBROUTINE READ_SURFX2COV_1COV_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
+USE MODD_CONF, ONLY: CPROGRAM
+use modd_field, only: tfielddata, TYPEINT
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, &
+ NIU, NJU, NIB, NJB, NIE, NJE
+
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
USE MODE_MSG
USE MODE_READ_SURF_MNH_TOOLS
-!
-USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, &
- NIU, NJU, NIB, NJB, NIE, NJE
-USE MODD_CONF, ONLY: CPROGRAM
-!
-!
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1193,14 +1189,14 @@ END SUBROUTINE READ_SURFN0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
+use modd_field, only: tfielddata, TYPEINT
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, &
+ NIU, NJU, NIB, NJB, NIE, NJE
+!
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
USE MODE_READ_SURF_MNH_TOOLS
!
-USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, &
- NIU, NJU, NIB, NJB, NIE, NJE
-!
USE MODI_PACK_2D_1D
!
IMPLICIT NONE
@@ -1301,18 +1297,17 @@ END SUBROUTINE READ_SURFN1_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPECHAR
+USE MODD_CONF, ONLY: LCARTESIAN, CPROGRAM
+use modd_field, only: tfielddata, TYPECHAR
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
+USE MODD_LUNIT, ONLY: TPGDFILE
+
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
USE MODE_MSG
USE MODE_POS
USE MODE_READ_SURF_MNH_TOOLS
-!
-USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
-USE MODD_CONF, ONLY: LCARTESIAN, CPROGRAM
-USE MODD_LUNIT, ONLY: TPGDFILE
-!
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1458,18 +1453,16 @@ END SUBROUTINE READ_SURFC0_MNH
!* 0. DECLARATIONS
! ------------
!
+use modd_field, only: tfielddata, TYPEINT, TYPELOG
USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE, NMASK, &
NIU, NJU, NIB, NJB, NIE, NJE
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT,TYPELOG
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
USE MODE_READ_SURF_MNH_TOOLS
!
USE MODI_PACK_2D_1D
!
-!
-!
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1576,14 +1569,13 @@ END SUBROUTINE READ_SURFL1_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG
+use modd_field, only: tfielddata, TYPELOG
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
+
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
USE MODE_READ_SURF_MNH_TOOLS
-!
-USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
-!
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1673,14 +1665,13 @@ END SUBROUTINE READ_SURFL0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPECHAR
+use modd_field, only: tfielddata, TYPECHAR
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
+USE MODD_TYPE_DATE
+
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
-!
-USE MODD_TYPE_DATE
-USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
-!
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1748,10 +1739,10 @@ IF (KRESP /=0) THEN
WRITE(ILUOUT,*) ' '
ENDIF
!
-KYEAR = TZDATETIME%TDATE%YEAR
-KMONTH = TZDATETIME%TDATE%MONTH
-KDAY = TZDATETIME%TDATE%DAY
-PTIME = TZDATETIME%TIME
+KYEAR = TZDATETIME%nyear
+KMONTH = TZDATETIME%nmonth
+KDAY = TZDATETIME%nday
+PTIME = TZDATETIME%xtime
!
!-------------------------------------------------------------------------------
END SUBROUTINE READ_SURFT0_MNH
@@ -1797,13 +1788,12 @@ END SUBROUTINE READ_SURFT0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPECHAR, TYPEINT, TYPEREAL
+use modd_field, only: tfielddata, TYPECHAR, TYPEINT, TYPEREAL
+USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
+
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_MSG
-!
-USE MODD_IO_SURF_MNH, ONLY: TOUT, TPINFILE
-!
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1887,7 +1877,7 @@ IF (KRESP /=0) THEN
WRITE(ILUOUT,*) ' '
ENDIF
!
-TZFIELD%CMNHNAME = TRIM(HREC)//'%TIME'
+TZFIELD%CMNHNAME = TRIM(HREC)//'%xtime'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = ''
diff --git a/src/MNH/read_ver_grid.f90 b/src/MNH/read_ver_grid.f90
index fb5ee72d1c296ff35af91332ed411b137b151bb0..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.
@@ -114,7 +114,7 @@ USE MODE_POS
!
USE MODI_DEFAULT_SLEVE
!
-USE MODN_BLANK
+USE MODN_BLANK_n
!
IMPLICIT NONE
!
@@ -194,8 +194,12 @@ XLEN2_n = XLEN2
!
IF (CPROGRAM=='REAL ') THEN
IF (ASSOCIATED (XZHAT) ) DEALLOCATE(XZHAT)
- CALL POSNAM(IPRE_REAL1,'NAM_BLANK',GFOUND,ILUOUT0)
- IF (GFOUND) READ(UNIT=IPRE_REAL1,NML=NAM_BLANK)
+ CALL POSNAM(IPRE_REAL1,'NAM_BLANKN',GFOUND,ILUOUT0)
+ IF (GFOUND) THEN
+ CALL INIT_NAM_BLANKn
+ READ(UNIT=IPRE_REAL1,NML=NAM_BLANKn)
+ CALL UPDATE_NAM_BLANKn
+ END IF
END IF
!
IKB=JPVEXT+1
diff --git a/src/MNH/recycl_fluc.f90 b/src/MNH/recycl_fluc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2ee5471c1cbaf789bda33b71efde9b70cdb644e8
--- /dev/null
+++ b/src/MNH/recycl_fluc.f90
@@ -0,0 +1,491 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_RECYCL_FLUC
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE RECYCL_FLUC (PPTABU,PPTABV,PPTABW,PTHT,PDZZ,ONR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS )
+
+ INTEGER ,INTENT(IN) :: ONR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PPTABU,PPTABV,PPTABW,PTHT,PDZZ
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+
+END SUBROUTINE RECYCL_FLUC
+!
+END INTERFACE
+!
+END MODULE MODI_RECYCL_FLUC
+!
+!
+!
+! ####################################
+ SUBROUTINE RECYCL_FLUC (PPTABU,PPTABV,PPTABW,PTHT,PDZZ,ONR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS, &
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS )
+
+! ####################################
+!
+!!**** *RECYCL_FLUC* - routine calculating the velocity forcing fluctuations
+!
+!!
+!! PURPOSE
+!! -------
+! RECYCLING METHOD
+!
+!! METHOD
+!! ------
+!!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Tim Nagel * Meteo-France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/2021
+!!
+!------------------------------------------------------------------------------
+!
+!**** 0. DECLARATIONS
+! ---------------
+!
+! module
+USE MODE_POS
+USE MODE_ll
+USE MODE_IO
+USE MODI_SHUMAN
+!
+! declaration
+USE MODD_VAR_ll, ONLY: IP, NPROC
+USE MODD_CONF, ONLY: NHALO
+!
+USE MODD_RECYCL_PARAM_n
+!
+USE MODD_PARAMETERS
+USE MODD_CONF
+!
+USE MODD_CST
+!
+USE MODD_DIM_n
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_METRICS_n
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_DYN_n
+USE MODD_FIELD_n
+USE MODD_CURVCOR_n
+USE MODI_GRADIENT_M
+USE MODI_GRADIENT_W
+USE MODI_GRADIENT_U
+USE MODI_GRADIENT_V
+USE MODE_GRIDPROJ
+USE MODD_REF
+USE MODD_LATZ_EDFLX
+!
+USE MODI_MEAN_Z
+!
+IMPLICIT NONE
+!
+!------------------------------------------------------------------------------
+!
+! 0.1 declarations of arguments
+ INTEGER ,INTENT(IN) :: ONR_COUNT,OPT_COUNT,PMINW,PMINN,PMINE,PMINS
+ REAL, DIMENSION(:,:,:) ,INTENT(IN) :: PPTABU,PPTABV,PPTABW,PTHT,PDZZ
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+!
+!------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+INTEGER :: IIU,IJU,IKU,IIP,JJ,JI,JK,IIB,IJB,IIE,IJE,IKE,IKB
+INTEGER :: ICOUNT,JCOUNT,IIMAX_ll,IJMAX_ll
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUTN,ZTMPVNN,ZTMPWTN !Velocity in the recycling Plan, NORTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUTN,ZTMPFVNN,ZTMPFWTN !Fluctuations in the recycling Plan, NORTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUNW,ZTMPVTW,ZTMPWTW !Velocity in the recycling Plan, WEST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUNW,ZTMPFVTW,ZTMPFWTW !Fluctuations in the recycling Plan, WEST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUNE,ZTMPVTE,ZTMPWTE !Velocity in the recycling Plan EAST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUNE,ZTMPFVTE,ZTMPFWTE !Fluctuations in the recycling Plan, EAST
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPUTS,ZTMPVNS,ZTMPWTS !Velocity in the recycling Plan, SOUTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPFUTS,ZTMPFVNS,ZTMPFWTS !Fluctuations in the recycling Plan, SOUTH
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZTMPZ
+REAL,DIMENSION(:,:) ,ALLOCATABLE :: ZALPNORTH,ZALPWEST,ZALPSOUTH,ZALPEAST !Coefficient for the fluctuation (ZALP IN [0-1])
+REAL, DIMENSION(:,:) ,ALLOCATABLE :: ZTMPNDW,ZTMPNDN,ZTMPNDE,ZTMPNDS !Brunt Vaisala frequency
+REAL, DIMENSION(:,:,:) ,ALLOCATABLE :: ZND,ZWORK32 !Brunt Vaisala frequency (3D fields)
+INTEGER :: IINFO_ll
+
+!------------------------------------------------------------------------------
+!
+! *** Allocation and dimension
+!
+CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+CALL GET_GLOBALDIMS_ll(IIMAX_ll,IJMAX_ll)
+IKU = SIZE(PPTABU,3)
+IKE=IKU-JPVEXT
+IKB = 1 + JPVEXT
+
+ALLOCATE(ZWORK32(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+ALLOCATE(ZND(SIZE(PTHT,1),SIZE(PTHT,2),SIZE(PTHT,3)))
+
+!
+! *** Dry Brunt Vaisala frequency
+!
+ZWORK32(:,:,:)=DZM(PTHT(:,:,:))/ MZM(PTHT(:,:,:))
+DO JK=1,(IKE+1)
+ DO JJ=1,(IJE+1)
+ DO JI=1,(IIE+1)
+ IF(ZWORK32(JI,JJ,JK)<0.) THEN
+ ZND(JI,JJ,JK)= -1.*SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ PDZZ(JI,JJ,JK) ))
+ ELSE
+ ZND(JI,JJ,JK)= SQRT( ABS( XG*ZWORK32(JI,JJ,JK)/ PDZZ(JI,JJ,JK) ) )
+ ENDIF
+ ENDDO
+ ENDDO
+ENDDO
+ZND(:,:,:) = ABS(ZND(:,:,:))
+DO JK=1,(IKE+1)
+ DO JJ=1,(IJE+1)
+ DO JI=1,(IIE+1)
+ IF(ZND(JI,JJ,JK)>1.E6) THEN
+ ZND(JI,JJ,JK)= 1.E6
+ ELSEIF(ZND(JI,JJ,JK)<1.E-6) THEN
+ ZND(JI,JJ,JK)= 1.E-6
+ ENDIF
+ ZND(JI,JJ,JK) = 1./ZND(JI,JJ,JK)
+ ENDDO
+ ENDDO
+ENDDO
+IF (LWEST_ll ()) ZND(IIB-1,:,:)=ZND(IIB,:,:)
+IF (LNORTH_ll()) ZND(:,IJE+1,:)=ZND(:,IJE,:)
+IF (LEAST_ll ()) ZND(IIE+1,:,:)=ZND(IIE,:,:)
+IF (LSOUTH_ll()) ZND(:,IJB-1,:)=ZND(:,IJB,:)
+ZND(:,:,IKE+1)=ZND(:,:,IKE)
+ZND(:,:,IKB-1)=ZND(:,:,IKB)
+
+
+IF (LRECYCLW) THEN
+ !-------------------------------------------------------
+ !-----------WEST
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUNW (IJU,IKU))
+ ALLOCATE(ZTMPVTW (IJU,IKU))
+ ALLOCATE(ZTMPWTW (IJU,IKU))
+ ALLOCATE(ZTMPZ (IJU,IKU))
+ ALLOCATE(ZTMPNDW (IJU,IKU))
+ ALLOCATE(ZALPWEST (IJU,IKU))
+ ALLOCATE(ZTMPFUNW (IJU,IKU))
+ ALLOCATE(ZTMPFVTW (IJU,IKU))
+ ALLOCATE(ZTMPFWTW (IJU,IKU))
+ ZTMPUNW =0.
+ ZTMPVTW =0.
+ ZTMPWTW =0.
+ ZTMPZ =0.
+ ZTMPNDW =0.
+ ZALPWEST=0.
+ CALL GET_2DSLICE_ll(PPTABU,'Y',PMINW,ZTMPUNW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'Y',PMINW,ZTMPVTW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'Y',PMINW,ZTMPWTW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'Y',PMINW,ZTMPZ(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'Y',1+JPHEXT,ZTMPNDW(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(ONR_COUNT.LE.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=ONR_COUNT/XTMOYCOUNT
+ XUMEANW(:,:,ICOUNT)=ZTMPUNW(:,:)
+ XVMEANW(:,:,ICOUNT)=ZTMPVTW(:,:)
+ XWMEANW(:,:,ICOUNT)=ZTMPWTW(:,:)
+ ENDIF
+ IF(ONR_COUNT.GT.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANW(:,:,JCOUNT)=XUMEANW(:,:,JCOUNT+1)
+ XVMEANW(:,:,JCOUNT)=XVMEANW(:,:,JCOUNT+1)
+ XWMEANW(:,:,JCOUNT)=XWMEANW(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANW(:,:,INT(XNUMBELT))=ZTMPUNW(:,:)
+ XVMEANW(:,:,INT(XNUMBELT))=ZTMPVTW(:,:)
+ XWMEANW(:,:,INT(XNUMBELT))=ZTMPWTW(:,:)
+ ENDIF
+ IF (LWEST_ll( )) THEN
+ DO JJ = 1,IJU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDW(JJ,JK)>XTBVTOP) THEN
+ ZALPWEST(JJ,JK)=1.
+ ELSE IF (ZTMPNDW(JJ,JK)<XTBVBOT) THEN
+ ZALPWEST(JJ,JK)=0.
+ ELSE
+ ZALPWEST(JJ,JK)=1./ABS(XTBVTOP-XTBVBOT)*ABS(ZTMPNDW(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(NR_COUNT.GT.XTMOY) THEN
+ ZTMPFUNW =ZTMPUNW(:,:)-(SUM(XUMEANW,DIM=3)/INT(XNUMBELT))
+ ZTMPFVTW =ZTMPVTW(:,:)-(SUM(XVMEANW,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTW =ZTMPWTW(:,:)-(SUM(XWMEANW,DIM=3)/INT(XNUMBELT))
+ PFLUCTUNW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUNW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPWEST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTVTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPWEST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTW(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPWEST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPUNW,ZTMPVTW,ZTMPWTW,ZTMPZ,ZTMPNDW,ZALPWEST,ZTMPFUNW,ZTMPFVTW,ZTMPFWTW)
+ENDIF
+
+IF (LRECYCLN) THEN
+ !-------------------------------------------------------
+ !-----------NORTH
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUTN (IIU,IKU))
+ ALLOCATE(ZTMPVNN (IIU,IKU))
+ ALLOCATE(ZTMPWTN (IIU,IKU))
+ ALLOCATE(ZTMPZ (IIU,IKU))
+ ALLOCATE(ZTMPNDN (IIU,IKU))
+ ALLOCATE(ZALPNORTH (IIU,IKU))
+ ALLOCATE(ZTMPFUTN (IIU,IKU))
+ ALLOCATE(ZTMPFVNN (IIU,IKU))
+ ALLOCATE(ZTMPFWTN (IIU,IKU))
+ ZTMPUTN =0.
+ ZTMPVNN =0.
+ ZTMPWTN =0.
+ ZTMPZ =0.
+ ZTMPNDN =0.
+ ZALPNORTH=0.
+ CALL GET_2DSLICE_ll(PPTABU,'X',PMINN,ZTMPUTN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'X',PMINN,ZTMPVNN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'X',PMINN,ZTMPWTN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'X',PMINN,ZTMPZ(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'X',IJMAX_ll+JPHEXT,ZTMPNDN(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(ONR_COUNT.LE.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=ONR_COUNT/XTMOYCOUNT
+ XUMEANN(:,:,ICOUNT)=ZTMPUTN(:,:)
+ XVMEANN(:,:,ICOUNT)=ZTMPVNN(:,:)
+ XWMEANN(:,:,ICOUNT)=ZTMPWTN(:,:)
+ ENDIF
+ IF(ONR_COUNT.GT.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANN(:,:,JCOUNT)=XUMEANN(:,:,JCOUNT+1)
+ XVMEANN(:,:,JCOUNT)=XVMEANN(:,:,JCOUNT+1)
+ XWMEANN(:,:,JCOUNT)=XWMEANN(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANN(:,:,INT(XNUMBELT))=ZTMPUTN(:,:)
+ XVMEANN(:,:,INT(XNUMBELT))=ZTMPVNN(:,:)
+ XWMEANN(:,:,INT(XNUMBELT))=ZTMPWTN(:,:)
+ ENDIF
+
+ IF (LNORTH_ll( )) THEN
+ DO JJ = 1,IIU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDN(JJ,JK)>XTBVTOP) THEN
+ ZALPNORTH(JJ,JK)=1.
+ ELSE IF (ZTMPNDN(JJ,JK)<XTBVBOT) THEN
+ ZALPNORTH(JJ,JK)=0.
+ ELSE
+ ZALPNORTH(JJ,JK)=1./(XTBVTOP-XTBVBOT)*(ZTMPNDN(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(NR_COUNT.GT.XTMOY) THEN
+ ZTMPFUTN =ZTMPUTN(:,:)-(SUM(XUMEANN,DIM=3)/INT(XNUMBELT))
+ ZTMPFVNN =ZTMPVNN(:,:)-(SUM(XVMEANN,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTN =ZTMPWTN(:,:)-(SUM(XWMEANN,DIM=3)/INT(XNUMBELT))
+ PFLUCTVNN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVNN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPNORTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTUTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPNORTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTN(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPNORTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPVNN,ZTMPUTN,ZTMPWTN,ZTMPZ,ZTMPNDN,ZALPNORTH,ZTMPFVNN,ZTMPFUTN,ZTMPFWTN)
+ENDIF
+
+IF (LRECYCLE) THEN
+ !-------------------------------------------------------
+ !-----------EAST
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUNE (IJU,IKU))
+ ALLOCATE(ZTMPVTE (IJU,IKU))
+ ALLOCATE(ZTMPWTE (IJU,IKU))
+ ALLOCATE(ZTMPZ (IJU,IKU))
+ ALLOCATE(ZTMPNDE (IJU,IKU))
+ ALLOCATE(ZALPEAST (IJU,IKU))
+ ALLOCATE(ZTMPFUNE (IJU,IKU))
+ ALLOCATE(ZTMPFVTE (IJU,IKU))
+ ALLOCATE(ZTMPFWTE (IJU,IKU))
+ ZTMPUNE =0.
+ ZTMPVTE =0.
+ ZTMPWTE =0.
+ ZTMPZ =0.
+ ZTMPNDE =0.
+ ZALPEAST=0.
+ CALL GET_2DSLICE_ll(PPTABU,'Y',PMINE,ZTMPUNE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'Y',PMINE,ZTMPVTE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'Y',PMINE,ZTMPWTE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'Y',PMINE,ZTMPZ(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'Y',IIMAX_ll+JPHEXT,ZTMPNDE(1:IJU,1:IKU), &
+ 1,IJU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(ONR_COUNT.LE.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=ONR_COUNT/XTMOYCOUNT
+ XUMEANE(:,:,ICOUNT)=ZTMPUNE(:,:)
+ XVMEANE(:,:,ICOUNT)=ZTMPVTE(:,:)
+ XWMEANE(:,:,ICOUNT)=ZTMPWTE(:,:)
+ ENDIF
+ IF(ONR_COUNT.GT.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANE(:,:,JCOUNT)=XUMEANE(:,:,JCOUNT+1)
+ XVMEANE(:,:,JCOUNT)=XVMEANE(:,:,JCOUNT+1)
+ XWMEANE(:,:,JCOUNT)=XWMEANE(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANE(:,:,INT(XNUMBELT))=ZTMPUNE(:,:)
+ XVMEANE(:,:,INT(XNUMBELT))=ZTMPVTE(:,:)
+ XWMEANE(:,:,INT(XNUMBELT))=ZTMPWTE(:,:)
+ ENDIF
+ IF (LEAST_ll( )) THEN
+ DO JJ = 1,IJU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDE(JJ,JK)>XTBVTOP) THEN
+ ZALPEAST(JJ,JK)=1.
+ ELSE IF (ZTMPNDE(JJ,JK)<XTBVBOT) THEN
+ ZALPEAST(JJ,JK)=0.
+ ELSE
+ ZALPEAST(JJ,JK)=1./ABS(XTBVTOP-XTBVBOT)*ABS(ZTMPNDE(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(NR_COUNT.GT.XTMOY) THEN
+ ZTMPFUNE =ZTMPUNE(:,:)-(SUM(XUMEANE,DIM=3)/INT(XNUMBELT))
+ ZTMPFVTE =ZTMPVTE(:,:)-(SUM(XVMEANE,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTE =ZTMPWTE(:,:)-(SUM(XWMEANE,DIM=3)/INT(XNUMBELT))
+ PFLUCTUNE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUNE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPEAST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTVTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPEAST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTE(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPEAST(1+JPHEXT:IJU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPUNE,ZTMPVTE,ZTMPWTE,ZTMPZ,ZTMPNDE,ZALPEAST,ZTMPFUNE,ZTMPFVTE,ZTMPFWTE)
+ENDIF
+!
+IF (LRECYCLS) THEN
+ !-------------------------------------------------------
+ !-----------SOUTH
+ !------------------------------------------------------
+ ALLOCATE(ZTMPUTS (IIU,IKU))
+ ALLOCATE(ZTMPVNS (IIU,IKU))
+ ALLOCATE(ZTMPWTS (IIU,IKU))
+ ALLOCATE(ZTMPZ (IIU,IKU))
+ ALLOCATE(ZTMPNDS (IIU,IKU))
+ ALLOCATE(ZALPSOUTH (IIU,IKU))
+ ALLOCATE(ZTMPFUTS (IIU,IKU))
+ ALLOCATE(ZTMPFVNS (IIU,IKU))
+ ALLOCATE(ZTMPFWTS (IIU,IKU))
+ ZTMPUTS =0.
+ ZTMPVNS =0.
+ ZTMPWTS =0.
+ ZTMPZ =0.
+ ZTMPNDS =0.
+ ZALPSOUTH=0.
+ CALL GET_2DSLICE_ll(PPTABU,'X',PMINS,ZTMPUTS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABV,'X',PMINS,ZTMPVNS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PPTABW,'X',PMINS,ZTMPWTS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(PDZZ,'X',PMINS,ZTMPZ(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ CALL GET_2DSLICE_ll(ZND,'X',1+JPHEXT,ZTMPNDS(1:IIU,1:IKU), &
+ 1,IIU,1,IKU,IINFO_ll)
+ !
+ ! *** Mean and fluctuations calculation
+ !
+ IF(ONR_COUNT.LE.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0) THEN
+ ICOUNT=ONR_COUNT/XTMOYCOUNT
+ XUMEANS(:,:,ICOUNT)=ZTMPUTS(:,:)
+ XVMEANS(:,:,ICOUNT)=ZTMPVNS(:,:)
+ XWMEANS(:,:,ICOUNT)=ZTMPWTS(:,:)
+ ENDIF
+ IF(ONR_COUNT.GT.XTMOY.AND.MOD(ONR_COUNT,INT(XTMOYCOUNT))==0.AND.OPT_COUNT/=1) THEN
+ DO JCOUNT=1,INT(XNUMBELT)-1
+ XUMEANS(:,:,JCOUNT)=XUMEANS(:,:,JCOUNT+1)
+ XVMEANS(:,:,JCOUNT)=XVMEANS(:,:,JCOUNT+1)
+ XWMEANS(:,:,JCOUNT)=XWMEANS(:,:,JCOUNT+1)
+ ENDDO
+ XUMEANS(:,:,INT(XNUMBELT))=ZTMPUTS(:,:)
+ XVMEANS(:,:,INT(XNUMBELT))=ZTMPVNS(:,:)
+ XWMEANS(:,:,INT(XNUMBELT))=ZTMPWTS(:,:)
+ ENDIF
+ IF (LSOUTH_ll( )) THEN
+ DO JJ = 1,IIU-1
+ DO JK = 1,IKU-1
+ IF (ZTMPNDS(JJ,JK)>XTBVTOP) THEN
+ ZALPSOUTH(JJ,JK)=1.
+ ELSE IF (ZTMPNDS(JJ,JK)<XTBVBOT) THEN
+ ZALPSOUTH(JJ,JK)=0.
+ ELSE
+ ZALPSOUTH(JJ,JK)=1./(XTBVTOP-XTBVBOT)*(ZTMPNDS(JJ,JK)-XTBVBOT)*1.
+ ENDIF
+ ENDDO
+ ENDDO
+ IF(NR_COUNT.GT.XTMOY) THEN
+ ZTMPFUTS =ZTMPUTS(:,:)-(SUM(XUMEANS,DIM=3)/INT(XNUMBELT))
+ ZTMPFVNS =ZTMPVNS(:,:)-(SUM(XVMEANS,DIM=3)/INT(XNUMBELT))
+ ZTMPFWTS =ZTMPWTS(:,:)-(SUM(XWMEANS,DIM=3)/INT(XNUMBELT))
+ PFLUCTVNS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFVNS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPSOUTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTUTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFUTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPSOUTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ PFLUCTWTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)= ZTMPFWTS(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)* &
+ ZALPSOUTH(1+JPHEXT:IIU-JPHEXT,1+JPVEXT:IKU-JPVEXT)
+ ENDIF
+ ENDIF
+ DEALLOCATE(ZTMPVNS,ZTMPUTS,ZTMPWTS,ZTMPZ,ZTMPNDS,ZALPSOUTH,ZTMPFVNS,ZTMPFUTS,ZTMPFWTS)
+ENDIF
+
+DEALLOCATE(ZWORK32,ZND)
+
+RETURN
+
+END SUBROUTINE RECYCL_FLUC
diff --git a/src/MNH/recycling.f90 b/src/MNH/recycling.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9734eebc00e2f5bc16e8e923bfdc04cba2f120e7
--- /dev/null
+++ b/src/MNH/recycling.f90
@@ -0,0 +1,184 @@
+!MNH_LIC Copyright 2021-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #####################
+ MODULE MODI_RECYCLING
+! #####################
+!
+INTERFACE
+!
+SUBROUTINE RECYCLING (PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS, &
+ PTCOUNT)
+
+ INTEGER ,INTENT(IN) :: PTCOUNT
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+ REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+
+END SUBROUTINE RECYCLING
+!
+END INTERFACE
+!
+END MODULE MODI_RECYCLING
+!
+!
+!
+! ####################################
+ SUBROUTINE RECYCLING (PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS, &
+ PTCOUNT)
+! ####################################
+!
+!!**** *RECYCLING* - routine initializing and building the velocity fluctuations fields
+!!
+!! PURPOSE
+!! -------
+! The purpose of this routine is to initialize and calculate
+! turbulent fluctuations in order to be applied at the domain
+! boundaries.
+!
+!! METHOD
+!! ------
+!!!
+!! EXTERNAL
+!! --------
+!! NONE
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! Tim Nagel * Meteo-France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/2021
+!!
+!------------------------------------------------------------------------------
+!
+!**** 0. DECLARATIONS
+! ---------------
+!
+! module
+USE MODE_POS
+USE MODE_ll
+USE MODE_IO
+!USE MODI_SHUMAN
+!
+USE MODD_PARAMETERS
+USE MODD_CONF
+!
+USE MODD_CST
+!
+USE MODD_DIM_n
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_METRICS_n
+USE MODD_TIME
+USE MODD_TIME_n
+USE MODD_DYN_n
+USE MODD_FIELD_n
+USE MODD_CURVCOR_n
+USE MODD_REF
+!
+USE MODD_VAR_ll, ONLY: IP, NPROC
+USE MODD_RECYCL_PARAM_n
+USE MODI_RECYCL_FLUC
+USE MODD_LUNIT_n, ONLY : TLUOUT
+!
+IMPLICIT NONE
+!
+!------------------------------------------------------------------------------
+!
+! 0.1 declarations of arguments
+INTEGER ,INTENT(IN) :: PTCOUNT ! temporal loop index of model KMODEL
+REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNW,PFLUCTVTW,PFLUCTVNN,PFLUCTUTN,PFLUCTWTW,PFLUCTWTN
+REAL, DIMENSION(:,:) ,INTENT(INOUT) :: PFLUCTUNE,PFLUCTVTE,PFLUCTVNS,PFLUCTUTS,PFLUCTWTE,PFLUCTWTS
+!
+!------------------------------------------------------------------------------
+!
+! 0.2 declaration of local variables
+INTEGER :: IIU,IJU,IKU,JCOUNT,ICOUNT,ILUOUT
+INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE,IIP
+INTEGER :: IIBG,IIEG,IJBG,IJEG,IIMAX,IJMAX
+INTEGER :: PMINW,PMINE,PMINN,PMINS
+INTEGER :: JIDIST,JJDIST
+REAL :: Z_DELTX,Z_DELTY
+!
+!------------------------------------------------------------------------------
+!
+! 0.3 allocation
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+IKU=NKMAX+2*JPVEXT
+PMINW=0
+PMINN=0
+PMINS=0
+PMINE=0
+
+CALL GET_OR_ll('B',IIBG,IJBG)
+IIBG = IIBG+IIB-1
+IJBG = IJBG+IJB-1
+CALL GET_GLOBALDIMS_ll( IIMAX,IJMAX)
+IIEG=IIBG+IIE-IIB
+IJEG=IJBG+IJE-IJB
+Z_DELTX = XXHAT(2)-XXHAT(1)
+Z_DELTY = XYHAT(2)-XYHAT(1)
+
+
+ILUOUT = TLUOUT%NLU
+!------------------------------------------------------------------------------
+!
+!**** 1. Recycling distance calculation
+! ---------------
+!
+!Moving averaged parameter verification
+IF (PTCOUNT==1 .AND. INT(XTMOY)/INT(XTMOYCOUNT) /= INT(XNUMBELT)) THEN
+ CMNHMSG(1) = 'XTMOY/XTMOYCOUNT must be equal to XNUMBELT'
+ CMNHMSG(2) = 'Please change the above parameters accordingly in NAM_RECYCL_PARAMn'
+ CALL PRINT_MSG( NVERB_FATAL, 'GEN', 'RECYCLING' )
+END IF
+
+IF(CCONF == "RESTA" .AND. PTCOUNT == 1 ) THEN
+ NR_COUNT = NR_COUNT
+ELSE
+ NR_COUNT = NR_COUNT +1
+ !IF (IP==1) WRITE(*,*)'RCOUNT: ', NR_COUNT
+ENDIF
+
+ IF (LRECYCLW) THEN
+ JIDIST = INT(XDRECYCLW*cos(XARECYCLW)/Z_DELTX)
+ JJDIST = INT(XDRECYCLW*sin(XARECYCLW)/Z_DELTY)
+ PMINW = 1+JPHEXT+JIDIST
+ ENDIF
+ IF (LRECYCLN) THEN
+ JIDIST = INT(XDRECYCLN*cos(XARECYCLN)/Z_DELTX)
+ JJDIST = INT(XDRECYCLN*sin(XARECYCLN)/Z_DELTY)
+ PMINN = 1+JPHEXT+JJDIST
+ ENDIF
+ IF (LRECYCLE) THEN
+ JIDIST = INT(XDRECYCLE*cos(XARECYCLE)/Z_DELTX)
+ JJDIST = INT(XDRECYCLE*sin(XARECYCLE)/Z_DELTY)
+ PMINE = 1+JPHEXT+JIDIST
+ ENDIF
+ IF (LRECYCLS) THEN
+ JIDIST = INT(XDRECYCLS*cos(XARECYCLS)/Z_DELTX)
+ JJDIST = INT(XDRECYCLS*sin(XARECYCLS)/Z_DELTY)
+ PMINS = 1+JPHEXT+JJDIST!
+ ENDIF
+
+ CALL RECYCL_FLUC (XUT,XVT,XWT,XTHT,XDZZ,NR_COUNT,PTCOUNT,PMINW,PMINN,PMINE,PMINS,&
+ PFLUCTUNW,PFLUCTVNN,PFLUCTUTN,PFLUCTVTW,PFLUCTWTW,PFLUCTWTN, &
+ PFLUCTUNE,PFLUCTVNS,PFLUCTUTS,PFLUCTVTE,PFLUCTWTE,PFLUCTWTS )
+
+RETURN
+
+END SUBROUTINE RECYCLING
+
diff --git a/src/MNH/rel_forcingn.f90 b/src/MNH/rel_forcingn.f90
index fe55e6705720942125a3dc714fa6c42545bf9360..7de540539fc3ca3e0a132c4fee018ee9cad6d90c 100644
--- a/src/MNH/rel_forcingn.f90
+++ b/src/MNH/rel_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.
@@ -94,7 +94,7 @@ END MODULE MODI_REL_FORCING_n
!! 28/03/2018 P. Wautelet: replace TEMPORAL_DIST by DATETIME_DISTANCE
!! use overloaded comparison operator for date_time
!! Philippe 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -108,9 +108,9 @@ USE MODD_PARAMETERS
USE MODD_RELFRC_n ! Modules for time evolving advfrc
USE MODD_TIME
!
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_DATETIME
!
-USE MODI_BUDGET
USE MODI_SHUMAN
!
IMPLICIT NONE
@@ -148,7 +148,9 @@ REAL :: ZRELAX_HEIGHT_TOP,ZRELAX_HEIGHT_BOT, ZRELAX_TIME
!
!* 1. PREPARATION OF FORCING
! ----------------------
-!
+
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), '2DREL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), '2DREL', prrs (:, :, :, 1) )
IF (GSFIRSTCALL) THEN
!
@@ -160,10 +162,10 @@ IF (GSFIRSTCALL) THEN
WRITE(UNIT=ILUOUT0,FMT='(" THERE ARE ",I2," REL FORCING FIELDs AT:")') NRELFRC
DO JSX_REL = 1 , NRELFRC
WRITE(UNIT=ILUOUT0,FMT='(F9.0, "s, date:", I3, "/", I3, "/", I5)') &
- TDTRELFRC(JSX_REL)%TIME, &
- TDTRELFRC(JSX_REL)%TDATE%DAY, &
- TDTRELFRC(JSX_REL)%TDATE%MONTH, &
- TDTRELFRC(JSX_REL)%TDATE%YEAR
+ TDTRELFRC(JSX_REL)%xtime, &
+ TDTRELFRC(JSX_REL)%nday, &
+ TDTRELFRC(JSX_REL)%nmonth, &
+ TDTRELFRC(JSX_REL)%nyear
END DO
!* 1.2 find first sounding to be used
@@ -247,8 +249,9 @@ END IF
!
!* 3. BUDGET CALLS
! ------------
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'2DREL_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'2DREL_BU_RRV')
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), '2DREL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), '2DREL', prrs (:, :, :, 1) )
+
!----------------------------------------------------------------------------
!
END SUBROUTINE REL_FORCING_n
diff --git a/src/MNH/relax2fw_ion.f90 b/src/MNH/relax2fw_ion.f90
index 001f00385fe034e52ef3128f4b0776ea90707f00..df2dafc7e90590c71bbf5826dd86f2bd12350744 100644
--- a/src/MNH/relax2fw_ion.f90
+++ b/src/MNH/relax2fw_ion.f90
@@ -1,7 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ########################
MODULE MODI_RELAX2FW_ION
! ########################
@@ -95,24 +96,23 @@ END MODULE MODI_RELAX2FW_ION
!! -------------
!! C.Lac, 07/11 : Avoid the horizontal relaxation if not father model
!! C.Lac, 11/11 : Adaptation to FIT temporal scheme
-!!
-!!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use modd_budget, only: lbudget_sv, NBUDGET_SV1, tbudgets
+USE MODD_CONF
+USE MODD_ELEC_n, ONLY: XCION_POS_FW, XCION_NEG_FW
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND
USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_BUDGET
-USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND
-USE MODD_ELEC_n, ONLY: XCION_POS_FW, XCION_NEG_FW
-!
+
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_ll
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-!
+
+USE MODI_SHUMAN
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -154,6 +154,12 @@ REAL, DIMENSION(SIZE(PSVM,1),SIZE(PSVM,2)) :: ZKH
!
!* 1. PRELIMINARIES
! -------------
+
+if ( lbudget_sv ) then
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg), 'REL', prsvs(:, :, :, nsv_elecbeg) )
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend), 'REL', prsvs(:, :, :, nsv_elecend) )
+end if
+
IKU = SIZE(PSVM,3)
IKE = IKU - JPVEXT
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
@@ -211,13 +217,10 @@ END IF
!* 4. STORES FIELDS IN BUDGET ARRAYS
! ------------------------------
!
-IF (LBUDGET_SV) THEN
- JSV = NSV_ELECBEG
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'REL_BU_RSV')
- JSV = NSV_ELECEND
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'REL_BU_RSV')
-END IF
-!
+if ( lbudget_sv ) then
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg), 'REL', prsvs(:, :, :, nsv_elecbeg) )
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend), 'REL', prsvs(:, :, :, nsv_elecend) )
+end if
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/relaxation.f90 b/src/MNH/relaxation.f90
index b9cf5c3bb1fef45d27379eb62846c1652608fc0e..7202c8ea13c44d2b708271e20e44fd158703750d 100644
--- a/src/MNH/relaxation.f90
+++ b/src/MNH/relaxation.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.
@@ -256,27 +256,31 @@ END MODULE MODI_RELAXATION
!! 06/2011 (M.Chong) Case of ELEC
!! 11/2011 (C.Lac) Adaptation to FIT temporal scheme
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 12/02/2021: bugfix: do not call budgets for all SV budgets if LRELAX2FW_ION=T
+! P. Wautelet 16/02/2021: bugfix: GMASK3D_RELAX was not computed if OHORELAX_UVWTH=F and needed by other variables
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_BUDGET
-USE MODD_NSV, ONLY : NSV_ELECBEG, NSV_ELECEND
-USE MODD_ELEC_DESCR, ONLY: LRELAX2FW_ION
-!
-USE MODE_ll
-!
-USE MODI_SHUMAN
-USE MODI_BUDGET
-USE MODE_EXTRAPOL
-!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_tke, &
+ lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ 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, &
+ tbudgets
+USE MODD_CONF, only: cconf
+USE MODD_ELEC_DESCR, ONLY: LRELAX2FW_ION
+USE MODD_NSV, ONLY: NSV_ELECBEG, NSV_ELECEND
+USE MODD_PARAMETERS, only: jphext, jpvext
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+USE MODE_EXTRAPOL, only: Extrapol
+USE MODE_ll, only: Get_intersection_ll
USE MODE_MPPDB
-!
-!
+
+USE MODI_SHUMAN
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -420,6 +424,7 @@ REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZKHU,ZKHV,ZKHW, &
! averages along x,y,z of the PRHODJ field
ZWORK
! work array used to expand the LB fields
+logical :: grelax_uvwth
LOGICAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: GMASK3D_RELAX ! 3D
! mask for hor. relax.
LOGICAL, DIMENSION(7) :: GHORELAXR ! local array of logical
@@ -440,7 +445,29 @@ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
CALL GET_GLOBALDIMS_ll(IIU_ll,IJU_ll)
IIU_ll=IIU_ll+2*JPHEXT
IJU_ll=IJU_ll+2*JPHEXT
-!
+
+grelax_uvwth = ohorelax_uvwth .or. ove_relax .or. ove_relax_grd
+
+if ( lbudget_u .and. grelax_uvwth ) call Budget_store_init( tbudgets(NBUDGET_U ), 'REL', prus (:, :, :) )
+if ( lbudget_v .and. grelax_uvwth ) call Budget_store_init( tbudgets(NBUDGET_V ), 'REL', prvs (:, :, :) )
+if ( lbudget_w .and. grelax_uvwth ) call Budget_store_init( tbudgets(NBUDGET_W ), 'REL', prws (:, :, :) )
+if ( lbudget_th .and. grelax_uvwth ) call Budget_store_init( tbudgets(NBUDGET_TH ), 'REL', prths (:, :, :) )
+if ( lbudget_tke .and. ohorelax_tke ) call Budget_store_init( tbudgets(NBUDGET_TKE), 'REL', prtkes(:, :, :) )
+if ( lbudget_rv .and. ohorelax_rv ) call Budget_store_init( tbudgets(NBUDGET_RV ), 'REL', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. ohorelax_rc ) call Budget_store_init( tbudgets(NBUDGET_RC ), 'REL', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. ohorelax_rr ) call Budget_store_init( tbudgets(NBUDGET_RR ), 'REL', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. ohorelax_ri ) call Budget_store_init( tbudgets(NBUDGET_RI ), 'REL', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. ohorelax_rs ) call Budget_store_init( tbudgets(NBUDGET_RS ), 'REL', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. ohorelax_rg ) call Budget_store_init( tbudgets(NBUDGET_RG ), 'REL', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. ohorelax_rh ) call Budget_store_init( tbudgets(NBUDGET_RH ), 'REL', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ if ( .not. lrelax2fw_ion .or. ( jsv /= nsv_elecbeg .and. jsv /= nsv_elecend ) ) then
+ if ( ohorelax_sv( jsv ) ) call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'REL', prsvs(:, :, :, jsv) )
+ end if
+ end do
+end if
+
ZRHODJU(:,:,:) = MXM(PRHODJ)
ZRHODJV(:,:,:) = MYM(PRHODJ)
ZRHODJW(:,:,:) = MZM(PRHODJ)
@@ -567,6 +594,10 @@ IF ( ANY(GHORELAXR) .OR. ANY(GHORELAXSV) .OR. ANY(OHORELAX_SV) &
! ZKHW(:,:,JK) = PKWRELAX(:,:)
! END DO
! END IF
+!
+ DO JK=1,IKU
+ GMASK3D_RELAX(:,:,JK)=OMASK_RELAX(:,:)
+ END DO
ENDIF
!
!
@@ -576,10 +607,6 @@ ENDIF
!
! special treatment is needed to expand LB for U and V because of the C grid
IF ( OHORELAX_UVWTH ) THEN
-!
- DO JK=1,IKU
- GMASK3D_RELAX(:,:,JK)=OMASK_RELAX(:,:)
- END DO
!
IDIMLB = SIZE(PLBXUM,1)
IF ( IDIMLB /= 0) THEN
@@ -707,24 +734,28 @@ END DO
! ------------------------------
!
CALL EXTRAPOL('W ', PRUS)
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'REL_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'REL_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'REL_BU_RW')
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'REL_BU_RTH')
-IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'REL_BU_RTKE')
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'REL_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'REL_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8,'REL_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'REL_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'REL_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'REL_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'REL_BU_RRH')
-IF (LBUDGET_SV) THEN
- DO JSV=1,KSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'REL_BU_RSV')
- END DO
-END IF
-!
+
+if ( lbudget_u .and. grelax_uvwth ) call Budget_store_end( tbudgets(NBUDGET_U ), 'REL', prus (:, :, :) )
+if ( lbudget_v .and. grelax_uvwth ) call Budget_store_end( tbudgets(NBUDGET_V ), 'REL', prvs (:, :, :) )
+if ( lbudget_w .and. grelax_uvwth ) call Budget_store_end( tbudgets(NBUDGET_W ), 'REL', prws (:, :, :) )
+if ( lbudget_th .and. grelax_uvwth ) call Budget_store_end( tbudgets(NBUDGET_TH ), 'REL', prths (:, :, :) )
+if ( lbudget_tke .and. ohorelax_tke ) call Budget_store_end( tbudgets(NBUDGET_TKE), 'REL', prtkes(:, :, :) )
+if ( lbudget_rv .and. ohorelax_rv ) call Budget_store_end( tbudgets(NBUDGET_RV ), 'REL', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. ohorelax_rc ) call Budget_store_end( tbudgets(NBUDGET_RC ), 'REL', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. ohorelax_rr ) call Budget_store_end( tbudgets(NBUDGET_RR ), 'REL', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. ohorelax_ri ) call Budget_store_end( tbudgets(NBUDGET_RI ), 'REL', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. ohorelax_rs ) call Budget_store_end( tbudgets(NBUDGET_RS ), 'REL', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. ohorelax_rg ) call Budget_store_end( tbudgets(NBUDGET_RG ), 'REL', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. ohorelax_rh ) call Budget_store_end( tbudgets(NBUDGET_RH ), 'REL', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ if ( .not. lrelax2fw_ion .or. ( jsv /= nsv_elecbeg .and. jsv /= nsv_elecend ) ) then
+ if ( ohorelax_sv( jsv ) ) call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'REL', prsvs(:, :, :, jsv) )
+ end if
+ end do
+end if
+
+
CONTAINS
! ######################################
SUBROUTINE EXPAND_LB (PLBX,PLBY,PWORK)
diff --git a/src/MNH/reset_exseg.f90 b/src/MNH/reset_exseg.f90
index 5c6a80d42b249e954c295db03ba6176789c28f6a..0d06d2be3cbadabfab8ce39faa44c18c8f496bcc 100644
--- a/src/MNH/reset_exseg.f90
+++ b/src/MNH/reset_exseg.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -56,6 +56,7 @@ END MODULE MODI_RESET_EXSEG
!! 02/2018 Q.Libois ECRAD
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 14/02/2019: remove CLUOUT/CLUOUT0 and associated variables
+! J. Escobar 11/02/2020: for retrotrajectories in //, reset NHALO >> 1 if needed from NAM_CONF_DIAG
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -74,6 +75,10 @@ USE MODN_PARAM_KAFR_n
USE MODN_PARAM_RAD_n
USE MODN_PARAM_ECRAD_n
!
+USE MODD_CONF, ONLY: NHALO
+!
+USE MODD_VAR_ll, ONLY : IP
+!
IMPLICIT NONE
!
!
@@ -88,6 +93,8 @@ INTEGER :: IGRID ! IGRID : grid indicator
INTEGER :: ILENCH ! ILENCH : length of comment string
TYPE(TFILEDATA),POINTER :: TZNMLFILE! Namelist file
!
+NAMELIST/NAM_CONF_DIAG/NHALO
+!
!-------------------------------------------------------------------------------
!
!* 1. OPENING NAMELIST FILE
@@ -112,7 +119,7 @@ IF (NCONV_KF>=0) THEN
IF (GFOUND) THEN
CALL INIT_NAM_PARAM_KAFRn
READ(UNIT=ILUNAM,NML=NAM_PARAM_KAFRN)
- PRINT*, ' namelist NAM_PARAM_KAFRN read'
+ IF ( IP == 1 ) PRINT*, ' namelist NAM_PARAM_KAFRN read'
END IF
IF (LUSERV) THEN
LDIAGCONV=.TRUE.
@@ -126,7 +133,7 @@ IF (NCONV_KF>=0) THEN
END IF
END IF
!
-PRINT*,'RESET_EXSEG OUTPUT: NCONV_KF=',NCONV_KF,' CDCONV=',CDCONV,' CGETCONV=',CGETCONV
+IF ( IP == 1 ) PRINT*,'RESET_EXSEG OUTPUT: NCONV_KF=',NCONV_KF,' CDCONV=',CDCONV,' CGETCONV=',CGETCONV
!
!-------------------------------------------------------------------------------
!
@@ -147,7 +154,7 @@ IF(NRAD_3D>=1) THEN
CALL INIT_NAM_PARAM_RADn
READ(UNIT=ILUNAM,NML=NAM_PARAM_RADN)
CALL UPDATE_NAM_PARAM_RADn
- PRINT*, ' namelist NAM_PARAM_RADN read'
+ IF ( IP == 1 ) PRINT*, ' namelist NAM_PARAM_RADN read'
END IF
#ifdef MNH_ECRAD
CALL POSNAM(ILUNAM,'NAM_PARAM_ECRADN',GFOUND)
@@ -155,7 +162,7 @@ IF(NRAD_3D>=1) THEN
CALL INIT_NAM_PARAM_EcRADn
READ(UNIT=ILUNAM,NML=NAM_PARAM_ECRADN)
CALL UPDATE_NAM_PARAM_ECRADn
- PRINT*, ' namelist NAM_PARAM_ECRADN read'
+ IF ( IP == 1 ) PRINT*, ' namelist NAM_PARAM_ECRADN read'
END IF
#endif
ENDIF
@@ -170,7 +177,7 @@ IF(LEN_TRIM(CRAD_SAT) /= 0) THEN
CRAD='ECMW'
END IF
!
-PRINT*,'RESET_EXSEG OUTPUT: NRAD_3D =',NRAD_3D,' CRAD =',CRAD,' CGETRAD =',CGETRAD
+IF ( IP == 1 ) PRINT*,'RESET_EXSEG OUTPUT: NRAD_3D =',NRAD_3D,' CRAD =',CRAD,' CGETRAD =',CGETRAD
!
!-------------------------------------------------------------------------------
!
@@ -179,8 +186,17 @@ PRINT*,'RESET_EXSEG OUTPUT: NRAD_3D =',NRAD_3D,' CRAD =',CRAD,' CGETRAD =',CGETR
!
IF (LUSECHEM .AND. .NOT.LCHEMDIAG) LUSECHEM =.FALSE.
!
-PRINT*,'RESET_EXSEG OUTPUT: LUSECHEM =',LUSECHEM,' LCHEMDIAG =',LCHEMDIAG
-PRINT*,' '
+IF ( IP == 1 ) PRINT*,'RESET_EXSEG OUTPUT: LUSECHEM =',LUSECHEM,' LCHEMDIAG =',LCHEMDIAG
+IF ( IP == 1 ) PRINT*,' '
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. For retrotrajectories in // , reset NHALO >> 1 if needed from NAM_CONF_DIAG
+! ---------------------------------------------------
+CALL POSNAM(ILUNAM,'NAM_CONF_DIAG',GFOUND)
+IF (GFOUND) THEN
+ READ(UNIT=ILUNAM,NML=NAM_CONF_DIAG)
+END IF
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/resolved_cloud.f90 b/src/MNH/resolved_cloud.f90
index 56dfb0cc57a6aa97c496d686bb8286fa6ccba493..8ccae12a83e71254dd24ec8960da69108f330964 100644
--- a/src/MNH/resolved_cloud.f90
+++ b/src/MNH/resolved_cloud.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@ INTERFACE
SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
- OCLOSE_OUT, OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
+ OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
PTHM, PRCM, PPABSM, &
@@ -25,6 +25,7 @@ INTERFACE
PSOLORG,PMI, &
! PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PSEA,PTOWN )
!
USE MODD_IO, ONLY: TFILEDATA
@@ -46,8 +47,6 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
! turbulence scheme
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the OUTPUT FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
! use values computed in CONDENSATION
@@ -136,8 +135,12 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols a
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
!
END SUBROUTINE RESOLVED_CLOUD
END INTERFACE
@@ -147,7 +150,7 @@ END MODULE MODI_RESOLVED_CLOUD
SUBROUTINE RESOLVED_CLOUD ( HCLOUD, HACTCCN, HSCONV, HMF_CLOUD, &
KRR, KSPLITR, KSPLITG, KMI, KTCOUNT, &
HLBCX, HLBCY, TPFILE, HRAD, HTURBDIM, &
- OCLOSE_OUT, OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
+ OSUBG_COND, OSIGMAS, HSUBG_AUCV, &
PTSTEP, PZZ, PRHODJ, PRHODREF, PEXNREF, &
PPABST, PTHT, PRT, PSIGS, PSIGQSAT, PMFCONV, &
PTHM, PRCM, PPABSM, &
@@ -162,6 +165,7 @@ END MODULE MODI_RESOLVED_CLOUD
PSOLORG,PMI, &
! PSPEEDC, PSPEEDR, PSPEEDS, PSPEEDG, PSPEEDH, &
PINDEP, PSUPSAT, PNACT, PNPRO,PSSPRO, PRAINFR, &
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PSEA,PTOWN )
! ##########################################################################
!
@@ -272,15 +276,23 @@ END MODULE MODI_RESOLVED_CLOUD
! 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 23/07/2019: OpenACC: move data creations from resolved_cloud to modeln and optimize updates
+! 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
+! P. Wautelet 11/06/2020: bugfix: correct ZSVS array indices
+! P. Wautelet 11/06/2020: bugfix: add "Non local correction for precipitating species" for ICE4
+! P. Wautelet + Benoit Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! 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
! ------------
-USE MODD_BUDGET, ONLY: LBUDGET_TH, LBUDGET_RC, LBUDGET_RG, LBUDGET_RH, LBUDGET_RI, LBUDGET_RR, LBUDGET_RS, LBUDGET_RV, &
- LBUDGET_SV
USE MODD_CH_AEROSOL, ONLY: LORILAM
USE MODD_DUST, ONLY: LDUST
-USE MODD_CST, ONLY: XCI, XCL, XCPD, XCPV, XLSTT, XLVTT, XMNH_TINY, XP00, XRD, XRHOLW, XTT
+use modd_cst, only: xcpd, xrd, xp00, xrholw
USE MODD_DUST , ONLY: LDUST
USE MODD_IO, ONLY: TFILEDATA
USE MODD_NSV, ONLY: NSV_C1R3END, NSV_C2R2BEG, NSV_C2R2END, &
@@ -289,33 +301,34 @@ 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, XCONC_CCN_TOT, NMOD_CCN, NMOD_IFN, NMOD_IMM, LPTSPLIT, &
- YRTMIN=>XRTMIN, YCTMIN=>XCTMIN
+USE MODD_PARAM_LIMA, ONLY: LADJ, LCOLD, LPTSPLIT, LSPRO, NMOD_CCN, NMOD_IFN, NMOD_IMM
USE MODD_RAIN_ICE_DESCR, ONLY: XRTMIN
USE MODD_SALT, ONLY: LSALT
+USE MODD_TURB_n, ONLY: CSUBG_AUCV_RI, CCONDENS, CLAMBDA3, CSUBG_MF_PDF
!
USE MODE_ll
USE MODE_MPPDB
#ifdef MNH_OPENACC
USE MODE_MSG
#endif
+use mode_sources_neg_correct, only: Sources_neg_correct
use mode_sum_ll, only: MIN_ll, SUM3D_ll
!
#ifdef MNH_BITREP
USE MODI_BITREP
#endif
-USE MODI_BUDGET
+!
USE MODI_C2R2_ADJUST
-USE MODI_C3R5_ADJUST
USE MODI_FAST_TERMS
USE MODI_GET_HALO
USE MODI_ICE_ADJUST
-USE MODI_ICE_C1R3
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
@@ -348,8 +361,6 @@ TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
CHARACTER(len=4), INTENT(IN) :: HRAD ! Radiation scheme name
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! Dimensionality of the
! turbulence scheme
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! Conditional closure of
- ! the OUTPUT FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for Subgrid Cond.
LOGICAL, INTENT(IN) :: OSIGMAS ! Switch for Sigma_s:
! use values computed in CONDENSATION
@@ -437,8 +448,12 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNACT !concentrtaion d'aérosols a
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PNPRO !concentrtaion d'aérosols activés au temps t
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSSPRO !sursat
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRAINFR ! Rain fraction
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
-REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HRC !HighLow liquid content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLC_HCF !HighLow liquid cloud fraction
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HRI !HighLow ice content
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PHLI_HCF !HighLow ice clous fraction
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PSEA ! Land Sea mask
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PTOWN ! Town fraction
!
!* 0.2 Declarations of local variables :
!
@@ -455,29 +470,27 @@ INTEGER :: IINFO_ll ! return code of parallel routine
INTEGER :: JI,JJ,JK,JL
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDZZ
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZT,ZEXN,ZLV,ZLS,ZCPH
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCOR
- ! for the correction of negative rv
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZEXN
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZZZ
! model layer height
-REAL :: ZMASSTOT ! total mass for one water category
- ! including the negative values
-REAL :: ZMASSPOS ! total mass for one water category
- ! after removing the negative values
-REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
+! REAL :: ZMASSTOT ! total mass for one water category
+! ! including the negative values
+! REAL :: ZMASSPOS ! total mass for one water category
+! ! after removing the negative values
+! REAL :: ZRATIO ! ZMASSTOT / ZMASSCOR
!
INTEGER :: ISVBEG ! first scalar index for microphysics
INTEGER :: ISVEND ! last scalar index for microphysics
REAL, DIMENSION(:), ALLOCATABLE :: ZRSMIN ! Minimum value for tendencies
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVT ! scalar variable for microphysics only
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSVS ! scalar tendency for microphysics only
LOGICAL, DIMENSION(:,:,:), ALLOCATABLE :: LLMICRO ! mask to limit computation
-! REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3), KRR) :: ZFPR
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZFPR
!
INTEGER :: JMOD, JMOD_IFN
LOGICAL :: GWEST,GEAST,GNORTH,GSOUTH
! BVIE work array waiting for PINPRI
REAL, DIMENSION(:,:), ALLOCATABLE :: ZINPRI
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZICEFR
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPRCFR
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTHSSTEP
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRSSTEP
!
@@ -485,16 +498,16 @@ REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZRSSTEP
!
! IN variables
!
-!$acc data present( PRHODJ, PZZ, PRHODREF, PEXNREF, PPABST, PTHT, PSIGS, PSIGQSAT, &
-!$acc & PMFCONV, PTHM, PPABSM, PRCM, PW_ACT, PDTHRAD, &
-!$acc & PCF_MF, PRC_MF, PRI_MF, &
-!$acc & PSOLORG, PMI, PSEA, PTOWN, &
+!$acc data present( PRHODJ, PZZ, PRHODREF, PEXNREF, PPABST, PTHT, PSIGS, PSIGQSAT, &
+!$acc & PMFCONV, PTHM, PPABSM, PRCM, PW_ACT, PDTHRAD, &
+!$acc & PCF_MF, PRC_MF, PRI_MF, &
+!$acc & PSOLORG, PMI, PSEA, PTOWN, &
!
! INOUT variables
!
-!$acc & PTHS, PRT, PRS, PSVT, PSVS, PCLDFR, PCIT, &
-!$acc & PINPRC, PINPRR, PINPRR3D, PEVAP3D, PINPRS, PINPRG, PINPRH, PINDEP, &
-!$acc & PSUPSAT, PNACT, PNPRO, PSSPRO, &
+!$acc & PTHS, PRT, PRS, PSVT, PSVS, PCLDFR, PCIT, &
+!$acc & PINPRC, PINPRR, PINPRR3D, PEVAP3D, PINPRS, PINPRG, PINPRH, PINDEP, &
+!$acc & PSUPSAT, PNACT, PNPRO, PSSPRO, PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
!
! OUT variables
!
@@ -547,22 +560,34 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PNACT,"RESOLVED_CLOUD beg:PNACT")
CALL MPPDB_CHECK(PNPRO,"RESOLVED_CLOUD beg:PNPRO")
CALL MPPDB_CHECK(PSSPRO,"RESOLVED_CLOUD beg:PSSPRO")
+ CALL MPPDB_CHECK(PHLC_HRC,"RESOLVED_CLOUD beg:PHLC_HRC")
+ CALL MPPDB_CHECK(PHLC_HCF,"RESOLVED_CLOUD beg:PHLC_HCF")
+ CALL MPPDB_CHECK(PHLI_HRI,"RESOLVED_CLOUD beg:PHLI_HRI")
+ CALL MPPDB_CHECK(PHLI_HCF,"RESOLVED_CLOUD beg:PHLI_HCF")
END IF
!
allocate ( LLMICRO ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
allocate ( ZDZZ ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZT ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZEXN ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZLV ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZLS ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZCPH ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
-allocate ( ZCOR ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
allocate ( ZZZ ( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
allocate ( ZINPRI ( SIZE(PZZ,1), SIZE(PZZ,2) ) )
allocate ( ZTHSSTEP ( SIZE(PTHS,1), SIZE(PTHS,2), SIZE(PTHS,3) ) )
allocate ( ZRSSTEP ( SIZE(PRS,1), SIZE(PRS,2), SIZE(PRS,3), SIZE(PRS,4) ) )
-!$acc data create(LLMICRO,ZDZZ,ZT,ZEXN,ZLV,ZLS,ZCPH,ZCOR,ZZZ,ZINPRI,ZTHSSTEP,ZRSSTEP)
+IF ( HCLOUD == 'ICE3' .OR. HCLOUD == 'ICE4' ) THEN
+ ALLOCATE( ZFPR( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3), KRR ) )
+ELSE
+ ALLOCATE( ZFPR(0, 0, 0, 0) )
+END IF
+
+IF ( HCLOUD == 'LIMA' .and. LPTSPLIT ) THEN
+ ALLOCATE( ZICEFR( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
+ ALLOCATE( ZPRCFR( SIZE(PZZ,1), SIZE(PZZ,2), SIZE(PZZ,3) ) )
+ELSE
+ ALLOCATE( ZICEFR(0, 0, 0) )
+ ALLOCATE( ZPRCFR(0, 0, 0) )
+END IF
+
+!$acc data create(LLMICRO,ZDZZ,ZZZ,ZINPRI,ZTHSSTEP,ZRSSTEP, ZFPR, ZICEFR, ZPRCFR)
CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKA=1
@@ -588,16 +613,9 @@ ELSE IF (HCLOUD == 'LIMA') THEN
ISVEND = NSV_LIMA_END
ELSE
ISVBEG = 0
- ISVEND = 0
+ ISVEND = -1
END IF
!
-IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
- ALLOCATE(ZSVT(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1))
- ALLOCATE(ZSVS(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3),ISVEND - ISVBEG + 1))
-!$acc enter data create(ZSVT,ZSVS)
- ZSVT(:,:,:,:) = PSVT(:,:,:,ISVBEG:ISVEND)
- ZSVS(:,:,:,:) = PSVS(:,:,:,ISVBEG:ISVEND)
-END IF
IF (HCLOUD(1:3)=='ICE' .AND. LRED) THEN
ALLOCATE(ZRSMIN(SIZE(XRTMIN)))
!$acc enter data create(ZRSMIN)
@@ -609,15 +627,15 @@ END IF
!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
! ---------------------------------------
!
-!$acc kernels present(PTHS,PRS,PRHODJ,PPABST,ZEXN,ZLV,ZLS,ZCPH,ZSVS)
+!$acc kernels present(PTHS,PRS,PRHODJ,PPABST)
PTHS(:,:,:) = PTHS(:,:,:) / PRHODJ(:,:,:)
DO JRR = 1,KRR
PRS(:,:,:,JRR) = PRS(:,:,:,JRR) / PRHODJ(:,:,:)
END DO
!
IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
- DO JSV = 1,SIZE(ZSVS,4)
- ZSVS(:,:,:,JSV) = ZSVS(:,:,:,JSV) / PRHODJ(:,:,:)
+ DO JSV = ISVBEG, ISVEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) / PRHODJ(:,:,:)
ENDDO
ENDIF
!
@@ -644,18 +662,18 @@ IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PRT(:,IJE+1:,:,2:) = 0.0
!
IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
DO JI=1,JPHEXT
- ZSVS(JI,:,:,:) = ZSVS(IIB,:,:,:)
- ZSVS(IIE+JI,:,:,:) = ZSVS(IIE,:,:,:)
- ZSVS(:,JI,:,:) = ZSVS(:,IJB,:,:)
- ZSVS(:,IJE+JI,:,:) = ZSVS(:,IJE,:,:)
+ PSVS(JI, :, :, ISVBEG:ISVEND) = PSVS(IIB, :, :, ISVBEG:ISVEND)
+ PSVS(IIE+JI, :, :, ISVBEG:ISVEND) = PSVS(IIE, :, :, ISVBEG:ISVEND)
+ PSVS(:, JI, :, ISVBEG:ISVEND) = PSVS(:, IJB, :, ISVBEG:ISVEND)
+ PSVS(:, IJE+JI, :, ISVBEG:ISVEND) = PSVS(:, IJE, :, ISVBEG:ISVEND)
END DO
!
! complete the physical boundaries to avoid some computations
!
- IF(GWEST .AND. HLBCX(1) /= 'CYCL') ZSVT(:IIB-1,:,:,:) = 0.0
- IF(GEAST .AND. HLBCX(2) /= 'CYCL') ZSVT(IIE+1:,:,:,:) = 0.0
- IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') ZSVT(:,:IJB-1,:,:) = 0.0
- IF(GNORTH .AND. HLBCY(2) /= 'CYCL') ZSVT(:,IJE+1:,:,:) = 0.0
+ IF(GWEST .AND. HLBCX(1) /= 'CYCL') PSVT(:IIB-1, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GEAST .AND. HLBCX(2) /= 'CYCL') PSVT(IIE+1:, :, :, ISVBEG:ISVEND) = 0.0
+ IF(GSOUTH .AND. HLBCY(1) /= 'CYCL') PSVT(:, :IJB-1, :, ISVBEG:ISVEND) = 0.0
+ IF(GNORTH .AND. HLBCY(2) /= 'CYCL') PSVT(:, IJE+1:, :, ISVBEG:ISVEND) = 0.0
ENDIF
!
! complete the vertical boundaries
@@ -671,395 +689,57 @@ PRT(:,:,IKE+1,:) = PRT(:,:,IKE,:)
!
IF (HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO' &
.OR. HCLOUD == 'LIMA') THEN
- ZSVS(:,:,IKB-1,:) = ZSVS(:,:,IKB,:)
- ZSVS(:,:,IKE+1,:) = ZSVS(:,:,IKE,:)
- ZSVT(:,:,IKB-1,:) = ZSVT(:,:,IKB,:)
- ZSVT(:,:,IKE+1,:) = ZSVT(:,:,IKE,:)
+ PSVS(:,:,IKB-1,ISVBEG:ISVEND) = PSVS(:,:,IKB,ISVBEG:ISVEND)
+ PSVS(:,:,IKE+1,ISVBEG:ISVEND) = PSVS(:,:,IKE,ISVBEG:ISVEND)
+ PSVT(:,:,IKB-1,ISVBEG:ISVEND) = PSVT(:,:,IKB,ISVBEG:ISVEND)
+ PSVT(:,:,IKE+1,ISVBEG:ISVEND) = PSVT(:,:,IKE,ISVBEG:ISVEND)
ENDIF
!
-! personal comment: tranfering these variables to the
-! microphysical routines would save
-! computing time
-!
-#ifndef MNH_BITREP
-ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
-#else
-ZEXN(:,:,:) = BR_POW(PPABST(:,:,:)/XP00,XRD/XCPD)
-#endif
-ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
-ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
-ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
-ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
!$acc end kernels
!
-!
!* 3. REMOVE NEGATIVE VALUES
! ----------------------
!
!* 3.1 Non local correction for precipitating species (Rood 87)
!
-IF (HCLOUD == 'KESS' .OR. HCLOUD == 'ICE3' &
- .OR. HCLOUD == 'C2R2' .OR. &
- HCLOUD == 'C3R5' .OR. HCLOUD == 'KHKO' .OR. HCLOUD=='LIMA' ) THEN
-!
- DO JRR = 3,KRR
- SELECT CASE (JRR)
- CASE(3,5,6,7) ! rain, snow, graupel and hail
-#ifndef MNH_OPENACC
- IF ( MIN_ll( PRS(:,:,:,JRR), IINFO_ll ) < 0.0 ) THEN
-#else
- IF ( MIN_ll( PRS(:,:,:,JRR), IINFO_ll, oondevice=.true. ) < 0.0 ) THEN
-#endif
-!
-! compute the total water mass computation
-!
-#ifndef MNH_OPENACC
- ZMASSTOT = MAX( 0. , SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
-#else
- ZMASSTOT = MAX( 0. , SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll, oondevice=.true. ) )
-#endif
-!
-! remove the negative values
-!
-!$acc kernels
- PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
-!$acc end kernels
-!
-! compute the new total mass
-!
-#ifndef MNH_OPENACC
- ZMASSPOS = MAX(XMNH_TINY,SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
-#else
- ZMASSPOS = MAX(XMNH_TINY,SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll, oondevice=.true. ) )
-#endif
-!
-! correct again in such a way to conserve the total mass
-!
- ZRATIO = ZMASSTOT / ZMASSPOS
-!$acc kernels
- PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO
-!$acc end kernels
-!
- END IF
- END SELECT
- END DO
-END IF
+! IF ( HCLOUD == 'KESS' &
+! .OR. HCLOUD == 'ICE3' .OR. HCLOUD == 'ICE4' &
+! .OR. HCLOUD == 'C2R2' .OR. HCLOUD == 'C3R5' &
+! .OR. HCLOUD == 'KHKO' .OR. HCLOUD == 'LIMA' ) THEN
+! !
+! DO JRR = 3,KRR
+! SELECT CASE (JRR)
+! CASE(3,5,6,7) ! rain, snow, graupel and hail
+!
+! IF ( MIN_ll( PRS(:,:,:,JRR), IINFO_ll) < 0.0 ) THEN
+! !
+! ! compute the total water mass computation
+! !
+! ZMASSTOT = MAX( 0. , SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
+! !
+! ! remove the negative values
+! !
+! PRS(:,:,:,JRR) = MAX( 0., PRS(:,:,:,JRR) )
+! !
+! ! compute the new total mass
+! !
+! ZMASSPOS = MAX(XMNH_TINY,SUM3D_ll( PRS(:,:,:,JRR), IINFO_ll ) )
+! !
+! ! correct again in such a way to conserve the total mass
+! !
+! ZRATIO = ZMASSTOT / ZMASSPOS
+! PRS(:,:,:,JRR) = PRS(:,:,:,JRR) * ZRATIO
+! !
+! END IF
+! END SELECT
+! END DO
+! END IF
!
!* 3.2 Adjustement for liquid and solid cloud
!
-SELECT CASE ( HCLOUD )
- CASE('KESS')
-#ifdef MNH_OPENACC
-CALL PRINT_MSG(NVERB_WARNING,'GEN','RESOLVED_CLOUD','KESS being implemented')
-#endif
-#ifndef MNH_OPENACC
- WHERE (PRS(:,:,:,2) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,2) = 0.0
- END WHERE
-#else
-!$acc kernels
-!$acc loop independent collapse(3)
- DO JK=1,SIZE(PRS,3)
- DO JJ=1,SIZE(PRS,2)
- DO JI=1,SIZE(PRS,1)
- IF (PRS(JI,JJ,JK,2) < 0.) THEN
- PRS(JI, JJ, JK , 1) = PRS(JI, JJ, JK , 1) + PRS(JI, JJ, JK , 2)
- PTHS(JI, JJ, JK ) = PTHS(JI, JJ, JK ) - PRS(JI, JJ, JK , 2) * ZLV(JI, JJ, JK ) &
- / ZCPH(JI, JJ, JK ) / PEXNREF(JI, JJ, JK )
- PRS(JI, JJ, JK , 2) = 0.0
- END IF
- END DO
- END DO
- END DO
-!$acc end kernels
-#endif
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NEGA', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
!
-!
-! CASE('C2R2','KHKO')
-! CALL GET_HALO(PRS(:,:,:,2))
-! CALL GET_HALO(ZSVS(:,:,:,2))
-! WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
-! ZSVS(:,:,:,1) = 0.0
-! END WHERE
-! DO JSV = 2, 3
-! WHERE (PRS(:,:,:,JSV) < 0. .OR. ZSVS(:,:,:,JSV) < 0.)
-! PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,JSV)
-! PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,JSV) * ZLV(:,:,:) / &
-! ZCPH(:,:,:) / ZEXN(:,:,:)
-! PRS(:,:,:,JSV) = 0.0
-! ZSVS(:,:,:,JSV) = 0.0
-! END WHERE
-! ENDDO
-! Commented 03/2013 O.Thouron
-! (at least necessary to be commented for supersaturation variable)
-! ZSVS(:,:,:,:) = MAX( 0.0,ZSVS(:,:,:,:) )
-!
-!
- CASE('ICE3','ICE4')
-#ifndef MNH_OPENACC
- WHERE (PRS(:,:,:,4) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,4) = 0.
- END WHERE
-!
-! cloud
- WHERE (PRS(:,:,:,2) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,2) = 0.
- END WHERE
-!
-! if rc or ri are positive, we can correct negative rv
-! cloud
- WHERE ((PRS(:,:,:,1) <0.) .AND. (PRS(:,:,:,2)> 0.) )
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,2) = 0.
- END WHERE
-! ice
- IF(KRR > 3) THEN
- WHERE ((PRS(:,:,:,1) < 0.).AND.(PRS(:,:,:,4) > 0.))
- ZCOR(:,:,:)=MIN(-PRS(:,:,:,1),PRS(:,:,:,4))
- PRS(:,:,:,1) = PRS(:,:,:,1) + ZCOR(:,:,:)
- PTHS(:,:,:) = PTHS(:,:,:) - ZCOR(:,:,:) * ZLS(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,4) = PRS(:,:,:,4) -ZCOR(:,:,:)
- END WHERE
- END IF
-#else
-#if 1
-!$acc kernels present(PTHS,PRS,PEXNREF) present(ZLV,ZLS,ZCPH,ZCOR)
-!$acc loop independent collapse(3)
- DO JK=1,SIZE(PZZ,3)
- DO JJ=1,SIZE(PZZ,2)
- DO JI=1,SIZE(PZZ,1)
- IF (PRS(JI,JJ,JK,4) < 0.) THEN
- PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + PRS(JI,JJ,JK,4)
- PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - PRS(JI,JJ,JK,4) * ZLS(JI,JJ,JK) / &
- ZCPH(JI,JJ,JK) / PEXNREF(JI,JJ,JK)
- PRS(JI,JJ,JK,4) = 0.
- END IF
- ! cloud
- IF (PRS(JI,JJ,JK,2) < 0.) THEN
- PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + PRS(JI,JJ,JK,2)
- PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - PRS(JI,JJ,JK,2) * ZLV(JI,JJ,JK) / &
- ZCPH(JI,JJ,JK) / PEXNREF(JI,JJ,JK)
- PRS(JI,JJ,JK,2) = 0.
- END IF
- ! if rc or ri are positive, we can correct negative rv
- ! cloud
- IF ( PRS(JI,JJ,JK,1) < 0. .AND. (PRS(JI,JJ,JK,2)> 0.) ) THEN
- PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + PRS(JI,JJ,JK,2)
- PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - PRS(JI,JJ,JK,2) * ZLV(JI,JJ,JK) / &
- ZCPH(JI,JJ,JK) / PEXNREF(JI,JJ,JK)
- PRS(JI,JJ,JK,2) = 0.
- END IF
- ! ice
- IF (KRR>3 .AND. (PRS(JI,JJ,JK,1) < 0.).AND.(PRS(JI,JJ,JK,4) > 0.)) THEN
- ZCOR(JI,JJ,JK)=MIN(-PRS(JI,JJ,JK,1),PRS(JI,JJ,JK,4))
- PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + ZCOR(JI,JJ,JK)
- PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - ZCOR(JI,JJ,JK) * ZLS(JI,JJ,JK) / &
- ZCPH(JI,JJ,JK) / PEXNREF(JI,JJ,JK)
- PRS(JI,JJ,JK,4) = PRS(JI,JJ,JK,4) -ZCOR(JI,JJ,JK)
- END IF
- END DO
- END DO
- END DO
-!$acc end kernels
-#else
-!$acc kernels present(PTHS,PRS,PEXNREF) present(ZLV,ZLS,ZCPH,ZCOR)
- DO JK=1,SIZE(PZZ,3)
- DO JJ=1,SIZE(PZZ,2)
- DO JI=1,SIZE(PZZ,1)
- IF (PRS(JI,JJ,JK,4) < 0.) THEN
- PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + PRS(JI,JJ,JK,4)
- PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - PRS(JI,JJ,JK,4) * ZLS(JI,JJ,JK) / &
- ZCPH(JI,JJ,JK) / PEXNREF(JI,JJ,JK)
- PRS(JI,JJ,JK,4) = 0.
- END IF
- ! cloud
- IF (PRS(JI,JJ,JK,2) < 0.) THEN
- PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + PRS(JI,JJ,JK,2)
- PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - PRS(JI,JJ,JK,2) * ZLV(JI,JJ,JK) / &
- ZCPH(JI,JJ,JK) / PEXNREF(JI,JJ,JK)
- PRS(JI,JJ,JK,2) = 0.
- ELSE
- ! if rc or ri are positive, we can correct negative rv
- ! cloud
- IF (PRS(JI,JJ,JK,1) < 0.) THEN
- PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + PRS(JI,JJ,JK,2)
- PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - PRS(JI,JJ,JK,2) * ZLV(JI,JJ,JK) / &
- ZCPH(JI,JJ,JK) / PEXNREF(JI,JJ,JK)
- PRS(JI,JJ,JK,2) = 0.
- ! ice
- IF(KRR > 3 .AND. PRS(JI,JJ,JK,4) > 0.) THEN
- ZCOR(JI,JJ,JK) = MIN(-PRS(JI,JJ,JK,1),PRS(JI,JJ,JK,4))
- PRS(JI,JJ,JK,1) = PRS(JI,JJ,JK,1) + ZCOR(JI,JJ,JK)
- PTHS(JI,JJ,JK) = PTHS(JI,JJ,JK) - ZCOR(JI,JJ,JK) * ZLS(JI,JJ,JK) / &
- ZCPH(JI,JJ,JK) / PEXNREF(JI,JJ,JK)
- PRS(JI,JJ,JK,4) = PRS(JI,JJ,JK,4) -ZCOR(JI,JJ,JK)
- END IF
- END IF
- END IF
- END DO
- END DO
- END DO
-!$acc end kernels
-#endif
-!
-!
-#endif
-!
- CASE('C3R5')
-#ifdef MNH_OPENACC
-CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C3R5 not yet implemented')
-#endif
- WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
- ZSVS(:,:,:,1) = 0.0
- END WHERE
- DO JSV = 2, 3
- WHERE (PRS(:,:,:,JSV) < 0. .OR. ZSVS(:,:,:,JSV) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,JSV)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,JSV) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,JSV) = 0.0
- ZSVS(:,:,:,JSV) = 0.0
- END WHERE
- ENDDO
- ZSVS(:,:,:,:) = MAX( 0.0,ZSVS(:,:,:,:) )
-! ice
- WHERE (PRS(:,:,:,4) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,4) = 0.0
- PSVS(:,:,:,4) = 0.0
- END WHERE
-! cloud
- WHERE (PRS(:,:,:,2) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,2) = 0.0
- PSVS(:,:,:,2) = 0.0
- END WHERE
- PSVS(:,:,:,:) = MAX( 0.0,PSVS(:,:,:,:) )
-!
- CASE('LIMA')
-#ifdef MNH_OPENACC
-CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','LIMA not yet implemented')
-#endif
-! Correction where rc<0 or Nc<0
- IF (OWARM) THEN
- WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,NSV_LIMA_NC) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,2)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,2) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / ZEXN(:,:,:)
- PRS(:,:,:,2) = 0.0
- ZSVS(:,:,:,NSV_LIMA_NC) = 0.0
- END WHERE
- END IF
-! Correction where rr<0 or Nr<0
- IF (OWARM .AND. ORAIN) THEN
- WHERE (PRS(:,:,:,3) < YRTMIN(3)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NR) < YCTMIN(3)/PTSTEP)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,3)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,3) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / ZEXN(:,:,:)
- PRS(:,:,:,3) = 0.0
- ZSVS(:,:,:,NSV_LIMA_NR) = 0.0
- END WHERE
- END IF
-! Correction where ri<0 or Ni<0
- IF (LCOLD) THEN
- WHERE (PRS(:,:,:,4) < YRTMIN(4)/PTSTEP .OR. ZSVS(:,:,:,NSV_LIMA_NI) < YCTMIN(4)/PTSTEP)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,4)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,4) * ZLS(:,:,:) / &
- ZCPH(:,:,:) / ZEXN(:,:,:)
- PRS(:,:,:,4) = 0.0
- ZSVS(:,:,:,NSV_LIMA_NI) = 0.0
- END WHERE
- END IF
-!
- ZSVS(:,:,:,:) = MAX( 0.0,ZSVS(:,:,:,:) )
- PRS(:,:,:,:) = MAX( 0.0,PRS(:,:,:,:) )
-!
-END SELECT
-!
-!
-!* 3.3 STORE THE BUDGET TERMS
-! ----------------------
-!
-IF ((HCLOUD /= 'KHKO') .AND. (HCLOUD /= 'C2R2') ) THEN
- IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:), 4,'NEGA_BU_RTH')
- END IF
- IF (LBUDGET_RV) THEN
-!$acc update self(PRS(:,:,:,1))
- CALL BUDGET (PRS(:,:,:,1) * PRHODJ(:,:,:), 6,'NEGA_BU_RRV')
- END IF
- IF (LBUDGET_RC) THEN
-!$acc update self(PRS(:,:,:,2))
- CALL BUDGET (PRS(:,:,:,2) * PRHODJ(:,:,:), 7,'NEGA_BU_RRC')
- END IF
-END IF
-IF (LBUDGET_RR) THEN
-!$acc update self(PRS(:,:,:,3))
- CALL BUDGET (PRS(:,:,:,3) * PRHODJ(:,:,:), 8,'NEGA_BU_RRR')
-END IF
-IF (LBUDGET_RI) THEN
-!$acc update self(PRS(:,:,:,4))
- CALL BUDGET (PRS(:,:,:,4) * PRHODJ(:,:,:) ,9,'NEGA_BU_RRI')
-END IF
-IF (LBUDGET_RS) THEN
-!$acc update self(PRS(:,:,:,5))
- CALL BUDGET (PRS(:,:,:,5) * PRHODJ(:,:,:),10,'NEGA_BU_RRS')
-END IF
-IF (LBUDGET_RG) THEN
-!$acc update self(PRS(:,:,:,6))
- CALL BUDGET (PRS(:,:,:,6) * PRHODJ(:,:,:),11,'NEGA_BU_RRG')
-END IF
-IF (LBUDGET_RH) THEN
-!$acc update self(PRS(:,:,:,7))
- CALL BUDGET (PRS(:,:,:,7) * PRHODJ(:,:,:),12,'NEGA_BU_RRH')
-END IF
-IF (LBUDGET_SV .AND. (HCLOUD == 'LIMA')) THEN
- IF ( OWARM ) THEN
-!$acc update self(ZSVS(:,:,:,NSV_LIMA_NC))
- CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NC) * PRHODJ(:,:,:),12+NSV_LIMA_NC,'NEGA_BU_RSV')
- END IF
- IF ( OWARM .AND. ORAIN ) THEN
-!$acc update self(ZSVS(:,:,:,NSV_LIMA_NR))
- CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NR) * PRHODJ(:,:,:),12+NSV_LIMA_NR,'NEGA_BU_RSV')
- END IF
- IF ( LCOLD ) THEN
-!$acc update self(ZSVS(:,:,:,NSV_LIMA_NI))
- CALL BUDGET (ZSVS(:,:,:,NSV_LIMA_NI) * PRHODJ(:,:,:),12+NSV_LIMA_NI,'NEGA_BU_RSV')
- END IF
- IF ( NMOD_CCN >= 1 ) THEN
-!$acc update self(ZSVS(:,:,:,NSV_LIMA_CCN_FREE:NSV_LIMA_CCN_FREE+NMOD_CCN-1))
- DO JL=1, NMOD_CCN
- CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_CCN_FREE+JL-1)* &
- PRHODJ(:,:,:),12+NSV_LIMA_CCN_FREE+JL-1,'NEGA_BU_RSV')
- END DO
- END IF
- IF ( NMOD_IFN >= 1 ) THEN
-!$acc update self(ZSVS(:,:,:,NSV_LIMA_IFN_FREE:NSV_LIMA_IFN_FREE+NMOD_IFN-1))
- DO JL=1, NMOD_IFN
- CALL BUDGET ( ZSVS(:,:,:,NSV_LIMA_IFN_FREE+JL-1)* &
- PRHODJ(:,:,:),12+NSV_LIMA_IFN_FREE+JL-1,'NEGA_BU_RSV')
- END DO
- END IF
-END IF
-!
-
!* 3.4 Limitations of Na and Nc to the CCN max number concentration
!
! Commented by O.Thouron 03/2013
@@ -1134,12 +814,13 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemente
!
!
CALL RAIN_C2R2_KHKO ( HCLOUD, OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
- TPFILE, OCLOSE_OUT, PZZ, PRHODJ, PRHODREF, PEXNREF, &
+ TPFILE, PZZ, PRHODJ, PRHODREF, PEXNREF, &
PPABST, PTHT, PRT(:,:,:,1), PRT(:,:,:,2), PRT(:,:,:,3), &
PTHM, PRCM, PPABSM, &
PW_ACT,PDTHRAD,PTHS, PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
- ZSVT(:,:,:,1), ZSVT(:,:,:,2), ZSVT(:,:,:,3), &
- ZSVS(:,:,:,1), ZSVS(:,:,:,2), ZSVS(:,:,:,3), &
+ PSVT(:,:,:,NSV_C2R2BEG), PSVT(:,:,:,NSV_C2R2BEG+1), &
+ PSVT(:,:,:,NSV_C2R2BEG+2), PSVS(:,:,:,NSV_C2R2BEG), &
+ PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG+2), &
PINPRC, PINPRR, PINPRR3D, PEVAP3D , &
PSVT(:,:,:,:), PSOLORG, PMI, HACTCCN, &
PINDEP, PSUPSAT, PNACT )
@@ -1148,20 +829,21 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemente
!* 7.2 Perform the saturation adjustment
!
IF (LSUPSAT) THEN
- CALL KHKO_NOTADJUST (KRR, KTCOUNT,TPFILE, HRAD, OCLOSE_OUT, &
+ CALL KHKO_NOTADJUST (KRR, KTCOUNT,TPFILE, HRAD, &
PTSTEP, PRHODJ, PPABSM, PPABST, PRHODREF, PZZ, &
PTHT,PRT(:,:,:,1),PRT(:,:,:,2),PRT(:,:,:,3), &
PTHS,PRS(:,:,:,1),PRS(:,:,:,2),PRS(:,:,:,3), &
- ZSVS(:,:,:,2),ZSVS(:,:,:,1), &
- ZSVS(:,:,:,4), PCLDFR, PSRCS , PNPRO,PSSPRO )
+ PSVS(:,:,:,NSV_C2R2BEG+1), PSVS(:,:,:,NSV_C2R2BEG), &
+ PSVS(:,:,:,NSV_C2R2BEG+3), PCLDFR, PSRCS, PNPRO, PSSPRO )
!
ELSE
- CALL C2R2_ADJUST ( KRR,TPFILE, HRAD, &
- HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
- PRHODJ, PSIGS, PPABST, &
- PTHS=PTHS, PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PCNUCS=ZSVS(:,:,:,1), PCCS=ZSVS(:,:,:,2), &
- PSRCS=PSRCS, PCLDFR=PCLDFR, PRRS=PRS(:,:,:,3) )
+ CALL C2R2_ADJUST ( KRR,TPFILE, HRAD, &
+ HTURBDIM, OSUBG_COND, PTSTEP, &
+ PRHODJ, PSIGS, PPABST, &
+ PTHS=PTHS, PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PCNUCS=PSVS(:,:,:,NSV_C2R2BEG), &
+ PCCS=PSVS(:,:,:,NSV_C2R2BEG+1), &
+ PSRCS=PSRCS, PCLDFR=PCLDFR, PRRS=PRS(:,:,:,3) )
!
END IF
!
@@ -1170,6 +852,11 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemente
!* 9. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 3 ICE SPECIES)
! -----------------------------------------------------
!
+ allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
+!$acc data create( ZEXN )
+!$acc kernels
+ ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+!$acc end kernels
!
!* 9.1 Compute the explicit microphysical sources
!
@@ -1194,17 +881,20 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemente
CALL MZF_DEVICE(1,IKU,1,PZZ,ZZZ)
#endif
IF(LRED .AND. LADJ_BEFORE) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'ADJU', &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF,PRC_MF,PRI_MF, &
- PRV=ZRSSTEP(:,:,:,1), PRC=ZRSSTEP(:,:,:,2), &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=ZTHSSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=ZRSSTEP(:,:,:,3), &
- PRI=ZRSSTEP(:,:,:,4), PRIS=PRS(:,:,:,4), &
- PRS=ZRSSTEP(:,:,:,5), &
- PRG=ZRSSTEP(:,:,:,6) )
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'ADJU', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=ZRSSTEP(:,:,:,1), PRC=ZRSSTEP(:,:,:,2), &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=ZTHSSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=ZRSSTEP(:,:,:,3), &
+ PRI=ZRSSTEP(:,:,:,4), PRIS=PRS(:,:,:,4), &
+ PRS=ZRSSTEP(:,:,:,5), &
+ PRG=ZRSSTEP(:,:,:,6), &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
ENDIF
IF (LRED) THEN
!$acc kernels
@@ -1220,18 +910,20 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemente
PRS(:,:,:,5)>ZRSMIN(5) .OR. &
PRS(:,:,:,6)>ZRSMIN(6)
!$acc end kernels
-
- CALL RAIN_ICE_RED ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,IKA,IKU,IKL, &
- PTSTEP, KRR, LLMICRO, ZEXN, &
+ CALL RAIN_ICE_RED (SIZE(PTHT, 1), SIZE(PTHT, 2), SIZE(PTHT, 3), COUNT(LLMICRO), &
+ OSEDIC, CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI, &
+ OWARM,IKA,IKU,IKL, &
+ PTSTEP, KRR, LLMICRO, ZEXN, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT,PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF, &
PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
PRT(:,:,:,3), PRT(:,:,:,4), &
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC,PINPRR, PEVAP3D, &
-! PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR,, PSEA,PTOWN, PFPR=ZFPR)
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA=PSEA,PTOWN=PTOWN)
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, &
+ PSEA=PSEA, PTOWN=PTOWN, PFPR=ZFPR )
ELSE
CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
KSPLITR, PTSTEP, KRR, &
@@ -1243,29 +935,31 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','C2R2//KHKO not yet implemente
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, &
-! PSEA, PTOWN, PFPR=ZFPR )
- PSEA, PTOWN )
+ PSEA, PTOWN, PFPR=ZFPR )
END IF
!
!* 9.2 Perform the saturation adjustment over cloud ice and cloud water
!
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'DEPI', &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF,PRC_MF,PRI_MF, &
- PRV=ZRSSTEP(:,:,:,1), PRC=ZRSSTEP(:,:,:,2), &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=ZTHSSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=ZRSSTEP(:,:,:,3), &
- PRI=ZRSSTEP(:,:,:,4), PRIS=PRS(:,:,:,4), &
- PRS=ZRSSTEP(:,:,:,5), &
- PRG=ZRSSTEP(:,:,:,6) )
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'DEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=ZRSSTEP(:,:,:,1), PRC=ZRSSTEP(:,:,:,2), &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=ZTHSSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=ZRSSTEP(:,:,:,3), &
+ PRI=ZRSSTEP(:,:,:,4), PRIS=PRS(:,:,:,4), &
+ PRS=ZRSSTEP(:,:,:,5), &
+ PRG=ZRSSTEP(:,:,:,6), &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
END IF
- !
-! DEALLOCATE(ZRSSTEP)
-! DEALLOCATE(ZTHSSTEP)
+
+!$acc end data
+ deallocate( zexn )
!
CASE ('ICE4')
#ifdef MNH_OPENACC
@@ -1275,6 +969,11 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','ICE4 not yet implemented')
!* 10. MIXED-PHASE MICROPHYSICAL SCHEME (WITH 4 ICE SPECIES)
! -----------------------------------------------------
!
+ allocate( zexn( size( pzz, 1 ), size( pzz, 2 ), size( pzz, 3 ) ) )
+!$acc data create( ZEXN )
+!$acc kernels
+ ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
+!$acc end kernels
!
!* 10.1 Compute the explicit microphysical sources
!
@@ -1286,18 +985,21 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','ICE4 not yet implemented')
!$acc end kernels
ZZZ = MZF( PZZ )
IF(LRED .AND. LADJ_BEFORE) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'ADJU', &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF,PRC_MF,PRI_MF, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- PRH=PRS(:,:,:,7)*PTSTEP )
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'ADJU', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
ENDIF
IF (LRED) THEN
LLMICRO(:,:,:)=PRT(:,:,:,2)>XRTMIN(2) .OR. &
@@ -1313,18 +1015,20 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','ICE4 not yet implemented')
PRS(:,:,:,5)>ZRSMIN(5) .OR. &
PRS(:,:,:,6)>ZRSMIN(6) .OR. &
PRS(:,:,:,7)>ZRSMIN(7)
- CALL RAIN_ICE_RED ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,IKA,IKU,IKL, &
+ CALL RAIN_ICE_RED (SIZE(PTHT, 1), SIZE(PTHT, 2), SIZE(PTHT, 3), COUNT(LLMICRO), &
+ OSEDIC, CSEDIM, HSUBG_AUCV, CSUBG_AUCV_RI,&
+ OWARM, IKA, IKU, IKL, &
PTSTEP, KRR, LLMICRO, ZEXN, &
ZDZZ, PRHODJ, PRHODREF, PEXNREF, PPABST, PCIT, PCLDFR,&
+ PHLC_HRC, PHLC_HCF, PHLI_HRI, PHLI_HCF,&
PTHT, PRT(:,:,:,1), PRT(:,:,:,2), &
PRT(:,:,:,3), PRT(:,:,:,4), &
PRT(:,:,:,5), PRT(:,:,:,6), &
PTHS, PRS(:,:,:,1), PRS(:,:,:,2), PRS(:,:,:,3), &
PRS(:,:,:,4), PRS(:,:,:,5), PRS(:,:,:,6), &
PINPRC, PINPRR, PEVAP3D, &
- PINPRS, PINPRG, PSIGS, PINDEP, PRAINFR, PSEA, PTOWN, &
-! PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
- PRT(:,:,:,7), PRS(:,:,:,7), PINPRH )
+ PINPRS, PINPRG, PINDEP, PRAINFR, PSIGS, PSEA, PTOWN, &
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH, PFPR=ZFPR )
ELSE
CALL RAIN_ICE ( OSEDIC,CSEDIM, HSUBG_AUCV, OWARM,1,IKU,1, &
KSPLITR, PTSTEP, KRR, &
@@ -1337,8 +1041,7 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','ICE4 not yet implemented')
PINPRC, PINPRR, PINPRR3D, PEVAP3D, &
PINPRS, PINPRG, PSIGS,PINDEP, PRAINFR, &
PSEA, PTOWN, &
-! PRT(:,:,:,7), PRS(:,:,:,7), PINPRH,PFPR=ZFPR )
- PRT(:,:,:,7), PRS(:,:,:,7), PINPRH)
+ PRT(:,:,:,7), PRS(:,:,:,7), PINPRH,PFPR=ZFPR )
END IF
@@ -1346,19 +1049,25 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','ICE4 not yet implemented')
!* 10.2 Perform the saturation adjustment over cloud ice and cloud water
!
IF (.NOT. LRED .OR. (LRED .AND. LADJ_AFTER) ) THEN
- CALL ICE_ADJUST (1,IKU,1, KRR, CFRAC_ICE_ADJUST, 'DEPI', &
- OSUBG_COND, OSIGMAS, PTSTEP,PSIGQSAT, &
- PRHODJ, PEXNREF, PSIGS, PMFCONV, PPABST, ZZZ, &
- ZEXN, PCF_MF,PRC_MF,PRI_MF, &
- PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
- PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
- PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
- PRR=PRS(:,:,:,3)*PTSTEP, &
- PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
- PRS=PRS(:,:,:,5)*PTSTEP, &
- PRG=PRS(:,:,:,6)*PTSTEP, &
- PRH=PRS(:,:,:,7)*PTSTEP )
+ CALL ICE_ADJUST (1, IKU, 1, KRR, CFRAC_ICE_ADJUST, CCONDENS, CLAMBDA3, &
+ 'DEPI', OSUBG_COND, OSIGMAS, CSUBG_MF_PDF, &
+ PTSTEP, PSIGQSAT, &
+ PRHODJ, PEXNREF, PRHODREF, PSIGS, PMFCONV, PPABST, ZZZ, &
+ ZEXN, PCF_MF, PRC_MF, PRI_MF, &
+ PRV=PRS(:,:,:,1)*PTSTEP, PRC=PRS(:,:,:,2)*PTSTEP, &
+ PRVS=PRS(:,:,:,1), PRCS=PRS(:,:,:,2), &
+ PTH=PTHS*PTSTEP, PTHS=PTHS, PSRCS=PSRCS, PCLDFR=PCLDFR, &
+ PRR=PRS(:,:,:,3)*PTSTEP, &
+ PRI=PRS(:,:,:,4)*PTSTEP, PRIS=PRS(:,:,:,4), &
+ PRS=PRS(:,:,:,5)*PTSTEP, &
+ PRG=PRS(:,:,:,6)*PTSTEP, &
+ PRH=PRS(:,:,:,7)*PTSTEP, &
+ PHLC_HRC=PHLC_HRC, PHLC_HCF=PHLC_HCF, &
+ PHLI_HRI=PHLI_HRI, PHLI_HCF=PHLI_HCF )
END IF
+
+!$acc end data
+ deallocate( zexn )
!
!
!* 12. 2-MOMENT MIXED-PHASE MICROPHYSICAL SCHEME LIMA
@@ -1377,96 +1086,101 @@ CALL PRINT_MSG(NVERB_FATAL,'GEN','RESOLVED_CLOUD','LIMA not yet implemented')
ENDDO
ZZZ = MZF( PZZ )
IF (LPTSPLIT) THEN
+ ZICEFR = 0.
+ ZPRCFR = 0.
CALL LIMA (1, IKU, 1, &
- PTSTEP, TPFILE, OCLOSE_OUT, &
+ PTSTEP, TPFILE, &
PRHODREF, PEXNREF, ZDZZ, &
PRHODJ, PPABSM, PPABST, &
NMOD_CCN, NMOD_IFN, NMOD_IMM, &
- PTHM, PTHT, PRT, ZSVT, PW_ACT, &
- PTHS, PRS, ZSVS, &
+ PDTHRAD, PTHT, PRT, &
+ 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, &
- TPFILE, OCLOSE_OUT, KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PW_ACT, PPABSM, PPABST, &
- PTHM, PRCM, &
- PTHT, PRT, ZSVT, &
- PTHS, PRS, ZSVS, &
- PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
+ IF (OWARM) CALL LIMA_WARM(OACTIT, OSEDC, ORAIN, KSPLITR, PTSTEP, KMI, &
+ TPFILE, KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PW_ACT, PPABSM, PPABST, &
+ PDTHRAD, PRCM, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRC, PINPRR, PINDEP, PINPRR3D, PEVAP3D )
!
IF (LCOLD) CALL LIMA_COLD(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
KRR, PZZ, PRHODJ, &
PRHODREF, PEXNREF, PPABST, PW_ACT, &
PTHM, PPABSM, &
- PTHT, PRT, ZSVT, &
- PTHS, PRS, ZSVS, &
- PINPRS, PINPRG, PINPRH)
-!
- IF (OWARM .AND. LCOLD) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
- KRR, PZZ, PRHODJ, &
- PRHODREF, PEXNREF, PPABST, PW_ACT, &
- PTHM, PPABSM, &
- PTHT, PRT, ZSVT, &
- PTHS, PRS, ZSVS )
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PINPRS, PINPRG, PINPRH )
+!
+ IF (OWARM .AND. LCOLD) CALL LIMA_MIXED(OSEDI, OHHONI, KSPLITG, PTSTEP, KMI, &
+ KRR, PZZ, PRHODJ, &
+ PRHODREF, PEXNREF, PPABST, PW_ACT, &
+ PTHM, PPABSM, &
+ PTHT, PRT, PSVT(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END), &
+ PTHS, PRS, PSVS(:,:,:,NSV_LIMA_BEG:NSV_LIMA_END) )
ENDIF
!
!* 12.2 Perform the saturation adjustment
!
- CALL LIMA_ADJUST(KRR, KMI, TPFILE, HRAD, &
- HTURBDIM, OCLOSE_OUT, OSUBG_COND, PTSTEP, &
- PRHODREF, PRHODJ, PEXNREF, PPABST, PSIGS, PPABST, &
- PRT, PRS, ZSVT, ZSVS, &
- 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
!
-! IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN
-! PINPRC3D=ZFPR(:,:,:,2) / XRHOLW
-! PINPRR3D=ZFPR(:,:,:,3) / XRHOLW
-! PINPRS3D=ZFPR(:,:,:,5) / XRHOLW
-! PINPRG3D=ZFPR(:,:,:,6) / XRHOLW
-! IF(KRR==7) PINPRH3D=ZFPR(:,:,:,7) / XRHOLW
-! WHERE (PRT(:,:,:,2) > 1.E-04 )
-! PSPEEDC=ZFPR(:,:,:,2) / (PRT(:,:,:,2) * PRHODREF(:,:,:))
-! ENDWHERE
-! WHERE (PRT(:,:,:,3) > 1.E-04 )
-! PSPEEDR=ZFPR(:,:,:,3) / (PRT(:,:,:,3) * PRHODREF(:,:,:))
-! ENDWHERE
-! WHERE (PRT(:,:,:,5) > 1.E-04 )
-! PSPEEDS=ZFPR(:,:,:,5) / (PRT(:,:,:,5) * PRHODREF(:,:,:))
-! ENDWHERE
-! WHERE (PRT(:,:,:,6) > 1.E-04 )
-! PSPEEDG=ZFPR(:,:,:,6) / (PRT(:,:,:,6) * PRHODREF(:,:,:))
-! ENDWHERE
-! IF(KRR==7) THEN
-! WHERE (PRT(:,:,:,7) > 1.E-04 )
-! PSPEEDH=ZFPR(:,:,:,7) / (PRT(:,:,:,7) * PRHODREF(:,:,:))
-! ENDWHERE
-! ENDIF
-! ENDIF
-!
-IF ( (HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2') ) THEN
-! CALL GET_HALO(PRS(:,:,:,2))
-! CALL GET_HALO(ZSVS(:,:,:,2))
-! CALL GET_HALO(ZSVS(:,:,:,3))
- WHERE (PRS(:,:,:,2) < 0. .OR. ZSVS(:,:,:,2) < 0.)
- ZSVS(:,:,:,1) = 0.0
- END WHERE
- DO JSV = 2, 3
- WHERE (PRS(:,:,:,JSV) < 0. .OR. ZSVS(:,:,:,JSV) < 0.)
- PRS(:,:,:,1) = PRS(:,:,:,1) + PRS(:,:,:,JSV)
- PTHS(:,:,:) = PTHS(:,:,:) - PRS(:,:,:,JSV) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / PEXNREF(:,:,:)
- PRS(:,:,:,JSV) = 0.0
- ZSVS(:,:,:,JSV) = 0.0
- END WHERE
- ENDDO
- IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:), 4,'NECON_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRS(:,:,:,1) * PRHODJ(:,:,:), 6,'NECON_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRS(:,:,:,2) * PRHODJ(:,:,:), 7,'NECON_BU_RRC')
-END IF
+#if 0
+IF(HCLOUD=='ICE3' .OR. HCLOUD=='ICE4' ) THEN
+ PINPRC3D=ZFPR(:,:,:,2) / XRHOLW
+ PINPRR3D=ZFPR(:,:,:,3) / XRHOLW
+ PINPRS3D=ZFPR(:,:,:,5) / XRHOLW
+ PINPRG3D=ZFPR(:,:,:,6) / XRHOLW
+ IF(KRR==7) PINPRH3D=ZFPR(:,:,:,7) / XRHOLW
+ WHERE (PRT(:,:,:,2) > 1.E-04 )
+ PSPEEDC=ZFPR(:,:,:,2) / (PRT(:,:,:,2) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,3) > 1.E-04 )
+ PSPEEDR=ZFPR(:,:,:,3) / (PRT(:,:,:,3) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,5) > 1.E-04 )
+ PSPEEDS=ZFPR(:,:,:,5) / (PRT(:,:,:,5) * PRHODREF(:,:,:))
+ ENDWHERE
+ WHERE (PRT(:,:,:,6) > 1.E-04 )
+ PSPEEDG=ZFPR(:,:,:,6) / (PRT(:,:,:,6) * PRHODREF(:,:,:))
+ ENDWHERE
+ IF(KRR==7) THEN
+ WHERE (PRT(:,:,:,7) > 1.E-04 )
+ PSPEEDH=ZFPR(:,:,:,7) / (PRT(:,:,:,7) * PRHODREF(:,:,:))
+ ENDWHERE
+ ENDIF
+ENDIF
+#endif
+
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NECON', krr, ptstep, ppabst, ptht, prt, pths, prs, psvs, prhodj )
+
!-------------------------------------------------------------------------------
!
!
@@ -1482,13 +1196,9 @@ END DO
!$acc end kernels
!
IF (HCLOUD=='C2R2' .OR. HCLOUD=='C3R5' .OR. HCLOUD=='KHKO' .OR. HCLOUD=='LIMA') THEN
- DO JSV = 1,SIZE(ZSVS,4)
- PSVS(:,:,:,JSV+ISVBEG-1) = ZSVS(:,:,:,JSV) * PRHODJ(:,:,:)
- ENDDO
- DO JSV = 1,SIZE(ZSVT,4)
- PSVT(:,:,:,JSV+ISVBEG-1) = ZSVT(:,:,:,JSV)
+ DO JSV = ISVBEG, ISVEND
+ PSVS(:,:,:,JSV) = PSVS(:,:,:,JSV) * PRHODJ(:,:,:)
ENDDO
-!$acc exit data delete(ZSVT,ZSVS)
ENDIF
!
IF (MPPDB_INITIALIZED) THEN
@@ -1512,6 +1222,10 @@ IF (MPPDB_INITIALIZED) THEN
CALL MPPDB_CHECK(PNACT,"RESOLVED_CLOUD end:PNACT")
CALL MPPDB_CHECK(PNPRO,"RESOLVED_CLOUD end:PNPRO")
CALL MPPDB_CHECK(PSSPRO,"RESOLVED_CLOUD end:PSSPRO")
+ CALL MPPDB_CHECK(PHLC_HRC,"RESOLVED_CLOUD end:PHLC_HRC")
+ CALL MPPDB_CHECK(PHLC_HCF,"RESOLVED_CLOUD end:PHLC_HCF")
+ CALL MPPDB_CHECK(PHLI_HRI,"RESOLVED_CLOUD end:PHLI_HRI")
+ CALL MPPDB_CHECK(PHLI_HCF,"RESOLVED_CLOUD end:PHLI_HCF")
!Check all OUT arrays
CALL MPPDB_CHECK(PSRCS, "RESOLVED_CLOUD end:PSRCS")
CALL MPPDB_CHECK(PRAINFR,"RESOLVED_CLOUD end:PRAINFR")
diff --git a/src/MNH/resolved_elecn.f90 b/src/MNH/resolved_elecn.f90
index 6d82e6e5b8cb6c9a045fecf2d36c553f8cacbc63..38ca1080bd0cf2ef039f71591c867eca8b7f6b41 100644
--- a/src/MNH/resolved_elecn.f90
+++ b/src/MNH/resolved_elecn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2009-2020 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.
@@ -171,18 +171,25 @@ END MODULE MODI_RESOLVED_ELEC_n
! P. Wautelet 22/01/2019: use standard FLUSH statement instead of non standard intrinsics
! P. Wautelet 14/03/2019: bugfix: correct management of files
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-!
+! P. Wautelet 12/02/2021: bugfix: change STATUS for opening files containing flash information (NEW->UNKNOWN)
+! P. Wautelet 17/02/2021: budgets: add DRIFT and CORAY terms for electricity
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use mode_budget, only: Budget_store_add, Budget_store_init, Budget_store_end
USE MODE_ELEC_ll
USE MODE_IO_FILE, ONLY: IO_File_close, IO_File_open
USE MODE_IO_MANAGE_STRUCT, ONLY: IO_File_add2list, IO_File_find_byname
USE MODE_ll
!
-USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZX, XDZY, XDZZ
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, &
+ lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, &
+ NBUDGET_SV1, &
+ tbudgets
+USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZX, XDZY, XDZZ
USE MODD_FIELD_n, ONLY : XRSVS
USE MODD_CONF, ONLY : L1D, L2D, CEXP
USE MODD_CST
@@ -190,7 +197,6 @@ USE MODD_IO, ONLY: TFILEDATA, TFILE_DUMMY
USE MODD_PARAMETERS, ONLY : JPVEXT
USE MODD_ELEC_DESCR
USE MODD_ELEC_n
-USE MODD_BUDGET
USE MODD_NSV
USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LCH_CONV_LINOX
USE MODD_DYN_n, ONLY: NSTOP, XTSTEP
@@ -205,7 +211,6 @@ USE MODI_ICE_ADJUST_ELEC
USE MODI_TO_ELEC_FIELD_n
USE MODI_FLASH_GEOM_ELEC_n
USE MODI_SHUMAN
-USE MODI_BUDGET
USE MODI_ION_ATTACH_ELEC
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
!
@@ -371,6 +376,19 @@ CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
IKB = 1 + JPVEXT
IKE = SIZE(PZZ,3) - JPVEXT
!
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NEGA', pths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NEGA', prs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'NEGA', prs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'NEGA', prs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'NEGA', prs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'NEGA', prs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'NEGA', prs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'NEGA', prs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jsv = nsv_elecbeg, nsv_elecend
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'NEGA', psvs(:, :, :, jsv) )
+ end do
+end if
!
!------------------------------------------------------------------------------
!
@@ -610,21 +628,19 @@ END DO
!
!* 3.4 store the budget terms
!
-IF (LBUDGET_RV) CALL BUDGET (PRS(:,:,:,1) * PRHODJ(:,:,:), 6,'NEGA_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRS(:,:,:,2) * PRHODJ(:,:,:), 7,'NEGA_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRS(:,:,:,3) * PRHODJ(:,:,:), 8,'NEGA_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRS(:,:,:,4) * PRHODJ(:,:,:) ,9,'NEGA_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRS(:,:,:,5) * PRHODJ(:,:,:),10,'NEGA_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRS(:,:,:,6) * PRHODJ(:,:,:),11,'NEGA_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRS(:,:,:,7) * PRHODJ(:,:,:),12,'NEGA_BU_RRH')
-IF (LBUDGET_TH) CALL BUDGET (PTHS(:,:,:) * PRHODJ(:,:,:), 4,'NEGA_BU_RTH')
-!
-IF (LBUDGET_SV) THEN
- DO JSV = NSV_ELECBEG, NSV_ELECEND
- CALL BUDGET (PSVS(:,:,:,JSV) * PRHODJ(:,:,:), 12+JSV, 'NEGA_BU_RSV')
- END DO
-END IF
-!
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NEGA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NEGA', prs (:, :, :, 1) * prhodj(:, :, :) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'NEGA', prs (:, :, :, 2) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'NEGA', prs (:, :, :, 3) * prhodj(:, :, :) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'NEGA', prs (:, :, :, 4) * prhodj(:, :, :) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'NEGA', prs (:, :, :, 5) * prhodj(:, :, :) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'NEGA', prs (:, :, :, 6) * prhodj(:, :, :) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'NEGA', prs (:, :, :, 7) * prhodj(:, :, :) )
+if ( lbudget_sv ) then
+ do jsv = nsv_elecbeg, nsv_elecend
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'NEGA', psvs(:, :, :, jsv) * prhodj(:, :, :) )
+ end do
+end if
!
!------------------------------------------------------------------------------
!
@@ -656,9 +672,13 @@ CALL MYPROC_ELEC_ll (IPROC)
!
CALL ION_DRIFT(ZCPH, ZCOR, PSVT, HLBCX, HLBCY)
-
PSVS(:,:,:,NSV_ELECBEG) = PSVS(:,:,:,NSV_ELECBEG) + ZCPH(:,:,:)
PSVS(:,:,:,NSV_ELECEND) = PSVS(:,:,:,NSV_ELECEND) + ZCOR(:,:,:)
+
+if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg), 'DRIFT', zcph(:, :, :) * prhodj(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend), 'DRIFT', zcor(:, :, :) * prhodj(:, :, :) )
+end if
!
!* 4.3 Add Cosmic Ray source
!
@@ -666,6 +686,11 @@ PSVS(:,:,:,NSV_ELECBEG) = PSVS(:,:,:,NSV_ELECBEG) + &
XIONSOURCEFW(:,:,:) / PRHODREF(:,:,:)
PSVS(:,:,:,NSV_ELECEND) = PSVS(:,:,:,NSV_ELECEND) + &
XIONSOURCEFW(:,:,:) / PRHODREF(:,:,:)
+
+if ( lbudget_sv ) then
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecbeg), 'CORAY', xionsourcefw(:,:,:)/prhodref(:,:,:) * prhodj(:, :, :) )
+ call Budget_store_add( tbudgets(NBUDGET_SV1 - 1 + nsv_elecend), 'CORAY', xionsourcefw(:,:,:)/prhodref(:,:,:) * prhodj(:, :, :) )
+end if
!
!-------------------------------------------------------------------------------
!
@@ -854,7 +879,7 @@ IF (KTCOUNT==1 .AND. IPROC==0) THEN
YASCFILE = CEXP//"_fgeom_diag.asc"
TZFILE_FGEOM_DIAG => NULL()
CALL IO_File_add2list(TZFILE_FGEOM_DIAG,YASCFILE,'TXT','WRITE')
- CALL IO_File_open(TZFILE_FGEOM_DIAG,HPOSITION='APPEND',HSTATUS='NEW')
+ CALL IO_File_open(TZFILE_FGEOM_DIAG,HPOSITION='APPEND',HSTATUS='UNKNOWN')
ILU = TZFILE_FGEOM_DIAG%NLU
WRITE (UNIT=ILU, FMT='(A)') '--------------------------------------------------------'
WRITE (UNIT=ILU, FMT='(A)') '*FLASH CHARACTERISTICS FROM FLASH_GEOM_ELEC*'
@@ -879,7 +904,7 @@ IF (KTCOUNT==1 .AND. IPROC==0) THEN
YASCFILE = CEXP//"_fgeom_coord.asc"
TZFILE_FGEOM_COORD => NULL()
CALL IO_File_add2list(TZFILE_FGEOM_COORD,YASCFILE,'TXT','WRITE')
- CALL IO_File_open(TZFILE_FGEOM_COORD,HPOSITION='APPEND',HSTATUS='NEW')
+ CALL IO_File_open(TZFILE_FGEOM_COORD,HPOSITION='APPEND',HSTATUS='UNKNOWN')
ILU = TZFILE_FGEOM_COORD%NLU
WRITE (UNIT=ILU,FMT='(A)') '------------------------------------------'
WRITE (UNIT=ILU,FMT='(A)') '*****FLASH COORD. FROM FLASH_GEOM_ELEC****'
@@ -898,7 +923,7 @@ IF (KTCOUNT==1 .AND. IPROC==0) THEN
YASCFILE = CEXP//"_series_cloud_elec.asc"
TZFILE_SERIES_CLOUD_ELEC => NULL()
CALL IO_File_add2list(TZFILE_SERIES_CLOUD_ELEC,YASCFILE,'TXT','WRITE')
- CALL IO_File_open(TZFILE_SERIES_CLOUD_ELEC,HPOSITION='APPEND',HSTATUS='NEW')
+ CALL IO_File_open(TZFILE_SERIES_CLOUD_ELEC,HPOSITION='APPEND',HSTATUS='UNKNOWN')
ILU = TZFILE_SERIES_CLOUD_ELEC%NLU
WRITE (UNIT=ILU, FMT='(A)') '----------------------------------------------------'
WRITE (UNIT=ILU, FMT='(A)') '********* RESULTS FROM of LSERIES_ELEC *************'
@@ -933,11 +958,11 @@ IF (LFLASH_GEOM .AND. LLMA) THEN
!
GLMA_FILE = .FALSE.
!
- IF (TDTCUR%TIME >= TDTLMA%TIME-PTSTEP .AND. CLMA_FILE(1:5) /= "BEGIN") THEN
+ IF (TDTCUR%xtime >= TDTLMA%xtime-PTSTEP .AND. CLMA_FILE(1:5) /= "BEGIN") THEN
LWRITE_LMA = .TRUE.
END IF
- IF (TDTCUR%TIME >= TDTLMA%TIME) THEN
- TDTLMA%TIME = TDTLMA%TIME + XDTLMA
+ IF (TDTCUR%xtime >= TDTLMA%xtime) THEN
+ TDTLMA%xtime = TDTLMA%xtime + XDTLMA
GLMA_FILE = .TRUE.
LWRITE_LMA = .FALSE.
END IF
@@ -949,18 +974,18 @@ IF (LFLASH_GEOM .AND. LLMA) THEN
TZFILE_LMA => NULL()
ENDIF
!
- TDTLMA%TIME = TDTLMA%TIME - XDTLMA
- WRITE (YNAME,FMT='(3I2.2,A1,3I2.2,A1,I4.4)') &
- ABS(TDTCUR%TDATE%YEAR-2000),TDTCUR%TDATE%MONTH,TDTCUR%TDATE%DAY,'_', &
- INT(TDTLMA%TIME/3600.),INT(REAL(MOD(INT(TDTLMA%TIME),3600))/60.), &
- MOD(INT(TDTLMA%TIME),60), '_', INT(XDTLMA)
- TDTLMA%TIME = MOD(TDTLMA%TIME + XDTLMA,86400.)
+ TDTLMA%xtime = TDTLMA%xtime - XDTLMA
+ WRITE (YNAME,FMT='(3I2.2,A1,3I2.2,A1,I4.4)') &
+ ABS(TDTCUR%nyear-2000),TDTCUR%nmonth,TDTCUR%nday,'_', &
+ INT(TDTLMA%xtime/3600.),INT(REAL(MOD(INT(TDTLMA%xtime),3600))/60.), &
+ MOD(INT(TDTLMA%xtime),60), '_', INT(XDTLMA)
+ TDTLMA%xtime = MOD(TDTLMA%xtime + XDTLMA,86400.)
CLMA_FILE = CEXP//"_SIMLMA_"//YNAME//".dat"
!
IF ( IPROC .EQ. 0 ) THEN
TZFILE_LMA => NULL()
CALL IO_File_add2list(TZFILE_LMA,CLMA_FILE,'TXT','WRITE')
- CALL IO_File_open(TZFILE_LMA,HPOSITION='APPEND',HSTATUS='NEW')
+ CALL IO_File_open(TZFILE_LMA,HPOSITION='APPEND',HSTATUS='UNKNOWN')
ILU = TZFILE_LMA%NLU
WRITE (UNIT=ILU,FMT='(A)') '----------------------------------------'
WRITE (UNIT=ILU,FMT='(A)') '*** FLASH COORD. FROM LMA SIMULATOR ****'
diff --git a/src/MNH/sbl_depth.f90 b/src/MNH/sbl_depth.f90
index 30916e244e59d25ba14ab9167cc0e9f0c731a9a1..1c1bb30382566dc057e40cbb3e2ba6d5d63624da 100644
--- a/src/MNH/sbl_depth.f90
+++ b/src/MNH/sbl_depth.f90
@@ -60,7 +60,7 @@ END MODULE MODI_SBL_DEPTH
!! MODIFICATIONS
!! -------------
!! Original nov. 2005
-!!
+!! 26/02/2020 T.Nagel Correction of SBL depth computation in neutral stratification
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -159,7 +159,7 @@ ZSBL_THER= XSBL_O_BL * BL_DEPTH_DIAG(KKB,KKE,ZQ0,PZZ(:,:,KKB),PWTHV,PZZ,XFTOP_O_
PSBL_DEPTH = 0.
WHERE (ZSBL_THER> 0. .AND. ZSBL_DYN> 0.) PSBL_DEPTH = MIN(ZSBL_THER(:,:),ZSBL_DYN(:,:))
WHERE (ZSBL_THER> 0. .AND. ZSBL_DYN==0.) PSBL_DEPTH = ZSBL_THER(:,:)
-WHERE (ZSBL_THER==0. .AND. ZSBL_DYN> 0.) PSBL_DEPTH = ZSBL_THER(:,:)
+WHERE (ZSBL_THER==0. .AND. ZSBL_DYN> 0.) PSBL_DEPTH = ZSBL_DYN(:,:)
!
DO JLOOP=1,5
WHERE (PLMO(:,:)/=XUNDEF .AND. ABS(PLMO(:,:))>=0.01 )
@@ -167,8 +167,8 @@ DO JLOOP=1,5
PSBL_DEPTH = 0.2 * PSBL_DEPTH + 0.8 * ((1.-ZA) * ZSBL_DYN + ZA * ZSBL_THER )
END WHERE
END DO
-WHERE (ABS(PLMO(:,:))<=0.01 ) PSBL_DEPTH = ZSBL_DYN
-WHERE (PLMO(:,:)==XUNDEF) PSBL_DEPTH = ZSBL_THER
+WHERE (ABS(PLMO(:,:))<=0.01 ) PSBL_DEPTH = ZSBL_THER
+WHERE (PLMO(:,:)==XUNDEF) PSBL_DEPTH = ZSBL_DYN
if ( mppdb_initialized ) then
!Check all inout arrays
diff --git a/src/MNH/sedim_blowsnow.f90 b/src/MNH/sedim_blowsnow.f90
index 521bf2059b3c39469bbdebb50e5eae9ddd06f7e7..2cb0f82646a9748e9cca38b64e336699bb01c983 100644
--- a/src/MNH/sedim_blowsnow.f90
+++ b/src/MNH/sedim_blowsnow.f90
@@ -1,8 +1,11 @@
-!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.
!-----------------------------------------------------------------
+! Modifications:
+! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+!-----------------------------------------------------------------
! ##############################
MODULE MODI_SEDIM_BLOWSNOW
!! ##############################
@@ -13,7 +16,6 @@ SUBROUTINE SEDIM_BLOWSNOW( &
PTHT & !I [K] theta
,PDTMONITOR & !I Time step
,PRHODREF & !I [kg/m3] air density
- ,PPABST & !I [Pa] pressure
,PZZ & !I [m] height of layers
,PSVT & !IO [scalar variable, ppp] Blowing snow concentration
,PSVS & !IO ! Blowing snow variable source
@@ -26,7 +28,6 @@ REAL, INTENT(IN) :: PDTMONITOR
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !scalar variable
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS !scalar variable
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT,PRHODREF, PZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PVGK !Settling velocity of blowing snow variable
@@ -39,7 +40,7 @@ END MODULE MODI_SEDIM_BLOWSNOW
!! #######################################
SUBROUTINE SEDIM_BLOWSNOW(PTHT,PDTMONITOR,&
- PRHODREF,PPABST,PZZ,PSVT,&
+ PRHODREF,PZZ,PSVT,&
PSVS,PVGK)
!! #######################################
!!
@@ -58,7 +59,6 @@ END MODULE MODI_SEDIM_BLOWSNOW
!! -------------
!! Original
!!
-! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
!
USE MODD_BLOWSNOW
USE MODD_CSTS_BLOWSNOW
@@ -73,7 +73,6 @@ REAL, INTENT(IN) :: PDTMONITOR
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT !scalar variable
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVS !scalar variable
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT,PRHODREF, PZZ
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PVGK !Settling velocity of blowing snow variable
!
diff --git a/src/MNH/select_std_pgd.f90 b/src/MNH/select_std_pgd.f90
deleted file mode 100644
index 355f99426bddb54eca52a5d543a234eadb31c0b7..0000000000000000000000000000000000000000
--- a/src/MNH/select_std_pgd.f90
+++ /dev/null
@@ -1,306 +0,0 @@
-!MNH_LIC Copyright 1997-2018 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed 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_SELECT_STD_PGD
-! ##########################
-INTERFACE
- SUBROUTINE SELECT_STD_PGD(HFIELD_NAME,PFIELD)
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFIELD_NAME ! pgd field name
-REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD ! pgd field
-!
-END SUBROUTINE SELECT_STD_PGD
-END INTERFACE
-END MODULE MODI_SELECT_STD_PGD
-!
-! ######################################
- SUBROUTINE SELECT_STD_PGD(HFIELD_NAME,PFIELD)
-! ######################################
-!
-!!****
-!!
-!! PURPOSE
-!! -------
-!!
-!! METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!!
-!! V. Masson Meteo-France
-!!
-!! MODIFICATION
-!! ------------
-!!
-!! Original 15/12/97
-!! F.Solmon 06/00 patch approach : Rq
-!! value of surface variable are atributed to NPT_USER class
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATION
-! -----------
-!
-USE MODD_LUNIT
-USE MODD_PGDFIELDS
-!
-!
-USE MODD_GROUND_PAR
-!
-!
-USE MODI_PGD_INDEX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-CHARACTER(LEN=*), INTENT(IN) :: HFIELD_NAME ! pgd field name
-REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD ! pgd field
-!
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-!
-CHARACTER(LEN=20) :: YFIELD
-!
-!-------------------------------------------------------------------------------
-!
-YFIELD=' '
-YFIELD=HFIELD_NAME//YFIELD
-!
-SELECT CASE (YFIELD)
-!
-!* 1. Vegetation parameters
-! ---------------------
-!
-!
- CASE('VEG ')
- LNOCLASS_PGD0(PGD_INDEX('VEG'))=.TRUE.
- XPGDVEG(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('LAI ')
- LNOCLASS_PGD0(PGD_INDEX('LAI'))=.TRUE.
- XPGDLAI(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('RSMIN ')
- LNOCLASS_PGD0(PGD_INDEX('RSMIN'))=.TRUE.
- XPGDRSMIN(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('GAMMA ')
- LNOCLASS_PGD0(PGD_INDEX('GAMMA'))=.TRUE.
- XPGDGAMMA(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('RGL ')
- LNOCLASS_PGD0(PGD_INDEX('RGL'))=.TRUE.
- XPGDRGL(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('CV ')
- LNOCLASS_PGD0(PGD_INDEX('CV'))=.TRUE.
- XPGDCV(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('DG2 ')
- LNOCLASS_PGD0(PGD_INDEX('DG2'))=.TRUE.
- XPGDDG(:,:,2,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('DG3 ')
- LNOCLASS_PGD0(PGD_INDEX('DG3'))=.TRUE.
- XPGDDG(:,:,3,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('Z0VEG ')
- LNOCLASS_PGD0(PGD_INDEX('Z0VEG'))=.TRUE.
- XPGDZ0VEG(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('Z0HVEG ')
- LNOCLASS_PGD0(PGD_INDEX('Z0HVEG'))=.TRUE.
- XPGDZ0HVEG(:,:,NPT_USER) = PFIELD (:,:)
-
- CASE('ALBNIR_ECO ')
- LNOCLASS_PGD0(PGD_INDEX('ALBNIR_ECO'))=.TRUE.
- XPGDALBNIR_ECO(:,:,NPT_USER) = PFIELD (:,:)
-!
- CASE('ALBVIS_ECO ')
- LNOCLASS_PGD0(PGD_INDEX('ALBVIS_ECO'))=.TRUE.
- XPGDALBVIS_ECO(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('EMIS_ECO ')
- LNOCLASS_PGD0(PGD_INDEX('EMIS_ECO'))=.TRUE.
- XPGDEMIS_ECO(:,:,NPT_USER) = PFIELD (:,:)
-
-!
- CASE('GMES ')
- LNOCLASS_PGD0(PGD_INDEX('GMES'))=.TRUE.
- XPGDGMES(:,:,NPT_USER) =PFIELD (:,:)
-
-!
- CASE('BSLAI ')
- LNOCLASS_PGD0(PGD_INDEX('BSLAI'))=.TRUE.
- XPGDBSLAI(:,:,NPT_USER) =PFIELD (:,:)
-
-!
- CASE('LAIMIN ')
- LNOCLASS_PGD0(PGD_INDEX('LAIMIN'))=.TRUE.
- XPGDLAIMIN(:,:,NPT_USER) =PFIELD (:,:)
-
-!
- CASE('SEFOLD ')
- LNOCLASS_PGD0(PGD_INDEX('SEFOLD'))=.TRUE.
- XPGDSEFOLD(:,:,NPT_USER) =PFIELD (:,:)
-
-!
- CASE('H_TREE ')
- LNOCLASS_PGD0(PGD_INDEX('H_TREE'))=.TRUE.
- XPGDH_TREE(:,:,NPT_USER) =PFIELD (:,:)
-
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Town parameters
-! ---------------
-!
- CASE('Z0_TOWN ')
- LNOCLASS_PGD0(PGD_INDEX('Z0_TOWN'))=.TRUE.
- XPGDZ0_TOWN(:,:) = PFIELD (:,:)
-!
- CASE('ALBNIR_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('ALBNIR_ROOF'))=.TRUE.
- XPGDALBNIR_ROOF(:,:) = PFIELD (:,:)
-!
- CASE('ALBVIS_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('ALBVIS_ROOF'))=.TRUE.
- XPGDALBVIS_ROOF(:,:) = PFIELD (:,:)
-!
- CASE('EMIS_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('EMIS_ROOF'))=.TRUE.
- XPGDEMIS_ROOF(:,:) = PFIELD (:,:)
-!
- CASE('HC_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('HC_ROOF'))=.TRUE.
- XPGDHC_ROOF(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDHC_ROOF,3))
-!
- CASE('TC_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('TC_ROOF'))=.TRUE.
- XPGDTC_ROOF(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDTC_ROOF,3))
-!
- CASE('D_ROOF ')
- LNOCLASS_PGD0(PGD_INDEX('D_ROOF'))=.TRUE.
- XPGDD_ROOF(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDD_ROOF,3))
-!
- CASE('ALBNIR_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('ALBNIR_ROAD'))=.TRUE.
- XPGDALBNIR_ROAD(:,:) = PFIELD (:,:)
-!
- CASE('ALBVIS_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('ALBVIS_ROAD'))=.TRUE.
- XPGDALBVIS_ROAD(:,:) = PFIELD (:,:)
-!
- CASE('EMIS_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('EMIS_ROAD'))=.TRUE.
- XPGDEMIS_ROAD(:,:) = PFIELD (:,:)
-!
- CASE('HC_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('HC_ROAD'))=.TRUE.
- XPGDHC_ROAD(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDHC_ROAD,3))
-!
- CASE('TC_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('TC_ROAD'))=.TRUE.
- XPGDTC_ROAD(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDTC_ROAD,3))
-!
- CASE('D_ROAD ')
- LNOCLASS_PGD0(PGD_INDEX('D_ROAD'))=.TRUE.
- XPGDD_ROAD(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDD_ROAD,3))
-!
- CASE('ALBNIR_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('ALBNIR_WALL'))=.TRUE.
- XPGDALBNIR_WALL(:,:) = PFIELD (:,:)
-!
- CASE('ALBVIS_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('ALBVIS_WALL'))=.TRUE.
- XPGDALBVIS_WALL(:,:) = PFIELD (:,:)
-!
- CASE('EMIS_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('EMIS_WALL'))=.TRUE.
- XPGDEMIS_WALL(:,:) = PFIELD (:,:)
-!
- CASE('HC_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('HC_WALL'))=.TRUE.
- XPGDHC_WALL(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDHC_WALL,3))
-!
- CASE('TC_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('TC_WALL'))=.TRUE.
- XPGDTC_WALL(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDTC_WALL,3))
-!
- CASE('D_WALL ')
- LNOCLASS_PGD0(PGD_INDEX('D_WALL'))=.TRUE.
- XPGDD_WALL(:,:,:) = SPREAD(PFIELD (:,:),3,SIZE(XPGDD_WALL,3))
-!
- CASE('BLD ')
- LNOCLASS_PGD0(PGD_INDEX('BLD'))=.TRUE.
- XPGDBLD(:,:) = PFIELD (:,:)
-!
- CASE('BLD_HEIGHT ')
- LNOCLASS_PGD0(PGD_INDEX('BLD_HEIGHT'))=.TRUE.
- XPGDBLD_HEIGHT(:,:) = PFIELD (:,:)
-!
- CASE('BLD_HL_RATIO ')
- LNOCLASS_PGD0(PGD_INDEX('BLD_HL_RATIO'))=.TRUE.
- XPGDBLD_HL_RATIO(:,:) = PFIELD (:,:)
-!
- CASE('CAN_HW_RATIO ')
- LNOCLASS_PGD0(PGD_INDEX('CAN_HW_RATIO'))=.TRUE.
- XPGDCAN_HW_RATIO(:,:) = PFIELD (:,:)
-!
- CASE('H_TRAFFIC ')
- LNOCLASS_PGD0(PGD_INDEX('H_TRAFFIC'))=.TRUE.
- XPGDH_TRAFFIC(:,:) = PFIELD (:,:)
-!
- CASE('LE_TRAFFIC ')
- LNOCLASS_PGD0(PGD_INDEX('LE_TRAFFIC'))=.TRUE.
- XPGDLE_TRAFFIC(:,:) = PFIELD (:,:)
-!
- CASE('H_INDUSTRY ')
- LNOCLASS_PGD0(PGD_INDEX('H_INDUSTRY'))=.TRUE.
- XPGDH_INDUSTRY(:,:) = PFIELD (:,:)
-!
- CASE('LE_INDUSTRY ')
- LNOCLASS_PGD0(PGD_INDEX('LE_INDUSTRY'))=.TRUE.
- XPGDLE_INDUSTRY(:,:) = PFIELD (:,:)
-!
-!-------------------------------------------------------------------------------
-!
- CASE DEFAULT
-
- PRINT*, ' '
- PRINT*, 'The field ',HFIELD_NAME, ' is not yet a standard PGD field.'
- PRINT*, 'IT WILL NOT BE SAVED ON THE PGD FILE.'
- PRINT*, ' '
-
-END SELECT
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE SELECT_STD_PGD
diff --git a/src/MNH/series_cloud_elec.f90 b/src/MNH/series_cloud_elec.f90
index 2346925601a90e9535358ee188f9f3928e82a027..cb4d18b427e80960d528689416df35526711dc03 100644
--- a/src/MNH/series_cloud_elec.f90
+++ b/src/MNH/series_cloud_elec.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2010-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
diff --git a/src/MNH/seriesn.f90 b/src/MNH/seriesn.f90
index c592e4b540e9bab63c7a48062de2430efad3081b..96487fcaa6d249df646e94c072d9278a0f8f6283 100644
--- a/src/MNH/seriesn.f90
+++ b/src/MNH/seriesn.f90
@@ -40,33 +40,31 @@
!! 01/2018 (G.Delautier) SURFEX 8.1
!! 03/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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+USE MODD_CONF, ONLY: NVERB
+USE MODD_CONF_n, ONLY: LUSERV,LUSERC,LUSERR,LUSERI,LUSERS,LUSERG,LUSERH
+USE MODD_FIELD_n, ONLY: XTHT,XWT,XUT,XPABST,XRT
+USE MODD_GRID_n, ONLY: XZZ
+USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_MNH_SURFEX_n
+USE MODD_PARAMETERS
+USE MODD_PRECIP_n, ONLY: XINPRC,XINPRR,XINPRS,XINPRG,XINPRH, &
+ XACPRC,XACPRR,XACPRS,XACPRG,XACPRH
+USE MODD_REF, ONLY: XRHODREFZ
USE MODD_SERIES
USE MODD_SERIES_n
-USE MODD_PARAMETERS
-USE MODD_CONF, ONLY: NVERB
-USE MODD_REF, ONLY: XRHODREFZ
-USE MODD_TIME, ONLY: TDTEXP
+USE MODD_TIME_n, ONLY: TDTCUR
USE MODD_TYPE_DATE
-USE MODD_CONF_n, ONLY: LUSERV,LUSERC,LUSERR,LUSERI,LUSERS,LUSERG,LUSERH
-USE MODD_FIELD_n, ONLY: XTHT,XWT,XUT,XPABST,XRT
-USE MODD_GRID_n, ONLY: XZZ
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PRECIP_n, ONLY: XINPRC,XINPRR,XINPRS,XINPRG,XINPRH, &
- XACPRC,XACPRR,XACPRS,XACPRG,XACPRH
-USE MODD_TIME_n, ONLY: TDTCUR
-! SURFACE FIELDS
-USE MODI_GET_SURF_VAR_n
!
-USE MODE_DATETIME
USE MODE_ll
USE MODE_MSG
!
-USE MODD_MNH_SURFEX_n
+USE MODI_GET_SURF_VAR_n
!
IMPLICIT NONE
!
@@ -92,7 +90,6 @@ INTEGER :: IRESP ! Return code of FM-routines
INTEGER :: ISER
CHARACTER (LEN=5), DIMENSION(3) :: YSUF
LOGICAL, DIMENSION(SIZE(LINBOX,1),SIZE(LINBOX,2),3) :: GINBOX
-TYPE (DATE_TIME) :: TZDTCUR ! current date and time
!SURFACE FIELDS
REAL, DIMENSION(SIZE(XTHT,1),SIZE(XTHT,2)) :: ZTS, ZTMNW, ZTBOT, ZCT,ZHML
INTEGER :: ILOOP, JLOOP, KI
@@ -168,13 +165,7 @@ IF(NVERB>=5) WRITE(ILUOUT,*) &
!
NSCOUNTD=NSCOUNTD+1
!
-TZDTCUR=TDTCUR
-!
-CALL DATETIME_DISTANCE(TDTEXP,TZDTCUR,XSTRAJT(NSCOUNTD,1))
-XSDATIME(13,NSCOUNTD)= TZDTCUR%TDATE%YEAR
-XSDATIME(14,NSCOUNTD)= TZDTCUR%TDATE%MONTH
-XSDATIME(15,NSCOUNTD)= TZDTCUR%TDATE%DAY
-XSDATIME(16,NSCOUNTD)= TZDTCUR%TIME
+tpsdates(nscountd) = tdtcur
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/set_advfrc.f90 b/src/MNH/set_advfrc.f90
index 954d6fb9607ae72667f10f5bfc57e2adaaf2fa28..395660c8837f8278d7a8544a33a4f1208464dc9c 100644
--- a/src/MNH/set_advfrc.f90
+++ b/src/MNH/set_advfrc.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -208,10 +208,10 @@ print*,"! 3. READ ASCII FILES FOR ADVECTIVE FORCING "
DO JKT = 1,NADVFRC
!
! Reading the date and the filename of mean state and frc
- READ(ILUPRE,*) TDTADVFRC(JKT)%TDATE%YEAR, &
- TDTADVFRC(JKT)%TDATE%MONTH, &
- TDTADVFRC(JKT)%TDATE%DAY, &
- TDTADVFRC(JKT)%TIME
+ READ(ILUPRE,*) TDTADVFRC(JKT)%nyear, &
+ TDTADVFRC(JKT)%nmonth, &
+ TDTADVFRC(JKT)%nday, &
+ TDTADVFRC(JKT)%xtime
! ; Read filenames
READ(ILUPRE,*) CFNAM_MEANVAR_ADV
READ(ILUPRE,*) CFNAM_ADV
@@ -318,10 +318,10 @@ print*,"!* 3. PRINT FORCING FIELDS"
WRITE(UNIT=ILUOUT,FMT='(" THERE ARE ",I2," ADV FORCING AT:")') NADVFRC
DO JL = 1 , NADVFRC
WRITE(UNIT=ILUOUT,FMT='(F9.0, "s, date:", I3, "/", I3, "/", I5)') &
- TDTADVFRC(JL)%TIME, &
- TDTADVFRC(JL)%TDATE%DAY, &
- TDTADVFRC(JL)%TDATE%MONTH, &
- TDTADVFRC(JL)%TDATE%YEAR
+ TDTADVFRC(JL)%xtime, &
+ TDTADVFRC(JL)%nday, &
+ TDTADVFRC(JL)%nmonth, &
+ TDTADVFRC(JL)%nyear
END DO
!
DO JKT = 2,NADVFRC-1
@@ -331,15 +331,15 @@ DO JKT = 2,NADVFRC-1
WRITE(ILUOUT,*) &
" soundings have to be entered in increasing temporal order"
WRITE(ILUOUT,*) "SOUNDING TIME ", JKT-1, " IS: "
- WRITE(ILUOUT,*) TDTADVFRC(JKT-1)%TDATE%YEAR, &
- TDTADVFRC(JKT-1)%TDATE%MONTH, &
- TDTADVFRC(JKT-1)%TDATE%DAY, &
- TDTADVFRC(JKT-1)%TIME
+ WRITE(ILUOUT,*) TDTADVFRC(JKT-1)%nyear, &
+ TDTADVFRC(JKT-1)%nmonth, &
+ TDTADVFRC(JKT-1)%nday, &
+ TDTADVFRC(JKT-1)%xtime
WRITE(ILUOUT,*) "SOUNDING TIME ", JKT, " IS: "
- WRITE(ILUOUT,*) TDTADVFRC(JKT)%TDATE%YEAR, &
- TDTADVFRC(JKT)%TDATE%MONTH, &
- TDTADVFRC(JKT)%TDATE%DAY, &
- TDTADVFRC(JKT)%TIME
+ WRITE(ILUOUT,*) TDTADVFRC(JKT)%nyear, &
+ TDTADVFRC(JKT)%nmonth, &
+ TDTADVFRC(JKT)%nday, &
+ TDTADVFRC(JKT)%xtime
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_ADVFRC','')
END IF
diff --git a/src/MNH/set_conc_lima.f90 b/src/MNH/set_conc_lima.f90
index 6f9e6c6ad06019e5104d70c6a2c4e92c01462bd4..3eeda7f5adc74f5e6b5f28bf2fd41cb64e56007e 100644
--- a/src/MNH/set_conc_lima.f90
+++ b/src/MNH/set_conc_lima.f90
@@ -1,32 +1,18 @@
-!MNH_LIC Copyright 2000-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!#######################################
- MODULE MODI_SET_CONC_LIMA
-! #######################################
-!
-INTERFACE
-!
- SUBROUTINE SET_CONC_LIMA (HGETCLOUD,PRHODREF,PRT,PSVT)
-!
-CHARACTER (LEN=4), INTENT(IN) :: HGETCLOUD ! Get indicator
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
-!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PSVT ! microphys. concentrations
-!
-!
-END SUBROUTINE SET_CONC_LIMA
-!
-END INTERFACE
-!
-END MODULE MODI_SET_CONC_LIMA
-!
+module mode_set_conc_lima
+!#######################################
+
+implicit none
+
+contains
+
! ###########################################################################
- SUBROUTINE SET_CONC_LIMA (HGETCLOUD,PRHODREF,PRT,PSVT)
+ SUBROUTINE SET_CONC_LIMA( kmi, HGETCLOUD, PRHODREF, PRT, PSVT )
! ###########################################################################
!
!!**** *SET_CONC_LIMA * - initialize droplet, raindrop and ice
@@ -79,7 +65,9 @@ END MODULE MODI_SET_CONC_LIMA
!! Original 15/11/00
!! 2014 G.Delautier : remplace MODD_RAIN_C2R2_PARAM par MODD_RAIN_C2R2_KHKO_PARAM *
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! B. Vié 03/03/2020: secure physical tests
+! P. Wautelet 04/06/2020: correct array start for microphys. concentrations + add kmi dummy argument
+! (this subroutine is also called for other models)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -87,21 +75,24 @@ END MODULE MODI_SET_CONC_LIMA
!
USE MODD_PARAM_LIMA, ONLY : XRTMIN, XCTMIN, LCOLD, LWARM, LRAIN, NMOD_CCN, NMOD_IFN
USE MODD_PARAM_LIMA_COLD, ONLY : XAI, XBI
-USE MODD_NSV, ONLY : NSV_LIMA_NC, NSV_LIMA_NR, NSV_LIMA_CCN_ACTI, NSV_LIMA_NI, NSV_LIMA_IFN_NUCL
+USE MODD_NSV, ONLY : NSV_LIMA_BEG_A, NSV_LIMA_NC_A, NSV_LIMA_NR_A, NSV_LIMA_CCN_ACTI_A, &
+ NSV_LIMA_NI_A, NSV_LIMA_IFN_NUCL_A
USE MODD_CST, ONLY : XPI, XRHOLW, XRHOLI
USE MODD_CONF, ONLY : NVERB
+USE MODD_CONF_n, ONLY : NRR
USE MODD_LUNIT_n, ONLY : TLUOUT
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
+integer, intent(in) :: kmi ! Model number
CHARACTER (LEN=4), INTENT(IN) :: HGETCLOUD ! Get indicator
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! Reference density
!
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! microphysical mixing ratios
!
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT):: PSVT ! microphys. concentrations
+REAL, DIMENSION(:,:,:,NSV_LIMA_BEG_A(kmi):), INTENT(INOUT):: PSVT ! microphys. concentrations
!
!
!* 0.2 Declarations of local variables :
@@ -119,25 +110,25 @@ ILUOUT = TLUOUT%NLU
!* 2. INITIALIZATION
! --------------
!
-IF (LWARM) THEN
+IF (LWARM .AND. NRR.GE.2) THEN
!
! droplets
!
ZCONCC = 300.E6 ! droplet concentration set at 300 cm-3
WHERE ( PRT(:,:,:,2) > 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_NC) = ZCONCC
+ PSVT(:,:,:,NSV_LIMA_NC_A(kmi)) = ZCONCC
END WHERE
WHERE ( PRT(:,:,:,2) <= 1.E-11 )
PRT(:,:,:,2) = 0.0
- PSVT(:,:,:,NSV_LIMA_NC) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NC_A(kmi)) = 0.0
END WHERE
IF (NMOD_CCN .GE. 1) THEN
WHERE ( PRT(:,:,:,2) > 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_CCN_ACTI) = ZCONCC
+ PSVT(:,:,:,NSV_LIMA_CCN_ACTI_A(kmi)) = ZCONCC
END WHERE
WHERE ( PRT(:,:,:,2) <= 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_CCN_ACTI) = 0.0
+ PSVT(:,:,:,NSV_LIMA_CCN_ACTI_A(kmi)) = 0.0
END WHERE
END IF
@@ -147,21 +138,21 @@ IF (LWARM) THEN
END IF
END IF
!
-IF (LWARM .AND. LRAIN) THEN
+IF (LWARM .AND. LRAIN .AND. NRR.GE.3) THEN
!
! drops
!
ZCONCR = (1.E7)**3/(XPI*XRHOLW) ! cf XCONCR_PARAM_INI in ini_rain_c2r2.f90
IF (HGETCLOUD == 'INI1') THEN ! init from REVE scheme
- PSVT(:,:,:,NSV_LIMA_NR) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = 0.0
ELSE ! init from KESS, ICE3...
WHERE ( PRT(:,:,:,3) > 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_NR) = MAX( SQRT(SQRT(PRHODREF(:,:,:)*PRT(:,:,:,3) &
- *ZCONCR)),XCTMIN(3) )
+ PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = MAX( SQRT(SQRT(PRHODREF(:,:,:)*PRT(:,:,:,3) &
+ *ZCONCR)),1. )
END WHERE
WHERE ( PRT(:,:,:,3) <= 1.E-11 )
PRT(:,:,:,3) = 0.0
- PSVT(:,:,:,NSV_LIMA_NR) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NR_A(kmi)) = 0.0
END WHERE
IF( NVERB >= 5 ) THEN
WRITE (UNIT=ILUOUT,FMT=*) "!INI_MODEL$n: The raindrop concentration has "
@@ -170,30 +161,30 @@ IF (LWARM .AND. LRAIN) THEN
END IF
END IF
!
-IF (LCOLD) THEN
+IF (LCOLD .AND. NRR.GE.4) THEN
!
! ice crystals
!
ZCONCI = 100.E3 ! maximum ice concentration set at 100/L
WHERE ( PRT(:,:,:,4) > 1.E-11 )
!
-! PSVT(:,:,:,NSV_LIMA_NI) = MIN( PRHODREF(:,:,:) / &
+! PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = MIN( PRHODREF(:,:,:) / &
! ( XRHOLI * XAI*(10.E-06)**XBI * PRT(:,:,:,4) ), &
! ZCONCI )
! Correction
- PSVT(:,:,:,NSV_LIMA_NI) = MIN(PRT(:,:,:,4)/(XAI*(10.E-06)**XBI),ZCONCI )
+ PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = MIN(PRT(:,:,:,4)/(0.82*(10.E-06)**2.5),ZCONCI )
END WHERE
WHERE ( PRT(:,:,:,4) <= 1.E-11 )
PRT(:,:,:,4) = 0.0
- PSVT(:,:,:,NSV_LIMA_NI) = 0.0
+ PSVT(:,:,:,NSV_LIMA_NI_A(kmi)) = 0.0
END WHERE
IF (NMOD_IFN .GE. 1) THEN
WHERE ( PRT(:,:,:,4) > 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_IFN_NUCL) = PSVT(:,:,:,NSV_LIMA_NI)
+ PSVT(:,:,:,NSV_LIMA_IFN_NUCL_A(kmi)) = PSVT(:,:,:,NSV_LIMA_NI_A(kmi))
END WHERE
WHERE ( PRT(:,:,:,4) <= 1.E-11 )
- PSVT(:,:,:,NSV_LIMA_IFN_NUCL) = 0.0
+ PSVT(:,:,:,NSV_LIMA_IFN_NUCL_A(kmi)) = 0.0
END WHERE
END IF
@@ -205,3 +196,5 @@ IF (LCOLD) THEN
END IF
!
END SUBROUTINE SET_CONC_LIMA
+
+end module mode_set_conc_lima
diff --git a/src/MNH/set_cstn.f90 b/src/MNH/set_cstn.f90
index 986526c82b5fd2812e3c20c9d54300592149a19e..31f00cb4dda81f39600edc8f0560ac6b91e7ed37 100644
--- a/src/MNH/set_cstn.f90
+++ b/src/MNH/set_cstn.f90
@@ -170,6 +170,7 @@ END MODULE MODI_SET_CSTN
!
USE MODD_CONF
USE MODD_CST
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
@@ -393,8 +394,12 @@ END DO
!* 4.3 Compute Mixing ratio
!
! determines the pressure under the ground
-ZEXNGRDM= ( ZPGROUND / XP00) ** ZRDSCPD &
- - XG/XCPD / (0.5*(ZTHV(1)+ZTHVM(1))) * (ZZMASS_PROFILE(1) - ZHEIGHT(1))
+IF (LOCEAN) THEN
+ ZEXNGRDM= ( ZPGROUND / XP00) ** ZRDSCPD
+ELSE
+ ZEXNGRDM= ( ZPGROUND / XP00) ** ZRDSCPD &
+ - XG/XCPD / (0.5*(ZTHV(1)+ZTHVM(1))) * (ZZMASS_PROFILE(1) - ZHEIGHT(1))
+END IF
ZPGRDM = XP00 * ZEXNGRDM ** (1./ZRDSCPD)
ZPM(:) = PRESS_HEIGHT(ZZMASS_PROFILE(:),ZTHVM,ZPGRDM,ZTHVM(1),ZZMASS_PROFILE(1)) ! compute P
ZTVM(:) = ZTHVM(:) * (ZPM(:) / XP00) ** ZRDSCPD ! compute Tv
diff --git a/src/MNH/set_frc.f90 b/src/MNH/set_frc.f90
index 8744c8d9d884afd7e4e7e38e61bd747b0b9d37a1..6c49fbbf288028ccd6c579aeddf88cc7988c05d8 100644
--- a/src/MNH/set_frc.f90
+++ b/src/MNH/set_frc.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -224,10 +224,10 @@ DO JKT = 1,NFRC
WRITE(UNIT=ILUOUT,FMT='(A, I4)') "SET_FRC: start reading forcing field ", JKT
!
IF( YZP=='ZFRC' ) THEN
- READ(ILUPRE,*) TDTFRC(JKT)%TDATE%YEAR, &
- TDTFRC(JKT)%TDATE%MONTH, &
- TDTFRC(JKT)%TDATE%DAY, &
- TDTFRC(JKT)%TIME
+ READ(ILUPRE,*) TDTFRC(JKT)%nyear, &
+ TDTFRC(JKT)%nmonth, &
+ TDTFRC(JKT)%nday, &
+ TDTFRC(JKT)%xtime
READ(ILUPRE,*) ZZGROUNDF ! data at ground level
READ(ILUPRE,*) ZPGROUNDF
READ(ILUPRE,*) ZTHDGROUNDF
@@ -267,10 +267,10 @@ DO JKT = 1,NFRC
END IF
!
IF( YZP=='PFRC' ) THEN
- READ(ILUPRE,*) TDTFRC(JKT)%TDATE%YEAR, &
- TDTFRC(JKT)%TDATE%MONTH, &
- TDTFRC(JKT)%TDATE%DAY, &
- TDTFRC(JKT)%TIME
+ READ(ILUPRE,*) TDTFRC(JKT)%nyear, &
+ TDTFRC(JKT)%nmonth, &
+ TDTFRC(JKT)%nday, &
+ TDTFRC(JKT)%xtime
!
READ(ILUPRE,*) ZZGROUNDF ! data at ground level
READ(ILUPRE,*) ZPGROUNDF
@@ -453,15 +453,15 @@ DO JKT = 2,NFRC-1
WRITE(ILUOUT,*) &
" soundings have to be entered in increasing temporal order"
WRITE(ILUOUT,*) "SOUNDING TIME ", JKT-1, " IS: "
- WRITE(ILUOUT,*) TDTFRC(JKT-1)%TDATE%YEAR, &
- TDTFRC(JKT-1)%TDATE%MONTH, &
- TDTFRC(JKT-1)%TDATE%DAY, &
- TDTFRC(JKT-1)%TIME
+ WRITE(ILUOUT,*) TDTFRC(JKT-1)%nyear, &
+ TDTFRC(JKT-1)%nmonth, &
+ TDTFRC(JKT-1)%nday, &
+ TDTFRC(JKT-1)%xtime
WRITE(ILUOUT,*) "SOUNDING TIME ", JKT, " IS: "
- WRITE(ILUOUT,*) TDTFRC(JKT)%TDATE%YEAR, &
- TDTFRC(JKT)%TDATE%MONTH, &
- TDTFRC(JKT)%TDATE%DAY, &
- TDTFRC(JKT)%TIME
+ WRITE(ILUOUT,*) TDTFRC(JKT)%nyear, &
+ TDTFRC(JKT)%nmonth, &
+ TDTFRC(JKT)%nday, &
+ TDTFRC(JKT)%xtime
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_FRC','')
END IF
@@ -524,10 +524,10 @@ END DO
WRITE(UNIT=ILUOUT,FMT='(" THERE ARE ",I2," FORCING SOUNDINGS AT:")') NFRC
DO JL = 1 , NFRC
WRITE(UNIT=ILUOUT,FMT='(F9.0, "s, date:", I3, "/", I3, "/", I5)') &
- TDTFRC(JL)%TIME, &
- TDTFRC(JL)%TDATE%DAY, &
- TDTFRC(JL)%TDATE%MONTH, &
- TDTFRC(JL)%TDATE%YEAR
+ TDTFRC(JL)%xtime, &
+ TDTFRC(JL)%nday, &
+ TDTFRC(JL)%nmonth, &
+ TDTFRC(JL)%nyear
END DO
!
IF (NVERB >= 10) THEN
diff --git a/src/MNH/set_grid.f90 b/src/MNH/set_grid.f90
index 9d8c9557115a4d595b5a787dd112f2d9292ec3c3..80b75a18778e0127d1c9792f21fc9e387e76c193 100644
--- a/src/MNH/set_grid.f90
+++ b/src/MNH/set_grid.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -211,10 +211,10 @@ END MODULE MODI_SET_GRID
!
!* 0. DECLARATIONS
! ------------
-USE MODD_BUDGET
USE MODD_CONF
USE MODD_CONF_n
USE MODD_DYN
+use modd_field, only: tfielddata, tfieldlist
USE MODD_GRID
USE MODD_IO, ONLY: TFILEDATA,TOUTBAK
USE MODD_LUNIT_n, ONLY: TLUOUT
@@ -222,7 +222,7 @@ USE MODD_OUT_n, ONLY: OUT_MODEL
USE MODD_PARAMETERS
USE MODD_NESTING
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TFIELDLIST, FIND_FIELD_ID_FROM_MNHNAME
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_GATHER_ll
USE MODE_GRIDCART
USE MODE_GRIDPROJ
diff --git a/src/MNH/set_mask.f90 b/src/MNH/set_mask.f90
index 81f58e13afcc26460d31991a4ea4bfdd77005bbc..36300b07e7020d88a8a605c4812d5416d1ad93f9 100644
--- a/src/MNH/set_mask.f90
+++ b/src/MNH/set_mask.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: /home/cvsroot/MNH-VX-Y-Z/src/MNH/set_mask.f90,v $ $Revision: 1.2.2.1.2.1.18.2 $
-! MASDEV4_7 budget 2006/09/08 10:35:15
-!-----------------------------------------------------------------
! ###################
SUBROUTINE SET_MASK
! ###################
@@ -26,7 +21,7 @@
!! According to each criterion associated to one zone, the mask is
!! set to TRUE at each point where the criterion is confirmed, at each
!! time step of the model. Finally, The number of occurence of this criteria is
-!! increased by 1 and stored in the array XBUSURF.
+!! increased by 1 and stored in the array NBUSURF.
!! Caution : The mask is defined on the inner domain.
!!
!!
@@ -39,7 +34,7 @@
!! Module MODD_BUDGET
!! LBU_MASK : logical array mask defining the zones
!! NBUTIME : number of the budget step
-!! XBUSURF : mask tracer array (surface array)
+!! NBUSURF : mask tracer array (surface array)
!!
!! REFERENCE
!! ---------
@@ -106,7 +101,7 @@ IF (NBUMASK>=2) &
! -------------------------
!
WHERE (LBU_MASK(:,:,:))
- XBUSURF(:,:,:,NBUTIME)=XBUSURF(:,:,:,NBUTIME)+1.
+ NBUSURF(:,:,:,NBUTIME) = NBUSURF(:,:,:,NBUTIME) + 1
END WHERE
!
!-------------------------------------------------------------------------------
diff --git a/src/MNH/set_mass.f90 b/src/MNH/set_mass.f90
index a7b266aaa997e476fbc3fa3d32a820b47f56efbe..b3402a0e3cd0ece6682058f04aa386e84f37686a 100644
--- a/src/MNH/set_mass.f90
+++ b/src/MNH/set_mass.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.
@@ -121,6 +121,7 @@ SUBROUTINE SET_MASS(TPFILE,OPROFILE_IN_PROC, PZFLUX_PROFILE,
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! J-L Redelsperger 06/2021: Ocean case
!
!-------------------------------------------------------------------------------
!!
@@ -135,6 +136,7 @@ USE MODD_CST
USE MODD_REF
USE MODD_PARAMETERS
USE MODD_DIM_n
+USE MODD_DYN_n, ONLY : LOCEAN
!
USE MODE_GATHER_ll
USE MODE_ll
@@ -147,6 +149,8 @@ USE MODI_VER_INT_DYN
USE MODI_SHUMAN
USE MODI_COMPUTE_EXNER_FROM_GROUND
USE MODI_COMPUTE_EXNER_FROM_TOP
+USE MODI_COMPUTE_PRESS_FROM_OCEANSFC
+USE MODI_COMPUTE_PRESS_FROM_OCEANBOT
USE MODI_SET_GEOSBAL
USE MODE_REPRO_SUM
USE MODE_MPPDB
@@ -191,7 +195,10 @@ REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZPMHP_MX ! pressu
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZRHOD_MX ! local rhod (mass level)
REAL,DIMENSION(SIZE(XZHAT)) :: ZRHOD_PROFILE ! local rhod (mass level) at initialization profile column
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZPMASS_MX ! pressure (mass level)
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZPFLUX_MX ! pressure (mass level)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) :: ZEXNSURF2D_MX ! local Exner function at ground
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) :: ZPRESS2D_MX ! local pressure at ground
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) :: ZPRESSFC ! pressure at ocean sfc (ocen model case)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZHEXNFLUX_MX ! local hyd. Exner function at flux points on the mixed grid
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZHEXNMASS_MX ! local hyd. Exner function at mass points on the mixed grid
!
@@ -224,6 +231,8 @@ REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZRHODJU ! horiz
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZRHODJV ! the MESONH Arakawa C grid
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZHEXNFLUX ! local hyd. Exner function at flux points (MNH grid)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZHEXNMASS ! local hyd. Exner function at mass points (MNH grid)
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZPMASS ! local hyd. pres at mass points (MNH grid)
+REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZPFLUX ! local hyd. pres at flux points (MNH grid)
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) :: ZRHOD ! dry density on MESO-NH grid
!
!!$INTEGER :: IIBP,IIEP,IJBP,IJEP
@@ -279,17 +288,35 @@ ENDIF
!------------------------------
!* 2.2 compute exner function on mixed grid
!
-ZEXNSURF2D_MX(:,:)=(PPGROUND/XP00)**(XRD/XCPD)
-CALL COMPUTE_EXNER_FROM_GROUND(ZTHV3D_MX,PZFLUX_MX,&
- ZEXNSURF2D_MX,ZHEXNFLUX_MX,ZHEXNMASS_MX)
-ZEXNTOP2D(:,:)=ZHEXNFLUX_MX(:,:,IKE+1)
-ZPMASS_MX(:,:,:)=XP00*(ZHEXNMASS_MX(:,:,:))**(XCPD/XRD)
-ZRHOD_MX(:,:,:)=ZPMASS_MX(:,:,:)/(ZPMASS_MX(:,:,:)/XP00)**(XRD/XCPD) &
+ZEXNSURF2D_MX(:,:)=(PPGROUND/XP00)**(XRD/XCPD)
+!
+IF (LOCEAN) THEN
+ ZTHVREF3D(:,:,:) = ZTHV3D_MX(:,:,:)
+ ZRHOD_MX(:,:,:)= XRH00OCEAN*(1.-XALPHAOC*(ZTHV3D_MX(:,:,:)-XTH00OCEAN) &
+ +XBETAOC *(ZMR3D_MX(:,:,:,1)-XSA00OCEAN))
+ ZPRESS2D_MX(:,:)=PPGROUND
+ CALL COMPUTE_PRESS_FROM_OCEANBOT(ZRHOD_MX,PZFLUX_MX,ZPRESS2D_MX,ZPFLUX_MX,ZPMASS_MX)
+ ZHEXNFLUX_MX(:,:,:)=(ZPFLUX_MX(:,:,:)/XP00)**(XRD/XCPD)
+ ZHEXNMASS_MX(:,:,:)=(ZPMASS_MX(:,:,:)/XP00)**(XRD/XCPD)
+ ZEXNTOP2D(:,:)=ZHEXNFLUX_MX(:,:,IKE+1)
+ELSE
+ CALL COMPUTE_EXNER_FROM_GROUND(ZTHV3D_MX,PZFLUX_MX,&
+ ZEXNSURF2D_MX,ZHEXNFLUX_MX,ZHEXNMASS_MX)
+ ZEXNTOP2D(:,:)=ZHEXNFLUX_MX(:,:,IKE+1)
+ ZPMASS_MX(:,:,:)=XP00*(ZHEXNMASS_MX(:,:,:))**(XCPD/XRD)
+ENDIF
+!
+IF (LOCEAN) THEN
+ IF (LCOUPLES) THEN
+ XEXNTOPO=SUM_DD_R2_ll(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
+ ELSE
+ XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
+ END IF
+ELSE
+ ZRHOD_MX(:,:,:)=ZPMASS_MX(:,:,:)/(ZPMASS_MX(:,:,:)/XP00)**(XRD/XCPD) &
/(XRD*ZTHV3D_MX(:,:,:)*(1.+WATER_SUM(ZMR3D_MX(:,:,:,:))))
-
-XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
-
-
+ XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX_MX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
+END IF
!------------------------------
!* 2.3 Rotate wind in model axis and take into account variations in x,y
! directions on the mixed grid
@@ -445,15 +472,17 @@ DEALLOCATE(ZNFLYZ_TOT,ZNFLYZ_TOT_ll)
!
IF (PRESENT(PCORIOZ)) THEN
+!To be modified later for ocean model case
CALL SET_GEOSBAL(ZUW3D_FL,ZVW3D_FL,PTHVM,PMRM, &
KILOC,KJLOC,OBOUSS,ZTHV3D,PCORIOZ)
CALL COMPUTE_EXNER_FROM_TOP(ZTHV3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
XPABSM(:,:,:)=XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
ELSE
-!
-! Interpolation of theta and r
!
- IF (SIZE(ZTHV3D_MX,3) > 3) THEN
+!No interpolation for ocean case (no bathimetry)
+! Interpolation of theta and r in atmos case
+!
+ IF (SIZE(ZTHV3D_MX,3) > 3) THEN
CALL VER_INT_THERMO(TPFILE,OSHIFT,ZTHV3D_MX,ZMR3D_MX,PZS_MX,PZS_MX,PZMASS_MX,&
PZFLUX_MX,ZPMHP_MX,ZEXNTOP2D, &
ZTHV3D,XRT,ZPMHP,ZDIAG)
@@ -462,7 +491,11 @@ ELSE
XRT = ZMR3D_MX
ZDIAG = 0.
END IF
- XTHT(:,:,:)=ZTHV3D(:,:,:)*(1.+WATER_SUM(XRT(:,:,:,:)))/(1.+XRV/XRD*XRT(:,:,:,1))
+ IF (LOCEAN) THEN
+ XTHT(:,:,:)=ZTHV3D(:,:,:)
+ ELSE
+ XTHT(:,:,:)=ZTHV3D(:,:,:)*(1.+WATER_SUM(XRT(:,:,:,:)))/(1.+XRV/XRD*XRT(:,:,:,1))
+ ENDIF
ZTHV3D(:,:,1)=ZTHV3D(:,:,2)
XTHT(:,:,1)=XTHT(:,:,2)
XRT(:,:,1,:)=XRT(:,:,2,:)
@@ -472,7 +505,6 @@ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTHV3D, 'SET_MASS::ZTHV3D' )
CALL ADD3DFIELD_ll( TZFIELDS_ll, XRT(:,:,1,:), 'SET_MASS::XRT(:,:,1,:)' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
-
!
IF (NRR>=3) THEN
WHERE (XRT(:,:,:,3)<1.E-20)
@@ -489,17 +521,19 @@ CALL CLEANLIST_ll(TZFIELDS_ll)
CALL VER_INT_DYN(OSHIFT,ZRHODU_MX,ZRHODV_MX,PZFLUX_MX,PZMASS_MX,PZS_MX,ZRHODUA,ZRHODVA)
ZRHODJU(:,:,:)=MXM(ZRHODUA(:,:,:)*PJ(:,:,:))
ZRHODJV(:,:,:)=MYM(ZRHODVA(:,:,:)*PJ(:,:,:))
- CALL COMPUTE_EXNER_FROM_TOP(ZTHV3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
- XPABST(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
- ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
- /(XRD*XTHT(:,:,:)*(1.+XRV/XRD*XRT(:,:,:,1)))
+ IF (.NOT.LOCEAN) THEN
+ CALL COMPUTE_EXNER_FROM_TOP(ZTHV3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
+ XPABST(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
+ ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) /(XRD*XTHT(:,:,:)*(1.+XRV/XRD*XRT(:,:,:,1)))
+ ELSE
+ ZRHOD(:,:,:)=XRH00OCEAN*(1.-XALPHAOC*(XTHT(:,:,:)-XTH00OCEAN)+XBETAOC*(XRT(:,:,:,1)-XSA00OCEAN))
+ END IF
XUT(:,:,:)=ZRHODJU(:,:,:)/MXM(ZRHOD(:,:,:)*PJ(:,:,:))
XVT(:,:,:)=ZRHODJV(:,:,:)/MYM(ZRHOD(:,:,:)*PJ(:,:,:))
XWT(:,:,:)=0
CALL MPPDB_CHECK3DM("SET_MASS:XVT,ZRHODJV,PJ,ZRHODVA",PRECISION,&
& XVT,ZRHODJV,PJ,ZRHODVA )
ENDIF
-
!
!-------------------------------------------------------------------------------
!* 4. COMPUTE ANELASTIC REFERENCE (PV)
@@ -518,17 +552,35 @@ ELSE
DO JK = 1,IKU
CALL REDUCESUM_ll(XTHVREFZ(JK), IINFO_ll)
END DO
-
- XRHODREFZ(:) = XP00/ (XRD* XTHVREFZ(:))
- ZTHVREF3D(:,:,:)=XTHVREFZ(2)
- CALL COMPUTE_EXNER_FROM_GROUND(ZTHVREF3D,PZFLUX_MX,&
+!
+ IF (LOCEAN) THEN
+! Ocean case boussinesq
+ IF (LCOUPLES) THEN
+ XRHODREFZO(:) = XRH00OCEAN
+ XTHVREFZ(:) = ZTHV3D(KILOC,KJLOC,IKU-3) ! XTHVREFZ is uniform
+ ZTHVREF3D(:,:,:)=XTHVREFZ(IKU-3)
+ ZPRESSFC(:,:)=XP00*XEXNTOPO**(XCPD/XRD)
+ ELSE
+ XRHODREFZ(:) = XRH00OCEAN
+ ZPRESSFC(:,:)=XP00*XEXNTOP**(XCPD/XRD)
+! on prend pour le moment la valeur de la couche mélangée
+ END IF
+ CALL COMPUTE_PRESS_FROM_OCEANSFC(ZRHOD,XZZ,ZPRESSFC,ZPFLUX,ZPMASS)
+ XPABST(:,:,:)= ZPMASS(:,:,:)
+!
+ ELSE
+! ATmos: rho = P/ (R Tv)
+ XRHODREFZ(:) = XP00/ (XRD* XTHVREFZ(:))
+ ZTHVREF3D(:,:,:)=XTHVREFZ(2)
+ CALL COMPUTE_EXNER_FROM_GROUND(ZTHVREF3D,PZFLUX_MX,&
ZEXNSURF2D_MX,ZHEXNFLUX,ZHEXNMASS)
- XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
-
- ZEXNTOP2D=ZHEXNFLUX(:,:,IKE+1)
- CALL COMPUTE_EXNER_FROM_TOP(ZTHVREF3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
- XPABST(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
+ XEXNTOP=SUM_DD_R2_ll(ZHEXNFLUX(IIB:IIE,IJB:IJE,IKE+1))/REAL(NIMAX_ll*NJMAX_ll)
+ ZEXNTOP2D=ZHEXNFLUX(:,:,IKE+1)
+ CALL COMPUTE_EXNER_FROM_TOP(ZTHVREF3D,XZZ,ZEXNTOP2D,ZHEXNFLUX,ZHEXNMASS)
+ XPABST(:,:,:)=ZPMHP(:,:,:) + XP00*ZHEXNMASS(:,:,:) ** (XCPD/XRD)
+ENDIF
+ ! end of bouss case
ENDIF
!---------------------------------------------------------------------------------
END SUBROUTINE SET_MASS
diff --git a/src/MNH/set_msk.f90 b/src/MNH/set_msk.f90
index 6f381239ccc7507b9227baa63d0f01e5a831d6f2..0e6a7d353c3edafd3f222c92bdeef28e8cb21d0c 100644
--- a/src/MNH/set_msk.f90
+++ b/src/MNH/set_msk.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-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 for details. version 1.
@@ -38,9 +38,8 @@ END MODULE MODI_SET_MSK
!! ------
!! According to each criterion associated to one zone, the mask is
!! set to TRUE at each point where the criterion is confirmed, at each
-!! time step of the model. Finally, The number of occurence of this criteria is
-!! increased by 1 and stored in the array XBUSURF.
-!!
+!! time step of the model.
+!!
!!
!! EXTERNAL
!! --------
@@ -48,8 +47,6 @@ END MODULE MODI_SET_MSK
!!
!! IMPLICIT ARGUMENTS
!! ------------------
-!! Module MODD_BUDGET
-!! XBUSURF : mask tracer array (surface array)
!!
!! REFERENCE
!! ---------
@@ -74,7 +71,6 @@ END MODULE MODI_SET_MSK
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
USE MODD_FIELD_n
USE MODD_RAIN_ICE_PARAM , ONLY : XFSEDR,XEXSEDR
USE MODD_RAIN_ICE_DESCR , ONLY : XCEXVT
diff --git a/src/MNH/set_perturb.f90 b/src/MNH/set_perturb.f90
index 1f88a63cfff307d1dd499afd5f73d1d7d1f51d9e..42e384c2a602a5eff3e16415e897edff93ae7922 100644
--- a/src/MNH/set_perturb.f90
+++ b/src/MNH/set_perturb.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -98,7 +98,8 @@ END MODULE MODI_SET_PERTURB
!! C.Lac, V.Masson 1/2018 : White noise in the LBC
!! Q.Rodier 10/2018 : move allocate(ZWHITE) for NKWH>2
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
-!
+!! J.L Redelsperger 03/2021 : : white noise in Ocean LES case at the top of domain(Sfc)
+!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -106,6 +107,7 @@ END MODULE MODI_SET_PERTURB
!
USE MODD_CST
USE MODD_CONF
+USE MODD_DYN_n, ONLY : LOCEAN
USE MODD_DIM_n
USE MODD_FIELD_n
USE MODD_GRID_n
@@ -115,6 +117,7 @@ USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_LSFIELD_n
USE MODD_PARAMETERS
USE MODD_REF_n
+USE MODD_REF
USE MODD_VAR_ll , ONLY : NMNH_COMM_WORLD
!
USE MODE_GATHER_ll
@@ -196,6 +199,7 @@ INTEGER, DIMENSION(:), ALLOCATABLE :: i_seed
INTEGER :: ni_seed
!
INTEGER :: IXOR,IYOR,JI_ll,JJ_ll
+INTEGER :: INOISB,INOISE ! Loop indice for White noise
!
NAMELIST/NAM_PERT_PRE/CPERT_KIND,XAMPLITH, &! Perturbation parameters
XAMPLIRV,XCENTERZ,XRADX, &!
@@ -249,6 +253,13 @@ IJE_ll=IJU_ll-JPHEXT
!
CALL GET_OR_ll('B',IXOR,IYOR)
!
+IF (LOCEAN) THEN
+ INOISB=NKWH
+ INOISE=IKE
+ELSE
+ INOISB=IKB
+ INOISE=NKWH
+ENDIF
!-------------------------------------------------------------------------------
!
!* 2. COMPUTE THE PERTURBATION ON THETA :
@@ -375,8 +386,7 @@ SELECT CASE(CPERT_KIND)
! J.Escobar optim => need only identical random on all domain
!
ALLOCATE(ZWHITE(IIU,IJU))
-!
- DO JK = IKB, NKWH
+ DO JK = INOISB,INOISE
IKX = (NIMAX_ll+1)/2
ZX = 2*XPI/NIMAX_ll
ALLOCATE(ZCX_ll(IIU_ll,IKX))
diff --git a/src/MNH/set_ref.f90 b/src/MNH/set_ref.f90
index 925fd52efdf6c0189af56d44e594453beaf3bd85..3fbd530b720dad8acead062a8a9854cfbc3950a0 100644
--- a/src/MNH/set_ref.f90
+++ b/src/MNH/set_ref.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -150,14 +150,16 @@ END MODULE MODI_SET_REF
!! PRHODREF, PEXNREF, PTHVREF after computation
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! Jean-Luc Redelsperger 03/2021 : OCEAN LES case
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
USE MODD_CONF
USE MODD_CST
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
USE MODD_REF
!
@@ -210,6 +212,7 @@ REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZRHOREF
! Reference density
REAL, DIMENSION(SIZE(PZZ,3)) :: ZZHATM ! height of the mass levels
! in the transformed space (GCS transf.) or without orography
+REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) :: ZDENSOC,ZPFLUX,ZPMASS
!
INTEGER :: IIU ! Upper dimension in x direction
INTEGER :: IJU ! Upper dimension in y direction
@@ -263,7 +266,12 @@ IF (KMI == 1) THEN
LNEUTRAL=.FALSE.
IF (MAXVAL(XTHVREFZ(IKB:IKE))-MINVAL(XTHVREFZ(IKB:IKE)) < 1.E-10) LNEUTRAL=.TRUE.
END IF
-!
+!* Ref state diff for O & A in LES coupled mode
+IF (LCOUPLES .AND. LOCEAN) THEN
+ CALL IO_Field_read(TPINIFILE,'RHOREFZ',XRHODREFZO)
+ CALL IO_Field_read(TPINIFILE,'THVREFZ',XTHVREFZO)
+ CALL IO_Field_read(TPINIFILE,'EXNTOP', XEXNTOPO)
+END IF
!-------------------------------------------------------------------------------
!
!* 3. SET REFERENCE STATE WITH OROGRAPHY
@@ -285,7 +293,13 @@ CALL MPPDB_CHECK3D(ZZM,"SET_REF::ZZM",PRECISION)
!
!* 3.2 Interpolation
!
-DO JI = 1,SIZE(PZZ,1)
+IF (LCOUPLES .AND. LOCEAN) THEN
+ DO JK = 1,IKU
+ PTHVREF(:,:,JK) = XTHVREFZO(JK)
+ PRHODREF(:,:,JK)= XRHODREFZO(JK)
+ END DO
+ELSE
+ DO JI = 1,SIZE(PZZ,1)
DO JJ = 1,SIZE(PZZ,2)
!
DO JK = 1,IKU
@@ -316,22 +330,21 @@ DO JI = 1,SIZE(PZZ,1)
END IF
END DO
END DO
-END DO
+ END DO
+END IF
!
! change the extrapolation option for the thvref field to be consistent with
! the extrapolation option for the flottability at the ground and for rhodref
! to be consistent with the extrapolation to compute a divergence
PTHVREF(:,:,IKB-1) = PTHVREF(:,:,IKB)
PRHODREF(:,:,IKB-1) = PRHODREF(:,:,IKB)
-
CALL MPPDB_CHECK3D(PTHVREF,"SET_REF::PTHVREF",PRECISION)
CALL MPPDB_CHECK3D(PRHODREF,"SET_REF::PRHODREF",PRECISION)
!
!-------------------------------------------------------------------------------
!
-!* 4. COMPUTE EXNER FUNCTION
-! ----------------------
-!
+!* 4. COMPUTE EXNER FUNCTION AT MASS GRID POINT
+! ----------------------------------------
IF (LCARTESIAN .OR. LTHINSHELL) THEN
ZD1=0.
ELSE
@@ -340,24 +353,56 @@ ENDIF
!
ZGSCPD = XG/XCPD
!
-PEXNREF(:,:,IKE)=(XEXNTOP*(1.+ZD1*2./7.*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE))/ &
- (XRADIUS+(PZZ(:,:,IKE+1)+ZZM(:,:,IKE))/2.)) &
- + ZGSCPD/PTHVREF(:,:,IKE)*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE)))/ &
-(1.-ZD1*2./7.*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE))/(XRADIUS+(PZZ(:,:,IKE+1)+ZZM(:,:,IKE))/2.))
+IF (LOCEAN) THEN
+!--------------------------------
+! Pressure at domain top (Flux point !!!) saved in Press_mass above the ocen sfc
+ IF (LCOUPLES) THEN
+ ZPMASS(:,:,IKE+1)= XP00 *XEXNTOPO**(XCPD/XRD)
+ ELSE
+ ZPMASS(:,:,IKE+1)= XP00 *XEXNTOP**(XCPD/XRD)
+ ENDIF
+ ZPMASS(:,:,IKE) = ZPMASS(:,:,IKE+1) +XG*PRHODREF(:,:,IKE)*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE))
+ DO JK = IKE-1,1,-1
+ ZPMASS(:,:,JK) = ZPMASS(:,:,JK+1) + XG * &
+ .5*(PRHODREF(:,:,JK)+ PRHODREF(:,:,JK+1)) * (ZZM(:,:,JK+1) -ZZM(:,:,JK))
+ END DO
+!
+ IF (LCOUPLES) THEN
+ DO JK = IKE+1, IKU
+! Pressure above domain top (i.e. ocean sfc), i.e. in atmosphere (should be not used)
+ ZPMASS(:,:,JK) = XP00 *XEXNTOPO**(XCPD/XRD)
+ END DO
+ ELSE
+ DO JK = IKE+1, IKU
+! Pressure above domain top (i.e. ocean sfc), i.e. in atmosphere (should be not used)
+ ZPMASS(:,:,JK) = XP00 *XEXNTOP**(XCPD/XRD)
+ END DO
+ ENDIF
+ PEXNREF(:,:,:)= (ZPMASS(:,:,:)/XP00)**(XRD/XCPD)
+ ! OCEAN end
+ELSE
+ ! ATMOSPHERE
+ PEXNREF(:,:,IKE)=(XEXNTOP*(1.+ZD1*2./7.*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE))/ &
+ (XRADIUS+(PZZ(:,:,IKE+1)+ZZM(:,:,IKE))/2.)) &
+ + ZGSCPD/PTHVREF(:,:,IKE)*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE)))/ &
+ (1.-ZD1*2./7.*(PZZ(:,:,IKE+1)-ZZM(:,:,IKE))/(XRADIUS+(PZZ(:,:,IKE+1)+ZZM(:,:,IKE))/2.))
+!
+ DO JK = IKE-1, 1, -1
+ PEXNREF(:,:,JK)=(PEXNREF(:,:,JK+1)*(1.+ZD1*2./7.*(ZZM(:,:,JK+1) -ZZM(:,:,JK))/ &
+ (XRADIUS+PZZ(:,:,JK+1)))+ &
+ 2.*ZGSCPD/(PTHVREF(:,:,JK+1)+PTHVREF(:,:,JK))*(ZZM(:,:,JK+1) -ZZM(:,:,JK)))/&
+ (1.-ZD1*2./7.*(ZZM(:,:,JK+1) -ZZM(:,:,JK))/(XRADIUS+PZZ(:,:,JK+1)))
+ END DO
+!
+ DO JK = IKE+1, IKU
+ PEXNREF(:,:,JK)=(PEXNREF(:,:,JK-1)*(1.+ZD1*2./7.*(ZZM(:,:,JK-1) -ZZM(:,:,JK))/ &
+ (XRADIUS+PZZ(:,:,JK)))+ &
+ 2.*ZGSCPD/(PTHVREF(:,:,JK-1)+PTHVREF(:,:,JK))*(ZZM(:,:,JK-1) -ZZM(:,:,JK)))/&
+ (1.-ZD1*2./7.*(ZZM(:,:,JK-1) -ZZM(:,:,JK))/ (XRADIUS+PZZ(:,:,JK)))
+ END DO
!
-DO JK = IKE-1, 1, -1
- PEXNREF(:,:,JK)=(PEXNREF(:,:,JK+1)*(1.+ZD1*2./7.*(ZZM(:,:,JK+1) -ZZM(:,:,JK))/ &
- (XRADIUS+PZZ(:,:,JK+1)))+ &
- 2.*ZGSCPD/(PTHVREF(:,:,JK+1)+PTHVREF(:,:,JK))*(ZZM(:,:,JK+1) -ZZM(:,:,JK)))/&
- (1.-ZD1*2./7.*(ZZM(:,:,JK+1) -ZZM(:,:,JK))/(XRADIUS+PZZ(:,:,JK+1)))
-END DO
+END IF
!
-DO JK = IKE+1, IKU
- PEXNREF(:,:,JK)=(PEXNREF(:,:,JK-1)*(1.+ZD1*2./7.*(ZZM(:,:,JK-1) -ZZM(:,:,JK))/ &
- (XRADIUS+PZZ(:,:,JK)))+ &
- 2.*ZGSCPD/(PTHVREF(:,:,JK-1)+PTHVREF(:,:,JK))*(ZZM(:,:,JK-1) -ZZM(:,:,JK)))/&
- (1.-ZD1*2./7.*(ZZM(:,:,JK-1) -ZZM(:,:,JK))/ (XRADIUS+PZZ(:,:,JK)))
-END DO
!
CALL MPPDB_CHECK3D(PEXNREF,"SET_REF::PEXNREF",PRECISION)
!-------------------------------------------------------------------------------
@@ -372,8 +417,8 @@ IF (LBOUSS) THEN
ELSE
ZRHOREF(:,:,:) = PEXNREF(:,:,:) ** ZCVD_O_RD * XP00 / ( XRD * PTHVREF(:,:,:) )
ZRHOREF(:,:,1)=ZRHOREF(:,:,2) ! this avoids to obtain erroneous values for
+ ! rv at this last point
END IF
- ! rv at this last point
!
IF ( CEQNSYS == 'DUR' ) THEN
IF ( SIZE(PRVREF,1) == 0 ) THEN
@@ -402,8 +447,6 @@ CALL CLEANLIST_ll(TZFIELDS_ll)
CALL MPPDB_CHECK3D(ZRHOREF,"SET_REF::ZRHOREF",PRECISION)
IF ( SIZE(PRVREF,1) /= 0 ) CALL MPPDB_CHECK3D(PRVREF,"SET_REF::PRVREF",PRECISION)
CALL MPPDB_CHECK3D(PRHODJ,"SET_REF::PRHODJ",PRECISION)
-
-
!
!* 6. COMPUTES THE TOTAL MASS OF REFERENCE ATMOSPHERE
! -----------------------------------------------
@@ -480,7 +523,7 @@ IF ( HLBCY(1)=='OPEN' ) THEN
ENDDO
ENDIF
PLINMASS = PLINMASS + SUM_DD_R2_ll(ZLINMASS_S_2D)
-!
+ !
ALLOCATE( ZLINMASS_N_2D(IIB:IIE,IJE+1:IJE+1))
ZLINMASS_N_2D = 0.0
IF (LNORTH_ll(HSPLITTING='B')) THEN
diff --git a/src/MNH/set_relfrc.f90 b/src/MNH/set_relfrc.f90
index 6de7d389ec9698629325142cc2dbecdbd2532563..d53c5ae3696c64ed0033d848869479f61bab9f88 100644
--- a/src/MNH/set_relfrc.f90
+++ b/src/MNH/set_relfrc.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2013-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2013-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -217,10 +217,10 @@ DO JKT = 1,NRELFRC
! Reading the date and the filename of mean state and frc
- READ(ILUPRE,*) TDTRELFRC(JKT)%TDATE%YEAR, &
- TDTRELFRC(JKT)%TDATE%MONTH, &
- TDTRELFRC(JKT)%TDATE%DAY, &
- TDTRELFRC(JKT)%TIME
+ READ(ILUPRE,*) TDTRELFRC(JKT)%nyear, &
+ TDTRELFRC(JKT)%nmonth, &
+ TDTRELFRC(JKT)%nday, &
+ TDTRELFRC(JKT)%xtime
! ; Read filenames
READ(ILUPRE,*) CFNAM_MEANVAR_REL
READ(ILUPRE,*) CFNAM_REL
@@ -341,10 +341,10 @@ END DO ! End of loop in time
WRITE(UNIT=ILUOUT,FMT='(" THERE ARE ",I2," REL FORCING AT:")') NRELFRC
DO JL = 1 , NRELFRC
WRITE(UNIT=ILUOUT,FMT='(F9.0, "s, date:", I3, "/", I3, "/", I5)') &
- TDTRELFRC(JL)%TIME, &
- TDTRELFRC(JL)%TDATE%DAY, &
- TDTRELFRC(JL)%TDATE%MONTH, &
- TDTRELFRC(JL)%TDATE%YEAR
+ TDTRELFRC(JL)%xtime, &
+ TDTRELFRC(JL)%nday, &
+ TDTRELFRC(JL)%nmonth, &
+ TDTRELFRC(JL)%nyear
END DO
!
DO JKT = 2,NRELFRC-1
@@ -354,15 +354,15 @@ DO JKT = 2,NRELFRC-1
WRITE(ILUOUT,*) &
" soundings have to be entered in increasing temporal order"
WRITE(ILUOUT,*) "SOUNDING TIME ", JKT-1, " IS: "
- WRITE(ILUOUT,*) TDTRELFRC(JKT-1)%TDATE%YEAR, &
- TDTRELFRC(JKT-1)%TDATE%MONTH, &
- TDTRELFRC(JKT-1)%TDATE%DAY, &
- TDTRELFRC(JKT-1)%TIME
+ WRITE(ILUOUT,*) TDTRELFRC(JKT-1)%nyear, &
+ TDTRELFRC(JKT-1)%nmonth, &
+ TDTRELFRC(JKT-1)%nday, &
+ TDTRELFRC(JKT-1)%xtime
WRITE(ILUOUT,*) "SOUNDING TIME ", JKT, " IS: "
- WRITE(ILUOUT,*) TDTRELFRC(JKT)%TDATE%YEAR, &
- TDTRELFRC(JKT)%TDATE%MONTH, &
- TDTRELFRC(JKT)%TDATE%DAY, &
- TDTRELFRC(JKT)%TIME
+ WRITE(ILUOUT,*) TDTRELFRC(JKT)%nyear, &
+ TDTRELFRC(JKT)%nmonth, &
+ TDTRELFRC(JKT)%nday, &
+ TDTRELFRC(JKT)%xtime
!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RELFRC','')
END IF
diff --git a/src/MNH/set_rsou.f90 b/src/MNH/set_rsou.f90
index 353c6298bd02baa8db936c4df60565fc4235c013..c0aca150473fb0ad44061c6bf50912678661a0c6 100644
--- a/src/MNH/set_rsou.f90
+++ b/src/MNH/set_rsou.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -102,7 +102,17 @@ END MODULE MODI_SET_RSOU
! (Pressure, U, V) ,
! (Pressure, T, Hu)
!
+! For ocean-LES case the following kind of data is permitted
+!
+! YKIND = 'IDEALOCE' : ZGROUND (Water depth),PGROUND(Sfc Atmos Press),
+! TGROUND (SST), RGROUND (SSS)
+! (Depth , U, V) starting from sfc
+! (Depth, T, S)
+! (Time, LE, H, SW_d,SW_u,LW_d,LW_u,Stress_X,Stress_Y)
!
+! YKIND = 'STANDOCE' : (Depth , Temp, Salinity, U, V) starting from sfc
+! (Time, LE, H, SW_d,SW_u,LW_d,LW_u,Stress_X,Stress_Y)
+!
!!** METHOD
!! ------
!! The radiosounding is first read, then data are converted in order to
@@ -242,6 +252,7 @@ END MODULE MODI_SET_RSOU
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 19/04/2019: removed unused dummy arguments and variables
+! JL Redelsperger 01/2021: Ocean LES cases added
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -250,11 +261,16 @@ END MODULE MODI_SET_RSOU
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_FIELD_n
USE MODD_GRID
USE MODD_GRID_n
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_IO, ONLY: TFILEDATA
+USE MODD_NETCDF
+USE MODD_OCEANH
USE MODD_PARAMETERS, ONLY: JPHEXT
+USE MODD_TYPE_DATE
!
USE MODE_ll
USE MODE_MSG
@@ -269,6 +285,8 @@ USE MODI_THETAVPU_THETAVPM
USE MODI_TH_R_FROM_THL_RT_1D
USE MODI_VERT_COORD
!
+USE NETCDF ! for reading the NR files
+!
IMPLICIT NONE
!
!
@@ -291,10 +309,15 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PJ ! jacobien
!
!* 0.2 Declarations of local variables :
!
-INTEGER :: ILUPRE ! logical unit number
-!
-! variables read in EXPRE file at the RS levels
-!
+INTEGER :: ILUPRE ! logical unit number of the EXPRE return code
+INTEGER :: ILUOUT ! Logical unit number for output-listing
+! local variables for reading sea sfc flux forcing for ocean model
+INTEGER :: IFRCLT
+REAL, DIMENSION(:), ALLOCATABLE :: ZSSUFL_T,ZSSVFL_T,ZSSTFL_T,ZSSOLA_T !
+TYPE (DATE_TIME), DIMENSION(:), ALLOCATABLE :: ZFRCLT ! date/time of sea surface forcings
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! variables read in EXPRE file at the RS/CTD levels
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
CHARACTER(LEN=8) :: YKIND ! Kind of variables in
! EXPRE FILE
INTEGER :: ILEVELU ! number of wind levels
@@ -332,7 +355,7 @@ REAL, DIMENSION(:), ALLOCATABLE :: ZLSOCPEXN
REAL, DIMENSION(SIZE(XZHAT)) :: ZZFLUX_PROFILE ! altitude of flux points on the initialization columns
REAL, DIMENSION(SIZE(XZHAT)) :: ZZMASS_PROFILE ! altitude of mass points on the initialization columns
!
-! fieds on the grid of the model without orography
+! fields on the grid of the model without orography
!
REAL, DIMENSION(SIZE(XZHAT)) :: ZUW,ZVW ! Wind at w model grid levels
REAL, DIMENSION(SIZE(XZHAT)) :: ZMRM ! vapor mixing ratio at mass model
@@ -341,19 +364,22 @@ REAL, DIMENSION(SIZE(XZHAT)) :: ZMRCM,ZMRIM
REAL, DIMENSION(SIZE(XZHAT)) :: ZTHVM ! Temperature at mass model grid levels
REAL, DIMENSION(SIZE(XZHAT)) :: ZTHLM ! Thetal at mass model grid levels
REAL, DIMENSION(SIZE(XZHAT)) :: ZTHM ! Thetal at mass model grid levels
+REAL, DIMENSION(SIZE(XZHAT)) :: ZRHODM ! density at mass model grid level
REAL, DIMENSION(:), ALLOCATABLE :: ZMRT ! Total Vapor mixing ratio at mass levels on mixed grid
REAL, DIMENSION(:), ALLOCATABLE :: ZEXNMASS ! exner fonction at mass level
REAL, DIMENSION(:), ALLOCATABLE :: ZEXNFLUX ! exner fonction at flux level
REAL :: ZEXNSURF ! exner fonction at surface
+REAL, DIMENSION(:), ALLOCATABLE :: ZPREFLUX ! pressure at flux model grid level
REAL, DIMENSION(:), ALLOCATABLE :: ZFRAC_ICE ! ice fraction
REAL, DIMENSION(:), ALLOCATABLE :: ZRSATW, ZRSATI
REAL :: ZDZSDH,ZDZ1SDH,ZDZ2SDH ! interpolation
! working arrays
!
-INTEGER :: JK,JKLEV, JKU,JKM ! Loop indexes
+INTEGER :: JK,JKLEV,JKU,JKM,JKT,JJ,JI,JO,JLOOP ! Loop indexes
INTEGER :: IKU ! Upper bound in z direction
REAL :: ZRDSCPD,ZRADSDG, & ! Rd/Cpd, Pi/180.,
- ZRVSRD,ZRDSRV ! Rv/Rd, Rd/Rv
+ ZRVSRD,ZRDSRV, & ! Rv/Rd, Rd/Rv
+ ZPTOP ! Pressure at domain top
LOGICAL :: GUSERC ! use of input data cloud
INTEGER :: IIB, IIE, IJB, IJE
INTEGER :: IXOR_ll, IYOR_ll
@@ -362,8 +388,19 @@ LOGICAL :: GPROFILE_IN_PROC ! T : initialization profile is in current
!
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) ::ZZS_LS
REAL,DIMENSION(SIZE(XXHAT),SIZE(XYHAT),SIZE(XZHAT)) ::ZZFLUX_MX,ZZMASS_MX ! mixed grid
-INTEGER :: JLOOP
!-------------------------------------------------------------------------------
+! For standard ocean version, reading external files
+CHARACTER(LEN=256) :: yinfile, yinfisf ! files to be read
+INTEGER :: IDX
+INTEGER(KIND=CDFINT) :: INZ, INLATI, INLONGI
+INTEGER(KIND=CDFINT) :: incid, ivarid, idimid, idimlen
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZOC_TEMPERATURE,ZOC_SALINITY,ZOC_U,ZOC_V
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_DEPTH
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_LE,ZOC_H
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_SW_DOWN,ZOC_SW_UP,ZOC_LW_DOWN,ZOC_LW_UP
+REAL, DIMENSION(:), ALLOCATABLE :: ZOC_TAUX,ZOC_TAUY
+
+!--------------------------------------------------------------------------------
!
!* 1. PROLOGUE : INITIALIZE SOME CONSTANTS, RETRIEVE LOGICAL
! UNIT NUMBERS AND READ KIND OF DATA IN EXPRE FILE
@@ -380,31 +417,21 @@ ZRVSRD = XRV/XRD
ZRDSRV = XRD/XRV
!
!* 1.2 Retrieve logical unit numbers
-!
-!
+!
ILUPRE = TPEXPREFILE%NLU
+ILUOUT = TLUOUT%NLU
!
!* 1.3 Read data kind in EXPRE file
!
READ(ILUPRE,*) YKIND
-!
+WRITE(ILUOUT,*) 'YKIND read in set_rsou: ', YKIND
!
IF(LUSERC .AND. YKIND/='PUVTHDMR' .AND. YKIND/='ZUVTHDMR' .AND. YKIND/='ZUVTHLMR') THEN
CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','hydrometeors are not allowed for YKIND = '//trim(YKIND))
ENDIF
-! Demande Thierry Bergot Sept 2012
-!IF(LUSERC .AND.(YKIND == 'PUVTHDMR' .OR. YKIND == 'ZUVTHDMR').AND. .NOT. L1D) THEN
-! !callabortstop
-! CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','use of hydrometeors for YKIND=P(Z)UVTHDMR is only allowed in 1D case')
-!ENDIF
-!
-!IF(LUSERI .AND. YKIND=='ZUVTHLMR') THEN
-! !callabortstop
-! CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','use of ice for YKIND=ZUVTHLMR is not allowed')
-!ENDIF
!
IF(YKIND=='ZUVTHLMR' .AND. .NOT. LUSERC) THEN
- !callabortstop
+!callabortstop
CALL PRINT_MSG(NVERB_FATAL,'GEN','SET_RSOU','LUSERC=T is required for YKIND=ZUVTHLMR')
ENDIF
!
@@ -416,8 +443,347 @@ IF(LUSERC .AND. (YKIND == 'PUVTHDMR' .OR. YKIND == 'ZUVTHDMR')) GUSERC=.TRUE.
! --------------------------------------------------------
!
SELECT CASE(YKIND)
+!
+! 2.0.1 Ocean case 1
+!
+ CASE ('IDEALOCE')
+!
+ XP00=XP00OCEAN
+ ! Read data in PRE_IDEA1.nam
+ ! Surface
+ WRITE(ILUOUT,FMT=*) 'Reading data for ideal ocean :IDEALOCE'
+ READ(ILUPRE,*) ZPTOP ! P_atmosphere at sfc =P top domain
+ READ(ILUPRE,*) ZTGROUND ! SST
+ READ(ILUPRE,*) ZMRGROUND ! SSS
+ WRITE(ILUOUT,FMT=*) 'Patm SST SSS', ZPTOP,ZTGROUND,ZMRGROUND
+ READ(ILUPRE,*) ILEVELU ! Read number of Current levels
+ ! Allocate required memory
+ ALLOCATE(ZHEIGHTU(ILEVELU),ZU(ILEVELU),ZV(ILEVELU))
+ ALLOCATE(ZOC_U(ILEVELU,1,1),ZOC_V(ILEVELU,1,1))
+ WRITE(ILUOUT,FMT=*) 'Level number for Current in data', ILEVELU
+ ! Read U and V at each wind level
+ DO JKU = 1,ILEVELU
+ READ(ILUPRE,*) ZHEIGHTU(JKU),ZOC_U(JKU,1,1),ZOC_V(JKU,1,1)
+ ! WRITE(ILUOUT,FMT=*) 'Leveldata D(m) under sfc: U_cur, V_cur', JKU, ZHEIGHTU(JKU),ZU(JKU),ZV(JKU)
+ END DO
+ DO JKU=1,ILEVELU
+ ! Z axis reoriented as in the model
+ IDX = ILEVELU-JKU+1
+ ZU(JKU) = ZOC_U(IDX,1,1)
+ ZV(JKU) = ZOC_V(IDX,1,1)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ ! Z oriented in same time to have a model domain axis going
+ ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
+ END DO
+ ! Read number of mass levels
+ READ(ILUPRE,*) ILEVELM
+ ! Allocate required memory
+ ALLOCATE(ZOC_DEPTH(ILEVELM))
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM),ZTH(ILEVELM),ZTHV(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM),ZRT(ILEVELM))
+ ALLOCATE(ZOC_TEMPERATURE(ILEVELM,1,1),ZOC_SALINITY(ILEVELM,1,1))
+ ! Read T and S at each mass level
+ DO JKM= 2,ILEVELM
+ READ(ILUPRE,*) ZOC_DEPTH(JKM),ZOC_TEMPERATURE(JKM,1,1),ZOC_SALINITY(JKM,1,1)
+ END DO
+ ! Complete the mass arrays with the ground informations read in EXPRE file
+ ZOC_DEPTH(1) = 0.
+ ZOC_TEMPERATURE(1,1,1)= ZTGROUND
+ ZOC_SALINITY(1,1,1)= ZMRGROUND
+ !!!!!!!!!!!!!!!!!!!!!!!!Inversing Axis!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Going from the data (axis downward i.e inverse model) grid to the model grid (axis upward)
+ ! Uniform bathymetry; depth goes from ocean sfc downwards (data grid)
+ ! ZHEIGHT goes from the model domain bottom up to the sfc ocean (top of model domain)
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ZZGROUND = 0.
+ ZTGROUND = ZOC_TEMPERATURE(ILEVELM,1,1)
+ ZMRGROUND = ZOC_SALINITY(ILEVELM,1,1)
+ DO JKM= 1,ILEVELM
+ ! Z upward axis (oriented as in the model), i.e.
+ ! going from 0m (ocean bottom/model bottom) upward to H (ocean sfc/model top)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ IDX = ILEVELM-JKM+1
+ ZTH(JKM) = ZOC_TEMPERATURE(IDX,1,1)
+ ZMR(JKM) = ZOC_SALINITY(IDX,1,1)
+ ZHEIGHTM(JKM)= ZOC_DEPTH(ILEVELM)- ZOC_DEPTH(IDX)
+ WRITE(ILUOUT,FMT=*) 'Model oriented initial data: JKM IDX depth T S ZHEIGHTM', &
+ JKM,IDX,ZOC_DEPTH(IDX),ZTH(JKM),ZMR(JKM),ZHEIGHTM(JKM)
+ END DO
+ ! mass levels of the RS
+ ZTHV = ZTH ! TV==THETA=TL
+ ZTHL = ZTH
+ ZRT = ZMR
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! READ Sea Surface Forcing !
+ !!!!!!!!!!!!!!!!!!!!!!!!!!!!
+ ! Reading the forcings from prep_idea1.nam
+ READ(ILUPRE,*) IFRCLT ! Number of time-dependent forcing
+ IF (IFRCLT > 99*8) THEN
+ ! CAUTION: number of forcing times is limited by the WRITE format 99(8E10.3)
+ ! and also by the name of forcing variables (format I3.3)
+ ! You have to modify those if you need more forcing times
+ CALL PRINT_MSG(NVERB_FATAL,'IO','SET_RSOU','maximum forcing times NFRCLT is 99*8')
+ END IF
+!
+ WRITE(UNIT=ILUOUT,FMT='(" THERE ARE ",I2," SFC FLUX FORCINGs AT:")') IFRCLT
+ ALLOCATE(ZFRCLT(IFRCLT))
+ ALLOCATE(ZSSUFL_T(IFRCLT)); ZSSUFL_T = 0.0
+ ALLOCATE(ZSSVFL_T(IFRCLT)); ZSSVFL_T = 0.0
+ ALLOCATE(ZSSTFL_T(IFRCLT)); ZSSTFL_T = 0.0
+ ALLOCATE(ZSSOLA_T(IFRCLT)); ZSSOLA_T = 0.0
+ DO JKT = 1,IFRCLT
+ WRITE(ILUOUT,FMT='(A, I4)') "SET_RSOU/Reading Sea Surface forcing: Number=", JKT
+ READ(ILUPRE,*) ZFRCLT(JKT)%nyear, ZFRCLT(JKT)%nmonth, &
+ ZFRCLT(JKT)%nday, ZFRCLT(JKT)%xtime
+ READ(ILUPRE,*) ZSSUFL_T(JKT)
+ READ(ILUPRE,*) ZSSVFL_T(JKT)
+ READ(ILUPRE,*) ZSSTFL_T(JKT)
+ READ(ILUPRE,*) ZSSOLA_T(JKT)
+ END DO
+!
+ DO JKT = 1 , IFRCLT
+ WRITE(UNIT=ILUOUT,FMT='(F9.0, "s, date:", I3, "/", I3, "/", I5)') &
+ ZFRCLT(JKT)%xtime, ZFRCLT(JKT)%nday, &
+ ZFRCLT(JKT)%nmonth, ZFRCLT(JKT)%nyear
+ END DO
+ NINFRT= INT(ZFRCLT(2)%xtime)
+ WRITE(ILUOUT,FMT='(A)') &
+ "Number U-Stress, V-Stress, Heat turb Flux, Solar Flux Interval(s)",NINFRT
+ DO JKT = 1, IFRCLT
+ WRITE(ILUOUT,FMT='(I10,99(3F10.2))') JKT, ZSSUFL_T(JKT),ZSSVFL_T(JKT),ZSSTFL_T(JKT)
+ END DO
+ NFRCLT = IFRCLT
+ ALLOCATE(TFRCLT(NFRCLT))
+ ALLOCATE(XSSUFL_T(NFRCLT));XSSUFL_T(:)=0.
+ ALLOCATE(XSSVFL_T(NFRCLT));XSSVFL_T(:)=0.
+ ALLOCATE(XSSTFL_T(NFRCLT));XSSTFL_T(:)=0.
+ ALLOCATE(XSSOLA_T(NFRCLT));XSSOLA_T(:)=0.
+!
+ DO JKT=1,NFRCLT
+ TFRCLT(JKT)= ZFRCLT(JKT)
+ XSSUFL_T(JKT)=ZSSUFL_T(JKT)/XRH00OCEAN
+ XSSVFL_T(JKT)=ZSSVFL_T(JKT)/XRH00OCEAN
+ ! working in SI
+ XSSTFL_T(JKT)=ZSSTFL_T(JKT) /(3900.*XRH00OCEAN)
+ XSSOLA_T(JKT)=ZSSOLA_T(JKT) /(3900.*XRH00OCEAN)
+ END DO
+ DEALLOCATE(ZFRCLT)
+ DEALLOCATE(ZSSUFL_T)
+ DEALLOCATE(ZSSVFL_T)
+ DEALLOCATE(ZSSTFL_T)
+ DEALLOCATE(ZSSOLA_T)
+!
+!--------------------------------------------------------------------------------
+! 2.0.2 Ocean standard initialize from netcdf files
+! U,V,T,S at Z levels + Forcings at model TOP (sea surface)
+!--------------------------------------------------------------------------------
+!
+ CASE ('STANDOCE')
+!
+ XP00=XP00OCEAN
+ READ(ILUPRE,*) ZPTOP ! P_atmosphere at sfc =P top domain
+ READ(ILUPRE,*) YINFILE, YINFISF
+ WRITE(ILUOUT,FMT=*) 'Netcdf files to read:', YINFILE, YINFISF
+ ! Open file containing initial profiles
+ CALL check(nf90_open(yinfile,NF90_NOWRITE,incid), "opening NC file")
+ ! Reading dimensions and lengths
+ CALL check( nf90_inq_dimid(incid, "depth",idimid), "getting depth dimension id" )
+ CALL check( nf90_inquire_dimension(incid, idimid, len=INZ), "getting INZ" )
+ CALL check( nf90_inquire_dimension(incid, INT(2,KIND=CDFINT), len=INLONGI), "getting NLONG" )
+ CALL check( nf90_inquire_dimension(incid, INT(1,KIND=CDFINT), len=INLATI), "getting NLAT" )
+!
+ WRITE(ILUOUT,FMT=*) 'NB LEVLS READ INZ, NLONG NLAT ', INZ, INLONGI,INLATI
+ ALLOCATE(ZOC_TEMPERATURE(INLATI,INLONGI,INZ),ZOC_SALINITY(INLATI,INLONGI,INZ))
+ ALLOCATE(ZOC_U(INLATI,INLONGI,INZ),ZOC_V(INLATI,INLONGI,INZ))
+ ALLOCATE(ZOC_DEPTH(INZ))
+ WRITE(ILUOUT,FMT=*) 'NETCDF READING ==> Temp'
+ CALL check(nf90_inq_varid(incid,"temperature",ivarid), "getting temp ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_TEMPERATURE), "reading temp")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> salinity'
+ CALL check(nf90_inq_varid(incid,"salinity",ivarid), "getting salinity ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_SALINITY), "reading salinity")
+ WRITE(ILUOUT,FMT=*) 'Netcdf ==> Reading depth'
+ CALL check(nf90_inq_varid(incid,"depth",ivarid), "getting depth ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_DEPTH), "reading depth")
+ WRITE(ILUOUT,FMT=*) 'depth: max min ', MAXVAL(ZOC_DEPTH),MINVAL(ZOC_DEPTH)
+ WRITE(ILUOUT,FMT=*) 'depth 1 nz: ', ZOC_DEPTH(1),ZOC_DEPTH(INZ)
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> Currents'
+ CALL check(nf90_inq_varid(incid,"u",ivarid), "getting u ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_U), "reading u")
+ CALL check(nf90_inq_varid(incid,"v",ivarid), "getting v ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_V), "reading v")
+ CALL check(nf90_close(incid), "closing yinfile")
+ WRITE(ILUOUT,FMT=*) 'End of initial file reading'
+!
+ DO JKM=1,INZ
+ ZOC_TEMPERATURE(1,1,JKM)=ZOC_TEMPERATURE(1,1,JKM)+273.15
+ WRITE(ILUOUT,FMT=*) 'Z T(Kelvin) S(Sverdup) U V K',&
+ JKM,ZOC_DEPTH(JKM),ZOC_TEMPERATURE(1,1,JKM),ZOC_SALINITY(1,1,JKM),ZOC_U(1,1,JKM),ZOC_V(1,1,JKM), JKM
+ ENDDO
+ ! number of data levels
+ ILEVELM=INZ
+ ! Model bottom
+ ZTGROUND = ZOC_TEMPERATURE(1,1,ILEVELM)
+ ZMRGROUND = ZOC_SALINITY(1,1,ILEVELM)
+ ZZGROUND=0.
+ ! Allocate required memory
+ ALLOCATE(ZHEIGHTM(ILEVELM))
+ ALLOCATE(ZT(ILEVELM))
+ ALLOCATE(ZTV(ILEVELM))
+ ALLOCATE(ZMR(ILEVELM))
+ ALLOCATE(ZTHV(ILEVELM))
+ ALLOCATE(ZTHL(ILEVELM))
+ ALLOCATE(ZRT(ILEVELM))
+ ! Going from the inverse model grid (data) to the normal one
+ DO JKM= 1,ILEVELM
+ ! Z axis reoriented as in the model
+ IDX = ILEVELM-JKM+1
+ ZT(JKM) = ZOC_TEMPERATURE(1,1,IDX)
+ ZMR(JKM) = ZOC_SALINITY(1,1,IDX)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ ! Z oriented in same time to have a model domain axis going
+ ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
+ ! translation/inversion
+ ZHEIGHTM(JKM) = -ZOC_DEPTH(IDX) + ZOC_DEPTH(ILEVELM)
+ WRITE(ILUOUT,FMT=*) 'End gridmodel comput: JKM IDX depth T S ZHEIGHTM', &
+ JKM,IDX,ZOC_DEPTH(IDX),ZT(JKM),ZMR(JKM),ZHEIGHTM(JKM)
+ END DO
+ ! complete ther variables
+ ZTV = ZT
+ ZTHV = ZT
+ ZRT = ZMR
+ ZTHL = ZT
+ ZTH = ZT
+ ! INIT --- U V -----
+ ILEVELU = INZ ! Same nb of levels for u,v,T,S
+ !Assume that current and temp are given at same level
+ ALLOCATE(ZHEIGHTU(ILEVELU))
+ ALLOCATE(ZU(ILEVELU),ZV(ILEVELU))
+ ZHEIGHTU=ZHEIGHTM
+ DO JKM= 1,ILEVELU
+ ! Z axis reoriented as in the model
+ IDX = ILEVELU-JKM+1
+ ZU(JKM) = ZOC_U(1,1,IDX)
+ ZV(JKM) = ZOC_V(1,1,IDX)
+ ! ZHEIGHT used only in set_ rsou, defined as such ZHEIGHT(ILEVELM)=H_model
+ ! Z oriented in same time to have a model domain axis going
+ ! from 0m (ocean bottom/model bottom) towards H (ocean sfc/model top)
+ END DO
!
-!* 2.1 STANDARD case : ZGROUND, PGROUND, TGROUND, TDGROUND
+ DEALLOCATE(ZOC_TEMPERATURE)
+ DEALLOCATE(ZOC_SALINITY)
+ DEALLOCATE(ZOC_U)
+ DEALLOCATE(ZOC_V)
+ DEALLOCATE(ZOC_DEPTH)
+!
+ ! Reading/initializing surface forcings
+!
+ WRITE(ILUOUT,FMT=*) 'netcdf sfc forcings file to be read:',yinfisf
+ ! Open of sfc forcing file
+ CALL check(nf90_open(yinfisf,NF90_NOWRITE,incid), "opening NC file")
+ ! Reading dimension and length
+ CALL check( nf90_inq_dimid(incid,"t",idimid), "getting time dimension id" )
+ CALL check( nf90_inquire_dimension(incid, idimid, len=idimlen), "getting idimlen " )
+!
+ WRITE(ILUOUT,FMT=*) 'nb sfc-forcing time idimlen=',idimlen
+ ALLOCATE(ZOC_LE(idimlen))
+ ALLOCATE(ZOC_H(idimlen))
+ ALLOCATE(ZOC_SW_DOWN(idimlen))
+ ALLOCATE(ZOC_SW_UP(idimlen))
+ ALLOCATE(ZOC_LW_DOWN(idimlen))
+ ALLOCATE(ZOC_LW_UP(idimlen))
+ ALLOCATE(ZOC_TAUX(idimlen))
+ ALLOCATE(ZOC_TAUY(idimlen))
+!
+ WRITE(ILUOUT,FMT=*)'Netcdf Reading ==> LE'
+ CALL check(nf90_inq_varid(incid,"LE",ivarid), "getting LE ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_LE), "reading LE flux")
+ WRITE(ILUOUT,FMT=*)'Netcdf Reading ==> H'
+ CALL check(nf90_inq_varid(incid,"H",ivarid), "getting H ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_H), "reading H flux")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> SW_DOWN'
+ CALL check(nf90_inq_varid(incid,"SW_DOWN",ivarid), "getting SW_DOWN ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_SW_DOWN), "reading SW_DOWN")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> SW_UP'
+ CALL check(nf90_inq_varid(incid,"SW_UP",ivarid), "getting SW_UP ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_SW_UP), "reading SW_UP")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> LW_DOWN'
+ CALL check(nf90_inq_varid(incid,"LW_DOWN",ivarid), "getting LW_DOWN ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_LW_DOWN), "reading LW_DOWN")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> LW_UP'
+ CALL check(nf90_inq_varid(incid,"LW_UP",ivarid), "getting LW_UP ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_LW_UP), "reading LW_UP")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> TAUX'
+ CALL check(nf90_inq_varid(incid,"TAUX",ivarid), "getting TAUX ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_TAUX), "reading TAUX")
+ WRITE(ILUOUT,FMT=*) 'Netcdf Reading ==> TAUY'
+ CALL check(nf90_inq_varid(incid,"TAUY",ivarid), "getting TAUY ivarid")
+ CALL check(nf90_get_var(incid,ivarid,ZOC_TAUY), "reading TAUY")
+ CALL check(nf90_close(incid), "closing yinfifs")
+!
+ WRITE(ILUOUT,FMT=*) ' Forcing-Number LE H SW_down SW_up LW_down LW_up TauX TauY'
+ DO JKM = 1, idimlen
+ WRITE(ILUOUT,FMT=*) JKM, ZOC_LE(JKM), ZOC_H(JKM),ZOC_SW_DOWN(JKM),ZOC_SW_UP(JKM),&
+ ZOC_LW_DOWN(JKM),ZOC_LW_UP(JKM),ZOC_TAUX(JKM),ZOC_TAUY(JKM)
+ ENDDO
+ ! IFRCLT FORCINGS at sea surface
+ IFRCLT=idimlen
+ ALLOCATE(ZFRCLT(IFRCLT))
+ ALLOCATE(ZSSUFL_T(IFRCLT)); ZSSUFL_T = 0.0
+ ALLOCATE(ZSSVFL_T(IFRCLT)); ZSSVFL_T = 0.0
+ ALLOCATE(ZSSTFL_T(IFRCLT)); ZSSTFL_T = 0.0
+ ALLOCATE(ZSSOLA_T(IFRCLT)); ZSSOLA_T = 0.0
+ DO JKT=1,IFRCLT
+ ! Initial file for CINDY-DYNAMO: all fluxes correspond to the absolute value (>0)
+ ! modele ocean: axe z dirigé du bas vers la sfc de l'océan
+ ! => flux dirigé vers le haut (positif ocean vers l'atmopshere i.e. bas vers le haut)
+ ZSSOLA_T(JKT)=ZOC_SW_DOWN(JKT)-ZOC_SW_UP(JKT)
+ ZSSTFL_T(JKT)=(ZOC_LW_DOWN(JKT)-ZOC_LW_UP(JKT)-ZOC_LE(JKT)-ZOC_H(JKT))
+ ! assume that Tau given on file is along Ox
+ ! rho_air UW_air = rho_ocean UW_ocean= N/m2
+ ! uw_ocean
+ ZSSUFL_T(JKT)=ZOC_TAUX(JKT)
+ ZSSVFL_T(JKT)=ZOC_TAUY(JKT)
+ WRITE(ILUOUT,FMT=*) 'Forcing Nb Sol NSol UW_oc VW',&
+ JKT,ZSSOLA_T(JKT),ZSSTFL_T(JKT),ZSSUFL_T(JKT),ZSSVFL_T(JKT)
+ ENDDO
+ ! Allocate and Writing the corresponding variables in module MODD_OCEAN_FRC
+ NFRCLT=IFRCLT
+ ! value to read later on file ?
+ NINFRT=600
+ ALLOCATE(TFRCLT(NFRCLT))
+ ALLOCATE(XSSUFL_T(NFRCLT));XSSUFL_T(:)=0.
+ ALLOCATE(XSSVFL_T(NFRCLT));XSSVFL_T(:)=0.
+ ALLOCATE(XSSTFL_T(NFRCLT));XSSTFL_T(:)=0.
+ ALLOCATE(XSSOLA_T(NFRCLT));XSSOLA_T(:)=0.
+ ! on passe en unités SI, signe, etc pour le modele ocean
+ ! W/m2 => SI : /(CP_mer * rho_mer)
+ ! a revoir dans tt le code pour mettre de svaleurs plus exactes
+ DO JKT=1,NFRCLT
+ TFRCLT(JKT)= ZFRCLT(JKT)
+ XSSUFL_T(JKT)=ZSSUFL_T(JKT)/XRH00OCEAN
+ XSSVFL_T(JKT)=ZSSVFL_T(JKT)/XRH00OCEAN
+ XSSTFL_T(JKT)=ZSSTFL_T(JKT) /(3900.*XRH00OCEAN)
+ XSSOLA_T(JKT)=ZSSOLA_T(JKT) /(3900.*XRH00OCEAN)
+ END DO
+ DEALLOCATE(ZFRCLT)
+ DEALLOCATE(ZSSUFL_T)
+ DEALLOCATE(ZSSVFL_T)
+ DEALLOCATE(ZSSTFL_T)
+ DEALLOCATE(ZSSOLA_T)
+ DEALLOCATE(ZOC_LE)
+ DEALLOCATE(ZOC_H)
+ DEALLOCATE(ZOC_SW_DOWN)
+ DEALLOCATE(ZOC_SW_UP)
+ DEALLOCATE(ZOC_LW_DOWN)
+ DEALLOCATE(ZOC_LW_UP)
+ DEALLOCATE(ZOC_TAUX)
+ DEALLOCATE(ZOC_TAUY)
+ ! END OCEAN STANDARD
+!
+!
+!* 2.1 ATMOSPHERIC STANDARD case : ZGROUND, PGROUND, TGROUND, TDGROUND
! (Pressure, dd, ff) ,
! (Pressure, T, Td)
!
@@ -448,8 +814,7 @@ SELECT CASE(YKIND)
ALLOCATE(ZHEIGHTM(ILEVELM)) ! Allocate memory for needed
ALLOCATE(ZTHV(ILEVELM)) ! arrays
ALLOCATE(ZMR(ILEVELM))
- ALLOCATE(ZTV(ILEVELM)) ! Allocate memory for intermediate
- ! arrays
+ ALLOCATE(ZTV(ILEVELM)) ! Allocate memory for intermediate arrays
ALLOCATE(ZTHL(ILEVELM))
ALLOCATE(ZRT(ILEVELM))
!
@@ -1203,20 +1568,36 @@ END DO
ALLOCATE(ZEXNFLUX(IKU))
ALLOCATE(ZEXNMASS(IKU))
ALLOCATE(ZPRESS(IKU))
+ALLOCATE(ZPREFLUX(IKU))
ALLOCATE(ZFRAC_ICE(IKU))
ALLOCATE(ZRSATW(IKU))
ALLOCATE(ZRSATI(IKU))
ALLOCATE(ZMRT(IKU))
ZMRT=ZMRM+ZMRCM+ZMRIM
-ZEXNSURF=(ZPGROUND/XP00)**(XRD/XCPD)
ZTHVM=ZTHLM
-DO JLOOP=1,20 ! loop for pression
- CALL COMPUTE_EXNER_FROM_GROUND(ZTHVM,ZZMASS_PROFILE(:),ZEXNSURF,ZEXNFLUX,ZEXNMASS)
- ZPRESS(:)=XP00*(ZEXNMASS(:))**(XCPD/XRD)
- CALL TH_R_FROM_THL_RT_1D('T',ZFRAC_ICE,ZPRESS,ZTHLM,ZMRT,ZTHM,ZMRM,ZMRCM,ZMRIM, &
- ZRSATW, ZRSATI)
- ZTHVM(:)=ZTHM(:)*(1.+XRV/XRD*ZMRM(:))/(1.+(ZMRM(:)+ZMRIM(:)+ZMRCM(:)))
-ENDDO
+!
+IF (LOCEAN) THEN
+ ZRHODM(:)=XRH00OCEAN*(1.-XALPHAOC*(ZTHLM(:) - XTH00OCEAN)&
+ +XBETAOC* (ZMRM(:) - XSA00OCEAN))
+ ZPREFLUX(IKU)=ZPTOP
+ DO JK=IKU-1,2,-1
+ ZPREFLUX(JK) = ZPREFLUX(JK+1) + XG*ZRHODM(JK)*(ZZFLUX_PROFILE(JK+1)-ZZFLUX_PROFILE(JK))
+ END DO
+ ZPGROUND=ZPREFLUX(2)
+ WRITE(ILUOUT,FMT=*)'ZPGROUND i.e. Pressure at ocean domain bottom',ZPGROUND
+ ZTHM=ZTHVM
+ELSE
+! Atmospheric case
+ ZEXNSURF=(ZPGROUND/XP00)**(XRD/XCPD)
+ DO JLOOP=1,20 ! loop for pression
+ CALL COMPUTE_EXNER_FROM_GROUND(ZTHVM,ZZMASS_PROFILE(:),ZEXNSURF,ZEXNFLUX,ZEXNMASS)
+ ZPRESS(:)=XP00*(ZEXNMASS(:))**(XCPD/XRD)
+ CALL TH_R_FROM_THL_RT_1D('T',ZFRAC_ICE,ZPRESS,ZTHLM,ZMRT,ZTHM,ZMRM,ZMRCM,ZMRIM, &
+ ZRSATW, ZRSATI)
+ ZTHVM(:)=ZTHM(:)*(1.+XRV/XRD*ZMRM(:))/(1.+(ZMRM(:)+ZMRIM(:)+ZMRCM(:)))
+ ENDDO
+ENDIF
+!
DEALLOCATE(ZEXNFLUX)
DEALLOCATE(ZEXNMASS)
DEALLOCATE(ZPRESS)
@@ -1224,7 +1605,6 @@ DEALLOCATE(ZFRAC_ICE)
DEALLOCATE(ZRSATW)
DEALLOCATE(ZRSATI)
DEALLOCATE(ZMRT)
-
!-------------------------------------------------------------------------------
!
!* 4. COMPUTE FIELDS ON THE MODEL GRID (WITH OROGRAPHY)
@@ -1234,6 +1614,20 @@ CALL SET_MASS(TPFILE,GPROFILE_IN_PROC, ZZFLUX_PROFILE, &
ZTHVM,ZMRM,ZUW,ZVW,OSHIFT,OBOUSS,PJ,HFUNU,HFUNV, &
PMRCM=ZMRCM,PMRIM=ZMRIM,PCORIOZ=PCORIOZ)
!
+DEALLOCATE(ZPREFLUX)
+DEALLOCATE(ZHEIGHTM)
+DEALLOCATE(ZTHV)
+DEALLOCATE(ZMR)
+DEALLOCATE(ZTHL)
!-------------------------------------------------------------------------------
+CONTAINS
+ SUBROUTINE CHECK( ISTATUS, YLOC )
+ INTEGER(KIND=CDFINT), INTENT(IN) :: ISTATUS
+ CHARACTER(LEN=*), INTENT(IN) :: YLOC
+
+ IF( ISTATUS /= NF90_NOERR ) THEN
+ CALL PRINT_MSG( NVERB_ERROR, 'IO', 'SET_RSOU', 'error at ' // Trim( yloc) // ': ' // NF90_STRERROR( ISTATUS ) )
+ END IF
+ END SUBROUTINE check
!
END SUBROUTINE SET_RSOU
diff --git a/src/MNH/shallow_mf.f90 b/src/MNH/shallow_mf.f90
index 4017b49d7540651b21d3d4040afd68f57418de68..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,6 +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
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -183,7 +184,6 @@ USE MODI_THL_RT_FROM_TH_R_MF
USE MODI_COMPUTE_UPDRAFT
USE MODI_COMPUTE_UPDRAFT_RHCJ10
USE MODI_COMPUTE_UPDRAFT_RAHA
-USE MODI_COMPUTE_UPDRAFT_HRIO
USE MODI_MF_TURB
USE MODI_MF_TURB_EXPL
USE MODI_MF_TURB_GREYZONE
@@ -308,8 +308,7 @@ IKB=KKA+KKL*JPVEXT
IKE=KKU-KKL*JPVEXT
! updraft governing variables
-IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'HRIO' .OR. &
- HMF_UPDRAFT == 'RHCJ' .OR. HMF_UPDRAFT == 'BOUT') THEN
+IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ') THEN
PENTR = 1.E20
PDETR = 1.E20
PEMF = 1.E20
@@ -337,7 +336,7 @@ ZTHVM(:,:) = PTHM(:,:)*((1.+XRV / XRD *PRM(:,:,1))/(1.+ZRTM(:,:)))
!!! 2. Compute updraft
!!! ---------------
!
-IF (HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'BOUT') THEN
+IF (HMF_UPDRAFT == 'EDKF') THEN
GENTR_DETR = .TRUE.
CALL COMPUTE_UPDRAFT(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV,&
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
@@ -378,22 +377,6 @@ ELSEIF (HMF_UPDRAFT == 'RAHA') THEN
ZDEPTH )
ELSEIF (HMF_UPDRAFT == 'DUAL') THEN
!Updraft characteristics are already computed and received by interface
-ELSEIF (HMF_UPDRAFT == 'HRIO') THEN
- GENTR_DETR = .TRUE.
- ! ma version avec l'entrainement de Rio et al.
- CALL COMPUTE_UPDRAFT_HRIO(KKA,IKB,IKE,KKU,KKL,HFRAC_ICE,GENTR_DETR,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PZZ,PDZZ, &
- PSFTH,PSFRV,PPABSM,PRHODREF, &
- PUM,PVM,PTKEM,PWM, &
- PTHM,PRM(:,:,1),ZTHLM,ZRTM, PSVM, &
- PTHL_UP,PRT_UP,PRV_UP,PRC_UP,PRI_UP, &
- PTHV_UP,PW_UP, PU_UP, PV_UP, ZSV_UP, &
- PFRAC_UP,ZFRAC_ICE_UP,ZRSAT_UP, &
- PTHL_DO, PTHV_DO, PRT_DO, &
- PU_DO, PV_DO, ZSV_DO, &
- PEMF,PDETR, &
- PENTR,ZBUO_INTEG,KKLCL,KKETL,KKCTL,ZDEPTH )
ELSE
call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) )
ENDIF
@@ -417,7 +400,7 @@ CALL COMPUTE_MF_CLOUD(KKA,IKB,IKE,KKU,KKL,KRR,KRRL,KRRI,&
!!! ------------------------------------------------------------------------
!
ZEMF_O_RHODREF=PEMF/PRHODREF
- IF(HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ'.OR. HMF_UPDRAFT == 'BOUT') THEN
+IF(HMF_UPDRAFT == 'EDKF' .OR. HMF_UPDRAFT == 'RHCJ') THEN
IF ( PIMPL_MF > 1.E-10 ) THEN
CALL MF_TURB(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
@@ -429,66 +412,17 @@ ZEMF_O_RHODREF=PEMF/PRHODREF
ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,ZSV_UP,&
PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
ZFLXZSVMF )
-ELSE
- CALL MF_TURB_EXPL(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
+ ELSE
+ CALL MF_TURB_EXPL(KKA, IKB, IKE, KKU, KKL, OMIXUV, &
PRHODJ, &
ZTHLM,ZTHVM,ZRTM,PUM,PVM, &
PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF, &
ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP, &
PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF)
-ENDIF
- ELSEIF (HMF_UPDRAFT == 'HRIO') THEN
- CALL MF_TURB_GREYZONE(KKA, IKB, IKE, KKU, KKL,OMIXUV, &
- ONOMIXLG,KSV_LGBEG,KSV_LGEND, &
- PIMPL_MF, PTSTEP, &
- PDZZ, &
- PRHODJ, &
- ZTHLM,ZTHVM,ZRTM,PUM,PVM,PSVM, &
- PDTHLDT_MF,PDRTDT_MF,PDUDT_MF,PDVDT_MF,PDSVDT_MF, &
- ZEMF_O_RHODREF,PTHL_UP,PTHV_UP,PRT_UP,PU_UP,PV_UP,ZSV_UP,&
- PTHL_DO,PTHV_DO,PRT_DO,PU_DO,PV_DO,ZSV_DO, &
- PFLXZTHMF,PFLXZTHVMF,PFLXZRMF,PFLXZUMF,PFLXZVMF, &
- ZFLXZSVMF )
- ELSE
- call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) )
- END IF
-
- IF (HMF_UPDRAFT == 'BOUT') THEN
- !! calcul de la hauteur de la couche limite ou de L_up
- DO JK=1,IKE-KKL
- PTHVREF(:,JK)=RESHAPE(XTHVREF(:,:,JK),(/SIZE(PTHM,1)*SIZE(PTHM,2)/) )
- ENDDO
- ZG_O_THVREF=XG/PTHVREF
- GLMIX=.TRUE.
- IF(CTURBLEN=='RM17') THEN
- ZDUDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PUM,PDZZ))
- ZDVDZ = MZF_MF(KKA,KKU,KKL,GZ_M_W_MF(KKA,KKU,KKL,PVM,PDZZ))
- ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
- ELSE
- ZSHEAR = 0. !no shear in bl89 mixing length
- END IF
- CALL COMPUTE_BL89_ML(KKA,IKB,IKE,KKU,KKL,PDZZ,PTKEM(:,IKB) ,ZG_O_THVREF(:,IKB),ZTHVM,IKB,GLMIX,.TRUE.,ZSHEAR,ZLUP)
- !! calcul de Dx/(h+hc)
- DO JI=1,SIZE(XDXHAT)
- DO JJ=1,SIZE(XDYHAT)
- ZRESOL_GRID((JJ-1)*SIZE(XDXHAT)+JI)=SQRT(XDXHAT(JI)*XDYHAT(JJ))
- ENDDO
- ENDDO
- ZRESOL_NORM=ZRESOL_GRID/ZLUP
- !! P=loi pour MF, on utilise la même loi à chaque fois
- ZPLAW=(ZRESOL_NORM*ZRESOL_NORM+0.19*ZRESOL_NORM**(2./3.))/ &
- (ZRESOL_NORM*ZRESOL_NORM+0.15*ZRESOL_NORM**(2./3.)+0.33)
- !! reduction des flux a posteriori
- !! MF=P*MF en première approximation, on oublie w'f' (Kgrad) et w'f'resol (nul avec ce flux)
- !
- DO JK=1,IKE-KKL
- PFLXZTHMF(:,JK)=PFLXZTHMF(:,JK)*ZPLAW
- PFLXZTHVMF(:,JK)=PFLXZTHVMF(:,JK)*ZPLAW
- PFLXZRMF(:,JK)=PFLXZRMF(:,JK)*ZPLAW
- PFLXZUMF(:,JK)=PFLXZUMF(:,JK)*ZPLAW
- PFLXZVMF(:,JK)=PFLXZVMF(:,JK)*ZPLAW
- ENDDO
- END IF
+ ENDIF
+ELSE
+ call Print_msg( NVERB_FATAL, 'GEN', 'SHALLOW_MF', 'no updraft model for EDKF: CMF_UPDRAFT='//trim(HMF_UPDRAFT) )
+END IF
! security in the case HMF_UPDRAFT = 'DUAL'
! to be modified if 'DUAL' is evolving (momentum mixing for example)
diff --git a/src/MNH/shallow_mf_pack.f90 b/src/MNH/shallow_mf_pack.f90
index 96fff37723b263791445e5d0e5e4891ef17e89c9..d5c0bbdfe887248e48f5ba99f4480353bce46465 100644
--- a/src/MNH/shallow_mf_pack.f90
+++ b/src/MNH/shallow_mf_pack.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.
@@ -11,7 +11,7 @@ INTERFACE
! #################################################################
SUBROUTINE SHALLOW_MF_PACK(KRR,KRRL,KRRI, &
HMF_UPDRAFT, HMF_CLOUD, OMIXUV, &
- OCLOSE_OUT,OMF_FLX,TPFILE,PTIME_LES, &
+ OMF_FLX,TPFILE,PTIME_LES, &
PIMPL_MF, PTSTEP, &
PDZZ, PZZ, &
PRHODJ, PRHODREF, &
@@ -36,8 +36,6 @@ CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT! Type of Mass Flux Scheme
CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
! scheme
LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for synchronous
- ! file opening
LOGICAL, INTENT(IN) :: OMF_FLX ! switch to write the
! MF fluxes in the synchronous FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -77,7 +75,7 @@ END MODULE MODI_SHALLOW_MF_PACK
! #################################################################
SUBROUTINE SHALLOW_MF_PACK(KRR,KRRL,KRRI, &
HMF_UPDRAFT, HMF_CLOUD, OMIXUV, &
- OCLOSE_OUT,OMF_FLX,TPFILE,PTIME_LES, &
+ OMF_FLX,TPFILE,PTIME_LES, &
PIMPL_MF, PTSTEP, &
PDZZ, PZZ, &
PRHODJ, PRHODREF, &
@@ -119,25 +117,28 @@ END MODULE MODI_SHALLOW_MF_PACK
! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
! S. Riette 11/2016: support for CFRAC_ICE_SHALLOW_MF
! P. Wautelet 28/03/2019: use MNHTIME for time measurement variables
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_th, lbudget_rv, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_TH, NBUDGET_RV, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
USE MODD_CST
USE MODD_IO, ONLY: TFILEDATA
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_NSV
USE MODD_PARAMETERS
USE MODD_PARAM_ICE, ONLY: CFRAC_ICE_SHALLOW_MF
USE MODD_PARAM_MFSHALL_n
use modd_precision, only: MNHTIME
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODI_BUDGET
USE MODI_DIAGNOS_LES_MF
USE MODI_SHALLOW_MF
USE MODI_SHUMAN
@@ -156,8 +157,6 @@ CHARACTER (LEN=4), INTENT(IN) :: HMF_UPDRAFT! Type of Mass Flux Scheme
CHARACTER (LEN=4), INTENT(IN) :: HMF_CLOUD ! Type of statistical cloud
! scheme
LOGICAL, INTENT(IN) :: OMIXUV ! True if mixing of momentum
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for synchronous
- ! file opening
LOGICAL, INTENT(IN) :: OMF_FLX ! switch to write the
! MF fluxes in the synchronous FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -276,6 +275,16 @@ IRR=SIZE(PRM,4)
! number of scalar var
ISV=SIZE(PSVM,4)
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'MAFL', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'MAFL', prvs (:, :, :) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'MAFL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'MAFL', prrs (:, :, :, 1) )
+if ( lbudget_sv ) then
+ do jsv = 1, isv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'MAFL', prsvs(:, :, :, jsv) )
+ end do
+end if
+
ZSVM(:,:,:) = 0.
!
!
@@ -371,18 +380,19 @@ DO JSV=1,ISV
END DO
!!! 7. call to MesoNH budgets
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'MAFL', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'MAFL', prvs (:, :, :) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'MAFL', prths(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'MAFL', prrs (:, :, :, 1) )
+if ( lbudget_sv ) then
+ do jsv = 1, isv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'MAFL', prsvs(:, :, :, jsv) )
+ end do
+end if
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'MAFL_BU_RTH')
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'MAFL_BU_RRV')
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'MAFL_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'MAFL_BU_RV')
-DO JSV=1,ISV
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),12+JSV,'MAFL_BU_RSV')
-END DO
-
!!! 8. Prints the fluxes in output file
!
-IF ( OMF_FLX .AND. OCLOSE_OUT ) THEN
+IF ( OMF_FLX .AND. tpfile%lopened ) THEN
! stores the conservative potential temperature vertical flux
ZWORK(:,:,:)=RESHAPE(ZFLXZTHMF (:,:),(/ IIU,IJU,IKU /) )
TZFIELD%CMNHNAME = 'MF_THW_FLX'
diff --git a/src/MNH/slow_terms.f90 b/src/MNH/slow_terms.f90
index 4874d71b73317339803dd7f493fa8645772c3d33..9b9149fec84aaffd196695d57cac565929415098 100644
--- a/src/MNH/slow_terms.f90
+++ b/src/MNH/slow_terms.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -111,7 +111,6 @@ END MODULE MODI_SLOW_TERMS
!! 'CART' for cartesian box configuration
!! 'MASK' for budget zone defined by a mask
!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
!! LBU_RTH : logical for budget of RTH (potential temperature)
!! .TRUE. = budget of RTH
!! .FALSE. = no budget of RTH
@@ -151,23 +150,26 @@ END MODULE MODI_SLOW_TERMS
!! 06/11/02 (V. Masson) update the budget calls
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
! P. Wautelet 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET, only: LBUDGET_RC, LBUDGET_RR, LBUDGET_RV, LBUDGET_TH
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, &
+ tbudgets
USE MODD_CLOUDPAR, only: XC1RC, XC2RC, XC1RE, XC2RE, XCEXRA, XCEXRE, XCEXRS, XCEXVT, XCRA, XCRS, XDIVA, XTHCO
USE MODD_CST, only: XALPW, XBETAW, XGAMW, XCL, XCPD, XCPV, XLVTT, XMD, XMV, XP00, XRD, XRHOLW, XRV, XTT
USE MODD_PARAMETERS, only: JPVEXT
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_mppdb
#ifdef MNH_BITREP
use modi_bitrep
#endif
-USE MODI_BUDGET
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
@@ -272,6 +274,7 @@ END DO
!* 2. COMPUTE THE SEDIMENTATION (RS) SOURCE
! -------------------------------------
!
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
!
!* 2.1 time splitting loop initialization
!
@@ -376,10 +379,7 @@ PRRS(:,:,:) = ZW1(:,:,:) / PTSTEP
!
!* 2.5 budget storage
!
-IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'SEDI_BU_RRR')
-END IF
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'SEDI', prrs(:, :, :) * prhodj(:, :, :) )
!
!-------------------------------------------------------------------------------
!
@@ -387,6 +387,8 @@ END IF
!* 3. COMPUTES THE ACCRETION SOURCE
! -----------------------------
!
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'ACCR', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'ACCR', prrs(:, :, :) * prhodj(:, :, :) )
!
!* 3.1 compute the accretion and update the tendencies
!
@@ -411,14 +413,8 @@ END WHERE
!
!* 3.2 budget storage
!
-IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'ACCR_BU_RRC')
-END IF
-IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'ACCR_BU_RRR')
-END IF
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'ACCR', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'ACCR', prrs(:, :, :) * prhodj(:, :, :) )
!
!-------------------------------------------------------------------------------
!
@@ -426,6 +422,8 @@ END IF
!* 4. COMPUTES THE AUTOCONVERSION SOURCE
! ----------------------------------
!
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
!
!* 4.1 compute the autoconversion and update the tendencies
!
@@ -452,20 +450,18 @@ END IF
!
!* 4.2 budget storage
!
-IF (LBUDGET_RC) THEN
-!$acc update self(PRCS)
- CALL BUDGET (PRCS(:,:,:)*PRHODJ(:,:,:),7,'AUTO_BU_RRC')
-END IF
-IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'AUTO_BU_RRR')
-END IF
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'AUTO', prcs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'AUTO', prrs(:, :, :) * prhodj(:, :, :) )
!
!-------------------------------------------------------------------------------
!
!* 5. COMPUTES THE RAIN EVAPORATION (RE) SOURCE
! -----------------------------------------
!
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
+
!$acc kernels
PEVAP3D(:,:,:)=0.
G3D(:,:,:) = PRRT(:,:,:)>0.0 .AND. PRCT(:,:,:)==0.0
@@ -537,18 +533,9 @@ END WHERE
!
!* 5.8 budget storage
!
-IF (LBUDGET_RV) THEN
-!$acc update self(PRVS)
- CALL BUDGET (PRVS(:,:,:)*PRHODJ(:,:,:),6,'REVA_BU_RRV')
-END IF
-IF (LBUDGET_RR) THEN
-!$acc update self(PRRS)
- CALL BUDGET (PRRS(:,:,:)*PRHODJ(:,:,:),8,'REVA_BU_RRR')
-END IF
-IF (LBUDGET_TH) THEN
-!$acc update self(PTHS)
- CALL BUDGET (PTHS(:,:,:)*PRHODJ(:,:,:),4,'REVA_BU_RTH')
-END IF
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'REVA', pths(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'REVA', prvs(:, :, :) * prhodj(:, :, :) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'REVA', prrs(:, :, :) * prhodj(:, :, :) )
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/sources_neg_correct.f90 b/src/MNH/sources_neg_correct.f90
new file mode 100644
index 0000000000000000000000000000000000000000..81d49856c651454e06a50734e65120171de54dca
--- /dev/null
+++ b/src/MNH/sources_neg_correct.f90
@@ -0,0 +1,359 @@
+!MNH_LIC Copyright 2020-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! Author: P. Wautelet 25/06/2020 (deduplication of code from advection_metsv, resolved_cloud and turb)
+! Modifications:
+! P. Wautelet 30/06/2020: remove non-local corrections in resolved_cloud for NEGA => new local corrections here
+! J. Escobar 21/07/2020: bug <-> array of size(:,:,:,0) => return if krr=0
+! P. Wautelet 10/02/2021: budgets: add missing sources for NSV_C2R2BEG+3 budget
+!-----------------------------------------------------------------
+module mode_sources_neg_correct
+
+implicit none
+
+private
+
+public :: Sources_neg_correct
+
+contains
+
+subroutine Sources_neg_correct( hcloud, hbudname, krr, ptstep, ppabst, ptht, prt, prths, prrs, prsvs, prhodj )
+
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_rc, lbudget_rr, lbudget_ri, &
+ lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, NBUDGET_RR, NBUDGET_RI, &
+ NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ 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, lspro_lima => lspro, lwarm_lima => lwarm, &
+ xctmin_lima => xctmin, xrtmin_lima => xrtmin
+
+use mode_budget, only: Budget_store_init, Budget_store_end
+use mode_msg
+
+implicit none
+
+character(len=*), intent(in) :: hcloud ! Kind of cloud parameterization
+character(len=*), intent(in) :: hbudname ! Budget name
+integer, intent(in) :: krr ! Number of moist variables
+real, intent(in) :: ptstep ! Timestep
+real, dimension(:, :, :), intent(in) :: ppabst ! Absolute pressure at time t
+real, dimension(:, :, :), intent(in) :: ptht ! Theta at time t
+real, dimension(:, :, :, :), intent(in) :: prt ! Moist variables at time t
+real, dimension(:, :, :), intent(inout) :: prths ! Source terms
+real, dimension(:, :, :, :), intent(inout) :: prrs ! Source terms
+real, dimension(:, :, :, :), intent(inout) :: prsvs ! Source terms
+real, dimension(:, :, :), intent(in), optional :: prhodj ! Dry density * jacobian
+
+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
+
+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
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), Trim( hbudname ), prths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), Trim( hbudname ), prrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), Trim( hbudname ), prrs (:, :, :, 2) )
+ if ( lbudget_rr .and. &
+ ( hbudname /= 'NETUR' .or. &
+ ( hbudname == 'NETUR' .and. ( hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'LIMA' ) ) ) ) &
+ call Budget_store_init( tbudgets(NBUDGET_RR), Trim( hbudname ), prrs (:, :, :, 3) )
+ IF (lbudget_ri .and. &
+ ( hbudname /= 'NETUR' .or. &
+ ( hbudname == 'NETUR' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' ) ) ) ) &
+ call Budget_store_init( tbudgets(NBUDGET_RI), Trim( hbudname ), prrs (:, :, :, 4) )
+ if ( lbudget_rs .and. hbudname /= 'NETUR' ) call Budget_store_init( tbudgets(NBUDGET_RS), Trim( hbudname ), prrs (:, :, :, 5) )
+ if ( lbudget_rg .and. hbudname /= 'NETUR' ) call Budget_store_init( tbudgets(NBUDGET_RG), Trim( hbudname ), prrs (:, :, :, 6) )
+ if ( lbudget_rh .and. hbudname /= 'NETUR' ) call Budget_store_init( tbudgets(NBUDGET_RH), Trim( hbudname ), prrs (:, :, :, 7) )
+ end if
+
+ if ( lbudget_sv .and. ( hcloud == 'C2R2' .or. hcloud == 'KHKO' ) ) then
+ do ji = nsv_c2r2beg, nsv_c2r2end
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
+ end do
+ end if
+ if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ 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
+else !NECON + NEGA
+ if ( .not. present( prhodj ) ) &
+ call Print_msg( NVERB_FATAL, 'GEN', 'Sources_neg_correct', 'optional argument prhodj not present' )
+
+ if ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. &
+ hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then
+ if ( lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), Trim( hbudname ), prths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv) call Budget_store_init( tbudgets(NBUDGET_RV), Trim( hbudname ), prrs (:, :, :, 1) * prhodj(:, :, :) )
+ if ( lbudget_rc) call Budget_store_init( tbudgets(NBUDGET_RC), Trim( hbudname ), prrs (:, :, :, 2) * prhodj(:, :, :) )
+ if ( lbudget_rr) call Budget_store_init( tbudgets(NBUDGET_RR), Trim( hbudname ), prrs (:, :, :, 3) * prhodj(:, :, :) )
+ if ( lbudget_ri) call Budget_store_init( tbudgets(NBUDGET_RI), Trim( hbudname ), prrs (:, :, :, 4) * prhodj(:, :, :) )
+ if ( lbudget_rs) call Budget_store_init( tbudgets(NBUDGET_RS), Trim( hbudname ), prrs (:, :, :, 5) * prhodj(:, :, :) )
+ if ( lbudget_rg) call Budget_store_init( tbudgets(NBUDGET_RG), Trim( hbudname ), prrs (:, :, :, 6) * prhodj(:, :, :) )
+ if ( lbudget_rh) call Budget_store_init( tbudgets(NBUDGET_RH), Trim( hbudname ), prrs (:, :, :, 7) * prhodj(:, :, :) )
+ end if
+
+ if ( lbudget_sv .and. ( hcloud == 'C2R2' .or. hcloud == 'KHKO' ) ) then
+ do ji = nsv_c2r2beg, nsv_c2r2end
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
+ end do
+ end if
+ if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ 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
+end if
+
+allocate( zt ( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+allocate( zexn( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+allocate( zlv ( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+allocate( zcph( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+
+zexn(:, :, :) = ( ppabst(:, :, :) / xp00 ) ** (xrd / xcpd )
+zt (:, :, :) = ptht(:, :, :) * zexn(:, :, :)
+zlv (:, :, :) = xlvtt + ( xcpv - xcl ) * ( zt(:, :, :) - xtt )
+if ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' ) then
+ allocate( zls( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ zls(:, :, :) = xlstt + ( xcpv - xci ) * ( zt(:, :, :) - xtt )
+end if
+zcph(:, :, :) = xcpd + xcpv * prt(:, :, :, 1)
+
+deallocate( zt )
+
+CLOUD: select case ( hcloud )
+ case ( 'KESS' )
+ jrmax = Size( prrs, 4 )
+ do jr = 2, jrmax
+ where ( prrs(:, :, :, jr) < 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ end where
+ end do
+
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ end where
+
+
+ case( 'ICE3', 'ICE4' )
+ if ( hbudname == 'NETUR' ) then
+ jrmax = 4
+ else
+ jrmax = Size( prrs, 4 )
+ end if
+ do jr = 4, jrmax
+ where ( prrs(:, :, :, jr) < 0.)
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ end where
+ end do
+!
+! cloud
+ if ( hbudname == 'NETUR' ) then
+ jrmax = 2
+ else
+ jrmax = 3
+ end if
+ do jr = 2, jrmax
+ where ( prrs(:, :, :, jr) < 0.)
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ end where
+ end do
+!
+! if rc or ri are positive, we can correct negative rv
+! cloud
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ end where
+! ice
+ if ( krr > 3 ) then
+ allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
+ zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
+ prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ end where
+ end if
+!
+!
+ case( 'C2R2', 'KHKO' )
+ where ( prrs(:, :, :, 2) < 0. .or. prsvs(:, :, :, nsv_c2r2beg + 1) < 0. )
+ prsvs(:, :, :, nsv_c2r2beg) = 0.
+ end where
+ do jsv = 2, 3
+ where ( prrs(:, :, :, jsv) < 0. .or. prsvs(:, :, :, nsv_c2r2beg - 1 + jsv) < 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jsv)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jsv) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jsv) = 0.
+ prsvs(:, :, :, nsv_c2r2beg - 1 + jsv) = 0.
+ end where
+ end do
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ prsvs(:, :, :, nsv_c2r2beg + 1) = 0.
+ end where
+!
+!
+ case( 'LIMA' )
+! Correction where rc<0 or Nc<0
+ if ( lwarm_lima ) then
+ where ( prrs(:, :, :, 2) < xrtmin_lima(2) / ptstep .or. prsvs(:, :, :, nsv_lima_nc) < xctmin_lima(2) / ptstep )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ prsvs(:, :, :, nsv_lima_nc) = 0.
+ end where
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 2) > 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 2)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 2) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 2) = 0.
+ prsvs(:, :, :, nsv_lima_nc) = 0.
+ end where
+ end if
+! Correction where rr<0 or Nr<0
+ if ( lwarm_lima .and. lrain_lima ) then
+ where ( prrs(:, :, :, 3) < xrtmin_lima(3) / ptstep .or. prsvs(:, :, :, nsv_lima_nr) < xctmin_lima(3) / ptstep )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 3)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 3) * zlv(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 3) = 0.
+ prsvs(:, :, :, nsv_lima_nr) = 0.
+ end where
+ end if
+! Correction where ri<0 or Ni<0
+ if ( lcold_lima ) then
+ where ( prrs(:, :, :, 4) < xrtmin_lima(4) / ptstep .or. prsvs(:, :, :, nsv_lima_ni) < xctmin_lima(4) / ptstep )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, 4)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, 4) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 4) = 0.
+ prsvs(:, :, :, nsv_lima_ni) = 0.
+ end where
+ if ( hbudname /= 'NETUR' ) then
+ do jr = 5, Size( prrs, 4 )
+ where ( prrs(:, :, :, jr) < 0. )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + prrs(:, :, :, jr)
+ prths(:, :, :) = prths(:, :, :) - prrs(:, :, :, jr) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, jr) = 0.
+ end where
+ end do
+ end if
+ if(krr > 3) then
+ allocate( zcor( Size( prths, 1 ), Size( prths, 2 ), Size( prths, 3 ) ) )
+ where ( prrs(:, :, :, 1) < 0. .and. prrs(:, :, :, 4) > 0. )
+ zcor(:, :, :) = Min( -prrs(:, :, :, 1), prrs(:, :, :, 4) )
+ prrs(:, :, :, 1) = prrs(:, :, :, 1) + zcor(:, :, :)
+ prths(:, :, :) = prths(:, :, :) - zcor(:, :, :) * zls(:, :, :) / &
+ ( zcph(:, :, :) * zexn(:, :, :) )
+ prrs(:, :, :, 4) = prrs(:, :, :, 4) - zcor(:, :, :)
+ end where
+ deallocate( zcor )
+ end if
+ end if
+
+ prsvs(:, :, :, nsv_lima_beg : isv_lima_end) = Max( 0.0, prsvs(:, :, :, nsv_lima_beg : isv_lima_end) )
+
+end select CLOUD
+
+
+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
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), Trim( hbudname ), prths(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), Trim( hbudname ), prrs (:, :, :, 1) )
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), Trim( hbudname ), prrs (:, :, :, 2) )
+ if ( lbudget_rr .and. &
+ ( hbudname /= 'NETUR' .or. &
+ ( hbudname == 'NETUR' .and. ( hcloud == 'C2R2' .or. hcloud == 'KHKO' .or. hcloud == 'LIMA' ) ) ) ) &
+ call Budget_store_end( tbudgets(NBUDGET_RR), Trim( hbudname ), prrs (:, :, :, 3) )
+ IF (lbudget_ri .and. &
+ ( hbudname /= 'NETUR' .or. &
+ ( hbudname == 'NETUR' .and. ( hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. hcloud == 'LIMA' ) ) ) ) &
+ call Budget_store_end( tbudgets(NBUDGET_RI), Trim( hbudname ), prrs (:, :, :, 4) )
+ if ( lbudget_rs .and. hbudname /= 'NETUR' ) call Budget_store_end( tbudgets(NBUDGET_RS), Trim( hbudname ), prrs (:, :, :, 5) )
+ if ( lbudget_rg .and. hbudname /= 'NETUR' ) call Budget_store_end( tbudgets(NBUDGET_RG), Trim( hbudname ), prrs (:, :, :, 6) )
+ if ( lbudget_rh .and. hbudname /= 'NETUR' ) call Budget_store_end( tbudgets(NBUDGET_RH), Trim( hbudname ), prrs (:, :, :, 7) )
+ end if
+
+ if ( lbudget_sv .and. ( hcloud == 'C2R2' .or. hcloud == 'KHKO' ) ) then
+ do ji = nsv_c2r2beg, nsv_c2r2end
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) )
+ end do
+ end if
+ if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ 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
+else !NECON + NEGA
+ if ( hcloud == 'KESS' .or. hcloud == 'ICE3' .or. hcloud == 'ICE4' .or. &
+ hcloud == 'KHKO' .or. hcloud == 'C2R2' .or. hcloud == 'LIMA' ) then
+ if ( lbudget_th) call Budget_store_end( tbudgets(NBUDGET_TH), Trim( hbudname ), prths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv) call Budget_store_end( tbudgets(NBUDGET_RV), Trim( hbudname ), prrs (:, :, :, 1) * prhodj(:, :, :) )
+ if ( lbudget_rc) call Budget_store_end( tbudgets(NBUDGET_RC), Trim( hbudname ), prrs (:, :, :, 2) * prhodj(:, :, :) )
+ if ( lbudget_rr) call Budget_store_end( tbudgets(NBUDGET_RR), Trim( hbudname ), prrs (:, :, :, 3) * prhodj(:, :, :) )
+ if ( lbudget_ri) call Budget_store_end( tbudgets(NBUDGET_RI), Trim( hbudname ), prrs (:, :, :, 4) * prhodj(:, :, :) )
+ if ( lbudget_rs) call Budget_store_end( tbudgets(NBUDGET_RS), Trim( hbudname ), prrs (:, :, :, 5) * prhodj(:, :, :) )
+ if ( lbudget_rg) call Budget_store_end( tbudgets(NBUDGET_RG), Trim( hbudname ), prrs (:, :, :, 6) * prhodj(:, :, :) )
+ if ( lbudget_rh) call Budget_store_end( tbudgets(NBUDGET_RH), Trim( hbudname ), prrs (:, :, :, 7) * prhodj(:, :, :) )
+ end if
+
+ if ( lbudget_sv .and. ( hcloud == 'C2R2' .or. hcloud == 'KHKO' ) ) then
+ do ji = nsv_c2r2beg, nsv_c2r2end
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ji), Trim( hbudname ), prsvs(:, :, :, ji) * prhodj(:, :, :) )
+ end do
+ end if
+ if ( lbudget_sv .and. hcloud == 'LIMA' ) then
+ 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
+end if
+
+end subroutine Sources_neg_correct
+
+end module mode_sources_neg_correct
diff --git a/src/MNH/spawn_field2.f90 b/src/MNH/spawn_field2.f90
index 62d152167dcaf4ba6853784893d1229937f27d4e..44aa7c3ce0835e7c48c58e373e25a9c06ff8c636 100644
--- a/src/MNH/spawn_field2.f90
+++ b/src/MNH/spawn_field2.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -155,6 +155,8 @@ 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
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -170,6 +172,7 @@ USE MODD_CST
USE MODD_CONF_n, ONLY: CONF_MODEL
USE MODD_DUST, ONLY: CDUSTNAMES
USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_FIELD_n, ONLY: FIELD_MODEL, XZWS_DEFAULT
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LATZ_EDFLX
@@ -189,7 +192,6 @@ USE MODD_SALT, ONLY: CSALTNAMES
USE MODD_SPAWN
!
use mode_bikhardt
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_ll
USE MODE_MSG
@@ -277,7 +279,6 @@ LOGICAL :: GUSERV
!
CHARACTER(LEN=15) :: YVAL
CHARACTER(LEN=2) :: INDICE
-INTEGER :: I
TYPE(TFIELDDATA) :: TZFIELD
!
!-------------------------------------------------------------------------------
@@ -926,16 +927,18 @@ IF (PRESENT(TPSONFILE)) THEN
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(3))//INDICE//'T'
END IF
! N IMM nucl
- I = 0
IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN
- I = I + 1
- WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(I))
+ WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(JSV - NSV_LIMA_IMM_NUCL + 1))
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(4))//INDICE//'T'
END IF
! Hom. freez. of CCN
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 ff2edc1eaabb3935cb93357fdb1430abe4e042a5..7d286b6eefcd54cd57468413da56fb828b8fdbba 100644
--- a/src/MNH/spawn_model2.f90
+++ b/src/MNH/spawn_model2.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -198,6 +198,9 @@ END MODULE MODI_SPAWN_MODEL2
! P. Wautelet 14/03/2019: correct ZWS when variable not present in file
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+! P. Wautelet 09/03/2021: move some chemistry initializations to ini_nsv
+! P. Wautelet 24/03/2021: bugfix: allocate XLSRVM, XINPAP and XACPAP to zero size when not needed
+!! 03/2021 (JL Redelsperger) Ocean model case
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -260,7 +263,6 @@ USE MODI_INI_BIKHARDT_n
USE MODI_DEALLOCATE_MODEL1
USE MODI_BOUNDARIES
USE MODI_INI_NSV
-USE MODI_CH_INIT_SCHEME_n
!$20140710
USE MODI_UPDATE_METRICS
!
@@ -577,7 +579,6 @@ IF (NSV_CHEM>0) THEN
LUSECHIC=.TRUE.
ENDIF
CCHEM_INPUT_FILE = HCHEM_INPUT_FILE
- CALL CH_INIT_SCHEME_n(1,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT,NVERB)
END IF
!
CTURB = HTURB ! for MODD_PARAM2
@@ -589,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
@@ -767,6 +768,8 @@ ALLOCATE(XLSWM(IIU,IJU,IKU))
ALLOCATE(XLSTHM(IIU,IJU,IKU))
IF ( NRR >= 1) THEN
ALLOCATE(XLSRVM(IIU,IJU,IKU))
+ELSE
+ ALLOCATE(XLSRVM(0,0,0))
ENDIF
! LB fields for lbc coupling
!
@@ -932,6 +935,9 @@ IF ( CCLOUD=='LIMA' .AND. LSCAV ) THEN
ALLOCATE(XACPAP(IIU,IJU))
XINPAP(:,:)=0.0
XACPAP(:,:)=0.0
+ELSE
+ ALLOCATE(XINPAP(0,0))
+ ALLOCATE(XACPAP(0,0))
END IF
!
! 4.8bis electric variables
@@ -1374,8 +1380,13 @@ ENDIF
ZTIME1 = ZTIME2
!
ALLOCATE(ZRHOD(IIU,IJU,IKU))
-ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
- /(XRD*ZTHVT(:,:,:)*(1.+ZSUMRT(:,:,:)))
+!
+IF (LOCEAN) THEN
+ ZRHOD(:,:,:)=XRH00OCEAN*(1.-XALPHAOC*(ZTHVT(:,:,:)-XTH00OCEAN)+XBETAOC*(XRT(:,:,:,1)-XSA00OCEAN))
+ELSE
+ ZRHOD(:,:,:)=XPABST(:,:,:)/(XPABST(:,:,:)/XP00)**(XRD/XCPD) &
+ /(XRD*ZTHVT(:,:,:)*(1.+ZSUMRT(:,:,:)))
+ENDIF
!$20140709
CALL MPPDB_CHECK3D(ZRHOD,"SPAWN_MOD2:ZRHOD",PRECISION)
CALL MPPDB_CHECK3D(XPABST,"SPAWN_MOD2:XPABST",PRECISION)
@@ -1413,7 +1424,7 @@ IF (.NOT. L1D) THEN
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
XLBXUM,XLBXVM,XLBXWM,XLBXTHM,XLBXTKEM,XLBXRM,XLBXSVM, &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
- XRHODJ, &
+ XRHODJ,XRHODREF, &
XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
END IF
!
@@ -1520,6 +1531,7 @@ IF (NVERB >= 5) THEN
WRITE(ILUOUT,*) 'SPAWN_MODEL2: NVERB=',NVERB
WRITE(ILUOUT,*) 'SPAWN_MODEL2: XLON0,XLAT0,XBETA=',XLON0,XLAT0,XBETA
WRITE(ILUOUT,*) 'SPAWN_MODEL2: LCARTESIAN=',LCARTESIAN
+ WRITE(ILUOUT,*) 'SPAWN_MODEL2: LOCEAN,LCOUPLES=',LOCEAN,LCOUPLES
IF(LCARTESIAN) THEN
WRITE(ILUOUT,*) 'SPAWN_MODEL2: No map projection used.'
ELSE
diff --git a/src/MNH/spawn_surf.f90 b/src/MNH/spawn_surf.f90
index deee96b3bd6a5bf44d5f35efadbafaa9a45f2e19..11f53dd211f1d1146666e5abdcfd9b54de769aba 100644
--- a/src/MNH/spawn_surf.f90
+++ b/src/MNH/spawn_surf.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2004-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -133,9 +133,8 @@ IF (CSURF=='EXTE') THEN
ALLOCATE(YSURF_CUR%DUO%CSELECT(0))
CALL WRITE_PGD_SURF_ATM_n(YSURF_CUR,'MESONH')
!* rereading of physiographic fields and definition of prognostic fields
- CALL INIT_PGD_SURF_ATM(YSURF_CUR,'MESONH','PRE',HINIFILE,'MESONH', &
- TDTCUR%TDATE%YEAR, TDTCUR%TDATE%MONTH, &
- TDTCUR%TDATE%DAY, TDTCUR%TIME )
+ CALL INIT_PGD_SURF_ATM( YSURF_CUR, 'MESONH', 'PRE', HINIFILE, 'MESONH', &
+ TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime )
CALL PREP_SURF_ATM(YSURF_CUR,'MESONH',HINIFILE,'MESONH',HINIFILEPGD,'MESONH',YLCTL)
!* writing of all surface fields
CALL WRITE_SURF_ATM_n(YSURF_CUR,'MESONH','ALL',.FALSE.)
diff --git a/src/MNH/spawning.f90 b/src/MNH/spawning.f90
index 2480473be3a44be2ae754e179093f444bf3c264b..15c7d98b76f599f4f2b5329cc09333df5c484bfb 100644
--- a/src/MNH/spawning.f90
+++ b/src/MNH/spawning.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 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.
@@ -76,7 +76,9 @@
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 07/02/2019: remove OPARALLELIO argument from open and close files subroutines
! (nsubfiles_ioz is now determined in IO_File_add2list)
-!! 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 11/02/2020: bugfix: close TINIFILEPGD only if previously opened
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -93,7 +95,7 @@ USE MODD_LUNIT
USE MODD_PARAMETERS
USE MODD_REF
USE MODD_SPAWN
-USE MODN_BLANK
+USE MODN_BLANK_n
USE MODD_NSV
USE MODN_CONFZ
!
@@ -104,7 +106,7 @@ USE MODD_CURVCOR_n
USE MODD_DIM_n
USE MODD_DYN_n, LRES_n=>LRES, XRES_n=>XRES
USE MODD_FIELD_n
-USE MODD_IO, ONLY: NIO_VERB,NVERB_DEBUG,TFILEDATA
+USE MODD_IO, only: TFILEDATA
USE MODD_LSFIELD_n
USE MODD_LBC_n
USE MODD_LUNIT_n
@@ -115,9 +117,10 @@ USE MODD_TIME_n
USE MODD_CH_MNHC_n
USE MODD_GRID_n
!
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_IO, only: IO_Init
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_File_find_byname, IO_Filelist_print
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_File_find_byname
USE MODE_ll
USE MODE_POS
USE MODE_MODELN_HANDLER
@@ -127,7 +130,6 @@ USE MODI_BOUNDARIES
!
USE MODI_VERSION
USE MODI_INIT_MNH
-USE MODD_MNH_SURFEX_n
USE MODE_MPPDB
!
!
@@ -191,8 +193,12 @@ CALL INIT_NMLVAR
CALL POSNAM(ILUSPA,'NAM_SPAWN_SURF',GFOUND)
IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_SPAWN_SURF)
CALL UPDATE_MODD_FROM_NMLVAR
-CALL POSNAM(ILUSPA,'NAM_BLANK',GFOUND)
-IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_BLANK)
+CALL POSNAM(ILUSPA,'NAM_BLANKN',GFOUND)
+CALL INIT_NAM_BLANKn
+IF (GFOUND) THEN
+ READ(UNIT=ILUSPA,NML=NAM_BLANKn)
+ CALL UPDATE_NAM_BLANKn
+END IF
CALL POSNAM(ILUSPA,'NAM_CONFZ',GFOUND)
IF (GFOUND) READ(UNIT=ILUSPA,NML=NAM_CONFZ)
CALL POSNAM(ILUSPA,'NAM_CONF_SPAWN',GFOUND)
@@ -208,7 +214,7 @@ CALL INIT_MNH
!
CALL IO_File_find_byname(TRIM(CINIFILE),TZINIFILE,IRESP)
CALL IO_File_close(TZINIFILE)
-CALL IO_File_close(TINIFILEPGD)
+IF ( TINIFILEPGD%LOPENED ) CALL IO_File_close(TINIFILEPGD)
!-------------------------------------------------------------------------------
!
!* 4. INITIALIZATION OF OUTER POINTS OF MODEL 1
@@ -220,7 +226,7 @@ CALL BOUNDARIES &
XLBYUM,XLBYVM,XLBYWM,XLBYTHM,XLBYTKEM,XLBYRM,XLBYSVM, &
XLBXUS,XLBXVS,XLBXWS,XLBXTHS,XLBXTKES,XLBXRS,XLBXSVS, &
XLBYUS,XLBYVS,XLBYWS,XLBYTHS,XLBYTKES,XLBYRS,XLBYSVS, &
- XRHODJ, &
+ XRHODJ,XRHODREF, &
XUT, XVT, XWT, XTHT, XTKET, XRT, XSVT, XSRCT )
CALL MPPDB_CHECK3D(XUT,"SPAWNING-after boundaries::XUT",PRECISION)
!
@@ -247,13 +253,8 @@ CALL SPAWN_MODEL2 (NRR,NSV_USER,CTURB,CSURF,CCLOUD, &
CCHEM_INPUT_FILE,YSPAFILE,YSPANBR,YSONFILE, &
CINIFILE, CINIFILEPGD, LSPAWN_SURF )
!
-CALL SURFEX_DEALLO_LIST
-!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
-!
-CALL IO_File_close(TLUOUT)
-!
-CALL END_PARA_ll(IINFO_ll)
+CALL FINALIZE_MNH()
+
CONTAINS
diff --git a/src/MNH/spec_ver_int.f90 b/src/MNH/spec_ver_int.f90
index 752f233df40446b29a850a818645f6c1f8b4be42..c09b57ffdfcc749dba786f4d11c2d47feb42ffe7 100644
--- a/src/MNH/spec_ver_int.f90
+++ b/src/MNH/spec_ver_int.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-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 for details. version 1.
@@ -51,8 +51,9 @@ END MODULE MODI_SPEC_VER_INT
!! Original 07/02/00
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
-!!
-!! --------------------------------------------------------------------------
+! P. Wautelet 05/01/2021: bugfix: CSPECTRA_LEVEL_TYPE='Z' computation was wrong
+! P. Wautelet 30/03/2021: budgets: LES cartesian subdomain limits are defined in the physical domain
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -96,13 +97,13 @@ IF (CSPECTRA_LEVEL_TYPE=='N') THEN
RETURN
ELSE IF (CSPECTRA_LEVEL_TYPE=='K') THEN
DO JK = 1, NSPECTRA_K
- ZA(:,:,JK) = PA_MNH(:,:,NSPECTRA_LEVELS(JK))
+ ZA(:,:,JK) = PA_MNH(:,:,NSPECTRA_LEVELS(JK) + JPVEXT)
END DO
ELSE IF (CSPECTRA_LEVEL_TYPE=='Z') THEN
- PA_SPEC = VER_INTERP_LIN(PA_MNH,NKLIN_CURRENT_SPEC,XCOEFLIN_CURRENT_SPEC)
+ ZA(:,:,:) = VER_INTERP_LIN(PA_MNH,NKLIN_CURRENT_SPEC,XCOEFLIN_CURRENT_SPEC)
!
WHERE(NKLIN_CURRENT_SPEC<2)
- PA_SPEC = XUNDEF
+ ZA(:,:,:) = XUNDEF
END WHERE
ELSE
call Print_msg( NVERB_FATAL, 'GEN', 'SPEC_VER_INT', 'invalid CSPECTRA_LEVEL_TYPE ('//CSPECTRA_LEVEL_TYPE//')' )
@@ -121,7 +122,7 @@ CALL GATHERALL_FIELD_ll('XY',ZA,ZA_ll,IRESP)
!
!-------------------------------------------------------------------------------
!
-PA_SPEC(:,:,:) = ZA_ll(NLESn_IINF(KMI):NLESn_ISUP(KMI),NLESn_JINF(KMI):NLESn_JSUP(KMI),:)
+PA_SPEC(:,:,:) = ZA_ll(NLESn_IINF(KMI)+JPHEXT:NLESn_ISUP(KMI)+JPHEXT,NLESn_JINF(KMI)+JPHEXT:NLESn_JSUP(KMI)+JPHEXT,:)
!
DO JK=1,SIZE(PA_SPEC,3)
ZA_MEAN(JK) = SUM(PA_SPEC(:,:,JK)) / SIZE(PA_SPEC(:,:,JK))
diff --git a/src/MNH/spectre.f90 b/src/MNH/spectre.f90
index 545c60629410ef29c5a16bfd5289f96038c41e28..a87838c936e9c344c04f5fcc40325dac525eeab5 100644
--- a/src/MNH/spectre.f90
+++ b/src/MNH/spectre.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2011-2019 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 for details. version 1.
@@ -17,7 +17,8 @@
!!
!!
!! Modifications:
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -25,8 +26,7 @@
!
!
USE MODD_CONF
-USE MODD_IO, ONLY: NIO_VERB,NVERB_DEBUG,TFILEDATA
-USE MODD_LUNIT
+USE MODD_IO, only: TFILEDATA
USE MODD_LUNIT_n
USE MODD_TIME_n
USE MODD_DIM_ll
@@ -35,13 +35,13 @@ USE MODD_SPECTRE
USE MODI_SPECTRE_MESONH
USE MODI_SPECTRE_AROME
!
-USE MODE_MSG
-USE MODE_POS
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_IO, only: IO_Config_set, IO_Init
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_Filelist_print
-use mode_init_ll, only: END_PARA_ll
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_MODELN_HANDLER
+USE MODE_MSG
+USE MODE_POS
!USE MODD_TYPE_DATE
USE MODI_VERSION
!
@@ -60,8 +60,6 @@ INTEGER :: ILUNAM ! Logical unit numbers for the
! and for output_listing file
LOGICAL :: GFOUND ! Return code when searching namelist
!
-INTEGER :: IINFO_ll ! return code for _ll routines
-!
REAL,DIMENSION(:,:,:),ALLOCATABLE:: ZWORK ! work array
REAL,DIMENSION(:,:,:),ALLOCATABLE:: ZWORKAROME ! work array
INTEGER :: NI,NJ,NK
@@ -191,9 +189,6 @@ IF (CTYPEFILE=='MESONH') THEN
CALL SPECTRE_MESONH(YOUTFILE)
!
CALL IO_File_close(LUNIT_MODEL(1)%TINIFILE)
- IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
- CALL IO_File_close(TLUOUT0)
- CALL IO_File_close(TLUOUT)
ELSEIF (CTYPEFILE=='AROME ')THEN
CALL SPECTRE_AROME(CINIFILE,YOUTFILE,XDELTAX,XDELTAY,NI,NJ,NK)
ELSE
@@ -205,8 +200,8 @@ ENDIF
!* 4. FINALIZE THE PARALLEL SESSION
! -----------------------------
!
-CALL END_PARA_ll(IINFO_ll)
-!
+CALL FINALIZE_MNH()
+
PRINT*, ' '
PRINT*, '****************************************************'
PRINT*, '* EXIT SPECTRE CORRECTLY *'
diff --git a/src/MNH/split_grid_parameter_mnh.f90 b/src/MNH/split_grid_parameter_mnh.f90
index e859565f1512b167ef76f96a8a8c1856968428b8..e04ff2ea5a2065123e3abf22bf0d58a0a26b1f17 100644
--- a/src/MNH/split_grid_parameter_mnh.f90
+++ b/src/MNH/split_grid_parameter_mnh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2011-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2011-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -11,7 +11,7 @@
#endif
! #############################################################
!
-!!**** * - routine to split a real array on the splitted grid
+!!**** * - routine to split a real array on the split grid
!
! Modifications
! M.Moge 10/02/2015 Using local subdomain for parallel execution
@@ -39,7 +39,7 @@ INTEGER, INTENT(IN) :: KJMAX_ll !(global) dimension of the dom
INTEGER, INTENT(IN) :: KHALO ! size of the Halo
#endif
REAL, DIMENSION(KDIM ), INTENT(IN) :: PFIELD ! real field for complete grid
-REAL, DIMENSION(KSIZE), INTENT(OUT):: PFIELD_SPLIT! real field for splitted grid
+REAL, DIMENSION(KSIZE), INTENT(OUT):: PFIELD_SPLIT! real field for split grid
!
!* 0.2 Declarations of local variables
!
@@ -143,7 +143,7 @@ END SUBROUTINE SPLIT_GRID_PARAMETERX1_MNH
#endif
! #############################################################
!
-!!**** * - routine to define an integer related to splitted grid
+!!**** * - routine to define an integer related to split grid
!
!
!
@@ -164,7 +164,7 @@ CHARACTER(LEN=6), INTENT(IN) :: HREC ! name of the parameter
INTEGER, INTENT(IN) :: KHALO ! size of the Halo
#endif
INTEGER, INTENT(IN) :: KFIELD ! integer scalar for complete grid
-INTEGER, INTENT(OUT):: KFIELD_SPLIT ! integer scalar for splitted grid
+INTEGER, INTENT(OUT):: KFIELD_SPLIT ! integer scalar for split grid
!* 0.2 Declarations of local variables
!
INTEGER :: IIB, IIE, IJB, IJE
diff --git a/src/MNH/station_reader.f90 b/src/MNH/station_reader.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0f6b74663480f8dc78a48531f285837929fdfad6
--- /dev/null
+++ b/src/MNH/station_reader.f90
@@ -0,0 +1,153 @@
+!MNH_LIC Copyright 2020-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! #######################
+ MODULE MODI_STATION_READER
+! #######################
+!
+INTERFACE
+!
+SUBROUTINE READ_CSV_STATION(HFILE,TPSTATION,OCARTESIAN)
+ USE MODD_STATION_n
+ CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+ TYPE(STATION), INTENT(OUT) :: TPSTATION ! stored blade data
+ LOGICAL, INTENT(IN) :: OCARTESIAN
+END SUBROUTINE READ_CSV_STATION
+!
+END INTERFACE
+!
+END MODULE MODI_STATION_READER
+!-------------------------------------------------------------------
+!
+!!**** *EOL_READER* -
+!!
+!! PURPOSE
+!! -------
+!! Prescribe probes through a CSV file
+!!
+!! AUTHOR
+!! ------
+!! E. Jézéquel *CNRM & IFPEN*
+!!
+!! MODIFICATIONS
+!! -------------
+!! 03/2020 Original
+!!
+!!---------------------------------------------------------------
+!
+!#########################################################
+SUBROUTINE READ_CSV_STATION(HFILE,TPSTATION,OCARTESIAN)
+USE MODD_ALLSTATION_n
+USE MODD_STATION_n
+USE MODD_PARAMETERS
+USE MODD_TYPE_STATION
+USE MODI_INI_SURFSTATION_n
+
+!
+CHARACTER(LEN=*), INTENT(IN) :: HFILE ! file to read
+TYPE(STATION), INTENT(INOUT) :: TPSTATION ! dummy stored
+LOGICAL, INTENT(IN) :: OCARTESIAN
+!
+INTEGER :: INBLINE ! Nb of line in csv file
+!
+CHARACTER(LEN=80) :: YERROR
+CHARACTER(LEN=400) :: YSTRING
+INTEGER :: ILU ! logical unit of the file
+!
+
+! Open file
+OPEN(NEWUNIT=ILU,FILE=HFILE, FORM='formatted')
+! Count lines
+REWIND(ILU)
+INBLINE=0
+DO
+ READ(ILU,END=101,FMT='(A400)') YSTRING
+!* analyses if the record has been written in French convention
+ CALL FRENCH_TO_ENGLISH(YSTRING) ! analyse de convention fr ou eng
+ IF (LEN_TRIM(YSTRING) > 0) THEN
+ INBLINE = INBLINE + 1
+ END IF
+END DO
+!
+101 CONTINUE
+ IF (INBLINE == 0) THEN
+ YERROR = 'Data not found in file : '//TRIM(HFILE)
+ PRINT*, YERROR
+ ELSE
+ ! Save number of station
+ NUMBSTAT = INBLINE - 1
+ !
+ ! Allocation des tableaux
+ ALLOCATE(TPSTATION%LAT(NUMBSTAT))
+ ALLOCATE(TPSTATION%LON(NUMBSTAT))
+ ALLOCATE(TPSTATION%X(NUMBSTAT))
+ ALLOCATE(TPSTATION%Y(NUMBSTAT))
+ ALLOCATE(TPSTATION%Z(NUMBSTAT))
+ ALLOCATE(TPSTATION%K(NUMBSTAT))
+ !ALLOCATE(TPSTATION%STEP(NUMBSTAT))
+ ALLOCATE(TPSTATION%NAME(NUMBSTAT))
+! ALLOCATE(TPSTATION%TYPE(NUMBSTAT))
+
+ TPSTATION%LON = XUNDEF
+ TPSTATION%LAT = XUNDEF
+ TPSTATION%Z = XUNDEF
+ TPSTATION%K = XUNDEF
+ TPSTATION%X = XUNDEF
+ TPSTATION%Y = XUNDEF
+ TPSTATION%NAME = " "
+! TPSTATION%TYPE = " "
+ ! Nouvelle lecture
+ REWIND(ILU)
+ READ(ILU,FMT='(A400)') YSTRING ! Lecture du header
+ !
+ ! Save the data
+ IF (OCARTESIAN) THEN
+ INBLINE = 1
+ DO INBLINE=1, NUMBSTAT
+ READ(ILU,FMT='(A400)') YSTRING
+ READ(YSTRING,*) TPSTATION%NAME(INBLINE), & !TPSTATION%TYPE(INBLINE),&
+ TPSTATION%X(INBLINE), TPSTATION%Y(INBLINE), TPSTATION%Z(INBLINE)!,&
+ END DO
+ REWIND(ILU)
+ CLOSE(ILU)
+ RETURN
+ ELSE
+ INBLINE = 1
+ DO INBLINE=1, NUMBSTAT
+ READ(ILU,FMT='(A400)') YSTRING
+ READ(YSTRING,*) TPSTATION%NAME(INBLINE), & !TPSTATION%TYPE(INBLINE),&
+ TPSTATION%LAT(INBLINE), TPSTATION%LON(INBLINE), TPSTATION%Z(INBLINE)!,&
+ END DO
+ REWIND(ILU)
+ CLOSE(ILU)
+ RETURN
+ END IF
+ END IF
+!
+END SUBROUTINE READ_CSV_STATION
+!#########################################################
+SUBROUTINE FRENCH_TO_ENGLISH(HSTRING)
+CHARACTER(LEN=400), INTENT(INOUT) :: HSTRING ! csv record
+INTEGER :: JL
+LOGICAL :: GFRENCH
+!
+GFRENCH = .FALSE.
+!* analyses if the record has been written in French convention
+! French convention (separator is ; decimal symbol is ,)
+! or English convention (separator is , decimal symbol is .)
+DO JL=1,400
+ IF (HSTRING(JL:JL)==';') GFRENCH=.TRUE.
+END DO
+!
+! If French convention is used in the file, transforms it in English convention
+IF (GFRENCH) THEN
+ DO JL=1,400
+ IF (HSTRING(JL:JL)==',') HSTRING(JL:JL)='.'
+ IF (HSTRING(JL:JL)==';') HSTRING(JL:JL)=','
+ END DO
+END IF
+!
+END SUBROUTINE FRENCH_TO_ENGLISH
+
diff --git a/src/MNH/stationn.f90 b/src/MNH/stationn.f90
index f1d20df7e869f96195e5b9ac6ca4e6e7fd7e6d1b..4de047e716b3d60dda687a4abe41342d8f6dabcb 100644
--- a/src/MNH/stationn.f90
+++ b/src/MNH/stationn.f90
@@ -1,6 +1,6 @@
-!MNH_LIC Copyright 2002-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
! ##########################
@@ -10,18 +10,11 @@ MODULE MODI_STATION_n
INTERFACE
!
SUBROUTINE STATION_n(PTSTEP, &
- TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
PXHAT, PYHAT, PZ, &
PU, PV, PW, PTH, PR, PSV, PTKE, &
PTS,PP )
!
-USE MODD_TYPE_DATE
-!
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTEXP! experiment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTMOD! model start date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG! segment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTCUR! current date and time
REAL, DIMENSION(:), INTENT(IN) :: PXHAT ! x coordinate
REAL, DIMENSION(:), INTENT(IN) :: PYHAT ! y coordinate
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
@@ -45,9 +38,8 @@ END MODULE MODI_STATION_n
!
! ########################################################
SUBROUTINE STATION_n(PTSTEP, &
- TPDTEXP, TPDTMOD, TPDTSEG, TPDTCUR, &
PXHAT, PYHAT, PZ, &
- PU, PV, PW, PTH, PR, PSV, PTKE, &
+ PU, PV, PW, PTH, PR, PSV, PTKE, &
PTS, PP )
! ########################################################
!
@@ -84,26 +76,28 @@ END MODULE MODI_STATION_n
!! P.Aumond 01/07/2011 : Add model levels
!! C.Lac 04/2013 : Correction on the vertical levels
!! C.Lac 04/2013 : Add I/J positioning
-!! P.Wautelet 28/03/2018 : Replace TEMPORAL_DIST by DATETIME_DISTANCE
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!! --------------------------------------------------------------------------
-!
+! P. Wautelet 28/03/2018: replace TEMPORAL_DIST by DATETIME_DISTANCE
+! 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: use LCARTESIAN instead of LSTATLAT for multiproc in cartesian
+!
+! --------------------------------------------------------------------------
+!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_TYPE_DATE
-USE MODD_STATION_n
-USE MODD_SUB_STATION_n
-USE MODD_DIAG_IN_RUN
-USE MODD_PARAMETERS
+USE MODD_CONF
USE MODD_CST
+USE MODD_DIAG_IN_RUN
USE MODD_GRID
-USE MODD_TIME
-USE MODD_CONF
-USE MODD_PARAM_n, ONLY : CRAD
+USE MODD_PARAMETERS
+USE MODD_PARAM_n, ONLY: CRAD
+USE MODD_STATION_n
+USE MODD_ALLSTATION_n, ONLY: LDIAG_SURFRAD
+USE MODD_SUB_STATION_n
+USE MODD_TIME, ONLY: tdtexp
+USE MODD_TIME_n, ONLY: tdtcur
!
-USE MODE_DATETIME
USE MODE_ll
!
USE MODI_WATER_SUM
@@ -117,10 +111,6 @@ IMPLICIT NONE
!
!
REAL, INTENT(IN) :: PTSTEP ! time step
-TYPE(DATE_TIME), INTENT(IN) :: TPDTEXP! experiment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTMOD! model start date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTSEG! segment date and time
-TYPE(DATE_TIME), INTENT(IN) :: TPDTCUR! current date and time
REAL, DIMENSION(:), INTENT(IN) :: PXHAT ! x coordinate
REAL, DIMENSION(:), INTENT(IN) :: PYHAT ! y coordinate
REAL, DIMENSION(:,:,:), INTENT(IN) :: PZ ! z array
@@ -145,7 +135,6 @@ INTEGER :: IIE !
INTEGER :: IJE !
INTEGER :: IIU !
INTEGER :: IJU !
-REAL :: ZTIMEEXP !
!
REAL, DIMENSION(SIZE(PXHAT)) :: ZXHATM ! mass point coordinates
REAL, DIMENSION(SIZE(PYHAT)) :: ZYHATM ! mass point coordinates
@@ -200,7 +189,6 @@ IF ( TSTATION%T_CUR == XUNDEF ) TSTATION%T_CUR = TSTATION%STEP - PTSTEP
!
TSTATION%T_CUR = TSTATION%T_CUR + PTSTEP
!
-CALL DATETIME_DISTANCE(TDTEXP,TDTSEG,ZTIMEEXP)
IF ( TSTATION%T_CUR >= TSTATION%STEP - 1.E-10 ) THEN
GSTORE = .TRUE.
TSTATION%T_CUR = TSTATION%T_CUR - TSTATION%STEP
@@ -211,24 +199,14 @@ ELSE
END IF
!
IF (GSTORE) THEN
- !
- TSTATION%TIME(IN) = (IN-1) * TSTATION%STEP + ZTIMEEXP
- TSTATION%DATIME( 1,IN) = TPDTEXP%TDATE%YEAR
- TSTATION%DATIME( 2,IN) = TPDTEXP%TDATE%MONTH
- TSTATION%DATIME( 3,IN) = TPDTEXP%TDATE%DAY
- TSTATION%DATIME( 4,IN) = TPDTEXP%TIME
- TSTATION%DATIME( 5,IN) = TPDTSEG%TDATE%YEAR
- TSTATION%DATIME( 6,IN) = TPDTSEG%TDATE%MONTH
- TSTATION%DATIME( 7,IN) = TPDTSEG%TDATE%DAY
- TSTATION%DATIME( 8,IN) = TPDTSEG%TIME
- TSTATION%DATIME( 9,IN) = TPDTMOD%TDATE%YEAR
- TSTATION%DATIME(10,IN) = TPDTMOD%TDATE%MONTH
- TSTATION%DATIME(11,IN) = TPDTMOD%TDATE%DAY
- TSTATION%DATIME(12,IN) = TPDTMOD%TIME
- TSTATION%DATIME(13,IN) = TPDTCUR%TDATE%YEAR
- TSTATION%DATIME(14,IN) = TPDTCUR%TDATE%MONTH
- TSTATION%DATIME(15,IN) = TPDTCUR%TDATE%DAY
- TSTATION%DATIME(16,IN) = TPDTCUR%TIME
+#if 0
+ tstation%tpdates(in)%date%year = tdtexp%date%year
+ tstation%tpdates(in)%date%month = tdtexp%date%month
+ tstation%tpdates(in)%date%day = tdtexp%date%day
+ tstation%tpdates(in)%xtime = tdtexp%xtime + ( in - 1 ) * tstation%step
+#else
+ tstation%tpdates(in) = tdtcur
+#endif
END IF
!
!
@@ -292,7 +270,6 @@ IF (GSTATFIRSTCALL) THEN
!
!* 4.4 Computations only on correct processor
! --------------------------------------
- IF ( LSTATLAT ) THEN
ZXCOEF(I) = 0.
ZYCOEF(I) = 0.
ZUCOEF(I) = 0.
@@ -331,7 +308,6 @@ IF (GSTATFIRSTCALL) THEN
!
END IF
- END IF
ENDDO
END IF
!----------------------------------------------------------------------------
@@ -340,10 +316,7 @@ END IF
! --------------
!
IF (GSTORE) THEN
-
- IF (TSTATION%TIME(IN) /= XUNDEF) THEN
-
- DO I=1,NUMBSTAT
+ DO I=1,NUMBSTAT
!
IF ((ZTHIS_PROCS(I)==1.).AND.(.NOT. TSTATION%ERROR(I))) THEN
IF (TSTATION%K(I)/= XUNDEF) THEN
@@ -360,18 +333,16 @@ IF (GSTORE) THEN
ENDIF
END IF
!
- ZGAM = (XRPK * (TSTATION%LON(I) - XLON0) - XBETA)*(XPI/180.)
- IF ( LSTATLAT ) THEN
- ZU_STAT = STATION_INTERP_2D_U(PU(:,:,J))
- ZV_STAT = STATION_INTERP_2D_V(PV(:,:,J))
+ IF (LCARTESIAN) THEN
+ TSTATION%ZON (IN,I) = STATION_INTERP_2D_U(PU(:,:,J))
+ TSTATION%MER (IN,I) = STATION_INTERP_2D_V(PV(:,:,J))
ELSE
- ZU_STAT = PU(TSTATION%I(I),TSTATION%J(I),J)
- ZV_STAT = PV(TSTATION%I(I),TSTATION%J(I),J)
- END IF
- !
- TSTATION%ZON (IN,I) = ZU_STAT * COS(ZGAM) + ZV_STAT * SIN(ZGAM)
- TSTATION%MER (IN,I) = - ZU_STAT * SIN(ZGAM) + ZV_STAT * COS(ZGAM)
- IF ( LSTATLAT ) THEN
+ ZU_STAT = STATION_INTERP_2D_U(PU(:,:,J))
+ ZV_STAT = STATION_INTERP_2D_V(PV(:,:,J))
+ ZGAM = (XRPK * (TSTATION%LON(I) - XLON0) - XBETA)*(XPI/180.)
+ TSTATION%ZON (IN,I) = ZU_STAT * COS(ZGAM) + ZV_STAT * SIN(ZGAM)
+ TSTATION%MER (IN,I) = - ZU_STAT * SIN(ZGAM) + ZV_STAT * COS(ZGAM)
+ ENDIF
TSTATION%W (IN,I) = STATION_INTERP_2D(PW(:,:,J))
TSTATION%TH (IN,I) = STATION_INTERP_2D(PTH(:,:,J))
TSTATION%P (IN,I) = STATION_INTERP_2D(PP(:,:,J))
@@ -388,7 +359,7 @@ IF (GSTORE) THEN
IF (SIZE(PTS) >0) TSTATION%TSRAD(IN,I) = STATION_INTERP_2D(PTS)
TSTATION%ZS(I) = STATION_INTERP_2D(PZ(:,:,1+JPVEXT))
!
- IF (LDIAG_IN_RUN) THEN
+ IF (LDIAG_SURFRAD) THEN
TSTATION%ZON10M(IN,I) = STATION_INTERP_2D(XCURRENT_ZON10M)
TSTATION%MER10M(IN,I) = STATION_INTERP_2D(XCURRENT_MER10M)
TSTATION%T2M (IN,I) = STATION_INTERP_2D(XCURRENT_T2M )
@@ -410,46 +381,7 @@ IF (GSTORE) THEN
ENDIF
TSTATION%SFCO2 (IN,I) = STATION_INTERP_2D(XCURRENT_SFCO2 )
ENDIF
- ELSE
- TSTATION%W (IN,I) = PW(TSTATION%I(I),TSTATION%J(I),J)
- TSTATION%TH (IN,I) = PTH(TSTATION%I(I),TSTATION%J(I),J)
- TSTATION%P (IN,I) = PP(TSTATION%I(I),TSTATION%J(I),J)
- !
- DO JSV=1,SIZE(PR,4)
- TSTATION%R (IN,I,JSV) = PR(TSTATION%I(I),TSTATION%J(I),J,JSV)
- END DO
- !
- DO JSV=1,SIZE(PSV,4)
- TSTATION%SV (IN,I,JSV) = PSV(TSTATION%I(I),TSTATION%J(I),J,JSV)
- END DO
- !
- IF (SIZE(PTKE)>0) TSTATION%TKE (IN,I) = PTKE(TSTATION%I(I),TSTATION%J(I),J)
- IF (SIZE(PTS) >0) TSTATION%TSRAD(IN,I) = PTS(TSTATION%I(I),TSTATION%J(I))
- TSTATION%ZS(I) = PZ(TSTATION%I(I),TSTATION%J(I),1+JPVEXT)
- !
- IF (LDIAG_IN_RUN) THEN
- TSTATION%ZON10M(IN,I) = XCURRENT_ZON10M(TSTATION%I(I),TSTATION%J(I))
- TSTATION%MER10M(IN,I) = XCURRENT_MER10M(TSTATION%I(I),TSTATION%J(I))
- TSTATION%T2M (IN,I) = XCURRENT_T2M(TSTATION%I(I),TSTATION%J(I))
- TSTATION%Q2M (IN,I) = XCURRENT_Q2M(TSTATION%I(I),TSTATION%J(I))
- TSTATION%HU2M (IN,I) = XCURRENT_HU2M(TSTATION%I(I),TSTATION%J(I))
- TSTATION%RN (IN,I) = XCURRENT_RN(TSTATION%I(I),TSTATION%J(I))
- TSTATION%H (IN,I) = XCURRENT_H(TSTATION%I(I),TSTATION%J(I))
- TSTATION%LE (IN,I) = XCURRENT_LE(TSTATION%I(I),TSTATION%J(I))
- TSTATION%LEI (IN,I) = XCURRENT_LEI(TSTATION%I(I),TSTATION%J(I))
- TSTATION%GFLUX (IN,I) = XCURRENT_GFLUX(TSTATION%I(I),TSTATION%J(I))
- IF (CRAD /= 'NONE') THEN
- TSTATION%SWD (IN,I) = XCURRENT_SWD(TSTATION%I(I),TSTATION%J(I))
- TSTATION%SWU (IN,I) = XCURRENT_SWU(TSTATION%I(I),TSTATION%J(I))
- TSTATION%LWD (IN,I) = XCURRENT_LWD(TSTATION%I(I),TSTATION%J(I))
- TSTATION%LWU (IN,I) = XCURRENT_LWU(TSTATION%I(I),TSTATION%J(I))
- TSTATION%SWDIR (IN,I) = XCURRENT_SWDIR(TSTATION%I(I),TSTATION%J(I))
- TSTATION%SWDIFF(IN,I) = XCURRENT_SWDIFF(TSTATION%I(I),TSTATION%J(I))
- TSTATION%DSTAOD(IN,I) = XCURRENT_DSTAOD(TSTATION%I(I),TSTATION%J(I))
- ENDIF
- TSTATION%SFCO2 (IN,I) = XCURRENT_SFCO2(TSTATION%I(I),TSTATION%J(I))
- ENDIF
- ENDIF
+
!
END IF
!
@@ -480,7 +412,7 @@ IF (GSTORE) THEN
IF (SIZE(PTKE)>0) CALL DISTRIBUTE_STATION(TSTATION%TKE (IN,I))
IF (SIZE(PTS) >0) CALL DISTRIBUTE_STATION(TSTATION%TSRAD(IN,I))
CALL DISTRIBUTE_STATION(TSTATION%ZS (I))
- IF (LDIAG_IN_RUN) THEN
+ IF (LDIAG_SURFRAD) THEN
CALL DISTRIBUTE_STATION(TSTATION%T2M (IN,I))
CALL DISTRIBUTE_STATION(TSTATION%Q2M (IN,I))
CALL DISTRIBUTE_STATION(TSTATION%HU2M (IN,I))
@@ -505,8 +437,6 @@ IF (GSTORE) THEN
!
ENDDO
!
- END IF
- !
END IF
!
!----------------------------------------------------------------------------
diff --git a/src/MNH/subl_blowsnow.f90 b/src/MNH/subl_blowsnow.f90
index a0f99e6ceef189543a7e357c43d4326d1b8d8a33..ad0cf278fa86b1eeedaf7c0a2da1344d8d86024a 100644
--- a/src/MNH/subl_blowsnow.f90
+++ b/src/MNH/subl_blowsnow.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.
@@ -6,6 +6,7 @@
! Modifications:
! P. Wautelet 28/05/2018: corrected truncated integer division (1*10**(-6) -> 1E-6)
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
+! P. Wautelet 01/03/2021: bugfix: correct intent of PSVT in module interface
!-----------------------------------------------------------------
! ####################
MODULE MODI_SUBL_BLOWSNOW
@@ -24,12 +25,12 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PPABST ! absolute pressure at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT ! Theta at time t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRVT ! Water vapor m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRCT ! Cloud water m.r. at t
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRIT ! Pristine ice m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRST ! Snow/aggregate m.r. at t
REAL, DIMENSION(:,:,:), INTENT(IN) :: PRGT ! Graupel/hail m.r. at t
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Blowing snow concentration
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT ! Blowing snow concentration
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVGK ! Mass averaged settling velocity
@@ -50,11 +51,16 @@ END MODULE MODI_SUBL_BLOWSNOW
PTHS, PRVS, PSVS,PSNWSUBL3D,PVGK)
USE MODD_BLOWSNOW
+use modd_budget, only: lbudget_th, lbudget_rv, lbudget_sv, &
+ NBUDGET_TH, NBUDGET_RV, NBUDGET_SV1, &
+ tbudgets
USE MODD_CST
USE MODD_CSTS_BLOWSNOW
+use modd_nsv, only: nsv_snwbeg, nsv_snwend
USE MODD_PARAMETERS
USE MODE_BLOWSNOW_PSD
+use mode_budget, only: Budget_store_init, Budget_store_end
use mode_tools, only: Countjv
USE MODI_GAMMA
@@ -102,8 +108,6 @@ INTEGER :: IKE !
!
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZBETA
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3)) :: ZT
-REAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
- :: ZW ! work array
LOGICAL, DIMENSION(SIZE(PEXNREF,1),SIZE(PEXNREF,2),SIZE(PEXNREF,3)) &
:: GSUBL ! Test where to compute sublimation
@@ -202,7 +206,7 @@ IKE=SIZE(PZZ,3) - JPVEXT
!
!-------------------------------------------------------------------------------
!
-!* 2. COMPUTE THE BLOWINGG SNOW SUBLIMATION
+!* 2. COMPUTE THE BLOWING SNOW SUBLIMATION
!
! Optimization by looking for locations where
! the blowing snow fields are larger than a minimal value only !!!
@@ -224,6 +228,14 @@ GSUBL(IIB:IIE,IJB:IJE,IKB:IKE) = &
IMICRO = COUNTJV( GSUBL(:,:,:),I1(:),I2(:),I3(:))
IF( IMICRO >= 0 ) THEN
+ if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'SNSUB', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'SNSUB', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ do jsv = nsv_snwbeg, nsv_snwend
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'SNSUB', psvs(:, :, :, jsv - nsv_snwbeg + 1) * prhodj(:, :, :) )
+ end do
+ end if
+
ALLOCATE(ZRVT(IMICRO))
ALLOCATE(ZRCT(IMICRO))
ALLOCATE(ZRRT(IMICRO))
@@ -287,22 +299,22 @@ IF( IMICRO >= 0 ) THEN
ALLOCATE(ZAM3(IMICRO))
ALLOCATE(NMAX(IMICRO))
-
-CALL SNOW_SUBL
-
- ZW(:,:,:) = PRVS(:,:,:)
- PRVS(:,:,:) = UNPACK( ZRVS(:),MASK=GSUBL(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PTHS(:,:,:)
- PTHS(:,:,:) = UNPACK( ZTHS(:),MASK=GSUBL(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PSVS(:,:,:,1)
- PSVS(:,:,:,1) = UNPACK( ZSVS(:,1),MASK=GSUBL(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PSVS(:,:,:,2)
- PSVS(:,:,:,2) = UNPACK( ZSVS(:,2),MASK=GSUBL(:,:,:),FIELD=ZW(:,:,:) )
-! ZW(:,:,:) = PSVS(:,:,:,3)
-! PSVS(:,:,:,3) = UNPACK( ZSVS(:,3),MASK=GSUBL(:,:,:),FIELD=ZW(:,:,:) )
- ZW(:,:,:) = PSNWSUBL3D(:,:,:)
- PSNWSUBL3D(:,:,:) = UNPACK( ZSNWSUBL(:),MASK=GSUBL(:,:,:),FIELD=ZW(:,:,:) )
-
+ CALL SNOW_SUBL
+
+ PRVS(:,:,:) = UNPACK( ZRVS(:), MASK=GSUBL(:,:,:),FIELD=PRVS(:,:,:) )
+ PTHS(:,:,:) = UNPACK( ZTHS(:), MASK=GSUBL(:,:,:),FIELD=PTHS(:,:,:) )
+ PSVS(:,:,:,1) = UNPACK( ZSVS(:,1), MASK=GSUBL(:,:,:),FIELD=PSVS(:,:,:,1) )
+ PSVS(:,:,:,2) = UNPACK( ZSVS(:,2), MASK=GSUBL(:,:,:),FIELD=PSVS(:,:,:,2) )
+! PSVS(:,:,:,3) = UNPACK( ZSVS(:,3),MASK=GSUBL(:,:,:),FIELD=PSVS(:,:,:,3) )
+ PSNWSUBL3D(:,:,:) = UNPACK( ZSNWSUBL(:),MASK=GSUBL(:,:,:),FIELD=PSNWSUBL3D(:,:,:) )
+
+ if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'SNSUB', pths(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'SNSUB', prvs(:, :, :) * prhodj(:, :, :) )
+ if ( lbudget_sv ) then
+ do jsv = nsv_snwbeg, nsv_snwend
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'SNSUB', psvs(:, :, :, jsv - nsv_snwbeg + 1) * prhodj(:, :, :) )
+ end do
+ end if
DEALLOCATE(ZRVT)
DEALLOCATE(ZRCT)
diff --git a/src/MNH/sunposn.f90 b/src/MNH/sunposn.f90
index 256ed7616f4bef0383f9077fe60097de71445140..6a3172abea49655f5e8b0a59cf24307020cd8494 100644
--- a/src/MNH/sunposn.f90
+++ b/src/MNH/sunposn.f90
@@ -1,13 +1,8 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! MASDEV4_7 rad 2006/05/18 13:07:25
-!-----------------------------------------------------------------
! ####################
MODULE MODI_SUNPOS_n
! ####################
@@ -134,7 +129,7 @@ END IF
!* 2. COMPUTES THE TRUE SOLAR TIME
! ----------------------------
!
-ZTIME = TDTRAD_FULL%TIME + 0.5*XDTRAD
+ZTIME = TDTRAD_FULL%xtime + 0.5*XDTRAD
ZUT = MOD( 24.0+MOD(ZTIME/3600.,24.0),24.0 )
diff --git a/src/MNH/th_r_from_thl_rt_1d.f90 b/src/MNH/th_r_from_thl_rt_1d.f90
index fcec2372fd5ff3a140c04b04df94a31073645167..e4ba92f8a9d8f7ca88e5411bfaadd73c1d8023fa 100644
--- a/src/MNH/th_r_from_thl_rt_1d.f90
+++ b/src/MNH/th_r_from_thl_rt_1d.f90
@@ -1,3 +1,8 @@
+!MNH_LIC Copyright 2006-2021 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
! ######spl
MODULE MODI_TH_R_FROM_THL_RT_1D
! ###############################
@@ -67,7 +72,8 @@ REAL, DIMENSION(:), INTENT(OUT) :: PRSATI ! estimated mixing ration at saturati
! ------------
!
USE MODI_COMPUTE_FRAC_ICE
-USE MODD_CST !, ONLY: XP00, XRD, XCPD, XCPV, XCL, XCI, XLVTT, XTT, XLSTT
+USE MODD_CST
+USE MODD_DYN_n, ONLY : LOCEAN
USE MODE_THERMO
!
IMPLICIT NONE
@@ -131,8 +137,11 @@ PTH(:)=PTHL(:)+ZLVOCPEXN(:)*PRL(:)+ZLSOCPEXN(:)*PRI(:)
! ---------
DO II=1,JITER
- ZT(:)=PTH(:)*ZEXN(:)
-
+ IF (LOCEAN) THEN
+ ZT=PTH
+ ELSE
+ ZT(:)=PTH(:)*ZEXN(:)
+ END IF
!Computation of liquid/ice fractions
PFRAC_ICE(:) = 0.
WHERE(PRL(:)+PRI(:) > 1.E-20)
diff --git a/src/MNH/tke_eps_sources.f90 b/src/MNH/tke_eps_sources.f90
index 55d7384c22eb1be568812290d9e9e59a414519b7..4485e07cce287c6d41284f771c7f0b5050b97936 100644
--- a/src/MNH/tke_eps_sources.f90
+++ b/src/MNH/tke_eps_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.
@@ -12,7 +12,7 @@ INTERFACE
PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
PTSTEP,PIMPL,PEXPL, &
HTURBLEN,HTURBDIM, &
- TPFILE,OCLOSE_OUT,OTURB_DIAG, &
+ TPFILE,OTURB_DIAG, &
PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS,PTR,PDISS )
!
USE MODD_IO, ONLY: TFILEDATA
@@ -34,8 +34,6 @@ CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
! diagnostic fields in the syncronous FM-file
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP ! Dyn. prod. of TKE
@@ -62,7 +60,7 @@ END MODULE MODI_TKE_EPS_SOURCES
PTRH,PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
PTSTEP,PIMPL,PEXPL, &
HTURBLEN,HTURBDIM, &
- TPFILE,OCLOSE_OUT,OTURB_DIAG, &
+ TPFILE,OTURB_DIAG, &
PTP,PRTKES,PRTKESM, PRTHLS,PCOEF_DISS,PTR,PDISS )
! ##################################################################
!
@@ -122,7 +120,6 @@ END MODULE MODI_TKE_EPS_SOURCES
!! 'CART' for cartesian box configuration
!! 'MASK' for budget zone defined by a mask
!! 'NONE' ' for no budget
-!! NBUPROCCTR : process counter used for each budget variable
!! LBU_RTKE : logical for budget of RTKE (turbulent kinetic energy)
!! .TRUE. = budget of RTKE
!! .FALSE. = no budget of RTKE
@@ -168,44 +165,44 @@ END MODULE MODI_TKE_EPS_SOURCES
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!! --------------------------------------------------------------------------
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
+USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+use modd_budget, only: lbudget_tke, lbudget_th, NBUDGET_TKE, NBUDGET_TH, tbudgets
USE MODD_CONF
+USE MODD_CST
USE MODD_CTURB
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS
-USE MODD_BUDGET
+USE MODD_DIAG_IN_RUN, ONLY: LDIAG_IN_RUN, XCURRENT_TKE_DISS
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
-USE MODD_DIAG_IN_RUN, ONLY : LDIAG_IN_RUN, XCURRENT_TKE_DISS
+USE MODD_PARAMETERS
!
-USE MODE_ll
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_ARGSLIST_ll, ONLY: ADD3DFIELD_ll, CLEANLIST_ll
+use mode_budget, only: Budget_store_add, Budget_store_end, Budget_store_init
+USE MODE_EXCHANGE_ll, ONLY: UPDATE_HALO_ll
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
!
+#ifdef MNH_BITREP
+USE MODI_BITREP
+#endif
+USE MODI_GET_HALO
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
USE MODI_GRADIENT_W
+USE MODI_LES_MEAN_SUBGRID
#ifndef MNH_OPENACC
USE MODI_SHUMAN
#else
USE MODI_SHUMAN_DEVICE
#endif
USE MODI_TRIDIAG_TKE
-USE MODI_BUDGET
-USE MODI_LES_MEAN_SUBGRID
-!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-!
-USE MODI_GET_HALO
-#ifdef MNH_BITREP
-USE MODI_BITREP
-#endif
!
IMPLICIT NONE
!
@@ -231,8 +228,6 @@ CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
! turbulence scheme
CHARACTER(len=4), INTENT(IN) :: HTURBLEN ! kind of mixing length
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
! diagnostic fields in the syncronous FM-file
REAL, DIMENSION(:,:,:), INTENT(INOUT):: PDP ! Dyn. prod. of TKE
@@ -333,6 +328,9 @@ ZKEFF(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
ZKEFF(:,:,:) = PLM(:,:,:) * BR_POW(PTKEM(:,:,:),0.5)
#endif
!
+!$acc end kernels
+if (lbudget_th) call Budget_store_init( tbudgets(NBUDGET_TH), 'DISSH', prthls(:, :, :) )
+!$acc kernels
!----------------------------------------------------------------------------
!
!* 2. TKE EQUATION
@@ -365,7 +363,7 @@ ZFLX(:,:,:) = XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:)
#else
ZFLX(:,:,:) = XCED * BR_POW(PTKEM(:,:,:),0.5) / PLEPS(:,:,:)
#endif
-ZSOURCE(:,:,:) = PRTKES(:,:,:) / PRHODJ(:,:,:) + PRTKESM(:,:,:) / PRHODJ(:,:,:) &
+ZSOURCE(:,:,:) = ( PRTKES(:,:,:) + PRTKESM(:,:,:) ) / PRHODJ(:,:,:) &
- PTKEM(:,:,:) / PTSTEP &
+ PDP(:,:,:) + PTP(:,:,:) + PTR(:,:,:) - PEXPL * ZFLX(:,:,:) * PTKEM(:,:,:)
!$acc end kernels
@@ -433,7 +431,7 @@ ENDIF
!END WHERE
!
IF ( LLES_CALL .OR. &
- (OTURB_DIAG .AND. OCLOSE_OUT) ) THEN
+ (OTURB_DIAG .AND. tpfile%lopened) ) THEN
!
! Compute the cartesian vertical flux of TKE in ZFLX
!
@@ -487,52 +485,36 @@ END IF
!
!* 2.4 stores the explicit sources for budget purposes
!
-IF (LBUDGET_TKE) THEN
-!
-! add the dynamical production
-!
-!$acc kernels
- PRTKES(:,:,:) = PRTKES(:,:,:) + PDP(:,:,:) * PRHODJ(:,:,:)
-!$acc end kernels
-!$acc update self(PRTKES)
- CALL BUDGET (PRTKES(:,:,:),5,'DP_BU_RTKE')
-!
-! add the thermal production
-!
-!$acc kernels
- PRTKES(:,:,:) = PRTKES(:,:,:) + PTP(:,:,:) * PRHODJ(:,:,:)
-!$acc end kernels
-!$acc update self(PRTKES)
- CALL BUDGET (PRTKES(:,:,:),5,'TP_BU_RTKE')
-!
-! add the dissipation
-!
-!$acc kernels
-#ifndef MNH_BITREP
-PRTKES(:,:,:) = PRTKES(:,:,:) - XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
-#else
-PRTKES(:,:,:) = PRTKES(:,:,:) - XCED * BR_POW(PTKEM(:,:,:),0.5) / PLEPS(:,:,:) * &
-#endif
- (PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:)
-!$acc end kernels
-!$acc update self(PRTKES)
-CALL BUDGET (PRTKES(:,:,:),5,'DISS_BU_RTKE')
-END IF
+if (lbudget_tke) then
+ ! Dynamical production
+ call Budget_store_add( tbudgets(NBUDGET_TKE), 'DP', pdp(:, :, :) * prhodj(:, :, :) )
+ ! Thermal production
+ call Budget_store_add( tbudgets(NBUDGET_TKE), 'TP', ptp(:, :, :) * prhodj(:, :, :) )
+ ! Dissipation
+ call Budget_store_add( tbudgets(NBUDGET_TKE), 'DISS', -xced * sqrt( ptkem(:, :, :) ) / pleps(:, :, :) &
+ * ( pexpl * ptkem(:, :, :) + pimpl * zres(:, :, :) ) * prhodj(:, :, :) )
+end if
!
!* 2.5 computes the final RTKE and stores the whole turbulent transport
! with the removal of the advection part
+
+if (lbudget_tke) then
+ !Store the previous source terms in prtkes before initializing the next one
+ PRTKES(:,:,:) = PRTKES(:,:,:) + PRHODJ(:,:,:) * &
+ ( PDP(:,:,:) + PTP(:,:,:) &
+ - XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * ( PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:) ) )
+
+ call Budget_store_init( tbudgets(NBUDGET_TKE), 'TR', prtkes(:, :, :) )
+end if
+
!$acc kernels
PRTKES(:,:,:) = ZRES(:,:,:) * PRHODJ(:,:,:) / PTSTEP - PRTKESM(:,:,:)
!$acc end kernels
!
! stores the whole turbulent transport
!
-IF (LBUDGET_TKE) THEN
-!$acc update self(PRTKES)
- CALL BUDGET (PRTKES(:,:,:),5,'TR_BU_RTKE')
-END IF
-!
-!
+if (lbudget_tke) call Budget_store_end( tbudgets(NBUDGET_TKE), 'TR', prtkes(:, :, :) )
+
!----------------------------------------------------------------------------
!
!* 3. COMPUTE THE DISSIPATIVE HEATING
@@ -545,7 +527,9 @@ PRTHLS(:,:,:) = PRTHLS(:,:,:) + XCED * SQRT(PTKEM(:,:,:)) / PLEPS(:,:,:) * &
PRTHLS(:,:,:) = PRTHLS(:,:,:) + XCED * BR_POW(PTKEM(:,:,:),0.5) / PLEPS(:,:,:) * &
#endif
(PEXPL*PTKEM(:,:,:) + PIMPL*ZRES(:,:,:)) * PRHODJ(:,:,:) * PCOEF_DISS(:,:,:)
-!
+
+if (lbudget_th) call Budget_store_end( tbudgets(NBUDGET_TH), 'DISSH', prthls(:, :, :) )
+
!----------------------------------------------------------------------------
!
!* 4. STORES SOME DIAGNOSTICS
@@ -558,7 +542,7 @@ PDISS(:,:,:) = -XCED * BR_POW(PTKEM(:,:,:),1.5) / PLEPS(:,:,:)
#endif
!$acc end kernels
!
-IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
!$acc update self(PDP,PTP,PTR,PDISS)
!
! stores the dynamic production
diff --git a/src/MNH/tools.f90 b/src/MNH/tools.f90
index 16b39d680821a3f5be3efa833e259c9436280c9c..2a3b27f35497530e954db5e2cdfb29fe4581d9d9 100644
--- a/src/MNH/tools.f90
+++ b/src/MNH/tools.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2019-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2019-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -21,12 +21,14 @@ module mode_tools
! P. Wautelet 28/05/2019: move COUNTJV function to tools.f90
! P. Wautelet 05/06/2019: add Countjv_device
! P. Wautelet 20/06/2019: add Countjv1d, Countjv1d_device and Countjv2d_device subroutines
+! P. Wautelet 17/01/2020: move Quicksort to tools.f90
implicit none
private
public :: Countjv
+public :: Quicksort
public :: Upcase
interface Countjv
@@ -316,6 +318,44 @@ end if
end subroutine Countjv3d_device
#endif
+recursive subroutine Quicksort( ka, kbeg, kend, kpos )
+ integer, dimension(:), intent(inout) :: ka
+ integer, intent(in) :: kbeg, kend
+ integer, dimension(:), optional, intent(inout) :: kpos
+
+ integer :: ji, jj
+ integer :: itmp, itmp2, ival
+
+ ival = ka( ( kbeg + kend ) / 2 )
+ ji = kbeg
+ jj = kend
+ do
+ do while ( ka(ji) < ival )
+ ji = ji + 1
+ end do
+ do while ( ival < ka(jj) )
+ jj = jj - 1
+ end do
+ if ( ji >= jj ) exit
+
+ itmp = ka(ji)
+ ka(ji) = ka(jj)
+ ka(jj) = itmp
+
+ if ( present( kpos ) ) then
+ itmp2 = kpos(ji)
+ kpos(ji) = kpos(jj)
+ kpos(jj) = itmp2
+ end if
+
+ ji=ji+1
+ jj=jj-1
+ end do
+ if ( kbeg < ji - 1 ) call Quicksort( ka, kbeg, ji - 1, kpos )
+ if ( jj + 1 < kend ) call Quicksort( ka, jj + 1, kend, kpos )
+end subroutine Quicksort
+
+
function Upcase(hstring)
character(len=*), intent(in) :: hstring
character(len=len(hstring)) :: upcase
diff --git a/src/MNH/trid.f90 b/src/MNH/trid.f90
deleted file mode 100644
index db2600ee0af0faddad79ec73885f01419298441e..0000000000000000000000000000000000000000
--- a/src/MNH/trid.f90
+++ /dev/null
@@ -1,645 +0,0 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ################
- MODULE MODI_TRID
-! ################
-!
-INTERFACE
-!
- SUBROUTINE TRID(HLBCX,HLBCY, &
- PMAP,PDXHAT,PDYHAT,PDXHATM,PDYHATM,PRHOM, &
- PAF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY, &
- PRHODJ,PTHVREF,PZZ,PBFY )
-!
-IMPLICIT NONE
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! x-direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference * J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
- ! Temperature of the reference state
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! scale factor
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
-!
-REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
-REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
-!
-REAL, INTENT(OUT) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(OUT) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(OUT) :: PRHOM ! mean of XRHODJ on the plane
- ! x y localized at a mass
- ! level
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBFY ! elements (yslice) of the tri-diag.
- ! matrix in the pressure eq.
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXY ! - along y
-
-!
-END SUBROUTINE TRID
-!
-END INTERFACE
-!
-END MODULE MODI_TRID
-!
-! ###################################################################
- SUBROUTINE TRID(HLBCX,HLBCY, &
- PMAP,PDXHAT,PDYHAT,PDXHATM,PDYHATM,PRHOM, &
- PAF,PCF,PTRIGSX,PTRIGSY,KIFAXX,KIFAXY, &
- PRHODJ,PTHVREF,PZZ,PBFY )
-! ####################################################################
-!
-!!**** *TRID * - Compute coefficients for the flat operator
-!!
-!! PURPOSE
-!! -------
-! The purpose of this routine is to compute the vertical time independent
-! coefficients a(k), b(k), c(k) required for the calculation of the "flat"
-! (i.e. neglecting the orography) operator Laplacian. RHOJ is averaged on
-! the whole horizontal domain. The form of the eigenvalues of the flat
-! operator depends on the lateral boundary conditions. Furthermore, this
-! routine initializes TRIGS and IFAX arrays required for the FFT transform
-! used in the routine PRECOND.
-!
-!!** METHOD
-!! ------
-!! The forms of the eigenvalues of the horizontal Laplacian are given by:
-!! Cyclic conditions:
-!! -----------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( imax ) <dyy> <dyy> ( jmax )
-!!
-!! Open conditions:
-!! -----------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( 2imax ) <dyy> <dyy> ( 2jmax )
-!!
-!! Cyclic condition along x and open condition along y:
-!! ------------------------------------------------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( imax ) <dyy> <dyy> ( 2jmax )
-!!
-!! Open condition along x and cyclic condition along y:
-!! ------------------------------------------------------
-!! <rhoj> 2 ( pi ) <rhoj> 2 ( pi )
-!! b(m,n) = -4 ----------- sin (----- m ) -4 ----------- sin (----- n )
-!! <dxx> <dxx> ( 2imax ) <dyy> <dyy> ( jmax )
-!!
-!! where m = 0,1,2....imax-1, n = 0,1,2....jmax-1
-!! Note that rhoj contains the Jacobian J = Deltax*Deltay*Deltaz = volume of
-!! an elementary mesh.
-
-!!
-!! EXTERNAL
-!! --------
-!! Function FFTFAX: initialization of TRIGSX,IFAXX,TRIGSY,IFAXY for
-!! the FFT transform
-!! GET_DIM_EXT_ll : get extended sub-domain sizes
-!! GET_INDICE_ll : get physical sub-domain bounds
-!! GET_DIM_PHYS_ll : get physical sub-domain sizes
-!! GET_GLOBALDIMS_ll : get physical global domain sizes
-!! GET_OR_ll : get origine coordonates of the physical sub-domain in global indices
-!! REDUCESUM_ll : sum into a scalar variable
-!! GET_SLICE_ll : get a slice of the global domain
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_CST : define constants
-!! XPI : pi
-!! XCPD
-!! Module MODD_PARAMETERS: declaration of parameter variables
-!! JPHEXT, JPVEXT: define the number of marginal points out of the
-!! physical domain along horizontal and vertical directions respectively
-!! Module MODD_CONF: model configurations
-!! LCARTESIAN: logical for CARTESIAN geometry
-!! .TRUE. = Cartesian geometry used
-!! L2D: logical for 2D model version
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of documentation (routine TRID)
-!!
-!! AUTHOR
-!! ------
-!! P. HÃ…reil and J. Stein * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 25/07/94
-!! 14/04/95 (J. Stein) bug in the ZDZM computation
-!! ( stretched case)
-!! 8/07/96 (P. Jabouille) change the FFT initialization
-!! which now works for odd number.
-!! 14/01/97 Durran anelastic equation (Stein,Lafore)
-!! 15/06/98 (D.Lugato, R.Guivarch) Parallelisation
-!! 10/08/98 (N. Asencio) add parallel code
-!! use PDXHAT, PDYHAT and not PXHAT,PYHAT
-!! PBFY is initialized
-!! 20/08/00 (J. Stein, J. Escobar) optimisation of the solver
-!! PBFY transposition
-!! 14/03/02 (P. Jabouille) set values for meaningless spectral coefficients
-!! (to avoid problem in bouissinesq configuration)
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-USE MODD_CST
-USE MODD_CONF
-USE MODD_LUNIT_n, ONLY: TLUOUT
-USE MODD_PARAMETERS
-!
-USE MODE_ll
-USE MODE_MSG
-!
-!JUAN
-USE MODE_REPRO_SUM
-!JUAN
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCX ! x-direction LBC type
-CHARACTER (LEN=4), DIMENSION(2), INTENT(IN) :: HLBCY ! y-direction LBC type
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! density of reference * J
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHVREF ! Virtual Potential
- ! Temperature of the reference state
-!
-REAL, DIMENSION(:,:), INTENT(IN) :: PMAP ! scale factor
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height z
-!
-REAL, DIMENSION(:), INTENT(IN) :: PDXHAT ! Stretching in x direction
-REAL, DIMENSION(:), INTENT(IN) :: PDYHAT ! Stretching in y direction
-!
-REAL, INTENT(OUT) :: PDXHATM ! mean grid increment in the x
- ! direction
-REAL, INTENT(OUT) :: PDYHATM ! mean grid increment in the y
- ! direction
-!
-REAL, DIMENSION (:), INTENT(OUT) :: PRHOM ! mean of XRHODJ on the plane
- ! x y localized at a mass
- ! level
-!
-REAL, DIMENSION(:), INTENT(OUT) :: PAF,PCF ! vectors giving the nonvanishing
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PBFY ! elements (yslice) of the tri-diag.
-! matrix in the pressure eq. which is transposed. PBFY is a y-slices structure
-!
- ! arrays of sin or cos values
- ! for the FFT :
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSX ! - along x
-REAL, DIMENSION(:), INTENT(OUT) :: PTRIGSY ! - along y
-!
- ! decomposition in prime
- ! numbers for the FFT:
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXX ! - along x
-INTEGER, DIMENSION(19), INTENT(OUT) :: KIFAXY ! - along y
-
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IRESP ! FM return code
-INTEGER :: ILUOUT ! Logical unit number for
- ! output-listing
-INTEGER :: IIB,IIE,IJB,IJE,IKB,IKE ! indice values of the physical subdomain
-INTEGER :: IKU ! size of the arrays along z
-INTEGER :: IIB_ll,IIE_ll,IJB_ll,IJE_ll ! indice values of the physical global domain
-INTEGER :: IIMAX,IJMAX ! Number of points of the physical subdomain
-INTEGER :: IIMAX_ll,IJMAX_ll ! Number of points of Global physical domain
-!
-INTEGER :: JI,JJ,JK ! loop indexes
-!
-INTEGER :: INN ! temporary result for the computation of array TRIGS
-!
-REAL, DIMENSION (:,:), ALLOCATABLE :: ZEIGEN_ll ! eigenvalues b(m,n) in global representation
-REAL, DIMENSION (:), ALLOCATABLE :: ZEIGENX_ll ! used for the computation of ZEIGEN_ll
-!
-REAL, DIMENSION( SIZE(PDXHAT)) :: ZWORKX ! work array to compute PDXHATM
-REAL, DIMENSION( SIZE(PDYHAT)) :: ZWORKY ! work array to compute PDYHATM
-!
-REAL :: ZGWNX,ZGWNY ! greater wave numbers allowed by the model
- ! configuration in x and y directions respectively
-!
-REAL, DIMENSION (SIZE(PZZ,3)) :: ZDZM ! mean of deltaz on the plane x y
- ! localized at a w-level
-!
-REAL :: ZANGLE,ZDEL ! needed for the initialization of the arrays used by the FFT
-!
-REAL :: ZINVMEAN ! inverse of inner points number in an horizontal grid
-!
-INTEGER :: IINFO_ll ! return code of parallel routine
-REAL, DIMENSION (SIZE(PMAP,1)) :: ZXMAP ! extraction of PMAP array along x
-REAL, DIMENSION (SIZE(PMAP,2)) :: ZYMAP ! extraction of PMAP array along y
-INTEGER :: IORXY_ll,IORYY_ll ! origin's coordinates of the y-slices subdomain
-INTEGER :: IIUY_ll,IJUY_ll ! dimensions of the y-slices subdomain
-INTEGER :: IXMODE_ll,IYMODE_ll ! number of modes in the x and y direction for global point of view
-INTEGER :: IXMODEY_ll,IYMODEY_ll ! number of modes in the x and y direction for y_slice point of view
-!JUAN16
-!TYPE(DOUBLE_DOUBLE) , DIMENSION (SIZE(PZZ,3)) :: ZRHOM_ll , ZDZM_ll
-REAL, ALLOCATABLE, DIMENSION(:,:) :: ZRHOM_2D , ZDZM_2D
-!JUAN16
-!
-!
-!
-!
-!
-!------------------------------------------------------------------------------
-!
-!* 1. INITIALIZATION
-! --------------
-!
-!* 1.1 retrieve a logical unit number
-! ------------------------------
-!
-ILUOUT = TLUOUT%NLU
-!
-!* 1.2 compute loop bounds
-! -------------------
-!
-! extended sub-domain
-CALL GET_DIM_EXT_ll ('Y',IIUY_ll,IJUY_ll)
-IKU=SIZE(PRHODJ,3)
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1 +JPVEXT
-IKE=IKU -JPVEXT
-! physical sub-domain
-CALL GET_DIM_PHYS_ll ( 'B',IIMAX,IJMAX)
-!
-! global physical domain limits
-CALL GET_GLOBALDIMS_ll ( IIMAX_ll, IJMAX_ll)
-IIB_ll = 1 + JPHEXT
-IIE_ll = IIMAX_ll + JPHEXT
-IJB_ll = 1 + JPHEXT
-IJE_ll = IJMAX_ll + JPHEXT
-!
-! the use of local array ZEIGENX and ZEIGEN would require some technical modifications
-!
-ALLOCATE (ZEIGENX_ll(IIMAX_ll + 2*JPHEXT))
-ALLOCATE (ZEIGEN_ll(IIMAX_ll + 2*JPHEXT, IJMAX_ll + 2*JPHEXT))
-ZEIGEN_ll = 0.0
-! Get the origin coordinates of the extended sub-domain in global landmarks
-CALL GET_OR_ll('Y',IORXY_ll,IORYY_ll)
-!
-!* 1.3 allocate x-slice array
-
-!
-!* 1.4 variables for the eigenvalues computation
-!
-ZGWNX = XPI/REAL(IIMAX_ll)
-ZGWNY = XPI/REAL(IJMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 2. COMPUTE THE AVERAGE OF RHOJ*CPD*THETAVREF ALONG XY
-! --------------------------------------------------
-!
-ZINVMEAN = 1./REAL(IIMAX_ll*IJMAX_ll)
-!JUAN16
-ALLOCATE(ZRHOM_2D(IIB:IIE, IJB:IJE))
-!
-DO JK = 1,SIZE(PZZ,3)
- IF ( CEQNSYS == 'DUR' .OR. CEQNSYS == 'MAE' ) THEN
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZRHOM_2D(JI,JJ) = PRHODJ(JI,JJ,JK)*XCPD*PTHVREF(JI,JJ,JK)*ZINVMEAN
- END DO
- END DO
- ELSEIF ( CEQNSYS == 'LHE' ) THEN
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZRHOM_2D(JI,JJ) = PRHODJ(JI,JJ,JK)*ZINVMEAN
- END DO
- END DO
- END IF
- ! global sum
- PRHOM(JK) = SUM_DD_R2_ll(ZRHOM_2D)
-END DO
-
-!
-! global sum
-!CALL REDUCESUM_ll(ZRHOM_ll,IINFO_ll)
-!PRHOM = ZRHOM_ll
-!JUAN16
-!
-!------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE MEAN INCREMENT BETWEEN Z LEVELS
-! -------------------------------------------
-!
-!JUAN16
-!ZDZM_ll = 0.
-ALLOCATE(ZDZM_2D(IIB:IIE, IJB:IJE))
-!
-DO JK = IKB-1,IKE
- DO JJ = IJB,IJE
- DO JI = IIB,IIE
- ZDZM_2D(JI,JJ) = (PZZ(JI,JJ,JK+1)-PZZ(JI,JJ,JK))*ZINVMEAN
- END DO
- END DO
- ZDZM(JK) = SUM_DD_R2_ll(ZDZM_2D)
-END DO
-ZDZM(IKE+1) = ZDZM(IKE)
-!
-! global sum
-!CALL REDUCESUM_ll(ZDZM_ll,IINFO_ll)
-!ZDZM = ZDZM_ll
-!JUAN16
-!
-!
-! vertical average to arrive at a w-level
-DO JK = IKE+1,IKB,-1
- ZDZM(JK) = (ZDZM(JK) + ZDZM(JK-1))*0.5
-END DO
-!
-ZDZM(IKB-1) = -999.
-!
-!------------------------------------------------------------------------------
-!
-!* 4. COMPUTE THE MEAN INCREMENT BETWEEN X LEVELS
-! -------------------------------------------
-!
-PDXHATM =0.
-! . local sum
-IF (LCARTESIAN) THEN
- PDXHATM = SUM_1DFIELD_ll ( PDXHAT,'X',IIB_ll,IIE_ll,IINFO_ll)
-ELSE
- ! Extraction of x-slice PMAP at j=(IJB_ll+IJE_ll)/2
- CALL GET_SLICE_ll (PMAP,'X',(IJB_ll+IJE_ll)/2,ZXMAP(IIB:IIE) &
- ,IIB,IIE,IINFO_ll)
- ! initialize the work array = PDXHAT/ZXMAP
- ZWORKX(IIB:IIE) = PDXHAT(IIB:IIE)/ ZXMAP (IIB:IIE)
- PDXHATM = SUM_1DFIELD_ll ( ZWORKX,'X',IIB_ll,IIE_ll,IINFO_ll)
-END IF
-! . division to complete sum
-PDXHATM = PDXHATM / REAL(IIMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 5. COMPUTE THE MEAN INCREMENT BETWEEN Y LEVELS
-! -------------------------------------------
-!
-PDYHATM = 0.
-IF (LCARTESIAN) THEN
- PDYHATM = SUM_1DFIELD_ll ( PDYHAT,'Y',IJB_ll,IJE_ll,IINFO_ll)
-ELSE
- ! Extraction of y-slice PMAP at i=IIB_ll+IIE_ll/2
- CALL GET_SLICE_ll (PMAP,'Y',(IIB_ll+IIE_ll)/2,ZYMAP(IJB:IJE) &
- ,IJB,IJE,IINFO_ll)
- ! initialize the work array = PDYHAT / ZYMAP
- ZWORKY(IJB:IJE) = PDYHAT(IJB:IJE) / ZYMAP (IJB:IJE)
- PDYHATM = SUM_1DFIELD_ll ( ZWORKY,'Y',IJB_ll,IJE_ll,IINFO_ll)
-END IF
-! . division to complete sum
-PDYHATM= PDYHATM / REAL(IJMAX_ll)
-!
-!------------------------------------------------------------------------------
-!
-!* 6. COMPUTE THE OUT-DIAGONAL ELEMENTS A AND C OF THE MATRIX
-! -------------------------------------------------------
-!
-DO JK = IKB,IKE
- PAF(JK) = 0.5 * ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2
- PCF(JK) = 0.5 * ( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1) **2
-END DO
-!
-! at the upper and lower levels PAF and PCF are computed using the Neumann
-! conditions applying on the vertical component of the gradient
-!
-PAF(IKE+1) = -0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / ZDZM(IKE+1) **2
-PCF(IKB-1) = 0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / ZDZM(IKB) **2
-!
-PAF(IKB-1) = 999.
-PCF(IKE+1) = 999.
-!------------------------------------------------------------------------------
-!* 7. COMPUTE THE DIAGONAL ELEMENTS B OF THE MATRIX
-! ---------------------------------------------
-!
-!* 7.1 compute the horizontal eigenvalues
-!
-!
-!* 7.1.1 compute the eigenvalues along the x direction
-!
-SELECT CASE (HLBCX(1))
-! in the cyclic case, the eigenvalues are the same for two following JM values:
-! it corresponds to the real and complex parts of the FFT
- CASE('CYCL') ! cyclic case
- IXMODE_ll = IIMAX_ll+2
- IXMODEY_ll = IIUY_ll
-!
- DO JI = 1,IXMODE_ll
- ZEIGENX_ll(JI) = - ( 2. * SIN ( (JI-1)/2*ZGWNX ) / PDXHATM )**2
- END DO
- CASE DEFAULT ! other cases
- IXMODE_ll = IIMAX_ll
-!
-!
- IF (LEAST_ll(HSPLITTING='Y')) THEN
- IXMODEY_ll = IIUY_ll - 2
- ELSE
- IXMODEY_ll = IIUY_ll
- END IF
-!
-!
- DO JI = 1,IXMODE_ll
- ZEIGENX_ll(JI) = - ( 2. *SIN (0.5*REAL(JI-1)*ZGWNX ) / PDXHATM )**2
- END DO
-END SELECT
-!
-!* 7.1.2 compute the eventual eigenvalues along the y direction
-!
-IF (.NOT. L2D) THEN
-!
-! y lateral boundary conditions for three-dimensional cases
-!
- SELECT CASE (HLBCY(1))
-! in the cyclic case, the eigenvalues are the same for two following JN values:
-! it corresponds to the real and complex parts of the FFT result
-!
- CASE('CYCL') ! 3D cyclic case
- IYMODE_ll = IJMAX_ll+2
- IYMODEY_ll = IJUY_ll
-!
- DO JJ = 1,IYMODE_ll
- DO JI = 1,IXMODE_ll
- ZEIGEN_ll(JI,JJ) = ZEIGENX_ll(JI) - &
- ( 2.* SIN ( (JJ-1)/2*ZGWNY ) / PDYHATM )**2
- END DO
- END DO
-!
- CASE DEFAULT ! 3D non-cyclic cases
- IYMODE_ll = IJMAX_ll
- IYMODEY_ll = IJUY_ll - 2
-!
- DO JJ = 1,IYMODE_ll
- DO JI = 1,IXMODE_ll
- ZEIGEN_ll(JI,JJ) = ZEIGENX_ll(JI) - ( 2.* SIN (0.5*REAL(JJ-1)*ZGWNY ) / &
- PDYHATM )**2
- END DO
- END DO
-!
- END SELECT
-ELSE
-!
-! copy the x eigenvalue array in a 2D array for a 2D case
-!
- IYMODE_ll = 1
- IYMODEY_ll = 1
- ZEIGEN_ll(1:IXMODE_ll,1)=ZEIGENX_ll(1:IXMODE_ll)
-!
-END IF
-!
-DEALLOCATE(ZEIGENX_ll)
-!
-!* 7.2 compute the matrix diagonal elements
-!
-!
-PBFY = 1.
-IF (L2D) THEN
- DO JK= IKB,IKE
- DO JJ= 1, IYMODEY_ll
- DO JI= 1, IXMODEY_ll
- PBFY(JI,JJ,JK) = PRHOM(JK)* ZEIGEN_ll(JI+IORXY_ll-1,JJ+IORYY_ll-1) - 0.5 * &
- ( ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2 &
- +( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1)**2 )
- END DO
- END DO
- END DO
-! at the upper and lower levels PBFY is computed using the Neumann
-! condition
-!
- PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKB-1) = -0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / &
- ZDZM(IKB) **2
- !
- PBFY(1:IXMODEY_ll,1:IYMODEY_ll,IKE+1) = 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / &
- ZDZM(IKE+1) **2
- !
-ELSE
- DO JK= IKB,IKE
- DO JJ= 1, IYMODEY_ll
- DO JI= 1, IXMODEY_ll
- PBFY(JJ,JI,JK) = PRHOM(JK)* ZEIGEN_ll(JI+IORXY_ll-1,JJ+IORYY_ll-1) - 0.5 * &
- ( ( PRHOM(JK-1) + PRHOM(JK) ) / ZDZM(JK) **2 &
- +( PRHOM(JK) + PRHOM(JK+1) ) / ZDZM(JK+1)**2 )
- END DO
- END DO
- END DO
-! at the upper and lower levels PBFY is computed using the Neumann
-! condition
-!
- PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKB-1) = -0.5 * ( PRHOM(IKB-1) + PRHOM(IKB) ) / &
- ZDZM(IKB) **2
- !
- PBFY(1:IYMODEY_ll,1:IXMODEY_ll,IKE+1) = 0.5 * ( PRHOM(IKE) + PRHOM(IKE+1) ) / &
- ZDZM(IKE+1) **2
- !
-END IF
-!
-DEALLOCATE(ZEIGEN_ll)
-!
-! second coefficent is meaningless in cyclic case
-IF (HLBCX(1) == 'CYCL' .AND. L2D) PBFY(2,:,:)=1.
-IF (HLBCX(1) == 'CYCL' .AND. .NOT.(L2D) .AND. LWEST_ll(HSPLITTING='Y')) PBFY(:,2,:)=1.
-IF (HLBCY(1) == 'CYCL' .AND. .NOT.(L2D)) PBFY(2,:,:)=1.
-!
-!------------------------------------------------------------------------------
-!* 8. INITIALIZATION OF THE TRIGS AND IFAX ARRAYS FOR THE FFT
-! -------------------------------------------------------
-!
-! 8.1 x lateral boundary conditions
-!
-CALL SET99(PTRIGSX,KIFAXX,IIMAX_ll)
-!
-! test on the value of KIMAX: KIMAX must be factorizable as a product
-! of powers of 2,3 and 5. KIFAXX(10) is equal to IIMAX if the decomposition
-! is correct, then KIFAXX(1) contains the number of decomposition factors
-! of KIMAX.
-!
-IF (KIFAXX(10) /= IIMAX_ll) THEN
- WRITE(UNIT=ILUOUT,FMT="(' ERROR',/, &
- &' : THE FORM OF THE FFT USED FOR THE INVERSION OF THE FLAT ',/,&
- &' OPERATOR REQUIRES THAT KIMAX MUST BE FACTORIZABLE' ,/,&
- & ' AS A PRODUCT OF POWERS OF 2, 3 AND 5.')")
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','TRID','')
-END IF
-!
-IF (HLBCX(1) /= 'CYCL') THEN
-!
-! extra trigs for shifted (co) sine transform (FFT55)
-!
- INN=2*(IIMAX_ll)
- ZDEL=ASIN(1.0)/REAL(IIMAX_ll)
- DO JI=1,IIMAX_ll
- ZANGLE=REAL(JI)*ZDEL
- PTRIGSX(INN+JI)=SIN(ZANGLE)
- END DO
-!
-ENDIF
-!
-! 8.2 y lateral boundary conditions
-!
-IF (.NOT. L2D) THEN
- CALL SET99(PTRIGSY,KIFAXY,IJMAX_ll)
- !
- ! test on the value of KJMAX: KJMAX must be factorizable as a product
- ! of powers of 2,3 and 5. KIFAXY(10) is equal to IJMAX_ll if the decomposition
- ! is correct, then KIFAXX(1) contains the number of decomposition factors
- ! of IIMAX_ll.
- !
- IF (KIFAXY(10) /= IJMAX_ll) THEN
- WRITE(UNIT=ILUOUT,FMT="(' ERROR',/, &
- &' : THE FORM OF THE FFT USED FOR THE INVERSION OF THE FLAT ',/,&
- &' OPERATOR REQUIRES THAT KJMAX MUST BE FACTORIZABLE' ,/,&
- & ' AS A PRODUCT OF POWERS OF 2, 3 AND 5.')")
- !callabortstop
- CALL PRINT_MSG(NVERB_FATAL,'GEN','TRID','')
- END IF
- !
- !
- ! other cases
- !
- IF (HLBCY(1) /= 'CYCL') THEN
- !
- ! extra trigs for shifted (co) sine transform
- !
- INN=2*(IJMAX_ll)
- ZDEL=ASIN(1.0)/REAL(IJMAX_ll)
- DO JJ=1,IJMAX_ll
- ZANGLE=REAL(JJ)*ZDEL
- PTRIGSY(INN+JJ)=SIN(ZANGLE)
- END DO
- !
- ENDIF
- !
-ENDIF
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE TRID
diff --git a/src/MNH/turb.f90 b/src/MNH/turb.f90
index 1eb7127f6fae74bd8729624ca4e8a7a8362622ab..115e9ce588ed13373c02869c843631d8b5da27ac 100644
--- a/src/MNH/turb.f90
+++ b/src/MNH/turb.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.
@@ -19,20 +19,21 @@ implicit none
private
-public :: turb
+public :: Turb
contains
! #################################################################
-SUBROUTINE TURB(KKA,KKU,KKL,KMI,KRR,KRRL,KRRI,HLBCX,HLBCY,KSPLIT,KMODEL_CL, &
- OCLOSE_OUT,OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
+ SUBROUTINE TURB(KKA, KKU, KKL, KMI,KRR,KRRL,KRRI,HLBCX,HLBCY, &
+ KSPLIT,KMODEL_CL, &
+ OTURB_FLX,OTURB_DIAG,OSUBG_COND,ORMC01, &
HTURBDIM,HTURBLEN,HTOM,HTURBLEN_CL,HCLOUD,PIMPL, &
PTSTEP,TPFILE,PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW,PCOSSLOPE,PSINSLOPE, &
PRHODJ,PTHVREF, &
PSFTH,PSFRV,PSFSV,PSFU,PSFV, &
PPABST,PUT,PVT,PWT,PTKET,PSVT,PSRCT, &
- PBL_DEPTH,PSBL_DEPTH, &
+ PBL_DEPTH, PSBL_DEPTH, &
PCEI,PCEI_MIN,PCEI_MAX,PCOEF_AMPL_SAT, &
PTHLT,PRT, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS,PRTKES,PRTKEMS,PSIGS,&
@@ -139,7 +140,6 @@ SUBROUTINE TURB(KKA,KKU,KKL,KMI,KRR,KRRL,KRRI,HLBCX,HLBCY,KSPLIT,KMODEL_CL, &
!! Module MODD_BUDGET:
!! NBUMOD
!! CBUTYPE
-!! NBUPROCCTR
!! LBU_RU
!! LBU_RV
!! LBU_RW
@@ -227,24 +227,41 @@ SUBROUTINE TURB(KKA,KKU,KKL,KMI,KRR,KRRL,KRRI,HLBCX,HLBCY,KSPLIT,KMODEL_CL, &
!! 10/2012 (J. Colin) Correct bug in DearDoff for dry simulations
!! 10/2012 J.Escobar Bypass PGI bug , redefine some allocatable array inplace of automatic
!! 04/2016 (C.Lac) correction of negativity for KHKO
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! 01/2018 (Q.Rodier) Introduction of RM17
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! Q. Rodier 01/2018: introduction of RM17
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 20/06/2019: take DELT and DEAR subroutines out of the TURB one (PGI compiler bug workaround) + transform into a mode_ module
-!! --------------------------------------------------------------------------
-!
+! 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
+! P. Wautelet 11/06/2020: bugfix: correct PRSVS array indices
+! P. Wautelet + Benoit Vié 06/2020: improve removal of negative scalar variables + adapt the corresponding budgets
+! P. Wautelet 30/06/2020: move removal of negative scalar variables to Sources_neg_correct
+! R. Honnert/V. Masson 02/2021: new mixing length in the grey zone
+! J.L. Redelsperger 03/2021: add Ocean LES case
+! --------------------------------------------------------------------------
+!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
+USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
-USE MODD_CONF
-USE MODD_BUDGET
+USE MODD_DYN_n, ONLY : LOCEAN
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_LS, XIBM_XMUT
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_NSV
+USE MODD_PARAMETERS, ONLY: JPVEXT_TURB
+USE MODD_PARAM_LIMA
+USE MODD_TURB_n, ONLY: XCADAP
!
+USE MODI_IBM_MIXINGLENGTH
USE MODI_GRADIENT_M
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
@@ -261,7 +278,6 @@ USE MODI_SHUMAN
USE MODI_SHUMAN_DEVICE
#endif
USE MODI_GRADIENT_M
-USE MODI_BUDGET
USE MODI_LES_MEAN_SUBGRID
USE MODI_RMC01
USE MODI_GRADIENT_W
@@ -269,18 +285,17 @@ USE MODI_TM06
USE MODI_UPDATE_LM
USE MODI_GET_HALO
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MPPDB
USE MODE_SBL
+use mode_sources_neg_correct, only: Sources_neg_correct
!
USE MODI_EMOIST
USE MODI_ETHETA
!
USE MODI_SECOND_MNH
!
-USE MODE_MPPDB
-!
-!! use, intrinsic :: ISO_C_BINDING
!
IMPLICIT NONE
!
@@ -299,8 +314,6 @@ INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
CHARACTER(LEN=*),DIMENSION(:),INTENT(IN):: HLBCX, HLBCY ! X- and Y-direc LBC
INTEGER, INTENT(IN) :: KSPLIT ! number of time-splitting
INTEGER, INTENT(IN) :: KMODEL_CL ! model number for cloud mixing length
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
@@ -361,6 +374,7 @@ REAL, INTENT(IN) :: PCOEF_AMPL_SAT ! saturation of the amplification coeff
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PTHLT ! conservative pot. temp.
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRT ! water var. where
! PRT(:,:,:,1) is the conservative mixing ratio
+!
! sources of momentum, conservative potential temperature, Turb. Kin. Energy,
! TKE dissipation
REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PRUS,PRVS,PRWS,PRTHLS,PRTKES
@@ -394,6 +408,7 @@ REAL, ALLOCATABLE, DIMENSION(:,:,:) ::&
ZEXN, & ! EXN at t-1
ZT, & ! T at t-1
ZLOCPEXNM, & ! Lv/Cp/EXNREF at t-1
+ ZLMW, & ! Turbulent mixing length (work array)
ZLEPS, & ! Dissipative length
ZTRH, & ! Dynamic and Thermal Production of TKE
ZATHETA,ZAMOIST, & ! coefficients for s = f (Thetal,Rnp)
@@ -434,8 +449,9 @@ INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
INTEGER :: JRR,JK,JSV ! loop counters
INTEGER :: JI,JJ ! loop counters
REAL :: ZL0 ! Max. Mixing Length in Blakadar formula
-REAL :: ZALPHA ! proportionnality constant between Dz/2 and
-! ! BL89 mixing length near the surface
+REAL :: ZALPHA ! work coefficient :
+ ! - proportionnality constant between Dz/2 and
+! ! BL89 mixing length near the surface
!
REAL :: ZTIME1, ZTIME2
REAL, DIMENSION(:,:,:), allocatable :: ZTT,ZEXNE,ZLV,ZCPH
@@ -536,7 +552,7 @@ ALLOCATE (ZFR2 (SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) )
ALLOCATE (ZFTHR (SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) )
ALLOCATE (ZTHLM (SIZE(PTHLT,1),SIZE(PTHLT,2),SIZE(PTHLT,3)) )
-IF ( HTURBLEN == 'BL89' .OR. HTURBLEN == 'RM17' .OR. ORMC01 ) &
+IF ( HTURBLEN == 'BL89' .OR. HTURBLEN == 'RM17' .OR. HTURBLEN == 'ADAP' .OR. ORMC01 ) &
ALLOCATE ( ZRM(SIZE(PRT,1),SIZE(PRT,2),SIZE(PRT,3),SIZE(PRT,4)) )
ALLOCATE ( ZTAU11M(SIZE(PTHLT,1),SIZE(PTHLT,2)) )
@@ -559,10 +575,10 @@ IF ( HCLOUD == 'KHKO' .OR. HCLOUD == 'C2R2' ) then
allocate( zlv (size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zcph (size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
end if
-IF ( HTURBLEN == 'BL89' .OR. HTURBLEN == 'RM17' ) then
+IF ( HTURBLEN == 'BL89' .OR. HTURBLEN == 'RM17' .OR. HTURBLEN == 'ADAP' ) then
allocate( zshear(size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
end if
-IF ( HTURBLEN == 'RM17' ) then
+IF ( HTURBLEN == 'RM17' .OR. HTURBLEN == 'ADAP' ) then
allocate( zdudz (size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
allocate( zdvdz (size( put, 1 ), size( put, 2 ), size( put, 3 ) ) )
end if
@@ -607,7 +623,7 @@ ZRVORD= XRV / XRD
!$acc update device(PTHLT,PRT)
!$acc kernels
!Copy data into ZTHLM and ZRM only if needed
-IF (HTURBLEN=='BL89' .OR. HTURBLEN=='RM17' .OR. ORMC01) THEN
+IF (HTURBLEN=='BL89' .OR. HTURBLEN=='RM17' .OR. HTURBLEN == 'ADAP' .OR. ORMC01) THEN
ZTHLM(:,:,:) = PTHLT(:,:,:)
ZRM(:,:,:,:) = PRT(:,:,:,:)
END IF
@@ -634,14 +650,18 @@ END DO
!
!* 2.2 Exner function at t
!
+IF (LOCEAN) THEN
+ ZEXN(:,:,:) = 1.
+ELSE
!PW: "BUG" PGI : results different on CPU and GPU due to the power function
!See http://www.pgroup.com/userforum/viewtopic.php?t=5364&sid=ec7b762b17fb9bb3332a47f0db57af55
!Use of own functions allows bit-reproducible results
#ifndef MNH_BITREP
-ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
+ ZEXN(:,:,:) = (PPABST(:,:,:)/XP00) ** (XRD/XCPD)
#else
-ZEXN(:,:,:) = BR_POW(PPABST(:,:,:)/XP00,XRD/XCPD)
+ ZEXN(:,:,:) = BR_POW(PPABST(:,:,:)/XP00,XRD/XCPD)
#endif
+END IF
!
!* 2.3 dissipative heating coeff a t
!
@@ -699,7 +719,7 @@ IF (KRRL >=1) THEN
END IF
!
!
- IF (OCLOSE_OUT .AND. OTURB_DIAG) THEN
+ IF ( tpfile%lopened .AND. OTURB_DIAG ) THEN
!$acc update self(ZAMOIST,ZATHETA)
TZFIELD%CMNHNAME = 'ATHETA'
TZFIELD%CSTDNAME = ''
@@ -786,20 +806,41 @@ SELECT CASE (HTURBLEN)
ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
!
-!* 3.3 Delta mixing length
+!* 3.3 Grey-zone combined RM17 & Deardorff mixing lengths
+! --------------------------------------------------
+
+ CASE ('ADAP')
+#ifdef MNH_OPENACC
+ call Print_msg( NVERB_FATAL, 'GEN', 'TURB', 'OpenACC: HTURBLEN=ADAP not yet implemented' )
+#endif
+ ZDUDZ = MXF(MZF(GZ_U_UW(PUT,PDZZ)))
+ ZDVDZ = MYF(MZF(GZ_V_VW(PVT,PDZZ)))
+ ZSHEAR = SQRT(ZDUDZ*ZDUDZ + ZDVDZ*ZDVDZ)
+ CALL BL89(KKA,KKU,KKL,PZZ,PDZZ,PTHVREF,ZTHLM,KRR,ZRM,PTKET,ZSHEAR,PLEM)
+
+ CALL DELT(KKA,KKU,KKL,IKB, IKE,IKTB, IKTE,ORMC01,HTURBDIM,PDXX, PDYY,PZZ,PDIRCOSZW,ZLMW,ODZ=.FALSE.)
+ ! The minimum mixing length is chosen between Horizontal grid mesh (not taking into account the vertical grid mesh) and RM17.
+ ! For large horizontal grid meshes, this is equal to RM17
+ ! For LES grid meshes, this is equivalent to Deardorff : the base mixing lentgh is the horizontal grid mesh,
+ ! and it is limited by a stability-based length (RM17), as was done in Deardorff length (but taking into account shear as well)
+ ! For grid meshes in the grey zone, then this is the smaller of the two.
+ PLEM = MIN(PLEM,XCADAP*ZLMW)
+!
+!* 3.4 Delta mixing length
! -------------------
!
CASE ('DELT')
- CALL DELT(KKA,KKU,KKL,IKB, IKE,IKTB, IKTE,ORMC01,HTURBDIM,PDXX, PDYY,PZZ,PDIRCOSZW,PLEM)
+ CALL DELT(KKA,KKU,KKL,IKB, IKE,IKTB, IKTE,ORMC01,HTURBDIM,PDXX, PDYY,PZZ,PDIRCOSZW,PLEM,ODZ=.TRUE.)
!
-!* 3.4 Deardorff mixing length
+!* 3.5 Deardorff mixing length
! -----------------------
!
CASE ('DEAR')
CALL DEAR(KKA,KKU,KKL,KRR, KRRI, IKB, IKE,IKTB, IKTE, &
ORMC01,HTURBDIM,PDXX, PDYY, PDZZ,PZZ,PDIRCOSZW,PTHLT,PTHVREF,PTKET,PSRCT,PRT,&
ZLOCPEXNM,ZATHETA, ZAMOIST, PLEM)
-!* 3.5 Blackadar mixing length
+!
+!* 3.6 Blackadar mixing length
! -----------------------
!
CASE ('BLKR')
@@ -868,12 +909,22 @@ IF (ORMC01) THEN
!$acc update device(PLEM,ZLEPS)
END IF
!
+!RMC01 is only applied on RM17 in ADAP
+IF (HTURBLEN=='ADAP') ZLEPS = MIN(ZLEPS,ZLMW*XCADAP)
+!
!* 3.8 Mixing length in external points (used if HTURBDIM="3DIM")
! ----------------------------------------------------------
!
IF (HTURBDIM=="3DIM") THEN
CALL UPDATE_LM(HLBCX,HLBCY,PLEM,ZLEPS)
END IF
+!
+!* 3.9 Mixing length correction if immersed walls
+! ------------------------------------------
+!
+IF (LIBM) THEN
+ CALL IBM_MIXINGLENGTH(PLEM,ZLEPS,XIBM_XMUT,XIBM_LS(:,:,:,1),PTKET)
+ENDIF
!----------------------------------------------------------------------------
!
!* 4. GO INTO THE AXES FOLLOWING THE SURFACE
@@ -990,10 +1041,44 @@ ENDIF
!* 5. TURBULENT SOURCES
! -----------------
!
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'VTURB', prus (:, :, :) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'VTURB', prvs (:, :, :) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'VTURB', prws (:, :, :) )
+
+if ( lbudget_th ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) )
+ end if
+end if
+
+if ( lbudget_rv ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
+ else
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) )
+ end if
+end if
+
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'VTURB', prrs (:, :, :, 2) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'VTURB', prrs (:, :, :, 4) )
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'VTURB', prsvs(:, :, :, jsv) )
+ end do
+end if
+
!$acc update device(PRHODJ)
!$acc update device(PRUS,PRVS,PRWS,PRSVS)
CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OCLOSE_OUT,OTURB_FLX, &
+ OTURB_FLX, &
HTURBDIM,HTOM,PIMPL,ZEXPL, &
PTSTEP,TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
@@ -1009,60 +1094,78 @@ CALL TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS, &
PDYP,PTHP,PSIGS,PWTH,PWRC,PWSV )
!$acc update self(PWTH,PWRC,PWSV)
+
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'VTURB', prus(:, :, :) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'VTURB', prvs(:, :, :) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'VTURB', prws(:, :, :) )
+
+if ( lbudget_th ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'VTURB', prthls(:, :, :) )
+ end if
+end if
+
+if ( lbudget_rv ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'VTURB', prrs(:, :, :, 1) )
+ end if
+end if
+
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'VTURB', prrs(:, :, :, 2) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'VTURB', prrs(:, :, :, 4) )
+
+if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'VTURB', prsvs(:, :, :, jsv) )
+ end do
+end if
!
-#ifdef MNH_OPENACC
-IF ( ( LBUDGET_TH .AND. ( ( KRRI >= 1 .AND. KRRL >= 1 ) .OR. ( KRRL >= 1 ) ) ) .OR. &
- LBUDGET_RV .OR. LBUDGET_RC .OR. LBUDGET_RI ) THEN
-!$acc update self(PRRS)
-ENDIF
-#endif
-!
-IF (LBUDGET_U) THEN
-!$acc update self(PRUS)
- CALL BUDGET (PRUS,1,'VTURB_BU_RU')
-END IF
-IF (LBUDGET_V) THEN
-!$acc update self(PRVS)
- CALL BUDGET (PRVS,2,'VTURB_BU_RV')
-END IF
-IF (LBUDGET_W) THEN
-!$acc update self(PRWS)
- CALL BUDGET (PRWS,3,'VTURB_BU_RW')
-END IF
-IF (LBUDGET_TH) THEN
-!$acc update self(PRTHLS)
- IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
-!$acc update self(ZLVOCPEXNM,ZLSOCPEXNM)
- CALL BUDGET (PRTHLS+ ZLVOCPEXNM * PRRS(:,:,:,2) + ZLSOCPEXNM * PRRS(:,:,:,4),4,'VTURB_BU_RTH')
- ELSE IF ( KRRL >= 1 ) THEN
-!$acc update self(ZLOCPEXNM)
- CALL BUDGET (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'VTURB_BU_RTH')
- ELSE
- CALL BUDGET (PRTHLS,4,'VTURB_BU_RTH')
- END IF
-END IF
-IF (LBUDGET_SV) THEN
-!$acc update self(PRSVS)
- DO JSV = 1,NSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'VTURB_BU_RSV')
- END DO
-END IF
-IF (LBUDGET_RV) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2)-PRRS(:,:,:,4),6,'VTURB_BU_RRV')
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2),6,'VTURB_BU_RRV')
- ELSE
- CALL BUDGET (PRRS(:,:,:,1),6,'VTURB_BU_RRV')
- END IF
-END IF
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'VTURB_BU_RRC')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'VTURB_BU_RRI')
-!
-!
-IF (HTURBDIM=='3DIM') THEN
+if ( hturbdim == '3DIM' ) then
+ if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'HTURB', prus (:, :, :) )
+ if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'HTURB', prvs (:, :, :) )
+ if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'HTURB', prws (:, :, :) )
+
+ if (lbudget_th) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_init( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) )
+ end if
+ end if
+
+ if ( lbudget_rv ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
+ else
+ call Budget_store_init( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) )
+ end if
+ end if
+
+ if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'HTURB', prrs(:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'HTURB', prrs(:, :, :, 4) )
+
+ if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + jsv), 'HTURB', prsvs(:, :, :, jsv) )
+ end do
+ end if
+
CALL TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
- HLBCX,HLBCY,OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -1076,48 +1179,44 @@ IF (HTURBDIM=='3DIM') THEN
PDYP,PTHP,PSIGS, &
ZTRH, &
PRUS,PRVS,PRWS,PRTHLS,PRRS,PRSVS )
-END IF
+
+ if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U), 'HTURB', prus(:, :, :) )
+ if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V), 'HTURB', prvs(:, :, :) )
+ if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W), 'HTURB', prws(:, :, :) )
+
+ if ( lbudget_th ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlvocpexnm(:, :, :) * prrs(:, :, :, 2) &
+ + zlsocpexnm(:, :, :) * prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) + zlocpexnm(:, :, :) * prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_TH), 'HTURB', prthls(:, :, :) )
+ end if
+ end if
+
+ if ( lbudget_rv ) then
+ if ( krri >= 1 .and. krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) - prrs(:, :, :, 4) )
+ else if ( krrl >= 1 ) then
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) - prrs(:, :, :, 2) )
+ else
+ call Budget_store_end( tbudgets(NBUDGET_RV), 'HTURB', prrs(:, :, :, 1) )
+ end if
+ end if
+
+ if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'HTURB', prrs(:, :, :, 2) )
+ if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'HTURB', prrs(:, :, :, 4) )
+
+ if ( lbudget_sv ) then
+ do jsv = 1, nsv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + jsv), 'HTURB', prsvs(:, :, :, jsv) )
+ end do
+ end if
+end if
+
!$acc update self(PSIGS,PRUS,PRVS,PRWS,PRSVS)
-!
-!
-#ifdef MNH_OPENACC
-IF ( ( LBUDGET_TH .AND. ( ( KRRI >= 1 .AND. KRRL >= 1 ) .OR. ( KRRL >= 1 ) ) ) .OR. &
- LBUDGET_RV .OR. LBUDGET_RC .OR. LBUDGET_RI ) THEN
-!$acc update self(PRRS)
-ENDIF
-#endif
-!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'HTURB_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'HTURB_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'HTURB_BU_RW')
-IF (LBUDGET_TH) THEN
-!$acc update self(PRTHLS)
- IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ZLVOCPEXNM*PRRS(:,:,:,2)+ZLSOCPEXNM*PRRS(:,:,:,4) &
- ,4,'HTURB_BU_RTH')
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ ZLOCPEXNM * PRRS(:,:,:,2),4,'HTURB_BU_RTH')
- ELSE
- CALL BUDGET (PRTHLS,4,'HTURB_BU_RTH')
- END IF
-END IF
-IF (LBUDGET_SV) THEN
- DO JSV = 1,NSV
- CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'HTURB_BU_RSV')
- END DO
-END IF
-IF (LBUDGET_RV) THEN
- IF ( KRRI >= 1 .AND. KRRL >= 1) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2)-PRRS(:,:,:,4),6,'HTURB_BU_RRV')
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRRS(:,:,:,1)-PRRS(:,:,:,2),6,'HTURB_BU_RRV')
- ELSE
- CALL BUDGET (PRRS(:,:,:,1),6,'HTURB_BU_RRV')
- END IF
-END IF
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'HTURB_BU_RRC')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'HTURB_BU_RRI')
-!
+
!----------------------------------------------------------------------------
!
!* 6. EVOLUTION OF THE TKE AND ITS DISSIPATION
@@ -1140,33 +1239,21 @@ CALL TKE_EPS_SOURCES(KKA,KKU,KKL,KMI,PTKET,PLEM,ZLEPS,PDYP,ZTRH, &
PRHODJ,PDZZ,PDXX,PDYY,PDZX,PDZY,PZZ, &
PTSTEP,PIMPL,ZEXPL, &
HTURBLEN,HTURBDIM, &
- TPFILE,OCLOSE_OUT,OTURB_DIAG, &
+ TPFILE,OTURB_DIAG, &
PTHP,PRTKES,PRTKEMS,PRTHLS,ZCOEF_DISS,PTR,PDISS )
!
!$acc update self(PTR,PDISS)
!$acc update self(PDYP,PTHP)
!
!$acc update self(PRTKES)
-IF (LBUDGET_TH) THEN
-!$acc update self(PRTHLS)
- IF ( KRRI >= 1 .AND. KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ZLVOCPEXNM*PRRS(:,:,:,2)+ZLSOCPEXNM*PRRS(:,:,:,4) &
- ,4,'DISSH_BU_RTH')
- ELSE IF ( KRRL >= 1 ) THEN
- CALL BUDGET (PRTHLS+ZLOCPEXNM* PRRS(:,:,:,2),4,'DISSH_BU_RTH')
- ELSE
- CALL BUDGET (PRTHLS,4,'DISSH_BU_RTH')
- END IF
-END IF
-!
+
!----------------------------------------------------------------------------
!
!* 7. STORES SOME INFORMATIONS RELATED TO THE TURBULENCE SCHEME
! ---------------------------------------------------------
!
!$acc update self(PLEM)
-!
-IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
!
! stores the mixing length
!
@@ -1246,37 +1333,12 @@ IF ( KRRL >= 1 ) THEN
!$acc update self(PRT(:,:,:,1))
END IF
END IF
+
!$acc update self(PRRS,PTHLT,PRTHLS)
-!
-IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
-#ifdef MNH_OPENACC
- call Print_msg( NVERB_FATAL, 'GEN', 'TURB', 'OpenACC: HCLOUD=KHKO or C2R2 not yet implemented' )
-#endif
- ZEXNE(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
- ZTT(:,:,:)= PTHLT(:,:,:)*ZEXNE(:,:,:)
- ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZTT(:,:,:)-XTT)
- ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
-! CALL GET_HALO(PRRS(:,:,:,2))
-! CALL GET_HALO(PRSVS(:,:,:,2))
-! CALL GET_HALO(PRSVS(:,:,:,3))
- WHERE (PRRS(:,:,:,2) < 0. .OR. PRSVS(:,:,:,2) < 0.)
- PRSVS(:,:,:,1) = 0.0
- END WHERE
- DO JSV = 2, 3
- WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,JSV) < 0.)
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,JSV)
- PRTHLS(:,:,:) = PRTHLS(:,:,:) - PRRS(:,:,:,JSV) * ZLV(:,:,:) / &
- ZCPH(:,:,:) / ZEXNE(:,:,:)
- PRRS(:,:,:,JSV) = 0.0
- PRSVS(:,:,:,JSV) = 0.0
- END WHERE
- END DO
-!
- IF (LBUDGET_TH) CALL BUDGET (PRTHLS(:,:,:), 4,'NETUR_BU_RTH')
- IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1), 6,'NETUR_BU_RRV')
- IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2), 7,'NETUR_BU_RRC')
-END IF
-!
+
+! Remove non-physical negative values (unnecessary in a perfect world) + corresponding budgets
+call Sources_neg_correct( hcloud, 'NETUR', krr, ptstep, ppabst, pthlt, prt, prthls, prrs, prsvs )
+
!----------------------------------------------------------------------------
!
!* 9. LES averaged surface fluxes
@@ -1766,7 +1828,7 @@ ELSE
!* 3.2 Delta mixing length
! -------------------
CASE ('DELT')
- CALL DELT(KKA,KKU,KKL,IKB, IKE,IKTB, IKTE,ORMC01,HTURBDIM,PDXX, PDYY,PZZ,PDIRCOSZW,ZLM_CLOUD)
+ CALL DELT(KKA,KKU,KKL,IKB, IKE,IKTB, IKTE,ORMC01,HTURBDIM,PDXX, PDYY,PZZ,PDIRCOSZW,ZLM_CLOUD,ODZ=.TRUE.)
!
!* 3.3 Deardorff mixing length
! -----------------------
@@ -1782,7 +1844,7 @@ ENDIF
! -----------------------------------------------
!
! Impression before modification of the mixing length
-IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'LM_CLEAR_SKY'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'LM_CLEAR_SKY'
@@ -1808,7 +1870,7 @@ WHERE (PCEI(:,:,:) == -1.) PLEM(:,:,:) = ZLM_CLOUD(:,:,:)
!* 5. IMPRESSION
! ----------
!
-IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'COEF_AMPL'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'COEF_AMPL'
@@ -1843,7 +1905,7 @@ END SUBROUTINE TURB
!###################
-SUBROUTINE DELT(KKA,KKU,KKL,KKB, KKE,KKTB, KKTE,ORMC01,HTURBDIM,PDXX, PDYY,PZZ,PDIRCOSZW,PLM)
+SUBROUTINE DELT(KKA,KKU,KKL,KKB, KKE,KKTB, KKTE,ORMC01,HTURBDIM,PDXX, PDYY,PZZ,PDIRCOSZW,PLM, ODZ)
!###################
!!
!!**** *DELT* routine to compute mixing length for DELT case
@@ -1862,7 +1924,8 @@ SUBROUTINE DELT(KKA,KKU,KKL,KKB, KKE,KKTB, KKTE,ORMC01,HTURBDIM,PDXX, PDYY,PZZ,P
!
!* 0. DECLARATIONS
! ------------
-use modd_conf, only: l2d
+use modd_conf, only: l2d
+USE MODD_DYN_n, ONLY: LOCEAN
use mode_mppdb
@@ -1892,6 +1955,7 @@ REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! physical distance
REAL, DIMENSION(:,:), INTENT(IN) :: PDIRCOSZW
! Director Cosinus along x, y and z directions at surface w-point
REAL, DIMENSION(:,:,:), INTENT(OUT) :: PLM
+LOGICAL, INTENT(IN) :: ODZ
!
!
!* 0.2 Declarations of local variables
@@ -1924,43 +1988,79 @@ allocate( ztmp2_device( size( pdxx, 1 ), size( pdxx, 2 ), size( pdxx, 3 ) ) )
!$acc data create( ztmp1_device, ztmp2_device )
+IF (ODZ) THEN
!$acc kernels
-DO JK = KKTB,KKTE ! 1D turbulence scheme
- PLM(:,:,JK) = PZZ(:,:,JK+KKL) - PZZ(:,:,JK)
-END DO
-PLM(:,:,KKU) = PLM(:,:,KKE)
-PLM(:,:,KKA) = PZZ(:,:,KKB) - PZZ(:,:,KKA)
+ ! Dz is take into account in the computation
+ DO JK = KKTB,KKTE ! 1D turbulence scheme
+ PLM(:,:,JK) = PZZ(:,:,JK+KKL) - PZZ(:,:,JK)
+ END DO
+ PLM(:,:,KKU) = PLM(:,:,KKE)
+ PLM(:,:,KKA) = PZZ(:,:,KKB) - PZZ(:,:,KKA)
!$acc end kernels
-IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
- IF ( L2D ) THEN
+ IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
+ IF ( L2D) THEN
#ifndef MNH_OPENACC
- PLM(:,:,:) = SQRT( PLM(:,:,:)*MXF(PDXX(:,:,:)) )
+ PLM(:,:,:) = SQRT( PLM(:,:,:)*MXF(PDXX(:,:,:)) )
#else
- CALL MXF_DEVICE( PDXX, ZTMP1_DEVICE )
+ CALL MXF_DEVICE( PDXX, ZTMP1_DEVICE )
!$acc kernels
- PLM(:,:,:) = SQRT( PLM(:,:,:) * ZTMP1_DEVICE )
+ PLM(:,:,:) = SQRT( PLM(:,:,:) * ZTMP1_DEVICE )
!$acc end kernels
#endif
- ELSE
+ ELSE
#ifndef MNH_OPENACC
#ifndef MNH_BITREP
- PLM(:,:,:) = (PLM(:,:,:)*MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./3.)
+ PLM(:,:,:) = (PLM(:,:,:)*MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./3.)
+#else
+ PLM(:,:,:) = BR_POW( PLM(:, :, : ) * MXF( PDXX(:, :, : ) ) * MYF( PDYY(:, :, : ) ), 1. / 3. )
+#endif
+#else
+ CALL MXF_DEVICE( PDXX, ZTMP1_DEVICE )
+ CALL MYF_DEVICE( PDYY, ZTMP2_DEVICE )
+!$acc kernels
+#ifndef MNH_BITREP
+ PLM(:,:,:) = ( PLM(:,:,:) * ZTMP1_DEVICE * ZTMP2_DEVICE ) ** (1./3.)
+#else
+ PLM(:,:,:) = BR_POW( PLM(:,:,:) * ZTMP1_DEVICE * ZTMP2_DEVICE, 1./3. )
+#endif
+!$acc end kernels
+#endif
+ END IF
+ END IF
+ELSE
+ ! Dz not taken into account in computation to assure invariability with vertical grid mesh
+!$acc kernels
+ PLM=1.E10
+!$acc end kernels
+ IF ( HTURBDIM /= '1DIM' ) THEN ! 3D turbulence scheme
+ IF ( L2D) THEN
+#ifndef MNH_OPENACC
+ PLM(:,:,:) = MXF(PDXX(:,:,:))
+#else
+ CALL MXF_DEVICE( PDXX, PLM )
+#endif
+ ELSE
+#ifndef MNH_OPENACC
+#ifndef MNH_BITREP
+ PLM(:,:,:) = (MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)) ) ** (1./2.)
#else
- PLM(:,:,:) = BR_POW( PLM(:, :, : ) * MXF( PDXX(:, :, : ) ) * MYF( PDYY(:, :, : ) ), 1. / 3. )
+ PLM(:,:,:) = BR_POW(MXF(PDXX(:,:,:))*MYF(PDYY(:,:,:)), 1. / 2. )
#endif
#else
- CALL MXF_DEVICE( PDXX, ZTMP1_DEVICE )
- CALL MYF_DEVICE( PDYY, ZTMP2_DEVICE )
+ CALL MXF_DEVICE( PDXX, ZTMP1_DEVICE )
+ CALL MYF_DEVICE( PDYY, ZTMP2_DEVICE )
!$acc kernels
#ifndef MNH_BITREP
- PLM(:,:,:) = ( PLM(:,:,:) * ZTMP1_DEVICE * ZTMP2_DEVICE ) ** (1./3.)
+ PLM(:,:,:) = ( ZTMP1_DEVICE * ZTMP2_DEVICE ) ** (1./2.)
#else
- PLM(:,:,:) = BR_POW( PLM(:,:,:) * ZTMP1_DEVICE * ZTMP2_DEVICE, 1./3. )
+ PLM(:,:,:) = BR_POW( ZTMP1_DEVICE * ZTMP2_DEVICE, 1. / 2. )
#endif
!$acc end kernels
#endif
+ END IF
END IF
END IF
+
!
! mixing length limited by the distance normal to the surface
! (with the same factor as for BL89)
@@ -1975,14 +2075,25 @@ IF (.NOT. ORMC01) THEN
!
DO JJ=1,SIZE(PLM,2)
DO JI=1,SIZE(PLM,1)
- DO JK=KKTB,KKTE
- ZD = ZALPHA * ( 0.5 * ( PZZ(JI, JJ, JK ) + PZZ(JI, JJ, JK+KKL ) ) - PZZ(JI, JJ, KKB ) ) * PDIRCOSZW(JI, JJ )
- IF ( PLM(JI,JJ,JK) > ZD ) THEN
- PLM(JI,JJ,JK) = ZD
- ELSE
- EXIT
- ENDIF
- END DO
+ IF (LOCEAN) THEN
+ DO JK=KKTE,KKTB,-1
+ ZD=ZALPHA*(PZZ(JI,JJ,KKTE+1)-PZZ(JI,JJ,JK))
+ IF ( PLM(JI,JJ,JK)>ZD) THEN
+ PLM(JI,JJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ELSE
+ DO JK=KKTB,KKTE
+ ZD = ZALPHA * ( 0.5 * ( PZZ(JI, JJ, JK) + PZZ(JI, JJ, JK+KKL) ) - PZZ(JI, JJ, KKB) ) * PDIRCOSZW(JI, JJ)
+ IF ( PLM(JI,JJ,JK) > ZD ) THEN
+ PLM(JI,JJ,JK) = ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ENDIF
END DO
END DO
END IF
@@ -2027,8 +2138,9 @@ SUBROUTINE DEAR(KKA,KKU,KKL,KRR, KRRI, KKB, KKE,KKTB, KKTE, &
!
!* 0. DECLARATIONS
! ------------
-use modd_conf, only: l2d
-use modd_cst, only: XG, XMNH_EPSILON
+use modd_conf, only: l2d
+use modd_cst, only: XALPHAOC, XBETAOC, XG, XMNH_EPSILON
+USE MODD_DYN_n, ONLY: LOCEAN
use mode_mppdb
@@ -2184,7 +2296,6 @@ CALL EMOIST(KRR,KRRI,PTHLT,PRT,PLOCPEXNM,PAMOIST,PSRCT,ZEMOIST)
#endif
!
!$acc kernels
-! For dry simulations
IF (KRR>0) THEN
!$acc loop independent collapse(3) private(ZVAR)
DO JK = KKTB+1,KKTE-1
@@ -2194,8 +2305,12 @@ IF (KRR>0) THEN
(PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
ZDRTDZ(JI,JJ,JK) = 0.5*((PRT(JI,JJ,JK+KKL,1)-PRT(JI,JJ,JK ,1))/PDZZ(JI,JJ,JK+KKL)+ &
(PRT(JI,JJ,JK ,1)-PRT(JI,JJ,JK-KKL,1))/PDZZ(JI,JJ,JK ))
- ZVAR=XG/PTHVREF(JI,JJ,JK)* &
+ IF (LOCEAN) THEN
+ ZVAR=XG*(XALPHAOC*ZDTHLDZ(JI,JJ,JK)-XBETAOC*ZDRTDZ(JI,JJ,JK))
+ ELSE
+ ZVAR=XG/PTHVREF(JI,JJ,JK)* &
(ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)+ZEMOIST(JI,JJ,JK)*ZDRTDZ(JI,JJ,JK))
+ END IF
!
IF (ZVAR>0.) THEN
PLM(JI,JJ,JK)=MAX(XMNH_EPSILON,MIN(PLM(JI,JJ,JK), &
@@ -2204,15 +2319,19 @@ IF (KRR>0) THEN
END DO
END DO
END DO
-ELSE
+ELSE! For dry atmos or unsalted ocean runs
!$acc loop independent collapse(3) private(ZVAR)
DO JK = KKTB+1,KKTE-1
DO JJ=1,SIZE(PLM,2)
DO JI=1,SIZE(PLM,1)
ZDTHLDZ(JI,JJ,JK)= 0.5*((PTHLT(JI,JJ,JK+KKL)-PTHLT(JI,JJ,JK ))/PDZZ(JI,JJ,JK+KKL)+ &
(PTHLT(JI,JJ,JK )-PTHLT(JI,JJ,JK-KKL))/PDZZ(JI,JJ,JK ))
- ZVAR=XG/PTHVREF(JI,JJ,JK)*ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)
- !
+ IF (LOCEAN) THEN
+ ZVAR= XG*XALPHAOC*ZDTHLDZ(JI,JJ,JK)
+ ELSE
+ ZVAR= XG/PTHVREF(JI,JJ,JK)*ZETHETA(JI,JJ,JK)*ZDTHLDZ(JI,JJ,JK)
+ END IF
+!
IF (ZVAR>0.) THEN
PLM(JI,JJ,JK)=MAX(XMNH_EPSILON,MIN(PLM(JI,JJ,JK), &
0.76* SQRT(PTKET(JI,JJ,JK)/ZVAR)))
@@ -2230,8 +2349,12 @@ ELSE
ZDRTDZ(:,:,KKB)=0
ENDIF
!
-ZWORK2D(:,:)=XG/PTHVREF(:,:,KKB)* &
- (ZETHETA(:,:,KKB)*ZDTHLDZ(:,:,KKB)+ZEMOIST(:,:,KKB)*ZDRTDZ(:,:,KKB))
+IF (LOCEAN) THEN
+ ZWORK2D(:,:)=XG*(XALPHAOC*ZDTHLDZ(:,:,KKB)-XBETAOC*ZDRTDZ(:,:,KKB))
+ELSE
+ ZWORK2D(:,:)=XG/PTHVREF(:,:,KKB)* &
+ (ZETHETA(:,:,KKB)*ZDTHLDZ(:,:,KKB)+ZEMOIST(:,:,KKB)*ZDRTDZ(:,:,KKB))
+END IF
WHERE(ZWORK2D(:,:)>0.)
PLM(:,:,KKB)=MAX(XMNH_EPSILON,MIN( PLM(:,:,KKB), &
0.76* SQRT(PTKET(:,:,KKB)/ZWORK2D(:,:))))
@@ -2244,15 +2367,26 @@ IF (.NOT. ORMC01) THEN
!
DO JJ=1,SIZE(PLM,2)
DO JI=1,SIZE(PLM,1)
- DO JK=KKTB,KKTE
- ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))-PZZ(JI,JJ,KKB)) &
- *PDIRCOSZW(JI,JJ)
- IF ( PLM(JI,JJ,JK)>ZD) THEN
- PLM(JI,JJ,JK)=ZD
- ELSE
- EXIT
- ENDIF
- END DO
+ IF (LOCEAN) THEN
+ DO JK=KKTE,KKTB,-1
+ ZD=ZALPHA*(PZZ(JI,JJ,KKTE+1)-PZZ(JI,JJ,JK))
+ IF ( PLM(JI,JJ,JK)>ZD) THEN
+ PLM(JI,JJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ELSE
+ DO JK=KKTB,KKTE
+ ZD=ZALPHA*(0.5*(PZZ(JI,JJ,JK)+PZZ(JI,JJ,JK+KKL))-PZZ(JI,JJ,KKB)) &
+ *PDIRCOSZW(JI,JJ)
+ IF ( PLM(JI,JJ,JK)>ZD) THEN
+ PLM(JI,JJ,JK)=ZD
+ ELSE
+ EXIT
+ ENDIF
+ END DO
+ ENDIF
END DO
END DO
END IF
diff --git a/src/MNH/turb_cloud_index.f90 b/src/MNH/turb_cloud_index.f90
index 811d8ee1dd3ca0f1224398987e1c74d736f9301d..c194db61154a5c3fe6fcf2308dae47d01720856c 100644
--- a/src/MNH/turb_cloud_index.f90
+++ b/src/MNH/turb_cloud_index.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_CLOUD_INDEX(PTSTEP,TPFILE, &
- OTURB_DIAG,OCLOSE_OUT,KRRI, &
+ OTURB_DIAG,KRRI, &
PRRS,PRM,PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY, &
PCEI )
!
@@ -20,8 +20,6 @@ REAL, INTENT(IN) :: PTSTEP ! Double Time step
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
! diagnostic fields in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS ! Sources term of RR
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Variable at t-dt
@@ -41,7 +39,7 @@ END MODULE MODI_TURB_CLOUD_INDEX
!
! #######################
SUBROUTINE TURB_CLOUD_INDEX(PTSTEP,TPFILE, &
- OTURB_DIAG,OCLOSE_OUT,KRRI, &
+ OTURB_DIAG,KRRI, &
PRRS,PRM,PRHODJ,PDXX,PDYY,PDZZ,PDZX,PDZY, &
PCEI )
! #######################
@@ -85,10 +83,10 @@ END MODULE MODI_TURB_CLOUD_INDEX
!
!-------------------------------------------------------------------------------
!
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS, ONLY: JPVEXT
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_tools_ll, only: GET_INDICE_ll
!
@@ -105,8 +103,6 @@ REAL, INTENT(IN) :: PTSTEP ! Double Time step
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
LOGICAL, INTENT(IN) :: OTURB_DIAG ! switch to write some
! diagnostic fields in the syncronous FM-file
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRRS ! Sources term of RR
REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRM ! Variable at t-dt
@@ -247,7 +243,7 @@ ENDDO
!
!* 2.5 Writing
!
-IF ( OTURB_DIAG .AND. OCLOSE_OUT ) THEN
+IF ( OTURB_DIAG .AND. tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'RVCI'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'RVCI'
diff --git a/src/MNH/turb_hor.f90 b/src/MNH/turb_hor.f90
index a9842851ec5a0419ba35b3dd821f97bee5064cc6..0d10395bcef33797e3cb09ae2b4ce3fa005b39aa 100644
--- a/src/MNH/turb_hor.f90
+++ b/src/MNH/turb_hor.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_HOR(KSPLT, KRR, KRRL, KRRI, PTSTEP, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -34,8 +34,6 @@ INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
REAL, INTENT(IN) :: PTSTEP !
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
@@ -109,7 +107,7 @@ END INTERFACE
END MODULE MODI_TURB_HOR
! ################################################################
SUBROUTINE TURB_HOR(KSPLT, KRR, KRRL, KRRI, PTSTEP, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -268,8 +266,6 @@ INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
REAL, INTENT(IN) :: PTSTEP !
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
@@ -422,7 +418,7 @@ end if
!* 7. < V' TPV' >
!
CALL TURB_HOR_THERMO_FLUX(KSPLT, KRR, KRRL, KRRI, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND, &
TPFILE, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -437,7 +433,7 @@ end if
!
IF (KSPLT==1) &
CALL TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND, &
TPFILE, &
PINV_PDXX,PINV_PDYY, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -452,7 +448,7 @@ end if
!* 11. < W'W'>
!
CALL TURB_HOR_DYN_CORR(KSPLT, PTSTEP, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
TPFILE, &
PK,PINV_PDZZ, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
@@ -469,7 +465,7 @@ end if
!* 12. < U'V'>
!
CALL TURB_HOR_UV(KSPLT, &
- OCLOSE_OUT,OTURB_FLX, &
+ OTURB_FLX, &
TPFILE, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -485,7 +481,7 @@ end if
!* 13. < U'W'>
!
CALL TURB_HOR_UW(KSPLT, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
TPFILE, &
PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDZZ,PDZX, &
@@ -499,7 +495,7 @@ end if
!* 14. < V'W'>
!
CALL TURB_HOR_VW(KSPLT, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
TPFILE, &
PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDYY,PDZZ,PDZY, &
@@ -513,7 +509,7 @@ end if
!* 15. HORIZONTAL FLUXES OF PASSIVE SCALARS
!
CALL TURB_HOR_SV_FLUX(KSPLT, &
- OCLOSE_OUT,OTURB_FLX, &
+ OTURB_FLX, &
TPFILE, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
diff --git a/src/MNH/turb_hor_dyn_corr.f90 b/src/MNH/turb_hor_dyn_corr.f90
index 3fc86172e3ed23fe6d5729977f9841976775013f..469bc39ba71a7d941b431d41b612f7887dd2c3ac 100644
--- a/src/MNH/turb_hor_dyn_corr.f90
+++ b/src/MNH/turb_hor_dyn_corr.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.
@@ -8,7 +8,7 @@ MODULE MODI_TURB_HOR_DYN_CORR
INTERFACE
!
SUBROUTINE TURB_HOR_DYN_CORR(KSPLT, PTSTEP, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
TPFILE, &
PK,PINV_PDZZ, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
@@ -26,8 +26,6 @@ USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
REAL, INTENT(IN) :: PTSTEP ! timestep
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -77,7 +75,7 @@ END INTERFACE
END MODULE MODI_TURB_HOR_DYN_CORR
! ################################################################
SUBROUTINE TURB_HOR_DYN_CORR(KSPLT, PTSTEP, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
TPFILE, &
PK,PINV_PDZZ, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
@@ -145,13 +143,13 @@ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_NSV
!
USE MODE_ll
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
!
@@ -183,8 +181,6 @@ IMPLICIT NONE
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
REAL, INTENT(IN) :: PTSTEP ! timestep
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -613,7 +609,7 @@ ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
!$acc update device(ZFLX) async(10)
!
-IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
! stores <U U>
TZFIELD%CMNHNAME = 'U_VAR'
TZFIELD%CSTDNAME = ''
@@ -800,7 +796,7 @@ ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
CALL UPDATE_HALO_ll(TZFIELDS_ll, IINFO_ll)
!$acc update device(ZFLX) async(10)
!
-IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
! stores <V V>
TZFIELD%CMNHNAME = 'V_VAR'
TZFIELD%CSTDNAME = ''
@@ -979,7 +975,7 @@ ZFLX(:,:,IKB-1) = &
ZFLX(:,:,IKB-1) = 2. * ZFLX(:,:,IKB-1) - ZFLX(:,:,IKB)
!$acc end kernels
!
-IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
!$acc wait(3)
!$acc update self(ZFLX)
! stores <W W>
diff --git a/src/MNH/turb_hor_splt.f90 b/src/MNH/turb_hor_splt.f90
index 452aeddec086feff3c20ca4d96ea7570fc031c8f..e0bf14aa321c9fd93648b616e02303cbdde96d88 100644
--- a/src/MNH/turb_hor_splt.f90
+++ b/src/MNH/turb_hor_splt.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
- HLBCX,HLBCY,OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -34,8 +34,6 @@ INTEGER, INTENT(IN) :: KRRL ! number of liquid water v
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
REAL, INTENT(IN) :: PTSTEP ! timestep
CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX,HLBCY
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
@@ -104,7 +102,7 @@ END INTERFACE
END MODULE MODI_TURB_HOR_SPLT
! ################################################################
SUBROUTINE TURB_HOR_SPLT(KSPLIT, KRR, KRRL, KRRI, PTSTEP, &
- HLBCX,HLBCY,OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ HLBCX,HLBCY,OTURB_FLX,OSUBG_COND, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -283,8 +281,6 @@ INTEGER, INTENT(IN) :: KRRL ! number of liquid water v
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
REAL, INTENT(IN) :: PTSTEP ! timestep
CHARACTER (LEN=*), DIMENSION(:), INTENT(IN) :: HLBCX,HLBCY
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
@@ -540,7 +536,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
!
! compute the turbulent tendencies for the small time step
CALL TURB_HOR(JSPLT, KRR, KRRL, KRRI, PTSTEP, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
@@ -726,7 +722,7 @@ IF (KSPLIT>1 .AND. CPROGRAM=='MESONH') THEN
ELSE
!
CALL TURB_HOR(1, KRR, KRRL, KRRI, PTSTEP, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PZZ, &
PDIRCOSXW,PDIRCOSYW,PDIRCOSZW, &
diff --git a/src/MNH/turb_hor_sv_flux.f90 b/src/MNH/turb_hor_sv_flux.f90
index 2d3ce6c4ef3489e3201afa00f9db03e29ea7b38a..723c8d56727e5c205015d5ea9c4fa0225ca15028 100644
--- a/src/MNH/turb_hor_sv_flux.f90
+++ b/src/MNH/turb_hor_sv_flux.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_HOR_SV_FLUX(KSPLT, &
- OCLOSE_OUT,OTURB_FLX, &
+ OTURB_FLX, &
TPFILE, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -23,8 +23,6 @@ INTERFACE
USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -57,7 +55,7 @@ END INTERFACE
END MODULE MODI_TURB_HOR_SV_FLUX
! ################################################################
SUBROUTINE TURB_HOR_SV_FLUX(KSPLT, &
- OCLOSE_OUT,OTURB_FLX, &
+ OTURB_FLX, &
TPFILE, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -114,13 +112,13 @@ END MODULE MODI_TURB_HOR_SV_FLUX
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_NSV, ONLY: NSV_LGBEG, NSV_LGEND
USE MODD_LES
USE MODD_BLOWSNOW
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
!
@@ -146,8 +144,6 @@ IMPLICIT NONE
!
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -342,7 +338,7 @@ DO JSV=1,ISV
#endif
!
! stores <U SVth>
- IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
WRITE(TZFIELD%CMNHNAME,'("USV_FLX_",I3.3)') JSV
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
@@ -455,7 +451,7 @@ DO JSV=1,ISV
#endif
!
! stores <V SVth>
- IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
WRITE(TZFIELD%CMNHNAME,'("VSV_FLX_",I3.3)') JSV
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
diff --git a/src/MNH/turb_hor_thermo_corr.f90 b/src/MNH/turb_hor_thermo_corr.f90
index 6e1e1ba278f3ea3bd842986b26237b8fa071d2e5..8d8f86309b41946f1f385388903475f894ebcd2b 100644
--- a/src/MNH/turb_hor_thermo_corr.f90
+++ b/src/MNH/turb_hor_thermo_corr.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND, &
TPFILE, &
PINV_PDXX,PINV_PDYY, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -25,8 +25,6 @@ USE MODD_IO, ONLY: TFILEDATA
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
@@ -67,7 +65,7 @@ END INTERFACE
END MODULE MODI_TURB_HOR_THERMO_CORR
! ################################################################
SUBROUTINE TURB_HOR_THERMO_CORR(KRR, KRRL, KRRI, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND, &
TPFILE, &
PINV_PDXX,PINV_PDYY, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -122,11 +120,11 @@ END MODULE MODI_TURB_HOR_THERMO_CORR
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
!
@@ -159,8 +157,6 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
@@ -199,7 +195,7 @@ REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PSIGS
!
REAL, DIMENSION(:,:,:), allocatable :: ZFLX,ZWORK,ZA ! work arrays
!
-INTEGER :: IKB,IKE,IKU
+INTEGER :: IKB,IKE
! Index values for the Beginning and End
! mass points of the domain
REAL, DIMENSION(:,:,:), allocatable :: ZCOEFF
@@ -294,7 +290,7 @@ ZCOEFF(:,:,IKB)= - (PDZZ(:,:,IKB+2)+2.*PDZZ(:,:,IKB+1)) / &
!
!
!
-IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
+IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. tpfile%lopened ) &
.OR. ( LLES_CALL ) ) THEN
!
!* 8.1 <THl THl>
@@ -402,7 +398,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
!$acc end kernels
!
! stores <THl THl>
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'THL_HVAR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'THL_HVAR'
@@ -600,7 +596,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
END IF
!$acc end kernels
! stores <THl Rnp>
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'THLR_HCOR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'THLR_HCOR'
@@ -776,7 +772,7 @@ IF ( ( KRRL > 0 .AND. OSUBG_COND) .OR. ( OTURB_FLX .AND. OCLOSE_OUT ) &
END IF
!$acc end kernels
! stores <Rnp Rnp>
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'R_HVAR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'R_HVAR'
diff --git a/src/MNH/turb_hor_thermo_flux.f90 b/src/MNH/turb_hor_thermo_flux.f90
index f50efc83e59cb99dbc4ab89f03a88e30eaca6fb3..b18d2c6f46c8079c373ef0538895763e3c993429 100644
--- a/src/MNH/turb_hor_thermo_flux.f90
+++ b/src/MNH/turb_hor_thermo_flux.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_HOR_THERMO_FLUX(KSPLT, KRR, KRRL, KRRI, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND, &
TPFILE, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -27,8 +27,6 @@ INTEGER, INTENT(IN) :: KSPLT ! split process index
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
@@ -74,7 +72,7 @@ END INTERFACE
END MODULE MODI_TURB_HOR_THERMO_FLUX
! ################################################################
SUBROUTINE TURB_HOR_THERMO_FLUX(KSPLT, KRR, KRRL, KRRI, &
- OCLOSE_OUT,OTURB_FLX,OSUBG_COND, &
+ OTURB_FLX,OSUBG_COND, &
TPFILE, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -132,11 +130,11 @@ END MODULE MODI_TURB_HOR_THERMO_FLUX
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
!
@@ -164,8 +162,6 @@ INTEGER, INTENT(IN) :: KSPLT ! split process index
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
LOGICAL, INTENT(IN) :: OSUBG_COND ! Switch for sub-grid
@@ -548,7 +544,7 @@ END IF
!!ZWORK(:,:,:) = ZFLX(:,:,:)
!
! stores the horizontal <U THl>
-IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UTHL_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UTHL_FLX'
@@ -689,7 +685,7 @@ IF (KRR/=0) THEN
END IF
!
! stores the horizontal <U Rnp>
- IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UR_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UR_FLX'
@@ -950,7 +946,7 @@ END IF
!! ZFLX(:,:,:)*MXM(EMOIST(KRR,KRRI,PTHLT,PEXNREF,PRT,PLOCPT,PSRCM))
!! !
!! ! stores the horizontal <U VPT>
-!! IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+!! IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
!! TZFIELD%CMNHNAME = 'UVPT_FLX'
!! TZFIELD%CSTDNAME = ''
!! TZFIELD%CLONGNAME = 'UVPT_FLX'
@@ -1057,7 +1053,7 @@ END IF
!!ZWORK(:,:,:) = ZFLX(:,:,:)
!
! stores the horizontal <V THl>
-IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'VTHL_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'VTHL_FLX'
@@ -1395,7 +1391,7 @@ IF (KRR/=0) THEN
END IF
!
! stores the horizontal <V Rnp>
- IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+ IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'VR_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'VR_FLX'
@@ -1677,7 +1673,7 @@ END IF
!! END IF
!! !
!! ! stores the horizontal <V VPT>
-!! IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+!! IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
!! TZFIELD%CMNHNAME = 'VVPT_FLX'
!! TZFIELD%CSTDNAME = ''
!! TZFIELD%CLONGNAME = 'VVPT_FLX'
diff --git a/src/MNH/turb_hor_uv.f90 b/src/MNH/turb_hor_uv.f90
index d8ab326ee5cfddefdfbef79696a1b607148cc9eb..d3d1c46dc6ab5541959a827451c4af772d05d019 100644
--- a/src/MNH/turb_hor_uv.f90
+++ b/src/MNH/turb_hor_uv.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_HOR_UV(KSPLT, &
- OCLOSE_OUT,OTURB_FLX, &
+ OTURB_FLX, &
TPFILE, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -25,8 +25,6 @@ INTERFACE
USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -73,7 +71,7 @@ END INTERFACE
END MODULE MODI_TURB_HOR_UV
! ################################################################
SUBROUTINE TURB_HOR_UV(KSPLT, &
- OCLOSE_OUT,OTURB_FLX, &
+ OTURB_FLX, &
TPFILE, &
PK,PINV_PDXX,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -128,11 +126,11 @@ END MODULE MODI_TURB_HOR_UV
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
!
@@ -161,8 +159,6 @@ IMPLICIT NONE
!
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
TYPE(TFILEDATA), INTENT(IN) :: TPFILE ! Output file
@@ -208,7 +204,7 @@ REAL, DIMENSION(:,:,:), allocatable :: ZFLX,ZWORK ! work arrays
!
REAL, DIMENSION(:,:), allocatable :: ZDIRSINZW
! sinus of the angle between the vertical and the normal to the orography
-INTEGER :: IKB,IKE,IKU
+INTEGER :: IKB,IKE
! Index values for the Beginning and End
! mass points of the domain
!
@@ -293,7 +289,6 @@ allocate( ztmp7_device(size( pum, 1 ), size( pum, 2 ), size( pum, 3 ) ) )
!
IKB = 1+JPVEXT
IKE = SIZE(PUM,3)-JPVEXT
-IKU = SIZE(PUM,3)
!
!$acc kernels
#ifndef MNH_BITREP
@@ -449,7 +444,7 @@ ZFLX(:,:,IKB-1) = 2. * ZTMP2_DEVICE(:,:,1) - ZFLX(:,:,IKB)
#endif
!
! stores <U V>
-IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UV_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UV_FLX'
diff --git a/src/MNH/turb_hor_uw.f90 b/src/MNH/turb_hor_uw.f90
index f64d43c2a8f31ff5e8f5ae775567ad4ef98b776c..f6e5b972cc48f6448a60f8926e8b3f8ce09b2c13 100644
--- a/src/MNH/turb_hor_uw.f90
+++ b/src/MNH/turb_hor_uw.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_HOR_UW(KSPLT, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
TPFILE, &
PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDZZ,PDZX, &
@@ -23,8 +23,6 @@ INTERFACE
USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -59,7 +57,7 @@ END INTERFACE
END MODULE MODI_TURB_HOR_UW
! ################################################################
SUBROUTINE TURB_HOR_UW(KSPLT, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
TPFILE, &
PK,PINV_PDXX,PINV_PDZZ,PMZM_PRHODJ, &
PDXX,PDZZ,PDZX, &
@@ -117,12 +115,12 @@ END MODULE MODI_TURB_HOR_UW
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_NSV
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
!
@@ -148,8 +146,6 @@ IMPLICIT NONE
!
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -285,7 +281,7 @@ ZFLX(:,:,IKB-1)=2.*ZFLX(:,:,IKB)- ZFLX(:,:,IKB+1)
!$acc end kernels
!
! stores <U W>
-IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'UW_HFLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'UW_HFLX'
diff --git a/src/MNH/turb_hor_vw.f90 b/src/MNH/turb_hor_vw.f90
index 475a4972e0d5624612004f55e1efcc75ed5a696e..0bc690ba35dbafc05a8bbeaae49e2797ceff88b3 100644
--- a/src/MNH/turb_hor_vw.f90
+++ b/src/MNH/turb_hor_vw.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_HOR_VW(KSPLT, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
TPFILE, &
PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDYY,PDZZ,PDZY, &
@@ -23,8 +23,6 @@ INTERFACE
USE MODD_IO, ONLY: TFILEDATA
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -58,7 +56,7 @@ END INTERFACE
END MODULE MODI_TURB_HOR_VW
! ################################################################
SUBROUTINE TURB_HOR_VW(KSPLT, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
TPFILE, &
PK,PINV_PDYY,PINV_PDZZ,PMZM_PRHODJ, &
PDYY,PDZZ,PDZY, &
@@ -116,12 +114,12 @@ END MODULE MODI_TURB_HOR_VW
USE MODD_CST
USE MODD_CONF
USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_NSV
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
!
@@ -147,8 +145,6 @@ IMPLICIT NONE
!
!
INTEGER, INTENT(IN) :: KSPLT ! split process index
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -263,34 +259,22 @@ END IF
!
! residual part of < V'W'> depending on dw/dy
!
-#ifndef MNH_OPENACC
IF (.NOT. L2D) THEN
+#ifndef MNH_OPENACC
ZFLX(:,:,:) = &
- XCMFS * MYM(MZM(PK)) * GY_W_VW_PWM
- !! & to be tested
- !! - (2./3.) * XCMFB * MZM( ZVPTV * MYM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
-ELSE
- ZFLX(:,:,:) = 0.
- !! & to be tested
- !! - (2./3.) * XCMFB * MZM( ZVPTV * MYM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
-END IF
#else
-IF (.NOT. L2D) THEN
CALL MZM_DEVICE(PK,ZTMP1_DEVICE)
CALL MYM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE)
!$acc kernels
ZFLX(:,:,:) = - XCMFS * ZTMP2_DEVICE * GY_W_VW_PWM
!$acc end kernels
- !! & to be tested
- !! - (2./3.) * XCMFB * MZM( ZVPTV * MYM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
+#endif
ELSE
!$acc kernels
ZFLX(:,:,:) = 0.
!$acc end kernels
- !! & to be tested
- !! - (2./3.) * XCMFB * MZM( ZVPTV * MYM( PLM / SQRT(PTKEM) * XG / PTHVREF ) )
END IF
-#endif
!
!$acc kernels
ZFLX(:,:,IKE+1) = 0. ! rigid wall condition => no turbulent flux
@@ -303,7 +287,7 @@ ZFLX(:,:,IKB-1)= 2.*ZFLX(:,:,IKB) - ZFLX(:,:,IKB+1)
!$acc end kernels
!
! stores <V W>
-IF ( OCLOSE_OUT .AND. OTURB_FLX ) THEN
+IF ( tpfile%lopened .AND. OTURB_FLX ) THEN
TZFIELD%CMNHNAME = 'VW_HFLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'VW_HFLX'
diff --git a/src/MNH/turb_ver.f90 b/src/MNH/turb_ver.f90
index b188f0778fd498f13ee0698be23738e54586f4a2..0f4e3e0b2d9894f0e21f7a7d8a40c081d1ad49be 100644
--- a/src/MNH/turb_ver.f90
+++ b/src/MNH/turb_ver.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.
@@ -10,8 +10,8 @@
INTERFACE
!
SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX, &
- HTURBDIM,HTOM,PIMPL,PEXPL, &
+ OTURB_FLX, &
+ HTURBDIM,HTOM,PIMPL,PEXPL, &
PTSTEP, TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
@@ -32,8 +32,6 @@ USE MODD_IO, ONLY: TFILEDATA
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
@@ -118,8 +116,8 @@ END MODULE MODI_TURB_VER
!
! ###############################################################
SUBROUTINE TURB_VER(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OCLOSE_OUT,OTURB_FLX, &
- HTURBDIM,HTOM,PIMPL,PEXPL, &
+ OTURB_FLX, &
+ HTURBDIM,HTOM,PIMPL,PEXPL, &
PTSTEP, TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW,PZZ, &
PCOSSLOPE,PSINSLOPE, &
@@ -224,10 +222,10 @@ END MODULE MODI_TURB_VER
!! _(M,UW,...) represent the localization of the
!! field derivated
!!
-!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
!! of a variable located at a mass point
!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
!! of a variable located at a wind point
!!
!! FUNCTIONs ETHETA and EMOIST :
@@ -312,6 +310,7 @@ END MODULE MODI_TURB_VER
!! 08/2014 (J.Escobar) Bypass PGI memory leak bug , replace IF statement with IF THEN ENDIF
!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! JL Redelsperger 03/2021 : add Ocean LES case
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -319,11 +318,12 @@ END MODULE MODI_TURB_VER
!
USE MODD_CST
USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_NSV, ONLY: NSV
-USE MODD_BLANK
!
USE MODI_PRANDTL
USE MODI_GRADIENT_M
@@ -336,7 +336,6 @@ USE MODI_TURB_VER_SV_CORR
USE MODI_LES_MEAN_SUBGRID
USE MODI_SBL_DEPTH
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
USE MODE_PRANDTL
@@ -355,8 +354,6 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
@@ -458,9 +455,9 @@ REAL, DIMENSION(:,:,:), allocatable :: &
REAL, DIMENSION(:,:,:,:), allocatable :: &
ZPSI_SV, & ! Prandtl number for scalars
- ZREDS1, & ! 1D Redeslperger number R_sv
- ZRED2THS, & ! 3D Redeslperger number R*2_thsv
- ZRED2RS ! 3D Redeslperger number R*2_rsv
+ ZREDS1, & ! 1D Redelsperger number R_sv
+ ZRED2THS, & ! 3D Redelsperger number R*2_thsv
+ ZRED2RS ! 3D Redelsperger number R*2_rsv
!
LOGICAL :: GUSERV ! flag to use water vapor
INTEGER :: IKB,IKE ! index value for the Beginning
@@ -584,7 +581,7 @@ IKE=KKU-JPVEXT_TURB*KKL
! 3D Redelsperger numbers
!
!
-CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OCLOSE_OUT,OTURB_FLX, &
+CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OTURB_FLX, &
HTURBDIM, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY, &
@@ -599,7 +596,11 @@ CALL PRANDTL(KKA,KKU,KKL,KRR,KRRI,OCLOSE_OUT,OTURB_FLX, &
! Buoyancy coefficient
!
!$acc kernels
-ZBETA(:,:,:) = XG/PTHVREF(:,:,:)
+IF (LOCEAN) THEN
+ ZBETA(:,:,:) = XG*XALPHAOC
+ELSE
+ ZBETA(:,:,:) = XG/PTHVREF(:,:,:)
+END IF
!
! Square root of Tke
!
@@ -687,7 +688,7 @@ END IF
! ----------------------------------------------------------------
!
CALL TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
+ OTURB_FLX,HTURBDIM,HTOM, &
PIMPL,PEXPL,PTSTEP, &
TPFILE, &
PDZZ,PDIRCOSZW,PZZ, &
@@ -703,7 +704,7 @@ END IF
PRTHLS,PRRS,ZTHLP,ZRP,PTP,PWTH,PWRC )
!
CALL TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
+ OTURB_FLX,HTURBDIM,HTOM, &
PIMPL,PEXPL, &
TPFILE, &
PDZZ, &
@@ -730,7 +731,7 @@ END IF
! -----------------------------------------------
!
CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
HTURBDIM,PIMPL,PEXPL,PTSTEP, &
TPFILE, &
PDXX,PDYY,PDZZ,PDZX,PDZY,PDIRCOSZW, &
@@ -750,7 +751,7 @@ CALL TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
!
IF (SIZE(PSVM,4)>0) &
CALL TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM, &
+ OTURB_FLX,HTURBDIM, &
PIMPL,PEXPL,PTSTEP, &
TPFILE, &
PDZZ,PDIRCOSZW, &
@@ -784,7 +785,7 @@ IF (SIZE(PSBL_DEPTH)>0) CALL SBL_DEPTH(IKB,IKE,PZZ,ZWU,ZWV,ZWTHV,PLMO,PSBL_DEPTH
! ------
!
!
-IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
!
! stores the Turbulent Prandtl number
!
diff --git a/src/MNH/turb_ver_dyn_flux.f90 b/src/MNH/turb_ver_dyn_flux.f90
index 879867dd012481e2da8e2b37872bf932e8ed3a1d..efc6b85c5c06ee447d814e45f57e46e7fcf3684b 100644
--- a/src/MNH/turb_ver_dyn_flux.f90
+++ b/src/MNH/turb_ver_dyn_flux.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
HTURBDIM,PIMPL,PEXPL, &
PTSTEP, &
TPFILE, &
@@ -28,8 +28,6 @@ USE MODD_IO, ONLY: TFILEDATA
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -85,7 +83,7 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!
! ###############################################################
SUBROUTINE TURB_VER_DYN_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,KRR, &
+ OTURB_FLX,KRR, &
HTURBDIM,PIMPL,PEXPL, &
PTSTEP, &
TPFILE, &
@@ -194,10 +192,10 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!! DXF,DYF,DZF,DZM
!! : Shuman functions (difference operators)
!!
-!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
!! of a variable located at a mass point
!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
!! of a variable located at a wind point
!!
!! FUNCTIONs ETHETA and EMOIST :
@@ -279,6 +277,7 @@ END MODULE MODI_TURB_VER_DYN_FLUX
!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Q. Rodier 17/01/2019 : cleaning : remove cyclic conditions on DP and ZA
+!! JL Redelsperger 03/2021 : Add Ocean & O-A Autocoupling LES Cases
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -287,10 +286,15 @@ END MODULE MODI_TURB_VER_DYN_FLUX
USE MODD_CONF
USE MODD_CST
USE MODD_CTURB
+USE MODD_DYN_n, ONLY: LOCEAN
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LES
USE MODD_NSV
+USE MODD_OCEANH
USE MODD_PARAMETERS
+USE MODD_REF, ONLY : LCOUPLES
+USE MODD_TURB_n
!
#ifdef MNH_BITREP
USE MODI_BITREP
@@ -309,10 +313,12 @@ USE MODI_SHUMAN_DEVICE
USE MODI_TRIDIAG
USE MODI_TRIDIAG_WIND
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
use mode_mppdb
+#ifdef MNH_OPENACC
+USE MODE_MSG
+#endif
!
IMPLICIT NONE
!
@@ -323,8 +329,6 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
INTEGER, INTENT(IN) :: KRR ! number of moist var.
@@ -572,45 +576,74 @@ ZTMP1_DEVICE(:,:,1) = ZCOEFS(:,:,1) / PDZZ(:,:,IKB)
CALL MXM_DEVICE(ZTMP1_DEVICE(:,:,1:1),ZCOEFS(:,:,1:1))
#endif
!
-! compute the explicit tangential flux at the W point
+!
+! ZSOURCE= FLUX /DZ
+IF (LOCEAN) THEN ! OCEAN MODEL ONLY
+#ifdef MNH_OPENACC
+ call Print_msg( NVERB_FATAL, 'GEN', 'TURB_VER_DYN_FLUX', 'OpenACC: LOCEAN=T not yet implemented' )
+#endif
+ ! Sfx flux assumed to be in SI & at vorticity point
+ IF (LCOUPLES) THEN
+ ZSOURCE(:,:,IKE:IKE) = XSSUFL_C(:,:,1:1)/PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)))
+ ELSE
+ ZSOURCE(:,:,IKE) = XSSUFL(:,:)
+ ZSOURCE(:,:,IKE:IKE) = ZSOURCE (:,:,IKE:IKE) /PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)) )
+ ENDIF
+ !No flux at the ocean domain bottom
+ ZSOURCE(:,:,IKB) = 0.
+ ZSOURCE(:,:,IKTB+1:IKTE-1) = 0
+!
+ELSE !ATMOS MODEL ONLY
+ IF (LCOUPLES) THEN
+#ifdef MNH_OPENACC
+ call Print_msg( NVERB_FATAL, 'GEN', 'TURB_VER_DYN_FLUX', 'OpenACC: LCOUPLES=T not yet implemented' )
+#endif
+ ZSOURCE(:,:,IKB:IKB) = XSSUFL_C(:,:,1:1)/PDZZ(:,:,IKB:IKB) &
+ * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
+ ELSE
+ ! compute the explicit tangential flux at the W point
!$acc kernels
-ZSOURCE(:,:,IKB) = &
- PTAU11M(:,:) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
- -PTAU12M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
- -PTAU33M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
+ ZSOURCE(:,:,IKB) = &
+ PTAU11M(:,:) * PCOSSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
+ -PTAU12M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) &
+ -PTAU33M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
+!
+ ! add the vertical part or the surface flux at the U,W vorticity point
!
-! add the vertical part or the surface flux at the U,W vorticity point
-
#ifndef MNH_OPENACC
-ZSOURCE(:,:,IKB:IKB) = &
- ( MXM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
- + MXM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZUSLOPEM(:,:,1:1) &
- -ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZVSLOPEM(:,:,1:1) ) &
- - ZCOEFS(:,:,1:1) * PUM(:,:,IKB:IKB) * PIMPL &
- ) * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
+ ZSOURCE(:,:,IKB:IKB) = &
+ ( MXM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
+ + MXM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+ *ZUSLOPEM(:,:,1:1) &
+ -ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+ *ZVSLOPEM(:,:,1:1) ) &
+ - ZCOEFS(:,:,1:1) * PUM(:,:,IKB:IKB) * PIMPL &
+ ) * 0.5 * ( 1. + MXM(PRHODJ(:,:,KKA:KKA)) / MXM(PRHODJ(:,:,IKB:IKB)) )
#else
-ZTMP1_DEVICE(:,:,IKB) = ZSOURCE(:,:,IKB) / PDZZ(:,:,IKB)
-ZTMP2_DEVICE(:,:,1) = ZCOEFFLXU(:,:,1) / PDZZ(:,:,IKB) &
- *ZUSLOPEM(:,:,1) &
- -ZCOEFFLXV(:,:,1) / PDZZ(:,:,IKB) &
- *ZVSLOPEM(:,:,1)
+ ZTMP1_DEVICE(:,:,IKB) = ZSOURCE(:,:,IKB) / PDZZ(:,:,IKB)
+ ZTMP2_DEVICE(:,:,1) = ZCOEFFLXU(:,:,1) / PDZZ(:,:,IKB) &
+ *ZUSLOPEM(:,:,1) &
+ -ZCOEFFLXV(:,:,1) / PDZZ(:,:,IKB) &
+ *ZVSLOPEM(:,:,1)
!$acc end kernels
-CALL MXM_DEVICE( ZTMP1_DEVICE(:,:,IKB:IKB), ZTMP3_DEVICE(:,:,1:1) )
-CALL MXM_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP4_DEVICE(:,:,1:1) )
-CALL MXM_DEVICE(PRHODJ(:,:,KKA:KKA),ZTMP1_DEVICE(:,:,KKA:KKA))
-CALL MXM_DEVICE(PRHODJ(:,:,IKB:IKB),ZTMP2_DEVICE(:,:,IKB:IKB))
+ CALL MXM_DEVICE( ZTMP1_DEVICE(:,:,IKB:IKB), ZTMP3_DEVICE(:,:,1:1) )
+ CALL MXM_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP4_DEVICE(:,:,1:1) )
+ CALL MXM_DEVICE(PRHODJ(:,:,KKA:KKA),ZTMP1_DEVICE(:,:,KKA:KKA))
+ CALL MXM_DEVICE(PRHODJ(:,:,IKB:IKB),ZTMP2_DEVICE(:,:,IKB:IKB))
!$acc kernels
-ZSOURCE(:,:,IKB) = ( ZTMP3_DEVICE(:,:,1) + ZTMP4_DEVICE(:,:,1) - ZCOEFS(:,:,1) * PUM(:,:,IKB) * PIMPL &
- ) * 0.5 * ( 1. + ZTMP1_DEVICE(:,:,KKA) / ZTMP2_DEVICE(:,:,IKB) )
+ ZSOURCE(:,:,IKB) = ( ZTMP3_DEVICE(:,:,1) + ZTMP4_DEVICE(:,:,1) - ZCOEFS(:,:,1) * PUM(:,:,IKB) * PIMPL &
+ ) * 0.5 * ( 1. + ZTMP1_DEVICE(:,:,KKA) / ZTMP2_DEVICE(:,:,IKB) )
#endif
+ ENDIF
!
-ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
-ZSOURCE(:,:,IKE) = 0.
+ ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
+ ZSOURCE(:,:,IKE) = 0.
!$acc end kernels
+ENDIF !end ocean or atmosphere cases
!
-! Obtention of the splitted U at t+ deltat
+! Obtention of the split U at t+ deltat
!
#ifndef MNH_OPENACC
CALL TRIDIAG_WIND(KKA,KKU,KKL,PUM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
@@ -669,8 +702,14 @@ ZFLXZ(:,:,IKB:IKB) = ZTMP1_DEVICE(:,:,IKB:IKB) * &
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!$acc end kernels
+IF (LOCEAN) THEN !ocean model at phys sfc (ocean domain top)
+ ZFLXZ(:,:,IKE:IKE) = MXM(PDZZ(:,:,IKE:IKE)) * &
+ ZSOURCE(:,:,IKE:IKE) &
+ / 0.5 / ( 1. + MXM(PRHODJ(:,:,KKU:KKU)) / MXM(PRHODJ(:,:,IKE:IKE)) )
+ ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
+END IF
!
-IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
!$acc update self(ZFLXZ)
! stores the U wind component vertical flux
TZFIELD%CMNHNAME = 'UW_VFLX'
@@ -727,6 +766,14 @@ PDP(:,:,IKB:IKB) = - ZTMP3_DEVICE(:,:,IKB:IKB)
!$acc end kernels
#endif
!
+IF (LOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
+ PDP(:,:,IKE:IKE) = - MXF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * (PUM(:,:,IKE:IKE)-PUM(:,:,IKE-KKL:IKE-KKL)) &
+ / MXM(PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ )
+END IF
+!
! Storage in the LES configuration
!
IF (LLES_CALL) THEN
@@ -767,9 +814,12 @@ END IF
!
IF(HTURBDIM=='3DIM') THEN
! Compute the source for the W wind component
-!$acc kernels
- ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
! used to compute the W source at the ground
+!$acc kernels
+ ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
+ IF (LOCEAN) THEN
+ ZFLXZ(:,:,KKU) = 2 * ZFLXZ(:,:,IKE) - ZFLXZ(:,:,IKE-KKL) ! extrapolation
+ END IF
!$acc end kernels
!
#ifndef MNH_OPENACC
@@ -865,6 +915,21 @@ IF(HTURBDIM=='3DIM') THEN
ZA(:,:,IKB:IKB) = - ZTMP4_DEVICE(:,:,1:1)
#endif
!
+IF (LOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
+ ZA(:,:,IKE:IKE) = - MXF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * &
+ ( DXM( PWM(:,:,IKE-KKL:IKE-KKL) ) &
+ -MXM( (PWM(:,:,IKE-2*KKL:IKE-2*KKL )-PWM(:,:,IKE-KKL:IKE-KKL)) &
+ /(PDZZ(:,:,IKE-2*KKL:IKE-2*KKL)+PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ +(PWM(:,:,IKE-KKL:IKE-KKL)-PWM(:,:,IKE:IKE )) &
+ /(PDZZ(:,:,IKE-KKL:IKE-KKL)+PDZZ(:,:,IKE:IKE )) &
+ ) &
+ * PDZX(:,:,IKE-KKL:IKE-KKL) &
+ ) / (0.5*(PDXX(:,:,IKE-KKL:IKE-KKL)+PDXX(:,:,IKE:IKE))) &
+ )
+END IF
+ !
PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
!$acc end kernels
!
@@ -989,46 +1054,70 @@ ZTMP1_DEVICE(:,:,1:1) = ZCOEFS(:,:,1:1) / PDZZ(:,:,IKB:IKB)
CALL MYM_DEVICE(ZTMP1_DEVICE(:,:,1:1),ZCOEFS(:,:,1:1) )
#endif
!
-! compute the explicit tangential flux at the W point
+IF (LOCEAN) THEN ! Ocean case
+ IF (LCOUPLES) THEN
+ ZSOURCE(:,:,IKE:IKE) = XSSVFL_C(:,:,1:1)/PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
+ ELSE
+ ZSOURCE(:,:,IKE) = XSSVFL(:,:)
+ ZSOURCE(:,:,IKE:IKE) = ZSOURCE(:,:,IKE:IKE)/PDZZ(:,:,IKE:IKE) &
+ *0.5 * ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
+ END IF
+ !No flux at the ocean domain bottom
+ ZSOURCE(:,:,IKB) = 0.
+ELSE ! Atmos case
+ IF (.NOT.LCOUPLES) THEN ! only atmosp without coupling
+ ! compute the explicit tangential flux at the W point
!$acc kernels
-ZSOURCE(:,:,IKB) = &
- PTAU11M(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
- +PTAU12M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) &
- -PTAU33M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
+ ZSOURCE(:,:,IKB) = &
+ PTAU11M(:,:) * PSINSLOPE(:,:) * PDIRCOSZW(:,:) * ZDIRSINZW(:,:) &
+ +PTAU12M(:,:) * PCOSSLOPE(:,:) * ZDIRSINZW(:,:) &
+ -PTAU33M(:,:) * PSINSLOPE(:,:) * ZDIRSINZW(:,:) * PDIRCOSZW(:,:)
!
-! add the vertical part or the surface flux at the V,W vorticity point
+ ! add the vertical part or the surface flux at the V,W vorticity point
#ifndef MNH_OPENACC
-ZSOURCE(:,:,IKB:IKB) = &
- ( MYM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
- + MYM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZUSLOPEM(:,:,1:1) &
- +ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
- *ZVSLOPEM(:,:,1:1) ) &
- - ZCOEFS(:,:,1:1) * PVM(:,:,IKB:IKB) * PIMPL &
- ) * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
+ ZSOURCE(:,:,IKB:IKB) = &
+ ( MYM( ZSOURCE(:,:,IKB:IKB) / PDZZ(:,:,IKB:IKB) ) &
+ + MYM( ZCOEFFLXU(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+ *ZUSLOPEM(:,:,1:1) &
+ +ZCOEFFLXV(:,:,1:1) / PDZZ(:,:,IKB:IKB) &
+ *ZVSLOPEM(:,:,1:1) ) &
+ - ZCOEFS(:,:,1:1) * PVM(:,:,IKB:IKB) * PIMPL &
+ ) * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
#else
-ZTMP1_DEVICE(:,:,1) = ZSOURCE(:,:,IKB) / PDZZ(:,:,IKB)
+ ZTMP1_DEVICE(:,:,1) = ZSOURCE(:,:,IKB) / PDZZ(:,:,IKB)
!$acc end kernels
-CALL MYM_DEVICE( ZTMP1_DEVICE(:,:,1:1), ZTMP2_DEVICE(:,:,1:1) )
+ CALL MYM_DEVICE( ZTMP1_DEVICE(:,:,1:1), ZTMP2_DEVICE(:,:,1:1) )
!$acc kernels
-ZTMP1_DEVICE(:,:,1) = ZCOEFFLXU(:,:,1) / PDZZ(:,:,IKB) &
- *ZUSLOPEM(:,:,1) &
- +ZCOEFFLXV(:,:,1) / PDZZ(:,:,IKB) &
- *ZVSLOPEM(:,:,1)
+ ZTMP1_DEVICE(:,:,1) = ZCOEFFLXU(:,:,1) / PDZZ(:,:,IKB) &
+ *ZUSLOPEM(:,:,1) &
+ +ZCOEFFLXV(:,:,1) / PDZZ(:,:,IKB) &
+ *ZVSLOPEM(:,:,1)
!$acc end kernels
-CALL MYM_DEVICE(ZTMP1_DEVICE(:,:,1:1),ZTMP3_DEVICE(:,:,1:1))
-CALL MYM_DEVICE(PRHODJ(:,:,KKA:KKA),ZTMP1_DEVICE(:,:,1:1))
-CALL MYM_DEVICE(PRHODJ(:,:,IKB:IKB),ZTMP4_DEVICE(:,:,1:1))
+ CALL MYM_DEVICE(ZTMP1_DEVICE(:,:,1:1),ZTMP3_DEVICE(:,:,1:1))
+ CALL MYM_DEVICE(PRHODJ(:,:,KKA:KKA),ZTMP1_DEVICE(:,:,1:1))
+ CALL MYM_DEVICE(PRHODJ(:,:,IKB:IKB),ZTMP4_DEVICE(:,:,1:1))
!$acc kernels
-ZSOURCE(:,:,IKB) = ( ZTMP2_DEVICE(:,:,1) + ZTMP3_DEVICE(:,:,1) - ZCOEFS(:,:,1) * PVM(:,:,IKB) * PIMPL ) &
- * 0.5 * ( 1. + ZTMP1_DEVICE(:,:,1) / ZTMP4_DEVICE(:,:,1) )
+ ZSOURCE(:,:,IKB) = ( ZTMP2_DEVICE(:,:,1) + ZTMP3_DEVICE(:,:,1) - ZCOEFS(:,:,1) * PVM(:,:,IKB) * PIMPL ) &
+ * 0.5 * ( 1. + ZTMP1_DEVICE(:,:,1) / ZTMP4_DEVICE(:,:,1) )
+!$acc end kernels
#endif
!
+ ELSE !atmosphere when coupling
+ ! input flux assumed to be in SI and at vorticity point
+ ZSOURCE(:,:,IKB:IKB) = -XSSVFL_C(:,:,1:1)/(1.*PDZZ(:,:,IKB:IKB)) &
+ * 0.5 * ( 1. + MYM(PRHODJ(:,:,KKA:KKA)) / MYM(PRHODJ(:,:,IKB:IKB)) )
+ ENDIF
+ !No flux at the atmosphere top
+!$acc kernels
+ ZSOURCE(:,:,IKE) = 0.
+!$acc end kernels
+ENDIF ! End of Ocean or Atmospher Cases
+!$acc kernels
ZSOURCE(:,:,IKTB+1:IKTE-1) = 0.
-ZSOURCE(:,:,IKE) = 0.
!$acc end kernels
-!
-! Obtention of the splitted V at t+ deltat
+!
+! Obtention of the split V at t+ deltat
#ifndef MNH_OPENACC
CALL TRIDIAG_WIND(KKA,KKU,KKL,PVM,ZA,ZCOEFS(:,:,1),PTSTEP,PEXPL,PIMPL, &
MYM(PRHODJ),ZSOURCE,ZRES)
@@ -1085,7 +1174,14 @@ ZFLXZ(:,:,IKB) = ZTMP1_DEVICE(:,:,1) * &
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!$acc end kernels
!
-IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+IF (LOCEAN) THEN
+ ZFLXZ(:,:,IKE:IKE) = MYM(PDZZ(:,:,IKE:IKE)) * &
+ ZSOURCE(:,:,IKE:IKE) &
+ / 0.5 / ( 1. + MYM(PRHODJ(:,:,KKU:KKU)) / MYM(PRHODJ(:,:,IKE:IKE)) )
+ ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
+END IF
+!
+IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
!$acc update self(ZFLXZ)
! stores the V wind component vertical flux
TZFIELD%CMNHNAME = 'VW_VFLX'
@@ -1141,6 +1237,14 @@ CALL MYF_DEVICE( ZTMP2_DEVICE(:,:,1:1), ZTMP1_DEVICE(:,:,1:1) )
ZA(:,:,IKB) = - ZTMP1_DEVICE(:,:,1)
#endif
!
+IF (LOCEAN) THEN
+ ! evaluate the dynamic production at w(IKE-KKL) in PDP(IKE)
+ ZA(:,:,IKE:IKE) = - MYF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * (PVM(:,:,IKE:IKE)-PVM(:,:,IKE-KKL:IKE-KKL)) &
+ / MYM(PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ )
+END IF
+!
PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
!$acc end kernels
!
@@ -1180,6 +1284,9 @@ IF(HTURBDIM=='3DIM') THEN
! Compute the source for the W wind component
!$acc kernels
ZFLXZ(:,:,KKA) = 2 * ZFLXZ(:,:,IKB) - ZFLXZ(:,:,IKB+KKL) ! extrapolation
+ IF (LOCEAN) THEN
+ ZFLXZ(:,:,KKU) = 2 * ZFLXZ(:,:,IKE) - ZFLXZ(:,:,IKE-KKL) ! extrapolation
+ END IF
!$acc end kernels
!
#ifndef MNH_OPENACC
@@ -1278,6 +1385,20 @@ IF(HTURBDIM=='3DIM') THEN
ZA(:,:,IKB:IKB) = - ZTMP1_DEVICE(:,:,1:1)
#endif
!
+ IF (LOCEAN) THEN
+ ZA(:,:,IKE:IKE) = - MYF ( &
+ ZFLXZ(:,:,IKE-KKL:IKE-KKL) * &
+ ( DYM( PWM(:,:,IKE-KKL:IKE-KKL) ) &
+ -MYM( (PWM(:,:,IKE-2*KKL:IKE-2*KKL)-PWM(:,:,IKE-KKL:IKE-KKL)) &
+ /(PDZZ(:,:,IKE-2*KKL:IKE-2*KKL)+PDZZ(:,:,IKE-KKL:IKE-KKL)) &
+ +(PWM(:,:,IKE-KKL:IKE-KKL)-PWM(:,:,IKE:IKE )) &
+ /(PDZZ(:,:,IKE-KKL:IKE-KKL)+PDZZ(:,:,IKE:IKE )) &
+ ) &
+ * PDZY(:,:,IKE-KKL:IKE-KKL) &
+ ) / (0.5*(PDYY(:,:,IKE-KKL:IKE-KKL)+PDYY(:,:,IKE:IKE))) &
+ )
+ END IF
+!
PDP(:,:,:)=PDP(:,:,:)+ZA(:,:,:)
!$acc end kernels
!
@@ -1339,7 +1460,7 @@ END IF
!* 7. DIAGNOSTIC COMPUTATION OF THE 1D <W W> VARIANCE
! -----------------------------------------------
!
-IF ( OTURB_FLX .AND. OCLOSE_OUT .AND. HTURBDIM == '1DIM') THEN
+IF ( OTURB_FLX .AND. tpfile%lopened .AND. HTURBDIM == '1DIM') THEN
#ifndef MNH_OPENACC
ZFLXZ(:,:,:)= (2./3.) * PTKEM(:,:,:) &
-XCMFS*PLM(:,:,:)*SQRT(PTKEM(:,:,:))*GZ_W_M(PWM,PDZZ)
diff --git a/src/MNH/turb_ver_sv_flux.f90 b/src/MNH/turb_ver_sv_flux.f90
index 564bb7af1c011cf87ac6e3e8ff318386c27ab8ca..d3e4fa41dbd1d2295f710505b70bed7dcb29e642 100644
--- a/src/MNH/turb_ver_sv_flux.f90
+++ b/src/MNH/turb_ver_sv_flux.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM, &
+ OTURB_FLX,HTURBDIM, &
PIMPL,PEXPL, &
PTSTEP, &
TPFILE, &
@@ -26,8 +26,6 @@ USE MODD_IO, ONLY: TFILEDATA
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=AR
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
@@ -69,7 +67,7 @@ END MODULE MODI_TURB_VER_SV_FLUX
!
! ###############################################################
SUBROUTINE TURB_VER_SV_FLUX(KKA,KKU,KKL, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM, &
+ OTURB_FLX,HTURBDIM, &
PIMPL,PEXPL, &
PTSTEP, &
TPFILE, &
@@ -177,7 +175,7 @@ END MODULE MODI_TURB_VER_SV_FLUX
!! DXF,DYF,DZF,DZM
!! : Shuman functions (difference operators)
!!
-!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
!! of a variable located at a mass point
!!
!! FUNCTIONs ETHETA and EMOIST :
@@ -269,13 +267,13 @@ END MODULE MODI_TURB_VER_SV_FLUX
!
USE MODD_CST
USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_LES
USE MODD_CONF
USE MODD_NSV, ONLY: XSVMIN, NSV_LGBEG, NSV_LGEND
USE MODD_BLOWSNOW
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
#ifdef MNH_OPENACC
@@ -303,8 +301,6 @@ IMPLICIT NONE
INTEGER, INTENT(IN) :: KKA !near ground array index
INTEGER, INTENT(IN) :: KKU !uppest atmosphere array index
INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -1=ARO
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
@@ -448,7 +444,7 @@ DO JSV=1,ISV
* 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
END IF
!
-! Obtention of the splitted JSV scalar variable at t+ deltat
+! Obtention of the split JSV scalar variable at t+ deltat
CALL TRIDIAG(KKA,KKU,KKL,PSVM(:,:,:,JSV),ZA,PTSTEP,PEXPL,PIMPL,PRHODJ,ZSOURCE,ZRES)
!
! Compute the equivalent tendency for the JSV scalar variable
@@ -457,7 +453,7 @@ DO JSV=1,ISV
! PRSVS(:,:,:,JSV)= MAX((PRSVS(:,:,:,JSV)+ &
! PRHODJ(:,:,:)*(ZRES(:,:,:)-PSVM(:,:,:,JSV))/PTSTEP),XSVMIN(JSV))
!
- IF ( (OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL ) THEN
+ IF ( (OTURB_FLX .AND. tpfile%lopened) .OR. LLES_CALL ) THEN
! Diagnostic of the cartesian vertical flux
!
ZFLXZ(:,:,:) = -ZCSV * PPSI_SV(:,:,:,JSV) * MZM(PLM*SQRT(PTKEM)) / PDZZ * &
@@ -484,7 +480,7 @@ DO JSV=1,ISV
PWSV(:,:,IKE,JSV)=PWSV(:,:,IKE-KKL,JSV)
END IF
!
- IF (OTURB_FLX .AND. OCLOSE_OUT) THEN
+ IF (OTURB_FLX .AND. tpfile%lopened) THEN
! stores the JSVth vertical flux
WRITE(TZFIELD%CMNHNAME,'("WSV_FLX_",I3.3)') JSV
TZFIELD%CSTDNAME = ''
diff --git a/src/MNH/turb_ver_thermo_corr.f90 b/src/MNH/turb_ver_thermo_corr.f90
index 8bdb18ba44fc76ccf89cebdf50aa173ce0401bf4..0bbbd7f376613bd879e944eb7b711635984260e9 100644
--- a/src/MNH/turb_ver_thermo_corr.f90
+++ b/src/MNH/turb_ver_thermo_corr.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
+ OTURB_FLX,HTURBDIM,HTOM, &
PIMPL,PEXPL, &
TPFILE, &
PDZZ, &
@@ -31,8 +31,6 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
@@ -90,7 +88,7 @@ END MODULE MODI_TURB_VER_THERMO_CORR
!
! ###############################################################
SUBROUTINE TURB_VER_THERMO_CORR(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
+ OTURB_FLX,HTURBDIM,HTOM, &
PIMPL,PEXPL, &
TPFILE, &
PDZZ, &
@@ -199,10 +197,10 @@ END MODULE MODI_TURB_VER_THERMO_CORR
!! DXF,DYF,DZF,DZM
!! : Shuman functions (difference operators)
!!
-!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
!! of a variable located at a mass point
!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
!! of a variable located at a wind point
!!
!! FUNCTIONs ETHETA and EMOIST :
@@ -292,6 +290,7 @@ END MODULE MODI_TURB_VER_THERMO_CORR
!
USE MODD_CST
USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_CONF
@@ -309,7 +308,6 @@ USE MODI_SHUMAN_DEVICE
USE MODI_TRIDIAG
USE MODI_LES_MEAN_SUBGRID
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
use mode_mppdb
USE MODE_PRANDTL
@@ -331,8 +329,6 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
@@ -737,7 +733,7 @@ END IF
!
!
! stores <THl THl>
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'THL_VVAR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'THL_VVAR'
@@ -1063,7 +1059,7 @@ END IF
END IF
!$acc end kernels
! stores <THl Rnp>
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'THLRCONS_VCOR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'THLRCONS_VCOR'
@@ -1348,7 +1344,7 @@ END IF
END IF
!$acc end kernels
! stores <Rnp Rnp>
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'RTOT_VVAR'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'RTOT_VVAR'
diff --git a/src/MNH/turb_ver_thermo_flux.f90 b/src/MNH/turb_ver_thermo_flux.f90
index 25dd181513bb83ac4a8fe1152d6d6f9714fbcc5d..51530c244f65bb4f771c936e78484bace7e38406 100644
--- a/src/MNH/turb_ver_thermo_flux.f90
+++ b/src/MNH/turb_ver_thermo_flux.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -10,7 +10,7 @@
INTERFACE
!
SUBROUTINE TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR,KRRL,KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
+ OTURB_FLX,HTURBDIM,HTOM, &
PIMPL,PEXPL, &
PTSTEP, &
TPFILE, &
@@ -34,8 +34,6 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
@@ -117,7 +115,7 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!
! ###############################################################
SUBROUTINE TURB_VER_THERMO_FLUX(KKA,KKU,KKL,KRR, KRRL, KRRI, &
- OCLOSE_OUT,OTURB_FLX,HTURBDIM,HTOM, &
+ OTURB_FLX,HTURBDIM,HTOM, &
PIMPL,PEXPL, &
PTSTEP, &
TPFILE, &
@@ -229,10 +227,10 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! DXF,DYF,DZF,DZM
!! : Shuman functions (difference operators)
!!
-!! SUBROUTINE TRIDIAG : to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG : to compute the split implicit evolution
!! of a variable located at a mass point
!!
-!! SUBROUTINE TRIDIAG_WIND: to compute the splitted implicit evolution
+!! SUBROUTINE TRIDIAG_WIND: to compute the split implicit evolution
!! of a variable located at a wind point
!!
!! FUNCTIONs ETHETA and EMOIST :
@@ -321,6 +319,14 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!! vertical levels
!! 04/2016 (M.Moge) Use openACC directives to port the TURB part of Meso-NH on GPU
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! 2021 (D. Ricard) last version of HGRAD turbulence scheme
+!! Leronard terms instead of Reynolds terms
+!! applied to vertical fluxes of r_np and Thl
+!! for implicit version of turbulence scheme
+!! corrections and cleaning
+!! June 2020 (B. Vie) Patch preventing negative rc and ri in 2.3 and 3.3
+!! JL Redelsperger : 03/2021: Ocean and Autocoupling O-A LES Cases
+!! Sfc flux shape for LDEEPOC Case
!!--------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -328,10 +334,20 @@ END MODULE MODI_TURB_VER_THERMO_FLUX
!
USE MODD_CST
USE MODD_CTURB
+use modd_field, only: tfielddata, TYPEREAL
+USE MODD_GRID_n, ONLY: XZS, XXHAT, XYHAT
USE MODD_IO, ONLY: TFILEDATA
+USE MODD_METRICS_n, ONLY: XDXX, XDYY, XDZX, XDZY, XDZZ
USE MODD_PARAMETERS
+USE MODD_TURB_n, ONLY: LHGRAD, XCOEFHGRADTHL, XCOEFHGRADRM, XALTHGRAD, XCLDTHOLD
USE MODD_CONF
USE MODD_LES
+USE MODD_DIM_n
+USE MODD_DYN_n, ONLY: LOCEAN
+USE MODD_OCEANH
+USE MODD_REF, ONLY: LCOUPLES
+USE MODD_TURB_n
+USE MODD_FRC
!
USE MODI_GRADIENT_U
USE MODI_GRADIENT_V
@@ -347,13 +363,16 @@ USE MODI_LES_MEAN_SUBGRID
USE MODI_TRIDIAG_THERMO
USE MODI_TM06_H
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+USE MODE_GATHER_ll
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_ll
+USE MODE_MPPDB
+#ifdef MNH_OPENACC
+USE MODE_MSG
+#endif
USE MODE_PRANDTL
!
USE MODI_SECOND_MNH
-USE MODE_MPPDB
-
!
IMPLICIT NONE
!
@@ -367,8 +386,6 @@ INTEGER, INTENT(IN) :: KKL !vert. levels type 1=MNH -
INTEGER, INTENT(IN) :: KRR ! number of moist var.
INTEGER, INTENT(IN) :: KRRL ! number of liquid water var.
INTEGER, INTENT(IN) :: KRRI ! number of ice water var.
-LOGICAL, INTENT(IN) :: OCLOSE_OUT ! switch for syncronous
- ! file opening
LOGICAL, INTENT(IN) :: OTURB_FLX ! switch to write the
! turbulent fluxes in the syncronous FM-file
CHARACTER(len=4), INTENT(IN) :: HTURBDIM ! dimensionality of the
@@ -448,8 +465,34 @@ INTEGER :: IKB,IKE ! I index values for the Beginning and End
INTEGER :: IKT ! array size in k direction
INTEGER :: IKTB,IKTE ! start, end of k loops in physical domain
!
-REAL :: ZTIME1, ZTIME2
+INTEGER :: JI, JJ ! loop indexes
+!
+INTEGER :: IIB,IJB ! Lower bounds of the physical
+ ! sub-domain in x and y directions
+INTEGER :: IIE,IJE ! Upper bounds of the physical
+ ! sub-domain in x and y directions
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT_ll ! Position x in the conformal
+ ! plane (array on the complete domain)
+REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT_ll ! Position y in the conformal
+ ! plane (array on the complete domain)
+!
!
+CHARACTER (LEN=100) :: YCOMMENT ! comment string in LFIFM file
+CHARACTER (LEN=LEN_HREC) :: YRECFM ! Name of the desired field in LFIFM file
+!
+REAL :: ZTIME1, ZTIME2
+REAL :: ZDELTAX
+REAL :: ZXBEG,ZXEND,ZYBEG,ZYEND ! Forcing size for ocean deep convection
+REAL, DIMENSION(SIZE(XXHAT),SIZE(XYHAT)) :: ZDIST ! distance
+ ! from the center of the cooling
+REAL :: ZFLPROV
+INTEGER :: JKM ! vertical index loop
+INTEGER :: JSW
+REAL :: ZSWA ! index for time flux interpolation
+!
+INTEGER :: IIU, IJU
+INTEGER :: IRESP
INTEGER :: JK
LOGICAL :: GUSERV ! flag to use water
LOGICAL :: GFTH2 ! flag to use w'th'2
@@ -459,14 +502,19 @@ LOGICAL :: GFWR ! flag to use w'2r'
LOGICAL :: GFTHR ! flag to use w'th'r'
!
REAL, DIMENSION(:,:,:), allocatable :: &
- ZA, & ! work variable for wrc or LES computation
- ZFLXZ, & ! vertical flux of the treated variable
- ZSOURCE, & ! source of evolution for the treated variable
- ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
- ZF, & ! Flux in dTh/dt =-dF/dz (evaluated at t-1)(or rt instead of Th)
- ZDFDDTDZ, & ! dF/d(dTh/dz)
- ZDFDDRDZ, & ! dF/d(dr/dz)
- Z3RDMOMENT ! 3 order term in flux or variance equation
+ ZA, & ! work variable for wrc or LES computation
+ ZFLXZ, & ! vertical flux of the treated variable
+ ZSOURCE, & ! source of evolution for the treated variable
+ ZKEFF, & ! effectif diffusion coeff = LT * SQRT( TKE )
+ ZF, & ! Flux in dTh/dt =-dF/dz (evaluated at t-1)(or rt instead of Th)
+ ZDFDDTDZ, & ! dF/d(dTh/dz)
+ ZDFDDRDZ, & ! dF/d(dr/dz)
+ Z3RDMOMENT, & ! 3 order term in flux or variance equation
+ ZF_NEW, &
+ ZRWTHL, &
+ ZRWRNP, &
+ ZCLD_THOLD
+REAL, DIMENSION(:,:,:), allocatable :: ZALT
#ifdef MNH_OPENACC
REAL, DIMENSION(:,:,:), allocatable :: ZTMP1_DEVICE,ZTMP2_DEVICE,ZTMP3_DEVICE,ZTMP4_DEVICE
#endif
@@ -540,6 +588,12 @@ allocate( zf (size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
allocate( zdfddtdz (size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
allocate( zdfddrdz (size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
allocate( z3rdmoment(size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
+allocate( ZF_NEW (size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
+allocate( ZRWTHL (size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
+allocate( ZRWRNP (size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
+allocate( ZCLD_THOLD(size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
+
+Allocate( ZALT(Size( XZS, 1 ), Size( XZS, 2 ), KKU ) )
#ifdef MNH_OPENACC
allocate( ztmp1_device(size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
@@ -549,11 +603,45 @@ allocate( ztmp4_device(size( pthlm, 1 ), size( pthlm, 2 ), size( pthlm, 3 ) ) )
#endif
!$acc data create( ZA, ZFLXZ, ZSOURCE, ZKEFF, ZF, ZDFDDTDZ, ZDFDDRDZ, Z3RDMOMENT, &
+!$acc & ZF_NEW, ZRWTHL, ZRWRNP, ZCLD_THOLD, ZALT, &
!$acc & ZTMP1_DEVICE, ZTMP2_DEVICE, ZTMP3_DEVICE, ZTMP4_DEVICE )
!
!* 1. PRELIMINARIES
! -------------
+! Size for a given proc & a given model
+IIU=SIZE(PTHLM,1)
+IJU=SIZE(PTHLM,2)
+!
+!! Compute Shape of sfc flux for Oceanic Deep Conv Case
+!
+IF (LOCEAN .AND. LDEEPOC) THEN
+#ifdef MNH_OPENACC
+ call Print_msg( NVERB_FATAL, 'GEN', 'TURB_VER_THERMO_FLUX', 'OpenACC: LOCEAN=T not yet implemented' )
+#endif
+ !* COMPUTES THE PHYSICAL SUBDOMAIN BOUNDS
+ ALLOCATE(ZXHAT_ll(NIMAX_ll+2*JPHEXT),ZYHAT_ll(NJMAX_ll+2*JPHEXT))
+ !compute ZXHAT_ll = position in the (0:Lx) domain 1 (Lx=Size of domain1 )
+ !compute XXHAT_ll = position in the (L0_subproc,Lx_subproc) domain for the current subproc
+ ! L0_subproc as referenced in the full domain 1
+ CALL GATHERALL_FIELD_ll('XX',XXHAT,ZXHAT_ll,IRESP)
+ CALL GATHERALL_FIELD_ll('YY',XYHAT,ZYHAT_ll,IRESP)
+ CALL GET_DIM_EXT_ll('B',IIU,IJU)
+ CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
+ DO JJ = IJB,IJE
+ DO JI = IIB,IIE
+ ZDIST(JI,JJ) = SQRT( &
+ (( (XXHAT(JI)+XXHAT(JI+1))*0.5 - XCENTX_OC ) / XRADX_OC)**2 + &
+ (( (XYHAT(JJ)+XYHAT(JJ+1))*0.5 - XCENTY_OC ) / XRADY_OC)**2 &
+ )
+ END DO
+ END DO
+ DO JJ=IJB,IJE
+ DO JI=IIB,IIE
+ IF ( ZDIST(JI,JJ) > 1.) XSSTFL(JI,JJ)=0.
+ END DO
+ END DO
+END IF !END DEEP OCEAN CONV CASE
!
IKT =SIZE(PTHLM,3)
IKTE =IKT-JPVEXT_TURB
@@ -575,6 +663,23 @@ ZTMP1_DEVICE(:,:,:) = PLM(:,:,:) * SQRT(PTKEM(:,:,:))
CALL MZM_DEVICE(ZTMP1_DEVICE, ZKEFF)
#endif
!
+! define a cloud mask with ri and rc (used after with a threshold) for Leonard terms
+!
+IF(LHGRAD) THEN
+#ifdef MNH_OPENACC
+ call Print_msg( NVERB_FATAL, 'GEN', 'TURB_VER_THERMO_FLUX', 'OpenACC: LHGRAD=T not yet implemented' )
+#endif
+!$acc kernels
+ IF ( KRRL >= 1 ) THEN
+ IF ( KRRI >= 1 ) THEN
+ ZCLD_THOLD(:,:,:) = PRM(:,:,:,2) + PRM(:,:,:,4)
+ ELSE
+ ZCLD_THOLD(:,:,:) = PRM(:,:,:,2)
+ END IF
+ END IF
+!$acc end kernels
+END IF
+!
! Flags for 3rd order quantities
!
GFTH2 = .FALSE.
@@ -614,6 +719,18 @@ CALL D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV,
ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF(:,:,:)*ZTMP2_DEVICE(:,:,:)
!$acc end kernels
#endif
+ZF (:,:,:) = -XCSHF*PPHI3*ZKEFF*DZM(PTHLM)/PDZZ
+ZDFDDTDZ(:,:,:) = -XCSHF*ZKEFF*D_PHI3DTDZ_O_DDTDZ(PPHI3,PREDTH1,PREDR1,PRED2TH3,PRED2THR3,HTURBDIM,GUSERV)
+!
+IF (LHGRAD) THEN
+ ! Compute the Leonard terms for thl
+ ZDELTAX= XXHAT(3) - XXHAT(2)
+ ZF_NEW (:,:,:)= XCOEFHGRADTHL*ZDELTAX*ZDELTAX/12.0*( &
+ MXF(GX_W_UW(PWM(:,:,:), XDXX, XDZZ, XDZX))&
+ *MZM(GX_M_M(PTHLM(:,:,:),XDXX,XDZZ,XDZX)) &
+ + MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY)) &
+ *MZM(GY_M_M(PTHLM(:,:,:),XDYY,XDZZ,XDZY)) )
+END IF
!
! Effect of 3rd order terms in temperature flux (at flux point)
!
@@ -740,34 +857,70 @@ IF (GFTHR) THEN
!$acc end kernels
END IF
#endif
+! compute interface flux
+IF (LCOUPLES) THEN ! Autocoupling O-A LES
+ IF (LOCEAN) THEN ! ocean model in coupled case
+!$acc kernels
+ ZF(:,:,IKE) = (XSSTFL_C(:,:,1)+XSSRFL_C(:,:,1)) &
+ *0.5* ( 1. + PRHODJ(:,:,KKU)/PRHODJ(:,:,IKE) )
+!$acc end kernels
+ ELSE ! atmosph model in coupled case
+!$acc kernels
+ ZF(:,:,IKB) = XSSTFL_C(:,:,1) &
+ *0.5* ( 1. + PRHODJ(:,:,KKA)/PRHODJ(:,:,IKB) )
+!$acc end kernels
+ ENDIF
!
-!* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
-! (in presence of slopes)
-!* in 1DIM case, the part of energy released in horizontal flux
-! is taken into account in the vertical part
+ELSE ! No coupling O and A cases
+ ! atmosp bottom
+ !*In 3D, a part of the flux goes vertically,
+ ! and another goes horizontally (in presence of slopes)
+ !*In 1D, part of energy released in horizontal flux is taken into account in the vertical part
+ IF (HTURBDIM=='3DIM') THEN
+!$acc kernels
+ ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
+ * PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+!$acc end kernels
+ ELSE
+!$acc kernels
+ ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
+ / PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+!$acc end kernels
+ END IF
!
-IF (HTURBDIM=='3DIM') THEN
+ IF (LOCEAN) THEN
!$acc kernels
- ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- * PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ ZF(:,:,IKE) = XSSTFL(:,:) *0.5*(1. + PRHODJ(:,:,KKU) / PRHODJ(:,:,IKE))
!$acc end kernels
-ELSE
+ ELSE !end ocean case (in nocoupled case)
+ ! atmos top
!$acc kernels
- ZF(:,:,IKB) = ( PIMPL*PSFTHP(:,:) + PEXPL*PSFTHM(:,:) ) &
- / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ ZF(:,:,IKE)=0.
!$acc end kernels
-END IF
+ END IF
+END IF !end no coupled cases
!
-! Compute the splitted conservative potential temperature at t+deltat
+! Compute the split conservative potential temperature at t+deltat
CALL TRIDIAG_THERMO(KKA,KKU,KKL,PTHLM,ZF,ZDFDDTDZ,PTSTEP,PIMPL,PDZZ,&
PRHODJ,PTHLP)
!
! Compute the equivalent tendency for the conservative potential temperature
+!
!$acc kernels
-PRTHLS(:,:,:)= PRTHLS(:,:,:) + &
- PRHODJ(:,:,:)*(PTHLP(:,:,:)-PTHLM(:,:,:))/PTSTEP
+ZRWTHL(:,:,:)= PRHODJ(:,:,:)*(PTHLP(:,:,:)-PTHLM(:,:,:))/PTSTEP
+! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
+IF (LHGRAD) THEN
+ DO JK=1,KKU
+ ZALT(:,:,JK) = PZZ(:,:,JK)-XZS(:,:)
+ END DO
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD) .AND. ( ZALT(:,:,:) >= XALTHGRAD) )
+ ZRWTHL(:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:))*ZF_NEW(:,:,:),XDZZ)
+ END WHERE
+END IF
+!
+PRTHLS(:,:,:)= PRTHLS(:,:,:) + ZRWTHL(:,:,:)
!$acc end kernels
!
!* 2.2 Partial Thermal Production
@@ -785,19 +938,35 @@ CALL DZM_DEVICE(KKA,KKU,KKL,ZTMP1_DEVICE,ZTMP2_DEVICE)
!$acc kernels
ZFLXZ(:,:,:) = ZF(:,:,:) + PIMPL * ZDFDDTDZ(:,:,:) * ZTMP2_DEVICE(:,:,:) / PDZZ(:,:,:)
#endif
+! replace the flux by the Leonard terms
+IF (LHGRAD) THEN
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD) .AND. ( ZALT(:,:,:) >= XALTHGRAD) )
+ ZFLXZ(:,:,:) = ZF_NEW(:,:,:)
+ END WHERE
+END IF
!
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
+IF (LOCEAN) THEN
+ ZFLXZ(:,:,KKU) = ZFLXZ(:,:,IKE)
+END IF
!
- DO JK=IKTB+1,IKTE-1
- PWTH(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
- END DO
- PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
- PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
+DO JK=IKTB+1,IKTE-1
+ PWTH(:,:,JK)=0.5*(ZFLXZ(:,:,JK)+ZFLXZ(:,:,JK+KKL))
+END DO
+!
+PWTH(:,:,IKB)=0.5*(ZFLXZ(:,:,IKB)+ZFLXZ(:,:,IKB+KKL))
+!
+IF (LOCEAN) THEN
+ PWTH(:,:,IKE)=0.5*(ZFLXZ(:,:,IKE)+ZFLXZ(:,:,IKE+KKL))
+ PWTH(:,:,KKA)=0.
+ PWTH(:,:,KKU)=ZFLXZ(:,:,KKU)
+ELSE
PWTH(:,:,IKE)=PWTH(:,:,IKE-KKL)
- PWTH(:, :, IKE + 1 : ) = XUNDEF
+ PWTH(:,:,KKA)=0.5*(ZFLXZ(:,:,KKA)+ZFLXZ(:,:,KKA+KKL))
+END IF
!$acc end kernels
!
-IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
!$acc update self(ZFLXZ)
! stores the conservative potential temperature vertical flux
TZFIELD%CMNHNAME = 'THW_FLX'
@@ -814,33 +983,42 @@ IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
END IF
!
! Contribution of the conservative temperature flux to the buoyancy flux
+IF (LOCEAN) THEN
#ifndef MNH_OPENACC
-IF (KRR /= 0) THEN
- PTP(:,:,:) = PBETA(:,:,:) * MZF( MZM(PETHETA) * ZFLXZ(:,:,:) )
- PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
- 0.5 * ( ZFLXZ(:,:,IKB) + ZFLXZ(:,:,IKB+KKL) )
+ PTP(:,:,:)= XG*XALPHAOC * MZF(ZFLXZ )
+#else
+ CALL MZF_DEVICE( ZFLXZ, ZTMP1_DEVICE )
+ PTP(:,:,:) = XG * XALPHAOC * ZTMP1_DEVICE
+#endif
ELSE
- PTP(:,:,:)= PBETA(:,:,:) * MZF( ZFLXZ )
-END IF
+#ifndef MNH_OPENACC
+ IF (KRR /= 0) THEN
+ PTP(:,:,:) = PBETA(:,:,:) * MZF( MZM(PETHETA) * ZFLXZ(:,:,:) )
+ PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
+ 0.5 * ( ZFLXZ(:,:,IKB) + ZFLXZ(:,:,IKB+KKL) )
+ ELSE
+ PTP(:,:,:)= PBETA(:,:,:) * MZF( ZFLXZ )
+ END IF
#else
-IF (KRR /= 0) THEN
- CALL MZM_DEVICE(PETHETA,ZTMP1_DEVICE)
+ IF (KRR /= 0) THEN
+ CALL MZM_DEVICE(PETHETA,ZTMP1_DEVICE)
!$acc kernels
- ZTMP2_DEVICE(:,:,:) = ZTMP1_DEVICE(:,:,:) * ZFLXZ(:,:,:)
+ ZTMP2_DEVICE(:,:,:) = ZTMP1_DEVICE(:,:,:) * ZFLXZ(:,:,:)
!$acc end kernels
- CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP2_DEVICE,ZTMP3_DEVICE)
+ CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP2_DEVICE,ZTMP3_DEVICE)
!$acc kernels
- PTP(:,:,:) = PBETA(:,:,:) * ZTMP3_DEVICE(:,:,:)
- PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
- 0.5 * ( ZFLXZ(:,:,IKB) + ZFLXZ(:,:,IKB+KKL) )
+ PTP(:,:,:) = PBETA(:,:,:) * ZTMP3_DEVICE(:,:,:)
+ PTP(:,:,IKB)= PBETA(:,:,IKB) * PETHETA(:,:,IKB) * &
+ 0.5 * ( ZFLXZ(:,:,IKB) + ZFLXZ(:,:,IKB+KKL) )
!$acc end kernels
-ELSE
- CALL MZF_DEVICE(KKA,KKU,KKL, ZFLXZ,ZTMP1_DEVICE)
+ ELSE
+ CALL MZF_DEVICE(KKA,KKU,KKL, ZFLXZ,ZTMP1_DEVICE)
!$acc kernels
- PTP(:,:,:)= PBETA(:,:,:) * ZTMP1_DEVICE(:,:,:)
+ PTP(:,:,:)= PBETA(:,:,:) * ZTMP1_DEVICE(:,:,:)
!$acc end kernels
-END IF
+ END IF
#endif
+END IF
!
! Buoyancy flux at flux points
!
@@ -854,48 +1032,48 @@ PWTHV(:,:,:) = ZTMP1_DEVICE(:,:,:) * ZFLXZ(:,:,:)
PWTHV(:,:,IKB) = PETHETA(:,:,IKB) * ZFLXZ(:,:,IKB)
!$acc end kernels
!
+IF (LOCEAN) THEN
+ ! temperature contribution to Buy flux
+!$acc kernels
+ PWTHV(:,:,IKE) = PETHETA(:,:,IKE) * ZFLXZ(:,:,IKE)
+!$acc end kernels
+END IF
!* 2.3 Partial vertical divergence of the < Rc w > flux
!
#ifndef MNH_OPENACC
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- DZF( MZM( PRHODJ(:,:,:)*PATHETA(:,:,:)*2.*PSRCM(:,:,:) )*ZFLXZ(:,:,:)/PDZZ(:,:,:) ) &
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ(:,:,:)*PATHETA(:,:,:)*2.*PSRCM(:,:,:)*DZF(ZFLXZ(:,:,:)/PDZZ(:,:,:)) &
*(1.0-PFRAC_ICE(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
- DZF( MZM( PRHODJ(:,:,:)*PATHETA(:,:,:)*2.*PSRCM(:,:,:) )*ZFLXZ(:,:,:)/PDZZ(:,:,:) ) &
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - &
+ PRHODJ(:,:,:)*PATHETA(:,:,:)*2.*PSRCM(:,:,:)*DZF(ZFLXZ(:,:,:)/PDZZ(:,:,:)) &
*PFRAC_ICE(:,:,:)
ELSE
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
- DZF( MZM( PRHODJ(:,:,:)*PATHETA(:,:,:)*2.*PSRCM(:,:,:) )*ZFLXZ(:,:,:)/PDZZ(:,:,:) )
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - &
+ PRHODJ(:,:,:)*PATHETA(:,:,:)*2.*PSRCM(:,:,:)*DZF(ZFLXZ(:,:,:)/PDZZ(:,:,:))
END IF
END IF
#else
IF ( KRRL >= 1 ) THEN
IF ( KRRI >= 1 ) THEN
!$acc kernels
- ZTMP1_DEVICE(:,:,:) = PRHODJ(:,:,:)*PATHETA(:,:,:)*2.*PSRCM(:,:,:)
-!$acc end kernels
- CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE )
-!$acc kernels
- ZTMP1_DEVICE(:,:,:) = ZTMP2_DEVICE(:,:,:)*ZFLXZ(:,:,:)/PDZZ(:,:,:)
+ ZTMP1_DEVICE(:,:,:) = PRHODJ(:,:,:) * PATHETA(:,:,:) * 2. * PSRCM(:,:,:)
+ ZTMP2_DEVICE(:,:,:) = ZFLXZ(:,:,:) / PDZZ(:,:,:)
!$acc end kernels
- CALL DZF_DEVICE(KKA,KKU,KKL, ZTMP1_DEVICE,ZTMP3_DEVICE )
+ CALL DZF_DEVICE( KKA, KKU, KKL, ZTMP2_DEVICE, ZTMP3_DEVICE )
!$acc kernels
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP3_DEVICE(:,:,:) * (1.0-PFRAC_ICE(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - ZTMP3_DEVICE(:,:,:) * PFRAC_ICE(:,:,:)
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP1_DEVICE(:,:,:) * ZTMP3_DEVICE * (1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - ZTMP1_DEVICE(:,:,:) * ZTMP3_DEVICE * PFRAC_ICE(:,:,:)
!$acc end kernels
ELSE
!$acc kernels
- ZTMP1_DEVICE(:,:,:) = PRHODJ(:,:,:)*PATHETA(:,:,:)*2.*PSRCM(:,:,:)
-!$acc end kernels
- CALL MZM_DEVICE(ZTMP1_DEVICE,ZTMP2_DEVICE )
-!$acc kernels
- ZTMP1_DEVICE(:,:,:) = ZTMP2_DEVICE(:,:,:)*ZFLXZ(:,:,:)/PDZZ(:,:,:)
+ ZTMP1_DEVICE(:,:,:) = PRHODJ(:,:,:) * PATHETA(:,:,:) * 2. * PSRCM(:,:,:)
+ ZTMP2_DEVICE(:,:,:) = ZFLXZ(:,:,:) / PDZZ(:,:,:)
!$acc end kernels
- CALL DZF_DEVICE(KKA,KKU,KKL, ZTMP1_DEVICE,ZTMP3_DEVICE )
+ CALL DZF_DEVICE( KKA, KKU, KKL, ZTMP2_DEVICE, ZTMP3_DEVICE )
!$acc kernels
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP3_DEVICE(:,:,:)
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP1_DEVICE(:,:,:) * ZTMP3_DEVICE(:,:,:)
!$acc end kernels
END IF
END IF
@@ -907,23 +1085,23 @@ IF (LLES_CALL) THEN
CALL SECOND_MNH(ZTIME1)
#ifndef MNH_OPENACC
CALL LES_MEAN_SUBGRID( MZF(ZFLXZ), X_LES_SUBGRID_WThl )
- CALL LES_MEAN_SUBGRID( MZF(PWM(:,:,:)*ZFLXZ(:,:,:)), X_LES_RES_W_SBG_WThl )
+ CALL LES_MEAN_SUBGRID( MZF(PWM*ZFLXZ), X_LES_RES_W_SBG_WThl )
CALL LES_MEAN_SUBGRID( GZ_W_M(PWM,PDZZ)*MZF(ZFLXZ),&
& X_LES_RES_ddxa_W_SBG_UaThl )
- CALL LES_MEAN_SUBGRID( MZF(PDTH_DZ(:,:,:)*ZFLXZ(:,:,:)), X_LES_RES_ddxa_Thl_SBG_UaThl )
- CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE(:,:,:)/PLM(:,:,:)*MZF(ZFLXZ), X_LES_SUBGRID_ThlPz )
- CALL LES_MEAN_SUBGRID( MZF(MZM(PETHETA)*ZFLXZ(:,:,:)), X_LES_SUBGRID_WThv )
+ CALL LES_MEAN_SUBGRID( MZF(PDTH_DZ*ZFLXZ), X_LES_RES_ddxa_Thl_SBG_UaThl )
+ CALL LES_MEAN_SUBGRID( -XCTP*PSQRT_TKE/PLM*MZF(ZFLXZ), X_LES_SUBGRID_ThlPz )
+ CALL LES_MEAN_SUBGRID( MZF(MZM(PETHETA)*ZFLXZ), X_LES_SUBGRID_WThv )
IF (KRR>=1) THEN
- CALL LES_MEAN_SUBGRID( MZF(PDR_DZ(:,:,:)*ZFLXZ(:,:,:)), X_LES_RES_ddxa_Rt_SBG_UaThl )
+ CALL LES_MEAN_SUBGRID( MZF(PDR_DZ*ZFLXZ), X_LES_RES_ddxa_Rt_SBG_UaThl )
END IF
!* diagnostic of mixing coefficient for heat
- ZA(:,:,:) = DZM(PTHLP)
- WHERE (ZA(:,:,:)==0.) ZA(:,:,:)=1.E-6
- ZA(:,:,:) = - ZFLXZ(:,:,:) / ZA(:,:,:) * PDZZ(:,:,:)
+ ZA = DZM(PTHLP)
+ WHERE (ZA==0.) ZA=1.E-6
+ ZA = - ZFLXZ / ZA * PDZZ
ZA(:,:,IKB) = XCSHF*PPHI3(:,:,IKB)*ZKEFF(:,:,IKB)
- ZA(:,:,:) = MZF( ZA )
- ZA(:,:,:) = MIN(MAX(ZA(:,:,:),-1000.),1000.)
- CALL LES_MEAN_SUBGRID( ZA, X_LES_SUBGRID_Kh )
+ ZA = MZF( ZA )
+ ZA = MIN(MAX(ZA,-1000.),1000.)
+ CALL LES_MEAN_SUBGRID( ZA, X_LES_SUBGRID_Kh )
#else
!$acc data copy(X_LES_SUBGRID_WThl,X_LES_RES_W_SBG_WThl,X_LES_RES_ddxa_W_SBG_UaThl,X_LES_RES_ddxa_Thl_SBG_UaThl,&
!$acc & X_LES_SUBGRID_ThlPz,X_LES_SUBGRID_WThv,X_LES_RES_ddxa_Rt_SBG_UaThl,X_LES_SUBGRID_Kh)
@@ -969,8 +1147,10 @@ IF (LLES_CALL) THEN
WHERE (ZA(:,:,:)==0.) ZA(:,:,:)=1.E-6
ZA(:,:,:) = - ZFLXZ(:,:,:) / ZA(:,:,:) * PDZZ(:,:,:)
ZA(:,:,IKB) = XCSHF*PPHI3(:,:,IKB)*ZKEFF(:,:,IKB)
+ !Copy ZA into ZTMP1_DEVICE to prevent aliasing in the following call to MZF_DEVICE
+ ZTMP1_DEVICE(:,:,:) = ZA(:,:,:)
!$acc end kernels
- CALL MZF_DEVICE(KKA,KKU,KKL, ZA, ZA )
+ CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP1_DEVICE, ZA )
!$acc kernels
ZA(:,:,:) = MIN(MAX(ZA(:,:,:),-1000.),1000.)
!$acc end kernels
@@ -1014,6 +1194,16 @@ IF (KRR /= 0) THEN
!$acc end kernels
#endif
!
+ ! Compute Leonard Terms for Cloud mixing ratio
+ IF (LHGRAD) THEN
+ ZDELTAX= XXHAT(3) - XXHAT(2)
+ ZF_NEW (:,:,:)= XCOEFHGRADRM*ZDELTAX*ZDELTAX/12.0*( &
+ MXF(GX_W_UW(PWM(:,:,:), XDXX, XDZZ, XDZX)) &
+ *MZM(GX_M_M(PRM(:,:,:,1),XDXX,XDZZ,XDZX)) &
+ +MYF(GY_W_VW(PWM(:,:,:), XDYY,XDZZ,XDZY)) &
+ *MZM(GY_M_M(PRM(:,:,:,1),XDYY,XDZZ,XDZY)) )
+ END IF
+ !
! Effect of 3rd order terms in temperature flux (at flux point)
!
! d(w'2r')/dz
@@ -1139,33 +1329,74 @@ IF (KRR /= 0) THEN
END IF
#endif
!
- !* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
- ! (in presence of slopes)
- !* in 1DIM case, the part of energy released in horizontal flux
- ! is taken into account in the vertical part
- !
- IF (HTURBDIM=='3DIM') THEN
+ ! compute interface flux
+ IF (LCOUPLES) THEN ! coupling NH O-A
+ IF (LOCEAN) THEN ! ocean model in coupled case
+ ! evap effect on salinity to be added later !!!
!$acc kernels
- ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
- * PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ ZF(:,:,IKE) = 0.
!$acc end kernels
- ELSE
+ ELSE ! atmosph model in coupled case
!$acc kernels
- ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
- / PDIRCOSZW(:,:) &
- * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+ ZF(:,:,IKB) = 0.
!$acc end kernels
- END IF
+ ! AJOUTER FLUX EVAP SUR MODELE ATMOS
+ ENDIF
!
- ! Compute the splitted conservative potential temperature at t+deltat
+ ELSE ! No coupling NH OA case
+ ! atmosp bottom
+ !* in 3DIM case, a part of the flux goes vertically, and another goes horizontally
+ ! (in presence of slopes)
+ !* in 1DIM case, the part of energy released in horizontal flux
+ ! is taken into account in the vertical part
+ !
+ IF (HTURBDIM=='3DIM') THEN
+!$acc kernels
+ ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
+ * PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+!$acc end kernels
+ ELSE
+!$acc kernels
+ ZF(:,:,IKB) = ( PIMPL*PSFRP(:,:) + PEXPL*PSFRM(:,:) ) &
+ / PDIRCOSZW(:,:) &
+ * 0.5 * (1. + PRHODJ(:,:,KKA) / PRHODJ(:,:,IKB))
+!$acc end kernels
+ END IF
+ !
+ IF (LOCEAN) THEN
+ ! General ocean case
+ ! salinity/evap effect to be added later !!!!!
+!$acc kernels
+ ZF(:,:,IKE) = 0.
+!$acc end kernels
+ ELSE !end ocean case (in nocoupled case)
+ ! atmos top
+!$acc kernels
+ ZF(:,:,IKE)=0.
+!$acc end kernels
+ END IF
+ END IF!end no coupled cases
+ ! Compute the split conservative potential temperature at t+deltat
CALL TRIDIAG_THERMO(KKA,KKU,KKL,PRM(:,:,:,1),ZF,ZDFDDRDZ,PTSTEP,PIMPL,&
PDZZ,PRHODJ,PRP)
!
! Compute the equivalent tendency for the conservative mixing ratio
+ !
!$acc kernels
- PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRHODJ(:,:,:) * &
- (PRP(:,:,:)-PRM(:,:,:,1))/PTSTEP
+ ZRWRNP (:,:,:) = PRHODJ(:,:,:)*(PRP(:,:,:)-PRM(:,:,:,1))/PTSTEP
+ !
+ ! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
+ IF (LHGRAD) THEN
+ DO JK=1,KKU
+ ZALT(:,:,JK) = PZZ(:,:,JK)-XZS(:,:)
+ END DO
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD ) .AND. ( ZALT(:,:,:) >= XALTHGRAD ) )
+ ZRWRNP (:,:,:) = -GZ_W_M(MZM(PRHODJ(:,:,:))*ZF_NEW(:,:,:),XDZZ)
+ END WHERE
+ END IF
+ !
+ PRRS(:,:,:,1) = PRRS(:,:,:,1) + ZRWRNP (:,:,:)
!$acc end kernels
!
!* 3.2 Complete thermal production
@@ -1185,6 +1416,15 @@ IF (KRR /= 0) THEN
!$acc end kernels
#endif
!
+ ! replace the flux by the Leonard terms above ZALT and ZCLD_THOLD
+ IF (LHGRAD) THEN
+!$acc kernels
+ WHERE ( (ZCLD_THOLD(:,:,:) >= XCLDTHOLD ) .AND. ( ZALT(:,:,:) >= XALTHGRAD ) )
+ ZFLXZ(:,:,:) = ZF_NEW(:,:,:)
+ END WHERE
+!$acc end kernels
+ END IF
+ !
!$acc kernels
ZFLXZ(:,:,KKA) = ZFLXZ(:,:,IKB)
!
@@ -1198,7 +1438,7 @@ IF (KRR /= 0) THEN
!$acc end kernels
!
!
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
!$acc update self(ZFLXZ)
! stores the conservative mixing ratio vertical flux
TZFIELD%CMNHNAME = 'RCONSW_FLX'
@@ -1215,33 +1455,49 @@ IF (KRR /= 0) THEN
END IF
!
! Contribution of the conservative water flux to the Buoyancy flux
+ IF (LOCEAN) THEN
#ifndef MNH_OPENACC
- ZA(:,:,:) = PBETA(:,:,:) * MZF( MZM(PEMOIST) * ZFLXZ(:,:,:) )
+ ZA(:,:,:)= -XG * XBETAOC * MZF(ZFLXZ )
#else
- CALL MZM_DEVICE(PEMOIST,ZTMP1_DEVICE)
- !$acc kernels
- ZTMP2_DEVICE(:,:,:) = ZTMP1_DEVICE(:,:,:) * ZFLXZ(:,:,:)
- !$acc end kernels
- CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP2_DEVICE, ZTMP3_DEVICE )
- !$acc kernels
- ZA(:,:,:) = PBETA(:,:,:) * ZTMP3_DEVICE(:,:,:)
+ CALL MZF_DEVICE( ZFLXZ, ZTMP1_DEVICE )
+!$acc kernels
+ ZA(:,:,:)= -XG * XBETAOC * ZTMP1_DEVICE(:,:,:)
+!$acc end kernels
#endif
- ZA(:,:,IKB) = PBETA(:,:,IKB) * PEMOIST(:,:,IKB) * &
- 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
- PTP(:,:,:) = PTP(:,:,:) + ZA(:,:,:)
- !$acc end kernels
+ ELSE
+#ifndef MNH_OPENACC
+ ZA(:,:,:) = PBETA * MZF( MZM(PEMOIST) * ZFLXZ )
+#else
+ CALL MZM_DEVICE(PEMOIST,ZTMP1_DEVICE)
+!$acc kernels
+ ZTMP2_DEVICE(:,:,:) = ZTMP1_DEVICE(:,:,:) * ZFLXZ(:,:,:)
+!$acc end kernels
+ CALL MZF_DEVICE(KKA,KKU,KKL, ZTMP2_DEVICE, ZTMP3_DEVICE )
+!$acc kernels
+ ZA(:,:,:) = PBETA(:,:,:) * ZTMP3_DEVICE(:,:,:)
+#endif
+ ZA(:,:,IKB) = PBETA(:,:,IKB) * PEMOIST(:,:,IKB) * &
+ 0.5 * ( ZFLXZ (:,:,IKB) + ZFLXZ (:,:,IKB+KKL) )
+ PTP(:,:,:) = PTP(:,:,:) + ZA(:,:,:)
+!$acc end kernels
+ END IF
!
! Buoyancy flux at flux points
!
#ifndef MNH_OPENACC
- PWTHV(:,:,:) = PWTHV(:,:,:) + MZM(PEMOIST) * ZFLXZ(:,:,:)
+ PWTHV = PWTHV + MZM(PEMOIST) * ZFLXZ
#else
CALL MZM_DEVICE(PEMOIST,ZTMP1_DEVICE)
- !$acc kernels
- PWTHV(:,:,:) = PWTHV(:,:,:) + ZTMP1_DEVICE(:,:,:) * ZFLXZ(:,:,:)
+!$acc kernels
+ PWTHV(:,:,:) = PWTHV(:,:,:) + ZTMP1_DEVICE * ZFLXZ
#endif
PWTHV(:,:,IKB) = PWTHV(:,:,IKB) + PEMOIST(:,:,IKB) * ZFLXZ(:,:,IKB)
- !$acc end kernels
+!$acc end kernels
+ IF (LOCEAN) THEN
+!$acc kernels
+ PWTHV(:,:,IKE) = PWTHV(:,:,IKE) + PEMOIST(:,:,IKE)* ZFLXZ(:,:,IKE)
+!$acc end kernels
+ END IF
!
!* 3.3 Complete vertical divergence of the < Rc w > flux
!
@@ -1249,14 +1505,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
#else
@@ -1264,27 +1520,21 @@ IF (KRR /= 0) THEN
IF ( KRRI >= 1 ) THEN
!$acc kernels
ZTMP1_DEVICE(:,:,:) = PRHODJ(:,:,:)*PAMOIST(:,:,:)*2.*PSRCM(:,:,:)
+ ZTMP2_DEVICE(:,:,:) = ZFLXZ(:,:,:)/PDZZ(:,:,:)
!$acc end kernels
- CALL MZM_DEVICE(ZTMP1_DEVICE, ZTMP2_DEVICE )
-!$acc kernels
- ZTMP3_DEVICE(:,:,:) = ZTMP2_DEVICE(:,:,:)*ZFLXZ(:,:,:)/PDZZ(:,:,:)
-!$acc end kernels
- CALL DZF_DEVICE(KKA,KKU,KKL, ZTMP3_DEVICE, ZTMP4_DEVICE )
+ CALL DZF_DEVICE(KKA,KKU,KKL, ZTMP2_DEVICE, ZTMP3_DEVICE )
!$acc kernels
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP4_DEVICE(:,:,:) * (1.0-PFRAC_ICE(:,:,:))
- PRRS(:,:,:,4) = PRRS(:,:,:,4) - ZTMP4_DEVICE(:,:,:) * PFRAC_ICE(:,:,:)
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP1_DEVICE(:,:,:) * ZTMP3_DEVICE(:,:,:) * (1.0-PFRAC_ICE(:,:,:))
+ PRRS(:,:,:,4) = PRRS(:,:,:,4) - ZTMP1_DEVICE(:,:,:) * ZTMP3_DEVICE(:,:,:) * PFRAC_ICE(:,:,:)
!$acc end kernels
ELSE
!$acc kernels
ZTMP1_DEVICE(:,:,:) = PRHODJ(:,:,:)*PAMOIST(:,:,:)*2.*PSRCM(:,:,:)
+ ZTMP2_DEVICE(:,:,:) = ZFLXZ(:,:,:)/PDZZ(:,:,:)
!$acc end kernels
- CALL MZM_DEVICE(ZTMP1_DEVICE, ZTMP2_DEVICE )
+ CALL DZF_DEVICE(KKA,KKU,KKL, ZTMP2_DEVICE, ZTMP3_DEVICE )
!$acc kernels
- ZTMP3_DEVICE(:,:,:) = ZTMP2_DEVICE(:,:,:)*ZFLXZ(:,:,:)/PDZZ(:,:,:)
-!$acc end kernels
- CALL DZF_DEVICE(KKA,KKU,KKL, ZTMP3_DEVICE, ZTMP4_DEVICE )
-!$acc kernels
- PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP4_DEVICE(:,:,:)
+ PRRS(:,:,:,2) = PRRS(:,:,:,2) - ZTMP1_DEVICE(:,:,:) * ZTMP3_DEVICE(:,:,:)
!$acc end kernels
END IF
END IF
@@ -1364,7 +1614,7 @@ END IF
!
!* 4.1 <w Rc>
!
-IF ( ((OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
+IF ( ((OTURB_FLX .AND. tpfile%lopened) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
!
! recover the Conservative potential temperature flux :
#ifndef MNH_OPENACC
@@ -1406,7 +1656,7 @@ IF ( ((OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
!$acc end kernels
!
! store the liquid water mixing ratio vertical flux
- IF ( OTURB_FLX .AND. OCLOSE_OUT ) THEN
+ IF ( OTURB_FLX .AND. tpfile%lopened ) THEN
TZFIELD%CMNHNAME = 'RCW_FLX'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = 'RCW_FLX'
@@ -1439,6 +1689,10 @@ IF ( ((OTURB_FLX .AND. OCLOSE_OUT) .OR. LLES_CALL) .AND. (KRRL > 0) ) THEN
!
END IF !end of <w Rc>
+IF (LOCEAN.AND.LDEEPOC) THEN
+ DEALLOCATE(ZXHAT_ll,ZYHAT_ll)
+END IF
+
if ( mppdb_initialized ) then
!Check all inout arrays
call Mppdb_check( pbl_depth, "Turb_ver_thermo_flux end:pbl_depth" )
diff --git a/src/MNH/two_way.f90 b/src/MNH/two_way.f90
index 64f72579c3d267f8fee4317d90886a6a21d8b22d..bd6a98cdc980bdc292adc3775a83bd2b02733c2e 100644
--- a/src/MNH/two_way.f90
+++ b/src/MNH/two_way.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1999-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1999-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -92,22 +92,27 @@ END MODULE MODI_TWO_WAY
!! hydrometeors, the Short and Long Wave
!! + MASKkids array
!! 20/05/06 Remove EPS
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! 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
+!
!------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
+use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
USE MODD_NESTING
-USE MODD_BUDGET
-USE MODI_BUDGET
-!
-USE MODI_TWO_WAY_n
+use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_MODELN_HANDLER
-!
+
+USE MODI_TWO_WAY_n
+
IMPLICIT NONE
!
!
@@ -145,6 +150,23 @@ INTEGER :: JKID ! loop index to look for the KID models
INTEGER :: JSV,JRR ! Loop index for scalar and moist variables
!
!-------------------------------------------------------------------------------
+
+if ( lbudget_u ) call Budget_store_init( tbudgets(NBUDGET_U ), 'NEST', prus (:, :, : ) )
+if ( lbudget_v ) call Budget_store_init( tbudgets(NBUDGET_V ), 'NEST', prvs (:, :, : ) )
+if ( lbudget_w ) call Budget_store_init( tbudgets(NBUDGET_W ), 'NEST', prws (:, :, : ) )
+if ( lbudget_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'NEST', prths(:, :, : ) )
+if ( lbudget_rv ) call Budget_store_init( tbudgets(NBUDGET_RV), 'NEST', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_init( tbudgets(NBUDGET_RC), 'NEST', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_init( tbudgets(NBUDGET_RR), 'NEST', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_init( tbudgets(NBUDGET_RI), 'NEST', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_init( tbudgets(NBUDGET_RS), 'NEST', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_init( tbudgets(NBUDGET_RG), 'NEST', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_init( tbudgets(NBUDGET_RH), 'NEST', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_init( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEST', prsvs(:, :, :, jsv) )
+ end do
+end if
!
!* 1. CALL THE RIGHT TWO_WAY$n
! ------------------------
@@ -165,22 +187,22 @@ CALL GOTO_MODEL(KMI)
!* 2. BUDGET COMPUTATION
! ------------------
!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'NEST_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'NEST_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,3,'NEST_BU_RW')
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'NEST_BU_RTH')
-DO JRR=1,KRR
- IF (JRR==1 .AND. LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,JRR),6,'NEST_BU_RRV')
- IF (JRR==2 .AND. LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,JRR),7,'NEST_BU_RRC')
- IF (JRR==3 .AND. LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,JRR),8,'NEST_BU_RRR')
- IF (JRR==4 .AND. LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,JRR),9,'NEST_BU_RRI')
- IF (JRR==5 .AND. LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,JRR),10,'NEST_BU_RRS')
- IF (JRR==6 .AND. LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,JRR),11,'NEST_BU_RRG')
- IF (JRR==7 .AND. LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,JRR),12,'NEST_BU_RRH')
-ENDDO
-DO JSV=1,KSV
- IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),12+JSV,'NEST_BU_RSV')
-END DO
+if ( lbudget_u ) call Budget_store_end( tbudgets(NBUDGET_U ), 'NEST', prus (:, :, : ) )
+if ( lbudget_v ) call Budget_store_end( tbudgets(NBUDGET_V ), 'NEST', prvs (:, :, : ) )
+if ( lbudget_w ) call Budget_store_end( tbudgets(NBUDGET_W ), 'NEST', prws (:, :, : ) )
+if ( lbudget_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'NEST', prths(:, :, : ) )
+if ( lbudget_rv ) call Budget_store_end( tbudgets(NBUDGET_RV), 'NEST', prrs (:, :, :, 1) )
+if ( lbudget_rc ) call Budget_store_end( tbudgets(NBUDGET_RC), 'NEST', prrs (:, :, :, 2) )
+if ( lbudget_rr ) call Budget_store_end( tbudgets(NBUDGET_RR), 'NEST', prrs (:, :, :, 3) )
+if ( lbudget_ri ) call Budget_store_end( tbudgets(NBUDGET_RI), 'NEST', prrs (:, :, :, 4) )
+if ( lbudget_rs ) call Budget_store_end( tbudgets(NBUDGET_RS), 'NEST', prrs (:, :, :, 5) )
+if ( lbudget_rg ) call Budget_store_end( tbudgets(NBUDGET_RG), 'NEST', prrs (:, :, :, 6) )
+if ( lbudget_rh ) call Budget_store_end( tbudgets(NBUDGET_RH), 'NEST', prrs (:, :, :, 7) )
+if ( lbudget_sv ) then
+ do jsv = 1, ksv
+ call Budget_store_end( tbudgets(jsv + NBUDGET_SV1 - 1), 'NEST', prsvs(:, :, :, jsv) )
+ end do
+end if
!------------------------------------------------------------------------------
!
END SUBROUTINE TWO_WAY
diff --git a/src/MNH/update_nsv.f90 b/src/MNH/update_nsv.f90
index 3d691aa48dabfe34ea208d0107de0cf630208887..c706bfe90fb70043a98770e68a2ab27e486a7745 100644
--- a/src/MNH/update_nsv.f90
+++ b/src/MNH/update_nsv.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!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.
@@ -26,6 +26,8 @@ END MODULE MODI_UPDATE_NSV
!! Modify (Vie) 2016 : add LIMA
!! V. Vionnet 7/2017 : add blowing snow var
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Wautelet 10/03/2021: add CSVNAMES and CSVNAMES_A to store the name of all the scalar variables
+!-------------------------------------------------------------------------------
!
USE MODD_CONF, ONLY : NVERB
USE MODD_NSV
@@ -35,6 +37,9 @@ use mode_msg
IMPLICIT NONE
INTEGER, INTENT(IN) :: KMI ! Model index
+
+CHARACTER(LEN=JPSVNAMELGTMAX), DIMENSION(:,:), ALLOCATABLE :: YSVNAMES_TMP
+INTEGER :: JI, JJ
!
! STOP if INI_NSV has not be called yet
IF (.NOT. LINI_NSV) THEN
@@ -44,6 +49,22 @@ END IF
! Update the NSV_* variables from original NSV_*_A arrays
! that have been initialized in ini_nsv.f90 for model KMI
!
+
+! Allocate/reallocate CSVNAMES_A
+IF ( .NOT. ALLOCATED( CSVNAMES_A ) ) ALLOCATE( CSVNAMES_A( NSV_A(KMI), KMI) )
+!If CSVNAMES_A is too small, enlarge it and transfer data
+IF ( SIZE( CSVNAMES_A, 1 ) < NSV_A(KMI) .OR. SIZE( CSVNAMES_A, 2 ) < KMI ) THEN
+ ALLOCATE( YSVNAMES_TMP(NSV_A(KMI), KMI) )
+ DO JJ = 1, SIZE( CSVNAMES_A, 2 )
+ DO JI = 1, SIZE( CSVNAMES_A, 1 )
+ YSVNAMES_TMP(JI, JJ) = CSVNAMES_A(JI, JJ)
+ END DO
+ END DO
+ CALL MOVE_ALLOC( FROM = YSVNAMES_TMP, TO = CSVNAMES_A )
+END IF
+
+CSVNAMES => CSVNAMES_A(:,KMI)
+
NSV = NSV_A(KMI)
NSV_USER = NSV_USER_A(KMI)
NSV_C2R2 = NSV_C2R2_A(KMI)
@@ -66,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/uv_to_zonal_and_merid.f90 b/src/MNH/uv_to_zonal_and_merid.f90
index 1403691bc4aa5fb2508a579179af35330f8f383c..6ce72b8c276368ca96f11d8626d9e8477081a170 100644
--- a/src/MNH/uv_to_zonal_and_merid.f90
+++ b/src/MNH/uv_to_zonal_and_merid.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2000-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -9,8 +9,8 @@
INTERFACE UV_TO_ZONAL_AND_MERID
SUBROUTINE UV_TO_ZONAL_AND_MERID3D(PU,PV,KGRID,PZC,PMC,TPFILE,TZFIELDS)
!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODE_FIELD, ONLY: TFIELDDATA
+use modd_field, only: tfielddata
+use modd_io, only: tfiledata
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! Input U component
REAL, DIMENSION(:,:,:), INTENT(IN) :: PV ! Input V component
@@ -24,8 +24,8 @@ END SUBROUTINE UV_TO_ZONAL_AND_MERID3D
!
SUBROUTINE UV_TO_ZONAL_AND_MERID2D(PU,PV,KGRID,PZC,PMC,TPFILE,TZFIELDS)
!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODE_FIELD, ONLY: TFIELDDATA
+use modd_field, only: tfielddata
+use modd_io, only: tfiledata
!
REAL, DIMENSION(:,:), INTENT(IN) :: PU ! Input U component
REAL, DIMENSION(:,:), INTENT(IN) :: PV ! Input V component
@@ -47,8 +47,8 @@ INTERFACE
!
SUBROUTINE UV_TO_ZONAL_AND_MERID3D(PU,PV,KGRID,PZC,PMC,TPFILE,TZFIELDS)
!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODE_FIELD, ONLY: TFIELDDATA
+use modd_field, only: tfielddata
+use modd_io, only: tfiledata
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PU ! Input U component
REAL, DIMENSION(:,:,:), INTENT(IN) :: PV ! Input V component
@@ -103,13 +103,13 @@ END MODULE MODI_UV_TO_ZONAL_AND_MERID3D
USE MODD_CONF
USE MODD_CST
USE MODD_DIM_n
+use modd_field, only: tfielddata
USE MODD_GRID
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
!
-USE MODE_FIELD, ONLY: TFIELDDATA
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
!
@@ -276,10 +276,10 @@ END SUBROUTINE UV_TO_ZONAL_AND_MERID3D
!* 0. DECLARATIONS
! ------------
!
+use modd_field, only: tfielddata
USE MODD_IO, ONLY: TFILEDATA, NVERB_WARNING
USE MODD_LUNIT_n, ONLY: TLUOUT
!
-USE MODE_FIELD, ONLY: TFIELDDATA
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_MSG
!
diff --git a/src/MNH/ver_dyn.f90 b/src/MNH/ver_dyn.f90
index 925c2225b66e5466ba7fc21484e247670678eb61..7c282a1f0b2a858ae475664d69980242d9412868 100644
--- a/src/MNH/ver_dyn.f90
+++ b/src/MNH/ver_dyn.f90
@@ -158,7 +158,6 @@ USE MODI_SHUMAN
USE MODI_VER_INT_DYN
USE MODI_VER_INTERP_LIN
USE MODI_VER_SHIFT
-USE MODI_WGUESS
!
IMPLICIT NONE
!
diff --git a/src/MNH/ver_int_thermo.f90 b/src/MNH/ver_int_thermo.f90
index 1d3424a943e422cf37b2ec52dd4651470c25a108..6be5b55a95870bb49b471dc9c686dd0529088234 100644
--- a/src/MNH/ver_int_thermo.f90
+++ b/src/MNH/ver_int_thermo.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -136,6 +136,7 @@ END MODULE MODI_VER_INT_THERMO
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
! P. Wautelet 22/02/2019: replace Hollerith edit descriptor (deleted from Fortran 95 standard)
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
+!! Jean-Luc Redelsperger 03/2021 OCEAN LES case
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -145,6 +146,7 @@ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
+USE MODD_DYN_n, ONLY: LOCEAN
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA
USE MODD_LUNIT, ONLY: TLUOUT0
@@ -343,38 +345,42 @@ CALL MPPDB_CHECK3D(ZPMHPOHP_SH,"ver_int_thermo2a::ZPMHPOHP_SH",PRECISION)
!* 3.1 Computation of the shift profile
! --------------------------------
!
-ZTHVCLIMGR=3.5E-3 ! K/m
-CALL FREE_ATM_PROFILE(TPFILE,PTHV_MX,PZMASS_MX,PZS_LS,PZSMT_LS,ZTHVCLIMGR,ZTHV_FREE,ZZ_FREE)
-CALL MPPDB_CHECK3D(ZTHV_FREE,"VER_INT_THERMO:ZTHV_FREE",PRECISION)
+IF (LOCEAN) THEN
+ ZTHV_SH(:,:,:) = PTHV_MX(:,:,:)
+ELSE
+ ZTHVCLIMGR=3.5E-3 ! K/m
+ CALL FREE_ATM_PROFILE(TPFILE,PTHV_MX,PZMASS_MX,PZS_LS,PZSMT_LS,ZTHVCLIMGR,ZTHV_FREE,ZZ_FREE)
+ CALL MPPDB_CHECK3D(ZTHV_FREE,"VER_INT_THERMO:ZTHV_FREE",PRECISION)
!
!* 3.2 Computation of the value of thetav on the shifted grid
! ------------------------------------------------------
!
-CALL COEF_VER_INTERP_LIN(ZZ_FREE(:,:,:),PZMASS_MX(:,:,:))
-ZTHV_FREE_MX(:,:,:)=VER_INTERP_LIN(ZTHV_FREE(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"VER_INT_THERMO:ZTHV_FREE_MX",PRECISION)
+ CALL COEF_VER_INTERP_LIN(ZZ_FREE(:,:,:),PZMASS_MX(:,:,:))
+ ZTHV_FREE_MX(:,:,:)=VER_INTERP_LIN(ZTHV_FREE(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+ CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"VER_INT_THERMO:ZTHV_FREE_MX",PRECISION)
!
-!20131113 add update_halo here
-CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"ver_int_thermo3a::ZTHV_FREE_MX",PRECISION)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTHV_FREE_MX, 'VER_INT_THERMO::ZTHV_FREE_MX' )
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!20131112 check3d
-CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"ver_int_thermo2a::ZTHV_FREE_MX",PRECISION)
+ !20131113 add update_halo here
+ CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"ver_int_thermo3a::ZTHV_FREE_MX",PRECISION)
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTHV_FREE_MX, 'VER_INT_THERMO::ZTHV_FREE_MX' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131112 check3d
+ CALL MPPDB_CHECK3D(ZTHV_FREE_MX,"ver_int_thermo2a::ZTHV_FREE_MX",PRECISION)
!
-CALL COEF_VER_INTERP_LIN(ZZ_FREE(:,:,:),ZZMASS_SH(:,:,:))
-ZTHV_FREE_SH(:,:,:)=VER_INTERP_LIN(ZTHV_FREE(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
-CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"VER_INT_THERMO:ZTHV_FREE_SH",PRECISION)
+ CALL COEF_VER_INTERP_LIN(ZZ_FREE(:,:,:),ZZMASS_SH(:,:,:))
+ ZTHV_FREE_SH(:,:,:)=VER_INTERP_LIN(ZTHV_FREE(:,:,:),NKLIN(:,:,:),XCOEFLIN(:,:,:))
+ CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"VER_INT_THERMO:ZTHV_FREE_SH",PRECISION)
!
-!20131113 add update_halo here
-CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"ver_int_thermo3a::ZTHV_FREE_SH",PRECISION)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTHV_FREE_SH, 'VER_INT_THERMO::ZTHV_FREE_SH' )
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!20131112 check3d
-CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"ver_int_thermo2a::ZTHV_FREE_SH",PRECISION)
-!
-ZTHV_SH(:,:,:) = PTHV_MX(:,:,:) - ZTHV_FREE_MX(:,:,:) + ZTHV_FREE_SH(:,:,:)
+ !20131113 add update_halo here
+ CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"ver_int_thermo3a::ZTHV_FREE_SH",PRECISION)
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTHV_FREE_SH, 'VER_INT_THERMO::ZTHV_FREE_SH' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131112 check3d
+ CALL MPPDB_CHECK3D(ZTHV_FREE_SH,"ver_int_thermo2a::ZTHV_FREE_SH",PRECISION)
+!
+ ZTHV_SH(:,:,:) = PTHV_MX(:,:,:) - ZTHV_FREE_MX(:,:,:) + ZTHV_FREE_SH(:,:,:)
+END IF
!
!20131113 add update_halo here
CALL MPPDB_CHECK3D(ZTHV_SH,"ver_int_thermo3a::ZTHV_SH",PRECISION)
@@ -393,29 +399,37 @@ CALL MPPDB_CHECK3D(ZTHV_SH,"ver_int_thermo2a::ZTHV_SH",PRECISION)
!* 4.1 Computation of relative humidity on the mixed grid
! --------------------------------------------------
!
-ZRV_MX(:,:,:)=MAX(PR_MX(:,:,:,1),1.E-10)
-ZTH_MX(:,:,:)=PTHV_MX(:,:,:)*(1.+WATER_SUM(PR_MX(:,:,:,:)))/(1.+XRV/XRD*ZRV_MX(:,:,:))
-!
-!20131113 add update_halo here
-CALL MPPDB_CHECK3D(ZTH_MX,"ver_int_thermo4a::ZTH_MX",PRECISION)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTH_MX, 'VER_INT_THERMO::ZTH_MX' )
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!20131112 check3d
-CALL MPPDB_CHECK3D(ZTH_MX,"ver_int_thermo4b::ZTH_MX",PRECISION)
+IF (LOCEAN) THEN
+ ZRV_MX(:,:,:) = PR_MX(:,:,:,1)
+ ZTH_MX(:,:,:) = PTHV_MX(:,:,:)
+ ZT_MX(:,:,:) = ZTH_MX(:,:,:)
+ ZES_MX(:,:,:) = SM_FOES(ZT_MX(:,:,:))
+ ZHU_MX(:,:,:) = 1.E-10
+ELSE
+ ZRV_MX(:,:,:)=MAX(PR_MX(:,:,:,1),1.E-10)
+ ZTH_MX(:,:,:)=PTHV_MX(:,:,:)*(1.+WATER_SUM(PR_MX(:,:,:,:)))/(1.+XRV/XRD*ZRV_MX(:,:,:))
!
-ZT_MX(:,:,:)=ZTH_MX(:,:,:)*ZEXNMASS_MX(:,:,:)
+ !20131113 add update_halo here
+ CALL MPPDB_CHECK3D(ZTH_MX,"ver_int_thermo4a::ZTH_MX",PRECISION)
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZTH_MX, 'VER_INT_THERMO::ZTH_MX' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131112 check3d
+ CALL MPPDB_CHECK3D(ZTH_MX,"ver_int_thermo4b::ZTH_MX",PRECISION)
!
-!20131113 add update_halo here
-CALL MPPDB_CHECK3D(ZT_MX,"ver_int_thermo4a::ZT_MX",PRECISION)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZT_MX, 'VER_INT_THERMO::ZT_MX' )
- CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
- CALL CLEANLIST_ll(TZFIELDS_ll)
-!20131112 check3d
-CALL MPPDB_CHECK3D(ZT_MX,"ver_int_thermo4b::ZT_MX",PRECISION)
+ ZT_MX(:,:,:)=ZTH_MX(:,:,:)*ZEXNMASS_MX(:,:,:)
!
-ZES_MX(:,:,:)=SM_FOES(ZT_MX(:,:,:))
-ZHU_MX(:,:,:)=100.*ZP_MX(:,:,:)/(XRD/XRV/ZRV_MX(:,:,:)+1.)/ZES_MX(:,:,:)
+ !20131113 add update_halo here
+ CALL MPPDB_CHECK3D(ZT_MX,"ver_int_thermo4a::ZT_MX",PRECISION)
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZT_MX, 'VER_INT_THERMO::ZT_MX' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131112 check3d
+ CALL MPPDB_CHECK3D(ZT_MX,"ver_int_thermo4b::ZT_MX",PRECISION)
+!
+ ZES_MX(:,:,:)=SM_FOES(ZT_MX(:,:,:))
+ ZHU_MX(:,:,:)=100.*ZP_MX(:,:,:)/(XRD/XRV/ZRV_MX(:,:,:)+1.)/ZES_MX(:,:,:)
+END IF
!
!20131113 add update_halo here
CALL MPPDB_CHECK3D(ZHU_MX,"ver_int_thermo4a::ZHU_MX",PRECISION)
@@ -549,17 +563,22 @@ END DO
CALL COMPUTE_EXNER_FROM_TOP(PTHV,XZZ,PEXNTOP2D,ZHEXN,ZHEXNMASS)
ZP(:,:,:) = PPMHP(:,:,:) + XP00 * ZHEXNMASS(:,:,:) ** (XCPD/XRD)
!
-!20131113 add update_halo here
-!CALL MPPDB_CHECK3D(ZP,"ver_int_thermo6a::ZP",PRECISION)
-CALL ADD3DFIELD_ll( TZFIELDS_ll, ZP, 'VER_INT_THERMO::ZP' )
-CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZFIELDS_ll)
-!20131112 check3d
-CALL MPPDB_CHECK3D(ZP,"ver_int_thermo6b::ZP",PRECISION)
-!
-PR(:,:,:,1)=SM_PMR_HU(ZP(:,:,:), &
- PTHV(:,:,:)*(ZP(:,:,:)/XP00)**(XRD/XCPD), &
- ZHU(:,:,:),PR(:,:,:,:),KITERMAX=100)
+IF (LOCEAN) THEN
+ !no interpolation for salinity
+ PR(:,:,:,1)=PR_MX(:,:,:,1)
+ELSE
+ !20131113 add update_halo here
+ !CALL MPPDB_CHECK3D(ZP,"ver_int_thermo6a::ZP",PRECISION)
+ CALL ADD3DFIELD_ll( TZFIELDS_ll, ZP, 'VER_INT_THERMO::ZP' )
+ CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
+ CALL CLEANLIST_ll(TZFIELDS_ll)
+ !20131112 check3d
+ CALL MPPDB_CHECK3D(ZP,"ver_int_thermo6b::ZP",PRECISION)
+!
+ PR(:,:,:,1)=SM_PMR_HU(ZP(:,:,:), &
+ PTHV(:,:,:)*(ZP(:,:,:)/XP00)**(XRD/XCPD), &
+ ZHU(:,:,:),PR(:,:,:,:),KITERMAX=100)
+END IF
CALL ADD3DFIELD_ll( TZFIELDS_ll, PR(:,:,:,1), 'VER_INT_THERMO::PR(:,:,:,1)' )
CALL UPDATE_HALO_ll(TZFIELDS_ll,IINFO_ll)
CALL CLEANLIST_ll(TZFIELDS_ll)
diff --git a/src/MNH/ver_prep_gribex_case.f90 b/src/MNH/ver_prep_gribex_case.f90
index 1c6ea2b2af6033a4dc355ca8f44fb22be3ae1cb5..8a6cc54bb401f84f1c5e5cbeafff1bb41cb6e2e9 100644
--- a/src/MNH/ver_prep_gribex_case.f90
+++ b/src/MNH/ver_prep_gribex_case.f90
@@ -85,6 +85,8 @@ END MODULE MODI_VER_PREP_GRIBEX_CASE
!! May 2006 Remove EPS
!! Apr, 09 2018 (J.-P. Chaboureau) add isobaric surface
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+!! Sep, 02, 2020 (Q. Rodier) use of geopotential height instead of
+!! height above orography for isobaric surface interpolation
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -271,8 +273,9 @@ IF (HFILE(1:3)=='ATM') THEN
ZU_LS,ZV_LS, &
ZW_LS,'FLUX' )
ELSE ! isobaric surfaces (w at mass points)
+ !Warning, in that case (NCEP only for now) ZZFLUX_LS is not correct (but not used)
CALL VER_INTERP_TO_MIXED_GRID('ATM ',.TRUE.,XZS_LS,XZSMT_LS, &
- ZZMASS_LS,ZSV_LS, &
+ XGH_LS,ZSV_LS, &
ZZFLUX_LS,XPS_LS,ZPMHP_LS, &
ZTHV_LS,ZR_LS, &
ZHU_LS, &
diff --git a/src/MNH/ver_thermo.f90 b/src/MNH/ver_thermo.f90
index 8da4d84de6d7035719490d242b73f17ffb41efed..d926e6c26166d796723e9c9050aad7b41e79ae0a 100644
--- a/src/MNH/ver_thermo.f90
+++ b/src/MNH/ver_thermo.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -159,6 +159,7 @@ USE MODD_CONF
USE MODD_CONF_n
USE MODD_CST
USE MODD_DYN_n
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_FIELD_n, ONLY: XTHT,XRT,XPABST,XDRYMASST
USE MODD_GRID_n
USE MODD_IO, ONLY: TFILEDATA,TFILE_DUMMY
@@ -170,7 +171,6 @@ USE MODD_REF_n
!
USE MODD_DIM_n
USE MODE_EXTRAPOL
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
USE MODE_MPPDB
diff --git a/src/MNH/version.f90 b/src/MNH/version.f90
index 3648f934480672301cf04642feb3769ab61fd8af..8a7e340814d6a5fc2b25c3bc61afc8b5f477c999 100644
--- a/src/MNH/version.f90
+++ b/src/MNH/version.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2002-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2002-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -43,10 +43,10 @@ USE MODD_CONF, ONLY : NMNHVERSION,NMASDEV,NBUGFIX,CBIBUSER
IMPLICIT NONE
!
NMNHVERSION(1)=5
-NMNHVERSION(2)=4
-NMNHVERSION(3)=3
-NMASDEV=54
-NBUGFIX=3
+NMNHVERSION(2)=5
+NMNHVERSION(3)=0
+NMASDEV=55
+NBUGFIX=0
CBIBUSER=''
!
END SUBROUTINE VERSION
diff --git a/src/MNH/viscosity.f90 b/src/MNH/viscosity.f90
index d02759b83919be70fb614b6fe82bae858675325e..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.
@@ -91,21 +91,29 @@ SUBROUTINE VISCOSITY(HLBCX, HLBCY, KRR, KSV, PNU, PPRANDTL, &
!! 01/18 (C.Lac) Add budgets
! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
! P. Wautelet 08/11/2019: corrected wrong budget name VISC_BU_RU -> VISC_BU_RTH
+! P. Wautelet 02/2020: use the new data structures and subroutines for budgets
+! T. Nagel 02/2021: add adhesion condition in case of an IBM-obstacle at the domain top boundary
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
- USE MODI_LAP_M
- USE MODI_SHUMAN
- USE MODD_PARAMETERS
+ USE MODD_ARGSLIST_ll, ONLY: LIST_ll
+ use modd_budget, only: lbudget_u, lbudget_v, lbudget_w, lbudget_th, lbudget_rv, lbudget_rc, &
+ lbudget_rr, lbudget_ri, lbudget_rs, lbudget_rg, lbudget_rh, lbudget_sv, &
+ NBUDGET_U, NBUDGET_V, NBUDGET_W, NBUDGET_TH, NBUDGET_RV, NBUDGET_RC, &
+ NBUDGET_RR, NBUDGET_RI, NBUDGET_RS, NBUDGET_RG, NBUDGET_RH, NBUDGET_SV1, &
+ tbudgets
USE MODD_CONF
- USE MODD_VISCOSITY
USE MODD_DRAG_n
- USE MODD_BUDGET
+ USE MODD_PARAMETERS
+ USE MODD_VISCOSITY
+
+ use mode_budget, only: Budget_store_init, Budget_store_end
USE MODE_ll
- USE MODD_ARGSLIST_ll, ONLY : LIST_ll
- USE MODI_BUDGET
+
+ USE MODI_SHUMAN
+ USE MODI_LAP_M
!
!-------------------------------------------------------------------------------
!
@@ -180,6 +188,23 @@ IIU=SIZE(PWT,1)
IJU=SIZE(PWT,2)
IKU=SIZE(PWT,3)
+if ( lbudget_u .and. ovisc_uvw ) call Budget_store_init( tbudgets(NBUDGET_U ), 'VISC', prus (:, :, :) )
+if ( lbudget_v .and. ovisc_uvw ) call Budget_store_init( tbudgets(NBUDGET_V ), 'VISC', prvs (:, :, :) )
+if ( lbudget_w .and. ovisc_uvw ) call Budget_store_init( tbudgets(NBUDGET_W ), 'VISC', prws (:, :, :) )
+if ( lbudget_th .and. ovisc_th ) call Budget_store_init( tbudgets(NBUDGET_TH), 'VISC', prths(:, :, :) )
+if ( lbudget_rv .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RV), 'VISC', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RC), 'VISC', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RR), 'VISC', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RI), 'VISC', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RS), 'VISC', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RG), 'VISC', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. ovisc_r ) call Budget_store_init( tbudgets(NBUDGET_RH), 'VISC', prrs (:, :, :, 7) )
+if ( lbudget_sv .and. ovisc_sv ) then
+ do ik = 1, ksv
+ call Budget_store_init( tbudgets(NBUDGET_SV1 - 1 + ik), 'VISC', prsvs(:, :, :, ik) )
+ end do
+end if
+
!* 1. Viscous forcing for potential temperature
! -----------------------------------------
!
@@ -193,8 +218,6 @@ IF (OVISC_TH) THEN
!
END IF
!
-IF (LBUDGET_TH) CALL BUDGET (PRTHS,4,'VISC_BU_RTH')
-!
!-------------------------------------------------------------------------------
!
!* 2. Viscous forcing for moisture
@@ -211,14 +234,6 @@ IF (OVISC_R .AND. (SIZE(PRT,1) > 0)) THEN
!
END IF
!
-IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'VISC_BU_RRV')
-IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'VISC_BU_RRC')
-IF (LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8,'VISC_BU_RRR')
-IF (LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'VISC_BU_RRI')
-IF (LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'VISC_BU_RRS')
-IF (LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'VISC_BU_RRG')
-IF (LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'VISC_BU_RRH')
-!
!-------------------------------------------------------------------------------
!
!* 3. Viscous forcing for passive scalars
@@ -234,13 +249,6 @@ IF (OVISC_SV .AND. (SIZE(PSVT,1) > 0)) THEN
!
END IF
!
-IF (LBUDGET_SV) THEN
- DO IK = 1, KSV
- CALL BUDGET (PRSVS(:,:,:,IK), 12+IK, 'VISC_BU_RSV')
- END DO
-END IF
-!
-
!-------------------------------------------------------------------------------
!
!* 4. Viscous forcing for momentum
@@ -254,6 +262,8 @@ IF (OVISC_UVW) THEN
ZY1 = MXF(PUT)
IF (ODRAG) THEN
ZY1(:,:,1) = PDRAG * ZY1(:,:,2)
+!!Add adhesion condition in case of an IBM-obstacle at the domain top boundary
+! ZY1(:,:,IKU) = PDRAG * ZY1(:,:,IKE)
ENDIF
!
!
@@ -333,9 +343,22 @@ ENDIF
ENDIF
ENDIF
END IF
-!
-IF (LBUDGET_U) CALL BUDGET (PRUS,1,'VISC_BU_RU')
-IF (LBUDGET_V) CALL BUDGET (PRVS,2,'VISC_BU_RV')
-IF (LBUDGET_W) CALL BUDGET (PRWS,2,'VISC_BU_RW')
-!
+
+if ( lbudget_u .and. ovisc_uvw ) call Budget_store_end( tbudgets(NBUDGET_U ), 'VISC', prus (:, :, :) )
+if ( lbudget_v .and. ovisc_uvw ) call Budget_store_end( tbudgets(NBUDGET_V ), 'VISC', prvs (:, :, :) )
+if ( lbudget_w .and. ovisc_uvw ) call Budget_store_end( tbudgets(NBUDGET_W ), 'VISC', prws (:, :, :) )
+if ( lbudget_th .and. ovisc_th ) call Budget_store_end( tbudgets(NBUDGET_TH), 'VISC', prths(:, :, :) )
+if ( lbudget_rv .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RV), 'VISC', prrs (:, :, :, 1) )
+if ( lbudget_rc .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RC), 'VISC', prrs (:, :, :, 2) )
+if ( lbudget_rr .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RR), 'VISC', prrs (:, :, :, 3) )
+if ( lbudget_ri .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RI), 'VISC', prrs (:, :, :, 4) )
+if ( lbudget_rs .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RS), 'VISC', prrs (:, :, :, 5) )
+if ( lbudget_rg .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RG), 'VISC', prrs (:, :, :, 6) )
+if ( lbudget_rh .and. ovisc_r ) call Budget_store_end( tbudgets(NBUDGET_RH), 'VISC', prrs (:, :, :, 7) )
+if ( lbudget_sv .and. ovisc_sv ) then
+ do ik = 1, ksv
+ call Budget_store_end( tbudgets(NBUDGET_SV1 - 1 + ik), 'VISC', prsvs(:, :, :, ik) )
+ end do
+end if
+
END SUBROUTINE VISCOSITY
diff --git a/src/MNH/wguess.f90 b/src/MNH/wguess.f90
deleted file mode 100644
index d6324d60702c9724022327ca7d0efc5550ddf6a6..0000000000000000000000000000000000000000
--- a/src/MNH/wguess.f90
+++ /dev/null
@@ -1,169 +0,0 @@
-!MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! ##################
- MODULE MODI_WGUESS
-! ##################
-INTERFACE
- SUBROUTINE WGUESS(PRHODJU,PRHODJV,PZZ,PDXX,PDYY,PDZZ,PDZX,PDZY,PRHODJW)
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJU ! rhodJU on the MESO-NH grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJV ! rhodJV on the MESO-NH grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of w points
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHODJW ! rhodJw on the MESO-NH grid
-!
-END SUBROUTINE WGUESS
-END INTERFACE
-END MODULE MODI_WGUESS
-!
-! #######################################################################
- SUBROUTINE WGUESS(PRHODJU,PRHODJV,PZZ,PDXX,PDYY,PDZZ,PDZX,PDZY,PRHODJW)
-! #######################################################################
-!
-!!**** *WGUESS* - compute the first guess of w
-!!
-!! PURPOSE
-!! -------
-!! This routine computes a value of w in order to have a first guess of w
-!! for the anelastic correction routine. The bottom boundary condition is
-!! verified, not the top one.
-!!
-!!** METHOD
-!! ------
-!!
-!! 1 the vertical contravariant component Wc of the momentum is computed
-!! from the uncompressible form of the continuity equation:
-!! _ _ _
-!! d(rhodJ Uc)/dx + d(rhodJ Vc)/dy + d(rhodJ Wc)/dz = 0.
-!! with Wc=0 at ground level
-!!
-!! 2 the final value of w ( vertical catesian component) is deduced from:
-!!
-!! Wc=1/dzz * (w-Udzx/dxx-Vdzy/dyy)
-!!
-!! CAUTION: the values of rhoJw at JI=IJU-1, JJ=IJU-1,JK=IKU-1 or JK=IKB
-!! are duplicated on the points JI=IJU, JJ=IJU JK=IKU and JK=IKB-1 to JK=1
-!! respectively.
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! DXF,DYF,MXF,MYF,MZM : Shuman operators
-!! Module MODI_SHUMAN : interface for Shuman operators
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_CONF : contains configuration variables for all models.
-!! NVERB : verbosity level for output-listing
-!! Module MODD_PARAMETERS
-!! JPVEXT
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/12/94
-!! 15/05/96 spread the residual divergence on the whole domain
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODI_SHUMAN ! interface module
-USE MODD_CONF ! declaration modules
-USE MODD_PARAMETERS
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJU ! rhodJU on the MESO-NH grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJV ! rhodJV on the MESO-NH grid
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! height of w points
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDXX ! metric coefficient dxx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDYY ! metric coefficient dyy
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZZ ! metric coefficient dzz
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZX ! metric coefficient dzx
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PDZY ! metric coefficient dzy
-REAL, DIMENSION(:,:,:), INTENT(OUT) :: PRHODJW ! rhodJw on the MESO-NH grid
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-INTEGER :: IIU,IJU
-INTEGER :: IKB,IKU
-INTEGER :: JK
-REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2),SIZE(PDZZ,3)) :: & !
- ZRHODJWC ! rhoJ Wc
-REAL, DIMENSION(SIZE(PDZZ,1),SIZE(PDZZ,2)) :: ZLAMBDA
- ! characteristic length for the weight function
-!-------------------------------------------------------------------------------
-!
-IIU=SIZE(PDZZ,1)
-IJU=SIZE(PDZZ,2)
-IKB=JPVEXT+1
-IKU=SIZE(PDZZ,3)
-!
-!* 1. INTEGRATION OF THE CONTRAVARIANT W
-! ----------------------------------
-!
-ZRHODJWC(:,:,IKB)=0.
-DO JK=IKB,IKU-1
- ZRHODJWC(:,:,JK+1:JK+1)=ZRHODJWC(:,:,JK:JK) &
- -DXF(PRHODJU(:,:,JK:JK)/PDXX(:,:,JK:JK)) &
- -DYF(PRHODJV(:,:,JK:JK)/PDYY(:,:,JK:JK))
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. COMPUTATION OF rhoJw
-! --------------------
-!
-!* 2.1 General case
-! ------------
-!
-PRHODJW= PDZZ*ZRHODJWC + MXF(PDZX*MZM(PRHODJU/PDXX)) &
- + MYF(PDZY*MZM(PRHODJV/PDYY))
-!
-!* 2.2 Copies on boundaries
-! --------------------
-!
-PRHODJW( 1 , : ,:)=PRHODJW( 2 , : ,:)
-PRHODJW(IIU, : ,:)=PRHODJW(IIU-1, : ,:)
-PRHODJW( : , 1 ,:)=PRHODJW( : , 2 ,:)
-PRHODJW( : ,IJU,:)=PRHODJW( : ,IJU-1,:)
-!
-!* 2.3 Apply a weight function
-! -----------------------
-ZLAMBDA(:,:)= (PZZ(:,:,IKU)-PZZ(:,:,IKB)) / 10
-DO JK=IKB,IKU
- PRHODJW(:,:,JK) = PRHODJW(:,:,JK) * &
- ( 1. - EXP( (PZZ(:,:,JK)-PZZ(:,:,IKU)) / ZLAMBDA(:,:) ) )
-END DO
-!
-DO JK=1,IKB-1
- PRHODJW(:,:,JK)=PRHODJW(:,:,IKB)
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!
-END SUBROUTINE WGUESS
diff --git a/src/MNH/write_aircraft_balloon.f90 b/src/MNH/write_aircraft_balloon.f90
index 3e4e7370ef4ba9607708e8888524e41d59e5243f..e132daa83eac80abbaaf8df6e561a57598729e15 100644
--- a/src/MNH/write_aircraft_balloon.f90
+++ b/src/MNH/write_aircraft_balloon.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2000-2019 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.
@@ -62,10 +62,16 @@ END MODULE MODI_WRITE_AIRCRAFT_BALLOON
!! aircraft, ballon and profiler
!! Oct 2016 : G.Delautier LIMA
!! August 2016 (M.Leriche) Add mass concentration of aerosol species
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! P. Wautelet 29/01/2019: bug: moved an instruction later (to prevent access to a not allocated array)
-!!
-!! --------------------------------------------------------------------------
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 29/01/2019: bug: moved an instruction later (to prevent access to a not allocated array)
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 02/10/2020: bugfix: YGROUP/YGROUPZ were too small
+! P. Wautelet 09/10/2020: bugfix: correction on IPROCZ when not LIMA (condition was wrong)
+! 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: budgets: remove ptrajx/y/z optional dummy arguments of Write_diachro
+! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
@@ -99,8 +105,8 @@ USE MODD_PARAM_LIMA , ONLY: NINDICE_CCN_IMM,NMOD_CCN,NMOD_IFN,NMOD_IMM
USE MODE_MODELN_HANDLER
USE MODE_DUST_PSD
USE MODE_AERO_PSD
-!
-USE MODI_WRITE_DIACHRO
+use mode_msg
+use mode_write_diachro, only: Write_diachro
!
IMPLICIT NONE
!
@@ -169,15 +175,18 @@ CONTAINS
!----------------------------------------------------------------------------
!
SUBROUTINE FLYER_DIACHRO(TPFLYER)
-!
+
+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
!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTRAJT ! localization of the
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJX ! temporal series
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJY ! in t,x,y and z.
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTRAJZ !
REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZWORK6 ! contains temporal serie
REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZW6 ! contains temporal serie to write
REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZWORKZ6! contains temporal serie
@@ -187,7 +196,7 @@ REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZPTOTA
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
!
INTEGER, DIMENSION(:), ALLOCATABLE :: IGRID ! grid indicator
-CHARACTER(LEN= 8) :: YGROUP ! group title
+CHARACTER(LEN=:), ALLOCATABLE :: YGROUP ! group title
CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YCOMMENT ! comment string
CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YTITLE ! title
CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YUNIT ! physical unit
@@ -195,7 +204,7 @@ CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YUNIT ! physical unit
INTEGER :: IPROC ! number of variables records
INTEGER :: JPROC ! loop counter
INTEGER, DIMENSION(:), ALLOCATABLE :: IGRIDZ ! grid indicator
-CHARACTER(LEN= 8) :: YGROUPZ ! group title
+CHARACTER(LEN=:), ALLOCATABLE :: YGROUPZ ! group title
CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YCOMMENTZ! comment string
CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YTITLEZ ! title
CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YUNITZ ! physical unit
@@ -206,8 +215,9 @@ INTEGER :: JSV ! loop counter
INTEGER :: JPT ! loop counter
INTEGER :: IKU, IK
CHARACTER(LEN=2) :: INDICE
-INTEGER :: I
INTEGER :: JLOOP
+type(tbudiachrometadata) :: tzbudiachro
+type(tfield_metadata_base), dimension(:), allocatable :: tzfields
!
!----------------------------------------------------------------------------
!
@@ -225,39 +235,28 @@ IPROCZ = SIZE(TPFLYER%RTZ,2)+ SIZE(TPFLYER%RZ,2)+ SIZE(TPFLYER%RZ,3)+ SIZE(TPFL
SIZE(TPFLYER%IWCZ,2)+ SIZE(TPFLYER%LWCZ,2) + SIZE(TPFLYER%CIZ,2) + &
SIZE(TPFLYER%ZZ,2)
-IF (NSV_LIMA_BEG/=NSV_LIMA_END) IPROCZ= IPROCZ+ SIZE(TPFLYER%CCZ,2) + SIZE(TPFLYER%CRZ,2)
+IF (NSV_LIMA_BEG<=NSV_LIMA_END) IPROCZ= IPROCZ+ SIZE(TPFLYER%CCZ,2) + SIZE(TPFLYER%CRZ,2)
IF (SIZE(TPFLYER%TKE )>0) IPROC = IPROC + 1
IF (LDIAG_IN_RUN) IPROC = IPROC + 1
IF (LORILAM) IPROC = IPROC + JPMODE*3
IF (LDUST) IPROC = IPROC + NMODE_DST*3
IF (SIZE(TPFLYER%TSRAD)>0) IPROC = IPROC + 1
!
-ALLOCATE (ZTRAJT( SIZE(TPFLYER%TIME),1))
-ALLOCATE (ZTRAJX(1,SIZE(TPFLYER%TIME),1))
-ALLOCATE (ZTRAJY(1,SIZE(TPFLYER%TIME),1))
-ALLOCATE (ZTRAJZ(1,SIZE(TPFLYER%TIME),1))
-ALLOCATE (ZWORK6(1,1,1,SIZE(TPFLYER%TIME),1,IPROC))
+ALLOCATE (ZWORK6(1,1,1,size(tpflyer%tpdates),1,IPROC))
ALLOCATE (YCOMMENT(IPROC))
ALLOCATE (YTITLE (IPROC))
ALLOCATE (YUNIT (IPROC))
ALLOCATE (IGRID (IPROC))
-ALLOCATE (ZWORKZ6(1,1,IKU,SIZE(TPFLYER%TIME),1,IPROCZ))
+ALLOCATE (ZWORKZ6(1,1,IKU,size(tpflyer%tpdates),1,IPROCZ))
ALLOCATE (YCOMMENTZ(IPROCZ))
ALLOCATE (YTITLEZ (IPROCZ))
ALLOCATE (YUNITZ (IPROCZ))
ALLOCATE (IGRIDZ (IPROCZ))
-
-!
-ZTRAJT (:,1) = TPFLYER%TIME
-ZTRAJX(1,:,1) = TPFLYER%X
-ZTRAJY(1,:,1) = TPFLYER%Y
-ZTRAJZ(1,:,1) = TPFLYER%Z
-!
!
IGRID = 1
YGROUP = TPFLYER%TITLE
IGRIDZ = 1
-YGROUPZ = TRIM(TPFLYER%TITLE)//"Z"
+YGROUPZ = TPFLYER%TITLE
!
!----------------------------------------------------------------------------
JPROC = 0
@@ -348,7 +347,7 @@ END DO
!
!add cloud liquid water content in g/m3 to compare to measurements from FSSP
!IF (.NOT.(ANY(TPFLYER%P(:) == 0.))) THEN
-ALLOCATE (ZRHO(1,1,SIZE(TPFLYER%TIME)))
+ALLOCATE (ZRHO(1,1,size(tpflyer%tpdates)))
IF (SIZE(TPFLYER%R,2) >1) THEN !cloud water is present
ZRHO(1,1,:) = 0.
DO JRR=1,SIZE(TPFLYER%R,2)
@@ -356,7 +355,7 @@ IF (SIZE(TPFLYER%R,2) >1) THEN !cloud water is present
ENDDO
ZRHO(1,1,:) = TPFLYER%TH(:) * ( 1. + XRV/XRD*TPFLYER%R(:,1) ) &
/ ( 1. + ZRHO(1,1,:) )
- DO JPT=1,SIZE(TPFLYER%TIME)
+ DO JPT=1,size(tpflyer%tpdates)
IF (TPFLYER%P(JPT) == 0.) THEN
ZRHO(1,1,JPT) = 0.
ELSE
@@ -395,7 +394,7 @@ ZWORK6 (1,1,1,:,1,JPROC) = TPFLYER%RCW_FLUX(:)
!
DO JSV=1,SIZE(TPFLYER%SVW_FLUX,2)
JPROC = JPROC + 1
- YTITLE (JPROC) = 'SV_FLUX'
+ WRITE ( YTITLE(JPROC), FMT = '( A7, I3.3 )' ) 'SV_FLUX', JSV
YUNIT (JPROC) = 'SVUNIT m s-1'
YCOMMENT (JPROC) = 'scalar flux'
ZWORK6 (1,1,1,:,1,JPROC) = TPFLYER%SVW_FLUX(:,JSV)
@@ -461,13 +460,12 @@ IF (SIZE(TPFLYER%SV,2)>=1) THEN
WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_NUCL + 1)
YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(3))//INDICE//'T'
ENDIF
- I = 0
IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN
- I = I + 1
- WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(I))
+ WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(JSV - NSV_LIMA_IMM_NUCL + 1))
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
@@ -504,12 +502,12 @@ IF (SIZE(TPFLYER%SV,2)>=1) THEN
END DO
IF ((LORILAM).AND. .NOT.(ANY(TPFLYER%P(:) == 0.))) THEN
- ALLOCATE (ZSV(1,1,SIZE(TPFLYER%TIME),NSV_AER))
- ALLOCATE (ZRHO(1,1,SIZE(TPFLYER%TIME)))
- ALLOCATE (ZN0(1,1,SIZE(TPFLYER%TIME),JPMODE))
- ALLOCATE (ZRG(1,1,SIZE(TPFLYER%TIME),JPMODE))
- ALLOCATE (ZSIG(1,1,SIZE(TPFLYER%TIME),JPMODE))
- ALLOCATE (ZPTOTA(1,1,SIZE(TPFLYER%TIME),NSP+NCARB+NSOA,JPMODE))
+ ALLOCATE (ZSV(1,1,size(tpflyer%tpdates),NSV_AER))
+ ALLOCATE (ZRHO(1,1,size(tpflyer%tpdates)))
+ ALLOCATE (ZN0(1,1,size(tpflyer%tpdates),JPMODE))
+ ALLOCATE (ZRG(1,1,size(tpflyer%tpdates),JPMODE))
+ ALLOCATE (ZSIG(1,1,size(tpflyer%tpdates),JPMODE))
+ ALLOCATE (ZPTOTA(1,1,size(tpflyer%tpdates),NSP+NCARB+NSOA,JPMODE))
ZSV(1,1,:,1:NSV_AER) = TPFLYER%SV(:,NSV_AERBEG:NSV_AEREND)
IF (SIZE(TPFLYER%R,2) >0) THEN
ZRHO(1,1,:) = 0.
@@ -527,7 +525,7 @@ IF (SIZE(TPFLYER%SV,2)>=1) THEN
ZRG = 0.
ZN0 = 0.
ZPTOTA = 0.
- DO JPT=1,SIZE(TPFLYER%TIME) ! prevent division by zero if ZSV = 0.
+ DO JPT=1,size(tpflyer%tpdates) ! prevent division by zero if ZSV = 0.
IF (ALL(ZSV(1,1,JPT,:)/=0.)) THEN
CALL PPP2AERO(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0, PCTOTA=ZPTOTA)
ENDIF
@@ -669,11 +667,11 @@ IF (SIZE(TPFLYER%SV,2)>=1) THEN
ZWORK6 (1,1,1,:,1,JPROC) = TPFLYER%SV(:,JSV) * 1.E9
END DO
IF ((LDUST).AND. .NOT.(ANY(TPFLYER%P(:) == 0.))) THEN
- ALLOCATE (ZSV(1,1,SIZE(TPFLYER%TIME),NSV_DST))
- ALLOCATE (ZRHO(1,1,SIZE(TPFLYER%TIME)))
- ALLOCATE (ZN0(1,1,SIZE(TPFLYER%TIME),NMODE_DST))
- ALLOCATE (ZRG(1,1,SIZE(TPFLYER%TIME),NMODE_DST))
- ALLOCATE (ZSIG(1,1,SIZE(TPFLYER%TIME),NMODE_DST))
+ ALLOCATE (ZSV(1,1,size(tpflyer%tpdates),NSV_DST))
+ ALLOCATE (ZRHO(1,1,size(tpflyer%tpdates)))
+ ALLOCATE (ZN0(1,1,size(tpflyer%tpdates),NMODE_DST))
+ ALLOCATE (ZRG(1,1,size(tpflyer%tpdates),NMODE_DST))
+ ALLOCATE (ZSIG(1,1,size(tpflyer%tpdates),NMODE_DST))
ZSV(1,1,:,1:NSV_DST) = TPFLYER%SV(:,NSV_DSTBEG:NSV_DSTEND)
IF (SIZE(TPFLYER%R,2) >0) THEN
ZRHO(1,1,:) = 0.
@@ -834,32 +832,158 @@ DO IK=1, IKU
END DO
!----------------------------------------------------------------------------
!
-ALLOCATE (ZW6(1,1,1,SIZE(TPFLYER%TIME),1,JPROC))
+ALLOCATE (ZW6(1,1,1,size(tpflyer%tpdates),1,JPROC))
ZW6 = ZWORK6(:,:,:,:,:,:JPROC)
DEALLOCATE(ZWORK6)
-ALLOCATE (ZWZ6(1,1,IKU,SIZE(TPFLYER%TIME),1,JPROCZ))
+ALLOCATE (ZWZ6(1,1,IKU,size(tpflyer%tpdates),1,JPROCZ))
ZWZ6 = ZWORKZ6(:,:,:,:,:,:JPROCZ)
DEALLOCATE(ZWORKZ6)
!
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"RSPL",IGRID, TPFLYER%DATIME, ZW6, &
- ZTRAJT,YTITLE,YUNIT,YCOMMENT, &
- PTRAJX=ZTRAJX, PTRAJY=ZTRAJY, PTRAJZ=ZTRAJZ )
-!
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUPZ,"CART",IGRIDZ, TPFLYER%DATIME, &
- ZWZ6,ZTRAJT,YTITLEZ,YUNITZ,YCOMMENTZ, &
- .TRUE.,.TRUE.,.FALSE., &
- KIL=1,KIH=1,KJL=1,KJH=1,KKL=1,KKH=IKU )
+allocate( tzfields( jproc ) )
+
+tzfields(:)%cmnhname = ytitle(1 : jproc)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = ytitle(1 : jproc)
+tzfields(:)%cunits = yunit(1 : jproc)
+tzfields(:)%ccomment = ycomment(1 : jproc)
+tzfields(:)%ngrid = 0
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 2
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(3) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(4) = NMNHDIM_FLYER_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_FLYER_PROC
+
+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) = '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
+! 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)
+! tzbudiachro%njh = NOT SET (default values)
+! tzbudiachro%nkl = NOT SET (default values)
+! tzbudiachro%nkh = NOT SET (default values)
+
+call Write_diachro( tpdiafile, tzbudiachro, tzfields, tpflyer%tpdates, zw6, &
+ tpflyer = tpflyer )
+
+deallocate( tzfields )
+
+allocate( tzfields( jprocz ) )
+
+tzfields(:)%cmnhname = ytitlez(1 : jprocz)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = ytitlez(1 : jprocz)
+tzfields(:)%cunits = yunitz(1 : jprocz)
+tzfields(:)%ccomment = ycommentz(1 : jprocz)
+tzfields(:)%ngrid = 0
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 3
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(3) = NMNHDIM_LEVEL
+tzfields(:)%ndimlist(4) = NMNHDIM_FLYER_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_FLYER_PROC
+
+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
+
+call Write_diachro( tpdiafile, tzbudiachro, tzfields, tpflyer%tpdates, zwz6, &
+ tpflyer = tpflyer )
+
+deallocate( tzfields )
-DEALLOCATE (ZTRAJT)
-DEALLOCATE (ZTRAJX)
-DEALLOCATE (ZTRAJY)
-DEALLOCATE (ZTRAJZ)
-DEALLOCATE (ZW6)
+DEALLOCATE (ZW6)
DEALLOCATE (YCOMMENT)
DEALLOCATE (YTITLE )
DEALLOCATE (YUNIT )
DEALLOCATE (IGRID )
-DEALLOCATE (ZWZ6)
+DEALLOCATE (ZWZ6)
DEALLOCATE (YCOMMENTZ)
DEALLOCATE (YTITLEZ )
DEALLOCATE (YUNITZ )
diff --git a/src/MNH/write_balloonn.f90 b/src/MNH/write_balloonn.f90
index c1d82c1b2378f84d968575a363c334a81ee306a0..f0c790ddd868d44f382b961b742bc4f6528b545e 100644
--- a/src/MNH/write_balloonn.f90
+++ b/src/MNH/write_balloonn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2001-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2001-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -96,7 +96,7 @@ CONTAINS
!-------------------------------------------------------------------------------
SUBROUTINE WRITE_LFI_BALLOON(TPFLYER)
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
+use modd_field, only: tfielddata, TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
TYPE(FLYER), INTENT(IN) :: TPFLYER
diff --git a/src/MNH/write_budget.f90 b/src/MNH/write_budget.f90
index e24f6a3009250f1f268fe012cc47cad643d5603a..767541ad935a58606ffd9de97aaddc47c1fe836c 100644
--- a/src/MNH/write_budget.f90
+++ b/src/MNH/write_budget.f90
@@ -1,40 +1,60 @@
-!MNH_LIC Copyright 1995-2019 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.
!-----------------------------------------------------------------
-!########################
- MODULE MODI_WRITE_BUDGET
-!########################
-!
-INTERFACE
-!
- SUBROUTINE WRITE_BUDGET(TPDIAFILE,TPDTCUR, &
- TPDTMOD,PTSTEP, KSV)
-!
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_TYPE_DATE
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
-TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
-TYPE (DATE_TIME), INTENT(IN) :: TPDTMOD ! Creation date and time
-REAL, INTENT(IN) :: PTSTEP ! time step
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-END SUBROUTINE WRITE_BUDGET
-!
-END INTERFACE
-!
-END MODULE MODI_WRITE_BUDGET
-!
-!
-!
-! ############################################
- SUBROUTINE WRITE_BUDGET(TPDIAFILE,TPDTCUR, &
- TPDTMOD,PTSTEP, KSV)
-! ############################################
+! Author:
+! J. Nicolau (Meteo-France) 27/02/1995
+! Modifications:
+! J. Stein 09/09/1996: add the writings in the diachronic file
+! J.-P. Pinty 18/12/1996: clarify the coding
+! J.-P. Pinty 18/03/1997: correction for the SVx
+! V. Gouget M. Chong J.-P. Lafore 10/02/1998: add the BURHODJ, TSTEP and BULEN and writes in physical units
+! V. Ducrocq 07/06/1999: //
+! N. Asencio 18/06/1999: // budget with MASK case
+! delete ZTORE arrays no longer used, so delete
+! KIU,KJU,KKU arguments
+! the mask is written once with a FMWRIT call outside
+! write_diachro: its name is MASK_(value of NBUTSHIFT).MASK
+! MENU_DIACHRO must be called after FMWRIT to be read in
+! read_diachro.
+! NBUTSHIFT is incremented at the beginning of the routine
+! The dimensions of the XBUR.. arrays are : first one
+! is the dimension along K, second one is the time, the
+! third one is the number of the masks.
+! G. Tanguy 10/2009: add ILENCH=LEN(YCOMMENT) after change of YCOMMENT
+! J. Escobar 24/03/2014: misplaced deallocate in RSV budget
+! C. Lac 11/09/2015: orrection due to FIT temporal scheme
+! P. Wautelet 28/03/2018: Replace TEMPORAL_DIST by DATETIME_DISTANCE
+! 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
+! P. Wautelet 14/10/2019: complete restructuration and deduplication of code
+! P. Wautelet 10/03/2020: use the new data structures and subroutines for budgets
+! P. Wautelet 09/10/2020: Write_diachro: use new datatype tpfields
+! P. Wautelet 08/12/2020: budgets: merge budgets terms with different nbutshift
+!-----------------------------------------------------------------
+
+!#######################
+module mode_write_budget
+!#######################
+
+use mode_msg
+
+implicit none
+
+private
+
+public :: Write_budget
+
+character(len=*), parameter :: CMASK_VARNAME = 'MASKS'
+
+contains
+
+!#########################################################
+subroutine Write_budget( tpdiafile, tpdtcur, ptstep, ksv )
+!#########################################################
!
-!!**** *WRITE_BUDGET* - routine to write a LFIFM file for the budget.
+!!**** *WRITE_BUDGET* - routine to write a budget file
!!
!!
!! PURPOSE
@@ -58,8 +78,8 @@ END MODULE MODI_WRITE_BUDGET
!! IGRID = 3 for V grid point
!! IGRID = 4 for w grid point
!! IGRID = 0 for meaningless case
-!!
-!!
+!!
+!!
!!
!! EXTERNAL
!! --------
@@ -68,1496 +88,770 @@ END MODULE MODI_WRITE_BUDGET
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_BUDGET
-!!
-!! CBUTYPE : Budget type (CART,MASK,SKIP or NONE)
-!! CBURECORD : name of output recording files for the budgets
-!! CBUCOMMENT : name of a process for a budget
-!! NBUPROCNBR : number of processes for each variable
-!! NBUTIME : number of the budget time intervals ('MASK' case)
-!! NBUWRNB : number of budget steps when the budget is written
-!! XBURU : budget array of the variable RU
-!! XBURV : budget array of the variable RV
-!! XBURW : budget array of the variable RW
-!! XBURTH : budget array of the variable RTH
-!! XBURTKE : budget array of the variable RTKE
-!! XBURRV : budget array of the variable RRV
-!! XBURRC : budget array of the variable RRC
-!! XBURRR : budget array of the variable RRR
-!! XBURRI : budget array of the variable RRI
-!! XBURRS : budget array of the variable RRS
-!! XBURRG : budget array of the variable RRG
-!! XBURRH : budget array of the variable RRH
-!! XBURSV : budget array of the variable RSVx
-!!
+!!
!!
!! REFERENCE
!! ---------
!! Book2 of MESO-NH documentation (routine WRITE_BUDGET)
!!
-!!
-!! AUTHOR
-!! ------
-!! J. Nicolau * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 27/02/95
-!! J. Stein 9/9/96 add the writings in the diachronic file
-!! J.-P. Pinty 18/12/96 clarify the coding
-!! J.-P. Pinty 18/03/97 correction for the SVx
-!! V. Gouget M. Chong J.-P. Lafore add the BURHODJ, TSTEP and BULEN
-!! 10/02/98 and writes in physical units
-!! V. Ducrocq 07/06/99 //
-!! N. Asencio 18/06/99 // budget with MASK case
-!! delete ZTORE arrays no longer used, so delete
-!! KIU,KJU,KKU arguments
-!! the mask is written once with a FMWRIT call outside
-!! write_diachro: its name is MASK_(value of NBUTSHIFT).MASK
-!! MENU_DIACHRO must be called after FMWRIT to be read in
-!! read_diachro.
-!! NBUTSHIFT is incremented at the beginning of the routine
-!! The dimensions of the XBUR.. arrays are : first one
-!! is the dimension along K, second one is the time, the
-!! third one is the number of the masks.
-!! October 2009 (G. Tanguy) add ILENCH=LEN(YCOMMENT) after
-!! change of YCOMMENT
-!! 24/03/2014 (J.Escobar ) miss placed deallocate in RSV budget
-!! 11/09/2015 (C.Lac) Correction due to FIT temporal scheme
-!! 28/03/2018 (P.Wautelet) Replace TEMPORAL_DIST by DATETIME_DISTANCE
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0.
-! ------------
-USE MODD_BUDGET
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
-!
-USE MODE_DATETIME
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_TIME
-!
-USE MODI_END_CART_COMPRESS
-USE MODI_END_MASK_COMPRESS
-USE MODI_MENU_DIACHRO
-USE MODI_WRITE_DIACHRO
-!
-!
-IMPLICIT NONE
-!
-!
-!* 0.1 Declarations of arguments :
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
-TYPE (DATE_TIME), INTENT(IN) :: TPDTCUR ! Current date and time
-TYPE (DATE_TIME), INTENT(IN) :: TPDTMOD ! Creation date and time
-REAL, INTENT(IN) :: PTSTEP ! time step
-INTEGER, INTENT(IN) :: KSV ! Number of Scalar Variables
-!
-!* 0.2 Declarations of local variables :
-!
-CHARACTER(LEN=NMNHNAMELGTMAX) :: YRECFM ! Name of the article to be written
-INTEGER :: JT,JPROC,JMASK
-!
-!
-REAL, ALLOCATABLE , DIMENSION(:,:,:,:,:,:) :: ZWORK, ZWORKT, ZWORKMASK ! local array
- ! conformal to what is asked by the diachro format for the fields
- ! and for the masks
-LOGICAL :: GNOCOMPRESS ! If TRUE : no compress along x and y direction in the CART option
-REAL, ALLOCATABLE , DIMENSION(:) :: ZCONVERT ! unit conversion coefficient
-REAL, ALLOCATABLE , DIMENSION(:,:):: ZWORKTEMP ! time
-INTEGER, ALLOCATABLE , DIMENSION(:) :: IWORKGRID ! grid label
-CHARACTER (LEN=99), ALLOCATABLE , DIMENSION(:) :: YBUCOMMENT ! comment
-CHARACTER (LEN=100), ALLOCATABLE , DIMENSION(:) :: YWORKCOMMENT ! comment
-CHARACTER (LEN=100), ALLOCATABLE , DIMENSION(:) :: YWORKUNIT ! comment
-CHARACTER (LEN=9) :: YGROUP_NAME ! group name
-CHARACTER(LEN=28) :: YFILEDIA
-REAL, ALLOCATABLE , DIMENSION(:,:):: ZWORKDATIME ! global time
- ! info
-INTEGER :: JSV ! loop index
- ! over the
- ! KSV SVx
-INTEGER :: IP
-TYPE(TFIELDDATA) :: TZFIELD
-!
-!-------------------------------------------------------------------------------
-!
-YFILEDIA = TPDIAFILE%CNAME
-!
-!* 1. write TSTEP and BULEN
-! ---------------------
-!
-TZFIELD%CMNHNAME = 'TSTEP'
-TZFIELD%CSTDNAME = ''
-TZFIELD%CLONGNAME = 'TSTEP'
-TZFIELD%CUNITS = 's'
-TZFIELD%CDIR = '--'
-TZFIELD%CCOMMENT = 'Time step'
-TZFIELD%NGRID = 0
-TZFIELD%NTYPE = TYPEREAL
-TZFIELD%NDIMS = 0
-TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPDIAFILE,TZFIELD,PTSTEP)
-!
-TZFIELD%CMNHNAME = 'BULEN'
-TZFIELD%CSTDNAME = ''
-TZFIELD%CLONGNAME = 'BULEN'
-TZFIELD%CUNITS = 's'
-TZFIELD%CDIR = '--'
-TZFIELD%CCOMMENT = 'Time step'
-TZFIELD%NGRID = 0
-TZFIELD%NTYPE = TYPEREAL
-TZFIELD%NDIMS = 0
-TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPDIAFILE,TZFIELD,XBULEN)
-!
-!* 1.1 initialize NBUTSHIFT
-! ---------------------
-!
-NBUTSHIFT = NBUTSHIFT+1
-!
-!
-SELECT CASE (CBUTYPE)
-!
!-------------------------------------------------------------------------------
-!
-!* 2. 'CART' CASE
-! -----------
-!
- CASE('CART','SKIP')
- GNOCOMPRESS=(.NOT.LBU_ICP .AND. .NOT.LBU_JCP)
-!
-!* 2.1 Initialization
-!
- ALLOCATE(ZWORKTEMP(1,1))
- ALLOCATE(ZWORKDATIME(16,1))
-!
- ZWORKDATIME(1,1)=TDTEXP%TDATE%YEAR
- ZWORKDATIME(2,1)=TDTEXP%TDATE%MONTH
- ZWORKDATIME(3,1)=TDTEXP%TDATE%DAY
- ZWORKDATIME(4,1)=TDTEXP%TIME
- ZWORKDATIME(5,1)=TDTSEG%TDATE%YEAR
- ZWORKDATIME(6,1)=TDTSEG%TDATE%MONTH
- ZWORKDATIME(7,1)=TDTSEG%TDATE%DAY
- ZWORKDATIME(8,1)=TDTSEG%TIME
- ZWORKDATIME(9,1)=TPDTMOD%TDATE%YEAR
- ZWORKDATIME(10,1)=TPDTMOD%TDATE%MONTH
- ZWORKDATIME(11,1)=TPDTMOD%TDATE%DAY
- ZWORKDATIME(12,1)=TPDTMOD%TIME
-!
- CALL DATETIME_DISTANCE(TDTEXP,TPDTCUR,ZWORKTEMP(1,1))
-!
- ZWORKTEMP(1,1)=ZWORKTEMP(1,1)+(1.-NBUSTEP*0.5)*PTSTEP
-!
- ZWORKDATIME(13,1)=TDTEXP%TDATE%YEAR
- ZWORKDATIME(14,1)=TDTEXP%TDATE%MONTH
- ZWORKDATIME(15,1)=TDTEXP%TDATE%DAY
- ZWORKDATIME(16,1)=TDTEXP%TIME+ZWORKTEMP(1,1)
-!
-!* 2.2 storage of the budgets array
-!
-!* 2.2.1 RU budget
-!
- IF (LBU_RU) THEN
-! XBURHODJU and RU budgets
-!
- IP=1
-! unit conversion for RU budgets
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RU
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURU(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJU(:,:,:)
- END DO
- ELSE
- ALLOCATE(ZWORK(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,1)) ! global budget of RhodjU
- ZWORK(:,:,:,1,1,1)=END_CART_COMPRESS(XBURHODJU(:,:,:))
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RU
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURU(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
-! RU budgets storage
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 'm s-2'; YWORKUNIT(1:3) = 'm s-1'
- YWORKCOMMENT(:) = 'Budget of momentum along X axis'
- IWORKGRID(:) = 2
- WRITE(YGROUP_NAME,FMT="('UU___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(1, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
-! XBURHODJU storage
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORK(NBUIMAX,NBUJMAX,NBUKMAX,1,1,1)) ! local budget of RHODJU
- ZWORK(:,:,:,1,1,1) = XBURHODJU(:,:,:)
- END IF
- ALLOCATE(YBUCOMMENT(1))
- ALLOCATE(YWORKUNIT(1))
- ALLOCATE(YWORKCOMMENT(1))
- ALLOCATE(IWORKGRID(1))
-!
- YBUCOMMENT(1) = 'RhodJX'
- YWORKUNIT(1) = 'kg'
- YWORKCOMMENT(1) = 'RhodJ for momentum along X axis'
- IWORKGRID(1) = 2
- WRITE(YGROUP_NAME,FMT="('RJX__',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME,'CART', IWORKGRID, &
- ZWORKDATIME, ZWORK, ZWORKTEMP, YBUCOMMENT, &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORK, YBUCOMMENT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
- END IF
-!
-!* 2.2.2 RV budget
-!
- IF (LBU_RV) THEN
- ! XBURHODJV and RV budgets
-!
- IP=2
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RV
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURV(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJV(:,:,:)
- END DO
- ELSE
- ALLOCATE(ZWORK(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,1)) ! global budget of RhodjV
- ZWORK(:,:,:,1,1,1)=END_CART_COMPRESS(XBURHODJV(:,:,:))
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RV
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURV(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
-! RV budgets storage
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
- !
- YWORKUNIT(:) = 'm s-2'; YWORKUNIT(1:3) = 'm s-1'
- YWORKCOMMENT(:) = 'Budget of momentum along Y axis'
- IWORKGRID(:) = 3
- WRITE(YGROUP_NAME,FMT="('VV___',I4.4)") NBUTSHIFT
- !
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-! XBURHODJV storage
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORK(NBUIMAX,NBUJMAX,NBUKMAX,1,1,1)) ! local budget of RHODJV
- ZWORK(:,:,:,1,1,1) = XBURHODJV(:,:,:)
- END IF
- ALLOCATE(YBUCOMMENT(1))
- ALLOCATE(YWORKUNIT(1))
- ALLOCATE(YWORKCOMMENT(1))
- ALLOCATE(IWORKGRID(1))
-!
- YBUCOMMENT(1) = 'RhodJY'
- YWORKUNIT(1) = 'kg'
- YWORKCOMMENT(1) = 'RhodJ for momentum along Y axis'
- IWORKGRID(1) = 3
- WRITE(YGROUP_NAME,FMT="('RJY__',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME,'CART', IWORKGRID, &
- ZWORKDATIME, ZWORK, ZWORKTEMP, YBUCOMMENT, &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(YBUCOMMENT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
- DEALLOCATE(ZWORK)
- END IF
-!
-!
-!* 2.2.3 RW budget
-!
- IF (LBU_RW) THEN
-!
- IP=3
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RW
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURW(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJW(:,:,:)
- END DO
- ELSE
- ALLOCATE(ZWORK(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,1)) ! global budget of RhodjW
- ZWORK(:,:,:,1,1,1)=END_CART_COMPRESS(XBURHODJW(:,:,:))
- !
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RW
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURW(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
-! RW budgets storage
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 'm s-2'; YWORKUNIT(1:3) = 'm s-1'
- YWORKCOMMENT(:) = 'Budget of momentum along Z axis'
- IWORKGRID(:) = 4
- WRITE(YGROUP_NAME,FMT="('WW___',I4.4)") NBUTSHIFT
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-! XBURHODJW storage
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORK(NBUIMAX,NBUJMAX,NBUKMAX,1,1,1)) ! local budget of RHODJW
- ZWORK(:,:,:,1,1,1) = XBURHODJW(:,:,:)
- END IF
- ALLOCATE(YBUCOMMENT(1))
- ALLOCATE(YWORKUNIT(1))
- ALLOCATE(YWORKCOMMENT(1))
- ALLOCATE(IWORKGRID(1))
-!
- YBUCOMMENT(1) = 'RhodJZ'
- YWORKUNIT(1) = 'kg'
- YWORKCOMMENT(1) = 'RhodJ for momentum along Z axis'
- IWORKGRID(1) = 4
- WRITE(YGROUP_NAME,FMT="('RJZ__',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME,'CART', IWORKGRID, &
- ZWORKDATIME, ZWORK, ZWORKTEMP, YBUCOMMENT, &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(YBUCOMMENT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
- DEALLOCATE(ZWORK)
- END IF
-
-!
-!* 2.2.3' XBURHODJ storage for Scalars
-!
- 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 (GNOCOMPRESS) THEN
- ALLOCATE(ZWORK(NBUIMAX,NBUJMAX,NBUKMAX,1,1,1)) ! local budget of RHODJ
- ZWORK(:,:,:,1,1,1) = XBURHODJ(:,:,:)
- ELSE
- ALLOCATE(ZWORK(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,1)) ! global budget of RodhjW
- ZWORK(:,:,:,1,1,1)=END_CART_COMPRESS(XBURHODJ(:,:,:))
- END IF
- ALLOCATE(YBUCOMMENT(1))
- ALLOCATE(YWORKUNIT(1))
- ALLOCATE(YWORKCOMMENT(1))
- ALLOCATE(IWORKGRID(1))
-!
- YBUCOMMENT(1) = 'RhodJS'
- YWORKUNIT(1) = 'kg'
- YWORKCOMMENT(1) = 'RhodJ for Scalars variables'
- IWORKGRID(1) = 1
- WRITE(YGROUP_NAME,FMT="('RJS__',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORK, ZWORKTEMP, YBUCOMMENT, &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- IF (GNOCOMPRESS) THEN
- DEALLOCATE(ZWORK, YBUCOMMENT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
- ELSE
- DEALLOCATE(YBUCOMMENT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
- ENDIF
-!
- ENDIF
-!
-!* 2.2.4 RTH budget
-!
- IF (LBU_RTH) THEN
-! RTH budgets storage
- IP=4
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RTH
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURTH(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJ(:,:,:)
- END DO
- ELSE
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RTH
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURTH(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 'K s-1' ; YWORKUNIT(1:3) = 'K'
- YWORKCOMMENT(:) = 'Budget of potential temperature'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('TH___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
- END IF
-!
-!* 2.2.5 RTKE budget
-!
- IF (LBU_RTKE) THEN
-! RTKE budgets storage
- IP=5
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RTKE
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURTKE(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJ(:,:,:)
- END DO
- ELSE
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RTKE
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURTKE(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 'm2 s-3' ; YWORKUNIT(1:3) = 'm2 s-1'
- YWORKCOMMENT(:) = 'Budget of turbulent kinetic energy'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('TK___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
- END IF
-!
-!* 2.2.6 RRV budget
-!
- IF (LBU_RRV) THEN
-! RRV budgets storage
- IP=6
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RTKE
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURRV(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJ(:,:,:)
- END DO
- ELSE
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RTKE
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURRV(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of water vapor mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RV___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
- END IF
-!
-!* 2.2.7 RRC budget
-!
- IF (LBU_RRC) THEN
-! RRV budgets storage
- IP=7
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RRC
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURRC(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJ(:,:,:)
- END DO
- ELSE
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RRC
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURRC(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of cloud water mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RC___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
- END IF
-!
-!* 2.2.8 RRR budget
-!
- IF (LBU_RRR) THEN
- IP=8
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RRR
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURRR(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJ(:,:,:)
- END DO
- ELSE
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RRR
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURRR(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of rain water mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RR___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
- END IF
-!
-!* 2.2.9 RRI budget
-!
- IF (LBU_RRI) THEN
- IP=9
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RRI
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURRI(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJ(:,:,:)
- END DO
- ELSE
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RRI
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURRI(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of cloud ice mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RI___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
- END IF
-!
-!* 2.2.10 RRS budget
-!
- IF (LBU_RRS) THEN
- IP=10
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RRS
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURRS(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJ(:,:,:)
- END DO
- ELSE
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RRS
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURRS(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of snow/aggregate mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RS___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
- END IF
-!
-!* 2.2.11 RRG budget
-!
- IF (LBU_RRG) THEN
- IP=11
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RRG
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURRG(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJ(:,:,:)
- END DO
- ELSE
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RRG
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURRG(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of graupel mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RG___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
- END IF
-!
-!* 2.2.12 RRH budget
-!
- IF (LBU_RRH) THEN
- IP=12
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RRH
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURRH(:,:,:,JPROC) * ZCONVERT(JPROC) &
- / XBURHODJ(:,:,:)
- END DO
- ELSE
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RRH
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURRH(:,:,:,JPROC))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of hail mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RH___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
- END IF
-!
-!* 2.2.13 RSV budget
-!
- IF (LBU_RSV) THEN
- DO JSV = 1,KSV
- IP=12+JSV
- ALLOCATE(ZCONVERT(NBUPROCNBR(IP)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(IP)) = 1.
-!
- IF (GNOCOMPRESS) THEN
- ALLOCATE(ZWORKT(NBUIMAX,NBUJMAX,NBUKMAX,1,1,NBUPROCNBR(IP))) ! local budget of RRH
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = XBURSV(:,:,:,JPROC,JSV) * ZCONVERT(JPROC) &
- / XBURHODJ(:,:,:)
- END DO
- ELSE
-!
- ALLOCATE(ZWORKT(NBUIMAX_ll,NBUJMAX_ll,NBUKMAX,1,1,NBUPROCNBR(IP))) ! global budget of RRH
-!
- DO JPROC=1,NBUPROCNBR(IP)
- ZWORKT(:,:,:,1,1,JPROC) = END_CART_COMPRESS(XBURSV(:,:,:,JPROC,JSV))
- ZWORKT(:,:,:,1,1,JPROC) = ZWORKT(:,:,:,1,1,JPROC)* ZCONVERT(JPROC) &
- / ZWORK(:,:,:,1,1,1)
- END DO
- DEALLOCATE(ZWORK)
- ENDIF
- DEALLOCATE(ZCONVERT)
-!
- ALLOCATE(YWORKUNIT(NBUPROCNBR(IP)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(IP)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(IP)))
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = ' '
- DO JT = 1,NBUPROCNBR(IP)
- WRITE(YWORKCOMMENT(JT),FMT="('Budget of SVx=',I3.3)") JSV
- END DO
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('SV',I3.3,I4.4)") JSV,NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, 'CART', IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(IP, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
- END DO
- END IF
-!
- IF (ALLOCATED(ZWORK)) DEALLOCATE(ZWORK)
- DEALLOCATE (ZWORKTEMP, ZWORKDATIME)
-!-------------------------------------------------------------------------------
-!
-!* 3. 'MASK' CASE
-! -----------
-!
- CASE('MASK')
- ALLOCATE(ZWORKTEMP(NBUWRNB,1))
- ALLOCATE(ZWORKDATIME(16,NBUWRNB))
- ALLOCATE(ZWORKMASK(SIZE(XBUSURF,1),SIZE(XBUSURF,2),1,NBUWRNB,NBUMASK,1))
-!
-! local array
- DO JMASK=1,NBUMASK
- DO JT=1,NBUWRNB
- ZWORKMASK(:,:,1,JT,JMASK,1) = XBUSURF(:,:,JMASK,JT)
+ use modd_budget, only: cbutype, nbumask, nbusurf, nbutshift, nbustep, nbusubwrite, xbulen, &
+ lbu_icp, lbu_jcp, &
+ lbu_ru, lbu_rv, lbu_rw, lbu_rth, lbu_rtke, lbu_rrv, lbu_rrc, lbu_rrr, &
+ lbu_rri, lbu_rrs, lbu_rrg, lbu_rrh, lbu_rsv, &
+ NBUDGET_RHO, 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, &
+ tbudgets, tburhodj
+ use modd_field, only: NMNHDIM_ONE, NMNHDIM_NI, NMNHDIM_NJ, &
+ NMNHDIM_BUDGET_TIME, NMNHDIM_BUDGET_MASK_NBUMASK, NMNHDIM_UNUSED, &
+ tfielddata, TYPEINT, TYPEREAL
+ use modd_io, only: tfiledata
+ use modd_lunit_n, only: tluout
+ use modd_parameters, only: NMNHNAMELGTMAX
+ use modd_type_date, only: date_time
+
+ use mode_datetime, only: datetime_distance
+ use mode_io_field_write, only: IO_Field_create, IO_Field_write
+#ifdef MNH_IOLFI
+ use mode_menu_diachro, only: Menu_diachro
+#endif
+ use mode_msg
+ use mode_time, only: tdtexp
+
+ implicit none
+
+ type(tfiledata), intent(in) :: tpdiafile ! file to write
+ type(date_time), intent(in) :: tpdtcur ! current date and time
+ real, intent(in) :: ptstep ! time step
+ integer, intent(in) :: ksv ! number of scalar variables
+
+ character(len=NMNHNAMELGTMAX) :: yrecfm ! name of the article to be written
+ integer :: jt, jmask
+ integer :: jsv ! loop index over the ksv svx
+ logical :: gnocompress ! true: no compression along x and y direction (cart option)
+ real, dimension(:), allocatable :: zworktemp
+ real, dimension(:,:,:,:,:,:), allocatable :: zrhodjn, zworkmask
+ type(date_time), dimension(:), allocatable :: tzdates
+ type(tfielddata) :: tzfield
+ type(tfiledata) :: tzfile
+ !
+ !-------------------------------------------------------------------------------
+ !
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Write_budget', 'called' )
+
+ gnocompress = .true.
+ !
+ !* Write TSTEP and BULEN
+ ! ---------------------
+ !
+ TZFIELD%CMNHNAME = 'TSTEP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'TSTEP'
+ TZFIELD%CUNITS = 's'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'Time step'
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 0
+ TZFIELD%LTIMEDEP = .FALSE.
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,PTSTEP)
+ !
+ TZFIELD%CMNHNAME = 'BULEN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'BULEN'
+ TZFIELD%CUNITS = 's'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'Time step'
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 0
+ TZFIELD%LTIMEDEP = .FALSE.
+ CALL IO_Field_write(TPDIAFILE,TZFIELD,XBULEN)
+ !
+ ! Initialize NBUTSHIFT
+ NBUTSHIFT = NBUTSHIFT+1
+ !
+ !
+ SELECT CASE (CBUTYPE)
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 2. 'CART' CASE
+ ! -----------
+ !
+ CASE('CART','SKIP')
+ GNOCOMPRESS=(.NOT.LBU_ICP .AND. .NOT.LBU_JCP)
+ !
+ !* 2.1 Initialization
+ !
+ ALLOCATE( ZWORKTEMP(1) )
+ !Note: tzdates are used only in LFI files; for netCDF files, dates are written in the coordinates
+ allocate( tzdates(1) )
+ !
+ !Compute time at the middle of the temporally-averaged budget timestep
+ !This time is computed from the beginning of the experiment
+ CALL DATETIME_DISTANCE(TDTEXP,TPDTCUR,ZWORKTEMP(1))
+ !
+ ZWORKTEMP(1)=ZWORKTEMP(1)+(1.-NBUSTEP*0.5)*PTSTEP
+ !
+ tzdates(1)%nyear = tdtexp%nyear
+ tzdates(1)%nmonth = tdtexp%nmonth
+ tzdates(1)%nday = tdtexp%nday
+ tzdates(1)%xtime = tdtexp%xtime + zworktemp(1)
+
+ DEALLOCATE ( ZWORKTEMP )
+ !
+ !-------------------------------------------------------------------------------
+ !
+ !* 3. 'MASK' CASE
+ ! -----------
+ !
+ CASE('MASK')
+ ALLOCATE(ZWORKTEMP(nbusubwrite))
+ !Note: tzdates are used only in LFI files; for netCDF files, dates are written in the coordinates
+ allocate( tzdates(nbusubwrite) )
+ !
+ CALL DATETIME_DISTANCE(TDTEXP,TPDTCUR,ZWORKTEMP(nbusubwrite))
+ !
+ ZWORKTEMP(nbusubwrite)=ZWORKTEMP(nbusubwrite)+(1.-NBUSTEP*0.5)*PTSTEP
+ !
+ tzdates(nbusubwrite)%nyear = tdtexp%nyear
+ tzdates(nbusubwrite)%nmonth = tdtexp%nmonth
+ tzdates(nbusubwrite)%nday = tdtexp%nday
+ tzdates(nbusubwrite)%xtime = tdtexp%xtime + zworktemp(nbusubwrite)
+ DO JT=1,nbusubwrite-1
+ ZWORKTEMP(JT) = ZWORKTEMP(nbusubwrite)-NBUSTEP*PTSTEP*(nbusubwrite-JT)
+ tzdates(jt)%nyear = tdtexp%nyear
+ tzdates(jt)%nmonth = tdtexp%nmonth
+ tzdates(jt)%nday = tdtexp%nday
+ tzdates(jt)%xtime = tdtexp%xtime + zworktemp(jt)
END DO
- END DO
-!
- ZWORKDATIME(1,:)=TDTEXP%TDATE%YEAR
- ZWORKDATIME(2,:)=TDTEXP%TDATE%MONTH
- ZWORKDATIME(3,:)=TDTEXP%TDATE%DAY
- ZWORKDATIME(4,:)=TDTEXP%TIME
- ZWORKDATIME(5,:)=TDTSEG%TDATE%YEAR
- ZWORKDATIME(6,:)=TDTSEG%TDATE%MONTH
- ZWORKDATIME(7,:)=TDTSEG%TDATE%DAY
- ZWORKDATIME(8,:)=TDTSEG%TIME
- ZWORKDATIME(9,:)=TPDTMOD%TDATE%YEAR
- ZWORKDATIME(10,:)=TPDTMOD%TDATE%MONTH
- ZWORKDATIME(11,:)=TPDTMOD%TDATE%DAY
- ZWORKDATIME(12,:)=TPDTMOD%TIME
-!
- CALL DATETIME_DISTANCE(TDTEXP,TPDTCUR,ZWORKTEMP(NBUWRNB,1))
-!
- ZWORKTEMP(NBUWRNB,1)=ZWORKTEMP(NBUWRNB,1)+(1.-NBUSTEP*0.5)*PTSTEP
-!
- ZWORKDATIME(13,NBUWRNB)=TDTEXP%TDATE%YEAR
- ZWORKDATIME(14,NBUWRNB)=TDTEXP%TDATE%MONTH
- ZWORKDATIME(15,NBUWRNB)=TDTEXP%TDATE%DAY
- ZWORKDATIME(16,NBUWRNB)=TDTEXP%TIME+ZWORKTEMP(NBUWRNB,1)
- DO JT=1,NBUWRNB-1
- ZWORKTEMP(JT,1) = ZWORKTEMP(NBUWRNB,1)-NBUSTEP*PTSTEP*(NBUWRNB-JT)
- ZWORKDATIME(13,JT)=TDTEXP%TDATE%YEAR
- ZWORKDATIME(14,JT)=TDTEXP%TDATE%MONTH
- ZWORKDATIME(15,JT)=TDTEXP%TDATE%DAY
- ZWORKDATIME(16,JT)=TDTEXP%TIME + ZWORKTEMP(JT,1)
- END DO
-!
-!* 3.1 storage of the masks array
-!
- WRITE(TZFIELD%CMNHNAME,FMT="('MASK_',I4.4,'.MASK')") NBUTSHIFT
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = ''
- TZFIELD%CDIR = 'XY'
- WRITE(TZFIELD%CCOMMENT,FMT="('X_Y_MASK',I4.4)") NBUTSHIFT
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 6
- TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write(TPDIAFILE,TZFIELD,ZWORKMASK(:,:,:,:,:,:))
- WRITE(YRECFM,FMT="('MASK_',I4.4)") NBUTSHIFT
- CALL MENU_DIACHRO(TPDIAFILE,YRECFM)
- DEALLOCATE(ZWORKMASK)
-!
-!* 3.2 storage of the budgets array
-!
-!* 3.2.1 RU budget
-!
+
+ DEALLOCATE( ZWORKTEMP )
+ !
+ !* 3.1 storage of the masks array
+ !
+#ifdef MNH_IOLFI
+ if ( Trim( tpdiafile%cformat ) == 'LFI' .or. Trim( tpdiafile%cformat ) == 'LFICDF4' ) then
+ Allocate( zworkmask(Size( nbusurf, 1 ), Size( nbusurf, 2 ), 1, nbusubwrite, nbumask,1) )
+ ! local array
+ do jmask = 1, nbumask
+ do jt = 1, nbusubwrite
+ zworkmask(:, :, 1, jt, jmask, 1) = Real( nbusurf(:, :, jmask, jt), kind = Kind( zworkmask ) )
+ end do
+ end do
+
+ tzfile = tpdiafile
+ tzfile%cformat = 'LFI'
+
+ Write( tzfield%cmnhname, fmt = "( 'MASK_', i4.4, '.MASK' )" ) nbutshift
+ tzfield%cstdname = ''
+ tzfield%clongname = Trim( tzfield%cmnhname )
+ tzfield%cunits = ''
+ tzfield%cdir = 'XY'
+ Write( tzfield%ccomment, fmt = "( 'X_Y_MASK', i4.4 )" ) nbutshift
+ tzfield%ngrid = 1
+ tzfield%ntype = TYPEREAL
+ tzfield%ndims = 6
+ tzfield%ltimedep = .FALSE.
+ tzfield%ndimlist(1) = NMNHDIM_NI
+ tzfield%ndimlist(2) = NMNHDIM_NJ
+ tzfield%ndimlist(3) = NMNHDIM_ONE
+ tzfield%ndimlist(4) = NMNHDIM_BUDGET_TIME
+ tzfield%ndimlist(5) = NMNHDIM_BUDGET_MASK_NBUMASK
+ tzfield%ndimlist(6) = NMNHDIM_ONE
+ call IO_Field_write( tzfile, tzfield, zworkmask(:, :, :, :, :, :) )
+
+ Write( yrecfm, fmt = "( 'MASK_', i4.4 )" ) nbutshift
+ call Menu_diachro( tzfile, yrecfm )
+
+ Deallocate( zworkmask )
+ end if
+#endif
+
+ if ( Trim( tpdiafile%cformat ) == 'LFICDF4' .or. Trim( tpdiafile%cformat ) == 'NETCDF4' ) then
+ tzfile = tpdiafile
+ tzfile%cformat = 'NETCDF4'
+
+ 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 = TYPEINT
+ tzfield%ndims = 4
+ tzfield%ltimedep = .false. !The time dependance is in the NMNHDIM_BUDGET_TIME dimension
+ tzfield%ndimlist(1) = NMNHDIM_NI
+ tzfield%ndimlist(2) = NMNHDIM_NJ
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_MASK_NBUMASK
+ tzfield%ndimlist(4) = NMNHDIM_BUDGET_TIME
+ tzfield%ndimlist(5:) = NMNHDIM_UNUSED
+
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tzfile, tzfield )
+
+ !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, CMASK_VARNAME )
+ end if
+ !
+ END SELECT
+ !
+ if ( cbutype == 'CART' .or. cbutype == 'SKIP' .or. cbutype == 'MASK' ) then
+ !
+ !* Storage of the budgets array
+ !
+ !* RU budgets
+ !
IF (LBU_RU) THEN
- ! XBURHODJU storage
-!
- ALLOCATE(ZWORK(1,1,NBUKMAX,NBUWRNB,NBUMASK,1))
- ALLOCATE(YWORKUNIT(1))
- ALLOCATE(YWORKCOMMENT(1))
- ALLOCATE(IWORKGRID(1))
-!
- ZWORK(1,1,:,:,:,1) = END_MASK_COMPRESS(XBURHODJU(:,:,:))
- WHERE (ZWORK(1,1,:,:,:,1) <= 0.)
- ZWORK(1,1,:,:,:,1)=-999.
- END WHERE
- YWORKUNIT(:) = 'kg'
- YWORKCOMMENT(:) = 'RhodJ for momentum along X axis'
- IWORKGRID(:) = 2
- WRITE(YGROUP_NAME,FMT="('RJX__',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORK, ZWORKTEMP, CBUCOMMENT(1, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE( YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
-! unit conversion of RU budgets and storage
-! -----------------------------------------
-!
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(1)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(1)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(1)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(1)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(1)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(1)) = 1.
- DO JPROC=1,NBUPROCNBR(1)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURU(:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT, ZWORK)
-
-!
- YWORKUNIT(:) = 'm s-2'; YWORKUNIT(1:3) = 'm s-1'
- YWORKCOMMENT(:) = 'Budget of momentum along X axis'
- IWORKGRID(:) = 2
- WRITE(YGROUP_NAME,FMT="('UU___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(1, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
+ 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
-!
-!* 3.2.2 RV budget
-!
+ !
+ !* RV budgets
+ !
IF (LBU_RV) THEN
- ! XBURHODJV storage
-!
- ALLOCATE(ZWORK(1,1,NBUKMAX,NBUWRNB,NBUMASK,1))
- ALLOCATE(YWORKUNIT(1))
- ALLOCATE(YWORKCOMMENT(1))
- ALLOCATE(IWORKGRID(1))
-!
- ZWORK(1,1,:,:,:,1)= END_MASK_COMPRESS( XBURHODJV(:,:,:))
- WHERE ( ZWORK(1,1,:,:,:,1) <= 0.)
- ZWORK(1,1,:,:,:,1)=-999.
- END WHERE
- YWORKUNIT(:) = 'kg'
- YWORKCOMMENT(:) = 'RhodJ for momentum along Y axis'
- IWORKGRID(:) = 3
- WRITE(YGROUP_NAME,FMT="('RJY__',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORK, ZWORKTEMP, CBUCOMMENT(1, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE( YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
-! unit conversion of RU budgets and storage
-!
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(2)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(2)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(2)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(2)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(2)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(2)) = 1.
- DO JPROC=1,NBUPROCNBR(2)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURV (:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT, ZWORK)
-!
- YWORKUNIT(:) = 'm s-2'; YWORKUNIT(1:3) = 'm s-1'
- YWORKCOMMENT(:) = 'Budget of momentum along Y axis'
- IWORKGRID(:) = 3
- WRITE(YGROUP_NAME,FMT="('VV___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(2, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
+ 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
-!
-!* 3.2.3 RW budget
-!
+ !
+ !* RW budgets
+ !
IF (LBU_RW) THEN
- ! XBURHODJW storage
-!
- ALLOCATE(ZWORK(1,1,NBUKMAX,NBUWRNB,NBUMASK,1))
- ALLOCATE(YWORKUNIT(1))
- ALLOCATE(YWORKCOMMENT(1))
- ALLOCATE(IWORKGRID(1))
-!
- ZWORK(1,1,:,:,:,1)=END_MASK_COMPRESS(XBURHODJW(:,:,:))
- WHERE (ZWORK(1,1,:,:,:,1) <= 0.)
- ZWORK(1,1,:,:,:,1)=-999.
- END WHERE
- YWORKUNIT(:) = 'kg'
- YWORKCOMMENT(:) = 'RhodJ for momentum along Z axis'
- IWORKGRID(:) = 4
- WRITE(YGROUP_NAME,FMT="('RJZ__',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORK, ZWORKTEMP, CBUCOMMENT(1, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE( YWORKUNIT, YWORKCOMMENT, IWORKGRID)
-!
-! unit conversion of RU budgets and storage
-!
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(3)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(3)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(3)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(3)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(3)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(3)) = 1.
- DO JPROC=1,NBUPROCNBR(3)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURW (:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT, ZWORK)
-!
- YWORKUNIT(:) = 'm s-2'; YWORKUNIT(1:3) = 'm s-1'
- YWORKCOMMENT(:) = 'Budget of momentum along Z axis'
- IWORKGRID(:) = 4
- WRITE(YGROUP_NAME,FMT="('WW___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(3, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
+ 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
-!
-!* 3.2.3' XBURHODJ storage for Scalars
-!
+ !
+ !* RHODJ storage for Scalars
+ !
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
-!
- ALLOCATE(ZWORK(1,1,NBUKMAX,NBUWRNB,NBUMASK,1))
- ALLOCATE(YWORKUNIT(1))
- ALLOCATE(YWORKCOMMENT(1))
- ALLOCATE(IWORKGRID(1))
-!
- ZWORK(1,1,:,:,:,1) = END_MASK_COMPRESS(XBURHODJ(:,:,:))
- WHERE (ZWORK(1,1,:,:,:,1) <= 0.)
- ZWORK(1,1,:,:,:,1)=-999.
- END WHERE
- YWORKUNIT(:) = 'kg'
- YWORKCOMMENT(:) = 'RhodJ for Scalars'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RJS__',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORK, ZWORKTEMP, CBUCOMMENT(1, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE( YWORKUNIT, YWORKCOMMENT, IWORKGRID)
- END IF
-!
-!* 3.2.4 RTH budget
-!
+ if ( .not. associated( tburhodj ) ) call Print_msg( NVERB_FATAL, 'BUD', 'Write_budget', 'tburhodj not associated' )
+ call Store_one_budget_rho( tpdiafile, tzdates, tburhodj, gnocompress, zrhodjn )
+ ENDIF
+ !
+ !* RTH budget
+ !
IF (LBU_RTH) THEN
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(4)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(4)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(4)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(4)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(4)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(4)) = 1.
- DO JPROC=1,NBUPROCNBR(4)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURTH (:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT)
-!
- YWORKUNIT(:) = 'K s-1' ; YWORKUNIT(1:3) = 'K'
- YWORKCOMMENT(:) = 'Budget of potential temperature'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('TH___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(4, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
+ call Store_one_budget( tpdiafile, tzdates, tbudgets(NBUDGET_TH), zrhodjn, gnocompress, ptstep )
END IF
-!
-!* 3.2.5 RTKE budget
-!
+ !
+ !* RTKE budget
+ !
IF (LBU_RTKE) THEN
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(5)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(5)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(5)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(5)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(5)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(5)) = 1.
- DO JPROC=1,NBUPROCNBR(5)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURTKE (:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT)
-!
- YWORKUNIT(:) = 'm2 s-3' ; YWORKUNIT(1:3) = 'm2 s-2'
- YWORKCOMMENT(:) = 'Budget of turbulent kinetic energy'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('TK___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(5, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
- END IF
-!
-!* 3.2.6 RRV budget
-!
+ call Store_one_budget( tpdiafile, tzdates, tbudgets(NBUDGET_TKE), zrhodjn, gnocompress, ptstep )
+ END IF
+ !
+ !* RRV budget
+ !
IF (LBU_RRV) THEN
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(6)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(6)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(6)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(6)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(6)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(6)) = 1.
- DO JPROC=1,NBUPROCNBR(6)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURRV (:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT)
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of water vapor mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RV___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(6, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
+ call Store_one_budget( tpdiafile, tzdates, tbudgets(NBUDGET_RV), zrhodjn, gnocompress, ptstep )
END IF
-!
-!* 3.2.7 RRC budget
-!
+ !
+ !* RRC budget
+ !
IF (LBU_RRC) THEN
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(7)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(7)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(7)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(7)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(7)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(7)) = 1.
- DO JPROC=1,NBUPROCNBR(7)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURRC (:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT)
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of cloud water mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RC___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(7, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
+ call Store_one_budget( tpdiafile, tzdates, tbudgets(NBUDGET_RC), zrhodjn, gnocompress, ptstep )
END IF
-!
-!* 3.2.8 RRR budget
-!
+ !
+ !* RRR budget
+ !
IF (LBU_RRR) THEN
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(8)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(8)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(8)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(8)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(8)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(8)) = 1.
- DO JPROC=1,NBUPROCNBR(8)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURRR (:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT)
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of rain water mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RR___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(8, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
+ call Store_one_budget( tpdiafile, tzdates, tbudgets(NBUDGET_RR), zrhodjn, gnocompress, ptstep )
END IF
-!
-!* 3.2.9 RRI budget
-!
+ !
+ !* RRI budget
+ !
IF (LBU_RRI) THEN
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(9)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(9)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(9)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(9)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(9)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(9)) = 1.
- DO JPROC=1,NBUPROCNBR(9)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURRI (:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT)
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of cloud ice mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RI___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(9, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
+ call Store_one_budget( tpdiafile, tzdates, tbudgets(NBUDGET_RI), zrhodjn, gnocompress, ptstep )
END IF
-!
-!* 3.2.10 RRS budget
-!
+ !
+ !* RRS budget
+ !
IF (LBU_RRS) THEN
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(10)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(10)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(10)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(10)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(10)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(10)) = 1.
- DO JPROC=1,NBUPROCNBR(10)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURRS (:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT)
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of snow/aggregate mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RS___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(10, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
+ call Store_one_budget( tpdiafile, tzdates, tbudgets(NBUDGET_RS), zrhodjn, gnocompress, ptstep )
END IF
-!
-!* 3.2.11 RRG budget
-!
+ !
+ !* RRG budget
+ !
IF (LBU_RRG) THEN
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(11)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(11)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(11)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(11)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(11)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(11)) = 1.
- DO JPROC=1,NBUPROCNBR(11)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURRG (:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT )
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of graupel mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RG___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(11, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
+ call Store_one_budget( tpdiafile, tzdates, tbudgets(NBUDGET_RG), zrhodjn, gnocompress, ptstep )
END IF
-!
-!* 3.2.12 RRH budget
-!
+ !
+ !* RRH budget
+ !
IF (LBU_RRH) THEN
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(12)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(12)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(12)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(12)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(12)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(12)) = 1.
- DO JPROC=1,NBUPROCNBR(12)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURRH (:,:,:,JPROC)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT)
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = 'kg kg-1'
- YWORKCOMMENT(:) = 'Budget of hail mixing ratio'
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('RH___',I4.4)") NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(12, :), &
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
+ call Store_one_budget( tpdiafile, tzdates, tbudgets(NBUDGET_RH), zrhodjn, gnocompress, ptstep )
END IF
-!
-!* 3.2.13 RSV budget
-!
+ !
+ !* RSV budgets
+ !
IF (LBU_RSV) THEN
- DO JSV = 1,KSV
- ALLOCATE(ZWORKT(1,1,NBUKMAX,NBUWRNB,NBUMASK,NBUPROCNBR(12+JSV)))
- ALLOCATE(YWORKUNIT(NBUPROCNBR(12+JSV)))
- ALLOCATE(YWORKCOMMENT(NBUPROCNBR(12+JSV)))
- ALLOCATE(IWORKGRID(NBUPROCNBR(12+JSV)))
-!
- ALLOCATE(ZCONVERT(NBUPROCNBR(12+JSV)))
- ZCONVERT(1:2) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(3) = PTSTEP * REAL(NBUSTEP)
- ZCONVERT(4:NBUPROCNBR(12+JSV)) = 1.
- DO JPROC=1,NBUPROCNBR(12+JSV)
- ZWORKT(1,1,:,:,:,JPROC) = END_MASK_COMPRESS( XBURSV (:,:,:,JPROC,JSV)) &
- * ZCONVERT(JPROC) / ZWORK(1,1,:,:,:,1)
- END DO
- DEALLOCATE(ZCONVERT)
-!
- YWORKUNIT(:) = 's-1' ; YWORKUNIT(1:3) = ' '
- DO JT = 1,NBUPROCNBR(12+JSV)
- WRITE(YWORKCOMMENT(JT),FMT="('Budget of SVx=',I3.3)") JSV
- END DO
- IWORKGRID(:) = 1
- WRITE(YGROUP_NAME,FMT="('SV',I3.3,I4.4)") JSV,NBUTSHIFT
-!
- CALL WRITE_DIACHRO(TPDIAFILE, TLUOUT, YGROUP_NAME, CBUTYPE, IWORKGRID, &
- ZWORKDATIME, ZWORKT, ZWORKTEMP, CBUCOMMENT(12+JSV,:),&
- YWORKUNIT, YWORKCOMMENT, &
- LBU_ICP, LBU_JCP, LBU_KCP, &
- NBUIL, NBUIH, NBUJL, NBUJH, NBUKL, NBUKH )
- DEALLOCATE(ZWORKT, YWORKUNIT, YWORKCOMMENT, IWORKGRID)
- END DO
- END IF
-!
- 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
- DEALLOCATE(ZWORK)
+ do jsv = nbudget_sv1, nbudget_sv1 - 1 + ksv
+ call Store_one_budget( tpdiafile, tzdates, tbudgets(jsv), zrhodjn, gnocompress, ptstep )
+ end do
END IF
-!
- DEALLOCATE (ZWORKTEMP, ZWORKDATIME)
-!
-END SELECT
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE WRITE_BUDGET
+ end if
+
+end subroutine Write_budget
+
+
+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, &
+ NMNHDIM_BUDGET_MASK_LEVEL, NMNHDIM_BUDGET_MASK_LEVEL_W, &
+ NMNHDIM_BUDGET_MASK_NBUMASK, NMNHDIM_BUDGET_TIME, &
+ NMNHDIM_UNUSED, NMNHDIM_UNKNOWN
+ use modd_io, only: tfiledata
+ use modd_lunit_n, only: tluout
+ use modd_parameters, only: XNEGUNDEF
+ use modd_type_date, only: date_time
+
+ use mode_msg
+ use mode_write_diachro, only: Write_diachro
+
+ use modi_end_cart_compress, only: End_cart_compress
+ use modi_end_mask_compress, only: End_mask_compress
+
+ implicit none
+
+ type(tfiledata), intent(in) :: tpdiafile ! file to write
+ type(date_time), dimension(:), intent(in) :: tpdates
+ type(tburhodata), intent(in) :: tprhodj ! rhodj datastructure
+ logical, intent(in) :: knocompress ! compression for the cart option
+ real, dimension(:,:,:,:,:,:), allocatable, intent(out) :: prhodjn
+
+ character(len=4) :: ybutype
+ type(tbudiachrometadata) :: tzbudiachro
+ type(tburhodata) :: tzfield
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Store_one_budget_rho', 'called for '//trim( tprhodj%cmnhname ) )
+
+ !if ( allocated( prhodjn ) ) deallocate( prhodjn ) !Not necessary: if intent(out) => automatically deallocated
+
+ ! pburhodj storage
+ select case ( cbutype )
+ case( 'CART', 'SKIP' )
+ !Set to CART for all processes even if has no data(='SKIP')
+ !Necessary to do the call and the collective write later (if knocompress)
+ ybutype = 'CART'
+ if ( knocompress ) then
+ allocate( prhodjn(nbuimax, nbujmax, nbukmax, 1, 1, 1) ) ! local budget of RHODJU
+ prhodjn(:, :, :, 1, 1, 1) = tprhodj%xdata(:, :, :)
+ else
+ allocate( prhodjn(nbuimax_ll, nbujmax_ll, nbukmax, 1, 1, 1) ) ! global budget of RhodjU
+ prhodjn(:,:,:,1,1,1)=End_cart_compress( tprhodj%xdata(:,:,:) )
+ end if
+ case('MASK')
+ ybutype = 'MASK'
+ allocate( prhodjn(1, 1, nbukmax, nbusubwrite, nbumask, 1) )
+ prhodjn(1, 1, :, :, :, 1) = End_mask_compress( tprhodj%xdata(:, :, :) )
+ where ( prhodjn(1, 1, :, :, :, 1) <= 0. )
+ prhodjn(1, 1, :, :, :, 1) = XNEGUNDEF
+ end where
+
+ case default
+ call Print_msg( NVERB_ERROR, 'BUD', 'Store_one_budget_rho', 'unknown CBUTYPE' )
+ end select
+
+ !Copy all fields from tprhodj
+ tzfield = tprhodj
+
+ !Modify metadata coming from tprhodj%tgroups
+ !ndims and ndimlist are adapted for Write_diachro
+ if ( tzfield%ngrid < 1 .or. tzfield%ngrid > 4 ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Store_one_budget_rho', 'invalid grid' )
+
+ if ( ybutype == 'CART' ) then
+ if ( .not. lbu_icp ) then
+ select case ( tzfield%ngrid )
+ case ( 1, 4 )
+ tzfield%ndimlist(1) = NMNHDIM_BUDGET_CART_NI
+ case ( 2 )
+ tzfield%ndimlist(1) = NMNHDIM_BUDGET_CART_NI_U
+ case ( 3 )
+ tzfield%ndimlist(1) = NMNHDIM_BUDGET_CART_NI_V
+ end select
+ else
+ tzfield%ndims = tzfield%ndims - 1
+ tzfield%ndimlist(1) = NMNHDIM_UNUSED
+ end if
+
+ if ( .not. lbu_jcp ) then
+ select case ( tzfield%ngrid )
+ case ( 1, 4 )
+ tzfield%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ
+ case ( 2 )
+ tzfield%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ_U
+ case ( 3 )
+ tzfield%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ_V
+ end select
+ else
+ tzfield%ndims = tzfield%ndims - 1
+ tzfield%ndimlist(2) = NMNHDIM_UNUSED
+ end if
+
+ if ( .not. lbu_kcp ) then
+ select case ( tzfield%ngrid )
+ case ( 1, 2, 3 )
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_CART_LEVEL
+ case ( 4 )
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_CART_LEVEL_W
+ end select
+ else
+ tzfield%ndims = tzfield%ndims - 1
+ tzfield%ndimlist(3) = NMNHDIM_UNUSED
+ end if
+ tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ else if ( ybutype == 'MASK' ) then
+ tzfield%ndimlist(1) = NMNHDIM_UNUSED
+ tzfield%ndimlist(2) = NMNHDIM_UNUSED
+ if ( .not. lbu_kcp ) then
+ select case ( tzfield%ngrid )
+ case ( 1, 2, 3 )
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_MASK_LEVEL
+ case ( 4 )
+ tzfield%ndimlist(3) = NMNHDIM_BUDGET_MASK_LEVEL_W
+ end select
+ else
+ tzfield%ndims = tzfield%ndims - 1
+ tzfield%ndimlist(3) = NMNHDIM_UNUSED
+ end if
+ tzfield%ndimlist(4) = NMNHDIM_BUDGET_TIME
+ tzfield%ndimlist(5) = NMNHDIM_BUDGET_MASK_NBUMASK
+ tzfield%ndimlist(6) = NMNHDIM_UNUSED
+
+ else
+ tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
+ end if
+
+ 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%lmobile = .false.
+ else
+ !Masks are updated at each timestep (therefore the studied domains change during execution)
+ tzbudiachro%lmobile = .true.
+ end if
+ 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
+ tzbudiachro%njh = nbujh
+ tzbudiachro%nkl = nbukl
+ tzbudiachro%nkh = nbukh
+
+ call Write_diachro( tpdiafile, tzbudiachro, [ tzfield ], tpdates, prhodjn, osplit = .true. )
+
+end subroutine Store_one_budget_rho
+
+
+subroutine Store_one_budget( tpdiafile, tpdates, tpbudget, prhodjn, knocompress, ptstep )
+ use modd_budget, only: cbutype, &
+ lbu_icp, lbu_jcp, lbu_kcp, &
+ nbuil, nbuih, nbujl, nbujh, nbukl, nbukh, &
+ nbuimax, nbuimax_ll, nbujmax, nbujmax_ll, nbukmax, nbustep, nbutshift, &
+ 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, &
+ NMNHDIM_BUDGET_CART_LEVEL, NMNHDIM_BUDGET_CART_LEVEL_W, &
+ NMNHDIM_BUDGET_MASK_LEVEL, NMNHDIM_BUDGET_MASK_LEVEL_W, &
+ NMNHDIM_BUDGET_MASK_NBUMASK, NMNHDIM_BUDGET_TIME, &
+ NMNHDIM_BUDGET_NGROUPS, NMNHDIM_UNUSED, NMNHDIM_UNKNOWN, &
+ TYPEREAL
+ use modd_io, only: tfiledata
+ use modd_lunit_n, only: tluout
+ use modd_nsv, only: csvnames
+ use modd_parameters, only: NBUNAMELGTMAX
+ use modd_type_date, only: date_time
+
+ use mode_msg
+ use mode_write_diachro, only: Write_diachro
+
+ use modi_end_cart_compress, only: End_cart_compress
+ use modi_end_mask_compress, only: End_mask_compress
+
+ implicit none
+
+ type(tfiledata), intent(in) :: tpdiafile ! file to write
+ type(date_time), dimension(:), intent(in) :: tpdates
+ type(tbudgetdata), intent(in) :: tpbudget ! Budget datastructure
+ real, dimension(:,:,:,:,:,:), allocatable, intent(in) :: prhodjn
+ logical, intent(in) :: knocompress ! compression for the cart option
+ real, intent(in) :: ptstep ! time step
+
+ character(len=4) :: ybutype
+ integer :: igroups
+ integer :: jproc
+ integer :: jsv
+ real, dimension(:), allocatable :: zconvert ! unit conversion coefficient
+ real, dimension(:,:,:,:,:,:), allocatable :: zworkt
+ type(tbudiachrometadata) :: tzbudiachro
+ type(tbugroupdata), dimension(:), allocatable :: tzfields
+
+ call Print_msg( NVERB_DEBUG, 'BUD', 'Store_one_budget', 'called for '//trim( tpbudget%cname ) )
+
+ if( .not. allocated( prhodjn ) ) then
+ call Print_msg( NVERB_ERROR, 'BUD', 'Store_one_budget', 'prhodjn not allocated' )
+ return
+ end if
+
+ igroups = tpbudget%ngroups
+
+ if ( igroups == 0 ) return
+
+ ! unit conversion for ru budgets
+ allocate( zconvert( igroups ) )
+ do jproc = 1, igroups
+ if ( tpbudget%tgroups(jproc)%cmnhname == 'INIF' &
+ .or. tpbudget%tgroups(jproc)%cmnhname == 'ENDF' &
+ .or. tpbudget%tgroups(jproc)%cmnhname == 'AVEF' ) then
+ zconvert(jproc) = ptstep * Real( nbustep )
+ else
+ zconvert(jproc) = 1.
+ end if
+ end do
+
+ select case ( cbutype )
+ case( 'CART', 'SKIP' )
+ ybutype = 'CART'
+ if ( knocompress ) then
+ allocate( zworkt(nbuimax, nbujmax, nbukmax, 1, 1, igroups ) ) ! local budget of ru
+ do jproc = 1, igroups
+ zworkt(:, :, :, 1, 1, jproc) = tpbudget%tgroups(jproc)%xdata(:, :, :) &
+ * zconvert(jproc) / prhodjn(:, :, :, 1, 1, 1)
+ end do
+ else
+ allocate( zworkt(nbuimax_ll, nbujmax_ll, nbukmax, 1, 1, igroups ) ) ! global budget of ru
+
+ do jproc = 1, igroups
+ zworkt(:, :, :, 1, 1, jproc) = End_cart_compress( tpbudget%tgroups(jproc)%xdata(:, :, :) )
+ zworkt(:, :, :, 1, 1, jproc) = zworkt(:, :, :, 1, 1, jproc) * zconvert(jproc) / prhodjn(:, :, :, 1, 1, 1)
+ end do
+ endif
+ case('MASK')
+ ybutype = 'MASK'
+ allocate( zworkt(1, 1, nbukmax, nbusubwrite, nbumask, igroups ) )
+ do jproc = 1, igroups
+ zworkt(1, 1, :, :, :, jproc) = End_mask_compress( tpbudget%tgroups(jproc)%xdata(:, :, :) ) &
+ * zconvert(jproc) / prhodjn(1, 1, :, :, :, 1)
+ end do
+
+ case default
+ call Print_msg( NVERB_ERROR, 'BUD', 'Store_one_budget', 'unknown CBUTYPE' )
+ end select
+
+ deallocate(zconvert)
+
+ allocate( tzfields( igroups ) )
+
+ !Copy all fields from tpbudget%tgroups
+ tzfields(:) = tpbudget%tgroups(:)
+
+ !Modify metadata coming from tpbudget%tgroups
+ !ndims and ndimlist are adapted for Write_diachro
+ do jproc = 1, igroups
+ tzfields(jproc)%ndims = 4
+
+ if ( tzfields(jproc)%ngrid < 1 .or. tzfields(jproc)%ngrid > 4 ) &
+ call Print_msg( NVERB_FATAL, 'BUD', 'Store_one_budget_rho', 'invalid grid' )
+
+ if ( ybutype == 'CART' ) then
+ if ( .not. lbu_icp ) then
+ select case ( tzfields(jproc)%ngrid )
+ case ( 1, 4 )
+ tzfields(jproc)%ndimlist(1) = NMNHDIM_BUDGET_CART_NI
+ case ( 2 )
+ tzfields(jproc)%ndimlist(1) = NMNHDIM_BUDGET_CART_NI_U
+ case ( 3 )
+ tzfields(jproc)%ndimlist(1) = NMNHDIM_BUDGET_CART_NI_V
+ end select
+ else
+ tzfields(jproc)%ndims = tzfields(jproc)%ndims - 1
+ tzfields(jproc)%ndimlist(1) = NMNHDIM_UNUSED
+ end if
+
+ if ( .not. lbu_jcp ) then
+ select case ( tzfields(jproc)%ngrid )
+ case ( 1, 4 )
+ tzfields(jproc)%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ
+ case ( 2 )
+ tzfields(jproc)%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ_U
+ case ( 3 )
+ tzfields(jproc)%ndimlist(2) = NMNHDIM_BUDGET_CART_NJ_V
+ end select
+ else
+ tzfields(jproc)%ndims = tzfields(jproc)%ndims - 1
+ tzfields(jproc)%ndimlist(2) = NMNHDIM_UNUSED
+ end if
+
+ if ( .not. lbu_kcp ) then
+ select case ( tzfields(jproc)%ngrid )
+ case ( 1, 2, 3 )
+ tzfields(jproc)%ndimlist(3) = NMNHDIM_BUDGET_CART_LEVEL
+ case ( 4 )
+ tzfields(jproc)%ndimlist(3) = NMNHDIM_BUDGET_CART_LEVEL_W
+ end select
+ else
+ tzfields(jproc)%ndims = tzfields(jproc)%ndims - 1
+ tzfields(jproc)%ndimlist(3) = NMNHDIM_UNUSED
+ end if
+ tzfields(jproc)%ndimlist(4) = NMNHDIM_UNUSED
+ tzfields(jproc)%ndimlist(5) = NMNHDIM_UNUSED
+ tzfields(jproc)%ndimlist(6) = NMNHDIM_BUDGET_NGROUPS
+
+ else if ( ybutype == 'MASK' ) then
+ tzfields(jproc)%ndimlist(1) = NMNHDIM_UNUSED
+ tzfields(jproc)%ndimlist(2) = NMNHDIM_UNUSED
+ if ( .not. lbu_kcp ) then
+ select case ( tzfields(jproc)%ngrid )
+ case ( 1, 2, 3 )
+ tzfields(jproc)%ndimlist(3) = NMNHDIM_BUDGET_MASK_LEVEL
+ case ( 4 )
+ tzfields(jproc)%ndimlist(3) = NMNHDIM_BUDGET_MASK_LEVEL_W
+ end select
+ else
+ tzfields(jproc)%ndims = tzfields(jproc)%ndims - 1
+ tzfields(jproc)%ndimlist(3) = NMNHDIM_UNUSED
+ end if
+ tzfields(jproc)%ndimlist(4) = NMNHDIM_BUDGET_TIME
+ tzfields(jproc)%ndimlist(5) = NMNHDIM_BUDGET_MASK_NBUMASK
+ tzfields(jproc)%ndimlist(6) = NMNHDIM_BUDGET_NGROUPS
+
+ else
+ tzfields(jproc)%ndimlist(:) = NMNHDIM_UNKNOWN
+ end if
+ end do
+
+ 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%lmobile = .false.
+ else
+ !Masks are updated at each timestep (therefore the studied domains change during execution)
+ tzbudiachro%lmobile = .true.
+ end if
+ 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. )
+
+end subroutine Store_one_budget
+
+end module mode_write_budget
diff --git a/src/MNH/write_desfmn.f90 b/src/MNH/write_desfmn.f90
index fc96071c8c8ae39e628d89700febd2003da034a3..fb24c9bae47e3b7140e3a266768cffe9a5216841 100644
--- a/src/MNH/write_desfmn.f90
+++ b/src/MNH/write_desfmn.f90
@@ -1,4 +1,4 @@
-!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.
@@ -94,7 +94,7 @@ END MODULE MODI_WRITE_DESFM_n
!!
!! Module MODN_LES : contains declaration of the control parameters
!! for Large Eddy Simulations' storages
-!! Module MODN_BLANK: contains declaration of MesoNH developper variables
+!! Module MODN_BLANK_n : contains declaration of MesoNH developper variables
!! for test and debugging purposes.
!!
!!
@@ -144,6 +144,8 @@ END MODULE MODI_WRITE_DESFM_n
!! 02/2018 Q.Libois ECRAD
!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
!! Modification V. Vionnet 07/2017 add blowing snow variables
+!! Modification F.Auguste 02/2021 add IBM
+!! E.Jezequel 02/2021 add stations read from CSV file
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -176,7 +178,7 @@ USE MODN_LUNIT_n
USE MODN_LBC_n
USE MODN_NUDGING_n
USE MODN_TURB_n
-USE MODN_BLANK
+USE MODN_BLANK_n
USE MODN_FRC
USE MODN_CH_MNHC_n
USE MODN_CH_SOLVER_n
@@ -201,6 +203,10 @@ USE MODD_FOREFIRE_n, ONLY : FFCOUPLING
#endif
USE MODN_BLOWSNOW_n
USE MODN_BLOWSNOW
+USE MODN_IBM_PARAM_n
+USE MODN_RECYCL_PARAM_n
+USE MODD_IBM_LSF, ONLY: LIBM_LSF
+USE MODN_STATION_n
!
IMPLICIT NONE
!
@@ -307,6 +313,20 @@ ELSE !return to namelist meaning of LHORELAX_SV
END IF
WRITE(UNIT=ILUSEG,NML=NAM_DYNn)
!
+IF (LIBM_LSF) THEN
+ !
+ CALL INIT_NAM_IBM_PARAMn
+ !
+ WRITE(UNIT=ILUSEG,NML=NAM_IBM_PARAMn)
+ !
+ IF (CPROGRAM/='MESONH') THEN
+ LIBM = .FALSE.
+ LIBM_TROUBLE = .FALSE.
+ CIBM_ADV = 'NOTHIN'
+ END IF
+ !
+END IF
+!
CALL INIT_NAM_ADVn
WRITE(UNIT=ILUSEG,NML=NAM_ADVn)
IF (CPROGRAM/='MESONH') THEN
@@ -344,6 +364,9 @@ WRITE(UNIT=ILUSEG,NML=NAM_NUDGINGn)
CALL INIT_NAM_TURBn
IF(CTURB /= 'NONE') WRITE(UNIT=ILUSEG,NML=NAM_TURBn)
!
+CALL INIT_NAM_BLANKn
+WRITE(UNIT=ILUSEG,NML=NAM_BLANKn)
+!
!IF (CPROGRAM/='MESONH') THEN
! LUSECHEM = .FALSE.
! LORILAM = .FALSE.
@@ -366,6 +389,9 @@ CALL INIT_NAM_BLOWSNOWn
IF(LBLOWSNOW) WRITE(UNIT=ILUSEG,NML=NAM_BLOWSNOWn)
IF(LBLOWSNOW) WRITE(UNIT=ILUSEG,NML=NAM_BLOWSNOW)
!
+CALL INIT_NAM_STATIONn
+IF(LSTATION) WRITE(UNIT=ILUSEG,NML=NAM_STATIONn)
+!
IF(LDUST) WRITE(UNIT=ILUSEG,NML=NAM_DUST)
IF(LSALT) WRITE(UNIT=ILUSEG,NML=NAM_SALT)
IF(LPASPOL) WRITE(UNIT=ILUSEG,NML=NAM_PASPOL)
@@ -408,7 +434,7 @@ IF(LBU_RRH) WRITE(UNIT=ILUSEG,NML=NAM_BU_RRH)
IF(LBU_RSV) WRITE(UNIT=ILUSEG,NML=NAM_BU_RSV)
IF(LLES_MEAN .OR. LLES_RESOLVED .OR. LLES_SUBGRID .OR. LLES_UPDRAFT &
.OR. LLES_DOWNDRAFT .OR. LLES_SPECTRA) WRITE(UNIT=ILUSEG,NML=NAM_LES)
-WRITE(UNIT=ILUSEG,NML=NAM_BLANK)
+WRITE(UNIT=ILUSEG,NML=NAM_BLANKn)
IF(LFORCING .OR. LTRANS) WRITE(UNIT=ILUSEG,NML=NAM_FRC)
IF(CCLOUD(1:3) == 'ICE') WRITE(UNIT=ILUSEG,NML=NAM_PARAM_ICE)
IF(CCLOUD == 'C2R2' .OR. CCLOUD == 'C3R5' .OR. CCLOUD == 'KHKO') &
@@ -446,7 +472,17 @@ IF (NVERB >= 5) THEN
!
WRITE(UNIT=ILUOUT,FMT="('********** ADVECTIONn **************')")
WRITE(UNIT=ILUOUT,NML=NAM_ADVn)
-!
+ !
+ IF (LIBM_LSF) THEN
+ WRITE(UNIT=ILUOUT,FMT="('********** IBM_PARAMn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_IBM_PARAMn)
+ ENDIF
+ !
+ IF (LRECYCL) THEN
+ WRITE(UNIT=ILUOUT,FMT="('********** RECYCL_PARAMn **************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_RECYCL_PARAMn)
+ ENDIF
+ !
WRITE(UNIT=ILUOUT,FMT="('********** PARAMETERIZATIONSn ******')")
WRITE(UNIT=ILUOUT,NML=NAM_PARAMn)
!
@@ -483,6 +519,9 @@ IF (NVERB >= 5) THEN
!
WRITE(UNIT=ILUOUT,FMT="('********** BLOWING SNOW SCHEME ****************')")
WRITE(UNIT=ILUOUT,NML=NAM_BLOWSNOWn)
+!
+ WRITE(UNIT=ILUOUT,FMT="('********** BLANKn *****************************')")
+ WRITE(UNIT=ILUOUT,NML=NAM_BLANKn)
!
IF (KMI==1) THEN
WRITE(UNIT=ILUOUT,FMT="(/,'PART OF SEGMENT FILE COMMON TO ALL THE MODELS')")
@@ -506,50 +545,60 @@ IF (NVERB >= 5) THEN
WRITE(UNIT=ILUOUT,FMT="('************ BUDGET ***************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BUDGET)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RU ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RU(0) )
WRITE(UNIT=ILUOUT,FMT="('************ U BUDGET *************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RU)
-!
+!
+ IF ( .NOT. ALLOCATED( CBULIST_RV ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RV(0) )
WRITE(UNIT=ILUOUT,FMT="('************ V BUDGET *************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RV)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RW ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RW(0) )
WRITE(UNIT=ILUOUT,FMT="('************ W BUDGET *************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RW)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RTH ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTH(0) )
WRITE(UNIT=ILUOUT,FMT="('************ TH BUDGET ************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RTH)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RTKE ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RTKE(0) )
WRITE(UNIT=ILUOUT,FMT="('************ TKE BUDGET ***********************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RTKE)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RRV ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRV(0) )
WRITE(UNIT=ILUOUT,FMT="('************ RV BUDGET ************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RRV)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RRC ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRC(0) )
WRITE(UNIT=ILUOUT,FMT="('************ RC BUDGET ************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RRC)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RRR ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRR(0) )
WRITE(UNIT=ILUOUT,FMT="('************ RR BUDGET ************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RRR)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RRI ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRI(0) )
WRITE(UNIT=ILUOUT,FMT="('************ RI BUDGET ************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RRI)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RRS ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRS(0) )
WRITE(UNIT=ILUOUT,FMT="('************ RS BUDGET ************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RRS)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RRG ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRG(0) )
WRITE(UNIT=ILUOUT,FMT="('************ RG BUDGET ************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RRG)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RRH ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RRH(0) )
WRITE(UNIT=ILUOUT,FMT="('************ RH BUDGET ************************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RRH)
!
+ IF ( .NOT. ALLOCATED( CBULIST_RSV ) ) ALLOCATE( CHARACTER(LEN=NBULISTMAXLEN) :: CBULIST_RSV(0) )
WRITE(UNIT=ILUOUT,FMT="('************ SVx BUDGET ***********************')")
WRITE(UNIT=ILUOUT,NML=NAM_BU_RSV)
!
WRITE(UNIT=ILUOUT,FMT="('************ LES ******************************')")
WRITE(UNIT=ILUOUT,NML=NAM_LES)
-!
- WRITE(UNIT=ILUOUT,FMT="('************ BLANK ****************************')")
- WRITE(UNIT=ILUOUT,NML=NAM_BLANK)
!
WRITE(UNIT=ILUOUT,FMT="('************ FORCING **************************')")
WRITE(UNIT=ILUOUT,NML=NAM_FRC)
diff --git a/src/MNH/write_diachro.f90 b/src/MNH/write_diachro.f90
index 5e24bc549cb02cc744252b57a5ce0e58ce34f76c..8ad7c453850bb1409087333d0c8ed12fcb1bfd0b 100644
--- a/src/MNH/write_diachro.f90
+++ b/src/MNH/write_diachro.f90
@@ -1,28 +1,41 @@
-!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.
!-----------------------------------------------------------------
-! #################################################################
- SUBROUTINE WRITE_DIACHRO(TPDIAFILE,TPLUOUTDIA,HGROUP,HTYPE, &
- KGRID,PDATIME,PVAR,PTRAJT, &
- HTITRE,HUNITE,HCOMMENT,OICP,OJCP,OKCP,KIL,KIH,KJL,KJH,KKL,KKH, &
- PTRAJX,PTRAJY,PTRAJZ,PMASK)
-! #################################################################
+module mode_write_diachro
+
+use mode_msg
+
+implicit none
+
+private
+
+public :: Write_diachro
+
+interface Att_write
+ procedure Att_write_c0, Att_write_i0, Att_write_x0
+end interface
+contains
+
+! #################################################################
+subroutine Write_diachro( tpdiafile, tpbudiachro, tpfields, &
+ tpdates, pvar, osplit, tpflyer )
+! #################################################################
!
!!**** *WRITE_DIACHRO* - Ecriture d'un enregistrement dans un fichier
!! diachronique (de nom de base HGROUP)
!!
!! PURPOSE
!! -------
-!
+!
!
!!** METHOD
!! ------
!! En fait pour un groupe donne HGROUP, on ecrit systematiquement
! plusieurs enregistrements :
! - 1: HGROUP.TYPE (type d'informations a enregistrer)
-! - 2: HGROUP.DIM (dimensions de toutes les matrices a
+! - 2: HGROUP.DIM (dimensions de toutes les matrices a
! enregistrer)
! - 3: HGROUP.TITRE (Nom des processus)
! - 4: HGROUP.UNITE (Unites pour chaque processus)
@@ -55,211 +68,390 @@
!! Original 08/01/96
!! Updated PM
!! Modification (N. Asencio) 18/06/99 : the two first dimensions of PMASK
-!! are linked to the horizontal grid, FMWRIT is called with 'XY' argument.
-!! In standard configuration of the budgets, the mask is written once
+!! are linked to the horizontal grid, FMWRIT is called with 'XY' argument.
+!! In standard configuration of the budgets, the mask is written once
!! outside this routine with FMWRIT call. Its record name is 'MASK_nnnn.MASK'
!! So optional PMASK is not used .
!! Modification (J. Duron) 24/06/99 : add logical GPACK to disable the pack option,
!! add the initialization of the dimensions of
-!! MASK array in MASK case with write outside the
+!! MASK array in MASK case with write outside the
!! routine.
!! J.Escobar 02/10/2015 modif for JPHEXT(JPVEXT) variable
!! D.Gazen+ G.Delautier 06/2016 modif for ncl files
!! P. Wautelet 09/06/2017: name of the variable added to the name of the written field
!! and better comment (true comment + units)
!! 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
+! P. Wautelet 13/09/2019: remove never used PMASK optional dummy-argument
+! P. Wautelet 28/08/2020: remove TPLUOUTDIA dummy argument
+! P. Wautelet 09/10/2020: use new data type tpfields
+! P. Wautelet 08/12/2020: merge budgets terms with different nbutshift in same group variables
+! P. Wautelet 03/03/2021: add tbudiachrometadata type (useful to pass more information to Write_diachro)
+! P. Wautelet 11/03/2021: remove ptrajx/y/z optional dummy arguments of Write_diachro
+! + get the trajectory data for LFI files differently
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_BUDGET
-USE MODD_CONF
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_PARAMETERS, ONLY: JPHEXT
-!
-USE MODE_FIELD
-USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Field_write_box
-USE MODE_ll
-!
-USE MODI_MENU_DIACHRO
+use modd_aircraft_balloon, only: flyer
+use modd_budget, only: tbudiachrometadata
+use modd_conf, only: lpack
+use modd_field, only: tfield_metadata_base
+use modd_io, only: tfiledata
+use modd_type_date, only: date_time
!
IMPLICIT NONE
!
!* 0.1 Dummy arguments
! ---------------
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
-TYPE(TFILEDATA), INTENT(IN) :: TPLUOUTDIA
-CHARACTER(LEN=*), INTENT(IN) :: HGROUP, HTYPE
-INTEGER,DIMENSION(:), INTENT(IN) :: KGRID
-REAL,DIMENSION(:,:), INTENT(IN) :: PDATIME
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PVAR
-REAL,DIMENSION(:,:), INTENT(IN) :: PTRAJT
-CHARACTER(LEN=*),DIMENSION(:),INTENT(IN) :: HTITRE, HUNITE, HCOMMENT
-LOGICAL, INTENT(IN),OPTIONAL :: OICP, OJCP, OKCP
-INTEGER, INTENT(IN),OPTIONAL :: KIL, KIH
-INTEGER, INTENT(IN),OPTIONAL :: KJL, KJH
-INTEGER, INTENT(IN),OPTIONAL :: KKL, KKH
-REAL,DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PTRAJX
-REAL,DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PTRAJY
-REAL,DIMENSION(:,:,:), INTENT(IN),OPTIONAL :: PTRAJZ
-REAL,DIMENSION(:,:,:,:,:,:), INTENT(IN),OPTIONAL :: PMASK
+TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
+type(tbudiachrometadata), intent(in) :: tpbudiachro
+class(tfield_metadata_base), dimension(:), intent(in) :: tpfields
+type(date_time), dimension(:), intent(in) :: tpdates !Used only for LFI files
+REAL, DIMENSION(:,:,:,:,:,:), INTENT(IN) :: PVAR
+logical, intent(in), optional :: osplit
+type(flyer), intent(in), optional :: tpflyer
!
!* 0.1 Local variables
! ---------------
+logical :: gpack
+!------------------------------------------------------------------------------
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Write_diachro', 'called' )
+
+gpack = lpack
+lpack = .false.
+
+#ifdef MNH_IOLFI
+if ( tpdiafile%cformat == 'LFI' .or. tpdiafile%cformat == 'LFICDF4' ) &
+ call Write_diachro_lfi( tpdiafile, tpbudiachro, tpfields, tpdates, pvar, tpflyer )
+#endif
+
+#ifdef MNH_IOCDF4
+if ( tpdiafile%cformat == 'NETCDF4' .or. tpdiafile%cformat == 'LFICDF4' ) &
+ call Write_diachro_nc4( tpdiafile, tpbudiachro, tpfields, pvar, osplit, tpflyer )
+#endif
+
+lpack = gpack
+
+end subroutine Write_diachro
+
+#ifdef MNH_IOLFI
+!-----------------------------------------------------------------------------
+subroutine Write_diachro_lfi( tpdiafile, tpbudiachro, tpfields, tpdates, pvar, tpflyer )
+
+use modd_aircraft_balloon, only: flyer
+use modd_budget, only: NLVL_CATEGORY, NLVL_GROUP, NLVL_SHAPE, nbumask, nbutshift, nbusubwrite, tbudiachrometadata
+use modd_field, only: NMNHDIM_ONE, NMNHDIM_UNKNOWN, NMNHDIM_BUDGET_LES_MASK, &
+ NMNHDIM_FLYER_TIME, NMNHDIM_NOTLISTED, NMNHDIM_UNUSED, &
+ TYPECHAR, TYPEINT, TYPEREAL, &
+ tfield_metadata_base, tfielddata
+use modd_io, only: tfiledata
+use modd_les, only: nles_current_iinf, nles_current_isup, nles_current_jinf, nles_current_jsup, &
+ nles_k, xles_current_z
+use modd_parameters, only: jphext
+use modd_time, only: tdtexp, tdtseg
+use modd_time_n, only: tdtmod
+use modd_type_date, only: date_time
+
+use mode_datetime, only: Datetime_distance
+use mode_io_field_write, only: IO_Field_write, IO_Field_write_box
+use mode_menu_diachro, only: Menu_diachro
+use mode_tools_ll, only: Get_globaldims_ll
+
+
+type(tfiledata), intent(in) :: tpdiafile ! File to write
+type(tbudiachrometadata), intent(in) :: tpbudiachro
+class(tfield_metadata_base), dimension(:), intent(in) :: tpfields
+type(date_time), dimension(:), intent(in) :: tpdates
+real, dimension(:,:,:,:,:,:), intent(in) :: pvar
+type(flyer), intent(in), optional :: tpflyer
+
+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
+character(len=:), allocatable :: ygroup
+character(len=LFITITLELGT), dimension(:), allocatable :: ytitles !Used to respect LFI fileformat
+character(len=LFIUNITLGT), dimension(:), allocatable :: yunits !Used to respect LFI fileformat
+character(len=LFICOMMENTLGT), dimension(:), allocatable :: ycomments !Used to respect LFI fileformat
INTEGER :: ILENG, ILENTITRE, ILENUNITE, ILENCOMMENT
-INTEGER :: ILUOUTDIA
+integer :: iil, iih, ijl, ijh, ikl, ikh
+integer :: idx
INTEGER :: II, IJ, IK, IT, IN, IP, J, JJ
INTEGER :: INTRAJT, IKTRAJX, IKTRAJY, IKTRAJZ
INTEGER :: ITTRAJX, ITTRAJY, ITTRAJZ
INTEGER :: INTRAJX, INTRAJY, INTRAJZ
INTEGER :: IIMASK, IJMASK, IKMASK, ITMASK, INMASK, IPMASK
-INTEGER :: ICOMPX, ICOMPY, ICOMPZ
INTEGER :: IIMAX_ll, IJMAX_ll ! size of the physical global domain
+integer :: ji
INTEGER,DIMENSION(:),ALLOCATABLE :: ITABCHAR
-LOGICAL :: GPACK
-TYPE(TFIELDDATA) :: TZFIELD
-!------------------------------------------------------------------------------
-!
-GPACK=LPACK
-LPACK=.FALSE.
+logical :: gdistributed
+real, dimension(:,:), allocatable :: ztimes
+real, dimension(:,:), allocatable :: zdatime
+real, dimension(:,:,:), allocatable :: ztrajz
+TYPE(TFIELDDATA) :: TZFIELD
+type(tfiledata) :: tzfile
+
+call Print_msg( NVERB_DEBUG, 'BUD', 'Write_diachro_lfi', 'called' )
+
+tzfile = tpdiafile
+
+iil = tpbudiachro%nil
+iih = tpbudiachro%nih
+ijl = tpbudiachro%njl
+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'
-!
-ILUOUTDIA = TPLUOUTDIA%NLU
-!
-! BUG ...ca passe que si PRESENT(OICP) sinon OICP non defini
-! Question: doit-on mettre condition comme:
-! IF(HTYPE == 'CART' .AND. .NOT. PRESENT(OICP) .AND. .NOT. PRESENT(OJCP)) THEN
-! en attendant correction on debranche avec un IF Present. ENDIF av
-! RETURN
-IF (PRESENT(OICP) .AND. PRESENT(OJCP)) THEN
- IF(HTYPE == 'CART' .AND. .NOT. OICP .AND. .NOT. OJCP) THEN
- !for parallel execution, PVAR is distributed on several proc
- II=KIH-KIL+1
- IJ=KJH-KJL+1
- ELSE
- II = SIZE(PVAR,1)
- IJ = SIZE(PVAR,2)
- ENDIF
-ELSE
- II = SIZE(PVAR,1)
- IJ = SIZE(PVAR,2)
+!Set ygroup to preserve backward compatibility of LFI files
+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%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 )
-ENDIF
+ 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 if ( tpbudiachro%clevels(NLVL_CATEGORY) == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_GROUP)(1:3)/='BU_' ) then
+ if ( tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_LES_MASK ) then
+ !Remove the name of the mask (different for each 'process') to get the common name for the group
+ idx = Index( tpfields(1)%cmnhname, ' ' )
+ if ( idx > 0 ) then
+ ygroup = tpfields(1)%cmnhname(1:idx- 1)
+ else
+ ygroup = Trim( tpfields(1)%cmnhname )
+ end if
+ else
+ ygroup = Trim( tpfields(1)%cmnhname )
+ end if
+else
+ ygroup = Trim( tpbudiachro%clevels(NLVL_GROUP) )
+end if
+
+!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_GROUP) ) == '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 ( 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
+ 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)
IP = SIZE(PVAR,6)
-INTRAJT=SIZE(PTRAJT,2)
+INTRAJT=SIZE(tpdates)
IKTRAJX=0; IKTRAJY=0; IKTRAJZ=0
ITTRAJX=0; ITTRAJY=0; ITTRAJZ=0
INTRAJX=0; INTRAJY=0; INTRAJZ=0
-IF(PRESENT(PTRAJX))THEN
- IKTRAJX=SIZE(PTRAJX,1)
- ITTRAJX=SIZE(PTRAJX,2)
- INTRAJX=SIZE(PTRAJX,3)
+IF ( PRESENT( tpflyer ) ) THEN
+ IKTRAJX = 1
+ ITTRAJX = SIZE( tpflyer%x )
+ INTRAJX = 1
+ELSE IF ( ycategory == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' ) THEN
+ IKTRAJX = 1
+ ITTRAJX = 1
+ INTRAJX = IN
ENDIF
-IF(PRESENT(PTRAJY))THEN
- IKTRAJY=SIZE(PTRAJY,1)
- ITTRAJY=SIZE(PTRAJY,2)
- INTRAJY=SIZE(PTRAJY,3)
+IF ( PRESENT( tpflyer ) ) THEN
+ IKTRAJY = 1
+ ITTRAJY = SIZE( tpflyer%y )
+ INTRAJY = 1
+ELSE IF ( ycategory == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' ) THEN
+ IKTRAJY = 1
+ ITTRAJY = 1
+ INTRAJY = IN
ENDIF
-IF(PRESENT(PTRAJZ))THEN
- IKTRAJZ=SIZE(PTRAJZ,1)
- ITTRAJZ=SIZE(PTRAJZ,2)
- INTRAJZ=SIZE(PTRAJZ,3)
+IF ( PRESENT( tpflyer ) ) THEN
+ IKTRAJZ = 1
+ ITTRAJZ = SIZE( tpflyer%z )
+ INTRAJZ = 1
+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(HTYPE == '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)
IIMASK=IIMAX_ll + 2 * JPHEXT
IJMASK=IJMAX_ll + 2 * JPHEXT
- IF(PRESENT(PMASK))THEN
- IKMASK=SIZE(PMASK,3)
- ITMASK=SIZE(PMASK,4)
- INMASK=SIZE(PMASK,5)
- IPMASK=SIZE(PMASK,6)
- ELSE
- IKMASK=1
- ITMASK=NBUWRNB
- INMASK=NBUMASK
- IPMASK=1
- ENDIF
+ IKMASK=1
+ ITMASK=nbusubwrite
+ INMASK=NBUMASK
+ IPMASK=1
ENDIF
-ILENTITRE = LEN(HTITRE)
-ILENUNITE = LEN(HUNITE)
-ILENCOMMENT = LEN(HCOMMENT)
-
-ICOMPX=0; ICOMPY=0; ICOMPZ=0
-IF(PRESENT(OICP))THEN
-IF(OICP)THEN
- ICOMPX=1
-ENDIF
-IF(OJCP)THEN
- ICOMPY=1
-ENDIF
-IF(OKCP)THEN
- ICOMPZ=1
-ENDIF
-ENDIF
-!
-IF (NVERB>=5) THEN
- WRITE(ILUOUTDIA,*)' WRITE_DIACHRO: ',TRIM(TPDIAFILE%CNAME)//'.lfi'
-ENDIF
+ILENTITRE = LFITITLELGT
+ILENUNITE = LFIUNITLGT
+ILENCOMMENT = LFICOMMENTLGT
!
! 1er enregistrement TYPE
!
-TZFIELD%CMNHNAME = TRIM(HGROUP)//'.TYPE'
+TZFIELD%CMNHNAME = TRIM(ygroup)//'.TYPE'
TZFIELD%CSTDNAME = ''
-TZFIELD%CLONGNAME = TRIM(HGROUP)//'.TYPE'
+TZFIELD%CLONGNAME = TRIM(ygroup)//'.TYPE'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 0
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPDIAFILE,TZFIELD,HTYPE)
-
-IF (NVERB>=5) THEN
- WRITE(ILUOUTDIA,*)' 1st record (',TRIM(TZFIELD%CMNHNAME),'): OK'
-ENDIF
+CALL IO_Field_write(tzfile,TZFIELD,YTYPE)
!
! 2eme enregistrement DIMENSIONS des MATRICES et LONGUEUR des TABLEAUX de CARACTERES et FLAGS de COMPRESSION sur les DIFFERENTS AXES
!
-TZFIELD%CMNHNAME = TRIM(HGROUP)//'.DIM'
+TZFIELD%CMNHNAME = TRIM(ygroup)//'.DIM'
TZFIELD%CSTDNAME = ''
-TZFIELD%CLONGNAME = TRIM(HGROUP)//'.DIM'
+TZFIELD%CLONGNAME = TRIM(ygroup)//'.DIM'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEINT
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
-SELECT CASE(HTYPE)
+SELECT CASE(YTYPE)
CASE('CART','MASK','SPXY')
+ 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_lfi', &
+ 'nil, nih, njl, njh, nkl or nkh not set in tpbudiachro for variable ' // Trim( tpfields(1)%cmnhname ) )
+ end if
ILENG = 34
ALLOCATE(ITABCHAR(ILENG))
ITABCHAR(1)=ILENTITRE; ITABCHAR(2)=ILENUNITE
ITABCHAR(3)=ILENCOMMENT; ITABCHAR(4)=II
ITABCHAR(5)=IJ; ITABCHAR(6)=IK
ITABCHAR(7)=IT; ITABCHAR(8)=IN
- ITABCHAR(9)=IP; ITABCHAR(10)=KIL
- ITABCHAR(11)=KJL; ITABCHAR(12)=KKL
- ITABCHAR(13)=KIH; ITABCHAR(14)=KJH
- ITABCHAR(15)=KKH; ITABCHAR(16)=ICOMPX
- ITABCHAR(17)=ICOMPY; ITABCHAR(18)=ICOMPZ
- IF(HTYPE == 'MASK')THEN
+ ITABCHAR(9)=IP; ITABCHAR(10)=iil
+ ITABCHAR(11)=ijl; ITABCHAR(12)=ikl
+ ITABCHAR(13)=iih; ITABCHAR(14)=ijh
+ ITABCHAR(15)=ikh
+ ITABCHAR(16)=Merge( 1, 0, tpbudiachro%licompress )
+ ITABCHAR(17)=Merge( 1, 0, tpbudiachro%ljcompress )
+ ITABCHAR(18)=Merge( 1, 0, tpbudiachro%lkcompress )
+ 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
@@ -272,13 +464,10 @@ SELECT CASE(HTYPE)
ITABCHAR(29)=IIMASK; ITABCHAR(30)=IJMASK
ITABCHAR(31)=IKMASK; ITABCHAR(32)=ITMASK
ITABCHAR(33)=INMASK; ITABCHAR(34)=IPMASK
- CALL IO_Field_write(TPDIAFILE,TZFIELD,ITABCHAR)
+ CALL IO_Field_write(tzfile,TZFIELD,ITABCHAR)
DEALLOCATE(ITABCHAR)
- IF (NVERB>=5) THEN
- WRITE(ILUOUTDIA,*)' ILENTITRE,ILENUNITE,ILENCOMMENT ',ILENTITRE,ILENUNITE,ILENCOMMENT
- ENDIF
CASE DEFAULT
- ILENG = 25
+ ILENG = 25
ALLOCATE(ITABCHAR(ILENG))
ITABCHAR(1)=ILENTITRE; ITABCHAR(2)=ILENUNITE
ITABCHAR(3)=ILENCOMMENT; ITABCHAR(4)=II
@@ -293,236 +482,1541 @@ SELECT CASE(HTYPE)
ITABCHAR(20)=IIMASK; ITABCHAR(21)=IJMASK
ITABCHAR(22)=IKMASK; ITABCHAR(23)=ITMASK
ITABCHAR(24)=INMASK; ITABCHAR(25)=IPMASK
- CALL IO_Field_write(TPDIAFILE,TZFIELD,ITABCHAR)
+ CALL IO_Field_write(tzfile,TZFIELD,ITABCHAR)
DEALLOCATE(ITABCHAR)
END SELECT
-IF (NVERB>=5) THEN
- WRITE(ILUOUTDIA,*)' 2nd record (',TRIM(TZFIELD%CMNHNAME),'): OK'
-ENDIF
!
! 3eme enregistrement TITRE
!
-TZFIELD%CMNHNAME = TRIM(HGROUP)//'.TITRE'
+TZFIELD%CMNHNAME = TRIM(ygroup)//'.TITRE'
TZFIELD%CSTDNAME = ''
-TZFIELD%CLONGNAME = TRIM(HGROUP)//'.TITRE'
+TZFIELD%CLONGNAME = TRIM(ygroup)//'.TITRE'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPDIAFILE,TZFIELD,HTITRE(1:IP))
-
-IF (NVERB>=5) THEN
- WRITE(ILUOUTDIA,*)' 3rd record (',TRIM(TZFIELD%CMNHNAME),'): OK'
-ENDIF
+allocate( ytitles( ip ) )
+ytitles(:) = tpfields(1 : ip)%cmnhname
+CALL IO_Field_write(tzfile,TZFIELD,ytitles(:))
+deallocate( ytitles )
!
! 4eme enregistrement UNITE
!
-TZFIELD%CMNHNAME = TRIM(HGROUP)//'.UNITE'
+TZFIELD%CMNHNAME = TRIM(ygroup)//'.UNITE'
TZFIELD%CSTDNAME = ''
-TZFIELD%CLONGNAME = TRIM(HGROUP)//'.UNITE'
+TZFIELD%CLONGNAME = TRIM(ygroup)//'.UNITE'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPDIAFILE,TZFIELD,HUNITE(1:IP))
-
-IF (NVERB>=5) THEN
- WRITE(ILUOUTDIA,*)' 4th record (',TRIM(TZFIELD%CMNHNAME),'): OK'
-ENDIF
+allocate( yunits( ip ) )
+yunits(:) = tpfields(1 : ip)%cunits
+CALL IO_Field_write(tzfile,TZFIELD,yunits(:))
+deallocate( yunits )
!
! 5eme enregistrement COMMENT
!
-TZFIELD%CMNHNAME = TRIM(HGROUP)//'.COMMENT'
+TZFIELD%CMNHNAME = TRIM(ygroup)//'.COMMENT'
TZFIELD%CSTDNAME = ''
-TZFIELD%CLONGNAME = TRIM(HGROUP)//'.COMMENT'
+TZFIELD%CLONGNAME = TRIM(ygroup)//'.COMMENT'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPECHAR
TZFIELD%NDIMS = 1
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPDIAFILE,TZFIELD,HCOMMENT(1:IP))
-
-IF (NVERB>=5) THEN
- WRITE(ILUOUTDIA,*)' 5th record (',TRIM(TZFIELD%CMNHNAME),'): OK'
-ENDIF
+allocate( ycomments( ip ) )
+ycomments(:) = tpfields(1 : ip)%ccomment
+CALL IO_Field_write(tzfile,TZFIELD,ycomments(:))
+deallocate( ycomments )
!
! 6eme enregistrement PVAR
!
-! Dans la mesure ou cette matrice risque d'etre tres volumineuse, on ecrira un
+! Dans la mesure ou cette matrice risque d'etre tres volumineuse, on ecrira un
! enregistrement par processus
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
-!ocl scalar
-!!!!!!!!!!!!!!!! FUJI compiler directive !!!!!!!!!!
DO J = 1,IP
+ if ( All( tpfields(1)%ndimlist(:) /= NMNHDIM_UNKNOWN ) ) then
+ tzfield%ndimlist(1:5) = tpfields(j)%ndimlist(1:5)
+ do jj = 1, 5
+ if ( tzfield%ndimlist(jj) == NMNHDIM_UNUSED ) then
+ tzfield%ndimlist(jj) = NMNHDIM_ONE
+ end if
+ end do
+ if ( tzfield%ndimlist(4) == NMNHDIM_FLYER_TIME ) tzfield%ndimlist(4) = NMNHDIM_NOTLISTED
+ tzfield%ndimlist(6:) = NMNHDIM_UNUSED
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_lfi', &
+ 'some dimensions are unknown for variable '//trim(tpfields(1)%cmnhname) )
+ end if
+
YJ = ' '
IF(J < 10)WRITE(YJ,'(I1)')J ; YJ = ADJUSTL(YJ)
- IF(J >= 10 .AND. J < 100) THEN
+ IF(J >= 10 .AND. J < 100) THEN
WRITE(YJ,'(I2)')J ; YJ = ADJUSTL(YJ)
- ELSE IF(J >= 100 .AND. J < 1000) THEN
+ ELSE IF(J >= 100 .AND. J < 1000) THEN
WRITE(YJ,'(I3)')J
ENDIF
-! BUG ...ca passe que si PRESENT(OICP) sinon OICP non defini
-IF (PRESENT(OICP) .AND. PRESENT(OJCP)) THEN
- IF(HTYPE == 'CART' .AND. .NOT. OICP .AND. .NOT. OJCP) THEN
- TZFIELD%CMNHNAME = TRIM(HGROUP)//'.PROC'//YJ
+ IF ( gdistributed ) THEN
+ TZFIELD%CMNHNAME = TRIM(ygroup)//'.PROC'//YJ
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = TRIM(HUNITE(J))
+ TZFIELD%CUNITS = tpfields(j)%cunits
TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = TRIM(HTITRE(J))//' - '//TRIM(HCOMMENT(J))//' ('//TRIM(HUNITE(J))//')'
- TZFIELD%NGRID = KGRID(J)
+ TZFIELD%CCOMMENT = TRIM(tpfields(j)%cmnhname)//' - '//TRIM(tpfields(j)%ccomment)//' ('// Trim( tpfields(j)%cunits ) //')'
+ TZFIELD%NGRID = tpfields(j)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 5
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write_BOX(TPDIAFILE,TZFIELD,'BUDGET',PVAR(:,:,:,:,:,J), &
- KIL+JPHEXT,KIH+JPHEXT,KJL+JPHEXT,KJH+JPHEXT)
+
+ CALL IO_Field_write_BOX(tzfile,TZFIELD,'BUDGET',PVAR(:,:,:,:,:,J), &
+ iil+JPHEXT,iih+JPHEXT,ijl+JPHEXT,ijh+JPHEXT)
ELSE
- TZFIELD%CMNHNAME = TRIM(HGROUP)//'.PROC'//YJ
+ TZFIELD%CMNHNAME = TRIM(ygroup)//'.PROC'//YJ
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = TRIM(HUNITE(J))
+ TZFIELD%CUNITS = tpfields(j)%cunits
TZFIELD%CDIR = '--'
- TZFIELD%CCOMMENT = TRIM(HTITRE(J))//' - '//TRIM(HCOMMENT(J))//' ('//TRIM(HUNITE(J))//')'
- TZFIELD%NGRID = KGRID(J)
+ TZFIELD%CCOMMENT = TRIM(tpfields(j)%cmnhname)//' - '//TRIM(tpfields(j)%ccomment)//' ('// Trim( tpfields(j)%cunits ) //')'
+ TZFIELD%NGRID = tpfields(j)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 5
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write(TPDIAFILE,TZFIELD,PVAR(:,:,:,:,:,J))
- ENDIF
-ELSE
- TZFIELD%CMNHNAME = TRIM(HGROUP)//'.PROC'//YJ
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CUNITS = TRIM(HUNITE(J))
- TZFIELD%CDIR = '--'
- TZFIELD%CCOMMENT = TRIM(HTITRE(J))//' - '//TRIM(HCOMMENT(J))//' ('//TRIM(HUNITE(J))//')'
- TZFIELD%NGRID = KGRID(J)
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 5
- TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write(TPDIAFILE,TZFIELD,PVAR(:,:,:,:,:,J))
-END IF
- IF (NVERB>=5) THEN
- WRITE(ILUOUTDIA,*)J,TRIM(TZFIELD%CMNHNAME)
+
+ CALL IO_Field_write(tzfile,TZFIELD,PVAR(:,:,:,:,:,J))
ENDIF
+ tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
ENDDO
-IF (NVERB>=5) THEN
- WRITE(ILUOUTDIA,*)' 6th record: OK'
-ENDIF
!
! 7eme enregistrement TRAJT
!
-TZFIELD%CMNHNAME = TRIM(HGROUP)//'.TRAJT'
+TZFIELD%CMNHNAME = TRIM(ygroup)//'.TRAJT'
TZFIELD%CSTDNAME = ''
-TZFIELD%CLONGNAME = TRIM(HGROUP)//'.TRAJT'
+TZFIELD%CLONGNAME = TRIM(ygroup)//'.TRAJT'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPDIAFILE,TZFIELD,PTRAJT)
-IF (NVERB>=5) THEN
- WRITE(ILUOUTDIA,*)' 7th record (',TRIM(TZFIELD%CMNHNAME),'): OK'
-ENDIF
+!NMNHDIM_FLYER_TIME excluded because created only in netCDF/HDF groups (local to each flyer)
+if ( tpfields(1)%ndimlist(4) /= NMNHDIM_UNKNOWN .and. tpfields(1)%ndimlist(4) /= NMNHDIM_UNUSED &
+ .and. tpfields(1)%ndimlist(4) /= NMNHDIM_FLYER_TIME ) then
+ tzfield%ndimlist(1) = tpfields(1)%ndimlist(4)
+ tzfield%ndimlist(2) = NMNHDIM_ONE
+ tzfield%ndimlist(3:) = NMNHDIM_UNUSED
+end if
+
+!Reconstitute old diachro format
+allocate( ztimes( size( tpdates ), 1 ) )
+
+do ji=1,size(tpdates)
+ call Datetime_distance( tdtexp, tpdates(ji ), ztimes(ji, 1 ) )
+end do
+
+call IO_Field_write( tzfile, tzfield, ztimes )
+
+!Reset ndimlist
+tzfield%ndimlist(:) = NMNHDIM_UNKNOWN
+
+deallocate( ztimes )
!
! Dans certains cas
!
!
! 8eme enregistrement TRAJX
!
-IF(PRESENT(PTRAJX))THEN
- TZFIELD%CMNHNAME = TRIM(HGROUP)//'.TRAJX'
+IF(PRESENT(tpflyer))THEN
+ TZFIELD%CMNHNAME = TRIM(ygroup)//'.TRAJX'
TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = TRIM(HGROUP)//'.TRAJX'
+ TZFIELD%CLONGNAME = TRIM(ygroup)//'.TRAJX'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
- TZFIELD%NGRID = KGRID(1)
+ TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write(TPDIAFILE,TZFIELD,PTRAJX)
-ENDIF
-!
-! ou
-!
-IF(PRESENT(PMASK))THEN
- TZFIELD%CMNHNAME = TRIM(HGROUP)//'.MASK'
+ CALL IO_Field_write(tzfile,TZFIELD, Reshape( tpflyer%x, [1, Size( tpflyer%x), 1] ) )
+ELSE IF ( ycategory == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' ) THEN
+ TZFIELD%CMNHNAME = TRIM(ygroup)//'.TRAJX'
TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = TRIM(HGROUP)//'.MASK'
+ TZFIELD%CLONGNAME = TRIM(ygroup)//'.TRAJX'
TZFIELD%CUNITS = ''
- TZFIELD%CDIR = 'XY'
+ TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
- TZFIELD%NGRID = KGRID(1)
+ TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 6
+ TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write(TPDIAFILE,TZFIELD,PMASK)
+ !TRAJX is given in extended domain coordinates (=> +jphext) for backward compatibility
+ 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] ) ) )
ENDIF
!
! 9eme enregistrement TRAJY
!
-IF(PRESENT(PTRAJY))THEN
- TZFIELD%CMNHNAME = TRIM(HGROUP)//'.TRAJY'
+IF(PRESENT(tpflyer))THEN
+ TZFIELD%CMNHNAME = TRIM(ygroup)//'.TRAJY'
TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = TRIM(HGROUP)//'.TRAJY'
+ TZFIELD%CLONGNAME = TRIM(ygroup)//'.TRAJY'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
- TZFIELD%NGRID = KGRID(1)
+ TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write(TPDIAFILE,TZFIELD,PTRAJY)
+ CALL IO_Field_write(tzfile,TZFIELD, Reshape( tpflyer%y, [1, Size( tpflyer%y), 1] ) )
+ELSE IF ( ycategory == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' ) THEN
+ TZFIELD%CMNHNAME = TRIM(ygroup)//'.TRAJY'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM(ygroup)//'.TRAJY'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = TRIM(YCOMMENT)
+ TZFIELD%NGRID = tpfields(1)%ngrid
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .FALSE.
+ !TRAJY is given in extended domain coordinates (=> +jphext) for backward compatibility
+ 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] ) ) )
ENDIF
!
! 10eme enregistrement TRAJZ
!
-IF(PRESENT(PTRAJZ))THEN
- TZFIELD%CMNHNAME = TRIM(HGROUP)//'.TRAJZ'
+IF(PRESENT(tpflyer))THEN
+ TZFIELD%CMNHNAME = TRIM(ygroup)//'.TRAJZ'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = TRIM(ygroup)//'.TRAJZ'
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = TRIM(YCOMMENT)
+ TZFIELD%NGRID = tpfields(1)%ngrid
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .FALSE.
+ CALL IO_Field_write(tzfile,TZFIELD, Reshape( tpflyer%z, [1, Size( tpflyer%z), 1] ) )
+ELSE IF ( ycategory == 'LES_budgets' .and. tpbudiachro%clevels(NLVL_SHAPE) == 'Cartesian' ) THEN
+ TZFIELD%CMNHNAME = TRIM(ygroup)//'.TRAJZ'
TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = TRIM(HGROUP)//'.TRAJZ'
+ TZFIELD%CLONGNAME = TRIM(ygroup)//'.TRAJZ'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
- TZFIELD%NGRID = KGRID(1)
+ TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 3
TZFIELD%LTIMEDEP = .FALSE.
- CALL IO_Field_write(TPDIAFILE,TZFIELD,PTRAJZ)
+
+ Allocate( ztrajz(IK, 1, IN) )
+ do jj = 1, IK
+ ztrajz(jj, :, :) = xles_current_z(jj)
+ end do
+ CALL IO_Field_write(tzfile,TZFIELD,ztrajz)
+ Deallocate( ztrajz )
ENDIF
!
! 11eme enregistrement PDATIME
!
-TZFIELD%CMNHNAME = TRIM(HGROUP)//'.DATIM'
+TZFIELD%CMNHNAME = TRIM(ygroup)//'.DATIM'
TZFIELD%CSTDNAME = ''
-TZFIELD%CLONGNAME = TRIM(HGROUP)//'.DATIM'
+TZFIELD%CLONGNAME = TRIM(ygroup)//'.DATIM'
TZFIELD%CUNITS = ''
TZFIELD%CDIR = '--'
TZFIELD%CCOMMENT = TRIM(YCOMMENT)
-TZFIELD%NGRID = KGRID(1)
+TZFIELD%NGRID = tpfields(1)%ngrid
TZFIELD%NTYPE = TYPEREAL
TZFIELD%NDIMS = 2
TZFIELD%LTIMEDEP = .FALSE.
-CALL IO_Field_write(TPDIAFILE,TZFIELD,PDATIME)
-!
-CALL MENU_DIACHRO(TPDIAFILE,HGROUP)
-LPACK=GPACK
+
+!Reconstitute old diachro format
+allocate( zdatime( 16, size(tpdates) ) )
+
+zdatime(1, : ) = tdtexp%nyear
+zdatime(2, : ) = tdtexp%nmonth
+zdatime(3, : ) = tdtexp%nday
+zdatime(4, : ) = tdtexp%xtime
+zdatime(5, : ) = tdtseg%nyear
+zdatime(6, : ) = tdtseg%nmonth
+zdatime(7, : ) = tdtseg%nday
+zdatime(8, : ) = tdtseg%xtime
+zdatime(9, : ) = tdtmod%nyear
+zdatime(10, : ) = tdtmod%nmonth
+zdatime(11, : ) = tdtmod%nday
+zdatime(12, : ) = tdtmod%xtime
+zdatime(13, : ) = tpdates(:)%nyear
+zdatime(14, : ) = tpdates(:)%nmonth
+zdatime(15, : ) = tpdates(:)%nday
+zdatime(16, : ) = tpdates(:)%xtime
+
+call IO_Field_write( tzfile, tzfield, zdatime )
+
+deallocate( zdatime )
+
+call Menu_diachro( tzfile, ygroup )
+
+end subroutine Write_diachro_lfi
+#endif
+
+#ifdef MNH_IOCDF4
!-----------------------------------------------------------------------------
-!
-!* 2. EXITS
-! -----
-!
-RETURN
-END SUBROUTINE WRITE_DIACHRO
+subroutine Write_diachro_nc4( tpdiafile, tpbudiachro, tpfields, pvar, osplit, tpflyer )
+
+use NETCDF, only: NF90_DEF_DIM, NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION, NF90_NOERR
+
+use modd_aircraft_balloon, only: flyer
+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: 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
+
+use mode_io_field_write, only: IO_Field_create, IO_Field_write, IO_Field_write_box
+use mode_io_tools_nc4, only: IO_Err_handle_nc4
+
+type(tfiledata), intent(in) :: tpdiafile ! File to write
+type(tbudiachrometadata), intent(in) :: tpbudiachro
+class(tfield_metadata_base), dimension(:), intent(in) :: tpfields
+real, dimension(:,:,:,:,:,:), intent(in) :: pvar
+logical, intent(in), optional :: osplit
+type(flyer), intent(in), optional :: tpflyer
+
+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 :: 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, 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'
+
+ycategory = Trim( tpbudiachro%clevels(NLVL_CATEGORY) )
+yshape = Trim( tpbudiachro%clevels(NLVL_SHAPE) )
+
+iil = tpbudiachro%nil
+iih = tpbudiachro%nih
+ijl = tpbudiachro%njl
+ijh = tpbudiachro%njh
+ikl = tpbudiachro%nkl
+ikh = tpbudiachro%nkh
+
+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
+ gdistributed = .false.
+end if
+
+if ( Present( osplit ) ) then
+ gsplit = osplit
+else
+ gsplit = .false.
+end if
+
+MASTER: if ( isp == tzfile%nmaster_rank) then
+ ilevelids(NLVL_ROOT) = tzfile%nncid
+
+ 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 = ''
+
+ 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. gleveldefined(NLVL_CATEGORY) ) then
+ ylevelname = tpbudiachro%clevels(NLVL_CATEGORY)
+ ilevelid = ilevelids (NLVL_CATEGORY)
+
+ 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) )
+
+ if ( ycategory == 'LES_budgets' ) &
+ call Att_write( ylevelname, ilevelid, 'temporal_sampling_frequency', xles_temp_sampling )
+ end if
+
+ if ( .not. gleveldefined(NLVL_SUBCATEGORY) ) then
+ ylevelname = tpbudiachro%clevels(NLVL_SUBCATEGORY)
+ ilevelid = ilevelids (NLVL_SUBCATEGORY)
+
+ 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
+
+ if ( .not. gleveldefined(NLVL_GROUP) ) then
+ ylevelname = tpbudiachro%clevels(NLVL_GROUP)
+ ilevelid = ilevelids (NLVL_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
+
+ 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
+
+ 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 ( ( 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 ( .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
+
+ 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 )
+ if ( Any( tpfields(jp)%ndimlist(:) == NMNHDIM_UNKNOWN ) ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', &
+ 'some dimensions are unknown for variable '//trim(tpfields(jp)%cmnhname) )
+
+ icount = Count( tpfields(jp)%ndimlist(:) /= NMNHDIM_UNUSED )
+
+ if ( tpfields(jp)%ndims /= icount ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', &
+ 'ndims is not coherent with ndimlist for variable '//trim(tpfields(jp)%cmnhname) )
+
+ if ( jp == 1 ) then
+ idims = icount
+ else
+ if ( idims /= icount ) &
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', &
+ 'number of dimensions not the same for all tpfields for variable '//trim(tpfields(jp)%cmnhname) )
+ end if
+end do
+
+!The dimension list should be the same for all tpfields entries
+do jp = 2, Size( tpfields )
+ do ji = 1, NMNHMAXDIMS
+ if ( tpfields(jp)%ndimlist(ji) /= tpfields(1)%ndimlist(ji) ) then
+ !For SERIES: it is possible to have NMNHDIM_NI and NMNHDIM_NI_U in the different tpfields
+ !For SERIES: it is possible to have NMNHDIM_SERIES_LEVEL and NMNHDIM_SERIES_LEVEL_W in the different tpfields
+ if ( tpfields(jp)%ndimlist(ji) /= NMNHDIM_NI .and. tpfields(jp)%ndimlist(ji) /= NMNHDIM_NI_U .and. &
+ tpfields(jp)%ndimlist(ji) /= NMNHDIM_SERIES_LEVEL .and. tpfields(jp)%ndimlist(ji) /= NMNHDIM_SERIES_LEVEL_W ) then
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_diachro_nc4', &
+ 'some dimensions are not the same for all tpfields entries for variable '//trim(tpfields(jp)%cmnhname) )
+ end if
+ end if
+ end do
+end do
+
+!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 cartesian shape without horizontal compression for variable ' &
+ // Trim( tpfields(1)%cmnhname ) )
+ end if
+
+ if ( ( tpfields(1)%ndimlist(1) /= NMNHDIM_BUDGET_CART_NI &
+ .and. tpfields(1)%ndimlist(1) /= NMNHDIM_BUDGET_CART_NI_U &
+ .and. tpfields(1)%ndimlist(1) /= NMNHDIM_BUDGET_CART_NI_V ) &
+ .or. ( tpfields(1)%ndimlist(2) /= NMNHDIM_BUDGET_CART_NJ &
+ .and. tpfields(1)%ndimlist(2) /= NMNHDIM_BUDGET_CART_NJ_U &
+ .and. tpfields(1)%ndimlist(2) /= NMNHDIM_BUDGET_CART_NJ_V ) &
+ .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 + 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 ) )
+ end if
+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, tpbudiachro, tpfields(1), pvar, [ integer:: ], gsplit, gdistributed )
+
+ case (1)
+
+ 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, 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, 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, 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, tpbudiachro, tpfields(1), pvar, [ 3 ], gsplit, gdistributed )
+ else if ( tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS .or. tpfields(1)%ndimlist(6) == NMNHDIM_PROFILER_PROC ) 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, 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 (1D variable '//trim(tpfields(1)%cmnhname)//')' )
+ end if
+
+
+ case (2)
+
+ 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 ] ) &
+ .and. 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, 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 ] ) &
+ .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, 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, 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, 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, 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, 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, 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, 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, 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_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, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 4 ], gsplit, gdistributed )
+ end do
+ else if ( tpfields(1)%ndimlist(4) == NMNHDIM_PROFILER_TIME &
+ .and. tpfields(1)%ndimlist(6) == NMNHDIM_PROFILER_PROC ) then
+ !Correspond to WRITE_PROFILER_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 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, 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 (2D variable '//trim(tpfields(1)%cmnhname)//')' )
+ end if
+
+
+ case (3)
+
+ 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 ] ) &
+ .and. 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, 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, 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 ] ) &
+ .and. 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, 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 ] ) &
+ .and. 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, 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 ) &
+ .and. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_TIME &
+ .and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_MASK_NBUMASK ) then
+ !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, 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 &
+ .or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
+ .and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_LES_MASK ) then
+ if ( nles_masks /= Size( pvar, 6 ) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
+ 'last dimension size of pvar is not equal to nles_masks (variable ' &
+ // Trim( tpfields(1)%cmnhname ) // ')' )
+
+ ! Loop on the processes
+ do ji = 1, Size( pvar, 6 )
+ 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 &
+ .or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
+ .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, 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 &
+ .or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
+ .and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_LES_PDF ) 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, tpbudiachro, tpfields(1), pvar, [ 3, 4, 5 ], gsplit, gdistributed )
+ 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 ) &
+ .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, 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 &
+ .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, 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 &
+ .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, 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 &
+ .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_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, 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 &
+ .and. tpfields(1)%ndimlist(6) == NMNHDIM_PROFILER_PROC ) then
+ !Correspond to PROFILER_DIACHRO_n
+ ! Loop on the processes
+ do ji = 1, Size( pvar, 6 )
+ 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 &
+ .and. tpfields(1)%ndimlist(6) == NMNHDIM_SERIES_PROC ) then
+ !Correspond to PROFILER_DIACHRO_n
+ ! Loop on the processes
+ do ji = 1, Size( pvar, 6 )
+ 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 &
+ .and. tpfields(1)%ndimlist(6) == NMNHDIM_SERIES_PROC ) then
+ !Correspond to PROFILER_DIACHRO_n
+ ! Loop on the processes
+ do ji = 1, Size( pvar, 6 )
+ 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, 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, 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 (3D variable '//trim(tpfields(1)%cmnhname)//')' )
+ end if
+
+ case (4)
+
+ 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. Any( tpfields(1)%ndimlist(3) == [ NMNHDIM_BUDGET_CART_LEVEL,NMNHDIM_BUDGET_CART_LEVEL_W ] ) &
+ .and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_NGROUPS ) then
+ !Correspond to Store_one_budget (CART)
+ ! Loop on the processes
+ do ji = 1, Size( pvar, 6 )
+ 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 ) &
+ .and. 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
+ !Correspond to Store_one_budget (MASK)
+ ! Loop on the processes
+ do ji = 1, Size( pvar, 6 )
+ 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 &
+ .or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
+ .and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_LES_SV &
+ .and. tpfields(1)%ndimlist(6) == NMNHDIM_BUDGET_LES_MASK ) then
+ if ( nles_masks /= Size( pvar, 6 ) ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
+ 'last dimension size of pvar is not equal to nles_masks (variable ' &
+ // Trim( tpfields(1)%cmnhname ) // ')' )
+
+ ! Loop on the processes
+ do ji = 1, Size( pvar, 6 )
+ 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 &
+ .or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
+ .and. tpfields(1)%ndimlist(5) == NMNHDIM_BUDGET_LES_SV &
+ .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, 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 &
+ .and. ( tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_TIME &
+ .or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
+ .and. tpfields(1)%ndimlist(5) == NMNHDIM_COMPLEX ) then
+ !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, 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 &
+ .or. tpfields(1)%ndimlist(4) == NMNHDIM_BUDGET_LES_AVG_TIME ) &
+ .and. tpfields(1)%ndimlist(5) == NMNHDIM_COMPLEX ) then
+ !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, tpbudiachro, tpfields(1), pvar, [ 2, 3, 4, 5 ], gsplit, gdistributed )
+ else
+ call Print_msg( NVERB_FATAL, 'IO', 'Write_diachro_nc4', &
+ 'case not yet implemented (4D variable '//trim(tpfields(1)%cmnhname)//')' )
+ end if
+
+! case (5)
+
+! case (6)
+
+ case default
+ do ji = 1, Size( pvar, 6 )
+ call Diachro_one_field_write_nc4( tzfile, tpbudiachro, tpfields(ji), pvar(:,:,:,:,:,ji:ji), [ 1, 2, 3, 4, 5 ], &
+ gsplit, gdistributed )
+ end do
+
+end select
+
+!Write X and Y position of the flyer
+if ( Present( tpflyer ) ) then
+ if ( lcartesian ) then
+ ystdnameprefix = 'plane'
+ else
+ ystdnameprefix = 'projection'
+ endif
+
+ tzfield%cmnhname = 'X'
+ tzfield%cstdname = Trim( ystdnameprefix ) // '_x_coordinate'
+ tzfield%clongname = 'x-position of the flyer'
+ tzfield%cunits = 'm'
+ tzfield%cdir = '--'
+ tzfield%ccomment = ''
+ tzfield%ngrid = 0
+ tzfield%ntype = TYPEREAL
+ tzfield%ltimedep = .false.
+ tzfield%ndims = 1
+ tzfield%ndimlist(1) = NMNHDIM_FLYER_TIME
+ tzfield%ndimlist(2:) = NMNHDIM_UNUSED
+
+ call IO_Field_write( tzfile, tzfield, tpflyer%x )
+
+ tzfield%cmnhname = 'Y'
+ tzfield%cstdname = Trim( ystdnameprefix ) // '_y_coordinate'
+ tzfield%clongname = 'y-position of the flyer'
+
+ call IO_Field_write( tzfile, tzfield, tpflyer%y )
+end if
+
+end subroutine Write_diachro_nc4
+
+
+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
+
+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
+real, dimension(:,:,:,:,:,:), intent(in) :: pvar
+integer, dimension(:), intent(in) :: kdims !List of indices of dimensions to use
+logical, intent(in) :: osplit
+logical, intent(in) :: odistributed !.T. if data is distributed among all processes
+integer, intent(in), optional :: kil, kih
+integer, intent(in), optional :: kjl, kjh
+integer, intent(in), optional :: kkl, kkh
+
+integer :: idims
+integer :: ibutimepos
+integer :: ji
+integer, dimension(size(shape(pvar))) :: isizes_alldims
+integer, dimension(:), allocatable :: ioffset
+integer, dimension(:), allocatable :: isizes
+real :: zdata0d
+real, dimension(:), allocatable :: zdata1d
+real, dimension(:,:), allocatable :: zdata2d
+real, dimension(:,:,:), allocatable :: zdata3d
+real, dimension(:,:,:,:), allocatable :: zdata4d
+real, dimension(:,:,:,:,:), allocatable :: zdata5d
+type(tfielddata) :: tzfield
+
+idims = Size( kdims )
+
+if ( odistributed ) then
+ 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 ( 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
+ if ( idims > 3 ) &
+ call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
+ 'osplit=.true. not allowed for dims>3, 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) )
+isizes_alldims = 1
+do ji = 1, idims
+ isizes(ji) = Size( pvar, kdims(ji) )
+ isizes_alldims(kdims(ji)) = isizes(ji)
+end do
+
+call Prepare_diachro_write( tpfield, tzfield, kdims, osplit, odistributed, ibutimepos )
+
+NDIMS: select case( idims )
+ case ( 0 ) NDIMS
+ zdata0d = pvar(1, 1, 1, 1, 1, 1)
+
+ if ( osplit ) then
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tpfile, tzfield )
+
+ call IO_Field_write( tpfile, tzfield, [ zdata0d ], koffset= [ ( nbutshift - 1 ) * nbusubwrite ] )
+ else
+ call IO_Field_write( tpfile, tzfield, zdata0d )
+ end if
+
+
+ case ( 1 ) NDIMS
+ ! Copy selected dimensions into zdata (+ auto-allocate it)
+ zdata1d = Reshape ( pvar(1:isizes_alldims(1), 1:isizes_alldims(2), 1:isizes_alldims(3), &
+ 1:isizes_alldims(4), 1:isizes_alldims(5), 1:isizes_alldims(6)), &
+ isizes(1:1) )
+
+ if ( osplit ) then
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tpfile, tzfield )
+
+ Allocate( ioffset( tzfield%ndims ) )
+ ioffset(:) = 0
+ ioffset(ibutimepos) = ( nbutshift - 1 ) * nbusubwrite
+
+ if ( tzfield%ndims == idims ) then
+ !No time dimension was added in Prepare_diachro_write
+ call IO_Field_write( tpfile, tzfield, zdata1d(:), koffset = ioffset )
+ else if ( tzfield%ndims == ( idims + 1 ) ) then
+ !A time dimension was added in Prepare_diachro_write
+ call IO_Field_write( tpfile, tzfield, Reshape( zdata1d, [ Size(zdata1d,1), 1 ] ), &
+ koffset = ioffset )
+ else
+ call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
+ 'probable bug for ' //Trim( tzfield%cmnhname ) )
+ end if
+ else !.not. osplit
+ call IO_Field_write( tpfile, tzfield, zdata1d )
+ end if
+
+
+ case ( 2 ) NDIMS
+ ! Copy selected dimensions into zdata (+ auto-allocate it)
+ zdata2d = Reshape ( pvar(1:isizes_alldims(1), 1:isizes_alldims(2), 1:isizes_alldims(3), &
+ 1:isizes_alldims(4), 1:isizes_alldims(5), 1:isizes_alldims(6)), &
+ isizes(1:2) )
+
+ if ( osplit ) then
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tpfile, tzfield )
+
+ Allocate( ioffset( tzfield%ndims ) )
+ ioffset(:) = 0
+ ioffset(ibutimepos) = ( nbutshift - 1 ) * nbusubwrite
+
+ if ( odistributed ) then
+ if ( tzfield%ndims == idims ) then
+ !No time dimension was added in Prepare_diachro_write
+ call IO_Field_write_box( tpfile, tzfield, 'BUDGET', &
+ zdata2d, &
+ kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
+ koffset = ioffset )
+ else if ( tzfield%ndims == ( idims + 1 ) ) then
+ !A time dimension was added in Prepare_diachro_write
+ call IO_Field_write_box( tpfile, tzfield, 'BUDGET', &
+ Reshape( zdata2d, [ Size(zdata2d,1), Size(zdata2d,2), 1 ] ), &
+ kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
+ koffset = ioffset )
+ else
+ call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
+ 'probable bug for ' //Trim( tzfield%cmnhname ) )
+ end if
+ else
+ !Data is already collected on the master process
+ if ( tzfield%ndims == idims ) then
+ !No time dimension was added in Prepare_diachro_write
+ call IO_Field_write( tpfile, tzfield, zdata2d(:,:), koffset = ioffset )
+ else if ( tzfield%ndims == ( idims + 1 ) ) then
+ !A time dimension was added in Prepare_diachro_write
+ call IO_Field_write( tpfile, tzfield, Reshape( zdata2d, [ Size(zdata2d,1), Size(zdata2d,2), 1 ] ), &
+ koffset = ioffset )
+ else
+ call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
+ 'probable bug for ' //Trim( tzfield%cmnhname ) )
+ end if
+ end if
+ else !.not. osplit
+ if ( odistributed ) then
+ call IO_Field_write_box( tpfile, tzfield, 'BUDGET', zdata2d, &
+ kil + jphext, kih + jphext, kjl + jphext, kjh + jphext )
+ else
+ !Data is already collected on the master process
+ call IO_Field_write( tpfile, tzfield, zdata2d )
+ end if
+ end if
+
+
+ case ( 3 ) NDIMS
+ ! Copy selected dimensions into zdata (+ auto-allocate it)
+ zdata3d = Reshape ( pvar(1:isizes_alldims(1), 1:isizes_alldims(2), 1:isizes_alldims(3), &
+ 1:isizes_alldims(4), 1:isizes_alldims(5), 1:isizes_alldims(6)), &
+ isizes(1:3) )
+
+ if ( osplit ) then
+ !Create the metadata of the field (has to be done only once)
+ if ( nbutshift == 1 ) call IO_Field_create( tpfile, tzfield )
+
+ Allocate( ioffset( tzfield%ndims ) )
+ ioffset(:) = 0
+ ioffset(ibutimepos) = ( nbutshift - 1 ) * nbusubwrite
+
+ if ( odistributed ) then
+ if ( tzfield%ndims == idims ) then
+ !No time dimension was added in Prepare_diachro_write
+ call IO_Field_write_box( tpfile, tzfield, 'BUDGET', &
+ zdata3d, &
+ kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
+ koffset = ioffset )
+ else if ( tzfield%ndims == ( idims + 1 ) ) then
+ !A time dimension was added in Prepare_diachro_write
+ call IO_Field_write_box( tpfile, tzfield, 'BUDGET', &
+ Reshape( zdata3d, [ Size(zdata3d,1), Size(zdata3d,2), Size(zdata3d,3), 1 ] ), &
+ kil + jphext, kih + jphext, kjl + jphext, kjh + jphext, &
+ koffset = ioffset )
+ else
+ call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
+ 'probable bug for ' //Trim( tzfield%cmnhname ) )
+ end if
+ else
+ !Data is already collected on the master process
+ if ( tzfield%ndims == idims ) then
+ !No time dimension was added in Prepare_diachro_write
+ call IO_Field_write( tpfile, tzfield, zdata3d(:,:,:), koffset = ioffset )
+ else if ( tzfield%ndims == ( idims + 1 ) ) then
+ !A time dimension was added in Prepare_diachro_write
+ call IO_Field_write( tpfile, tzfield, Reshape( zdata3d, [ Size(zdata3d,1), Size(zdata3d,2), Size(zdata3d,3), 1 ] ), &
+ koffset = ioffset )
+ else
+ call Print_msg( NVERB_FATAL, 'IO', 'Diachro_one_field_write_nc4', &
+ 'probable bug for ' //Trim( tzfield%cmnhname ) )
+ end if
+ end if
+ else !.not. osplit
+ if ( odistributed ) then
+ call IO_Field_write_box( tpfile, tzfield, 'BUDGET', zdata3d, &
+ kil + jphext, kih + jphext, kjl + jphext, kjh + jphext )
+ else
+ !Data is already collected on the master process
+ call IO_Field_write( tpfile, tzfield, zdata3d )
+ end if
+ end if
+
+
+ case ( 4 ) NDIMS
+ ! Copy selected dimensions into zdata (+ auto-allocate it)
+ zdata4d = Reshape ( pvar(1:isizes_alldims(1), 1:isizes_alldims(2), 1:isizes_alldims(3), &
+ 1:isizes_alldims(4), 1:isizes_alldims(5), 1:isizes_alldims(6)), &
+ isizes(1:4) )
+
+ call IO_Field_write( tpfile, tzfield, zdata4d )
+
+
+ case ( 5 ) NDIMS
+ ! Copy selected dimensions into zdata (+ auto-allocate it)
+ zdata5d = Reshape ( pvar(1:isizes_alldims(1), 1:isizes_alldims(2), 1:isizes_alldims(3), &
+ 1:isizes_alldims(4), 1:isizes_alldims(5), 1:isizes_alldims(6)), &
+ isizes(1:5) )
+
+ call IO_Field_write( tpfile, tzfield, zdata5d )
+
+
+ case default NDIMS
+ call Print_msg( NVERB_ERROR, 'IO', 'Diachro_one_field_write_nc4', Trim( tpfile%cname ) // &
+ ': unsupported number of dimensions' )
+ return
+
+end select NDIMS
+
+end subroutine Diachro_one_field_write_nc4
+
+
+subroutine Prepare_diachro_write( tpfieldin, tpfieldout, kdims, osplit, odistributed, kbutimepos )
+use modd_field, only: NMNHDIM_BUDGET_TIME, NMNHDIM_UNUSED, NMNHMAXDIMS, tfielddata, tfield_metadata_base
+
+class(tfield_metadata_base), intent(in) :: tpfieldin
+type(tfielddata), intent(out) :: tpfieldout
+integer, dimension(:), intent(in) :: kdims ! List of indices of dimensions to use
+logical, intent(in) :: osplit
+logical, intent(in) :: odistributed ! .true. if data is distributed among all the processes
+integer, intent(out) :: kbutimepos
+
+integer :: idims
+integer :: jdim
+
+idims = Size( kdims )
+
+if ( idims > NMNHMAXDIMS ) call Print_msg( NVERB_FATAL, 'IO', 'Prepare_diachro_write', &
+ 'kdims is too big for ' //Trim( tpfieldin%cmnhname ) )
+
+tpfieldout%cmnhname = tpfieldin%cmnhname
+tpfieldout%cstdname = tpfieldin%cstdname
+tpfieldout%clongname = tpfieldin%clongname
+tpfieldout%cunits = tpfieldin%cunits
+if ( .not. odistributed ) then
+ tpfieldout%cdir = '--'
+else
+ tpfieldout%cdir = 'XY'
+end if
+tpfieldout%ccomment = tpfieldin%ccomment
+tpfieldout%ngrid = tpfieldin%ngrid
+tpfieldout%ntype = tpfieldin%ntype
+tpfieldout%ltimedep = .false.
+
+tpfieldout%ndims = idims
+
+do jdim = 1, idims
+ tpfieldout%ndimlist(jdim) = tpfieldin%ndimlist(kdims(jdim))
+end do
+tpfieldout%ndimlist(idims + 1:) = NMNHDIM_UNUSED
+
+kbutimepos = -1
+
+!Add budget time dimension if required
+if ( osplit ) then
+ do jdim = 1, idims
+ if ( tpfieldout%ndimlist(jdim) == NMNHDIM_BUDGET_TIME ) then
+ kbutimepos = jdim
+ exit
+ end if
+ end do
+
+ !budget time dimension was not found => add it
+ if ( kbutimepos == -1 ) then
+ idims = idims + 1
+ if ( idims > NMNHMAXDIMS ) call Print_msg( NVERB_FATAL, 'IO', 'Prepare_diachro_write', &
+ 'impossible to add NMNHDIM_BUDGET_TIME dimension for ' //Trim( tpfieldin%cmnhname ) )
+ kbutimepos = idims
+ tpfieldout%ndims = idims
+ tpfieldout%ndimlist(idims) = NMNHDIM_BUDGET_TIME
+ end if
+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_dummy_gr_fieldn.f90 b/src/MNH/write_dummy_gr_fieldn.f90
index e177c4e2ed84ac3182383366b0217d31db542ff0..74f56e63cbd956f50ef7992ef52b3b2fbaebfce9 100644
--- a/src/MNH/write_dummy_gr_fieldn.f90
+++ b/src/MNH/write_dummy_gr_fieldn.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1996-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -63,10 +63,10 @@ END MODULE MODI_WRITE_DUMMY_GR_FIELD_n
!
USE MODD_DUMMY_GR_FIELD_n, ONLY: NDUMMY_GR_NBR, CDUMMY_GR_NAME, &
CDUMMY_GR_AREA, XDUMMY_GR_FIELDS
+use modd_field, only: tfielddata, TYPEINT, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS, ONLY: NMNHNAMELGTMAX
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT,TYPEREAL
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
IMPLICIT NONE
diff --git a/src/MNH/write_lbn.f90 b/src/MNH/write_lbn.f90
index 32f0fd5835e0e93685737ecda1cee76b6bffd2c0..dc3fd036f944836a55cfef155c74925c3b9fcaf4 100644
--- a/src/MNH/write_lbn.f90
+++ b/src/MNH/write_lbn.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.
@@ -75,8 +75,9 @@ END MODULE MODI_WRITE_LB_n
!! P. Tulet 09/14 modif SALT
!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
!! J.-P. Pinty 09/02/16 Add LIMA that is LBC for CCN and IFN
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! S. Bielli 02/2019: Sea salt: significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 10/03/2021: use scalar variable names for dust and salt
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -120,7 +121,7 @@ USE MODI_DUSTLFI_n
USE MODI_SALTLFI_n
USE MODD_PARAMETERS, ONLY: JPHEXT
USE MODD_IO, ONLY: TFILEDATA
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
+use modd_field, only: tfielddata, TYPELOG, TYPEREAL
!
!
IMPLICIT NONE
@@ -143,8 +144,6 @@ LOGICAL, DIMENSION (7) :: GUSER ! array with the use indicator of the
REAL, DIMENSION(SIZE(XLBXSVM, 1), SIZE(XLBXSVM,2), SIZE(XLBXSVM,3)) :: ZRHODREFX
REAL, DIMENSION(SIZE(XLBYSVM, 1), SIZE(XLBYSVM,2), SIZE(XLBYSVM,3)) :: ZRHODREFY
INTEGER :: JK
-! Integers, counters for dust modes
-INTEGER :: JMOM, IMOMENTS, JMODE, ISV_NAME_IDX
INTEGER :: IMI ! Current model index
CHARACTER(LEN=2) :: INDICE ! to index CCN and IFN fields of LIMA scheme
INTEGER :: I
@@ -256,7 +255,7 @@ IF (NRR >=1) THEN
TZFIELD%CLONGNAME = 'LBYR'//YC(JRR)//'M'
TZFIELD%CLBTYPE = 'LBY'
TZFIELD%CCOMMENT = '2_Y_Z_LBYR'//YC(JRR)//'M'
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXR_ll,XLBYRM(:,:,:,IRR))
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYR_ll,XLBYRM(:,:,:,IRR))
END IF
END IF
END DO
@@ -611,123 +610,51 @@ IF (NSV >=1) THEN
CALL DUSTLFI_n(XLBYSVM(:,:,:,NSV_DSTBEG:NSV_DSTEND), ZRHODREFY)
END IF
!
- IF ((CPROGRAM == 'REAL ').OR. (CPROGRAM == 'IDEAL ')) THEN
- ! In this case CDUSTNAMES is not allocated. We will use YPDUST_INI,
- !but remember that this variable does not follow JPDUSTORDER
- IMOMENTS = INT(NSV_DSTEND - NSV_DSTBEG + 1)/NMODE_DST
- !Should equal 3 at this point
- IF (IMOMENTS > 3) THEN
- WRITE(YMSG,*) 'number of DST moments must be 3',NSV_DSTBEG, NSV_DSTEND,NMODE_DST,IMOMENTS
- CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LB_n',YMSG)
- END IF ! Test IMOMENTS
- !
- TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'ppp'
- TZFIELD%CDIR = ''
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- !
- IF (IMOMENTS == 1) THEN
- DO JMODE=1, NMODE_DST
- !Index from which names are picked
- ISV_NAME_IDX = (JPDUSTORDER(JMODE) - 1)*3 + 2
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + 1 & !Number of moments in this mode
- + (NSV_DSTBEG -1) !Previous list of tracers
-
- IF(NSIZELBXSV_ll /= 0) THEN !Check on border points in X direction
- TZFIELD%CMNHNAME = 'LBX_'//TRIM(YPDUST_INI(ISV_NAME_IDX))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBX'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
- ENDIF !Check on border points in X direction
- IF(NSIZELBYSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBY_'//TRIM(YPDUST_INI(ISV_NAME_IDX))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBY'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'X_2_Z_','LBYSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
- ENDIF !Check on points in Y direction
- ENDDO ! Loop on mode
- ELSE ! valeur IMOMENTS =/ 1
- DO JMODE=1,NMODE_DST
- DO JMOM=1,IMOMENTS
- ISV_NAME_IDX = (JPDUSTORDER(JMODE) - 1)*3 + JMOM
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + JMOM & !Number of moments in this mode
- + (NSV_DSTBEG -1)
- !
- IF(NSIZELBXSV_ll /= 0) THEN !Check on border points in X direction
- TZFIELD%CMNHNAME = 'LBX_'//TRIM(YPDUST_INI(ISV_NAME_IDX))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBX'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
- ENDIF !Check on border points in X direction
- IF(NSIZELBYSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBY_'//TRIM(YPDUST_INI(ISV_NAME_IDX))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBY'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3,A8)')'X_2_Z_','LBYSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
- ENDIF !Check on points in Y direction
- ENDDO ! Loop on moments
- ENDDO ! Loop on modes
- END IF ! valeur IMOMENTS
-
- ELSE ! Test CPROGRAM
- ! We are in the subprogram MESONH, CDUSTNAMES are allocated and are
- !in the same order as the variables in XSVM (i.e. following JPDUSTORDER)
- !
- TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'ppp'
- TZFIELD%CDIR = ''
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'ppp'
+ TZFIELD%CDIR = ''
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ DO JSV = NSV_DSTBEG,NSV_DSTEND
+ IF(NSIZELBXSV_ll /= 0) THEN
+ TZFIELD%CMNHNAME = 'LBX_'//TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CLBTYPE = 'LBX'
+ WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ END IF
!
- DO JSV = NSV_DSTBEG,NSV_DSTEND
+ IF(NSIZELBYSV_ll /= 0) THEN
+ TZFIELD%CMNHNAME = 'LBY_'//TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CLBTYPE = 'LBY'
+ WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ END IF
+ END DO
+ IF (LDEPOS_DST(IMI)) THEN
+ DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND
IF(NSIZELBXSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBX_'//TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))
+ TZFIELD%CMNHNAME = 'LBX_'//TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
- END IF
+ END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBY_'//TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))
+ TZFIELD%CMNHNAME = 'LBY_'//TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
END IF
END DO
- IF (LDEPOS_DST(IMI)) THEN
- DO JSV = NSV_DSTDEPBEG,NSV_DSTDEPEND
- IF(NSIZELBXSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBX_'//TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBX'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
- END IF
- !
- IF(NSIZELBYSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBY_'//TRIM(CDEDSTNAMES(JSV-NSV_DSTDEPBEG+1))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBY'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
- END IF
- END DO
- END IF
- END IF
- ENDIF
+ END IF
+ ENDIF
!
IF (LSALT) THEN
DO JK=1,size(XLBXSVM,3)
@@ -772,120 +699,50 @@ IF (NSV >=1) THEN
END IF
END IF
!
- IF ((CPROGRAM == 'REAL ').OR. (CPROGRAM == 'IDEAL ')) THEN
- ! In this case CSALTNAMES is not allocated. We will use YPSALT_INI,
- !but remember that this variable does not follow JPSALTORDER
- IMOMENTS = INT(NSV_SLTEND - NSV_SLTBEG + 1)/NMODE_SLT
- !Should equal 3 at this point
- IF (IMOMENTS > 3) THEN
- WRITE(YMSG,*) 'number of SLT moments must be 3',NSV_SLTBEG, NSV_SLTEND,NMODE_SLT,IMOMENTS
- CALL PRINT_MSG(NVERB_FATAL,'GEN','WRITE_LB_n',YMSG)
- END IF ! Test IMOMENTS
- !
- TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'ppp'
- TZFIELD%CDIR = ''
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- !
- IF (IMOMENTS == 1) THEN
- DO JMODE=1, NMODE_SLT
- !Index from which names are picked
- ISV_NAME_IDX = (JPSALTORDER(JMODE) - 1)*3 + 2
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + 1 & !Number of moments in this mode
- + (NSV_SLTBEG -1) !Previous list of tracers
-
- IF(NSIZELBXSV_ll /= 0) THEN !Check on border points in X direction
- TZFIELD%CMNHNAME = 'LBX_'//TRIM(YPSALT_INI(ISV_NAME_IDX))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBX'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
- ENDIF !Check on border points in X direction
- IF(NSIZELBYSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBY_'//TRIM(YPSALT_INI(ISV_NAME_IDX))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBY'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
- ENDIF !Check on points in Y direction
- ENDDO ! Loop on mode
- ELSE ! valeur IMOMENTS =/ 1
- DO JMODE=1,NMODE_SLT
- DO JMOM=1,IMOMENTS
- ISV_NAME_IDX = (JPSALTORDER(JMODE) - 1)*3 + JMOM
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + JMOM & !Number of moments in this mode
- + (NSV_SLTBEG -1)
-
- IF(NSIZELBXSV_ll /= 0) THEN !Check on border points in X direction
- TZFIELD%CMNHNAME = 'LBX_'//TRIM(YPSALT_INI(ISV_NAME_IDX))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBX'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
- ENDIF !Check on border points in X direction
- IF(NSIZELBYSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBY_'//TRIM(YPSALT_INI(ISV_NAME_IDX))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBY'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
- ENDIF !Check on points in Y direction
- ENDDO ! Loop on moments
- ENDDO ! Loop on modes
- END IF ! valeur IMOMENTS
- ELSE ! Test CPROGRAM
- ! We are in the subprogram MESONH, CSALTNAMES are allocated and are
- !in the same order as the variables in XSVM (i.e. following JPSALTORDER)
- TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'ppp'
- TZFIELD%CDIR = ''
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'ppp'
+ TZFIELD%CDIR = ''
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ DO JSV = NSV_SLTBEG,NSV_SLTEND
+ IF(NSIZELBXSV_ll /= 0) THEN
+ TZFIELD%CMNHNAME = 'LBX_'//TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CLBTYPE = 'LBX'
+ WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
+ END IF
!
- DO JSV = NSV_SLTBEG,NSV_SLTEND
+ IF(NSIZELBYSV_ll /= 0) THEN
+ TZFIELD%CMNHNAME = 'LBY_'//TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ TZFIELD%CLBTYPE = 'LBY'
+ WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
+ CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
+ END IF
+ END DO
+ IF (LDEPOS_SLT(IMI)) THEN
+ DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND
IF(NSIZELBXSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBX_'//TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))
+ TZFIELD%CMNHNAME = 'LBX_'//TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBX'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
- END IF
+ END IF
!
IF(NSIZELBYSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBY_'//TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))
+ TZFIELD%CMNHNAME = 'LBY_'//TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CLBTYPE = 'LBY'
WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
- END IF
+ END IF
END DO
- IF (LDEPOS_SLT(IMI)) THEN
- DO JSV = NSV_SLTDEPBEG,NSV_SLTDEPEND
- IF(NSIZELBXSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBX_'//TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBX'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'2_Y_Z_','LBXSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBXSV_ll,XLBXSVM(:,:,:,JSV))
- END IF
- !
- IF(NSIZELBYSV_ll /= 0) THEN
- TZFIELD%CMNHNAME = 'LBY_'//TRIM(CDESLTNAMES(JSV-NSV_SLTDEPBEG+1))
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- TZFIELD%CLBTYPE = 'LBY'
- WRITE(TZFIELD%CCOMMENT,'(A6,A6,I3.3)')'X_2_Z_','LBYSVM',JSV
- CALL IO_Field_write_lb(TPFILE,TZFIELD,NSIZELBYSV_ll,XLBYSVM(:,:,:,JSV))
- END IF
- END DO
- END IF
- END IF
+ END IF
ENDIF
!
! lagrangian variables
diff --git a/src/MNH/write_les_budgetn.f90 b/src/MNH/write_les_budgetn.f90
index dc12b57cabc42288aa6f4d366456a91f4450f27a..7827ba184b18d710839d63155d807c186b67eb01 100644
--- a/src/MNH/write_les_budgetn.f90
+++ b/src/MNH/write_les_budgetn.f90
@@ -1,34 +1,27 @@
-!MNH_LIC Copyright 2000-2019 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.
!-----------------------------------------------------------------
-!######################
-MODULE MODI_WRITE_LES_BUDGET_n
-!######################
-!
-INTERFACE
-!
- SUBROUTINE WRITE_LES_BUDGET_n(TPDIAFILE,HLES_AVG)
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=1), INTENT(IN) :: HLES_AVG ! flag to perform the averages
-! ! or normalizations
-END SUBROUTINE WRITE_LES_BUDGET_n
-!
-END INTERFACE
-!
-END MODULE MODI_WRITE_LES_BUDGET_n
+!#############################
+module mode_write_les_budget_n
+!#############################
+
+implicit none
+
+private
-! ######################
- SUBROUTINE WRITE_LES_BUDGET_n(TPDIAFILE,HLES_AVG)
-! ######################
+public :: Write_les_budget_n
+
+contains
+
+!##########################################
+subroutine Write_les_budget_n( tpdiafile )
+!##########################################
!
!
-!!**** *WRITE_LES_n* writes the LES final diagnostics for model _n
-!!
+!!**** *Write_les_budget_n* writes the LES final diagnostics for model _n
+!!
!!
!! PURPOSE
!! -------
@@ -50,36 +43,53 @@ END MODULE MODI_WRITE_LES_BUDGET_n
!! -------------
!! Original 07/02/00
!! 06/11/02 (V. Masson) new LES budgets
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!! --------------------------------------------------------------------------
-!
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 15/10/2020: restructure Les_diachro calls to use tfield_metadata_base type
+! JL Redelsperger 03/21 modif buoyancy flix for OCEAN LES case
+! --------------------------------------------------------------------------
+!
!* 0. DECLARATIONS
! ------------
-!
-USE MODD_CST
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_LES_n
-USE MODD_CONF_n
-USE MODD_LES_BUDGET
-!
-USE MODE_ll
-!
-USE MODE_LES_DIACHRO
-!
+
+use modd_conf_n, only: luserv
+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
+use modd_io, only: tfiledata
+use modd_les, only: cles_norm_type, nles_k, xles_temp_mean_start, xles_temp_mean_end, xles_temp_sampling
+use modd_les_n, only: nles_times, &
+ xles_bu_res_ke, xles_bu_res_thl2, xles_bu_res_wthl, &
+ xles_bu_sbg_tke, &
+ xles_mean_dthldz, xles_mean_dudz, xles_mean_dvdz, xles_mean_dwdz, &
+ xles_mean_th, xles_mean_thv, xles_mean_w, &
+ xles_res_ddxa_thl_sbg_uaw, xles_res_ddxa_w_sbg_uathl, xles_res_ddxa_thl_sbg_uathl, &
+ xles_res_ddz_thl_sbg_w2, &
+ xles_res_w_sbg_thl2, xles_res_w_sbg_wthl, &
+ xles_subgrid_diss_thl2, &
+ xles_subgrid_thl2, xles_subgrid_thlpz, xles_subgrid_thlthv, xles_subgrid_w2, &
+ xles_subgrid_w2thl, xles_subgrid_wthl, xles_subgrid_wthl2, xles_subgrid_wu, xles_subgrid_wv, &
+ xles_z
+use modd_les_budget, only: NLES_RELA, NLES_RAD, NLES_GRAV, NLES_COR, NLES_MICR, NLES_HTURB, NLES_VTURB, NLES_FORC, &
+ NLES_PRES, NLES_DIFF, NLES_CURV, NLES_PREF, NLES_DP, NLES_TP, NLES_TR, NLES_DISS, &
+ NLES_TEND, NLES_ADVR, NLES_ADVM, NLES_NEST, NLES_MISC
+use modd_parameters, only: XUNDEF
+
+use mode_les_diachro, only: Les_diachro
+
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=1), INTENT(IN) :: HLES_AVG ! flag to perform the averages
-! ! or normalizations
!
!
!* 0.2 declaration of local variables
!
+integer, parameter :: NMAX_ILES = 40
+
INTEGER :: ILES
INTEGER :: ILES_STA
INTEGER :: JLES
@@ -88,27 +98,43 @@ INTEGER :: ILES_P1, ILES_P2
INTEGER :: JK ! vertical loop counter
INTEGER :: JT ! temporal loop counter
!
-CHARACTER(len=9), DIMENSION(:), ALLOCATABLE :: YSUBTITLE
-CHARACTER(len=8) :: YGROUP
+CHARACTER(len=9), DIMENSION(NMAX_ILES) :: YFIELDNAMES
+CHARACTER(len=100), DIMENSION(NMAX_ILES) :: YFIELDCOMMENTS
+character(len=:), allocatable :: ygroup
+character(len=:), allocatable :: ygroupcomment
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLES_BUDGET
!
+logical :: gdoavg ! Compute and store time average
+logical :: gdonorm ! Compute and store normalized field
+type(tfield_metadata_base) :: tzfield
!-------------------------------------------------------------------------------
!
!* Initializations
! ---------------
!
-ALLOCATE(ZLES_BUDGET(NLES_K,NLES_TIMES,40))
-ALLOCATE(YSUBTITLE(40))
+ALLOCATE(ZLES_BUDGET(NLES_K,NLES_TIMES,NMAX_ILES))
!
ZLES_BUDGET=XUNDEF
-YSUBTITLE(:)=' '
+YFIELDNAMES(:)=' '
+
+tzfield%ngrid = 0 !Not on the Arakawa grid
+tzfield%ntype = TYPEREAL
+tzfield%ndims = 3
+tzfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tzfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tzfield%ndimlist(3) = NMNHDIM_BUDGET_TERM
+tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+gdoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+gdonorm = Trim( cles_norm_type ) /= 'NONE'
!-------------------------------------------------------------------------------
!
!* 1. total (resolved+subgrid) kinetic energy budget
! ------------------------------------
!
-YGROUP= 'BU_KE '
+ygroup = 'BU_KE'
+ygroupcomment = 'Total (resolved+subgrid) kinetic energy budget'
ILES=0
ILES_STA=ILES
!
@@ -116,16 +142,18 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TEND'
+YFIELDNAMES(ILES) = 'SBG_TEND'
+YFIELDCOMMENTS(ILES) = 'subgrid tendency'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_TEND)
!
!
-!* 1.2 production by mean wind gradient
+!* 1.2 dynamic production by mean wind gradient
! ---------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YFIELDNAMES(ILES) = 'SBG_DP_M'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by mean gradient'
!
ZLES_BUDGET(:,:,ILES)= - XLES_SUBGRID_WU (:,:,1) * XLES_MEAN_DUDZ(:,:,1) &
- XLES_SUBGRID_WV (:,:,1) * XLES_MEAN_DVDZ(:,:,1) &
@@ -135,7 +163,8 @@ ZLES_BUDGET(:,:,ILES)= - XLES_SUBGRID_WU (:,:,1) * XLES_MEAN_DUDZ(:,:,1) &
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YFIELDNAMES(ILES) = 'SBG_DP_R'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by resolved fluctuations'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_DP) - ZLES_BUDGET(:,:,2)
!
@@ -146,7 +175,8 @@ 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'
+YFIELDNAMES(ILES) = 'SBG_ADVM'
+YFIELDCOMMENTS(ILES) = 'subgrid advection by mean flow'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_ADVM)
END IF
@@ -157,7 +187,8 @@ END IF
!
IF ( ANY(XLES_BU_SBG_TKE(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG FORC'
+YFIELDNAMES(ILES) = 'SBG_FORC'
+YFIELDCOMMENTS(ILES) = 'subgrid advection by large-scale W forcing'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_FORC)
END IF
@@ -167,7 +198,8 @@ END IF
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TR '
+YFIELDNAMES(ILES) = 'SBG_TR'
+YFIELDCOMMENTS(ILES) = 'subgrid turbulent transport'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_TR)
!
@@ -176,7 +208,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_TR)
! -----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG ADVR'
+YFIELDNAMES(ILES) = 'SBG_ADVR'
+YFIELDCOMMENTS(ILES) = 'subgrid advection by resolved flow'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_ADVR)
!
@@ -186,7 +219,8 @@ 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'
+YFIELDNAMES(ILES) = 'SBG_PRES'
+YFIELDCOMMENTS(ILES) = 'subgrid pressure-correlation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_PRES)
END IF
@@ -196,7 +230,8 @@ END IF
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TP'
+YFIELDNAMES(ILES) = 'SBG_TP'
+YFIELDCOMMENTS(ILES) = 'subgrid thermal production'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_TP)
!
@@ -205,7 +240,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_TP)
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS'
+YFIELDNAMES(ILES) = 'SBG_DISS'
+YFIELDCOMMENTS(ILES) = 'subgrid dissipation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_DISS)
!
@@ -215,7 +251,8 @@ 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'
+YFIELDNAMES(ILES) = 'SBG_NUMD'
+YFIELDCOMMENTS(ILES) = 'subgrid numerical diffusion'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_DIFF)
END IF
@@ -225,7 +262,8 @@ END IF
!
IF ( ANY(XLES_BU_SBG_TKE(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RELA'
+YFIELDNAMES(ILES) = 'SBG_RELA'
+YFIELDCOMMENTS(ILES) = 'subgrid sponge layer relaxation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_RELA)
END IF
@@ -235,7 +273,8 @@ END IF
!
IF ( ANY(XLES_BU_SBG_TKE(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG NEST'
+YFIELDNAMES(ILES) = 'SBG_NEST'
+YFIELDCOMMENTS(ILES) = 'subgrid average from smaller nested models'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_NEST)
END IF
@@ -246,7 +285,8 @@ END IF
!
IF ( ANY(XLES_BU_SBG_TKE(:,:,NLES_MISC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG MISC'
+YFIELDNAMES(ILES) = 'SBG_MISC'
+YFIELDCOMMENTS(ILES) = 'subgrid: other effects'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_SBG_TKE(:,:,NLES_MISC)
END IF
@@ -256,7 +296,8 @@ END IF
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YFIELDNAMES(ILES) = 'SBG_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of subgrid budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -269,7 +310,8 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YFIELDNAMES(ILES) = 'RES_TEND'
+YFIELDCOMMENTS(ILES) = 'resolved tendency'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_TEND)
!
@@ -279,7 +321,8 @@ 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 '
+YFIELDNAMES(ILES) = 'RES_ADV'
+YFIELDCOMMENTS(ILES) = 'resolved advection by mean flow'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Ke(:,:,NLES_ADVM)
END IF
@@ -290,17 +333,19 @@ END IF
!
IF ( ANY(XLES_BU_RES_KE(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YFIELDNAMES(ILES) = 'RES_FORC'
+YFIELDCOMMENTS(ILES) = 'resolved advection by large-scale W forcing'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Ke(:,:,NLES_FORC)
END IF
!
!
-!* 1.19 production by mean wind gradient
+!* 1.19 dynamic production by mean wind gradient
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YFIELDNAMES(ILES) = 'RES_DP'
+YFIELDCOMMENTS(ILES) = 'resolved dynamic production by mean gradient'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Ke(:,:,NLES_DP)
!
@@ -309,7 +354,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Ke(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YFIELDNAMES(ILES) = 'RES_TR'
+YFIELDCOMMENTS(ILES) = 'turbulent transport of resolved flux by itself'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_TR)
!
@@ -319,7 +365,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_TR)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES PRES'
+YFIELDNAMES(ILES) = 'RES_PRES'
+YFIELDCOMMENTS(ILES) = 'resolved pressure-correlation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_PRES)
!
@@ -328,7 +375,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_PRES)
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TP '
+YFIELDNAMES(ILES) = 'RES_TP'
+YFIELDCOMMENTS(ILES) = 'resolved thermal production'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_GRAV)
!
@@ -337,7 +385,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_GRAV)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YFIELDNAMES(ILES) = 'RES_SBGT'
+YFIELDCOMMENTS(ILES) = 'resolved sink due to subgrid turbulence'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_VTURB) + XLES_BU_RES_KE(:,:,NLES_HTURB)
!
@@ -346,7 +395,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_CORI'
+YFIELDCOMMENTS(ILES) = 'resolved Coriolis effect'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_COR)
END IF
@@ -356,7 +406,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_KE(:,:,NLES_DIFF)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NUMD'
+YFIELDNAMES(ILES) = 'RES_NUMD'
+YFIELDCOMMENTS(ILES) = 'resolved numerical diffusion'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_DIFF)
END IF
@@ -366,7 +417,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_KE(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YFIELDNAMES(ILES) = 'RES_RELA'
+YFIELDCOMMENTS(ILES) = 'resolved sponge layer relaxation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_RELA)
END IF
@@ -376,7 +428,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_KE(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YFIELDNAMES(ILES) = 'RES_NEST'
+YFIELDCOMMENTS(ILES) = 'resolved average from smaller nested models'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_NEST)
END IF
@@ -388,7 +441,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_MISC'
+YFIELDCOMMENTS(ILES) = 'resolved: other effects'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_KE(:,:,NLES_MISC) &
+ XLES_BU_RES_KE(:,:,NLES_CURV)
@@ -398,7 +452,8 @@ END IF
! ------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YFIELDNAMES(ILES) = 'RES_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of resolved budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -409,25 +464,33 @@ END DO
! -------
!
!
-CALL LES_DIACHRO_MASKS(TPDIAFILE,YGROUP,YSUBTITLE(:ILES),"resolved KE budget"//YSUBTITLE(:ILES),"m2 s-3", &
- ZLES_BUDGET(:,:,:ILES),HLES_AVG)
-!
+tzfield%cmnhname = ygroup !cmnhname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%cstdname = ''
+tzfield%clongname = ygroup !clongname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%ccomment = 'resolved KE budget' !ccomment will be completed with yfieldnames(:) in Les_diachro
+tzfield%cunits = 'm2 s-3'
+
+call Les_diachro( tpdiafile, tzfield, ygroup, ygroupcomment, gdoavg, gdonorm, zles_budget(:, :, :iles), &
+ hfieldnames = yfieldnames(:iles), hfieldcomments = yfieldcomments(:iles) )
+
!-------------------------------------------------------------------------------
!
!
!* 2. temperature variance budget
! ---------------------------
!
-YGROUP= 'BU_THL2 '
+ygroup = 'BU_THL2'
+ygroupcomment = 'Temperature variance budget'
ILES=0
!
ILES_STA=ILES
!
-!* 2.1 production by mean gradients
+!* 2.1 dynamic production by mean gradients
! ----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YFIELDNAMES(ILES) = 'SBG_DP_M'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by mean gradient'
ILES_P1=ILES
!
ZLES_BUDGET(:,:,ILES)= - 2. * XLES_SUBGRID_WThl(:,:,1) * XLES_MEAN_dThldz(:,:,1)
@@ -438,7 +501,8 @@ 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 '
+YFIELDNAMES(ILES) = 'SBG_TR'
+YFIELDCOMMENTS(ILES) = 'subgrid turbulent transport'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES) = - ( XLES_SUBGRID_WThl2 (JK+1,:,1) &
@@ -455,7 +519,8 @@ END IF
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YFIELDNAMES(ILES) = 'SBG_DP_R'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by resolved fluctuations'
ILES_P2=ILES
!
ZLES_BUDGET(:,:,ILES)= - 2. * XLES_RES_ddxa_Thl_SBG_UaThl(:,:,1) &
@@ -466,7 +531,8 @@ ZLES_BUDGET(:,:,ILES)= - 2. * XLES_RES_ddxa_Thl_SBG_UaThl(:,:,1) &
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS '
+YFIELDNAMES(ILES) = 'SBG_DISS'
+YFIELDCOMMENTS(ILES) = 'subgrid dissipation'
!
ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_Thl2(:,:,1)
!
@@ -475,7 +541,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_Thl2(:,:,1)
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YFIELDNAMES(ILES) = 'SBG_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of subgrid budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -488,7 +555,8 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YFIELDNAMES(ILES) = 'RES_TEND'
+YFIELDCOMMENTS(ILES) = 'resolved tendency'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_TEND)
!
@@ -498,7 +566,8 @@ 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 '
+YFIELDNAMES(ILES) = 'RES_ADV'
+YFIELDCOMMENTS(ILES) = 'resolved advection by mean flow'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_ADVM)
END IF
@@ -509,7 +578,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_Thl2(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YFIELDNAMES(ILES) = 'RES_FORC'
+YFIELDCOMMENTS(ILES) = 'resolved advection by large-scale W forcing'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_FORC)
END IF
@@ -519,7 +589,8 @@ END IF
! ----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YFIELDNAMES(ILES) = 'RES_DP'
+YFIELDCOMMENTS(ILES) = 'resolved dynamic production by mean gradient'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_DP)
@@ -528,7 +599,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YFIELDNAMES(ILES) = 'RES_TR'
+YFIELDCOMMENTS(ILES) = 'turbulent transport of resolved flux by itself'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_TR)
!
@@ -537,7 +609,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_TR)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YFIELDNAMES(ILES) = 'RES_SBGT'
+YFIELDCOMMENTS(ILES) = 'resolved sink due to subgrid turbulence'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_VTURB) + XLES_BU_RES_Thl2(:,:,NLES_HTURB)
!
@@ -546,7 +619,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_NUMD'
+YFIELDCOMMENTS(ILES) = 'resolved numerical diffusion'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_DIFF)
END IF
@@ -556,7 +630,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_Thl2(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YFIELDNAMES(ILES) = 'RES_RELA'
+YFIELDCOMMENTS(ILES) = 'resolved sponge layer relaxation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_RELA)
END IF
@@ -566,7 +641,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_Thl2(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YFIELDNAMES(ILES) = 'RES_NEST'
+YFIELDCOMMENTS(ILES) = 'resolved average from smaller nested models'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_NEST)
END IF
@@ -579,7 +655,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_MISC'
+YFIELDCOMMENTS(ILES) = 'resolved: other effects'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Thl2(:,:,NLES_MISC) &
+ XLES_BU_RES_Thl2(:,:,NLES_RAD ) &
@@ -592,7 +669,8 @@ END IF
! ---------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YFIELDNAMES(ILES) = 'RES_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of resolved budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -603,7 +681,8 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YFIELDNAMES(ILES) = 'NSG_TEND'
+YFIELDCOMMENTS(ILES) = 'neglected tendency'
!
ZLES_BUDGET(:,:,ILES) = 0.
IF (NLES_TIMES>2) THEN
@@ -622,7 +701,8 @@ END IF
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YFIELDNAMES(ILES) = 'NSG_ADVM'
+YFIELDCOMMENTS(ILES) = 'neglected advection by mean flow'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= -XLES_MEAN_W(JK,:,1) &
@@ -639,7 +719,8 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YFIELDNAMES(ILES) = 'NSG_ADVR'
+YFIELDCOMMENTS(ILES) = 'neglected advection by resolved flow'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - ( XLES_RES_W_SBG_Thl2 (JK+1,:,1) &
@@ -656,24 +737,32 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! -------
!
!
-CALL LES_DIACHRO_MASKS(TPDIAFILE,YGROUP,YSUBTITLE(:ILES),"thetal variance budget"//YSUBTITLE(:ILES),"K2 s-1", &
- ZLES_BUDGET(:,:,:ILES),HLES_AVG)
-!
+tzfield%cmnhname = ygroup !cmnhname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%cstdname = ''
+tzfield%clongname = ygroup !clongname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%ccomment = 'thetal variance budget' !ccomment will be completed with yfieldnames(:) in Les_diachro
+tzfield%cunits = 'K2 s-1'
+
+call Les_diachro( tpdiafile, tzfield, ygroup, ygroupcomment, gdoavg, gdonorm, zles_budget(:, :, :iles), &
+ hfieldnames = yfieldnames(:iles), hfieldcomments = yfieldcomments(:iles) )
+
!-------------------------------------------------------------------------------
!
!* 3. temperature flux budget
! ---------------------
!
-YGROUP= 'BU_WTHL '
+ygroup = 'BU_WTHL'
+ygroupcomment = 'Temperature flux budget'
ILES=0
!
ILES_STA=ILES
!
-!* 3.1 production by mean gradients
+!* 3.1 dynamic production by mean gradients
! -----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YFIELDNAMES(ILES) = 'SBG_DP_M'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by mean gradient'
ILES_P1=ILES
!
ZLES_BUDGET(:,:,ILES) = - XLES_SUBGRID_W2(:,:,1) * XLES_MEAN_dThldz(:,:,1)
@@ -683,7 +772,8 @@ ZLES_BUDGET(:,:,ILES) = - XLES_SUBGRID_W2(:,:,1) * XLES_MEAN_dThldz(:,:,1)
! -------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YFIELDNAMES(ILES) = 'SBG_DP_R'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by resolved fluctuations'
!
ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddz_Thl_SBG_W2(:,:,1) &
- ZLES_BUDGET(:,:,ILES_P1)
@@ -694,7 +784,8 @@ 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 '
+YFIELDNAMES(ILES) = 'SBG_TR'
+YFIELDCOMMENTS(ILES) = 'subgrid turbulent transport'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES) = - ( XLES_SUBGRID_W2Thl (JK+1,:,1) &
@@ -713,7 +804,8 @@ END IF
!
IF ( ANY(XLES_SUBGRID_ThlPz(:,:,1)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG PRES'
+YFIELDNAMES(ILES) = 'SBG_PRES'
+YFIELDCOMMENTS(ILES) = 'subgrid pressure-correlation'
!
ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_ThlPz(:,:,1)
END IF
@@ -723,7 +815,8 @@ END IF
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TP '
+YFIELDNAMES(ILES) = 'SBG_TP'
+YFIELDCOMMENTS(ILES) = 'subgrid thermal production'
!
IF (LUSERV) THEN
ZLES_BUDGET(:,:,ILEs) = XG * XLES_SUBGRID_ThlThv(:,:,1) &
@@ -732,12 +825,16 @@ ELSE
ZLES_BUDGET(:,:,ILES) = XG * XLES_SUBGRID_ThlThv(:,:,1) &
/ XLES_MEAN_Th (:,:,1)
END IF
+IF (LOCEAN) THEN
+ ZLES_BUDGET(:,:,ILES) = XG * XLES_SUBGRID_ThlThv(:,:,1) *XALPHAOC
+END IF
!
!* 3.6 residual of subgrid budget
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YFIELDNAMES(ILES) = 'SBG_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of subgrid budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -750,7 +847,8 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YFIELDNAMES(ILES) = 'RES_TEND'
+YFIELDCOMMENTS(ILES) = 'resolved tendency'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_TEND)
!
@@ -759,7 +857,8 @@ 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 '
+YFIELDNAMES(ILES) = 'RES_ADV'
+YFIELDCOMMENTS(ILES) = 'resolved advection by mean flow'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_ADVM)
END IF
@@ -769,7 +868,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WThl(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YFIELDNAMES(ILES) = 'RES_FORC'
+YFIELDCOMMENTS(ILES) = 'resolved advection by large-scale W forcing'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_FORC)
END IF
@@ -779,7 +879,8 @@ END IF
! ----------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YFIELDNAMES(ILES) = 'RES_DP'
+YFIELDCOMMENTS(ILES) = 'resolved dynamic production by mean gradient'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_DP)
!
@@ -787,7 +888,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YFIELDNAMES(ILES) = 'RES_TR'
+YFIELDCOMMENTS(ILES) = 'turbulent transport of resolved flux by itself'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_TR)
!
@@ -796,7 +898,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_TR)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES PRES'
+YFIELDNAMES(ILES) = 'RES_PRES'
+YFIELDCOMMENTS(ILES) = 'resolved pressure-correlation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_PRES)
!
@@ -805,7 +908,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_PRES)
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TP '
+YFIELDNAMES(ILES) = 'RES_TP'
+YFIELDCOMMENTS(ILES) = 'resolved thermal production'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_GRAV)
!
@@ -814,7 +918,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_GRAV)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YFIELDNAMES(ILES) = 'RES_SBGT'
+YFIELDCOMMENTS(ILES) = 'resolved sink due to subgrid turbulence'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_VTURB) + XLES_BU_RES_WThl(:,:,NLES_HTURB)
!
@@ -823,7 +928,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_CORI'
+YFIELDCOMMENTS(ILES) = 'resolved Coriolis effect'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_COR)
END IF
@@ -833,7 +939,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WThl(:,:,NLES_DIFF)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NUMD'
+YFIELDNAMES(ILES) = 'RES_NUMD'
+YFIELDCOMMENTS(ILES) = 'resolved numerical diffusion'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_DIFF)
END IF
@@ -843,7 +950,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WThl(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YFIELDNAMES(ILES) = 'RES_RELA'
+YFIELDCOMMENTS(ILES) = 'resolved sponge layer relaxation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_RELA)
END IF
@@ -853,7 +961,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WThl(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YFIELDNAMES(ILES) = 'RES_NEST'
+YFIELDCOMMENTS(ILES) = 'resolved average from smaller nested models'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_NEST)
END IF
@@ -867,7 +976,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_MISC'
+YFIELDCOMMENTS(ILES) = 'resolved: other effects'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WThl(:,:,NLES_MISC) &
+ XLES_BU_RES_WThl(:,:,NLES_RAD ) &
@@ -881,7 +991,8 @@ END IF
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YFIELDNAMES(ILES) = 'RES_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of resolved budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -892,7 +1003,8 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YFIELDNAMES(ILES) = 'NSG_TEND'
+YFIELDCOMMENTS(ILES) = 'neglected tendency'
!
ZLES_BUDGET(:,:,ILES) = 0.
IF (NLES_TIMES>2) THEN
@@ -913,7 +1025,8 @@ END IF
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YFIELDNAMES(ILES) = 'NSG_ADVM'
+YFIELDCOMMENTS(ILES) = 'neglected advection by mean flow'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - XLES_MEAN_W(JK,:,1) &
@@ -930,7 +1043,8 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YFIELDNAMES(ILES) = 'NSG_ADVR'
+YFIELDCOMMENTS(ILES) = 'neglected advection by resolved flow'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - ( XLES_RES_W_SBG_WThl(JK+1,:,1) &
@@ -946,7 +1060,8 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ----------------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGW'
+YFIELDNAMES(ILES) = 'NSG_DPGW'
+YFIELDCOMMENTS(ILES) = 'neglected production by gradient of vertical velocity for subgrid quantity'
!
ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddxa_W_SBG_UaThl(:,:,1)
!
@@ -955,7 +1070,8 @@ ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddxa_W_SBG_UaThl(:,:,1)
! -------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGT'
+YFIELDNAMES(ILES) = 'NSG_DPGT'
+YFIELDCOMMENTS(ILES) = 'neglected production by horizontal gradient of Thl for subgrid quantity'
!
ZLES_BUDGET(:,:,ILES)=-XLES_RES_ddxa_Thl_SBG_UaW(:,:,1) &
-ZLES_BUDGET(:,:,ILES_P1) -ZLES_BUDGET(:,:,ILES_P2)
@@ -966,15 +1082,21 @@ ZLES_BUDGET(:,:,ILES)=-XLES_RES_ddxa_Thl_SBG_UaW(:,:,1) &
! -------
!
!
-CALL LES_DIACHRO_MASKS(TPDIAFILE,YGROUP,YSUBTITLE(:ILES),"thetal flux budget"//YSUBTITLE(:ILES),"m K s-2", &
- ZLES_BUDGET(:,:,:ILES),HLES_AVG)
-!
-!
+tzfield%cmnhname = ygroup !cmnhname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%cstdname = ''
+tzfield%clongname = ygroup !clongname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%ccomment = 'thetal flux budget' !ccomment will be completed with yfieldnames(:) in Les_diachro
+tzfield%cunits = 'm K s-2'
+
+call Les_diachro( tpdiafile, tzfield, ygroup, ygroupcomment, gdoavg, gdonorm, zles_budget(:, :, :iles), &
+ hfieldnames = yfieldnames(:iles), hfieldcomments = yfieldcomments(:iles) )
+
!-------------------------------------------------------------------------------
!
DEALLOCATE(ZLES_BUDGET)
-DEALLOCATE(YSUBTITLE)
!
!-------------------------------------------------------------------------------
!
-END SUBROUTINE WRITE_LES_BUDGET_n
+end subroutine Write_les_budget_n
+
+end module mode_write_les_budget_n
diff --git a/src/MNH/write_les_rt_budgetn.f90 b/src/MNH/write_les_rt_budgetn.f90
index 92f37d1dbbe8cd2a6c95b775d401f9d5ad97dd4c..114d39cda70bc47d713bcfbddc3f550c9a27d491 100644
--- a/src/MNH/write_les_rt_budgetn.f90
+++ b/src/MNH/write_les_rt_budgetn.f90
@@ -1,33 +1,26 @@
-!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.
!-----------------------------------------------------------------
-!######################
-MODULE MODI_WRITE_LES_RT_BUDGET_n
-!######################
-!
-INTERFACE
-!
- SUBROUTINE WRITE_LES_RT_BUDGET_n(TPDIAFILE,HLES_AVG)
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
-CHARACTER(LEN=1), INTENT(IN) :: HLES_AVG ! flag to perform the averages
-! ! or normalizations
-END SUBROUTINE WRITE_LES_RT_BUDGET_n
-!
-END INTERFACE
-!
-END MODULE MODI_WRITE_LES_RT_BUDGET_n
-!
-! ######################
- SUBROUTINE WRITE_LES_RT_BUDGET_n(TPDIAFILE,HLES_AVG)
-! ######################
+!################################
+module mode_write_les_rt_budget_n
+!################################
+
+implicit none
+
+private
+
+public :: Write_les_rt_budget_n
+
+contains
+
+!#############################################
+subroutine Write_les_rt_budget_n( tpdiafile )
+!#############################################
!
!
-!!**** *WRITE_LES_n* writes the LES final diagnostics for model _n
+!!**** *Write_les_rt_budget_n* writes the LES final diagnostics for model _n
!!
!!
!! PURPOSE
@@ -49,35 +42,47 @@ END MODULE MODI_WRITE_LES_RT_BUDGET_n
!! MODIFICATIONS
!! -------------
!! Original 06/11/02
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!! --------------------------------------------------------------------------
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 15/10/2020: restructure Les_diachro calls to use tfield_metadata_base type
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
-!
-USE MODD_CST
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_LES_n
-USE MODD_LES_BUDGET
-!
-USE MODE_ll
-!
-USE MODE_LES_DIACHRO
-!
+
+use modd_cst, only: xg
+use modd_field, only: NMNHDIM_BUDGET_LES_LEVEL, NMNHDIM_BUDGET_LES_TIME, &
+ NMNHDIM_BUDGET_TERM, NMNHDIM_UNUSED, &
+ tfield_metadata_base, TYPEREAL
+use modd_io, only: tfiledata
+use modd_les, only: cles_norm_type, nles_k, xles_temp_mean_start, xles_temp_mean_end, xles_temp_sampling
+use modd_les_n, only: nles_times, &
+ xles_bu_res_rt2, xles_bu_res_thlrt, xles_bu_res_wrt, &
+ xles_mean_drtdz, xles_mean_dthldz, xles_mean_thv, xles_mean_w, &
+ xles_res_ddxa_rt_sbg_uart, xles_res_ddxa_rt_sbg_uaw, xles_res_ddxa_w_sbg_uart, &
+ xles_res_ddxa_rt_sbg_uathl, xles_res_ddxa_thl_sbg_uart, &
+ xles_res_ddz_rt_sbg_w2, xles_res_w_sbg_wrt, xles_res_w_sbg_rt2, xles_res_w_sbg_thlrt, &
+ xles_subgrid_diss_rt2, xles_subgrid_diss_thlrt, xles_subgrid_rt2, xles_subgrid_rtpz, &
+ xles_subgrid_rtthv, xles_subgrid_thlrt, xles_subgrid_w2, xles_subgrid_wrt, xles_subgrid_wrt2, &
+ xles_subgrid_w2rt, xles_subgrid_wthl, xles_subgrid_wthlrt, &
+ xles_z
+use modd_les_budget, only: NLES_RELA, NLES_RAD, NLES_GRAV, NLES_COR, NLES_MICR, NLES_HTURB, NLES_VTURB, NLES_FORC, &
+ NLES_PRES, NLES_DIFF, NLES_PREF, NLES_DP, NLES_TR, NLES_TEND, NLES_ADVM, NLES_NEST, NLES_MISC
+use modd_parameters, only: XUNDEF
+
+use mode_les_diachro, only: Les_diachro
+
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
-CHARACTER(LEN=1), INTENT(IN) :: HLES_AVG ! flag to perform the averages
-! ! or normalizations
!
!
!* 0.2 declaration of local variables
!
+integer, parameter :: NMAX_ILES = 40
+
INTEGER :: ILES
INTEGER :: ILES_STA
INTEGER :: JLES
@@ -86,36 +91,54 @@ INTEGER :: ILES_P1, ILES_P2
INTEGER :: JK ! vertical loop counter
INTEGER :: JT ! temporal loop counter
!
-CHARACTER(len=9), DIMENSION(:), ALLOCATABLE :: YSUBTITLE
-CHARACTER(len=8) :: YGROUP
+CHARACTER(len=9), DIMENSION(NMAX_ILES) :: YFIELDNAMES
+CHARACTER(len=100), DIMENSION(NMAX_ILES) :: YFIELDCOMMENTS
+character(len=:), allocatable :: ygroup
+character(len=:), allocatable :: ygroupcomment
!
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZLES_BUDGET
!
+logical :: gdoavg ! Compute and store time average
+logical :: gdonorm ! Compute and store normalized field
+type(tfield_metadata_base) :: tzfield
!-------------------------------------------------------------------------------
!
!* Initializations
! ---------------
!
-ALLOCATE(ZLES_BUDGET(NLES_K,NLES_TIMES,40))
-ALLOCATE(YSUBTITLE(40))
+ALLOCATE(ZLES_BUDGET(NLES_K,NLES_TIMES,NMAX_ILES))
!
ZLES_BUDGET(:,:,:) = XUNDEF
+
+tzfield%ngrid = 0 !Not on the Arakawa grid
+tzfield%ntype = TYPEREAL
+tzfield%ndims = 3
+tzfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tzfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tzfield%ndimlist(3) = NMNHDIM_BUDGET_TERM
+tzfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+gdoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+gdonorm = Trim( cles_norm_type ) /= 'NONE'
+
!-------------------------------------------------------------------------------
!
!* 2. total water variance budget
! ---------------------------
!
!
-YGROUP= 'BU_RT2 '
+ygroup = 'BU_RT2'
+ygroupcomment = 'Total water variance budget'
ILES=0
ILES_STA=ILES
!
!
-!* 2.1 production by mean gradients
+!* 2.1 dynamic production by mean gradients
! ----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YFIELDNAMES(ILES) = 'SBG_DP_M'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by mean gradient'
ILES_P1=ILES
!
ZLES_BUDGET(:,:,ILES)= - 2. * XLES_SUBGRID_WRt(:,:,1) * XLES_MEAN_dRtdz(:,:,1)
@@ -125,7 +148,8 @@ ZLES_BUDGET(:,:,ILES)= - 2. * XLES_SUBGRID_WRt(:,:,1) * XLES_MEAN_dRtdz(:,:,1)
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YFIELDNAMES(ILES) = 'SBG_DP_R'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by resolved fluctuations'
!
ZLES_BUDGET(:,:,ILES)= - 2. * XLES_RES_ddxa_Rt_SBG_UaRt(:,:,1) &
- ZLES_BUDGET(:,:,ILES_P1)
@@ -136,7 +160,8 @@ 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 '
+YFIELDNAMES(ILES) = 'SBG_TR'
+YFIELDCOMMENTS(ILES) = 'subgrid turbulent transport'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES) = - ( XLES_SUBGRID_WRt2 (JK+1,:,1) &
@@ -153,7 +178,8 @@ END IF
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS '
+YFIELDNAMES(ILES) = 'SBG_DISS'
+YFIELDCOMMENTS(ILES) = 'subgrid dissipation'
!
ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_Rt2(:,:,1)
!
@@ -162,7 +188,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_Rt2(:,:,1)
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YFIELDNAMES(ILES) = 'SBG_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of subgrid budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -175,7 +202,8 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YFIELDNAMES(ILES) = 'RES_TEND'
+YFIELDCOMMENTS(ILES) = 'resolved tendency'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_TEND)
!
@@ -185,7 +213,8 @@ 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 '
+YFIELDNAMES(ILES) = 'RES_ADV'
+YFIELDCOMMENTS(ILES) = 'resolved advection by mean flow'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_ADVM)
END IF
@@ -195,7 +224,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_Rt2(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YFIELDNAMES(ILES) = 'RES_FORC'
+YFIELDCOMMENTS(ILES) = 'resolved advection by large-scale W forcing'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_FORC)
END IF
@@ -205,7 +235,8 @@ END IF
! ----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YFIELDNAMES(ILES) = 'RES_DP'
+YFIELDCOMMENTS(ILES) = 'resolved dynamic production by mean gradient'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_DP)
@@ -214,7 +245,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YFIELDNAMES(ILES) = 'RES_TR'
+YFIELDCOMMENTS(ILES) = 'turbulent transport of resolved flux by itself'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_TR)
!
@@ -223,7 +255,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_TR)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YFIELDNAMES(ILES) = 'RES_SBGT'
+YFIELDCOMMENTS(ILES) = 'resolved sink due to subgrid turbulence'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_VTURB) + XLES_BU_RES_Rt2(:,:,NLES_HTURB)
!
@@ -233,7 +266,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_NUMD'
+YFIELDCOMMENTS(ILES) = 'resolved numerical diffusion'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_DIFF)
END IF
@@ -243,7 +277,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_Rt2(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YFIELDNAMES(ILES) = 'RES_RELA'
+YFIELDCOMMENTS(ILES) = 'resolved sponge layer relaxation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_RELA)
END IF
@@ -253,7 +288,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_Rt2(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YFIELDNAMES(ILES) = 'RES_NEST'
+YFIELDCOMMENTS(ILES) = 'resolved average from smaller nested models'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_NEST)
END IF
@@ -264,7 +300,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_MISC'
+YFIELDCOMMENTS(ILES) = 'resolved: other effects'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_Rt2(:,:,NLES_MISC) &
+ XLES_BU_RES_Rt2(:,:,NLES_MICR)
@@ -275,7 +312,8 @@ END IF
! ---------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YFIELDNAMES(ILES) = 'RES_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of resolved budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -286,7 +324,8 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YFIELDNAMES(ILES) = 'NSG_TEND'
+YFIELDCOMMENTS(ILES) = 'neglected tendency'
!
ZLES_BUDGET(:,:,ILES) = 0.
IF (NLES_TIMES>2) THEN
@@ -305,7 +344,8 @@ END IF
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YFIELDNAMES(ILES) = 'NSG_ADVM'
+YFIELDCOMMENTS(ILES) = 'neglected advection by mean flow'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= -XLES_MEAN_W(JK,:,1) &
@@ -322,7 +362,8 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YFIELDNAMES(ILES) = 'NSG_ADVR'
+YFIELDCOMMENTS(ILES) = 'neglected advection by resolved flow'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - ( XLES_RES_W_SBG_Rt2 (JK+1,:,1) &
@@ -338,26 +379,32 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
!* 2.16 writing
! -------
!
-!
-CALL LES_DIACHRO_MASKS(TPDIAFILE,YGROUP,YSUBTITLE(:ILES),"Rt variance budget"//YSUBTITLE(:ILES),"kg2 kg-2 s-1", &
- ZLES_BUDGET(:,:,:ILES),HLES_AVG)
-!
-!
+tzfield%cmnhname = ygroup !cmnhname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%cstdname = ''
+tzfield%clongname = ygroup !clongname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%ccomment = 'Rt variance budget' !ccomment will be completed with yfieldnames(:) in Les_diachro
+tzfield%cunits = 'kg2 kg-2 s-1'
+
+call Les_diachro( tpdiafile, tzfield, ygroup, ygroupcomment, gdoavg, gdonorm, zles_budget(:, :, :iles), &
+ hfieldnames = yfieldnames(:iles), hfieldcomments = yfieldcomments(:iles) )
+
!-------------------------------------------------------------------------------
!
!* 3. total water flux budget
! -----------------------
!
!
-YGROUP= 'BU_WRT '
+ygroup = 'BU_WRT'
+ygroupcomment = 'Total water flux budget'
ILES=0
ILES_STA=ILES
!
-!* 3.1 production by mean gradients
+!* 3.1 dynamic production by mean gradients
! -----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YFIELDNAMES(ILES) = 'SBG_DP_M'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by mean gradient'
ILES_P1=ILES
!
ZLES_BUDGET(:,:,ILES) = - XLES_SUBGRID_W2(:,:,1) * XLES_MEAN_dRtdz(:,:,1)
@@ -367,7 +414,8 @@ ZLES_BUDGET(:,:,ILES) = - XLES_SUBGRID_W2(:,:,1) * XLES_MEAN_dRtdz(:,:,1)
! -------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(2) = ' SBG DP R'
+YFIELDNAMES(ILES) = 'SBG_DP_R'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by resolved fluctuations'
ILES_P2=ILES
!
ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddz_Rt_SBG_W2(:,:,1) &
@@ -380,7 +428,8 @@ 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 '
+YFIELDNAMES(ILES) = 'SBG_TR'
+YFIELDCOMMENTS(ILES) = 'subgrid turbulent transport'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES) = - ( XLES_SUBGRID_W2Rt (JK+1,:,1) &
@@ -398,7 +447,8 @@ END IF
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG PRES'
+YFIELDNAMES(ILES) = 'SBG_PRES'
+YFIELDCOMMENTS(ILES) = 'subgrid pressure-correlation'
!
ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_RtPz(:,:,1)
!
@@ -407,7 +457,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_RtPz(:,:,1)
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TP '
+YFIELDNAMES(ILES) = 'SBG_TP'
+YFIELDCOMMENTS(ILES) = 'subgrid thermal production'
!
ZLES_BUDGET(:,:,ILES) = XG * XLES_SUBGRID_RtThv(:,:,1) &
/ XLES_MEAN_Thv (:,:,1)
@@ -416,8 +467,10 @@ 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 '
+YFIELDNAMES(ILES) = 'SBG_DISS'
+YFIELDCOMMENTS(ILES) = 'subgrid dissipation'
!
ZLES_BUDGET(:,:,ILES) = 0.
!
@@ -426,7 +479,8 @@ ZLES_BUDGET(:,:,ILES) = 0.
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YFIELDNAMES(ILES) = 'SBG_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of subgrid budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -439,7 +493,8 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YFIELDNAMES(ILES) = 'RES_TEND'
+YFIELDCOMMENTS(ILES) = 'resolved tendency'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_TEND)
!
@@ -448,7 +503,8 @@ 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 '
+YFIELDNAMES(ILES) = 'RES_ADV'
+YFIELDCOMMENTS(ILES) = 'resolved advection by mean flow'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_ADVM)
END IF
@@ -458,7 +514,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WRt(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YFIELDNAMES(ILES) = 'RES_FORC'
+YFIELDCOMMENTS(ILES) = 'resolved advection by large-scale W forcing'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_FORC)
END IF
@@ -467,7 +524,8 @@ END IF
! ----------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YFIELDNAMES(ILES) = 'RES_DP'
+YFIELDCOMMENTS(ILES) = 'resolved dynamic production by mean gradient'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_DP)
!
@@ -475,7 +533,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YFIELDNAMES(ILES) = 'RES_TR'
+YFIELDCOMMENTS(ILES) = 'turbulent transport of resolved flux by itself'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_TR)
!
@@ -484,7 +543,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_TR)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES PRES'
+YFIELDNAMES(ILES) = 'RES_PRES'
+YFIELDCOMMENTS(ILES) = 'resolved pressure-correlation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_PRES)
!
@@ -493,7 +553,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_PRES)
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TP '
+YFIELDNAMES(ILES) = 'RES_TP'
+YFIELDCOMMENTS(ILES) = 'resolved thermal production'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_GRAV)
!
@@ -502,7 +563,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_GRAV)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YFIELDNAMES(ILES) = 'RES_SBGT'
+YFIELDCOMMENTS(ILES) = 'resolved sink due to subgrid turbulence'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_VTURB) + XLES_BU_RES_WRt(:,:,NLES_HTURB)
!
@@ -511,7 +573,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_CORI'
+YFIELDCOMMENTS(ILES) = 'resolved Coriolis effect'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_COR)
END IF
@@ -521,7 +584,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WRt(:,:,NLES_DIFF)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NUMD'
+YFIELDNAMES(ILES) = 'RES_NUMD'
+YFIELDCOMMENTS(ILES) = 'resolved numerical diffusion'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_DIFF)
END IF
@@ -531,7 +595,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WRt(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YFIELDNAMES(ILES) = 'RES_RELA'
+YFIELDCOMMENTS(ILES) = 'resolved sponge layer relaxation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_RELA)
END IF
@@ -541,7 +606,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WRt(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YFIELDNAMES(ILES) = 'RES_NEST'
+YFIELDCOMMENTS(ILES) = 'resolved average from smaller nested models'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_NEST)
END IF
@@ -552,7 +618,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_MISC'
+YFIELDCOMMENTS(ILES) = 'resolved: other effects'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_WRt(:,:,NLES_MISC) &
+ XLES_BU_RES_WRt(:,:,NLES_MICR)
@@ -562,7 +629,8 @@ END IF
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YFIELDNAMES(ILES) = 'RES_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of resolved budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -573,7 +641,8 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TEND'
+YFIELDNAMES(ILES) = 'NSG_TEND'
+YFIELDCOMMENTS(ILES) = 'neglected tendency'
!
ZLES_BUDGET(:,:,ILES) = 0.
IF (NLES_TIMES>2) THEN
@@ -594,7 +663,8 @@ END IF
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YFIELDNAMES(ILES) = 'NSG_ADVM'
+YFIELDCOMMENTS(ILES) = 'neglected advection by mean flow'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - XLES_MEAN_W(JK,:,1) &
@@ -611,7 +681,8 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YFIELDNAMES(ILES) = 'NSG_ADVR'
+YFIELDCOMMENTS(ILES) = 'neglected advection by resolved flow'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - ( XLES_RES_W_SBG_WRt(JK+1,:,1) &
@@ -627,7 +698,8 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ----------------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGW'
+YFIELDNAMES(ILES) = 'NSG_DPGW'
+YFIELDCOMMENTS(ILES) = 'neglected production by gradient of vertical velocity for subgrid quantity'
!
ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddxa_W_SBG_UaRt(:,:,1)
!
@@ -636,7 +708,8 @@ ZLES_BUDGET(:,:,ILES)=- XLES_RES_ddxa_W_SBG_UaRt(:,:,1)
! -------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGT'
+YFIELDNAMES(ILES) = 'NSG_DPGT'
+YFIELDCOMMENTS(ILES) = 'neglected production by horizontal gradient of Thl for subgrid quantity'
!
ZLES_BUDGET(:,:,ILES)=-XLES_RES_ddxa_Rt_SBG_UaW(:,:,1) &
-ZLES_BUDGET(:,:,ILES_P1) -ZLES_BUDGET(:,:,ILES_P2)
@@ -645,27 +718,34 @@ ZLES_BUDGET(:,:,ILES)=-XLES_RES_ddxa_Rt_SBG_UaW(:,:,1) &
!* 3.22 writing
! -------
!
-!
-CALL LES_DIACHRO_MASKS(TPDIAFILE,YGROUP,YSUBTITLE(:ILES),"Rt flux budget"//YSUBTITLE(:ILES),"m kg kg-1 s-2", &
- ZLES_BUDGET(:,:,:ILES),HLES_AVG)
-!
-!
+tzfield%cmnhname = ygroup !cmnhname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%cstdname = ''
+tzfield%clongname = ygroup !clongname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%ccomment = 'Rt flux budget' !ccomment will be completed with yfieldnames(:) in Les_diachro
+tzfield%cunits = 'm kg kg-1 s-2'
+
+call Les_diachro( tpdiafile, tzfield, ygroup, ygroupcomment, gdoavg, gdonorm, zles_budget(:, :, :iles), &
+ hfieldnames = yfieldnames(:iles), hfieldcomments = yfieldcomments(:iles) )
+
!-------------------------------------------------------------------------------
!
!* 4. liquid potential temperature - total water covariance budget
! ------------------------------------------------------------
!
!
-YGROUP= 'BU_THLR '
+ygroup = 'BU_THLR'
+ygroupcomment = 'Liquid potential temperature - total water covariance budget'
+YGROUP= 'BU_THLR'
ILES=0
ILES_STA=ILES
!
!
-!* 2.1 production by mean gradients
+!* 2.1 dynamic production by mean gradients
! ----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YFIELDNAMES(ILES) = 'SBG_DP_M'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by mean gradient'
ILES_P1=ILES
!
ZLES_BUDGET(:,:,ILES)=-XLES_SUBGRID_WRt (:,:,1) * XLES_MEAN_dThldz(:,:,1) &
@@ -676,7 +756,8 @@ ZLES_BUDGET(:,:,ILES)=-XLES_SUBGRID_WRt (:,:,1) * XLES_MEAN_dThldz(:,:,1) &
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YFIELDNAMES(ILES) = 'SBG_DP_R'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by resolved fluctuations'
!
ZLES_BUDGET(:,:,ILES)= - XLES_RES_ddxa_Rt_SBG_UaThl(:,:,1) &
- XLES_RES_ddxa_Thl_SBG_UaRt(:,:,1) &
@@ -688,7 +769,8 @@ 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 '
+YFIELDNAMES(ILES) = 'SBG_TR'
+YFIELDCOMMENTS(ILES) = 'subgrid turbulent transport'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES) = - ( XLES_SUBGRID_WThlRt (JK+1,:,1) &
@@ -705,7 +787,8 @@ END IF
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS '
+YFIELDNAMES(ILES) = 'SBG_DISS'
+YFIELDCOMMENTS(ILES) = 'subgrid dissipation'
!
ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_ThlRt(:,:,1)
!
@@ -714,7 +797,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_SUBGRID_DISS_ThlRt(:,:,1)
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YFIELDNAMES(ILES) = 'SBG_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of subgrid budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -727,7 +811,8 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YFIELDNAMES(ILES) = 'RES_TEND'
+YFIELDCOMMENTS(ILES) = 'resolved tendency'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_TEND)
!
@@ -737,7 +822,8 @@ 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 '
+YFIELDNAMES(ILES) = 'RES_ADV'
+YFIELDCOMMENTS(ILES) = 'resolved advection by mean flow'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_ADVM)
END IF
@@ -747,7 +833,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_ThlRt(:,:,NLES_FORC)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES FORC'
+YFIELDNAMES(ILES) = 'RES_FORC'
+YFIELDCOMMENTS(ILES) = 'resolved advection by large-scale W forcing'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_FORC)
END IF
@@ -756,7 +843,8 @@ END IF
! ----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YFIELDNAMES(ILES) = 'RES_DP'
+YFIELDCOMMENTS(ILES) = 'resolved dynamic production by mean gradient'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_DP)
!
@@ -764,7 +852,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_DP)
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YFIELDNAMES(ILES) = 'RES_TR'
+YFIELDCOMMENTS(ILES) = 'turbulent transport of resolved flux by itself'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_TR)
!
@@ -773,7 +862,8 @@ ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_TR)
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YFIELDNAMES(ILES) = 'RES_SBGT'
+YFIELDCOMMENTS(ILES) = 'resolved sink due to subgrid turbulence'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_VTURB) + XLES_BU_RES_ThlRt(:,:,NLES_HTURB)
!
@@ -783,7 +873,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_NUMD'
+YFIELDCOMMENTS(ILES) = 'resolved numerical diffusion'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_DIFF)
END IF
@@ -793,7 +884,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_ThlRt(:,:,NLES_RELA)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RELA'
+YFIELDNAMES(ILES) = 'RES_RELA'
+YFIELDCOMMENTS(ILES) = 'resolved sponge layer relaxation'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_RELA)
END IF
@@ -803,7 +895,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_ThlRt(:,:,NLES_NEST)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES NEST'
+YFIELDNAMES(ILES) = 'RES_NEST'
+YFIELDCOMMENTS(ILES) = 'resolved average from smaller nested models'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_NEST)
END IF
@@ -816,7 +909,8 @@ 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'
+YFIELDNAMES(ILES) = 'RES_MISC'
+YFIELDCOMMENTS(ILES) = 'resolved: other effects'
!
ZLES_BUDGET(:,:,ILES) = XLES_BU_RES_ThlRt(:,:,NLES_MISC) &
+ XLES_BU_RES_ThlRt(:,:,NLES_PREF) &
@@ -829,7 +923,8 @@ END IF
! ---------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YFIELDNAMES(ILES) = 'RES_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of resolved budget'
!
ZLES_BUDGET(:,:,ILES) = 0.
DO JLES=ILES_STA+1,ILES-1
@@ -840,7 +935,8 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YFIELDNAMES(ILES) = 'NSG_TEND'
+YFIELDCOMMENTS(ILES) = 'neglected tendency'
!
ZLES_BUDGET(:,:,ILES) = 0.
IF (NLES_TIMES>2) THEN
@@ -859,7 +955,8 @@ END IF
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YFIELDNAMES(ILES) = 'NSG_ADVM'
+YFIELDCOMMENTS(ILES) = 'neglected advection by mean flow'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= -XLES_MEAN_W(JK,:,1) &
@@ -876,7 +973,8 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YFIELDNAMES(ILES) = 'NSG_ADVR'
+YFIELDCOMMENTS(ILES) = 'neglected advection by resolved flow'
!
DO JK=2,NLES_K-1
ZLES_BUDGET(JK,:,ILES)= - ( XLES_RES_W_SBG_ThlRt (JK+1,:,1) &
@@ -892,15 +990,21 @@ ZLES_BUDGET(NLES_K,:,ILES) = ZLES_BUDGET(NLES_K-1,:,ILES)
!* 2.16 writing
! -------
!
-!
-CALL LES_DIACHRO_MASKS(TPDIAFILE,YGROUP,YSUBTITLE(:ILES),"Thl-Rt covariance budget"//YSUBTITLE(:ILES), &
- "K kg kg-1 s-1",ZLES_BUDGET(:,:,:ILES),HLES_AVG)
-!
+tzfield%cmnhname = ygroup !cmnhname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%cstdname = ''
+tzfield%clongname = ygroup !clongname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%ccomment = 'Thl-Rt covariance budget' !ccomment will be completed with yfieldnames(:) in Les_diachro
+tzfield%cunits = 'K kg kg-1 s-1'
+
+call Les_diachro( tpdiafile, tzfield, ygroup, ygroupcomment, gdoavg, gdonorm, zles_budget(:, :, :iles), &
+ hfieldnames = yfieldnames(:iles), hfieldcomments = yfieldcomments(:iles) )
+
!-------------------------------------------------------------------------------
!
DEALLOCATE(ZLES_BUDGET)
-DEALLOCATE(YSUBTITLE)
!
!-------------------------------------------------------------------------------
!
-END SUBROUTINE WRITE_LES_RT_BUDGET_n
+end subroutine Write_les_rt_budget_n
+
+end module mode_write_les_rt_budget_n
diff --git a/src/MNH/write_les_sv_budgetn.f90 b/src/MNH/write_les_sv_budgetn.f90
index 10df1eebe24ef9fa2df341213eac4eceec3bba35..6a3997964fff08e950d3de7c18fa1603f5e392ad 100644
--- a/src/MNH/write_les_sv_budgetn.f90
+++ b/src/MNH/write_les_sv_budgetn.f90
@@ -1,33 +1,26 @@
-!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.
!-----------------------------------------------------------------
-!######################
-MODULE MODI_WRITE_LES_SV_BUDGET_n
-!######################
-!
-INTERFACE
-!
- SUBROUTINE WRITE_LES_SV_BUDGET_n(TPDIAFILE,HLES_AVG)
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
-CHARACTER(LEN=1), INTENT(IN) :: HLES_AVG ! flag to perform the averages
-! ! or normalizations
-END SUBROUTINE WRITE_LES_SV_BUDGET_n
-!
-END INTERFACE
-!
-END MODULE MODI_WRITE_LES_SV_BUDGET_n
+!################################
+module mode_write_les_sv_budget_n
+!################################
+
+implicit none
+
+private
-! ######################
- SUBROUTINE WRITE_LES_SV_BUDGET_n(TPDIAFILE,HLES_AVG)
-! ######################
+public :: Write_les_sv_budget_n
+
+contains
+
+!############################################
+subroutine Write_les_sv_budget_n( tpdiafile )
+!############################################
!
!
-!!**** *WRITE_LES_n* writes the LES final diagnostics for model _n
+!!**** *Write_les_sv_budget_n* writes the LES final diagnostics for model _n
!!
!!
!! PURPOSE
@@ -49,36 +42,46 @@ END MODULE MODI_WRITE_LES_SV_BUDGET_n
!! MODIFICATIONS
!! -------------
!! Original 06/11/02
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
-!! --------------------------------------------------------------------------
+! P. Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 14/10/2020: restructure Les_diachro calls to use tfield_metadata_base type
+! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_LES_n
-USE MODD_CONF_n
-USE MODD_LES_BUDGET
-USE MODD_NSV
-!
-USE MODE_ll
-!
-USE MODE_LES_DIACHRO
-!
+use modd_conf_n, only: luserv
+use modd_cst, only: xg
+use modd_field, only: NMNHDIM_BUDGET_LES_LEVEL, NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_LES_SV, &
+ NMNHDIM_BUDGET_TERM, NMNHDIM_UNUSED, &
+ tfield_metadata_base, TYPEREAL
+use modd_io, only: tfiledata
+use modd_les, only: cles_norm_type, nles_k, xles_temp_mean_start, xles_temp_mean_end, xles_temp_sampling
+use modd_les_n, only: nles_times, &
+ xles_bu_res_sv2, xles_bu_res_wsv, &
+ xles_mean_dsvdz, xles_mean_dwdz, xles_mean_th, xles_mean_thv, xles_mean_w, &
+ xles_res_ddxa_sv_sbg_uasv, xles_res_ddxa_sv_sbg_uaw, xles_res_ddxa_w_sbg_uasv, &
+ xles_res_ddz_sv_sbg_w2, xles_res_w_sbg_wsv, xles_res_w_sbg_sv2, &
+ xles_subgrid_diss_sv2, xles_subgrid_sv2, xles_subgrid_svpz, xles_subgrid_svthv, &
+ xles_subgrid_w2, xles_subgrid_wsv, xles_subgrid_wsv2, xles_subgrid_w2sv, &
+ xles_z
+use modd_les_budget, only: NLES_RELA, NLES_GRAV, NLES_COR, NLES_HTURB, NLES_VTURB, NLES_FORC, NLES_PRES, &
+ NLES_DIFF, NLES_DP, NLES_TR, NLES_TEND, NLES_ADVM, NLES_NEST, NLES_MISC
+use modd_nsv, only: nsv
+use modd_parameters, only: XUNDEF
+
+use mode_les_diachro, only: Les_diachro
+
IMPLICIT NONE
!
!
!* 0.1 declarations of arguments
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! file to write
-CHARACTER(LEN=1), INTENT(IN) :: HLES_AVG ! flag to perform the averages
-! ! or normalizations
!
!* 0.2 declaration of local variables
!
+integer, parameter :: NMAX_ILES = 50
+
INTEGER :: ILES
INTEGER :: ILES_STA
INTEGER :: JLES
@@ -89,20 +92,22 @@ INTEGER :: JT ! temporal loop counter
INTEGER :: JSV! scalar loop counter
INTEGER :: JP ! process loop counter
!
-CHARACTER(len=9), DIMENSION(:), ALLOCATABLE :: YSUBTITLE
-CHARACTER(len=8) :: YGROUP
-CHARACTER(len=20) :: YTITLE
+CHARACTER(len=9), DIMENSION(NMAX_ILES) :: YFIELDNAMES
+CHARACTER(len=100), DIMENSION(NMAX_ILES) :: YFIELDCOMMENTS
+character(len=:), allocatable :: ygroup
+character(len=:), allocatable :: ygroupcomment
!
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZLES_BUDGET
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV_BUDGET
!
+logical :: gdoavg ! Compute and store time average
+logical :: gdonorm ! Compute and store normalized field
+type(tfield_metadata_base) :: tzfield
!-------------------------------------------------------------------------------
!
!* Initializations
! ---------------
!
-ALLOCATE(ZLES_BUDGET(NLES_K,NLES_TIMES,50,NSV))
-ALLOCATE(YSUBTITLE(50))
+ALLOCATE(ZLES_BUDGET(NLES_K,NLES_TIMES,NMAX_ILES,NSV))
!
ZLES_BUDGET(:,:,:,:) = XUNDEF
!-------------------------------------------------------------------------------
@@ -111,16 +116,18 @@ ZLES_BUDGET(:,:,:,:) = XUNDEF
! ----------------------------
!
!
-YGROUP='BU_SV2 '
+ygroup = 'BU_SV2'
+ygroupcomment = 'Total scalar variance budget'
!
ILES=0
ILES_STA=ILES
!
-!* 2.1 production by mean gradients
+!* 2.1 dynamic production by mean gradients
! ----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YFIELDNAMES(ILES) = 'SBG_DP_M'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by mean gradient'
ILES_P1=ILES
!
DO JSV=1,NSV
@@ -132,7 +139,8 @@ END DO
! --------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YFIELDNAMES(ILES) = 'SBG_DP_R'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by resolved fluctuations'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV)= - 2. * XLES_RES_ddxa_Sv_SBG_UaSv(:,:,1,JSV) &
@@ -145,7 +153,8 @@ END DO
!
IF ( ANY(XLES_SUBGRID_WSv2(:,:,1,:)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TR '
+YFIELDNAMES(ILES) = 'SBG_TR'
+YFIELDCOMMENTS(ILES) = 'subgrid turbulent transport'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -164,7 +173,8 @@ END IF
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS '
+YFIELDNAMES(ILES) = 'SBG_DISS'
+YFIELDCOMMENTS(ILES) = 'subgrid dissipation'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_SUBGRID_DISS_Sv2(:,:,1,JSV)
@@ -175,7 +185,8 @@ END DO
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YFIELDNAMES(ILES) = 'SBG_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of subgrid budget'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -190,7 +201,8 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YFIELDNAMES(ILES) = 'RES_TEND'
+YFIELDCOMMENTS(ILES) = 'resolved tendency'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_TEND,JSV)
@@ -201,7 +213,8 @@ END DO
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_ADVM,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES ADV '
+ YFIELDNAMES(ILES) = 'RES_ADV'
+ YFIELDCOMMENTS(ILES) = 'resolved advection by mean flow'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_ADVM,JSV)
@@ -213,7 +226,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_FORC,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES FORC'
+ YFIELDNAMES(ILES) = 'RES_FORC'
+ YFIELDCOMMENTS(ILES) = 'resolved advection by large-scale W forcing'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_FORC,JSV)
@@ -225,7 +239,8 @@ END IF
! ----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YFIELDNAMES(ILES) = 'RES_DP'
+YFIELDCOMMENTS(ILES) = 'resolved dynamic production by mean gradient'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_DP,JSV)
@@ -235,7 +250,8 @@ END DO
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YFIELDNAMES(ILES) = 'RES_TR'
+YFIELDCOMMENTS(ILES) = 'turbulent transport of resolved flux by itself'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_TR,JSV)
@@ -246,7 +262,8 @@ END DO
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YFIELDNAMES(ILES) = 'RES_SBGT'
+YFIELDCOMMENTS(ILES) = 'resolved sink due to subgrid turbulence'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_VTURB,JSV) &
@@ -258,7 +275,8 @@ END DO
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_DIFF,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES NUMD'
+ YFIELDNAMES(ILES) = 'RES_NUMD'
+ YFIELDCOMMENTS(ILES) = 'resolved numerical diffusion'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_DIFF,JSV)
@@ -270,7 +288,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_RELA,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES RELA'
+ YFIELDNAMES(ILES) = 'RES_RELA'
+ YFIELDCOMMENTS(ILES) = 'resolved sponge layer relaxation'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_RELA,JSV)
@@ -282,7 +301,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_NEST,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES NEST'
+ YFIELDNAMES(ILES) = 'RES_NEST'
+ YFIELDCOMMENTS(ILES) = 'resolved average from smaller nested models'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_NEST,JSV)
@@ -294,7 +314,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_Sv2(:,:,NLES_MISC,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES MISC'
+ YFIELDNAMES(ILES) = 'RES_MISC'
+ YFIELDCOMMENTS(ILES) = 'resolved: other effects'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_Sv2(:,:,NLES_MISC,JSV)
@@ -305,7 +326,8 @@ END IF
! ---------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YFIELDNAMES(ILES) = 'RES_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of resolved budget'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -318,7 +340,8 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YFIELDNAMES(ILES) = 'NSG_TEND'
+YFIELDCOMMENTS(ILES) = 'neglected tendency'
!
IF (NLES_TIMES>2) THEN
DO JSV=1,NSV
@@ -339,7 +362,8 @@ END IF
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YFIELDNAMES(ILES) = 'NSG_ADVM'
+YFIELDCOMMENTS(ILES) = 'neglected advection by mean flow'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -357,7 +381,8 @@ END DO
! ----------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YFIELDNAMES(ILES) = 'NSG_ADVR'
+YFIELDCOMMENTS(ILES) = 'neglected advection by resolved flow'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -374,34 +399,47 @@ END DO
!* 2.16 writing
! -------
!
-ALLOCATE(ZSV_BUDGET(NLES_K,NLES_TIMES,ILES,NSV))
-DO JSV=1,NSV
- DO JP=1,ILES
- ZSV_BUDGET(:,:,JP,JSV) = ZLES_BUDGET(:,:,JP,JSV)
- END DO
-END DO
+tzfield%ngrid = 0 !Not on the Arakawa grid
+tzfield%ntype = TYPEREAL
+
+tzfield%cmnhname = ygroup !cmnhname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%cstdname = ''
+tzfield%clongname = ygroup !clongname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%ccomment = 'Sv variance budget' !ccomment will be completed with yfieldnames(:) in Les_diachro
+tzfield%cunits = 'kg2 kg-2 s-1'
+
+tzfield%ndims = 4
+tzfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tzfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tzfield%ndimlist(3) = NMNHDIM_BUDGET_TERM
+tzfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
+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, ygroup, ygroupcomment, gdoavg, gdonorm, zles_budget(:, :, :iles, :), &
+ hfieldnames = yfieldnames(:iles), hfieldcomments = yfieldcomments(:iles) )
-YTITLE = "Sv variance budget "
-CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,YGROUP,YSUBTITLE(:ILES),YTITLE//YSUBTITLE(:ILES),"kg2/kg2/s",ZSV_BUDGET,HLES_AVG)
-!
-DEALLOCATE(ZSV_BUDGET)
!-------------------------------------------------------------------------------
!
!* 3. total water flux budget
! -----------------------
!
!
-YGROUP = 'BU_WSV '
+ygroup = 'BU_WSV'
+ygroupcomment = 'Total water flux budget'
!
!
ILES=0
ILES_STA=ILES
!
-!* 3.1 production by mean gradients
+!* 3.1 dynamic production by mean gradients
! -----------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP M'
+YFIELDNAMES(ILES) = 'SBG_DP_M'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by mean gradient'
ILES_P1=ILES
!
DO JSV=1,NSV
@@ -414,7 +452,8 @@ END DO
! -------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG DP R'
+YFIELDNAMES(ILES) = 'SBG_DP_R'
+YFIELDCOMMENTS(ILES) = 'subgrid dynamic production by resolved fluctuations'
ILES_P2=ILES
!
DO JSV=1,NSV
@@ -429,7 +468,8 @@ END DO
!
IF ( ANY(XLES_SUBGRID_W2Sv(:,:,1,:)/= 0.) ) THEN
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TR '
+YFIELDNAMES(ILES) = 'SBG_TR'
+YFIELDCOMMENTS(ILES) = 'subgrid turbulent transport'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -448,7 +488,8 @@ END IF
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG PRES'
+YFIELDNAMES(ILES) = 'SBG_PRES'
+YFIELDCOMMENTS(ILES) = 'subgrid pressure-correlation'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_SUBGRID_SvPz(:,:,1,JSV)
@@ -459,7 +500,8 @@ END DO
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG TP '
+YFIELDNAMES(ILES) = 'SBG_TP'
+YFIELDCOMMENTS(ILES) = 'subgrid thermal production'
!
IF (LUSERV) THEN
DO JSV=1,NSV
@@ -478,7 +520,9 @@ END IF
! -----------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' DISS '
+!PW: not in documentation. Always set to 0
+YFIELDNAMES(ILES) = 'SBG_DISS'
+YFIELDCOMMENTS(ILES) = 'subgrid dissipation'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -489,7 +533,8 @@ END DO
! --------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' SBG RESI'
+YFIELDNAMES(ILES) = 'SBG_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of subgrid budget'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -504,7 +549,8 @@ ILES_STA=ILES
! --------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TEND'
+YFIELDNAMES(ILES) = 'RES_TEND'
+YFIELDCOMMENTS(ILES) = 'resolved tendency'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_TEND,JSV)
@@ -515,7 +561,8 @@ END DO
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_ADVM,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES ADV '
+ YFIELDNAMES(ILES) = 'RES_ADV'
+ YFIELDCOMMENTS(ILES) = 'resolved advection by mean flow'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_ADVM,JSV)
@@ -527,7 +574,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_FORC,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES FORC'
+ YFIELDNAMES(ILES) = 'RES_FORC'
+ YFIELDCOMMENTS(ILES) = 'resolved advection by large-scale W forcing'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_FORC,JSV)
@@ -538,7 +586,8 @@ END IF
! ----------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES DP '
+YFIELDNAMES(ILES) = 'RES_DP'
+YFIELDCOMMENTS(ILES) = 'resolved dynamic production by mean gradient'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_DP,JSV)
@@ -548,7 +597,8 @@ END DO
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TR '
+YFIELDNAMES(ILES) = 'RES_TR'
+YFIELDCOMMENTS(ILES) = 'turbulent transport of resolved flux by itself'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_TR,JSV)
@@ -559,7 +609,8 @@ END DO
! -------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES PRES'
+YFIELDNAMES(ILES) = 'RES_PRES'
+YFIELDCOMMENTS(ILES) = 'resolved pressure-correlation'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_PRES,JSV)
@@ -570,7 +621,8 @@ END DO
! ------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES TP '
+YFIELDNAMES(ILES) = 'RES_TP'
+YFIELDCOMMENTS(ILES) = 'resolved thermal production'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_GRAV,JSV)
@@ -581,7 +633,8 @@ END DO
! ----------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES SBGT'
+YFIELDNAMES(ILES) = 'RES_SBGT'
+YFIELDCOMMENTS(ILES) = 'resolved sink due to subgrid turbulence'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_VTURB,JSV) + XLES_BU_RES_WSv(:,:,NLES_HTURB,JSV)
@@ -592,7 +645,8 @@ END DO
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_COR,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES CORI'
+ YFIELDNAMES(ILES) = 'RES_CORI'
+ YFIELDCOMMENTS(ILES) = 'resolved Coriolis effect'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_COR,JSV)
@@ -604,7 +658,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_DIFF,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES NUMD'
+ YFIELDNAMES(ILES) = 'RES_NUMD'
+ YFIELDCOMMENTS(ILES) = 'resolved numerical diffusion'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_DIFF,JSV)
@@ -616,7 +671,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_RELA,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES RELA'
+ YFIELDNAMES(ILES) = 'RES_RELA'
+ YFIELDCOMMENTS(ILES) = 'resolved sponge layer relaxation'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_RELA,JSV)
@@ -628,7 +684,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_NEST,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES NEST'
+ YFIELDNAMES(ILES) = 'RES_NEST'
+ YFIELDCOMMENTS(ILES) = 'resolved average from smaller nested models'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_NEST,JSV)
@@ -640,7 +697,8 @@ END IF
!
IF ( ANY(XLES_BU_RES_WSv(:,:,NLES_MISC,:)/= 0.) ) THEN
ILES=ILES+1
- YSUBTITLE(ILES) = ' RES MISC'
+ YFIELDNAMES(ILES) = 'RES_MISC'
+ YFIELDCOMMENTS(ILES) = 'resolved: other effects'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = XLES_BU_RES_WSv(:,:,NLES_MISC,JSV)
@@ -651,7 +709,8 @@ END IF
! -------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' RES RESI'
+YFIELDNAMES(ILES) = 'RES_RESI'
+YFIELDCOMMENTS(ILES) = 'residual of resolved budget'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -664,7 +723,8 @@ END DO
! ------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG TEND'
+YFIELDNAMES(ILES) = 'NSG_TEND'
+YFIELDCOMMENTS(ILES) = 'neglected tendency'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV) = 0.
@@ -687,7 +747,8 @@ END DO
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVM'
+YFIELDNAMES(ILES) = 'NSG_ADVM'
+YFIELDCOMMENTS(ILES) = 'neglected advection by mean flow'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -705,7 +766,8 @@ END DO
! ------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG ADVR'
+YFIELDNAMES(ILES) = 'NSG_ADVR'
+YFIELDCOMMENTS(ILES) = 'neglected advection by resolved flow'
!
DO JSV=1,NSV
DO JK=2,NLES_K-1
@@ -722,7 +784,8 @@ END DO
! ----------------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGW'
+YFIELDNAMES(ILES) = 'NSG_DPGW'
+YFIELDCOMMENTS(ILES) = 'neglected production by gradient of vertical velocity for subgrid quantity'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV)=- XLES_RES_ddxa_W_SBG_UaSv(:,:,1,JSV)
@@ -733,7 +796,8 @@ END DO
! -------------------------------------------------------------------------
!
ILES=ILES+1
-YSUBTITLE(ILES) = ' NSG DPGT'
+YFIELDNAMES(ILES) = 'NSG_DPGT'
+YFIELDCOMMENTS(ILES) = 'neglected production by horizontal gradient of Thl for subgrid quantity'
!
DO JSV=1,NSV
ZLES_BUDGET(:,:,ILES,JSV)=-XLES_RES_ddxa_Sv_SBG_UaW(:,:,1,JSV) &
@@ -744,22 +808,34 @@ END DO
!* 3.22 writing
! -------
!
-ALLOCATE(ZSV_BUDGET(NLES_K,NLES_TIMES,ILES,NSV))
-DO JSV=1,NSV
- DO JP=1,ILES
- ZSV_BUDGET(:,:,JP,JSV) = ZLES_BUDGET(:,:,JP,JSV)
- END DO
-END DO
+tzfield%ngrid = 0 !Not on the Arakawa grid
+tzfield%ntype = TYPEREAL
+
+tzfield%cmnhname = ygroup !cmnhname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%cstdname = ''
+tzfield%clongname = ygroup !clongname will be overwritten by yfieldnames(:) in Les_diachro
+tzfield%ccomment = 'Sv flux budget' !ccomment will be completed with yfieldnames(:) in Les_diachro
+tzfield%cunits = 'm kg kg-1 s-2'
+
+tzfield%ndims = 4
+tzfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tzfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tzfield%ndimlist(3) = NMNHDIM_BUDGET_TERM
+tzfield%ndimlist(4) = NMNHDIM_BUDGET_LES_SV
+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, ygroup, ygroupcomment, gdoavg, gdonorm, zles_budget(:, :, :iles, :), &
+ hfieldnames = yfieldnames(:iles), hfieldcomments = yfieldcomments(:iles) )
-YTITLE = "Sv flux budget "
-CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,YGROUP,YSUBTITLE(:ILES),YTITLE//YSUBTITLE(:ILES),"mkg/kg/s2",ZSV_BUDGET,HLES_AVG)
-!
-DEALLOCATE(ZSV_BUDGET)
!-------------------------------------------------------------------------------
!
DEALLOCATE(ZLES_BUDGET)
-DEALLOCATE(YSUBTITLE)
!
!-------------------------------------------------------------------------------
!
-END SUBROUTINE WRITE_LES_SV_BUDGET_n
+end subroutine Write_les_sv_budget_n
+
+end module mode_write_les_sv_budget_n
diff --git a/src/MNH/write_lesn.f90 b/src/MNH/write_lesn.f90
index 1ae4ad90c4df2ed27e600a5de13bbcc226ba3c50..e4adb2045bd0fc24bbcf5f685c34fd7051a53ba7 100644
--- a/src/MNH/write_lesn.f90
+++ b/src/MNH/write_lesn.f90
@@ -1,34 +1,44 @@
-!MNH_LIC Copyright 2000-2019 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.
!-----------------------------------------------------------------
!######################
-MODULE MODI_WRITE_LES_n
+module mode_write_les_n
!######################
-!
-INTERFACE
-!
- SUBROUTINE WRITE_LES_n(TPDIAFILE,HLES_AVG)
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=1), INTENT(IN) :: HLES_AVG ! flag to perform the averages
-! ! or normalizations
-END SUBROUTINE WRITE_LES_n
-!
-END INTERFACE
-!
-END MODULE MODI_WRITE_LES_n
-! ######################
- SUBROUTINE WRITE_LES_n(TPDIAFILE,HLES_AVG)
-! ######################
+use modd_field, only: tfield_metadata_base
+
+implicit none
+
+private
+
+public :: Write_les_n
+
+
+character(len=:), allocatable :: cgroup
+character(len=:), allocatable :: cgroupcomment
+
+logical :: ldoavg ! Compute and store time average
+logical :: ldonorm ! Compute and store normalized field
+
+type(tfield_metadata_base) :: tfield
+type(tfield_metadata_base) :: tfieldx
+type(tfield_metadata_base) :: tfieldy
+
+interface Les_diachro_write
+ module procedure Les_diachro_write_1D, Les_diachro_write_2D, Les_diachro_write_3D, Les_diachro_write_4D
+end interface
+
+contains
+
+!###################################
+subroutine Write_les_n( tpdiafile )
+!###################################
!
!
-!!**** *WRITE_LES_n* writes the LES final diagnostics for model _n
-!!
+!!**** *WRITE_LES_n* writes the LES final diagnostics for model _n
+!!
!!
!! PURPOSE
!! -------
@@ -55,45 +65,43 @@ END MODULE MODI_WRITE_LES_n
!! 10/10/09 (P. Aumond) Add user multimaskS
!! 11/15 (C.Lac) Add production terms of TKE
!! 10/2016 (C.Lac) Add droplet deposition
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!!! 02/2019 (C. Lac) Add rain fraction as a LES diagnostic
-
-!! --------------------------------------------------------------------------
-!
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! C. Lac 02/2019: add rain fraction as a LES diagnostic
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! P. Wautelet 12/10/2020: remove HLES_AVG dummy argument and group all 4 calls
+! P. Wautelet 13/10/2020: bugfix: correct some names for LES_DIACHRO_2PT diagnostics (Ri)
+! P. Wautelet 26/10/2020: bugfix: correct some comments and conditions + add missing RES_RTPZ
+! P. Wautelet 26/10/2020: restructure subroutines to use tfield_metadata_base type
+! --------------------------------------------------------------------------
+!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LES
-USE MODD_LES_n
-USE MODD_FIELD_n
-USE MODD_CONF_n
-USE MODD_PARAM_n
-USE MODD_TURB_n
-USE MODD_GRID_n
-USE MODD_NSV, ONLY : NSV
-USE MODD_PARAM_ICE, ONLY : LDEPOSC
-USE MODD_PARAM_C2R2, ONLY : LDEPOC
-!
-USE MODE_ll
-!
-USE MODE_LES_DIACHRO
-USE MODE_LES_SPEC_N
-USE MODE_MODELN_HANDLER
-!
-USE MODI_WRITE_LES_BUDGET_n
-USE MODI_WRITE_LES_RT_BUDGET_n
-USE MODI_WRITE_LES_SV_BUDGET_n
-!
+use modd_conf_n, only: luserv, luserc, luserr, luseri, lusers, luserg, luserh
+use modd_io, only: tfiledata
+use modd_field, only: NMNHDIM_BUDGET_LES_TIME, NMNHDIM_BUDGET_LES_LEVEL, NMNHDIM_BUDGET_LES_SV, NMNHDIM_BUDGET_LES_MASK, &
+ NMNHDIM_BUDGET_LES_PDF, &
+ NMNHDIM_SPECTRA_2PTS_NI, NMNHDIM_SPECTRA_2PTS_NJ, NMNHDIM_SPECTRA_LEVEL, NMNHDIM_UNUSED, &
+ TYPEREAL
+use modd_grid_n, only: xdxhat, xdyhat
+use modd_nsv, only: nsv
+use modd_les
+use modd_les_n
+use modd_param_c2r2, only: ldepoc
+use modd_param_ice, only: ldeposc
+use modd_parameters, only: XUNDEF
+
+use mode_les_spec_n, only: Les_spec_n
+use mode_modeln_handler, only: Get_current_model_index
+use mode_write_les_budget_n, only: Write_les_budget_n
+use mode_write_les_rt_budget_n, only: Write_les_rt_budget_n
+use mode_write_les_sv_budget_n, only: Write_les_sv_budget_n
+
IMPLICIT NONE
!
-!
!* 0.1 declarations of arguments
!
TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE! file to write
-CHARACTER(LEN=1), INTENT(IN) :: HLES_AVG ! flag to perform the averages
-! ! or normalizations
!
!
!* 0.2 declaration of local variables
@@ -102,27 +110,22 @@ INTEGER :: IMASK
!
INTEGER :: JSV ! scalar loop counter
INTEGER :: JI ! loop counter
-INTEGER :: JPDF ! pdf 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
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZAVG_PTS_ll
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUND_PTS_ll
REAL :: ZCART_PTS_ll
INTEGER :: IMI ! Current model inde
!
-!
!-------------------------------------------------------------------------------
!
IF (.NOT. LLES) RETURN
!
-IF (HLES_AVG=='A' &
- .AND. (XLES_TEMP_MEAN_START==XUNDEF .OR. XLES_TEMP_MEAN_END==XUNDEF)) RETURN
-IF (HLES_AVG=='E' .AND. CLES_NORM_TYPE=='NONE' ) RETURN
-IF (HLES_AVG=='H' .AND. (CLES_NORM_TYPE=='NONE' &
- .OR. XLES_TEMP_MEAN_START/=XUNDEF .OR. XLES_TEMP_MEAN_END/=XUNDEF)) RETURN
-!
!* 1. Initializations
! ---------------
!
@@ -217,12 +220,8 @@ END IF
!
NLES_CURRENT_TIMES=NLES_TIMES
!
-ALLOCATE(XLES_CURRENT_TRAJT(NLES_TIMES,1))
-XLES_CURRENT_TRAJT(:,:) = XLES_TRAJT(:,:)
ALLOCATE(XLES_CURRENT_Z(NLES_K))
XLES_CURRENT_Z(:) = XLES_Z(:)
-ALLOCATE(XLES_CURRENT_DATIME(16,NLES_TIMES))
-XLES_CURRENT_DATIME(:,:) = XLES_DATIME(:,:)
!
XLES_CURRENT_ZS = XLES_ZS
!
@@ -233,1273 +232,1083 @@ NLES_CURRENT_JSUP=NLESn_JSUP(IMI)
!
XLES_CURRENT_DOMEGAX=XDXHAT(1)
XLES_CURRENT_DOMEGAY=XDYHAT(1)
-!
-!
+
+tfield%ngrid = 0 !Not on the Arakawa grid
+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
! ---------------------
!
-IF (HLES_AVG==' ' .OR. HLES_AVG=='A') THEN
- ALLOCATE(ZAVG_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
- ALLOCATE(ZUND_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
- !
- ZAVG_PTS_ll(:,:,:) = NLES_AVG_PTS_ll(:,:,:)
- ZUND_PTS_ll(:,:,:) = NLES_UND_PTS_ll(:,:,:)
- ZCART_PTS_ll = (NLESn_ISUP(IMI)-NLESn_IINF(IMI)+1) * (NLESn_JSUP(IMI)-NLESn_JINF(IMI)+1)
- !
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"AVG_PTS ",YSUBTITLE(:), &
- "number of points used for averaging"//YSUBTITLE(:),"1",ZAVG_PTS_ll,HLES_AVG)
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"AVG_PTSF",YSUBTITLE(:), &
- "fraction of points used for averaging"//YSUBTITLE(:),"1",ZAVG_PTS_ll/ZCART_PTS_ll,HLES_AVG)
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"UND_PTS ",YSUBTITLE(:), &
- "number of points below orography"//YSUBTITLE(:),"1",ZUND_PTS_ll,HLES_AVG)
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"UND_PTSF",YSUBTITLE(:), &
- "fraction of points below orography"//YSUBTITLE(:),"1",ZUND_PTS_ll/ZCART_PTS_ll,HLES_AVG)
- !
- DEALLOCATE(ZAVG_PTS_ll)
- DEALLOCATE(ZUND_PTS_ll)
-END IF
-!
-!
-!* 2.1 mean quantities
-! ---------------
-!
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_U ",YSUBTITLE(:), &
- "Mean U Profile"//YSUBTITLE(:),"m s-1",XLES_MEAN_U,HLES_AVG)
-
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_V ",YSUBTITLE(:), &
- "Mean V Profile"//YSUBTITLE(:),"m s-1",XLES_MEAN_V,HLES_AVG)
-
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_W ",YSUBTITLE(:), &
- "Mean W Profile"//YSUBTITLE(:),"m s-1",XLES_MEAN_W,HLES_AVG)
-
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_PRE",YSUBTITLE(:), &
- "Mean pressure Profile"//YSUBTITLE(:),"Pa",XLES_MEAN_P,HLES_AVG)
-
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_DP",YSUBTITLE(:), &
- "Mean Dyn production TKE Profile"//YSUBTITLE(:),"m2 s-3",XLES_MEAN_DP,HLES_AVG)
-
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_TP",YSUBTITLE(:), &
- "Mean Thermal production TKE Profile "//YSUBTITLE(:),"m2 s-3",XLES_MEAN_TP,HLES_AVG)
-
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_TR",YSUBTITLE(:), &
- "Mean transport production TKE Profile"//YSUBTITLE(:),"m2 s-3",XLES_MEAN_TR,HLES_AVG)
+ALLOCATE(ZAVG_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
+ALLOCATE(ZUND_PTS_ll (NLES_K,NLES_TIMES,NLES_MASKS))
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_DISS",YSUBTITLE(:), &
- "Mean Dissipation TKE Profile"//YSUBTITLE(:),"m2 s-3",XLES_MEAN_DISS,HLES_AVG)
+ZAVG_PTS_ll(:,:,:) = NLES_AVG_PTS_ll(:,:,:)
+ZUND_PTS_ll(:,:,:) = NLES_UND_PTS_ll(:,:,:)
+ZCART_PTS_ll = (NLESn_ISUP(IMI)-NLESn_IINF(IMI)+1) * (NLESn_JSUP(IMI)-NLESn_JINF(IMI)+1)
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_LM",YSUBTITLE(:), &
- "Mean mixing length Profile"//YSUBTITLE(:),"m",XLES_MEAN_LM,HLES_AVG)
+tfield%ndims = 3
+tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+tfield%ndimlist(4:) = NMNHDIM_UNUSED
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_RHO",YSUBTITLE(:), &
- "Mean density Profile"//YSUBTITLE(:),"kg m-3",XLES_MEAN_RHO,HLES_AVG)
+ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+ldonorm = .false.
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_TH ",YSUBTITLE(:),&
- "Mean potential temperature Profile"//YSUBTITLE(:),"K",XLES_MEAN_Th,HLES_AVG)
+cgroup = 'Miscellaneous'
+cgroupcomment = 'Miscellaneous terms (geometry, various unclassified averaged terms...)'
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_MF ",YSUBTITLE(:),&
- "Mass-flux Profile"//YSUBTITLE(:),"m s-1",XLES_MEAN_Mf,HLES_AVG)
+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 )
-IF (LUSERC) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_THL",YSUBTITLE(:), &
- "Mean liquid potential temperature Profile"//YSUBTITLE(:),"K",XLES_MEAN_Thl,HLES_AVG)
-
-IF (LUSERV) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_THV",YSUBTITLE(:), &
- "Mean virtual potential temperature Profile"//YSUBTITLE(:),"K",XLES_MEAN_Thv,HLES_AVG)
-
-IF (LUSERC) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_RT ",YSUBTITLE(:), &
- "Mean Rt Profile"//YSUBTITLE(:),"kg kg-1",XLES_MEAN_Rt,HLES_AVG)
-
-IF (LUSERV) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_RV ",YSUBTITLE(:), &
- "Mean Rv Profile"//YSUBTITLE(:),"kg kg-1",XLES_MEAN_Rv,HLES_AVG)
-
-IF (LUSERV) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_REHU ",YSUBTITLE(:), &
- "Mean Rh Profile"//YSUBTITLE(:),"percent",XLES_MEAN_Rehu,HLES_AVG)
-
-IF (LUSERV) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_QS ",YSUBTITLE(:), &
- "Mean Qs Profile"//YSUBTITLE(:),"kg kg-1",XLES_MEAN_Qs,HLES_AVG)
-
-IF (LUSERC) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_KHT ",YSUBTITLE(:),&
- "Eddy-diffusivity (temperature) Profile"//YSUBTITLE(:),"m2 s-1",XLES_MEAN_KHt,HLES_AVG)
-
-IF (LUSERC) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_KHR ",YSUBTITLE(:),&
- "Eddy-diffusivity (wvapor) Profile"//YSUBTITLE(:),"m2 s-1",XLES_MEAN_KHr,HLES_AVG)
-
-IF (LUSERC) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_RC ",YSUBTITLE(:), &
- "Mean Rc Profile"//YSUBTITLE(:),"kg kg-1",XLES_MEAN_Rc,HLES_AVG)
-
-IF (LUSERC) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_CF ",YSUBTITLE(:), &
- "Mean Cf Profile"//YSUBTITLE(:),"1",XLES_MEAN_Cf,HLES_AVG)
-
-IF (LUSERC) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_INDCF ",YSUBTITLE(:), &
- "Mean Cf>1-6 Profile (0 ou 1)"//YSUBTITLE(:),"1",XLES_MEAN_INDCf,HLES_AVG)
-
-IF (LUSERC) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_INDCF2 ",YSUBTITLE(:), &
- "Mean Cf>1-5 Profile (0 ou 1)"//YSUBTITLE(:),"1",XLES_MEAN_INDCf2,HLES_AVG)
-
-IF (LUSERR) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_RR ",YSUBTITLE(:), &
- "Mean Rr Profile"//YSUBTITLE(:),"kg kg-1",XLES_MEAN_Rr,HLES_AVG)
-
-IF (LUSERR) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_RF ",YSUBTITLE(:), &
- "Mean RF Profile"//YSUBTITLE(:),"1",XLES_MEAN_RF,HLES_AVG)
-
-IF (LUSERI) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_RI ",YSUBTITLE(:), &
- "Mean Ri Profile"//YSUBTITLE(:),"kg kg-1",XLES_MEAN_Ri,HLES_AVG)
-
-IF (LUSERS) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_RS ",YSUBTITLE(:), &
- "Mean Rs Profile"//YSUBTITLE(:),"kg kg-1",XLES_MEAN_Rs,HLES_AVG)
-
-IF (LUSERG) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_RG ",YSUBTITLE(:), &
- "Mean Rg Profile"//YSUBTITLE(:),"kg kg-1",XLES_MEAN_Rg,HLES_AVG)
-
-IF (LUSERH) &
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEAN_RH ",YSUBTITLE(:), &
- "Mean Rh Profile"//YSUBTITLE(:),"kg kg-1",XLES_MEAN_Rh,HLES_AVG)
-
-IF (NSV>0) &
-CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"MEAN_SV ",YSUBTITLE(:), &
- "Mean Sv Profiles"//YSUBTITLE(:),"kg kg-1",XLES_MEAN_Sv,HLES_AVG)
-
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEANWIND",YSUBTITLE(:), &
- "Profile of Mean Modulus of Wind"//YSUBTITLE(:),"m s-1",XLES_MEAN_WIND,HLES_AVG)
+DEALLOCATE(ZAVG_PTS_ll)
+DEALLOCATE(ZUND_PTS_ll)
!
-CALL LES_DIACHRO_MASKS(TPDIAFILE,"MEANMSFX",YSUBTITLE(:), &
- "Total updraft mass flux"//YSUBTITLE(:),"kg m-2 s-1",XLES_RESOLVED_MASSFX ,HLES_AVG)
+!* 2.1 mean quantities
+! ---------------
!
-IF (LLES_PDF) THEN
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"PDF_TH ",YSUBTITLE(:), &
- "Pdf potential temperature Profiles"//YSUBTITLE(:),"1",XLES_PDF_TH,HLES_AVG)
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"PDF_W ",YSUBTITLE(:), &
- "Pdf vertical velocity Profiles"//YSUBTITLE(:),"1",XLES_PDF_W,HLES_AVG)
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"PDF_THV ",YSUBTITLE(:), &
- "Pdf virtual pot. temp. Profiles"//YSUBTITLE(:),"1",XLES_PDF_THV,HLES_AVG)
-
- IF (LUSERV) THEN
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"PDF_RV ",YSUBTITLE(:), &
- "Pdf Rv Profiles"//YSUBTITLE(:),"1",XLES_PDF_RV,HLES_AVG)
- END IF
-
- IF (LUSERC) THEN
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"PDF_RC ",YSUBTITLE(:), &
- "Pdf Rc Profiles"//YSUBTITLE(:),"1",XLES_PDF_RC,HLES_AVG)
-
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"PDF_RT ",YSUBTITLE(:), &
- "Pdf Rt Profiles"//YSUBTITLE(:),"1",XLES_PDF_RT,HLES_AVG)
-
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"PDF_THL ",YSUBTITLE(:), &
- "Pdf Thl Profiles"//YSUBTITLE(:),"1",XLES_PDF_THL,HLES_AVG)
- END IF
- IF (LUSERR) &
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"PDF_RR ",YSUBTITLE(:), &
- "Pdf Rr Profiles"//YSUBTITLE(:),"1",XLES_PDF_RR,HLES_AVG)
-
- IF (LUSERI) &
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"PDF_RI ",YSUBTITLE(:), &
- "Pdf Ri Profiles"//YSUBTITLE(:),"1",XLES_PDF_RI,HLES_AVG)
-
- IF (LUSERS) &
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"PDF_RS ",YSUBTITLE(:), &
- "Pdf Rs Profiles"//YSUBTITLE(:),"1",XLES_PDF_RS,HLES_AVG)
-
- IF (LUSERG) &
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"PDF_RG ",YSUBTITLE(:), &
- "Pdf Rg Profiles"//YSUBTITLE(:),"1",XLES_PDF_RG,HLES_AVG)
-
-END IF
+cgroup = 'Mean'
+cgroupcomment = 'Mean vertical profiles of the model variables'
+
+tfield%ndims = 3
+tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+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', 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', ymasks )
+if ( luserv ) &
+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', ymasks )
+if ( luserv ) &
+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', ymasks )
+if ( luserv ) &
+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', ymasks )
+if ( luserc ) &
+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', ymasks )
+if ( luserc ) &
+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', ymasks )
+if ( luserc ) &
+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', ymasks )
+if ( luserr ) &
+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', ymasks )
+if ( lusers ) &
+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', ymasks )
+if ( luserh ) &
+call Les_diachro_write( tpdiafile, XLES_MEAN_Rh, 'MEAN_RH', 'Mean Rh Profile', 'kg kg-1', ymasks )
+
+if ( nsv > 0 ) then
+ tfield%ndims = 4
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ 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', ymasks )
+
+ tfield%ndims = 3
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_UNUSED
+ !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', ymasks )
+call Les_diachro_write( tpdiafile, XLES_RESOLVED_MASSFX, 'MEANMSFX', 'Total updraft mass flux', 'kg m-2 s-1', ymasks )
+
+if ( lles_pdf ) then
+ cgroup = 'PDF'
+ cgroupcomment = ''
+
+ tfield%ndims = 4
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_BUDGET_LES_PDF
+ tfield%ndimlist(5:) = NMNHDIM_UNUSED
+
+ 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', ymasks )
+ if ( luserc ) then
+ 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', ymasks )
+ if ( luseri ) &
+ 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', ymasks )
+ if ( luserg ) &
+ call Les_diachro_write( tpdiafile, XLES_PDF_RG, 'PDF_RG', 'Pdf Rg Profiles', '1', ymasks )
+end if
!
!* 2.2 resolved quantities
! -------------------
!
-IF (LLES_RESOLVED) THEN
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_U2 ",YSUBTITLE(:), &
- "Resolved <u2> variance "//YSUBTITLE(:),"m2 s-2",XLES_RESOLVED_U2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_V2 ",YSUBTITLE(:), &
- "Resolved <v2> variance"//YSUBTITLE(:),"m2 s-2",XLES_RESOLVED_V2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_W2 ",YSUBTITLE(:), &
- "Resolved <w2> variance"//YSUBTITLE(:),"m2 s-2",XLES_RESOLVED_W2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_UV ",YSUBTITLE(:), &
- "Resolved <uv> Flux"//YSUBTITLE(:),"m2 s-2",XLES_RESOLVED_UV,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WU ",YSUBTITLE(:), &
- "Resolved <wu> Flux"//YSUBTITLE(:),"m2 s-2",XLES_RESOLVED_WU,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WV ",YSUBTITLE(:), &
- "Resolved <wv> Flux"//YSUBTITLE(:),"m2 s-2",XLES_RESOLVED_WV,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_KE ",YSUBTITLE(:), &
- "Resolved TKE Profile"//YSUBTITLE(:),"m2 s-2",XLES_RESOLVED_Ke,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_P2 ",YSUBTITLE(:), &
- "Resolved pressure variance"//YSUBTITLE(:),"Pa2",XLES_RESOLVED_P2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_UPZ ",YSUBTITLE(:), &
- "Resolved <up> horizontal Flux"//YSUBTITLE(:),"Pa s-1",XLES_RESOLVED_UP,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_VPZ ",YSUBTITLE(:), &
- "Resolved <vp> horizontal Flux"//YSUBTITLE(:),"Pa s-1",XLES_RESOLVED_VP,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WPZ ",YSUBTITLE(:), &
- "Resolved <wp> vertical Flux"//YSUBTITLE(:),"Pa s-1",XLES_RESOLVED_WP,HLES_AVG)
-
- IF (LUSERV) &
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_THTV ",YSUBTITLE(:), &
- "Resolved potential temperature - virtual potential temperature covariance"//YSUBTITLE(:), &
- "K2",XLES_RESOLVED_ThThv,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_TLTV ",YSUBTITLE(:), &
- "Resolved liquid potential temperature - virtual potential temperature covariance"//YSUBTITLE(:), &
- "K2",XLES_RESOLVED_ThlThv,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_TH2 ",YSUBTITLE(:), &
- "Resolved potential temperature variance"//YSUBTITLE(:),"K2",XLES_RESOLVED_Th2,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_THL2",YSUBTITLE(:), &
- "Resolved liquid potential temperature variance"//YSUBTITLE(:),"K2",XLES_RESOLVED_Thl2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_UTH ",YSUBTITLE(:), &
- "Resolved <uth> horizontal Flux"//YSUBTITLE(:),"m K s-1",XLES_RESOLVED_UTh,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_VTH ",YSUBTITLE(:), &
- "Resolved <vth> horizontal Flux"//YSUBTITLE(:),"m K s-1",XLES_RESOLVED_VTh,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WTH ",YSUBTITLE(:), &
- "Resolved <wth> vertical Flux"//YSUBTITLE(:),"m K s-1",XLES_RESOLVED_WTh,HLES_AVG)
-
- IF (LUSERC) THEN
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_UTHL",YSUBTITLE(:), &
- "Resolved <uthl> horizontal Flux"//YSUBTITLE(:),"m K s-1",XLES_RESOLVED_UThl,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_VTHL",YSUBTITLE(:), &
- "Resolved <vthl> horizontal Flux"//YSUBTITLE(:),"m K s-1",XLES_RESOLVED_VThl,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WTHL",YSUBTITLE(:), &
- "Resolved <wthl> vertical Flux "//YSUBTITLE(:),"m K s-1",XLES_RESOLVED_WThl,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_RT2 ",YSUBTITLE(:), &
- "Resolved total water variance"//YSUBTITLE(:),"kg2 kg-2",XLES_RESOLVED_Rt2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WRT ",YSUBTITLE(:), &
- "Resolved <wrt> vertical Flux "//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_WRt,HLES_AVG)
- END IF
-
- IF (LUSERV) THEN
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_UTHV",YSUBTITLE(:), &
- "Resolved <uthv> horizontal Flux"//YSUBTITLE(:),"m K s-1",XLES_RESOLVED_UThv,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_VTHV",YSUBTITLE(:), &
- "Resolved <vthl> horizontal Flux"//YSUBTITLE(:),"m K s-1",XLES_RESOLVED_VThv,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WTHV",YSUBTITLE(:), &
- "Resolved <wthv> vertical Flux "//YSUBTITLE(:),"m K s-1",XLES_RESOLVED_WThv,HLES_AVG)
- END IF
-!
- IF (LUSERV) THEN
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_RV2 ",YSUBTITLE(:), &
- "Resolved water vapor variance"//YSUBTITLE(:),"kg2 kg-2",XLES_RESOLVED_Rv2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_THRV",YSUBTITLE(:), &
- "Resolved <thrv> covariance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThRv,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_TLRV",YSUBTITLE(:), &
- "Resolved <thlrv> covariance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThlRv,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_TVRV",YSUBTITLE(:), &
- "Resolved <thvrv> covariance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThvRv,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_URV ", YSUBTITLE(:), &
- "Resolved <urv> horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_URv,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_VRV ", YSUBTITLE(:), &
- "Resolved <vrv> horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_VRv,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WRV ", YSUBTITLE(:), &
- "Resolved <wrv> vertical flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_WRv,HLES_AVG)
- END IF
-
- IF (LUSERC) THEN
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_RC2 ", YSUBTITLE(:), &
- "Resolved cloud water variance"//YSUBTITLE(:),"kg2 kg-2",XLES_RESOLVED_Rc2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_THRC", YSUBTITLE(:), &
- "Resolved <thrc> covariance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThRc,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_TLRC", YSUBTITLE(:), &
- "Resolved <thlrc> covariance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThlRc,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_TVRC", YSUBTITLE(:), &
- "Resolved <thvrc> covariance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThvRc,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_URC ", YSUBTITLE(:), &
- "Resolved <urc> horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_URc,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_VRC ", YSUBTITLE(:), &
- "Resolved <vrc> horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_VRc,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WRC ", YSUBTITLE(:), &
- "Resolved <wrc> vertical flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_WRc,HLES_AVG)
- END IF
-
- IF (LUSERI) THEN
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_RI2 ", YSUBTITLE(:), &
- "Resolved cloud ice variance"//YSUBTITLE(:),"kg2 kg-2",XLES_RESOLVED_Ri2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_THRI", YSUBTITLE(:), &
- "Resolved <thri> covariance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThRi,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_TLRI", YSUBTITLE(:), &
- "Resolved <thlri> covariance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThlRi,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_TVRI", YSUBTITLE(:), &
- "Resolved <thvri> covariance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThvRi,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_URI ", YSUBTITLE(:), &
- "Resolved <uri> horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_URi,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_VRI ", YSUBTITLE(:), &
- "Resolved <vri> horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_VRi,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WRI ", YSUBTITLE(:), &
- "Resolved <wri> vertical flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_WRi,HLES_AVG)
- END IF
-
- IF (LUSERR) THEN
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WRR ", YSUBTITLE(:), &
- "Resolved <wrr> vertical flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_WRr,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"INPRR3D ", YSUBTITLE(:), &
- "Precipitation flux"//YSUBTITLE(:),"m s-1",XLES_INPRR3D,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"MAXINPR3D ", YSUBTITLE(:), &
- "Max Precip flux"//YSUBTITLE(:),"m s-1",XLES_MAX_INPRR3D,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"EVAP3D ", YSUBTITLE(:), &
- "Evaporation profile"//YSUBTITLE(:),"kg kg-1 s-1",XLES_EVAP3D,HLES_AVG)
- ENDIF
- IF (NSV>0) THEN
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RES_SV2 ", YSUBTITLE(:), &
- "Resolved scalar variables variances"//YSUBTITLE(:),"kg2 kg-2",XLES_RESOLVED_Sv2,HLES_AVG)
-
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RES_THSV", YSUBTITLE(:), &
- "Resolved <ThSv> variance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThSv,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RES_TLSV", YSUBTITLE(:), &
- "Resolved <ThlSv> variance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThlSv,HLES_AVG)
-
- IF (LUSERV) &
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RES_TVSV", YSUBTITLE(:), &
- "Resolved <ThvSv> variance"//YSUBTITLE(:),"K kg kg-1",XLES_RESOLVED_ThvSv,HLES_AVG)
-
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RES_USV ", YSUBTITLE(:), &
- "Resolved <uSv> horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_USv,HLES_AVG)
-
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RES_VSV ", YSUBTITLE(:), &
- "Resolved <vSv> horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_VSv,HLES_AVG)
-
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RES_WSV ", YSUBTITLE(:), &
- "Resolved <wSv> vertical flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_RESOLVED_WSv,HLES_AVG)
- END IF
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_U3 ",YSUBTITLE(:), &
- "Resolved <w3>"//YSUBTITLE(:),"m3 s-3",XLES_RESOLVED_U3,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_V3 ",YSUBTITLE(:), &
- "Resolved <w3>"//YSUBTITLE(:),"m3 s-3",XLES_RESOLVED_V3,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_W3 ",YSUBTITLE(:), &
- "Resolved <w3>"//YSUBTITLE(:),"m3 s-3",XLES_RESOLVED_W3,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_U4 ",YSUBTITLE(:), &
- "Resolved <w3>"//YSUBTITLE(:),"m4 s-4",XLES_RESOLVED_U4,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_V4 ",YSUBTITLE(:), &
- "Resolved <w3>"//YSUBTITLE(:),"m4 s-4",XLES_RESOLVED_V4,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_W4 ",YSUBTITLE(:), &
- "Resolved <w3>"//YSUBTITLE(:),"m4 s-4",XLES_RESOLVED_W4,HLES_AVG)
-
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WTL2",YSUBTITLE(:), &
- "Resolved <wThl2>"//YSUBTITLE(:),"m K2 s-1",XLES_RESOLVED_WThl2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_W2TL",YSUBTITLE(:), &
- "Resolved <w2Thl>"//YSUBTITLE(:),"m2 K s-2",XLES_RESOLVED_W2Thl,HLES_AVG)
-
- IF (LUSERV) THEN
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WRV2",YSUBTITLE(:), &
- "Resolved <wRv2>"//YSUBTITLE(:),"m kg2 kg-2 s-1",XLES_RESOLVED_WRv2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_W2RV",YSUBTITLE(:), &
- "Resolved <w2Rv>"//YSUBTITLE(:),"m2 kg kg-1 s-2",XLES_RESOLVED_W2Rv,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WRT2",YSUBTITLE(:), &
- "Resolved <wRt2>"//YSUBTITLE(:),"m kg2 kg-2 s-1",XLES_RESOLVED_WRt2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_W2RT",YSUBTITLE(:), &
- "Resolved <w2Rt>"//YSUBTITLE(:),"m2 kg kg-1 s-2",XLES_RESOLVED_W2Rt,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RE_WTLRV",YSUBTITLE(:), &
- "Resolved <wThlRv>"//YSUBTITLE(:),"m K kg kg-1 s-1",XLES_RESOLVED_WThlRv,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RE_WTLRT",YSUBTITLE(:), &
- "Resolved <wThlRt>"//YSUBTITLE(:),"m K kg kg-1 s-1",XLES_RESOLVED_WThlRt,HLES_AVG)
- END IF
-
- IF (LUSERC) THEN
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WRC2",YSUBTITLE(:), &
- "Resolved <wRc2>"//YSUBTITLE(:),"m kg2 kg-2 s-1",XLES_RESOLVED_WRc2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_W2RC",YSUBTITLE(:), &
- "Resolved <w2Rc>"//YSUBTITLE(:),"m2 kg kg-1 s-2",XLES_RESOLVED_W2Rc,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RE_WTLRC",YSUBTITLE(:), &
- "Resolved <wThlRc>"//YSUBTITLE(:),"m K kg kg-1 s-1",XLES_RESOLVED_WThlRc,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RE_WRVRC",YSUBTITLE(:), &
- "Resolved <wRvRc>"//YSUBTITLE(:),"m kg2 kg-2 s-1",XLES_RESOLVED_WRvRc,HLES_AVG)
- END IF
-
- IF (LUSERI) THEN
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WRI2",YSUBTITLE(:), &
- "Resolved <wRi2>"//YSUBTITLE(:),"m kg2 kg-2 s-1",XLES_RESOLVED_WRi2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_W2RI",YSUBTITLE(:), &
- "Resolved <w2Ri>"//YSUBTITLE(:),"m2 kg kg-1 s-2",XLES_RESOLVED_W2Ri,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RE_WTLRI",YSUBTITLE(:), &
- "Resolved <wThlRi>"//YSUBTITLE(:),"m K kg kg-1 s-1",XLES_RESOLVED_WThlRi,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RE_WRVRI",YSUBTITLE(:), &
- "Resolved <wRvRi>"//YSUBTITLE(:),"m kg2 kg-2 s-1",XLES_RESOLVED_WRvRi,HLES_AVG)
- END IF
-
- IF (NSV>0) THEN
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RES_WSV2",YSUBTITLE(:), &
- "Resolved <wSv2>"//YSUBTITLE(:),"m kg2 kg-2 s-1",XLES_RESOLVED_WSv2,HLES_AVG)
-
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RES_W2SV",YSUBTITLE(:), &
- "Resolved <w2Sv>"//YSUBTITLE(:),"m2 kg kg-1 s-2",XLES_RESOLVED_W2Sv,HLES_AVG)
-
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RE_WTLSV",YSUBTITLE(:), &
- "Resolved <wThlSv>"//YSUBTITLE(:),"m K kg kg-1 s-1",XLES_RESOLVED_WThlSv,HLES_AVG)
-
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RE_WRVSV",YSUBTITLE(:), &
- "Resolved <wRvSv>"//YSUBTITLE(:),"m kg2 kg-2 s-1",XLES_RESOLVED_WRvSv,HLES_AVG)
- END IF
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_TLPZ",YSUBTITLE(:), &
- "Resolved <Thldp/dz>"//YSUBTITLE(:),"K Pa m-1",XLES_RESOLVED_ThlPz,HLES_AVG)
-
- IF (LUSERV) &
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_RVPZ",YSUBTITLE(:), &
- "Resolved <Rvdp/dz>"//YSUBTITLE(:),"kg2 kg-2 Pa m-1",XLES_RESOLVED_RvPz,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_RCPZ",YSUBTITLE(:), &
- "Resolved <Rcdp/dz>"//YSUBTITLE(:),"kg2 kg-2 Pa m-1",XLES_RESOLVED_RcPz,HLES_AVG)
-
- IF (LUSERI) &
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_RIPZ",YSUBTITLE(:), &
- "Resolved <Ridp/dz>"//YSUBTITLE(:),"kg2 kg-2 Pa m-1",XLES_RESOLVED_RiPz,HLES_AVG)
-
- IF (NSV>0) THEN
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"RES_SVPZ",YSUBTITLE(:), &
- "Resolved <Svdp/dz>"//YSUBTITLE(:),"kg2 kg-2 Pa m-1",XLES_RESOLVED_SvPz,HLES_AVG)
- END IF
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_UKE ", YSUBTITLE(:), &
- "Resolved flux of resolved kinetic energy"//YSUBTITLE(:),"m3 s-3",XLES_RESOLVED_UKe,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_VKE ", YSUBTITLE(:), &
- "Resolved flux of resolved kinetic energy"//YSUBTITLE(:),"m3 s-3",XLES_RESOLVED_VKe,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RES_WKE ", YSUBTITLE(:), &
- "Resolved flux of resolved kinetic energy"//YSUBTITLE(:),"m3 s-3",XLES_RESOLVED_WKe,HLES_AVG)
-
-END IF
+if ( lles_resolved ) then
+ !Prepare metadata (used in Les_diachro_write calls)
+ ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+ ldonorm = trim(cles_norm_type) /= 'NONE'
+
+ cgroup = 'Resolved'
+ cgroupcomment = 'Mean vertical profiles of the resolved fluxes, variances and covariances'
+
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ 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', 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', ymasks )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_RESOLVED_ThlThv, 'RES_TLTV', &
+ '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',&
+ 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', 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', 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', 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', 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', 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', 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
+ tfield%ndims = 4
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ 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', 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', ymasks )
+ if ( luserv ) &
+ 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
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_UNUSED
+ !tfield%ndimlist(5:) = NMNHDIM_UNUSED
+ end if
+
+ 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', 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', 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', 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', 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
+ tfield%ndims = 4
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ 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', 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', ymasks )
+
+ tfield%ndims = 3
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_UNUSED
+ !tfield%ndimlist(5:) = NMNHDIM_UNUSED
+ end if
+
+ 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', ymasks )
+ if ( luserv ) &
+ 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', ymasks )
+ if ( luseri ) &
+ 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
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ 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', ymasks )
+
+ tfield%ndims = 3
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_UNUSED
+ !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', 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
!
!
!* 2.3 subgrid quantities
! ------------------
!
-IF (LLES_SUBGRID) THEN
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_TKE ",YSUBTITLE(:), &
- "Subgrid TKE"//YSUBTITLE(:),"m2 s-2",XLES_SUBGRID_Tke,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_U2 ", YSUBTITLE(:), &
- "Subgrid <u2> variance"//YSUBTITLE(:),"m2 s-2",XLES_SUBGRID_U2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_V2 ", YSUBTITLE(:), &
- "Subgrid <v2> variance"//YSUBTITLE(:),"m2 s-2",XLES_SUBGRID_V2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_W2 ", YSUBTITLE(:), &
- "Subgrid <w2> variance"//YSUBTITLE(:),"m2 s-2",XLES_SUBGRID_W2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_UV ", YSUBTITLE(:), &
- "Subgrid <uv> flux"//YSUBTITLE(:),"m2 s-2",XLES_SUBGRID_UV,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_WU ", YSUBTITLE(:), &
- "Subgrid <wu> flux"//YSUBTITLE(:),"m2 s-2",XLES_SUBGRID_WU,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_WV ", YSUBTITLE(:), &
- "Subgrid <wv> flux"//YSUBTITLE(:),"m2 s-2",XLES_SUBGRID_WV,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_THL2", YSUBTITLE(:), &
- "Subgrid liquid potential temperature variance"//YSUBTITLE(:),"K2",XLES_SUBGRID_Thl2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_UTHL", YSUBTITLE(:), &
- "Subgrid hor. flux of liquid potential temperature"//YSUBTITLE(:),"m K s-1",XLES_SUBGRID_UThl,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_VTHL", YSUBTITLE(:), &
- "Subgrid hor. flux of liquid potential temperature"//YSUBTITLE(:),"m K s-1",XLES_SUBGRID_VThl,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_WTHL", YSUBTITLE(:), &
- "Subgrid vert. flux of liquid potential temperature"//YSUBTITLE(:),"m K s-1",XLES_SUBGRID_WThl,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_WP ",YSUBTITLE(:), &
- "Subgrid <wp> vertical Flux"//YSUBTITLE(:),"mPa/s",XLES_SUBGRID_WP,HLES_AVG)
-!!
-!!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"THLUP_MF",YSUBTITLE(:), &
- "Subgrid <thl> of updraft"//YSUBTITLE(:),"K",XLES_SUBGRID_THLUP_MF,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RTUP_MF ",YSUBTITLE(:), &
- "Subgrid <rt> of updraft"//YSUBTITLE(:),"kg kg-1",XLES_SUBGRID_RTUP_MF,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RVUP_MF ",YSUBTITLE(:), &
- "Subgrid <rv> of updraft"//YSUBTITLE(:),"kg kg-1",XLES_SUBGRID_RVUP_MF,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RCUP_MF ",YSUBTITLE(:), &
- "Subgrid <rc> of updraft"//YSUBTITLE(:),"kg kg-1",XLES_SUBGRID_RCUP_MF,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"RIUP_MF ",YSUBTITLE(:), &
- "Subgrid <ri> of updraft"//YSUBTITLE(:),"kg kg-1",XLES_SUBGRID_RIUP_MF,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"WUP_MF ",YSUBTITLE(:), &
- "Subgrid <w> of updraft"//YSUBTITLE(:),"m s-1",XLES_SUBGRID_WUP_MF,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"MAFLX_MF",YSUBTITLE(:), &
- "Subgrid <MF> of updraft"//YSUBTITLE(:),"kg m-2 s-1",XLES_SUBGRID_MASSFLUX,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"DETR_MF ",YSUBTITLE(:), &
- "Subgrid <detr> of updraft"//YSUBTITLE(:),"kg m-3 s-1",XLES_SUBGRID_DETR,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"ENTR_MF ",YSUBTITLE(:), &
- "Subgrid <entr> of updraft"//YSUBTITLE(:),"kg m-3 s-1",XLES_SUBGRID_ENTR,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"FRCUP_MF",YSUBTITLE(:), &
- "Subgrid <FracUp> of updraft"//YSUBTITLE(:),"1",XLES_SUBGRID_FRACUP,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"THVUP_MF",YSUBTITLE(:), &
- "Subgrid <thv> of updraft"//YSUBTITLE(:),"K",&
- XLES_SUBGRID_THVUP_MF,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"WTHL_MF ",YSUBTITLE(:), &
- "Subgrid <wthl> of mass flux convection scheme"//YSUBTITLE(:),"m K s-1",&
- XLES_SUBGRID_WTHLMF,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"WRT_MF ",YSUBTITLE(:), &
- "Subgrid <wrt> of mass flux convection scheme"//YSUBTITLE(:),"m kg kg-1 s-1",&
- XLES_SUBGRID_WRTMF,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"WTHV_MF ",YSUBTITLE(:), &
- "Subgrid <wthv> of mass flux convection scheme"//YSUBTITLE(:),"m K s-1",&
- XLES_SUBGRID_WTHVMF,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"WU_MF ",YSUBTITLE(:), &
- "Subgrid <wu> of mass flux convection scheme"//YSUBTITLE(:),"m2 s-2",&
- XLES_SUBGRID_WUMF,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"WV_MF ",YSUBTITLE(:), &
- "Subgrid <wv> of mass flux convection scheme"//YSUBTITLE(:),"m2 s-2",&
- XLES_SUBGRID_WVMF,HLES_AVG)
-!!
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_PHI3",YSUBTITLE(:), &
- "Subgrid Phi3 function"//YSUBTITLE(:),"1",XLES_SUBGRID_PHI3,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_LMIX",YSUBTITLE(:), &
- "Subgrid Mixing Length"//YSUBTITLE(:),"1",XLES_SUBGRID_LMix,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_LDIS",YSUBTITLE(:), &
- "Subgrid Dissipation Length"//YSUBTITLE(:),"1",XLES_SUBGRID_LDiss,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_KM ",YSUBTITLE(:), &
- "Eddy diffusivity for momentum"//YSUBTITLE(:),"m2 s-1",XLES_SUBGRID_Km,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_KH ",YSUBTITLE(:), &
- "Eddy diffusivity for heat"//YSUBTITLE(:),"m2 s-1",XLES_SUBGRID_Kh,HLES_AVG)
-!
- IF (LUSERV) THEN
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_WTHV", YSUBTITLE(:), &
- "Subgrid vert. flux of liquid potential temperature"//YSUBTITLE(:),"m K s-1",XLES_SUBGRID_WThv,HLES_AVG)
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_RT2 ", YSUBTITLE(:), &
- "Subgrid total water variance"//YSUBTITLE(:),"kg2 kg-2",XLES_SUBGRID_Rt2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_TLRT", YSUBTITLE(:), &
- "Subgrid <thlrt> covariance"//YSUBTITLE(:),"K kg kg-1",XLES_SUBGRID_ThlRt,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_URT ", YSUBTITLE(:), &
- "Subgrid total water horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_SUBGRID_URt,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_VRT ", YSUBTITLE(:), &
- "Subgrid total water horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_SUBGRID_VRt,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_WRT ", YSUBTITLE(:), &
- "Subgrid total water vertical flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_SUBGRID_WRt,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_PSI3",YSUBTITLE(:), &
- "Subgrid Psi3 function"//YSUBTITLE(:),"1",XLES_SUBGRID_PSI3,HLES_AVG)
- END IF
-
- IF (LUSERC) THEN
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_RC2 ", YSUBTITLE(:), &
- "Subgrid cloud water variance"//YSUBTITLE(:),"kg2 kg-2",XLES_SUBGRID_Rc2,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_URC ", YSUBTITLE(:), &
- "Subgrid cloud water horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_SUBGRID_URc,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_VRC ", YSUBTITLE(:), &
- "Subgrid cloud water horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_SUBGRID_VRc,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_WRC ", YSUBTITLE(:), &
- "Subgrid cloud water vertical flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_SUBGRID_WRc,HLES_AVG)
- END IF
-
- IF (NSV>0) THEN
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"SBG_USV ", YSUBTITLE(:), &
- "Subgrid <uSv> horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_SUBGRID_USv,HLES_AVG)
-
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"SBG_VSV ", YSUBTITLE(:), &
- "Subgrid <vSv> horizontal flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_SUBGRID_VSv,HLES_AVG)
-
- CALL LES_DIACHRO_SV_MASKS(TPDIAFILE,"SBG_WSV ", YSUBTITLE(:), &
- "Subgrid <wSv> vertical flux"//YSUBTITLE(:),"m kg kg-1 s-1",XLES_SUBGRID_WSv,HLES_AVG)
- END IF
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_UTKE", YSUBTITLE(:), &
- "Subgrid flux of subgrid kinetic energy"//YSUBTITLE(:),"m3 s-3",XLES_SUBGRID_UTke,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_VTKE", YSUBTITLE(:), &
- "Subgrid flux of subgrid kinetic energy"//YSUBTITLE(:),"m3 s-3",XLES_SUBGRID_VTke,HLES_AVG)
-
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_WTKE",YSUBTITLE(:), &
- "Subgrid flux of subgrid kinetic energy"//YSUBTITLE(:),"m3 s-3",XLES_SUBGRID_WTke,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_W2TL",YSUBTITLE(:), &
- "Subgrid flux of subgrid kinetic energy"//YSUBTITLE(:),"m2 K s-2",XLES_SUBGRID_W2Thl,HLES_AVG)
-!
- CALL LES_DIACHRO_MASKS(TPDIAFILE,"SBG_WTL2",YSUBTITLE(:), &
- "Subgrid flux of subgrid kinetic energy"//YSUBTITLE(:),"m K2 s-1",XLES_SUBGRID_WThl2,HLES_AVG)
-!
-END IF
+if ( lles_subgrid ) then
+ !Prepare metadata (used in Les_diachro_write calls)
+ ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+ ldonorm = trim(cles_norm_type) /= 'NONE'
+
+ cgroup = 'Subgrid'
+ cgroupcomment = 'Mean vertical profiles of the subgrid fluxes, variances and covariances'
+
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ 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', 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', 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', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WRTMF, 'WRT_MF', 'Subgrid <wrt> of mass flux convection scheme', &
+ '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', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WUMF, 'WU_MF', 'Subgrid <wu> of mass flux convection scheme', &
+ 'm2 s-2', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WVMF, 'WV_MF', 'Subgrid <wv> of mass flux convection scheme', &
+ 'm2 s-2', ymasks )
+
+ 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 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', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_VRt, 'SBG_VRT', 'Subgrid total water horizontal flux', &
+ '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', 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', ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_URc, 'SBG_URC', 'Subgrid cloud water horizontal flux', 'm kg kg-1 s-1', &
+ ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_VRc, 'SBG_VRC', 'Subgrid cloud water horizontal flux', 'm kg kg-1 s-1', &
+ ymasks )
+ call Les_diachro_write( tpdiafile, XLES_SUBGRID_WRc, 'SBG_WRC', 'Subgrid cloud water vertical flux', 'm kg kg-1 s-1', &
+ ymasks )
+ end if
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 4
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ 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', 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
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ !tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_MASK
+ tfield%ndimlist(4) = NMNHDIM_UNUSED
+ !tfield%ndimlist(5:) = NMNHDIM_UNUSED
+
+
+ end if
+
+ 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
+
+
+!Prepare metadata (used in Les_diachro_write calls)
+tfield%ndims = 2
+tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tfield%ndimlist(3:) = NMNHDIM_UNUSED
+
+ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+ldonorm = trim(cles_norm_type) /= 'NONE'
!
!* 2.4 Updraft quantities
! ------------------
!
-IF (LLES_UPDRAFT) THEN
- CALL LES_DIACHRO(TPDIAFILE,"UP_FRAC ", &
- "Updraft fraction","1",XLES_UPDRAFT,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_W ", &
- "Updraft W mean value","m s-1",XLES_UPDRAFT_W,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_TH ", &
- "Updraft potential temperature mean value","K",XLES_UPDRAFT_Th,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_THL ", &
- "Updraft liquid potential temperature mean value","K",XLES_UPDRAFT_Thl,HLES_AVG)
-
- IF (LUSERV) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_THV ", &
- "Updraft virutal potential temperature mean value","K",XLES_UPDRAFT_Thv,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_KE ", &
- "Updraft resolved TKE mean value","m2 s-2",XLES_UPDRAFT_Ke,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_TKE ", &
- "Updraft subgrid TKE mean value","m2 s-2",XLES_UPDRAFT_Tke,HLES_AVG)
-
- IF (LUSERV) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_RV ", &
- "Updraft water vapor mean value","kg kg-1",XLES_UPDRAFT_Rv,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_RC ", &
- "Updraft cloud water mean value","kg kg-1",XLES_UPDRAFT_Rc,HLES_AVG)
-
- IF (LUSERR) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_RR ", &
- "Updraft rain mean value","kg kg-1",XLES_UPDRAFT_Rr,HLES_AVG)
-
- IF (LUSERI) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_RI ", &
- "Updraft ice mean value","kg kg-1",XLES_UPDRAFT_Ri,HLES_AVG)
-
- IF (LUSERS) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_RS ", &
- "Updraft snow mean value","kg kg-1",XLES_UPDRAFT_Rs,HLES_AVG)
-
- IF (LUSERG) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_RG ", &
- "Updraft graupel mean value","kg kg-1",XLES_UPDRAFT_Rg,HLES_AVG)
-
- IF (LUSERH) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_RH ", &
- "Updraft hail mean value","kg kg-1",XLES_UPDRAFT_Rh,HLES_AVG)
-
- IF (NSV>0) &
- CALL LES_DIACHRO_SV(TPDIAFILE,"UP_SV ", &
- "Updraft scalar variables mean values","kg kg-1",XLES_UPDRAFT_Sv,HLES_AVG)
- !
- CALL LES_DIACHRO(TPDIAFILE,"UP_TH2 ", &
- "Updraft resolved Theta variance ","K2",XLES_UPDRAFT_Th2,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_THL2", &
- "Updraft resolved Theta_l variance ","K2",XLES_UPDRAFT_Thl2,HLES_AVG)
-
- IF (LUSERV) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_THTV", &
- "Updraft resolved Theta Theta_v covariance ","K2",XLES_UPDRAFT_ThThv,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_TLTV", &
- "Updraft resolved Theta_l Theta_v covariance ","K2",XLES_UPDRAFT_ThlThv,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_WTH ", &
- "Updraft resolved WTh flux","m K s-1",XLES_UPDRAFT_WTh,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_WTHL ", &
- "Updraft resolved WThl flux","m K s-1",XLES_UPDRAFT_WThl,HLES_AVG)
-
- IF (LUSERV) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_WTHV ", &
- "Updraft resolved WThv flux","m K s-1",XLES_UPDRAFT_WThv,HLES_AVG)
- !
- IF (LUSERV) THEN
- CALL LES_DIACHRO(TPDIAFILE,"UP_RV2 ", &
- "Updraft resolved water vapor variance","kg2 kg-2",XLES_UPDRAFT_Rv2,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_THRV ", &
- "Updraft resolved <thrv> covariance","K kg kg-1",XLES_UPDRAFT_ThRv,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"UP_THLRV", &
- "Updraft resolved <thlrv> covariance","K kg kg-1",XLES_UPDRAFT_ThlRv,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_THVRV", &
- "Updraft resolved <thvrv> covariance","K kg kg-1",XLES_UPDRAFT_ThvRv,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_WRV ", &
- "Updraft resolved <wrv> vertical flux","m kg kg-1 s-1",XLES_UPDRAFT_WRv,HLES_AVG)
- END IF
-
- IF (LUSERC) THEN
- CALL LES_DIACHRO(TPDIAFILE,"UP_RC2 ", &
- "Updraft resolved cloud water variance","kg2 kg-2",XLES_UPDRAFT_Rc2,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_THRC ", &
- "Updraft resolved <thrc> covariance","K kg kg-1",XLES_UPDRAFT_ThRc,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_THLRC", &
- "Updraft resolved <thlrc> covariance","K kg kg-1",XLES_UPDRAFT_ThlRc,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_THVRC", &
- "Updraft resolved <thvrc> covariance","K kg kg-1",XLES_UPDRAFT_ThvRc,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_WRC ", &
- "Updraft resolved <wrc> vertical flux","m kg kg-1 s-1",XLES_UPDRAFT_WRc,HLES_AVG)
- END IF
-
- IF (LUSERI) THEN
- CALL LES_DIACHRO(TPDIAFILE,"UP_RI2 ", &
- "Updraft resolved cloud ice variance","kg2 kg-2",XLES_UPDRAFT_Ri2,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_THRI ", &
- "Updraft resolved <thri> covariance","K kg kg-1",XLES_UPDRAFT_ThRi,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_THLRI", &
- "Updraft resolved <thlri> covariance","K kg kg-1",XLES_UPDRAFT_ThlRi,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_THVRI", &
- "Updraft resolved <thvri> covariance","K kg kg-1",XLES_UPDRAFT_ThvRi,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"UP_WRI ", &
- "Updraft resolved <wri> vertical flux","m kg kg-1 s-1",XLES_UPDRAFT_WRi,HLES_AVG)
- END IF
-
- IF (NSV>0) THEN
- CALL LES_DIACHRO_SV(TPDIAFILE,"UP_SV2 ", &
- "Updraft resolved scalar variables variances","kg2 kg-2",XLES_UPDRAFT_Sv2,HLES_AVG)
-
- CALL LES_DIACHRO_SV(TPDIAFILE,"UP_THSV ", &
- "Updraft resolved <ThSv> variance","K kg kg-1",XLES_UPDRAFT_ThSv,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO_SV(TPDIAFILE,"UP_THLSV", &
- "Updraft resolved <ThlSv> variance","K kg kg-1",XLES_UPDRAFT_ThlSv,HLES_AVG)
-
- IF (LUSERV) &
- CALL LES_DIACHRO_SV(TPDIAFILE,"UP_THVSV", &
- "Updraft resolved <ThvSv> variance","K kg kg-1",XLES_UPDRAFT_ThvSv,HLES_AVG)
-
- CALL LES_DIACHRO_SV(TPDIAFILE,"UP_WSV ", &
- "Updraft resolved <wSv> vertical flux","m kg kg-1 s-1",XLES_UPDRAFT_WSv,HLES_AVG)
- END IF
-END IF
-!
+if ( lles_updraft ) then
+ cgroup = 'Updraft'
+ cgroupcomment = 'Updraft vertical profiles of some resolved and subgrid fluxes, variances and covariances'
+
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT, 'UP_FRAC', 'Updraft fraction', '1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_W, 'UP_W', 'Updraft W mean value', 'm s-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Th, 'UP_TH', 'Updraft potential temperature mean value', 'K' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Thl, 'UP_THL', 'Updraft liquid potential temperature mean value', 'K' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Thv, 'UP_THV', 'Updraft virtual potential temperature mean value', 'K' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Ke, 'UP_KE', 'Updraft resolved TKE mean value', 'm2 s-2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Tke, 'UP_TKE', 'Updraft subgrid TKE mean value', 'm2 s-2' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rv, 'UP_RV', 'Updraft water vapor mean value', 'kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rc, 'UP_RC', 'Updraft cloud water mean value', 'kg kg-1' )
+ if ( luserr ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rr, 'UP_RR', 'Updraft rain mean value', 'kg kg-1' )
+ if ( luseri ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Ri, 'UP_RI', 'Updraft ice mean value', 'kg kg-1' )
+ if ( lusers ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rs, 'UP_RS', 'Updraft snow mean value', 'kg kg-1' )
+ if ( luserg ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rg, 'UP_RG', 'Updraft graupel mean value', 'kg kg-1' )
+ if ( luserh ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rh, 'UP_RH', 'Updraft hail mean value', 'kg kg-1' )
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Sv, 'UP_SV', 'Updraft scalar variables mean values', 'kg kg-1' )
+
+ tfield%ndims = 2
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_UNUSED
+ !tfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Th2, 'UP_TH2', 'Updraft resolved Theta variance', 'K2' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Thl2, 'UP_THL2', 'Updraft resolved Theta_l variance', 'K2' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThThv, 'UP_THTV', 'Updraft resolved Theta Theta_v covariance', 'K2' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlThv, 'UP_TLTV', 'Updraft resolved Theta_l Theta_v covariance', 'K2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WTh, 'UP_WTH', 'Updraft resolved WTh flux', 'm K s-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WThl, 'UP_WTHL', 'Updraft resolved WThl flux', 'm K s-1' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WThv, 'UP_WTHV', 'Updraft resolved WThv flux', 'm K s-1' )
+
+ if ( luserv ) then
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rv2, 'UP_RV2', 'Updraft resolved water vapor variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThRv, 'UP_THRV', 'Updraft resolved <thrv> covariance', 'K kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlRv, 'UP_THLRV', 'Updraft resolved <thlrv> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvRv, 'UP_THVRV', 'Updraft resolved <thvrv> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WRv, 'UP_WRV', 'Updraft resolved <wrv> vertical flux', 'm kg kg-1 s-1' )
+ end if
+
+ if ( luserc ) then
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Rc2, 'UP_RC2', 'Updraft resolved cloud water variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThRc, 'UP_THRC', 'Updraft resolved <thrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlRc, 'UP_THLRC', 'Updraft resolved <thlrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvRc, 'UP_THVRC', 'Updraft resolved <thvrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WRc, 'UP_WRC', 'Updraft resolved <wrc> vertical flux', 'm kg kg-1 s-1' )
+ end if
+
+ if ( luseri ) then
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Ri2, 'UP_RI2', 'Updraft resolved cloud ice variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThRi, 'UP_THRI', 'Updraft resolved <thri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlRi, 'UP_THLRI', 'Updraft resolved <thlri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvRi, 'UP_THVRI', 'Updraft resolved <thvri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WRi, 'UP_WRI', 'Updraft resolved <wri> vertical flux', 'm kg kg-1 s-1' )
+ end if
+
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_Sv2, 'UP_SV2', 'Updraft resolved scalar variables variances', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThSv, 'UP_THSV', 'Updraft resolved <ThSv> variance', 'K kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThlSv, 'UP_THLSV', 'Updraft resolved <ThlSv> variance', 'K kg kg-1' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_ThvSv, 'UP_THVSV', 'Updraft resolved <ThvSv> variance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_UPDRAFT_WSv, 'UP_WSV', 'Updraft resolved <wSv> vertical flux', 'm kg kg-1 s-1' )
+
+ tfield%ndims = 2
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_UNUSED
+ !tfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+end if
+!
!
!* 2.5 Downdraft quantities
! --------------------
!
-IF (LLES_DOWNDRAFT) THEN
- CALL LES_DIACHRO(TPDIAFILE,"DW_FRAC ", &
- "Downdraft fraction","1",XLES_DOWNDRAFT,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"DW_W ", &
- "Downdraft W mean value","m s-1",XLES_DOWNDRAFT_W,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"DW_TH ", &
- "Downdraft potential temperature mean value","K",XLES_DOWNDRAFT_Th,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_THL ", &
- "Downdraft liquid potential temperature mean value","K",XLES_DOWNDRAFT_Thl,HLES_AVG)
-
- IF (LUSERV) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_THV ", &
- "Downdraft virtual potential temperature mean value","K",XLES_DOWNDRAFT_Thv,HLES_AVG)
-
-
- CALL LES_DIACHRO(TPDIAFILE,"DW_KE ", &
- "Downdraft resolved TKE mean value","m2 s-2",XLES_DOWNDRAFT_Ke,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"DW_TKE ", &
- "Downdraft subgrid TKE mean value","m2 s-2",XLES_DOWNDRAFT_Tke,HLES_AVG)
-
- IF (LUSERV) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_RV ", &
- "Downdraft water vapor mean value","kg kg-1",XLES_DOWNDRAFT_Rv,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_RC ", &
- "Downdraft cloud water mean value","kg kg-1",XLES_DOWNDRAFT_Rc,HLES_AVG)
-
- IF (LUSERR) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_RR ", &
- "Downdraft rain mean value","kg kg-1",XLES_DOWNDRAFT_Rr,HLES_AVG)
-
- IF (LUSERI) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_RI ", &
- "Downdraft ice mean value","kg kg-1",XLES_DOWNDRAFT_Ri,HLES_AVG)
-
- IF (LUSERS) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_RS ", &
- "Downdraft snow mean value","kg kg-1",XLES_DOWNDRAFT_Rs,HLES_AVG)
-
- IF (LUSERG) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_RG ", &
- "Downdraft graupel mean value","kg kg-1",XLES_DOWNDRAFT_Rg,HLES_AVG)
-
- IF (LUSERH) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_RH ", &
- "Downdraft hail mean value","kg kg-1",XLES_DOWNDRAFT_Rh,HLES_AVG)
-
- IF (NSV>0) &
- CALL LES_DIACHRO_SV(TPDIAFILE,"DW_SV ", &
- "Downdraft scalar variables mean values","kg kg-1",XLES_DOWNDRAFT_Sv,HLES_AVG)
- !
- CALL LES_DIACHRO(TPDIAFILE,"DW_TH2 ", &
- "Downdraft resolved Theta variance ","K2",XLES_DOWNDRAFT_Th2,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_THL2", &
- "Downdraft resolved Theta_l variance ","K2",XLES_DOWNDRAFT_Thl2,HLES_AVG)
-
- IF (LUSERV) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_THTV ", &
- "Downdraft resolved Theta Theta_v covariance ","K2",XLES_DOWNDRAFT_ThThv,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_TLTV ", &
- "Downdraft resolved Theta_l Theta_v covariance ","K2",XLES_DOWNDRAFT_ThlThv,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"DW_WTH ", &
- "Downdraft resolved WTh flux","m K s-1",XLES_DOWNDRAFT_WTh,HLES_AVG)
-
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_WTHL ", &
- "Downdraft resolved WThl flux","m K s-1",XLES_DOWNDRAFT_WThl,HLES_AVG)
+if ( lles_downdraft ) then
+ cgroup = 'Downdraft'
+ cgroupcomment = 'Downdraft vertical profiles of some resolved and subgrid fluxes, variances and covariances'
+
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT, 'DW_FRAC', 'Downdraft fraction', '1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_W, 'DW_W', 'Downdraft W mean value', 'm s-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Th, 'DW_TH', 'Downdraft potential temperature mean value', 'K' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Thl, 'DW_THL', 'Downdraft liquid potential temperature mean value', 'K' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Thv, 'DW_THV', 'Downdraft virtual potential temperature mean value', 'K' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Ke, 'DW_KE', 'Downdraft resolved TKE mean value', 'm2 s-2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Tke, 'DW_TKE', 'Downdraft subgrid TKE mean value', 'm2 s-2' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rv, 'DW_RV', 'Downdraft water vapor mean value', 'kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rc, 'DW_RC', 'Downdraft cloud water mean value', 'kg kg-1' )
+ if ( luserr ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rr, 'DW_RR', 'Downdraft rain mean value', 'kg kg-1' )
+ if ( luseri ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Ri, 'DW_RI', 'Downdraft ice mean value', 'kg kg-1' )
+ if ( lusers ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rs, 'DW_RS', 'Downdraft snow mean value', 'kg kg-1' )
+ if ( luserg ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rg, 'DW_RG', 'Downdraft graupel mean value', 'kg kg-1' )
+ if ( luserh ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rh, 'DW_RH', 'Downdraft hail mean value', 'kg kg-1' )
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Sv, 'DW_SV', 'Downdraft scalar variables mean values', 'kg kg-1' )
+
+ tfield%ndims = 2
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_UNUSED
+ !tfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Th2, 'DW_TH2', 'Downdraft resolved Theta variance', 'K2' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Thl2, 'DW_THL2', 'Downdraft resolved Theta_l variance', 'K2' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThThv, 'DW_THTV', 'Downdraft resolved Theta Theta_v covariance', 'K2' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlThv, 'DW_TLTV', 'Downdraft resolved Theta_l Theta_v covariance', 'K2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WTh, 'DW_WTH', 'Downdraft resolved WTh flux', 'm K s-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WThl, 'DW_WTHL', 'Downdraft resolved WThl flux', 'm K s-1' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WThv, 'DW_WTHV', 'Downdraft resolved WThv flux', 'm K s-1' )
+
+ if ( luserv ) then
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rv2, 'DW_RV2', 'Downdraft resolved water vapor variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThRv, 'DW_THRV', 'Downdraft resolved <thrv> covariance', 'K kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlRv, 'DW_THLRV', 'Downdraft resolved <thlrv> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvRv, 'DW_THVRV', 'Downdraft resolved <thvrv> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WRv, 'DW_WRV', 'Downdraft resolved <wrv> vertical flux', &
+ 'm kg kg-1 s-1' )
+ end if
+
+ if ( luserc ) then
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Rc2, 'DW_RC2', 'Downdraft resolved cloud water variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThRc, 'DW_THRC', 'Downdraft resolved <thrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlRc, 'DW_THLRC', 'Downdraft resolved <thlrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvRc, 'DW_THVRC', 'Downdraft resolved <thvrc> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WRc, 'DW_WRC', 'Downdraft resolved <wrc> vertical flux', &
+ 'm kg kg-1 s-1' )
+ end if
+
+ if ( luseri ) then
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Ri2, 'DW_RI2', 'Downdraft resolved cloud ice variance', 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThRi, 'DW_THRI', 'Downdraft resolved <thri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlRi, 'DW_THLRI', 'Downdraft resolved <thlri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvRi, 'DW_THVRI', 'Downdraft resolved <thvri> covariance', 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WRi, 'DW_WRI', 'Downdraft resolved <wri> vertical flux', &
+ 'm kg kg-1 s-1' )
+ end if
+
+
+ if ( nsv > 0 ) then
+ tfield%ndims = 3
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_Sv2, 'DW_SV2', 'Downdraft resolved scalar variables variances', &
+ 'kg2 kg-2' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThSv, 'DW_THSV', 'Downdraft resolved <ThSv> variance', &
+ 'K kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThlSv, 'DW_THLSV', 'Downdraft resolved <ThlSv> variance', &
+ 'K kg kg-1' )
+ if ( luserv ) &
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_ThvSv, 'DW_THVSV', 'Downdraft resolved <ThvSv> variance', &
+ 'K kg kg-1' )
+ call Les_diachro_write( tpdiafile, XLES_DOWNDRAFT_WSv, 'DW_WSV', 'Downdraft resolved <wSv> vertical flux', &
+ 'm kg kg-1 s-1' )
+
+ tfield%ndims = 2
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+ !tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(3) = NMNHDIM_UNUSED
+ !tfield%ndimlist(4:) = NMNHDIM_UNUSED
+ end if
+end if
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. surface normalization parameters
+! --------------------------------
+!
+cgroup = 'Radiation'
+cgroupcomment = 'Radiative terms'
- IF (LUSERV) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_WTHV ", &
- "Downdraft resolved WThv flux","m K s-1",XLES_DOWNDRAFT_WThv,HLES_AVG)
- !
- IF (LUSERV) THEN
- CALL LES_DIACHRO(TPDIAFILE,"DW_RV2 ", &
- "Downdraft resolved water vapor variance","kg2 kg-2",XLES_DOWNDRAFT_Rv2,HLES_AVG)
+!Prepare metadata (used in Les_diachro_write calls)
+tfield%ndims = 2
+tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_LEVEL
+tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_TIME
+tfield%ndimlist(3:) = NMNHDIM_UNUSED
- CALL LES_DIACHRO(TPDIAFILE,"DW_THRV ", &
- "Downdraft resolved <thrv> covariance","K kg kg-1",XLES_DOWNDRAFT_ThRv,HLES_AVG)
+ldoavg = xles_temp_mean_start /= XUNDEF .and. xles_temp_mean_end /= XUNDEF
+ldonorm = .false.
- IF (LUSERC) &
- CALL LES_DIACHRO(TPDIAFILE,"DW_THLRV", &
- "Downdraft resolved <thlrv> covariance","K kg kg-1",XLES_DOWNDRAFT_ThlRv,HLES_AVG)
+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' )
+
+
+cgroup = 'Surface'
+cgroupcomment = 'Averaged surface fields'
+
+! !Prepare metadate (used in Les_diachro_write calls)
+tfield%ndims = 1
+tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_TIME
+tfield%ndimlist(2:) = NMNHDIM_UNUSED
+
+call Les_diachro_write( tpdiafile, XLES_Q0, 'Q0', 'Sensible heat flux at the surface', 'm K s-1' )
+if ( luserv ) &
+call Les_diachro_write( tpdiafile, XLES_E0, 'E0', 'Latent heat flux at the surface', 'kg kg-1 m s-1' )
+
+if ( nsv > 0 ) then
+ tfield%ndims = 2
+ tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(2) = NMNHDIM_BUDGET_LES_SV
+ tfield%ndimlist(3:) = NMNHDIM_UNUSED
+
+ call Les_diachro_write( tpdiafile, XLES_SV0, 'SV0', 'Scalar variable fluxes at the surface', 'kg kg-1 m s-1' )
+
+ tfield%ndims = 1
+ !tfield%ndimlist(1) = NMNHDIM_BUDGET_LES_TIME
+ tfield%ndimlist(2) = NMNHDIM_UNUSED
+ !tfield%ndimlist(3:) = NMNHDIM_UNUSED
+end if
+
+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_MO_LENGTH, 'L_MO', 'Monin-Obukhov length', 'm' )
+if ( luserr ) &
+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', 'Instantaneous precipitation rate', 'mm day-1' )
+if ( luserc ) &
+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', 'Instantaneous cloud deposition rate', 'mm day-1' )
+if ( luserr ) &
+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', 'Accumulated precipitation rate', 'mm' )
+
+
+cgroup = 'Miscellaneous'
+cgroupcomment = 'Miscellaneous terms (geometry, various unclassified averaged terms...)'
+
+call Les_diachro_write( tpdiafile, XLES_BL_HEIGHT, 'BL_H', 'Boundary Layer Height', 'm' )
+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 (rc>1e-6)', '1' )
+if ( luserc ) &
+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 ) &
+call Les_diachro_write( tpdiafile, XLES_LWPVAR, 'LWPVAR', 'Liquid Water path variance', 'kg m-4' )
+if ( luserr ) &
+call Les_diachro_write( tpdiafile, XLES_RWP, 'RWP', 'Rain Water path', 'kg m-2' )
+if ( luseri ) &
+call Les_diachro_write( tpdiafile, XLES_IWP, 'IWP', 'Ice Water path', 'kg m-2' )
+if ( lusers ) &
+call Les_diachro_write( tpdiafile, XLES_SWP, 'SWP', 'Snow Water path', 'kg m-2' )
+if ( luserg ) &
+call Les_diachro_write( tpdiafile, XLES_GWP, 'GWP', 'Graupel Water path', 'kg m-2' )
+if ( luserh ) &
+call Les_diachro_write( tpdiafile, XLES_HWP, 'HWP', 'Hail Water path', 'kg m-2' )
+if ( luserc ) &
+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 fraction maximum (rc>1e-5)', 'm' )
- CALL LES_DIACHRO(TPDIAFILE,"DW_THVRV", &
- "Downdraft resolved <thvrv> covariance","K kg kg-1",XLES_DOWNDRAFT_ThvRv,HLES_AVG)
+!-------------------------------------------------------------------------------
+!
+!* 4. LES budgets
+! -----------
+!
+call Write_les_budget_n( tpdiafile )
- CALL LES_DIACHRO(TPDIAFILE,"DW_WRV ", &
- "Downdraft resolved <wrv> vertical flux","m kg kg-1 s-1",XLES_DOWNDRAFT_WRv,HLES_AVG)
- END IF
+if ( luserv ) call Write_les_rt_budget_n( tpdiafile )
- IF (LUSERC) THEN
- CALL LES_DIACHRO(TPDIAFILE,"DW_RC2 ", &
- "Downdraft resolved cloud water variance","kg2 kg-2",XLES_DOWNDRAFT_Rc2,HLES_AVG)
+if ( nsv > 0 ) call Write_les_sv_budget_n( tpdiafile )
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. (ni,z,t) and (nj,z,t) 2points correlations
+! ------------------------------------------
+!
+if ( nspectra_k > 0 ) then
+ tfieldx%cstdname = ''
+ tfieldx%ngrid = 0 !Not on the Arakawa grid
+ tfieldx%ntype = TYPEREAL
+ tfieldx%ndims = 3
+ tfieldx%ndimlist(1) = NMNHDIM_SPECTRA_2PTS_NI
+ tfieldx%ndimlist(2) = NMNHDIM_SPECTRA_LEVEL
+ tfieldx%ndimlist(3) = NMNHDIM_BUDGET_LES_TIME
+ tfieldx%ndimlist(4:) = NMNHDIM_UNUSED
+
+ tfieldy%cstdname = ''
+ tfieldy%ngrid = 0 !Not on the Arakawa grid
+ tfieldy%ntype = TYPEREAL
+ tfieldy%ndims = 3
+ tfieldy%ndimlist(1) = NMNHDIM_SPECTRA_2PTS_NJ
+ tfieldy%ndimlist(2) = NMNHDIM_SPECTRA_LEVEL
+ tfieldy%ndimlist(3) = NMNHDIM_BUDGET_LES_TIME
+ tfieldy%ndimlist(4:) = NMNHDIM_UNUSED
+
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_UU, XCORRj_UU, 'UU', 'U*U 2 points correlations', 'm2 s-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_VV, XCORRj_VV, 'VV', 'V*V 2 points correlations', 'm2 s-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WW, XCORRj_WW, 'WW', 'W*W 2 points correlations', 'm2 s-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_UV, XCORRj_UV, 'UV', 'U*V 2 points correlations', 'm2 s-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WU, XCORRj_WU, 'WU', 'W*U 2 points correlations', 'm2 s-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WV, XCORRj_WV, 'WV', 'W*V 2 points correlations', 'm2 s-2' )
+
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThTh, XCORRj_ThTh, 'THTH', 'Th*Th 2 points correlations', 'K2' )
+ if ( luserc ) &
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlThl, XCORRj_ThlThl, 'TLTL', 'Thl*Thl 2 points correlations', 'K2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WTh, XCORRj_WTh, 'WTH', 'W*Th 2 points correlations', 'm K s-1' )
+ if ( luserc ) &
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WThl, XCORRj_WThl, 'WTHL', 'W*Thl 2 points correlations', 'm K s-1' )
+
+ if ( luserv ) then
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_RvRv, XCORRj_RvRv, 'RVRV', 'rv*rv 2 points correlations', 'kg2 kg-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThRv, XCORRj_ThRv, 'THRV', 'TH*RV 2 points correlations', 'K kg kg-1' )
+ if ( luserc ) &
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlRv, XCORRj_ThlRv, 'TLRV', 'thl*rv 2 points correlations', 'K kg kg-1' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WRv, XCORRj_WRv, 'WRV', 'W*rv 2 points correlations', 'm kg s-1 kg-1' )
+ end if
+
+ if ( luserc ) then
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_RcRc, XCORRj_RcRc, 'RCRC', 'rc*rc 2 points correlations', 'kg2 kg-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThRc, XCORRj_ThRc, 'THRC', 'th*rc 2 points correlations', 'K kg kg-1' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlRc, XCORRj_ThlRc, 'TLRC', 'thl*rc 2 points correlations', 'K kg kg-1' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_WRc, XCORRj_WRc, 'WRC', 'W*rc 2 points correlations', 'm kg s-1 kg-1' )
+ end if
+
+ if ( luseri ) then
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_RiRi, XCORRj_RiRi, 'RIRI', 'ri*ri 2 points correlations', 'kg2 kg-2' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThRi, XCORRj_ThRi, 'THRI', 'th*ri 2 points correlations', 'K kg kg-1' )
+ call Les_diachro_2pt_write( tpdiafile, XCORRi_ThlRi, XCORRj_ThlRi, 'TLRI', 'thl*ri 2 points correlations', 'K kg kg-1' )
+ 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, &
+ 'W*Sv 2 points correlations','m kg s-1 kg-1' )
+ end do
+end if
+!
+!-------------------------------------------------------------------------------
+!
+!* 6. spectra and time-averaged profiles (if first call to WRITE_LES_n)
+! ----------------------------------
+!
+call Les_spec_n( tpdiafile )
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. deallocations
+! -------------
+!
+DEALLOCATE( XLES_CURRENT_Z )
- CALL LES_DIACHRO(TPDIAFILE,"DW_THRC ", &
- "Downdraft resolved <thrc> covariance","K kg kg-1",XLES_DOWNDRAFT_ThRc,HLES_AVG)
+IF (CLES_NORM_TYPE/='NONE' ) THEN
+ DEALLOCATE(XLES_NORM_M )
+ DEALLOCATE(XLES_NORM_S )
+ DEALLOCATE(XLES_NORM_K )
+ DEALLOCATE(XLES_NORM_RHO)
+ DEALLOCATE(XLES_NORM_RV )
+ DEALLOCATE(XLES_NORM_SV )
+ DEALLOCATE(XLES_NORM_P )
+END IF
- CALL LES_DIACHRO(TPDIAFILE,"DW_THLRC", &
- "Downdraft resolved <thlrc> covariance","K kg kg-1",XLES_DOWNDRAFT_ThlRc,HLES_AVG)
+end subroutine Write_les_n
- CALL LES_DIACHRO(TPDIAFILE,"DW_THVRC", &
- "Downdraft resolved <thvrc> covariance","K kg kg-1",XLES_DOWNDRAFT_ThvRc,HLES_AVG)
+!------------------------------------------------------------------------------
- CALL LES_DIACHRO(TPDIAFILE,"DW_WRC ", &
- "Downdraft resolved <wrc> vertical flux","m kg kg-1 s-1",XLES_DOWNDRAFT_WRc,HLES_AVG)
- END IF
+subroutine Les_diachro_write_1D( tpdiafile, pdata, hmnhname, hcomment, hunits )
- IF (LUSERI) THEN
- CALL LES_DIACHRO(TPDIAFILE,"DW_RI2 ", &
- "Downdraft resolved cloud ice variance","kg2 kg-2",XLES_DOWNDRAFT_Ri2,HLES_AVG)
+use modd_io, only: tfiledata
- CALL LES_DIACHRO(TPDIAFILE,"DW_THRI ", &
- "Downdraft resolved <thri> covariance","K kg kg-1",XLES_DOWNDRAFT_ThRi,HLES_AVG)
+use mode_les_diachro, only: Les_diachro
- CALL LES_DIACHRO(TPDIAFILE,"DW_THLRI", &
- "Downdraft resolved <thlri> covariance","K kg kg-1",XLES_DOWNDRAFT_ThlRi,HLES_AVG)
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+real, dimension(:), intent(in) :: pdata
+character(len=*), intent(in) :: hmnhname
+character(len=*), intent(in) :: hcomment
+character(len=*), intent(in) :: hunits
- CALL LES_DIACHRO(TPDIAFILE,"DW_THVRI", &
- "Downdraft resolved <thvri> covariance","K kg kg-1",XLES_DOWNDRAFT_ThvRi,HLES_AVG)
+tfield%cmnhname = hmnhname
+tfield%clongname = hmnhname
+tfield%ccomment = hcomment
+tfield%cunits = hunits
- CALL LES_DIACHRO(TPDIAFILE,"DW_WRI ", &
- "Downdraft resolved <wri> vertical flux","m kg kg-1 s-1",XLES_DOWNDRAFT_WRi,HLES_AVG)
- END IF
+call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata )
- IF (NSV>0) THEN
- CALL LES_DIACHRO_SV(TPDIAFILE,"DW_SV2 ", &
- "Downdraft resolved scalar variables variances","kg2 kg-2",XLES_DOWNDRAFT_Sv2,HLES_AVG)
+end subroutine Les_diachro_write_1D
- CALL LES_DIACHRO_SV(TPDIAFILE,"DW_THSV ", &
- "Downdraft resolved <ThSv> variance","K kg kg-1",XLES_DOWNDRAFT_ThSv,HLES_AVG)
+!------------------------------------------------------------------------------
- IF (LUSERC) &
- CALL LES_DIACHRO_SV(TPDIAFILE,"DW_THLSV", &
- "Downdraft resolved <ThlSv> variance","K kg kg-1",XLES_DOWNDRAFT_ThlSv,HLES_AVG)
+subroutine Les_diachro_write_2D( tpdiafile, pdata, hmnhname, hcomment, hunits )
- IF (LUSERV) &
- CALL LES_DIACHRO_SV(TPDIAFILE,"DW_THVSV", &
- "Downdraft resolved <ThvSv> variance","K kg kg-1",XLES_DOWNDRAFT_ThvSv,HLES_AVG)
+use modd_io, only: tfiledata
- CALL LES_DIACHRO_SV(TPDIAFILE,"DW_WSV ", &
- "Downdraft resolved <wSv> vertical flux","m kg kg-1 s-1",XLES_DOWNDRAFT_WSv,HLES_AVG)
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. surface normalization parameters
-! --------------------------------
-!
-IF (HLES_AVG==' ' .OR. HLES_AVG=='A') THEN
+use mode_les_diachro, only: Les_diachro
- CALL LES_DIACHRO_SURF(TPDIAFILE,"Q0 ", &
- "Sensible heat flux at the surface","m K s-1",XLES_Q0,HLES_AVG)
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+real, dimension(:,:), intent(in) :: pdata
+character(len=*), intent(in) :: hmnhname
+character(len=*), intent(in) :: hcomment
+character(len=*), intent(in) :: hunits
- IF (LUSERV) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"E0 ", &
- "Latent heat flux at the surface","kg kg-1 m s-1",XLES_E0,HLES_AVG)
- !writes sw and lw flux and dthrad at all levels
- CALL LES_DIACHRO(TPDIAFILE,"SWU ", &
- "sw_up ","W m-2 ",XLES_SWU,HLES_AVG)
+tfield%cmnhname = hmnhname
+tfield%clongname = hmnhname
+tfield%ccomment = hcomment
+tfield%cunits = hunits
- CALL LES_DIACHRO(TPDIAFILE,"SWD ", &
- "sw_down ","W m-2 ",XLES_SWD,HLES_AVG)
-
- CALL LES_DIACHRO(TPDIAFILE,"LWU ", &
- "lw_up ","W m-2 ",XLES_LWU,HLES_AVG)
+call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata )
- CALL LES_DIACHRO(TPDIAFILE,"LWD ", &
- "lw_down ","W m-2 ",XLES_LWD,HLES_AVG)
+end subroutine Les_diachro_write_2D
- CALL LES_DIACHRO(TPDIAFILE,"DTHRADSW ", &
- "dthrad_sw ","K s-1 ",XLES_DTHRADSW,HLES_AVG)
+!------------------------------------------------------------------------------
- CALL LES_DIACHRO(TPDIAFILE,"DTHRADLW ", &
- "dthrad_lw ","K s-1 ",XLES_DTHRADLW,HLES_AVG)
-!writes mean_effective radius at all levels
- CALL LES_DIACHRO(TPDIAFILE,"RADEFF ", &
- "mean effective radius ","microm ",XLES_RADEFF,HLES_AVG)
+subroutine Les_diachro_write_3D( tpdiafile, pdata, hmnhname, hcomment, hunits, hmasks )
- IF (NSV>0) &
- CALL LES_DIACHRO_SURF_SV(TPDIAFILE,"SV0 ", &
- "Scalar variable fluxes at the surface","kg kg-1 m s-1",XLES_SV0,HLES_AVG)
+use modd_io, only: tfiledata
- CALL LES_DIACHRO_SURF(TPDIAFILE,"U* ", &
- "Friction velocity","m s-1",XLES_USTAR,HLES_AVG)
+use mode_les_diachro, only: Les_diachro
- CALL LES_DIACHRO_SURF(TPDIAFILE,"W* ", &
- "Convective velocity","m s-1",XLES_WSTAR,HLES_AVG)
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+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) :: hmasks
- CALL LES_DIACHRO_SURF(TPDIAFILE,"BL_H ", &
- "Boundary Layer Height","m",XLES_BL_HEIGHT,HLES_AVG)
+tfield%cmnhname = hmnhname
+tfield%clongname = hmnhname
+tfield%ccomment = hcomment
+tfield%cunits = hunits
- CALL LES_DIACHRO_SURF(TPDIAFILE,"L_MO ", &
- "Monin-Obukhov length","m",XLES_MO_LENGTH,HLES_AVG)
+call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata, hmasks = hmasks )
- CALL LES_DIACHRO_SURF(TPDIAFILE,"INT_TKE ", &
- "Vertical integrated tke","m2.s-2",XLES_INT_TKE,HLES_AVG)
+end subroutine Les_diachro_write_3D
- IF (LUSERC) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"ZCB ", &
- "Cloud base Height","m",XLES_ZCB,HLES_AVG)
+!------------------------------------------------------------------------------
- IF (LUSERC) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"ZCFTOT ", &
- "Total Cloud cover","1",XLES_CFtot,HLES_AVG)
+subroutine Les_diachro_write_4D( tpdiafile, pdata, hmnhname, hcomment, hunits, hmasks )
- IF (LUSERC) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"ZCF2TOT ", &
- "Total Cloud cove 2r","1",XLES_CF2tot,HLES_AVG)
+use modd_io, only: tfiledata
- IF (LUSERC) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"LWP ", &
- "Liquid Water path","kg m-2",XLES_LWP,HLES_AVG)
+use mode_les_diachro, only: Les_diachro
- IF (LUSERC) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"LWPVAR ", &
- "Liquid Water path variance","kg m-4",XLES_LWPVAR,HLES_AVG)
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+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) :: hmasks
- IF (LUSERR) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"RWP ", &
- "Rain Water path","kg m-2",XLES_RWP,HLES_AVG)
+tfield%cmnhname = hmnhname
+tfield%clongname = hmnhname
+tfield%ccomment = hcomment
+tfield%cunits = hunits
- IF (LUSERI) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"IWP ", &
- "Ice Water path","kg m-2",XLES_IWP,HLES_AVG)
+call Les_diachro( tpdiafile, tfield, cgroup, cgroupcomment, ldoavg, ldonorm, pdata, hmasks = hmasks )
- IF (LUSERS) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"SWP ", &
- "Snow Water path","kg m-2",XLES_SWP,HLES_AVG)
+end subroutine Les_diachro_write_4D
- IF (LUSERG) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"GWP ", &
- "Graupel Water path","kg m-2",XLES_GWP,HLES_AVG)
+!------------------------------------------------------------------------------
- IF (LUSERH) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"HWP ", &
- "Hail Water path","kg m-2",XLES_HWP,HLES_AVG)
+subroutine Les_diachro_2pt_write( tpdiafile, zcorri, zcorrj, hmnhname, hcomment, hunits )
- IF (LUSERR) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"PREC_FRAC ", &
- "Fract of col where rain at surface","",XLES_PRECFR,HLES_AVG)
+use modd_io, only: tfiledata
- IF (LUSERR) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"INST_PREC ", &
- "Inst precip rate","mm day-1",XLES_INPRR,HLES_AVG)
+use mode_les_diachro, only: Les_diachro_2pt
- IF (LUSERC) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"INST_SEDIM ", &
- "Inst cloud precip rate","mm day-1",XLES_INPRC,HLES_AVG)
+type(tfiledata), intent(in) :: tpdiafile ! file to write
+real, dimension(:,:,:), intent(in) :: zcorri ! 2 pts correlation data
+real, dimension(:,:,:), intent(in) :: zcorrj ! 2 pts correlation data
+character(len=*), intent(in) :: hmnhname
+character(len=*), intent(in) :: hcomment
+character(len=*), intent(in) :: hunits
- IF (LUSERC .AND. (LDEPOSC .OR. LDEPOC)) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"INST_DEPOS ", &
- "Inst cloud deposi rate","mm day-1",XLES_INDEP,HLES_AVG)
+tfieldx%cmnhname = hmnhname
+tfieldx%clongname = hmnhname
+tfieldx%ccomment = hcomment
+tfieldx%cunits = hunits
- IF (LUSERR) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"RAIN_PREC ", &
- "inst pr. rate over rainy grid cells","mm day-1",XLES_RAIN_INPRR,HLES_AVG)
-
- IF (LUSERR) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"ACCU_PREC ", &
- "Accu precip rate","mm",XLES_ACPRR,HLES_AVG)
+tfieldy%cmnhname = hmnhname
+tfieldy%clongname = hmnhname
+tfieldy%ccomment = hcomment
+tfieldy%cunits = hunits
- IF (LUSERC) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"ZMAXCF ", &
- "Height of Cloud fraction max","m",XLES_ZMAXCF,HLES_AVG)
+call Les_diachro_2pt( tpdiafile, tfieldx, tfieldy, zcorri, zcorrj )
- IF (LUSERC) &
- CALL LES_DIACHRO_SURF(TPDIAFILE,"ZMAXCF2 ", &
- "Height of Cloud fraction2max","m",XLES_ZMAXCF2,HLES_AVG)
+end subroutine Les_diachro_2pt_write
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. LES budgets
-! -----------
-!
-CALL WRITE_LES_BUDGET_n(TPDIAFILE,HLES_AVG)
-IF (LUSERV) CALL WRITE_LES_RT_BUDGET_n(TPDIAFILE,HLES_AVG)
-IF (NSV>0) CALL WRITE_LES_SV_BUDGET_n(TPDIAFILE,HLES_AVG)
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. (ni,z,t) and (nj,z,t) 2points correlations
-! ------------------------------------------
-!
-IF (HLES_AVG==' ' .OR. HLES_AVG=='A') THEN
- IF (NSPECTRA_K>0) THEN
- CALL LES_DIACHRO_2PT(TPDIAFILE,"UU ","U*U 2 points correlations", &
- "m2 s-2",XCORRi_UU, XCORRj_UU,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"VV ","V*V 2 points correlations", &
- "m2 s-2",XCORRi_VV, XCORRj_VV,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"WW ","W*W 2 points correlations", &
- "m2 s-2",XCORRi_WW, XCORRj_WW,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"UV ","U*V 2 points correlations", &
- "m2 s-2",XCORRi_UV, XCORRj_UV,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"WU ","W*U 2 points correlations", &
- "m2 s-2",XCORRi_WU, XCORRj_WU,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"WV ","W*V 2 points correlations", &
- "m2 s-2",XCORRi_WV, XCORRj_WV,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"THTH ","Th*Th 2 points correlations", &
- "K2 ",XCORRi_ThTh, XCORRj_ThTh,HLES_AVG)
- IF (LUSERC) &
- CALL LES_DIACHRO_2PT(TPDIAFILE,"TLTL ","Thl*Thl 2 points correlations", &
- "K2 ",XCORRi_ThlThl,XCORRj_ThlThl,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"WTH ","W*Th 2 points correlations", &
- "m K s-1 ",XCORRi_WTh, XCORRj_WTh,HLES_AVG)
- IF (LUSERC) &
- CALL LES_DIACHRO_2PT(TPDIAFILE,"WTHL ","W*Thl 2 points correlations", &
- "m K s-1 ",XCORRi_WThl, XCORRj_WThl,HLES_AVG)
- !
- IF (LUSERV) THEN
- CALL LES_DIACHRO_2PT(TPDIAFILE,"RVRV ","rv*rv 2 points correlations", &
- "kg2 kg-2 ",XCORRi_RvRv, XCORRj_RvRv,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"THRV ","th*rv 2 points correlations", &
- "K kg kg-1 ",XCORRi_ThRv, XCORRj_ThRv,HLES_AVG)
- IF (LUSERC) &
- CALL LES_DIACHRO_2PT(TPDIAFILE,"TLRV ","thl*rv 2 points correlations", &
- "K kg kg-1 ",XCORRi_ThlRv, XCORRj_ThlRv,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"WRV ","W*rv 2 points correlations", &
- "m kg s-1 kg-1",XCORRi_WRv, XCORRj_WRv,HLES_AVG)
- END IF
- IF (LUSERC) THEN
- CALL LES_DIACHRO_2PT(TPDIAFILE,"RCRC ","rc*rc 2 points correlations", &
- "kg2 kg-2 ",XCORRi_RcRc, XCORRj_RcRc,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"THRC ","th*rc 2 points correlations", &
- "K kg kg-1 ",XCORRi_ThRc, XCORRj_ThRc,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"TLRC ","thl*rc 2 points correlations", &
- "K kg kg-1 ",XCORRi_ThlRc, XCORRj_ThlRc,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"WRC ","W*rc 2 points correlations", &
- "m kg s-1 kg-1",XCORRi_WRc, XCORRj_WRc,HLES_AVG)
- END IF
- IF (LUSERI) THEN
- CALL LES_DIACHRO_2PT(TPDIAFILE,"RCRC ","ri*ri 2 points correlations", &
- "kg2 kg-2 ",XCORRi_RiRi, XCORRj_RiRi,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"THRC ","th*ri 2 points correlations", &
- "K kg kg-1 ",XCORRi_ThRi, XCORRj_ThRi,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"TLRC ","thl*ri 2 points correlations", &
- "K kg kg-1 ",XCORRi_ThlRi, XCORRj_ThlRi,HLES_AVG)
- CALL LES_DIACHRO_2PT(TPDIAFILE,"WRC ","W*ri 2 points correlations", &
- "m kg s-1 kg-1",XCORRi_WRi, XCORRj_WRi,HLES_AVG)
- END IF
- DO JSV=1,NSV
- WRITE (YGROUP,FMT="(A2,I3.3)") "SS",JSV
- CALL LES_DIACHRO_2PT(TPDIAFILE,YGROUP,"Sv*Sv 2 points correlations", &
- "kg2 kg-2 ",XCORRi_SvSv(:,:,:,JSV), XCORRj_SvSv(:,:,:,JSV),HLES_AVG)
- END DO
- DO JSV=1,NSV
- WRITE (YGROUP,FMT="(A2,I3.3)") "WS",JSV
- CALL LES_DIACHRO_2PT(TPDIAFILE,YGROUP,"W*Sv 2 points correlations", &
- "m kg s-1 kg-1",XCORRi_WSv(:,:,:,JSV), XCORRj_WSv(:,:,:,JSV),HLES_AVG)
- END DO
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 6. spectra and time-averaged profiles (if first call to WRITE_LES_n)
-! ----------------------------------
-!
-IF (HLES_AVG==' ') CALL LES_SPEC_n(TPDIAFILE)
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. deallocations
-! -------------
-!
-DEALLOCATE(XLES_CURRENT_TRAJT )
-DEALLOCATE(XLES_CURRENT_Z )
-DEALLOCATE(XLES_CURRENT_DATIME)
+!------------------------------------------------------------------------------
-IF (CLES_NORM_TYPE/='NONE' ) THEN
- DEALLOCATE(XLES_NORM_M )
- DEALLOCATE(XLES_NORM_S )
- DEALLOCATE(XLES_NORM_K )
- DEALLOCATE(XLES_NORM_RHO)
- DEALLOCATE(XLES_NORM_RV )
- DEALLOCATE(XLES_NORM_SV )
- DEALLOCATE(XLES_NORM_P )
-END IF
-!
-END SUBROUTINE WRITE_LES_n
+end module mode_write_les_n
diff --git a/src/MNH/write_lfifm1_for_diag.f90 b/src/MNH/write_lfifm1_for_diag.f90
index 90eb9db9fec006b07514c1dd7663a40c475069b9..60240e9caf00f71d49bb49ef35d0410ceb14dfa1 100644
--- a/src/MNH/write_lfifm1_for_diag.f90
+++ b/src/MNH/write_lfifm1_for_diag.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.
@@ -143,7 +143,11 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG
!! D.Ricard and P.Marquet 2016-2017 : THETAL + THETAS1 POVOS1 or THETAS2 POVOS2
!! if LMOIST_L LMOIST_S1 or LMOIST_S2
! P. Wautelet 08/02/2019: minor bug: compute ZWORK36 only when needed
-!! 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 18/03/2020: remove ICE2 option
+! B. Vie 06/2020 Add prognostic supersaturation for LIMA
+! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
+! J.L Redelsperger 03/2021 Adding OCEAN LES Case and Autocoupled O-A LES
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -152,6 +156,7 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG
USE MODD_DIM_n
USE MODD_CONF
USE MODD_CONF_n
+use modd_field, only: tfielddata, tfieldlist, TYPEINT, TYPEREAL
USE MODD_GRID
USE MODD_GRID_n
USE MODD_IO, ONLY : TFILEDATA
@@ -233,8 +238,8 @@ USE MODI_FREE_ATM_PROFILE
USE MODI_GPS_ZENITH
USE MODI_CONTRAV
!
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_GRIDPROJ
-USE MODE_FIELD
USE MODE_GATHER_ll
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
@@ -337,7 +342,7 @@ INTEGER :: ILUOUT0 ! Logical unit number for output-listing
!
CHARACTER(LEN=2) :: INDICE
CHARACTER(LEN=100) :: YMSG
-INTEGER :: I,IID
+INTEGER :: IID
TYPE(TFIELDDATA) :: TZFIELD
TYPE(TFIELDDATA),DIMENSION(2) :: TZFIELD2
!
@@ -452,6 +457,8 @@ CALL IO_Field_write(TPFILE,'DTSEG',TDTSEG)
!
CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN)
CALL IO_Field_write(TPFILE,'LBOUSS', LBOUSS)
+CALL IO_Field_write(TPFILE,'LOCEAN', LOCEAN)
+CALL IO_Field_write(TPFILE,'LCOUPLES', LCOUPLES)
!
IF (LCARTESIAN .AND. LWIND_ZM) THEN
LWIND_ZM=.FALSE.
@@ -459,9 +466,15 @@ IF (LCARTESIAN .AND. LWIND_ZM) THEN
END IF
!* 1.4 Reference state variables :
!
-CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
-CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
-CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
+IF (LCOUPLES.AND.LOCEAN) THEN
+ CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZO)
+ CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZO)
+ CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOPO)
+ELSE
+ CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
+ CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
+ CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
+END IF
!
CALL IO_Field_write(TPFILE,'RHODREF',XRHODREF)
CALL IO_Field_write(TPFILE,'THVREF', XTHVREF)
@@ -667,11 +680,11 @@ IF (LVAR_PR .AND. LUSERR .AND. SIZE(XINPRR)>0 ) THEN
TZFIELD%CUNITS = 'mm hour-1'
CALL IO_Field_write(TPFILE,TZFIELD,ZWORK21*3.6E6)
!
- ZWORK21(:,:) = (XACPRR(:,:) + XACPRS(:,:) + XACPRG(:,:))*1.0E3
+ ZWORK21(:,:) = XACPRR(:,:) + XACPRS(:,:) + XACPRG(:,:)
IF (SIZE(XINPRC) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XACPRC(:,:)*1.0E3
+ ZWORK21(:,:) = ZWORK21(:,:) + XACPRC(:,:)
IF (SIZE(XINPRH) /= 0 ) &
- ZWORK21(:,:) = ZWORK21(:,:) + XACPRH(:,:)*1.0E3
+ ZWORK21(:,:) = ZWORK21(:,:) + XACPRH(:,:)
!
CALL FIND_FIELD_ID_FROM_MNHNAME('ACPRT',IID,IRESP)
TZFIELD = TFIELDLIST(IID)
@@ -1150,10 +1163,8 @@ IF (LLIMA_DIAG) THEN
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(3))//INDICE//'T'
END IF
! N IMM nucl
- I = 0
IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN
- I = I + 1
- WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(I))
+ WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(JSV - NSV_LIMA_IMM_NUCL + 1))
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_CONC(4))//INDICE//'T'
END IF
! Hom. freez. of CCN
@@ -1161,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)
@@ -1198,7 +1214,7 @@ IF (LLIMA_DIAG) THEN
!
END IF
!
-! chemical scalar variables in gas phase PPBV
+! chemical scalar variables in gas phase ppbv
IF (LCHEMDIAG) THEN
DO JSV = NSV_CHGSBEG,NSV_CHGSEND
TZFIELD%CMNHNAME = TRIM(UPCASE(CNAMES(JSV-NSV_CHGSBEG+1)))//'T'
@@ -1216,8 +1232,7 @@ IF (LCHEMDIAG) THEN
END IF
IF (LCHAQDIAG) THEN !aqueous concentration in M
TZFIELD%CSTDNAME = ''
- !PW TODO: check units
- TZFIELD%CUNITS = ''
+ TZFIELD%CUNITS = 'M'
TZFIELD%CDIR = 'XY'
TZFIELD%NGRID = 1
TZFIELD%NTYPE = TYPEREAL
@@ -1226,9 +1241,9 @@ IF (LCHAQDIAG) THEN !aqueous concentration in M
!
ZWORK31(:,:,:)=0.
DO JSV = NSV_CHACBEG, NSV_CHACBEG-1+NEQAQ/2 !cloud water
- TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))//'M'
+ TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3,A4)')'X_Y_Z_','CHAQ',JSV,' (M)'
+ WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHAQ',JSV
WHERE(((XRT(:,:,:,2)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ)
ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,2))
ENDWHERE
@@ -1237,9 +1252,9 @@ IF (LCHAQDIAG) THEN !aqueous concentration in M
!
ZWORK31(:,:,:)=0.
DO JSV = NSV_CHACBEG+NEQAQ/2, NSV_CHACEND !rain water
- TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))//'M'
+ TZFIELD%CMNHNAME = TRIM(CNAMES(JSV-NSV_CHACBEG+NSV_CHGS+1))//'T'
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3,A4)')'X_Y_Z_','CHAQ',JSV,' (M)'
+ WRITE(TZFIELD%CCOMMENT,'(A6,A4,I3.3)')'X_Y_Z_','CHAQ',JSV
WHERE(((XRT(:,:,:,3)*XRHODREF(:,:,:))/1.e3) .GE. XRTMIN_AQ)
ZWORK31(:,:,:)=(XSVT(:,:,:,JSV)*1000.)/(XMD*1.E+3*XRT(:,:,:,3))
ENDWHERE
@@ -3909,7 +3924,7 @@ IF (LLIDAR) THEN
ZTMP2(:,:,:,1)=ZRG_DST(:,:,:,IACCMODE)
ZTMP3(:,:,:,1)=ZSIG_DST(:,:,:,IACCMODE)
SELECT CASE ( CCLOUD )
- CASE('KESS','ICE2','ICE3','ICE4')
+ CASE('KESS''ICE3','ICE4')
CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, &
XRT, ZWORK31, ZWORK32, &
PDSTC=ZTMP1, &
@@ -3947,7 +3962,7 @@ IF (LLIDAR) THEN
END SELECT
ELSE
SELECT CASE ( CCLOUD )
- CASE('KESS','ICE2','ICE3','ICE4')
+ CASE('KESS','ICE3','ICE4')
CALL LIDAR(CCLOUD, YVIEW, XALT_LIDAR, XWVL_LIDAR, XZZ, XRHODREF, XCLDFR, &
XRT, ZWORK31, ZWORK32)
CASE('C2R2')
diff --git a/src/MNH/write_lfifm1_for_diag_supp.f90 b/src/MNH/write_lfifm1_for_diag_supp.f90
index 03881cc177e0733c00f840f913da6f8b3c1ea711..1bb11e435afd44755eff957d81908fa904554cb6 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
@@ -96,6 +97,7 @@ END MODULE MODI_WRITE_LFIFM1_FOR_DIAG_SUPP
!
USE MODE_ll
USE MODD_CST
+use modd_field, only: tfielddata, tfieldlist, TYPEINT, TYPEREAL
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PARAMETERS
USE MODD_CONF_n
@@ -153,10 +155,13 @@ 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
!
-USE MODE_FIELD
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
!
USE MODI_GET_SURF_UNDEF
@@ -800,12 +805,12 @@ IF (LEN_TRIM(CRAD_SAT) /= 0 .AND. NRR /=0) THEN
DO JI=1,ITOTGEO
ZIRBT(:,:) = XUNDEF
ZWVBT(:,:) = XUNDEF
- CALL RADTR_SATEL(TDTCUR%TDATE%YEAR,TDTCUR%TDATE%MONTH,TDTCUR%TDATE%DAY, &
- TDTCUR%TIME, NDLON, NFLEV, NSTATM, NRAD_COLNBR, XEMIS(:,:,1), &
- XCCO2, XTSRAD, XSTATM, XTHT, XRT, XPABST, XZZ, &
- XSIGS, XMFCONV, XCLDFR, LUSERI, LSIGMAS, &
- LSUBG_COND, LRAD_SUBG_COND, ZIRBT, ZWVBT, &
- INDGEO(JI),VSIGQSAT )
+ CALL RADTR_SATEL( TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
+ NDLON, NFLEV, NSTATM, NRAD_COLNBR, XEMIS(:,:,1), &
+ XCCO2, XTSRAD, XSTATM, XTHT, XRT, XPABST, XZZ, &
+ XSIGS, XMFCONV, XCLDFR, LUSERI, LSIGMAS, &
+ LSUBG_COND, LRAD_SUBG_COND, ZIRBT, ZWVBT, &
+ INDGEO(JI), VSIGQSAT )
!
TZFIELD%CMNHNAME = TRIM(YNAM_SAT(JI))//'_IRBT'
TZFIELD%CSTDNAME = ''
@@ -840,20 +845,22 @@ 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), &
LUSERI, NRTTOVINFO, TPFILE )
-#else
-#ifdef MNH_RTTOV_11
+#elif MNH_RTTOV_11
CALL CALL_RTTOV11(NDLON, NFLEV, XEMIS(:,:,1), XTSRAD, XTHT, XRT, &
XPABST, XZZ, XMFCONV, XCLDFR, XUT(:,:,IKB), XVT(:,:,IKB), &
LUSERI, NRTTOVINFO, TPFILE )
+#elif 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
END IF
!
!-------------------------------------------------------------------------------
@@ -1287,41 +1294,61 @@ IF (LISOAL .AND.XISOAL(1)/=0.) THEN
! *********************
! Cloud
! *********************
- IF (SIZE(XRT,4) >= 5) THEN
- ZWORK31(:,:,:) = (XRT(:,:,:,2)+XRT(:,:,:,4)+XRT(:,:,:,5))*1.E3
- CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
- WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
- TZFIELD%CMNHNAME = 'ALT_CLOUD'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'ALT_CLOUD'
- TZFIELD%CUNITS = 'g kg-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_cloud ALT'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
- END IF
+ ZWORK31(:,:,:) = 0.
+ IF (SIZE(XRT,4) >= 2) ZWORK31(:,:,:) = XRT(:,:,:,2) ! Rc
+ IF (SIZE(XRT,4) >= 4) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,4) !Ri
+ ZWORK31(:,:,:) = ZWORK31(:,:,:)*1.E3
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD%CMNHNAME = 'ALT_CLOUD'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ALT_CLOUD'
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_cloud ALT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
! *********************
! Precipitation
! *********************
- IF (SIZE(XRT,4) >= 6) THEN
- ZWORK31(:,:,:) = (XRT(:,:,:,2)+XRT(:,:,:,6))*1.E3
- CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
- WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
- TZFIELD%CMNHNAME = 'ALT_PRECIP'
- TZFIELD%CSTDNAME = ''
- TZFIELD%CLONGNAME = 'ALT_PRECIP'
- TZFIELD%CUNITS = 'g kg-1'
- TZFIELD%CDIR = 'XY'
- TZFIELD%CCOMMENT = 'X_Y_precipitation ALT'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
- END IF
+ ZWORK31(:,:,:) = 0.
+ IF (SIZE(XRT,4) >= 3) ZWORK31(:,:,:) = XRT(:,:,:,3) ! Rr
+ IF (SIZE(XRT,4) >= 5) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,5) !Rsnow
+ IF (SIZE(XRT,4) >= 6) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,6) !Rgraupel
+ IF (SIZE(XRT,4) >= 7) ZWORK31(:,:,:) = ZWORK31(:,:,:) + XRT(:,:,:,7) !Rhail
+ ZWORK31(:,:,:) = ZWORK31(:,:,:)*1.E3
+ CALL ZINTER(ZWORK31, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD%CMNHNAME = 'ALT_PRECIP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ALT_PRECIP'
+ TZFIELD%CUNITS = 'g kg-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_precipitation ALT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
+! *********************
+! Potential temperature
+! *********************
+ CALL ZINTER(XTHT, XZZ, ZWAL, ZAL, IIU, IJU, IKU, IKB, IAL, XUNDEF)
+ WHERE(ZWAL.EQ.XUNDEF) ZWAL=ZFILLVAL
+ TZFIELD%CMNHNAME = 'ALT_THETA'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'ALT_THETA'
+ TZFIELD%CUNITS = 'K'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CCOMMENT = 'X_Y_potential temperature ALT'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWAL)
! *********************
! Pressure
! *********************
diff --git a/src/MNH/write_lfifmn_fordiachron.f90 b/src/MNH/write_lfifmn_fordiachron.f90
index 2e96502f1a4d3d4ac4a9472e35ce1bd522386d5c..d6c6ba317f2e39677d1aa0befe5efbebf1116e54 100644
--- a/src/MNH/write_lfifmn_fordiachron.f90
+++ b/src/MNH/write_lfifmn_fordiachron.f90
@@ -3,6 +3,15 @@
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
+module mode_write_lfifmn_fordiachro_n
+
+implicit none
+
+private
+
+public :: Write_lfifmn_fordiachro_n
+
+contains
! #############################################
SUBROUTINE WRITE_LFIFMN_FORDIACHRO_n(TPFILE)
! #############################################
@@ -209,3 +218,5 @@ LPACK=GPACK
!-------------------------------------------------------------------------------
!
END SUBROUTINE WRITE_LFIFMN_FORDIACHRO_n
+
+end module mode_write_lfifmn_fordiachro_n
diff --git a/src/MNH/write_lfin.f90 b/src/MNH/write_lfin.f90
index 75c4c6d8f0157264aa29c590de96ef8033ef9cd5..ea08bd41d0a36e803f2afda33d7fa63f8d75a317 100644
--- a/src/MNH/write_lfin.f90
+++ b/src/MNH/write_lfin.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.
@@ -163,15 +163,23 @@ END MODULE MODI_WRITE_LFIFM_n
!! J.escobar 04/08/2015 suit Pb with writ_lfin JSA increment , modif in ini_nsv to have good order initialization
!! Modification 01/2016 (JP Pinty) Add LIMA
!! M.Mazoyer 04/16 : Add supersaturation fields
-!! P.Wautelet 11/07/2016 removed MNH_NCWRIT define
-!! JP Chaboureau 27/11/2017 add wind tendency forcing
-!! 02/2018 Q.Libois move Diagnostic related to the radiations in radiations.f90
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! V. Vionnet 07/2017, add blowing snow variables
-!! P.Wautelet 11/01/2019: bug correction in write XBL_DEPTH->XSBL_DEPTH
-!! C.Lac 18/02/2019: add rain fraction as an output field
-!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! P. Wautelet 11/07/2016: remove MNH_NCWRIT define
+! V. Vionnet 07/2017: add blowing snow variables
+! JP Chaboureau 27/11/2017: add wind tendency forcing
+! Q. Libois 02/2018: move Diagnostic related to the radiations in radiations.f90
+! P. Wautelet 11/01/2019: bug correction in write XBL_DEPTH->XSBL_DEPTH
+! C. Lac 18/02/2019: add rain fraction as an output field
+! S. Bielli 02/2019: Sea salt: significant sea wave height influences salt emission; 5 salt modes
! P. Wautelet 10/04/2019: replace ABORT and STOP calls by Print_msg
+! P. Tulet 02/2020: correction for dust and sea salts
+!! B. Vie 06/2020 Add prognostic supersaturation for LIMA
+! PA. Joulin 12/2020: add wind turbine outputs
+! F. Auguste 02/2021: add IBM
+! T. Nagel 02/2021: add turbulence recycling
+! P. Wautelet 10/03/2021: use scalar variable names for dust and salt
+! P. Wautelet 11/03/2021: bugfix: correct name for NSV_LIMA_IMM_NUCL
+! J.L. Redelsperger 03/2021: add OCEAN and auto-coupled O-A LES cases
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -180,6 +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, TYPELOG, TYPEREAL
USE MODD_GRID
USE MODD_GRID_n
USE MODD_TIME
@@ -222,6 +231,7 @@ USE MODD_HURR_FIELD_n
USE MODD_PREP_REAL, ONLY: CDUMMY_2D, XDUMMY_2D
USE MODD_DUST
USE MODD_SALT
+USE MODD_OCEANH
USE MODD_PASPOL
#ifdef MNH_FOREFIRE
USE MODD_FOREFIRE
@@ -244,7 +254,7 @@ USE MODE_IO_FILE, only: IO_File_close
USE MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_ll
USE MODD_IO, ONLY: TFILEDATA
-USE MODE_FIELD
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_GATHER_ll
USE MODE_GRIDPROJ
USE MODE_MSG
@@ -256,6 +266,8 @@ USE MODI_WRITE_BALLOON_n
USE MODI_DUSTLFI_n
USE MODI_SALTLFI_n
USE MODI_CH_AER_REALLFI_n
+USE MODI_SALT_FILTER
+USE MODI_DUST_FILTER
!
!20131128
USE MODE_MPPDB
@@ -270,6 +282,15 @@ USE MODD_ADVFRC_n ! Modif PP ADV FRC
USE MODD_RELFRC_n
!
USE MODD_PARAM_C2R2
+!
+USE MODD_EOL_MAIN
+USE MODD_EOL_SHARED_IO
+USE MODD_EOL_ADNR
+USE MODD_EOL_ALM
+!
+USE MODD_RECYCL_PARAM_n
+USE MODD_IBM_PARAM_n, ONLY: LIBM, XIBM_LS
+USE MODD_IBM_LSF, ONLY: LIBM_LSF
!
IMPLICIT NONE
!
@@ -291,8 +312,6 @@ INTEGER :: JSA ! beginning of chemical-aerosol variables
CHARACTER(LEN=3) :: YFRC ! to mark the time of the forcing
INTEGER :: JT ! loop index
!
-INTEGER :: JMOM, IMOMENTS, JMODE, ISV_NAME_IDX ! dust modes
-!
REAL,DIMENSION(:,:), ALLOCATABLE :: ZWORK2D ! Working array
REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZWORK3D ! Working array
!
@@ -314,7 +333,7 @@ INTEGER :: JI,JJ,JK ! loop index
INTEGER :: IIU,IJU,IKU,IIB,IJB,IKB,IIE,IJE,IKE ! Arrays bounds
!
CHARACTER(LEN=2) :: INDICE
-INTEGER :: I, IID
+INTEGER :: IID
TYPE(TFIELDDATA) :: TZFIELD
!-------------------------------------------------------------------------------
!
@@ -419,11 +438,24 @@ CALL IO_Field_write(TPFILE,'L2D', L2D)
CALL IO_Field_write(TPFILE,'PACK', LPACK)
CALL IO_Field_write(TPFILE,'CARTESIAN',LCARTESIAN)
CALL IO_Field_write(TPFILE,'LBOUSS', LBOUSS)
+CALL IO_Field_write(TPFILE,'LOCEAN', LOCEAN)
+CALL IO_Field_write(TPFILE,'LCOUPLES', LCOUPLES)
!
CALL IO_Field_write(TPFILE,'SURF', CSURF)
CALL IO_Field_write(TPFILE,'CPL_AROME',LCPL_AROME)
CALL IO_Field_write(TPFILE,'COUPLING', LCOUPLING)
!
+TZFIELD%CMNHNAME = 'RECYCLING'
+TZFIELD%CLONGNAME = 'RECYCLING'
+TZFIELD%CSTDNAME = ''
+TZFIELD%CUNITS = ''
+TZFIELD%CDIR = '--'
+TZFIELD%NGRID = 1
+TZFIELD%NTYPE = TYPELOG
+TZFIELD%NDIMS = 0
+TZFIELD%LTIMEDEP = .FALSE.
+CALL IO_Field_write(TPFILE,TZFIELD,LRECYCL)
+!
!* 1.4 Prognostic variables :
!
!
@@ -457,6 +489,201 @@ IF ( (CUVW_ADV_SCHEME == 'CEN4TH') .AND. (CTEMP_SCHEME == 'LEFR') ) THEN
CALL IO_Field_write(TPFILE,'DWM',XDWM)
END IF
!
+IF (LIBM .OR. LIBM_LSF) THEN
+ !
+ TZFIELD%CMNHNAME = 'LSFP'
+ TZFIELD%CLONGNAME = 'LSFP'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'Level Set Function at mass node'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XIBM_LS(:,:,:,1))
+ !
+ENDIF
+!
+IF (LRECYCL) THEN
+ !
+ TZFIELD%CMNHNAME = 'RCOUNT'
+ TZFIELD%CLONGNAME = 'RCOUNT'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = ''
+ TZFIELD%CDIR = '--'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEINT
+ TZFIELD%NDIMS = 0
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'Incremental counter for averaging purpose'
+ CALL IO_Field_write(TPFILE,TZFIELD,NR_COUNT)
+ !
+ IF (LRECYCLW) THEN
+ TZFIELD%CMNHNAME = 'URECYCLW'
+ TZFIELD%CLONGNAME = 'URECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-WEST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANW(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLW'
+ TZFIELD%CLONGNAME = 'VRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-WEST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANW(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLW'
+ TZFIELD%CLONGNAME = 'WRECYCLW'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-WEST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XWMEANW(:,:,:))
+ !
+ ENDIF
+ IF (LRECYCLN) THEN
+ TZFIELD%CMNHNAME = 'URECYCLN'
+ TZFIELD%CLONGNAME = 'URECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-NORTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANN(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLN'
+ TZFIELD%CLONGNAME = 'VRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-NORTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANN(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLN'
+ TZFIELD%CLONGNAME = 'WRECYCLN'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-NORTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XWMEANN(:,:,:))
+ !
+ ENDIF
+ IF (LRECYCLE) THEN
+ TZFIELD%CMNHNAME = 'URECYCLE'
+ TZFIELD%CLONGNAME = 'URECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-EAST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANE(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLE'
+ TZFIELD%CLONGNAME = 'VRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-EAST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANE(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLE'
+ TZFIELD%CLONGNAME = 'WRECYCLE'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-EAST side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XWMEANE(:,:,:))
+ !
+ ENDIF
+ IF (LRECYCLS) THEN
+ TZFIELD%CMNHNAME = 'URECYCLS'
+ TZFIELD%CLONGNAME = 'URECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 2
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'UMEAN-SOUTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XUMEANS(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'VRECYCLS'
+ TZFIELD%CLONGNAME = 'VRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 3
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'VMEAN-SOUTH side plan for recycling purpose'
+ !
+ CALL IO_Field_write(TPFILE,TZFIELD,XVMEANS(:,:,:))
+ !
+ TZFIELD%CMNHNAME = 'WRECYCLS'
+ TZFIELD%CLONGNAME = 'WRECYCLS'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'm s-1'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 4
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ TZFIELD%CCOMMENT = 'WMEAN-SOUTH side plan for recycling purpose'
+ !
+ ENDIF
+ENDIF
+!
IF (MEAN_COUNT /= 0) THEN
!
TZFIELD%CSTDNAME = ''
@@ -487,6 +714,13 @@ IF (MEAN_COUNT /= 0) THEN
TZFIELD%CCOMMENT = 'X_Y_Z_U component of max wind'
CALL IO_Field_write(TPFILE,TZFIELD,XUM_MAX)
!
+ TZFIELD%CMNHNAME = 'UWME'
+ TZFIELD%CLONGNAME = 'UWME'
+ TZFIELD%CUNITS = 'm2 s-2'
+ TZFIELD%CCOMMENT = 'X_Y_Z_UW component of mean wind variance'
+ ZWORK3D = XUW_MEAN/MEAN_COUNT-(XUM_MEAN*XWM_MEAN)/MEAN_COUNT**2
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
+ !
TZFIELD%NGRID = 3
!
TZFIELD%CMNHNAME = 'VMME'
@@ -532,6 +766,13 @@ IF (MEAN_COUNT /= 0) THEN
CALL IO_Field_write(TPFILE,TZFIELD,XWM_MAX)
!
TZFIELD%NGRID = 1
+!
+ TZFIELD%CMNHNAME = 'CMME'
+ TZFIELD%CLONGNAME = 'CMME'
+ TZFIELD%CUNITS = 'kg kg-1'
+ TZFIELD%CCOMMENT = 'mean Passive scalar'
+ ZWORK3D = XSVT_MEAN/MEAN_COUNT
+ CALL IO_Field_write(TPFILE,TZFIELD,ZWORK3D)
!
TZFIELD%CMNHNAME = 'THMME'
TZFIELD%CLONGNAME = 'THMME'
@@ -758,10 +999,8 @@ IF (NSV >=1) THEN
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(3))//INDICE//'T'
END IF
! N IMM nucl
- I = 0
IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN
- I = I + 1
- WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(I))
+ WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(JSV - NSV_LIMA_IMM_NUCL + 1))
TZFIELD%CMNHNAME = TRIM(CLIMA_COLD_NAMES(4))//INDICE//'T'
END IF
! Hom. freez. of CCN
@@ -769,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))
!
@@ -1153,81 +1397,25 @@ IF (NSV >=1) THEN
CALL DUSTLFI_n(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), XRHODREF)
!At this point, we have the tracer array in order of importance, i.e.
!if mode 2 is most important it will occupy place 1-3 of XSVT
- IF ((CPROGRAM == 'REAL ').AND.((LDSTINIT).OR.(LDSTPRES)).OR.&
- (CPROGRAM == 'IDEAL ') ) THEN
- ! In this case CDUSTNAMES is not allocated. We will use YPDUST_INI,
- !but remember that this variable does not follow JPDUSTORDER
- IMOMENTS = INT(NSV_DSTEND - NSV_DSTBEG+1)/NMODE_DST
- !Should equal 3 at this point
- IF (IMOMENTS > 3) THEN
- WRITE(ILUOUT,*) 'Error in write_lfin: number of moments must be less or equal to 3'
- WRITE(ILUOUT,*) NSV_DSTBEG, NSV_DSTEND,NMODE_DST,IMOMENTS
- call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_LFIFM_n', 'number of moments must be less or equal to 3' )
- END IF ! Test IMOMENTS
- ALLOCATE(YDSTNAMES(NSV_DSTEND - NSV_DSTBEG+1))
- !
- TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'ppp'
- TZFIELD%CDIR = 'XY'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- !
- IF (IMOMENTS == 1) THEN
- DO JMODE=1, NMODE_DST
- ISV_NAME_IDX = (JPDUSTORDER(JMODE) - 1)*3 + 2
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + 1 & !Number of moments in this mode
- + (NSV_DSTBEG -1) !Previous list of tracers
- TZFIELD%CMNHNAME = TRIM(YPDUST_INI(ISV_NAME_IDX))//'T'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
- YDSTNAMES((JMODE-1)*IMOMENTS+1)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
- END DO ! Loop on mode
- ELSE
- DO JMODE=1,NMODE_DST
- DO JMOM=1,IMOMENTS
- ISV_NAME_IDX = (JPDUSTORDER(JMODE) - 1)*3 + JMOM
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + JMOM & !Number of moments in this mode
- + (NSV_DSTBEG -1)
- TZFIELD%CMNHNAME = TRIM(YPDUST_INI(ISV_NAME_IDX))//'T' !The refererence which will be written to file
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
- YDSTNAMES((JMODE-1)*IMOMENTS+JMOM)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
- END DO ! Loop on moment
- END DO ! loop on mode
- END IF ! Valeur IMOMENTS
-!
- DO JSV = NSV_DSTBEG,NSV_DSTEND
- YCHNAMES(JSV-JSA) = YDSTNAMES(JSV-NSV_DSTBEG+1)
- END DO
- DEALLOCATE(YDSTNAMES)
- ELSE
- ! We are in the subprogram MESONH, CDUSTNAMES are allocated and are
- !in the same order as the variables in XSVT (i.e. following JPDUSTORDER)
- !
- TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'ppp'
- TZFIELD%CDIR = 'XY'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- !
- DO JSV = NSV_DSTBEG,NSV_DSTEND
- TZFIELD%CMNHNAME = TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'T'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
- IF (JSV==NSV_DSTBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_DSTBEG ',JSV
- IF (JSV==NSV_DSTEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_DSTEND ',JSV
- YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
- END DO ! Loop on dust scalar variables
- END IF
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'ppp'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ CALL DUST_FILTER(XSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), XRHODREF)
+ DO JSV = NSV_DSTBEG,NSV_DSTEND
+ TZFIELD%CMNHNAME = TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))//'T'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ IF (JSV==NSV_DSTBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_DSTBEG ',JSV
+ IF (JSV==NSV_DSTEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_DSTEND ',JSV
+ YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
+ END DO ! Loop on dust scalar variables
+
IF (LDEPOS_DST(IMI)) THEN
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'ppp'
@@ -1245,9 +1433,9 @@ IF (NSV >=1) THEN
IF (JSV==NSV_DSTDEPBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_DSTDEPBEG ',JSV
IF (JSV==NSV_DSTDEPEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_DSTDEPEND ',JSV
YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
- END DO ! Loop on aq dust scalar variables
+ END DO ! Loop on aq dust scalar variables
ENDIF
- ENDIF
+ ENDIF
! sea salt scalar variables
IF (LSALT) THEN
IF ((CPROGRAM == 'REAL ').AND.(NSV_SLT > 1).AND.(IMI==1).AND.(LSLTINIT)) &
@@ -1256,67 +1444,25 @@ IF (NSV >=1) THEN
CALL SALTLFI_n(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF, XZZ)
!At this point, we have the tracer array in order of importance, i.e.
!if mode 2 is most important it will occupy place 1-3 of XSVT
- IF (((CPROGRAM == 'REAL ').AND.(LSLTINIT)).OR.&
- (CPROGRAM == 'IDEAL ') ) THEN
- ! In this case CSALTNAMES is not allocated. We will use YPSALT_INI,
- !but remember that this variable does not follow JPSALTORDER
- IMOMENTS = INT(NSV_SLTEND - NSV_SLTBEG+1)/NMODE_SLT
- !Should equal 3 at this point
- IF (IMOMENTS .NE. 3) THEN
- WRITE(ILUOUT,*) 'Error in write_lfin: number of moments must be equal to 3'
- WRITE(ILUOUT,*) NSV_SLTBEG, NSV_SLTEND,NMODE_SLT,IMOMENTS
- call Print_msg( NVERB_FATAL, 'GEN', 'WRITE_LFIFM_n', 'number of moments must be equal to 3' )
- END IF
- ALLOCATE(YSLTNAMES(NSV_SLTEND - NSV_SLTBEG+1))
- TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'ppp'
- TZFIELD%CDIR = 'XY'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- DO JMODE=1, NMODE_SLT
- DO JMOM = 1, IMOMENTS
- !Index from which names are picked
- ISV_NAME_IDX = (JPSALTORDER(JMODE)-1)*IMOMENTS + JMOM
- !Index which counts in the XSVT
- JSV = (JMODE-1)*IMOMENTS & !Number of moments previously counted
- + JMOM & !Number of moments in this mode
- + (NSV_SLTBEG -1) !Previous list of tracers
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CUNITS = 'ppp'
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%LTIMEDEP = .TRUE.
+ !
+ CALL SALT_FILTER(XSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), XRHODREF)
+ DO JSV = NSV_SLTBEG,NSV_SLTEND
+ TZFIELD%CMNHNAME = TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))//'T'
+ TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
+ WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
+ CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
+ IF (JSV==NSV_SLTBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_SLTBEG ',JSV
+ IF (JSV==NSV_SLTEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_SLTEND ',JSV
+ YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
+ END DO ! Loop on sea salt scalar variables
- TZFIELD%CMNHNAME = TRIM(YPSALT_INI(ISV_NAME_IDX))//'T' !The refererence which will be written to file
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
- YSLTNAMES((JMODE-1)*IMOMENTS+JMOM)=TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
- END DO ! Loop on moments
- END DO ! Loop on modes
- !
- DO JSV = NSV_SLTBEG,NSV_SLTEND
- YCHNAMES(JSV-JSA) = YSLTNAMES(JSV-NSV_SLTBEG+1)
- END DO
- DEALLOCATE(YSLTNAMES)
- ELSE
- ! We are in the subprogram MESONH, CSALTNAMES are allocated and are
- !in the same order as the variables in XSVT (i.e. following JPSALTORDER)
- TZFIELD%CSTDNAME = ''
- TZFIELD%CUNITS = 'ppp'
- TZFIELD%CDIR = 'XY'
- TZFIELD%NGRID = 1
- TZFIELD%NTYPE = TYPEREAL
- TZFIELD%NDIMS = 3
- TZFIELD%LTIMEDEP = .TRUE.
- !
- DO JSV = NSV_SLTBEG,NSV_SLTEND
- TZFIELD%CMNHNAME = TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))//'T'
- TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
- WRITE(TZFIELD%CCOMMENT,'(A6,A3,I3.3)')'X_Y_Z_','SVT',JSV
- CALL IO_Field_write(TPFILE,TZFIELD,XSVT(:,:,:,JSV))
- IF (JSV==NSV_SLTBEG) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_SLTBEG ',JSV
- IF (JSV==NSV_SLTEND) WRITE(ILUOUT,*)'MNHC: write_lfin:NSV_SLTEND ',JSV
- YCHNAMES(JSV-JSA) = TZFIELD%CMNHNAME(1:LEN_TRIM(TZFIELD%CMNHNAME)-1)
- END DO ! Loop on sea salt scalar variables
- END IF
IF (LDEPOS_SLT(IMI)) THEN
TZFIELD%CSTDNAME = ''
TZFIELD%CUNITS = 'ppp'
@@ -1426,9 +1572,15 @@ END IF
!
!* 1.5 Reference state variables :
!
-CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
-CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
-CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
+IF (LCOUPLES.AND.LOCEAN) THEN
+ CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZO)
+ CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZO)
+ CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOPO)
+ELSE
+ CALL IO_Field_write(TPFILE,'RHOREFZ',XRHODREFZ)
+ CALL IO_Field_write(TPFILE,'THVREFZ',XTHVREFZ)
+ CALL IO_Field_write(TPFILE,'EXNTOP', XEXNTOP)
+END IF
!
!
!* 1.6 Tendencies
@@ -1807,8 +1959,63 @@ IF(LBLOWSNOW) THEN
END IF
ENDIF
!
-!* 1.11 Forcing variables
+!* 1.11 Ocean LES variables
+!
+IF ((.NOT.LCOUPLES).AND.LOCEAN) THEN
+ CALL IO_Field_write(TPFILE,'NFRCLT',NFRCLT)
+ CALL IO_Field_write(TPFILE,'NINFRT',NINFRT)
+ !
+ TZFIELD%CMNHNAME = 'SSUFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSUFL'
+ TZFIELD%CUNITS = 'kg m-1 s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc stress along U to force ocean LES'
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ CALL IO_Field_write(TPFILE,TZFIELD,XSSUFL_T(:))
+ !
+ TZFIELD%CMNHNAME = 'SSVFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSVFL'
+ TZFIELD%CUNITS = 'kg m-1 s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc stress along V to force ocean LES'
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ CALL IO_Field_write(TPFILE,TZFIELD,XSSVFL_T(:))
+ !
+ TZFIELD%CMNHNAME = 'SSTFL_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSTFL'
+ TZFIELD%CUNITS = 'kg m3 K m s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc total heat flux to force ocean LES'
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ CALL IO_Field_write(TPFILE,TZFIELD,XSSTFL_T(:))
+ !
+ TZFIELD%CMNHNAME = 'SSOLA_T'
+ TZFIELD%CSTDNAME = ''
+ TZFIELD%CLONGNAME = 'SSOLA'
+ TZFIELD%CUNITS = 'kg m3 K m s-1'
+ TZFIELD%CDIR = '--'
+ TZFIELD%CCOMMENT = 'sfc solar flux to force ocean LES'
+ TZFIELD%NGRID = 0
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%LTIMEDEP = .FALSE.
+ CALL IO_Field_write(TPFILE,TZFIELD,XSSOLA_T(:))
+ !
+END IF ! ocean sfc forcing end
!
+!* 1.12 Forcing variables
!
IF (LFORCING) THEN
!
@@ -2094,7 +2301,7 @@ IF ( L2D_REL_FRC ) THEN
ENDDO
ENDIF
!
-!* 1.11bis Eddy Fluxes variables ! Modif PP
+!* 1.13 Eddy Fluxes variables ! Modif PP
!
IF ( LTH_FLX ) THEN
CALL IO_Field_write(TPFILE,'VT_FLX',XVTH_FLUX_M)
@@ -2103,13 +2310,13 @@ END IF
!
IF ( LUV_FLX) CALL IO_Field_write(TPFILE,'VU_FLX',XVU_FLUX_M)
!
-!* 1.12 Balloon variables
+!* 1.14 Balloon variables
!
!
IF (LFLYER) CALL WRITE_BALLOON_n(TPFILE)
!
!
-!* 1.13 Filtered variables for hurricane initialization
+!* 1.15 Filtered variables for hurricane initialization
!
!
IF ( CPROGRAM=='REAL ' ) THEN
@@ -2154,7 +2361,7 @@ IF ( CPROGRAM=='REAL ' ) THEN
!
END IF
!
-!* 1.14 Dummy variables in PREP_REAL_CASE
+!* 1.16 Dummy variables in PREP_REAL_CASE
!
IF (ALLOCATED(CDUMMY_2D)) THEN
TZFIELD%CSTDNAME = ''
@@ -2175,6 +2382,200 @@ IF ( CPROGRAM=='REAL ' ) THEN
!
END IF
!
+!* 1.17 Wind turbine variables
+!
+! i) Main
+!
+IF (LMAIN_EOL .AND. IMI == NMODEL_EOL) THEN
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 3
+ TZFIELD%CDIR = 'XY'
+ TZFIELD%CUNITS = 'N'
+!
+ TZFIELD%CMNHNAME = 'FX_RG'
+ TZFIELD%CLONGNAME = 'FX_RG'
+ TZFIELD%CCOMMENT = 'X-component field of aerodynamic force (wind->rotor) in global frame (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFX_RG)
+!
+ TZFIELD%CMNHNAME = 'FY_RG'
+ TZFIELD%CLONGNAME = 'FY_RG'
+ TZFIELD%CCOMMENT = 'Y-component field of aerodynamic force (wind->rotor) in global frame (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFY_RG)
+!
+ TZFIELD%CMNHNAME = 'FZ_RG'
+ TZFIELD%CLONGNAME = 'FZ_RG'
+ TZFIELD%CCOMMENT = 'Z-component field of aerodynamic force (wind->rotor) in global frame (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFZ_RG)
+!
+ TZFIELD%CMNHNAME = 'FX_SMR_RG'
+ TZFIELD%CLONGNAME = 'FX_SMR_RG'
+ TZFIELD%CCOMMENT = 'X-component field of smeared aerodynamic force (wind->rotor) in global frame (N)'
+ TZFIELD%CCOMMENT = ''
+ CALL IO_Field_write(TPFILE,TZFIELD,XFX_SMR_RG)
+!
+ TZFIELD%CMNHNAME = 'FY_SMR_RG'
+ TZFIELD%CLONGNAME = 'FY_SMR_RG'
+ TZFIELD%CCOMMENT = 'Y-component field of smeared aerodynamic force (wind->rotor) in global frame (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFY_SMR_RG)
+!
+ TZFIELD%CMNHNAME = 'FZ_SMR_RG'
+ TZFIELD%CLONGNAME = 'FZ_SMR_RG'
+ TZFIELD%CCOMMENT = 'Z-component field of smeared aerodynamic force (wind->rotor) in global frame (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFZ_SMR_RG)
+!
+SELECT CASE(CMETH_EOL)
+!
+! ii) Actuator Disk without Rotation model
+!
+ CASE('ADNR') ! Actuator Disc Non-Rotating
+!
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%NDIMS = 1
+ TZFIELD%CDIR = '--'
+ TZFIELD%CUNITS = '1'
+!
+ TZFIELD%CMNHNAME = 'A_INDU'
+ TZFIELD%CLONGNAME = 'INDUCTION_FACTOR'
+ TZFIELD%CCOMMENT = 'Induction factor (1)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XA_INDU)
+!
+ TZFIELD%CMNHNAME = 'CT_D'
+ TZFIELD%CLONGNAME = 'CTHRUST_D'
+ TZFIELD%CCOMMENT = 'Thrust coefficient at disk (1), &
+ used with wind speed at disk'
+ CALL IO_Field_write(TPFILE,TZFIELD,XCT_D)
+!
+ TZFIELD%CMNHNAME = 'THRUT'
+ TZFIELD%CLONGNAME = 'THRUSTT_EOL'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID instantaneous thrust of the wind turbines (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHRUT)
+!
+ IF (MEAN_COUNT /= 0) THEN
+
+ TZFIELD%CMNHNAME = 'THRUMME'
+ TZFIELD%CLONGNAME = 'MEAN_THRUST_EOL'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID mean thrust of the wind turbines (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHRU_SUM/MEAN_COUNT)
+!
+ END IF
+! iii) Actuator Line Model
+!
+ CASE('ALM') ! Actuator Line Method
+!
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%CDIR = '--'
+!
+ TZFIELD%NDIMS = 1
+!
+ TZFIELD%CMNHNAME = 'THRUT'
+ TZFIELD%CLONGNAME = 'THRUSTT_EOL'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID instantaneous thrust (N) of wind turbines'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHRUT)
+!
+ TZFIELD%CMNHNAME = 'TORQT'
+ TZFIELD%CLONGNAME = 'TORQUET_EOL'
+ TZFIELD%CUNITS = 'Nm'
+ TZFIELD%CCOMMENT = 'RID instantaneous torque (Nm) of wind turbines'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTORQT)
+!
+ TZFIELD%CMNHNAME = 'POWT'
+ TZFIELD%CLONGNAME = 'POWERT_EOL'
+ TZFIELD%CUNITS = 'W'
+ TZFIELD%CCOMMENT = 'RID instantaneous power (W) of wind turbines'
+ CALL IO_Field_write(TPFILE,TZFIELD,XPOWT)
+!
+ TZFIELD%NDIMS = 3
+!
+ TZFIELD%CMNHNAME = 'ELT_RAD'
+ TZFIELD%CLONGNAME = 'ELT_RAD'
+ TZFIELD%CUNITS = 'm'
+ TZFIELD%CCOMMENT = 'RID_BID_EID radius (m) of wind turbine blade elements'
+ CALL IO_Field_write(TPFILE,TZFIELD,XELT_RAD)
+!
+ TZFIELD%CMNHNAME = 'AOA'
+ TZFIELD%CLONGNAME = 'ANGLE OF ATTACK'
+ TZFIELD%CUNITS = 'rad'
+ TZFIELD%CCOMMENT = 'RID_BID_EID instantaneous angle of attack (rad)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XAOA_GLB)
+!
+ TZFIELD%CMNHNAME = 'FLIFT'
+ TZFIELD%CLONGNAME = 'LIFT FORCE'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID_BID_EID instantaneous lift (N) in relative frame'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFLIFT_GLB)
+!
+ TZFIELD%CMNHNAME = 'FDRAG'
+ TZFIELD%CLONGNAME = 'DRAG FORCE'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID_BID_EID instantaneous drag (N) in relative frame'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFDRAG_GLB)
+!
+ TZFIELD%NDIMS = 4
+!
+ TZFIELD%CMNHNAME = 'FAERO_RE'
+ TZFIELD%CLONGNAME = 'AERODYNAMIC FORCE RE'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID_BID_EID_XYZ instantaneous forces (N) in RE'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFAERO_RE_GLB)
+!
+ TZFIELD%CMNHNAME = 'FAERO_RG'
+ TZFIELD%CLONGNAME = 'AERODYNAMIC FORCE RG'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID_BID_EID_XYZ instantaneous forces (N) in RG'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFAERO_RG_GLB)
+!
+ IF (MEAN_COUNT /= 0) THEN
+!
+ TZFIELD%NGRID = 1
+ TZFIELD%NTYPE = TYPEREAL
+ TZFIELD%CDIR = '--'
+!
+ TZFIELD%NDIMS = 1
+!
+ TZFIELD%CMNHNAME = 'THRUMME'
+ TZFIELD%CLONGNAME = 'MEAN_THRUST_EOL'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID mean thrust of the wind turbines (N)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTHRU_SUM/MEAN_COUNT)
+!
+ TZFIELD%CMNHNAME = 'TORQMME'
+ TZFIELD%CLONGNAME = 'MEAN_TORQUE_EOL'
+ TZFIELD%CUNITS = 'Nm'
+ TZFIELD%CCOMMENT = 'RID mean torque of the wind turbines (Nm)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XTORQ_SUM/MEAN_COUNT)
+!
+ TZFIELD%CMNHNAME = 'POWMME'
+ TZFIELD%CLONGNAME = 'MEAN_POWER_EOL'
+ TZFIELD%CUNITS = 'W'
+ TZFIELD%CCOMMENT = 'RID mean power of the wind turbines (W)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XPOW_SUM/MEAN_COUNT)
+!
+ TZFIELD%NDIMS = 3
+!
+ TZFIELD%CMNHNAME = 'AOAMME'
+ TZFIELD%CLONGNAME = 'MEAN_ANGLE_OF_ATTACK'
+ TZFIELD%CUNITS = 'rad'
+ TZFIELD%CCOMMENT = 'RID_BID_EID mean angle of attack (rad)'
+ CALL IO_Field_write(TPFILE,TZFIELD,XAOA_SUM/MEAN_COUNT)
+!
+ TZFIELD%NDIMS = 4
+!
+ TZFIELD%CMNHNAME = 'FAEROMME_RE'
+ TZFIELD%CLONGNAME = 'MEAN_AERODYNAMIC_FORCE_RE'
+ TZFIELD%CUNITS = 'N'
+ TZFIELD%CCOMMENT = 'RID_BID_EID_XYZ mean forces (N) in RE'
+ CALL IO_Field_write(TPFILE,TZFIELD,XFAERO_RE_SUM/MEAN_COUNT)
+!
+ END IF
+!
+ END SELECT
+END IF
!
DEALLOCATE(ZWORK2D,ZWORK3D)
!
diff --git a/src/MNH/write_profilern.f90 b/src/MNH/write_profilern.f90
index 2eb2b3b4452ca203fc7d05e8e536933d876ef857..486978e1c2accda7b8125d056c48166d2a5f201c 100644
--- a/src/MNH/write_profilern.f90
+++ b/src/MNH/write_profilern.f90
@@ -1,98 +1,54 @@
-!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.
!-----------------------------------------------------------------
+! Author:
+! P. Tulet 15/02/2002
+!
+! Modifications
+! G. Delautier 2016: LIMA
+! C. Lac 10/2016: add visibility diagnostics for fog
+! P. Wautelet 05/2016-04/2018: new data structures and calls for I/O
+! J. Escobar 16/08/2018: From Pierre & Maud , correction use CNAMES(JSV-NSV_CHEMBEG+1)
+! P. Wautelet 13/09/2019: budget: simplify and modernize date/time management
+! 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
+! P. Wautelet 05/07/2021: reorganisation to store point values correctly (not in vertical profiles)
+! M. Taufour 07/2021: modify RARE for hydrometeors containing ice and add bright band calculation for RARE
+!-----------------------------------------------------------------
! ###########################
-MODULE MODI_WRITE_PROFILER_n
+MODULE MODE_WRITE_PROFILER_n
! ###########################
!
-INTERFACE
-!
- SUBROUTINE WRITE_PROFILER_n(TPDIAFILE)
-!
-USE MODD_IO, ONLY: TFILEDATA
-!
-TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! diachronic file to write
-!
-END SUBROUTINE WRITE_PROFILER_n
-!
-END INTERFACE
-!
-END MODULE MODI_WRITE_PROFILER_n
-!
-! ##########################################
- SUBROUTINE WRITE_PROFILER_n(TPDIAFILE)
-! ##########################################
+implicit none
+
+private
+
+public :: WRITE_PROFILER_n
+
+CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: CCOMMENT ! comment string
+CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: CTITLE ! title
+CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: CUNIT ! physical unit
+
+REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: XWORK6 ! contains temporal serie
+
+contains
!
+!#####################################
+SUBROUTINE WRITE_PROFILER_n(TPDIAFILE)
+!#####################################
!
-!!**** *WRITE_PROFILER* - write the balloon and aircraft trajectories and records
-!! in the diachronic file
-!!
-!! PURPOSE
-!! -------
!
+!**** *WRITE_PROFILER* - write the balloon and aircraft trajectories and records
+! in the diachronic file
!
-!!** METHOD
-!! ------
-!!
-!!
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!! AUTHOR
-!! ------
-!! Pierre TULET * Meteo-France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 15/02/2002
-!! 2016 : G.DELAUTIER : LIMA
-!! Oct, 2016 (C.Lac) Add visibility diagnostics for fog
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!! J. Escobar : 16/08/2018: From Pierre & Maud , correction use CNAMES(JSV-NSV_CHEMBEG+1)
-!!
-!! --------------------------------------------------------------------------
-!
!* 0. DECLARATIONS
! ------------
!
-USE MODD_CST
-USE MODD_IO, ONLY: TFILEDATA
-USE MODD_LUNIT
-USE MODD_PARAMETERS
-!
-USE MODD_TYPE_PROFILER
-USE MODD_PROFILER_n
-USE MODD_CH_M9_n, ONLY: CNAMES
-USE MODD_CH_AEROSOL, ONLY: CAERONAMES, LORILAM, JPMODE
-USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
-USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
-USE MODD_ELEC_DESCR, ONLY: CELECNAMES
-USE MODD_LG, ONLY: CLGNAMES
-USE MODD_DUST, ONLY: CDUSTNAMES, LDUST, NMODE_DST
-USE MODD_SALT, ONLY: CSALTNAMES, LSALT
-USE MODD_NSV
-USE MODD_RADIATIONS_n, ONLY:NAER
-USE MODD_DIAG_IN_RUN
-USE MODD_PARAM_n, ONLY: CRAD
-!
-USE MODE_DUST_PSD
-USE MODE_AERO_PSD
-!
-USE MODI_WRITE_DIACHRO
-USE MODD_PARAM_LIMA_WARM, ONLY: CLIMA_WARM_NAMES, CAERO_MASS
-USE MODD_PARAM_LIMA_COLD, ONLY: CLIMA_COLD_NAMES
-USE MODD_PARAM_LIMA , ONLY: NINDICE_CCN_IMM,NMOD_CCN,NMOD_IFN,NMOD_IMM
+USE MODD_IO, ONLY: TFILEDATA
+use MODD_PROFILER_n, only: NUMBPROFILER
!
IMPLICIT NONE
!
@@ -105,546 +61,588 @@ TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! diachronic file to write
!
! 0.2 declaration of local variables
!
-INTEGER :: II ! loop
+INTEGER :: JI
!
!----------------------------------------------------------------------------
!
-DO II=1,NUMBPROFILER
- CALL PROFILER_DIACHRO_n(TPROFILER, II)
+DO JI = 1, NUMBPROFILER
+ CALL PROFILER_DIACHRO_n( TPDIAFILE, JI )
ENDDO
!
!----------------------------------------------------------------------------
+END SUBROUTINE WRITE_PROFILER_n
!----------------------------------------------------------------------------
-!
-CONTAINS
-!
-!----------------------------------------------------------------------------
+
+
!----------------------------------------------------------------------------
+SUBROUTINE PROFILER_DIACHRO_n( TPDIAFILE, KI )
+
+use modd_budget, only: NLVL_CATEGORY, NLVL_SUBCATEGORY, NLVL_GROUP, NLVL_SHAPE, NLVL_TIMEAVG, NLVL_NORM, NLVL_MASK, &
+ tbudiachrometadata
+USE MODD_DIAG_IN_RUN, only: LDIAG_IN_RUN
+USE MODD_DUST, ONLY: CDUSTNAMES, LDUST, NMODE_DST
+USE MODD_CH_AEROSOL, ONLY: CAERONAMES, LORILAM, JPMODE
+USE MODD_CH_M9_n, ONLY: CNAMES
+USE MODD_CST, ONLY: XRV
+USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+use modd_field, only: NMNHDIM_LEVEL, NMNHDIM_PROFILER_TIME, NMNHDIM_PROFILER_PROC, NMNHDIM_UNUSED, &
+ tfield_metadata_base, TYPEREAL
+USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LG, ONLY: CLGNAMES
+USE MODD_NSV
+USE MODD_PARAMETERS, ONLY: XUNDEF
+USE MODD_PARAM_LIMA, ONLY: NINDICE_CCN_IMM,NMOD_CCN,NMOD_IFN,NMOD_IMM
+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: CRAD
+USE MODD_PROFILER_n
+USE MODD_RADIATIONS_n, ONLY: NAER
+USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
+USE MODD_SALT, ONLY: CSALTNAMES, LSALT
+USE MODD_TYPE_PROFILER
!
-!----------------------------------------------------------------------------
-SUBROUTINE PROFILER_DIACHRO_n(TPROFILER,II)
+USE MODE_AERO_PSD
+USE MODE_DUST_PSD
+use mode_write_diachro, only: Write_diachro
!
-TYPE(PROFILER), INTENT(IN) :: TPROFILER
-INTEGER, INTENT(IN) :: II
+TYPE(TFILEDATA), INTENT(IN) :: TPDIAFILE ! diachronic file to write
+INTEGER, INTENT(IN) :: KI
!
!* 0.2 declaration of local variables for diachro
!
-REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZWORK6 ! contains temporal serie
-REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZW6 ! contains temporal serie to write
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTRAJT ! localization of the
-REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV, ZN0, ZSIG, ZRG
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
-!
-INTEGER, DIMENSION(:), ALLOCATABLE :: IGRID ! grid indicator
-CHARACTER(LEN= 8) :: YGROUP ! group title
-CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YCOMMENT ! comment string
-CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YTITLE ! title
-CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YUNIT ! physical unit
-!
-INTEGER :: IPROC ! number of variables records
-INTEGER :: JPROC ! loop counter
-INTEGER :: JRR ! loop counter
-INTEGER :: JSV ! loop counter
-INTEGER :: IKU, IK ! loop counter
-CHARACTER(LEN=2) :: INDICE
-INTEGER :: I
+character(len=2) :: yidx
+character(len=100) :: ycomment
+character(len=100) :: yname
+CHARACTER(LEN=:), allocatable :: YGROUP ! group title
+INTEGER :: IKU
+INTEGER :: IPROC ! number of variables records
+INTEGER :: JPROC
+INTEGER :: JRR ! loop counter
+INTEGER :: JSV ! loop counter
+integer :: ji
+integer :: irr !Number of moist variables
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV, ZN0, ZSIG, ZRG
+type(tbudiachrometadata) :: tzbudiachro
+type(tfield_metadata_base), dimension(:), allocatable :: tzfields
!
!----------------------------------------------------------------------------
!
-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)
+IF (TPROFILER%X(KI)==XUNDEF) RETURN
+IF (TPROFILER%Y(KI)==XUNDEF) RETURN
+!
+IKU = SIZE(TPROFILER%W,2) !Number of vertical levels
!
-IPROC = 24 + SIZE(TPROFILER%R,4) + SIZE(TPROFILER%SV,4)
+!IPROC is too large (not a big problem) due to the separation between vertical profiles and point values
+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
IF (LDUST .OR. LORILAM .OR. LSALT) IPROC=IPROC+NAER
IF (SIZE(TPROFILER%TKE )>0) IPROC = IPROC + 1
!
-ALLOCATE (ZTRAJT( SIZE(TPROFILER%TIME),1))
-ALLOCATE (ZWORK6(1,1,IKU,SIZE(TPROFILER%TIME),1,IPROC))
-ALLOCATE (YCOMMENT(IPROC))
-ALLOCATE (YTITLE (IPROC))
-ALLOCATE (YUNIT (IPROC))
-ALLOCATE (IGRID (IPROC))
-!
-ZTRAJT (:,1) = TPROFILER%TIME(:)
+ALLOCATE (XWORK6(1,1,IKU,size(tprofiler%tpdates),1,IPROC))
+ALLOCATE (CCOMMENT(IPROC))
+ALLOCATE (CTITLE (IPROC))
+ALLOCATE (CUNIT (IPROC))
!
-IGRID = 1
-YGROUP = TPROFILER%NAME(II)
+YGROUP = TPROFILER%NAME(KI)
!
!----------------------------------------------------------------------------
-DO IK=1, IKU
-!
-JPROC=0
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'Th'
-YUNIT (JPROC) = 'K'
-YCOMMENT (JPROC) = 'Potential temperature'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%TH(:,IK,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'Thv'
-YUNIT (JPROC) = 'K'
-YCOMMENT (JPROC) = 'Virtual Potential temperature'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%THV(:,IK,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'VISI'
-YUNIT (JPROC) = 'km'
-YCOMMENT (JPROC) = 'Visibility'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%VISI(:,IK,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'VISIKUN'
-YUNIT (JPROC) = 'km'
-YCOMMENT (JPROC) = 'Visibility Kunkel'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%VISIKUN(:,IK,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'RARE'
-YUNIT (JPROC) = 'dBZ'
-YCOMMENT (JPROC) = 'Radar reflectivity'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%RARE(:,IK,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'P'
-YUNIT (JPROC) = 'Pascal'
-YCOMMENT (JPROC) = 'Pressure'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%P(:,IK,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'ALT'
-YUNIT (JPROC) = 'm'
-YCOMMENT (JPROC) = 'Altitude'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZZ(:,IK,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'LON'
-YUNIT (JPROC) = 'degree'
-YCOMMENT (JPROC) = 'Longitude'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LON(II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'LAT'
-YUNIT (JPROC) = 'degree'
-YCOMMENT (JPROC) = 'Latitude'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LAT(II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'ZON_WIND'
-YUNIT (JPROC) = 'm s-1'
-YCOMMENT (JPROC) = 'Zonal wind'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZON(:,IK,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'MER_WIND'
-YUNIT (JPROC) = 'm s-1'
-YCOMMENT (JPROC) = 'Meridional wind'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%MER(:,IK,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'FF'
-YUNIT (JPROC) = 'm s-1'
-YCOMMENT (JPROC) = 'Wind intensity'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%FF(:,IK,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'DD'
-YUNIT (JPROC) = 'degree'
-YCOMMENT (JPROC) = 'Wind direction'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%DD(:,IK,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'W'
-YUNIT (JPROC) = 'm s-1'
-YCOMMENT (JPROC) = 'Air vertical speed'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%W(:,IK,II)
-!
-IF (LDIAG_IN_RUN) THEN
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'T2m'
- YUNIT (JPROC) = 'K'
- YCOMMENT (JPROC) = '2-m temperature'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%T2M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'Q2m'
- YUNIT (JPROC) = 'kg kg-1'
- YCOMMENT (JPROC) = '2-m humidity'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%Q2M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'HU2m'
- YUNIT (JPROC) = 'percent'
- YCOMMENT (JPROC) = '2-m relative humidity'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%HU2M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'zon10m'
- YUNIT (JPROC) = 'm s-1'
- YCOMMENT (JPROC) = '10-m zonal wind'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZON10M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'mer10m'
- YUNIT (JPROC) = 'm s-1'
- YCOMMENT (JPROC) = '10-m meridian wind'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%MER10M(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'RN'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Net radiation'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%RN(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'H'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Sensible heat flux'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%H(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'LE'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Total Latent heat flux'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LE(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'G'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Storage heat flux'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%GFLUX(:,II)
- !
- IF (CRAD /= 'NONE') THEN
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'SWD'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Downward short-wave radiation'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SWD(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'SWU'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Upward short-wave radiation'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SWU(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'LWD'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Downward long-wave radiation'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LWD(:,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'LWU'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Upward long-wave radiation'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LWU(:,II)
- !
- END IF
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'TKE_DISS'
- YUNIT (JPROC) = 'm2 s-2'
- YCOMMENT (JPROC) = 'TKE dissipation rate'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%TKE_DISS(:,IK,II)
- !
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'LEI'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Solid Latent heat flux'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%LEI(:,II)
-!
-ENDIF
-!
-DO JRR=1,SIZE(TPROFILER%R,4)
- JPROC = JPROC+1
- YUNIT (JPROC) = 'kg kg-1'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%R(:,IK,II,JRR)
- IF (JRR==1) THEN
- YTITLE (JPROC) = 'Rv'
- YCOMMENT (JPROC) = 'Water vapor mixing ratio'
- ELSE IF (JRR==2) THEN
- YTITLE (JPROC) = 'Rc'
- YCOMMENT (JPROC) = 'Liquid cloud water mixing ratio'
- ELSE IF (JRR==3) THEN
- YTITLE (JPROC) = 'Rr'
- YCOMMENT (JPROC) = 'Rain water mixing ratio'
- ELSE IF (JRR==4) THEN
- YTITLE (JPROC) = 'Ri'
- YCOMMENT (JPROC) = 'Ice cloud water mixing ratio'
- ELSE IF (JRR==5) THEN
- YTITLE (JPROC) = 'Rs'
- YCOMMENT (JPROC) = 'Snow mixing ratio'
- ELSE IF (JRR==6) THEN
- YTITLE (JPROC) = 'Rg'
- YCOMMENT (JPROC) = 'Graupel mixing ratio'
- ELSE IF (JRR==7) THEN
- YTITLE (JPROC) = 'Rh'
- YCOMMENT (JPROC) = 'Hail mixing ratio'
- END IF
-END DO
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'Rhod'
-YUNIT (JPROC) = 'kg m-3'
-YCOMMENT (JPROC) = 'Density of dry air in moist'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%RHOD(:,IK,II)
-!
-IF (SIZE(TPROFILER%TKE,1)>0) THEN
- JPROC = JPROC+1
- YTITLE (JPROC) = 'Tke'
- YUNIT (JPROC) = 'm2 s-2'
- YCOMMENT (JPROC) = 'Turbulent kinetic energy'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%TKE(:,IK,II)
-END IF
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'IWV'
-YUNIT (JPROC) = 'kg m-2'
-YCOMMENT (JPROC) = 'Integrated Water Vapour'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%IWV(:,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'ZTD'
-YUNIT (JPROC) = 'm'
-YCOMMENT (JPROC) = 'Zenith Tropospheric Delay'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZTD(:,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'ZWD'
-YUNIT (JPROC) = 'm'
-YCOMMENT (JPROC) = 'Zenith Wet Delay'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZWD(:,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'ZHD'
-YUNIT (JPROC) = 'm'
-YCOMMENT (JPROC) = 'Zenith Hydrostatic Delay'
-ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%ZHD(:,II)
-!
-IF (SIZE(TPROFILER%SV,4)>=1) THEN
+!Treat vertical profiles
+jproc = 0
+
+call Add_profile( 'Th', 'Potential temperature', 'K', tprofiler%th )
+call Add_profile( 'Thv', 'Virtual Potential temperature', 'K', tprofiler%thv )
+call Add_profile( 'VISI', 'Visibility', 'km', tprofiler%visi )
+call Add_profile( 'VISIKUN', 'Visibility Kunkel', 'km', tprofiler%visikun )
+call Add_profile( 'RARE', 'Radar reflectivity', 'dBZ', tprofiler%crare )
+call Add_profile( 'RAREatt', 'Radar attenuated reflectivity', 'dBZ', tprofiler%crare_att )
+call Add_profile( 'P', 'Pressure', 'Pa', tprofiler%p )
+call Add_profile( 'ALT', 'Altitude', 'm', tprofiler%zz )
+call Add_profile( 'ZON_WIND', 'Zonal wind', 'm s-1', tprofiler%zon )
+call Add_profile( 'MER_WIND', 'Meridional wind', 'm s-1', tprofiler%mer )
+call Add_profile( 'FF', 'Wind intensity', 'm s-1', tprofiler%ff )
+call Add_profile( 'DD', 'Wind direction', 'degree', tprofiler%dd )
+call Add_profile( 'W', 'Air vertical speed', 'm s-1', tprofiler%w )
+
+if ( ldiag_in_run ) &
+ call Add_profile( 'TKE_DISS', 'TKE dissipation rate', 'm2 s-2', tprofiler% tke_diss )
+
+if ( Size( tprofiler%ciz, 1 ) > 0 ) &
+ call Add_profile( 'CIT', 'Ice concentration', 'kg-3', tprofiler%ciz )
+
+irr = Size( tprofiler%r )
+if ( irr >= 1 ) call Add_profile( 'Rv', 'Water vapor mixing ratio', 'kg kg-1', tprofiler%r(:,:,:,1) )
+if ( irr >= 2 ) call Add_profile( 'Rc', 'Liquid cloud water mixing ratio', 'kg kg-1', tprofiler%r(:,:,:,2) )
+if ( irr >= 3 ) call Add_profile( 'Rr', 'Rain water mixing ratio', 'kg kg-1', tprofiler%r(:,:,:,3) )
+if ( irr >= 4 ) call Add_profile( 'Ri', 'Ice cloud water mixing ratio', 'kg kg-1', tprofiler%r(:,:,:,4) )
+if ( irr >= 5 ) call Add_profile( 'Rs', 'Snow mixing ratio', 'kg kg-1', tprofiler%r(:,:,:,5) )
+if ( irr >= 6 ) call Add_profile( 'Rg', 'Graupel mixing ratio', 'kg kg-1', tprofiler%r(:,:,:,6) )
+if ( irr >= 7 ) call Add_profile( 'Rh', 'Hail mixing ratio', 'kg kg-1', tprofiler%r(:,:,:,7) )
+
+call Add_profile( 'Rhod', 'Density of dry air in moist', 'kg m-3', tprofiler%rhod )
+if ( Size( tprofiler%tke, 1 ) > 0 ) &
+ call Add_profile( 'Tke', 'Turbulent kinetic energy', 'm2 s-2', tprofiler%tke )
+
+if ( Size( tprofiler%sv, 4 ) > 0 ) then
! User scalar variables
- DO JSV = 1,NSV_USER
- JPROC = JPROC+1
- WRITE (YTITLE(JPROC),FMT='(A2,I3.3)') 'Sv',JSV
- YUNIT (JPROC) = 'kg kg-1'
- YCOMMENT (JPROC) = ' '
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
- END DO
+ do jsv = 1, nsv_user
+ Write ( yname, fmt = '( a2, i3.3 )' ) 'Sv', jsv
+ call Add_profile( yname, '', 'kg kg-1', tprofiler%sv(:,:,:,jsv) )
+ end do
! Passive pollutant scalar variables
- DO JSV = NSV_PPBEG,NSV_PPEND
- JPROC = JPROC+1
- WRITE (YTITLE(JPROC),FMT='(A2,I3.3)') 'Sv',JSV
- YUNIT (JPROC) = ''
- YCOMMENT (JPROC) = ' '
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
- END DO
+ do jsv = nsv_ppbeg, nsv_ppend
+ Write ( yname, fmt = '( a2, i3.3 )' ) 'Sv', jsv
+ call Add_profile( yname, '', '1', tprofiler%sv(:,:,:,jsv) )
+ end do
! microphysical C2R2 scheme scalar variables
- DO JSV = NSV_C2R2BEG,NSV_C2R2END
- JPROC = JPROC+1
- YTITLE(JPROC)= TRIM(C2R2NAMES(JSV-NSV_C2R2BEG+1))
- YUNIT (JPROC) = 'm-3'
- YCOMMENT (JPROC) = ' '
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
- END DO
+ do jsv = nsv_ppbeg, nsv_ppend
+ call Add_profile( Trim( c2r2names(jsv - nsv_c2r2beg + 1) ), '', 'm-3', tprofiler%sv(:,:,:,jsv) )
+ end do
! microphysical C3R5 scheme additional scalar variables
- DO JSV = NSV_C1R3BEG,NSV_C1R3END
- JPROC = JPROC+1
- YTITLE(JPROC)= TRIM(C1R3NAMES(JSV-NSV_C1R3BEG+1))
- YUNIT (JPROC) = 'm-3'
- YCOMMENT (JPROC) = ' '
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
- END DO
+ do jsv = nsv_c1r3beg, nsv_c1r3end
+ call Add_profile( Trim( c1r3names(jsv - nsv_c1r3beg + 1) ), '', 'm-3', tprofiler%sv(:,:,:,jsv) )
+ end do
! LIMA variables
- DO JSV=NSV_LIMA_BEG,NSV_LIMA_END
- JPROC = JPROC+1
- YUNIT (JPROC) = 'kg-1'
- YCOMMENT (JPROC) = ' '
- IF (JSV==NSV_LIMA_NC) YTITLE(JPROC)=TRIM(CLIMA_WARM_NAMES(1))//'T'
- IF (JSV==NSV_LIMA_NR) YTITLE(JPROC)=TRIM(CLIMA_WARM_NAMES(2))//'T'
- IF (JSV .GE. NSV_LIMA_CCN_FREE .AND. JSV .LT. NSV_LIMA_CCN_ACTI) THEN
- WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_FREE + 1)
- YTITLE(JPROC)=TRIM(CLIMA_WARM_NAMES(3))//INDICE//'T'
- ENDIF
- IF (JSV .GE. NSV_LIMA_CCN_ACTI .AND. JSV .LT. NSV_LIMA_CCN_ACTI + NMOD_CCN) THEN
- WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_CCN_ACTI + 1)
- YTITLE(JPROC)=TRIM(CLIMA_WARM_NAMES(4))//INDICE//'T'
- ENDIF
- IF (JSV .EQ. NSV_LIMA_SCAVMASS) YTITLE(JPROC)=TRIM(CAERO_MASS(1))//'T'
- IF (JSV==NSV_LIMA_NI) YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(1))//'T'
- IF (JSV .GE. NSV_LIMA_IFN_FREE .AND. JSV .LT. NSV_LIMA_IFN_NUCL) THEN
- WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_FREE + 1)
- YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(2))//INDICE//'T'
- ENDIF
- IF (JSV .GE. NSV_LIMA_IFN_NUCL .AND. JSV .LT. NSV_LIMA_IFN_NUCL + NMOD_IFN) THEN
- WRITE(INDICE,'(I2.2)')(JSV - NSV_LIMA_IFN_NUCL + 1)
- YTITLE(JPROC)=TRIM(CLIMA_COLD_NAMES(3))//INDICE//'T'
- ENDIF
- I = 0
- IF (JSV .GE. NSV_LIMA_IMM_NUCL .AND. JSV .LT. NSV_LIMA_IMM_NUCL + NMOD_IMM) THEN
- I = I + 1
- WRITE(INDICE,'(I2.2)')(NINDICE_CCN_IMM(I))
- 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'
-
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
- END DO
+ do jsv = nsv_lima_beg, nsv_lima_end
+ if ( jsv == nsv_lima_nc ) then
+ yname = Trim( clima_warm_names(1) ) // 'T'
+ else if ( jsv == nsv_lima_nr ) then
+ yname = Trim( clima_warm_names(2) ) // 'T'
+ else if ( jsv >= nsv_lima_ccn_free .and. jsv < nsv_lima_ccn_free + nmod_ccn ) then
+ Write( yidx, '( i2.2 )' ) jsv - nsv_lima_ccn_free + 1
+ yname = Trim( clima_warm_names(3) ) // yidx // 'T'
+ else if ( jsv >= nsv_lima_ccn_acti .and. jsv < nsv_lima_ccn_acti + nmod_ccn ) then
+ Write( yidx, '( i2.2 )' ) jsv - nsv_lima_ccn_acti + 1
+ yname = Trim( clima_warm_names(4) ) // yidx // 'T'
+ else if ( jsv == nsv_lima_scavmass ) then
+ yname = Trim( caero_mass(1) ) // 'T'
+ else if ( jsv == nsv_lima_ni ) then
+ yname = Trim( clima_cold_names(1) ) // 'T'
+ else if ( jsv >= nsv_lima_ifn_free .and. jsv < nsv_lima_ifn_free + nmod_ifn ) then
+ Write( yidx, '( i2.2 )' ) jsv - nsv_lima_ifn_free + 1
+ yname = Trim( clima_cold_names(2) ) // yidx // 'T'
+ else if ( jsv >= nsv_lima_ifn_nucl .and. jsv < nsv_lima_ifn_nucl + nmod_ifn ) then
+ Write( yidx, '( i2.2 )' ) jsv - nsv_lima_ifn_nucl + 1
+ yname = Trim( clima_cold_names(3) ) // yidx // 'T'
+ else if ( jsv >= nsv_lima_imm_nucl .and. jsv < nsv_lima_imm_nucl + nmod_imm ) then
+ write( yidx, '( i2.2 )' ) nindice_ccn_imm(jsv - nsv_lima_imm_nucl + 1)
+ yname = Trim( clima_cold_names(4) ) // yidx // 'T'
+ else if ( jsv == nsv_lima_hom_haze ) then
+ yname = Trim( clima_cold_names(5) ) // 'T'
+ else if ( jsv == nsv_lima_spro ) then
+ yname = Trim( clima_warm_names(5) ) // 'T'
+ end if
+ call Add_profile( yname, '', 'kg-1', tprofiler%sv(:,:,:,jsv) )
+ end do
! electrical scalar variables
- DO JSV = NSV_ELECBEG,NSV_ELECEND
- JPROC = JPROC+1
- YTITLE(JPROC)= TRIM(CELECNAMES(JSV-NSV_ELECBEG+1))
- YUNIT (JPROC) = 'C'
- YCOMMENT (JPROC) = ' '
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV)
- END DO
+ do jsv = nsv_elecbeg, nsv_elecend
+ call Add_profile( Trim( celecnames(jsv - nsv_elecbeg + 1) ), '', 'C', tprofiler%sv(:,:,:,jsv) )
+ end do
! chemical scalar variables
- DO JSV=NSV_CHEMBEG,NSV_CHEMEND
- JPROC = JPROC+1
- YTITLE(JPROC)= TRIM(CNAMES(JSV-NSV_CHEMBEG+1))
- YUNIT (JPROC) = 'ppb'
- WRITE(YCOMMENT (JPROC),'(A5,A3,I3.3)') 'T(s) ','SVT',JSV
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV) * 1.E9
- END DO
- IF ((LORILAM).AND. .NOT.(ANY(TPROFILER%P(:,IK,II) == 0.))) THEN
- ALLOCATE (ZSV(1,1,SIZE(TPROFILER%TIME),NSV_AER))
- ALLOCATE (ZRHO(1,1,SIZE(TPROFILER%TIME)))
- ALLOCATE (ZN0(1,1,SIZE(TPROFILER%TIME),JPMODE))
- ALLOCATE (ZRG(1,1,SIZE(TPROFILER%TIME),JPMODE))
- ALLOCATE (ZSIG(1,1,SIZE(TPROFILER%TIME),JPMODE))
- ZSV(1,1,:,1:NSV_AER) = TPROFILER%SV(:,IK,II,NSV_AERBEG:NSV_AEREND)
+ do jsv = nsv_chembeg, nsv_chemend
+ Write( ycomment, '( a5, a3, i3.3 )' ) 'T(s) ', 'SVT', jsv
+ call Add_profile( Trim( cnames(jsv - nsv_chembeg + 1) ), ycomment, 'ppb', tprofiler%sv(:,:,:,jsv) * 1.e9 )
+ end do
+ IF ( LORILAM .AND. .NOT.(ANY(TPROFILER%P(:,:,KI) == 0.)) ) THEN
+ ALLOCATE (ZSV (1,iku,size(tprofiler%tpdates),NSV_AER))
+ ALLOCATE (ZRHO(1,iku,size(tprofiler%tpdates)))
+ ALLOCATE (ZN0 (1,iku,size(tprofiler%tpdates),JPMODE))
+ ALLOCATE (ZRG (1,iku,size(tprofiler%tpdates),JPMODE))
+ ALLOCATE (ZSIG(1,iku,size(tprofiler%tpdates),JPMODE))
+ do ji = 1, iku
+ ZSV(1,ji,:,1:NSV_AER) = TPROFILER%SV(:,ji,KI,NSV_AERBEG:NSV_AEREND)
+ end do
IF (SIZE(TPROFILER%R,4) >0) THEN
- ZRHO(1,1,:) = 0.
- DO JRR=1,SIZE(TPROFILER%R,4)
- ZRHO(1,1,:) = ZRHO(1,1,:) + TPROFILER%R(:,IK,II,JRR)
- ENDDO
- ZRHO(1,1,:) = TPROFILER%TH(:,IK,II) * ( 1. + XRV/XRD*TPROFILER%R(:,IK,II,1) ) &
- / ( 1. + ZRHO(1,1,:) )
+ ZRHO(1,:,:) = 0.
+ do ji = 1, iku
+ DO JRR=1,SIZE(TPROFILER%R,4)
+ ZRHO(1,ji,:) = ZRHO(1,ji,:) + TPROFILER%R(:,ji,KI,JRR)
+ ENDDO
+ ZRHO(1,ji,:) = TPROFILER%TH(:,ji,KI) * ( 1. + XRV/XRD*TPROFILER%R(:,ji,KI,1) ) &
+ / ( 1. + ZRHO(1,ji,:) )
+ end do
ELSE
- ZRHO(1,1,:) = TPROFILER%TH(:,IK,II)
+ do ji = 1, iku
+ ZRHO(1,ji,:) = TPROFILER%TH(:,ji,KI)
+ end do
ENDIF
- ZRHO(1,1,:) = TPROFILER%P(:,IK,II) / &
- (XRD *ZRHO(1,1,:) *((TPROFILER%P(:,IK,II)/XP00)**(XRD/XCPD)) )
+ do ji = 1, iku
+ ZRHO(1,ji,:) = TPROFILER%P(:,ji,KI) / &
+ (XRD *ZRHO(1,ji,:) *((TPROFILER%P(:,ji,KI)/XP00)**(XRD/XCPD)) )
+ end do
CALL PPP2AERO(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0)
DO JSV=1,JPMODE
! mean radius
JPROC = JPROC+1
- WRITE(YTITLE(JPROC),'(A6,I1)')'AERRGA',JSV
- YUNIT (JPROC) = 'um'
- WRITE(YCOMMENT(JPROC),'(A18,I1)')'RG (nb) AERO MODE ',JSV
- ZWORK6 (1,1,IK,:,1,JPROC) = ZRG(1,1,:,JSV)
+ WRITE(CTITLE(JPROC),'(A6,I1)')'AERRGA',JSV
+ CUNIT(JPROC) = 'um'
+ WRITE(CCOMMENT(JPROC),'(A18,I1)')'RG (nb) AERO MODE ',JSV
+ do ji = 1, iku
+ XWORK6(1,1,ji,:,1,JPROC) = ZRG(1,ji,:,JSV)
+ end do
! standard deviation
JPROC = JPROC+1
- WRITE(YTITLE(JPROC),'(A7,I1)')'AERSIGA',JSV
- YUNIT (JPROC) = ' '
- WRITE(YCOMMENT(JPROC),'(A16,I1)')'SIGMA AERO MODE ',JSV
- ZWORK6 (1,1,IK,:,1,JPROC) = ZSIG(1,1,:,JSV)
+ WRITE(CTITLE(JPROC),'(A7,I1)')'AERSIGA',JSV
+ CUNIT(JPROC) = ' '
+ WRITE(CCOMMENT(JPROC),'(A16,I1)')'SIGMA AERO MODE ',JSV
+ do ji = 1, iku
+ XWORK6(1,1,ji,:,1,JPROC) = ZSIG(1,ji,:,JSV)
+ end do
! particles number
JPROC = JPROC+1
- WRITE(YTITLE(JPROC),'(A6,I1)')'AERN0A',JSV
- YUNIT (JPROC) = 'm-3'
- WRITE(YCOMMENT(JPROC),'(A13,I1)')'N0 AERO MODE ',JSV
- ZWORK6 (1,1,IK,:,1,JPROC) = ZN0(1,1,:,JSV)
+ WRITE(CTITLE(JPROC),'(A6,I1)')'AERN0A',JSV
+ CUNIT(JPROC) = 'm-3'
+ WRITE(CCOMMENT(JPROC),'(A13,I1)')'N0 AERO MODE ',JSV
+ do ji = 1, iku
+ XWORK6(1,1,ji,:,1,JPROC) = ZN0(1,ji,:,JSV)
+ end do
ENDDO
- DEALLOCATE (ZSV,ZRHO)
- DEALLOCATE (ZN0,ZRG,ZSIG)
+ DEALLOCATE (ZSV,ZRHO)
+ DEALLOCATE (ZN0,ZRG,ZSIG)
END IF
! dust scalar variables
- DO JSV = NSV_DSTBEG,NSV_DSTEND
- JPROC = JPROC+1
- YTITLE(JPROC)= TRIM(CDUSTNAMES(JSV-NSV_DSTBEG+1))
- YUNIT (JPROC) = 'ppb'
- YCOMMENT (JPROC) = ' '
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV) * 1.E9
- END DO
- IF ((LDUST).AND. .NOT.(ANY(TPROFILER%P(:,IK,II) == 0.))) THEN
- ALLOCATE (ZSV(1,1,SIZE(TPROFILER%TIME),NSV_DST))
- ALLOCATE (ZRHO(1,1,SIZE(TPROFILER%TIME)))
- ALLOCATE (ZN0(1,1,SIZE(TPROFILER%TIME),NMODE_DST))
- ALLOCATE (ZRG(1,1,SIZE(TPROFILER%TIME),NMODE_DST))
- ALLOCATE (ZSIG(1,1,SIZE(TPROFILER%TIME),NMODE_DST))
- ZSV(1,1,:,1:NSV_DST) = TPROFILER%SV(:,IK,II,NSV_DSTBEG:NSV_DSTEND)
+ do jsv = nsv_dstbeg, nsv_dstend
+ call Add_profile( Trim( cdustnames(jsv - nsv_dstbeg + 1) ), '', 'ppb', tprofiler%sv(:,:,:,jsv) * 1.e9 )
+ end do
+ IF ((LDUST).AND. .NOT.(ANY(TPROFILER%P(:,:,KI) == 0.))) THEN
+ ALLOCATE (ZSV (1,iku,size(tprofiler%tpdates),NSV_DST))
+ ALLOCATE (ZRHO(1,iku,size(tprofiler%tpdates)))
+ ALLOCATE (ZN0 (1,iku,size(tprofiler%tpdates),NMODE_DST))
+ ALLOCATE (ZRG (1,iku,size(tprofiler%tpdates),NMODE_DST))
+ ALLOCATE (ZSIG(1,iku,size(tprofiler%tpdates),NMODE_DST))
+ do ji = 1, iku
+ ZSV(1,ji,:,1:NSV_DST) = TPROFILER%SV(:,ji,KI,NSV_DSTBEG:NSV_DSTEND)
+ end do
IF (SIZE(TPROFILER%R,4) >0) THEN
- ZRHO(1,1,:) = 0.
- DO JRR=1,SIZE(TPROFILER%R,4)
- ZRHO(1,1,:) = ZRHO(1,1,:) + TPROFILER%R(:,IK,II,JRR)
- ENDDO
- ZRHO(1,1,:) = TPROFILER%TH(:,IK,II) * ( 1. + XRV/XRD*TPROFILER%R(:,IK,II,1) ) &
- / ( 1. + ZRHO(1,1,:) )
+ ZRHO(1,:,:) = 0.
+ do ji = 1, iku
+ DO JRR=1,SIZE(TPROFILER%R,4)
+ ZRHO(1,ji,:) = ZRHO(1,ji,:) + TPROFILER%R(:,ji,KI,JRR)
+ ENDDO
+ ZRHO(1,ji,:) = TPROFILER%TH(:,ji,KI) * ( 1. + XRV/XRD*TPROFILER%R(:,ji,KI,1) ) &
+ / ( 1. + ZRHO(1,ji,:) )
+ end do
ELSE
- ZRHO(1,1,:) = TPROFILER%TH(:,IK,II)
+ do ji = 1, iku
+ ZRHO(1,ji,:) = TPROFILER%TH(:,ji,KI)
+ end do
ENDIF
- ZRHO(1,1,:) = TPROFILER%P(:,IK,II) / &
- (XRD *ZRHO(1,1,:) *((TPROFILER%P(:,IK,II)/XP00)**(XRD/XCPD)) )
+ do ji = 1, iku
+ ZRHO(1,ji,:) = TPROFILER%P(:,ji,KI) / &
+ (XRD *ZRHO(1,ji,:) *((TPROFILER%P(:,ji,KI)/XP00)**(XRD/XCPD)) )
+ end do
CALL PPP2DUST(ZSV,ZRHO, PSIG3D=ZSIG, PRG3D=ZRG, PN3D=ZN0)
DO JSV=1,NMODE_DST
! mean radius
JPROC = JPROC+1
- WRITE(YTITLE(JPROC),'(A6,I1)')'DSTRGA',JSV
- YUNIT (JPROC) = 'um'
- WRITE(YCOMMENT(JPROC),'(A18,I1)')'RG (nb) DUST MODE ',JSV
- ZWORK6 (1,1,IK,:,1,JPROC) = ZRG(1,1,:,JSV)
+ WRITE(CTITLE(JPROC),'(A6,I1)')'DSTRGA',JSV
+ CUNIT(JPROC) = 'um'
+ WRITE(CCOMMENT(JPROC),'(A18,I1)')'RG (nb) DUST MODE ',JSV
+ do ji = 1, iku
+ XWORK6 (1,1,ji,:,1,JPROC) = ZRG(1,ji,:,JSV)
+ end do
! standard deviation
JPROC = JPROC+1
- WRITE(YTITLE(JPROC),'(A7,I1)')'DSTSIGA',JSV
- YUNIT (JPROC) = ' '
- WRITE(YCOMMENT(JPROC),'(A16,I1)')'SIGMA DUST MODE ',JSV
- ZWORK6 (1,1,IK,:,1,JPROC) = ZSIG(1,1,:,JSV)
+ WRITE(CTITLE(JPROC),'(A7,I1)')'DSTSIGA',JSV
+ CUNIT(JPROC) = ' '
+ WRITE(CCOMMENT(JPROC),'(A16,I1)')'SIGMA DUST MODE ',JSV
+ do ji = 1, iku
+ XWORK6 (1,1,ji,:,1,JPROC) = ZSIG(1,ji,:,JSV)
+ end do
! particles number
JPROC = JPROC+1
- WRITE(YTITLE(JPROC),'(A6,I1)')'DSTN0A',JSV
- YUNIT (JPROC) = 'm-3'
- WRITE(YCOMMENT(JPROC),'(A13,I1)')'N0 DUST MODE ',JSV
- ZWORK6 (1,1,IK,:,1,JPROC) = ZN0(1,1,:,JSV)
+ WRITE(CTITLE(JPROC),'(A6,I1)')'DSTN0A',JSV
+ CUNIT(JPROC) = 'm-3'
+ WRITE(CCOMMENT(JPROC),'(A13,I1)')'N0 DUST MODE ',JSV
+ do ji = 1, iku
+ XWORK6 (1,1,ji,:,1,JPROC) = ZN0(1,ji,:,JSV)
+ end do
ENDDO
- DEALLOCATE (ZSV,ZRHO)
- DEALLOCATE (ZN0,ZRG,ZSIG)
+ DEALLOCATE (ZSV,ZRHO)
+ DEALLOCATE (ZN0,ZRG,ZSIG)
END IF
! sea salt scalar variables
- DO JSV = NSV_SLTBEG,NSV_SLTEND
- JPROC = JPROC+1
- YTITLE(JPROC)= TRIM(CSALTNAMES(JSV-NSV_SLTBEG+1))
- YUNIT (JPROC) = 'ppb'
- YCOMMENT (JPROC) = ' '
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%SV(:,IK,II,JSV) * 1.E9
- END DO
- IF (LDUST .OR. LORILAM .OR. LSALT) THEN
- DO JSV = 1,NAER
- JPROC = JPROC+1
- WRITE(YTITLE(JPROC),'(A6,I1)')'AEREXT',JSV
- YUNIT (JPROC) = ' '
- YCOMMENT (JPROC) = 'Aerosol Extinction'
- ZWORK6 (1,1,IK,:,1,JPROC) = TPROFILER%AER(:,IK,II,JSV)
- END DO
- ENDIF
-ENDIF
-!
-END DO
-!
+ do jsv = nsv_sltbeg, nsv_sltend
+ call Add_profile( Trim( csaltnames(jsv - nsv_sltbeg + 1) ), '', 'ppb', tprofiler%sv(:,:,:,jsv) * 1.e9 )
+ end do
+ if ( ldust .or. lorilam .or. lsalt ) then
+ do jsv = 1, naer
+ Write( yname, '( a, i1 )' ) 'AEREXT', jsv
+ call Add_profile( yname, 'Aerosol Extinction', '1', tprofiler%aer(:,:,:,jsv) )
+ end do
+ end if
+end if
+
+allocate( tzfields( jproc ) )
+
+tzfields(:)%cmnhname = ctitle(1 : jproc)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = ctitle(1 : jproc)
+tzfields(:)%cunits = cunit(1 : jproc)
+tzfields(:)%ccomment = ccomment(1 : jproc)
+tzfields(:)%ngrid = 0
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 3
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(3) = NMNHDIM_LEVEL
+tzfields(:)%ndimlist(4) = NMNHDIM_PROFILER_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_PROFILER_PROC
+
+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) = 'Data at position of profiler ' // Trim( ygroup )
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .true.
+tzbudiachro%clevels (NLVL_SHAPE) = 'Vertical_profile'
+tzbudiachro%ccomments(NLVL_SHAPE) = 'Vertical profiles at position of profiler ' // 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.
+!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
+
+call Write_diachro( tpdiafile, tzbudiachro, tzfields, tprofiler%tpdates, xwork6(:,:,:,:,:,:jproc) )
+
+Deallocate( tzfields )
+Deallocate( xwork6 )
+
!----------------------------------------------------------------------------
-!
+!Treat point values
+
+ALLOCATE (XWORK6(1,1,1,size(tprofiler%tpdates),1,IPROC))
+
+jproc = 0
+
+if ( ldiag_in_run ) then
+ call Add_point( 'T2m', '2-m temperature', 'K', tprofiler%t2m )
+ call Add_point( 'Q2m', '2-m humidity', 'kg kg-1', tprofiler%q2m )
+ call Add_point( 'HU2m', '2-m relative humidity', 'percent', tprofiler%hu2m )
+ call Add_point( 'zon10m', '10-m zonal wind', 'm s-1', tprofiler%zon10m )
+ call Add_point( 'mer10m', '10-m meridian wind', 'm s-1', tprofiler%mer10m )
+ call Add_point( 'RN', 'Net radiation', 'W m-2', tprofiler%rn )
+ call Add_point( 'H', 'Sensible heat flux', 'W m-2', tprofiler%h )
+ call Add_point( 'LE', 'Total Latent heat flux', 'W m-2', tprofiler%le )
+ call Add_point( 'G', 'Storage heat flux', 'W m-2', tprofiler%gflux )
+ if ( crad /= 'NONE' ) then
+ call Add_point( 'SWD', 'Downward short-wave radiation', 'W m-2', tprofiler%swd )
+ call Add_point( 'SWU', 'Upward short-wave radiation', 'W m-2', tprofiler%swu )
+ call Add_point( 'LWD', 'Downward long-wave radiation', 'W m-2', tprofiler%lwd )
+ call Add_point( 'LWU', 'Upward long-wave radiation', 'W m-2', tprofiler%lwu )
+ end if
+ call Add_point( 'LEI', 'Solid Latent heat flux', 'W m-2', tprofiler%lei )
+end if
+
+call Add_point( 'IWV', 'Integrated Water Vapour', 'kg m-2', tprofiler%iwv )
+call Add_point( 'ZTD', 'Zenith Tropospheric Delay', 'm', tprofiler%ztd )
+call Add_point( 'ZWD', 'Zenith Wet Delay', 'm', tprofiler%zwd )
+call Add_point( 'ZHD', 'Zenith Hydrostatic Delay', 'm', tprofiler%zhd )
+
+Allocate( tzfields( jproc ) )
+
+tzfields(:)%cmnhname = ctitle(1 : jproc)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = ctitle(1 : jproc)
+tzfields(:)%cunits = cunit(1 : jproc)
+tzfields(:)%ccomment = ccomment(1 : jproc)
+tzfields(:)%ngrid = 0
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 2
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(3) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(4) = NMNHDIM_PROFILER_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_PROFILER_PROC
+
+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) = 'Data at position of profiler ' // Trim( ygroup )
+
+tzbudiachro%lleveluse(NLVL_SHAPE) = .true.
+tzbudiachro%clevels (NLVL_SHAPE) = 'Point'
+tzbudiachro%ccomments(NLVL_SHAPE) = 'Values at position of profiler ' // 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.
+!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
+tzbudiachro%nkl = 1
+tzbudiachro%nkh = 1
+
+call Write_diachro( tpdiafile, tzbudiachro, tzfields, tprofiler%tpdates, xwork6(:,:,:,:,:,:jproc) )
+
+Deallocate( tzfields )
-ALLOCATE (ZW6(1,1,IKU,SIZE(TPROFILER%TIME),1,JPROC))
-ZW6 = ZWORK6(:,:,:,:,:,:JPROC)
-DEALLOCATE(ZWORK6)
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"CART",IGRID(:JPROC), TPROFILER%DATIME,&
- ZW6,ZTRAJT,YTITLE(:JPROC),YUNIT(:JPROC),YCOMMENT(:JPROC), &
- .TRUE.,.TRUE.,.FALSE., &
- KIL=1,KIH=1,KJL=1,KJH=1,KKL=1,KKH=IKU )
-!
-DEALLOCATE (ZTRAJT )
-DEALLOCATE (ZW6 )
-DEALLOCATE (YCOMMENT)
-DEALLOCATE (YTITLE )
-DEALLOCATE (YUNIT )
-DEALLOCATE (IGRID )
!----------------------------------------------------------------------------
+!Treat position
+
+jproc = 0
+
+JPROC = JPROC + 1
+CTITLE (JPROC) = 'LON'
+CUNIT (JPROC) = 'degree'
+CCOMMENT (JPROC) = 'Longitude'
+XWORK6 (1,1,1,:,1,JPROC) = TPROFILER%LON(KI)
+
+JPROC = JPROC + 1
+CTITLE (JPROC) = 'LAT'
+CUNIT (JPROC) = 'degree'
+CCOMMENT (JPROC) = 'Latitude'
+XWORK6 (1,1,1,:,1,JPROC) = TPROFILER%LAT(KI)
+
+Allocate( tzfields( jproc ) )
+
+tzfields(:)%cmnhname = ctitle(1 : jproc)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = ctitle(1 : jproc)
+tzfields(:)%cunits = cunit(1 : jproc)
+tzfields(:)%ccomment = ccomment(1 : jproc)
+tzfields(:)%ngrid = 0
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 1
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(3) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(4) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_PROFILER_PROC
+
+call Write_diachro( tpdiafile, tzbudiachro, tzfields, tprofiler%tpdates, xwork6(:,:,:,:,:,:jproc) )
+
+
+!Necessary because global variables (private inside module)
+Deallocate( xwork6 )
+Deallocate (ccomment)
+Deallocate (ctitle )
+Deallocate (cunit )
+
+
+contains
+
+
+subroutine Add_profile( htitle, hcomment, hunits, pfield )
+
+use mode_msg
+
+character(len=*), intent(in) :: htitle
+character(len=*), intent(in) :: hcomment
+character(len=*), intent(in) :: hunits
+real, dimension(:,:,:), intent(in) :: pfield
+
+integer :: jk
+
+jproc = jproc + 1
+
+if ( jproc > iproc ) call Print_msg( NVERB_FATAL, 'IO', 'Add_profile', 'more profiles than expected' )
+
+ctitle(jproc) = Trim( htitle)
+ccomment(jproc) = Trim( hcomment )
+cunit(jproc) = Trim( hunits )
+
+do jk = 1, iku
+ xwork6(1, 1, jk, :, 1, jproc) = pfield(:, jk, ki)
+end do
+
+end subroutine Add_profile
+
+
+subroutine Add_point( htitle, hcomment, hunits, pfield )
+
+use mode_msg
+
+character(len=*), intent(in) :: htitle
+character(len=*), intent(in) :: hcomment
+character(len=*), intent(in) :: hunits
+real, dimension(:,:), intent(in) :: pfield
+
+integer :: jk
+
+jproc = jproc + 1
+
+if ( jproc > iproc ) call Print_msg( NVERB_FATAL, 'IO', 'Add_profile', 'more profiles than expected' )
+
+ctitle(jproc) = Trim( htitle)
+ccomment(jproc) = Trim( hcomment )
+cunit(jproc) = Trim( hunits )
+
+xwork6(1, 1, 1, :, 1, jproc) = pfield(:, ki)
+
+end subroutine Add_point
+
END SUBROUTINE PROFILER_DIACHRO_n
-!----------------------------------------------------------------------------
-!----------------------------------------------------------------------------
-!
-END SUBROUTINE WRITE_PROFILER_n
+
+END MODULE MODE_WRITE_PROFILER_n
diff --git a/src/MNH/write_seriesn.f90 b/src/MNH/write_seriesn.f90
index d4851b5a335e5f7b4b1e0c208a61ee9499ef5cd4..54ed6c7c8cc5667860dc1c0bc285787c09f76772 100644
--- a/src/MNH/write_seriesn.f90
+++ b/src/MNH/write_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.
@@ -56,19 +56,27 @@ END MODULE MODI_WRITE_SERIES_n
!! MODIFICATIONS
!! -------------
!! Original 4/03/2002
-!! Modification 7/01/2013 Add key for netcdf writing
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! P.Wautelet: 11/07/2016 : removed MNH_NCWRIT define
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
-!!
+! 07/01/2013: add key for netCDF writing
+! J. Escobar 15/09/2015: WENO5 & JPHEXT <> 1
+! P. Wautelet 11/07/2016: removed MNH_NCWRIT define
+! 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
+! 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)
!-------------------------------------------------------------------------------
!
!
!* 0. Declaration
! --------------
-!
-USE MODD_IO, ONLY: NGEN_VERB, TFILEDATA
-USE MODD_LUNIT_n, ONLY: TLUOUT
+!
+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, &
+ tfield_metadata_base, TYPEREAL
+USE MODD_IO, ONLY: NGEN_VERB, TFILEDATA
+USE MODD_LUNIT_n, ONLY: TLUOUT
USE MODD_PARAMETERS
USE MODD_SERIES
USE MODD_SERIES_n
@@ -76,8 +84,7 @@ USE MODD_SERIES_n
USE MODE_GATHER_ll
USE MODE_ll
USE MODE_MSG
-!
-USE MODI_WRITE_DIACHRO
+use mode_write_diachro, only: Write_diachro
!
IMPLICIT NONE
!
@@ -89,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
@@ -109,8 +116,10 @@ INTEGER :: IRESP ! Return code of FM-routines
INTEGER :: INFO_ll ! Return code of FM-routines
INTEGER :: ISER,INAV
REAL :: ZSIZEHB
-LOGICAL :: GICP,GJCP,GKCP ! compression flags along the 3 directions
CHARACTER(LEN=100) :: YMSG
+type(tbudiachrometadata) :: tzbudiachro
+type(tfield_metadata_base), dimension(:), allocatable :: tzfields
+type(tfiledata) :: tzfile
!----------------------------------------------------------------------------
!
!* 1. INITIALIZATION
@@ -235,12 +244,90 @@ ENDIF
!
!* 2.3 Write in diachro file
!
-GICP=.TRUE. ; GJCP=.TRUE. ; GKCP=.TRUE.
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT,'TSERIES','CART',NSGRIDD1,XSDATIME(:,1:NSNBSTEPT), &
- XSSERIES1(1:1,1:1,1:1,1:NSNBSTEPT,:,:), &
- XSTRAJT(1:NSNBSTEPT,:),CSTITLE1,CSUNIT1,CSCOMMENT1, &
- GICP,GJCP,GKCP, &
- KIL=1,KIH=1,KJL=1,KJH=1,KKL=1,KKH=1)
+allocate( tzfields( nstemp_serie1 ) )
+
+tzfields(:)%cmnhname = cstitle1(:)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = cstitle1(:)
+tzfields(:)%cunits = csunit1(:)
+tzfields(:)%ccomment = cscomment1(:)
+tzfields(:)%ngrid = nsgridd1(:)
+tzfields(:)%ntype = TYPEREAL
+! 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
+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
+tzbudiachro%njh = njboxh
+tzbudiachro%nkl = 1
+tzbudiachro%nkh = ikmax
+
+tzfile = tpdiafile
+if ( Trim( tpdiafile%cformat ) == 'LFI' .or. Trim( tpdiafile%cformat ) == 'LFICDF4' ) then
+ !For LFI files, it is necessary to write all the 'processes' (source terms) of the different masks in one pass
+ !to ensure that they are grouped together and not overwritten
+ tzfile%cformat = 'LFI'
+
+ call Write_diachro( tzfile, tzbudiachro, tzfields, tpsdates(1:nsnbstept), &
+ xsseries1(1:1,1:1,1:1,1:nsnbstept,1:1,:) )
+end if
+
+if ( Trim( tpdiafile%cformat ) /= 'LFI' ) then! Loop on the different masks
+ tzfile%cformat = 'NETCDF4'
+
+ ! 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( tzfile, tzbudiachro, [ tzfields(jp) ], tpsdates(1:nsnbstept), &
+ xsseries1(1:1,1:1,1:1,1:nsnbstept,1:1,jp:jp) )
+ end do
+end if
+
+deallocate( tzfields )
!
!----------------------------------------------------------------------------
!
@@ -289,12 +376,98 @@ DEALLOCATE(ZVAR3D)
!
!* 3.2 Write in diachro file
!
-GICP=.TRUE. ; GJCP=.TRUE. ; GKCP=.FALSE.
-CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT,'ZTSERIES','CART',NSGRIDD2,XSDATIME(:,1:NSNBSTEPT), &
- XSSERIES2(1:1,1:1,1:IKMAX,1:NSNBSTEPT,:,:), &
- XSTRAJT(1:NSNBSTEPT,:),CSTITLE2,CSUNIT2,CSCOMMENT2, &
- GICP,GJCP,GKCP, &
- KIL=1,KIH=1,KJL=1,KJH=1,KKL=IKB,KKH=IKE)
+allocate( tzfields( nstemp_serie2 ) )
+
+tzfields(:)%cmnhname = cstitle2(:)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = cstitle2(:)
+tzfields(:)%cunits = csunit2(:)
+tzfields(:)%ccomment = cscomment2(:)
+tzfields(:)%ngrid = nsgridd2(:)
+tzfields(:)%ntype = TYPEREAL
+! 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
+ if ( nsgridd2(ji) == 1 ) then
+ tzfields(ji)%ndimlist(3) = NMNHDIM_SERIES_LEVEL
+ else if ( nsgridd2(ji) == 4 ) then
+ tzfields(ji)%ndimlist(3) = NMNHDIM_SERIES_LEVEL_W
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_series_n', 'invalid nsgridd2' )
+ tzfields(ji)%ndimlist(3) = NMNHDIM_SERIES_LEVEL
+ end if
+end do
+tzfields(:)%ndimlist(4) = NMNHDIM_SERIES_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+! 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
+tzbudiachro%njh = njboxh
+tzbudiachro%nkl = 1
+tzbudiachro%nkh = ikmax
+
+if ( Trim( tpdiafile%cformat ) == 'LFI' .or. Trim( tpdiafile%cformat ) == 'LFICDF4' ) then
+ !For LFI files, it is necessary to write all the 'processes' (source terms) of the different masks in one pass
+ !to ensure that they are grouped together and not overwritten
+ tzfile%cformat = 'LFI'
+
+ call Write_diachro( tzfile, tzbudiachro, tzfields, tpsdates(1:nsnbstept), &
+ xsseries2(1:1,1:1,1:ikmax,1:nsnbstept,1:1,:) )
+end if
+
+if ( Trim( tpdiafile%cformat ) /= 'LFI' ) then! Loop on the different masks
+ tzfile%cformat = 'NETCDF4'
+
+ ! 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( tzfile, tzbudiachro, [ tzfields(jp) ], tpsdates(1:nsnbstept), &
+ xsseries2(1:1,1:1,1:ikmax,1:nsnbstept,1:1,jp:jp) )
+ end do
+end if
+
+deallocate( tzfields )
!
!----------------------------------------------------------------------------
!
@@ -347,12 +520,78 @@ DO JS=1,NBJSLICE
DO JT=1, NSTEMP_SERIE3
YSTITLE3S(JT)=ADJUSTL(ADJUSTR(CSTITLE3(JT))//'Y'//YSL//'-'//YSH)
END DO
- GICP=.FALSE. ; GJCP=.TRUE. ; GKCP=.TRUE.
- CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT,YGROUP,'CART',NSGRIDD3,XSDATIME(:,1:NSNBSTEPT), &
- ZSERIES3_ll(1:IIU_ll,1:1,1:1,1:NSNBSTEPT,1:1,ISB1:ISB2),&
- XSTRAJT(1:NSNBSTEPT,:),YSTITLE3S,CSUNIT3,CSCOMMENT3, &
- GICP,GJCP,GKCP, &
- KIL=1,KIH=IIU_ll,KJL=1,KJH=1,KKL=1,KKH=1)
+ allocate( tzfields( isb2 - isb1 + 1 ) )
+
+ tzfields(:)%cmnhname = ystitle3s(:)
+ tzfields(:)%cstdname = ''
+ tzfields(:)%clongname = ystitle3s(:)
+ tzfields(:)%cunits = csunit3(:)
+ tzfields(:)%ccomment = cscomment3(:)
+ tzfields(:)%ngrid = nsgridd3(:)
+ tzfields(:)%ntype = TYPEREAL
+ tzfields(:)%ndims = 3
+ do ji = 1, isb2 - isb1 + 1
+ if ( nsgridd3(ji) == 1 .or. nsgridd3(ji) == 4 ) then
+ tzfields(ji)%ndimlist(1) = NMNHDIM_NI
+ else if ( nsgridd3(ji) == 2 ) then
+ tzfields(ji)%ndimlist(1) = NMNHDIM_NI_U
+ else
+ call Print_msg( NVERB_ERROR, 'IO', 'Write_series_n', 'invalid nsgridd3' )
+ tzfields(ji)%ndimlist(1) = NMNHDIM_NI
+ end if
+ end do
+ 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%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
+ tzbudiachro%njh = 1
+ tzbudiachro%nkl = 1
+ tzbudiachro%nkh = 1
+
+ call Write_diachro( tpdiafile, tzbudiachro, tzfields, tpsdates(1:nsnbstept), &
+ zseries3_ll(1:iiu_ll, 1:1, 1:1, 1:nsnbstept, 1:1, isb1:isb2) )
+
+ deallocate( tzfields )
END DO
DEALLOCATE(ZVAR3D,ZWORK2D,ZSERIES3_ll)
!
diff --git a/src/MNH/write_stationn.f90 b/src/MNH/write_stationn.f90
index 916f951e3b4a5c45a51d019d01d7dbefd7fec4d5..7efb9adaa863a844ec485d803cec0a409b8b69e6 100644
--- a/src/MNH/write_stationn.f90
+++ b/src/MNH/write_stationn.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.
@@ -57,38 +57,41 @@ END MODULE MODI_WRITE_STATION_n
!! -------------
!! Original 15/02/2002
!! 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
+! 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)
+! --------------------------------------------------------------------------
+!
!* 0. DECLARATIONS
! ------------
!
+use MODD_BUDGET, ONLY: tbudiachrometadata
+USE MODD_CH_M9_n, ONLY: CNAMES
+USE MODD_CH_AEROSOL, ONLY: CAERONAMES, LORILAM, JPMODE
+USE MODD_CONF
USE MODD_CST
+USE MODD_DIAG_IN_RUN
+USE MODD_DIM_n
+USE MODD_DUST, ONLY: CDUSTNAMES, LDUST, NMODE_DST
+USE MODD_ELEC_DESCR, ONLY: CELECNAMES
+USE MODD_GRID_n
+USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LG, ONLY: CLGNAMES
USE MODD_LUNIT
+USE MODD_NSV
USE MODD_PARAMETERS
-!
-USE MODD_CH_M9_n, ONLY: CNAMES
-USE MODD_CH_AEROSOL, ONLY: CAERONAMES, LORILAM, JPMODE
+USE MODD_PARAM_n, ONLY: CRAD, CSURF
+USE MODD_PASPOL
USE MODD_RAIN_C2R2_DESCR, ONLY: C2R2NAMES
-USE MODD_ICE_C1R3_DESCR, ONLY: C1R3NAMES
-USE MODD_ELEC_DESCR, ONLY: CELECNAMES
-USE MODD_LG, ONLY: CLGNAMES
-USE MODD_DUST, ONLY: CDUSTNAMES, LDUST, NMODE_DST
USE MODD_SALT, ONLY: CSALTNAMES, LSALT, NMODE_SLT
-USE MODD_NSV
-USE MODD_DIAG_IN_RUN
-USE MODD_PARAM_n, ONLY: CRAD
-!
-USE MODD_DIM_n
-USE MODD_GRID_n
USE MODD_STATION_n
+USE MODD_ALLSTATION_n, ONLY: LDIAG_SURFRAD
!
+USE MODE_AERO_PSD
USE MODE_DUST_PSD
USE MODE_SALT_PSD
-USE MODE_AERO_PSD
-!
-USE MODI_WRITE_DIACHRO
+use MODE_WRITE_DIACHRO, ONLY: Write_diachro
!
IMPLICIT NONE
!
@@ -120,15 +123,18 @@ CONTAINS
!
!----------------------------------------------------------------------------
SUBROUTINE STATION_DIACHRO_n(TSTATION,II)
-!
+
+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
INTEGER, INTENT(IN) :: II
!
!* 0.2 declaration of local variables for diachro
!
-REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZWORK6 ! contains temporal serie
-REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZW6 ! contains temporal serie to write
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZTRAJT ! localization of the
+REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZWORK6 ! contains temporal series
+REAL, DIMENSION(:,:,:,:,:,:), ALLOCATABLE :: ZW6 ! contains temporal series to write
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZSV, ZN0, ZSIG, ZRG
REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: ZPTOTA
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRHO
@@ -139,37 +145,39 @@ CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YCOMMENT ! comment string
CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YTITLE ! title
CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE :: YUNIT ! physical unit
!
-!!! do not forget to incremente the IPROC value if you add diagnostic !!!
+!!! do not forget to increment the IPROC value if you add diagnostic !!!
INTEGER :: IPROC ! number of variables records
-!!! do not forget to incremente the IPROC value if you add diagnostic !!!
+!!! do not forget to increment the JPROC value if you add diagnostic !!!
INTEGER :: JPROC ! loop counter
INTEGER :: JRR ! loop counter
INTEGER :: JSV ! loop counter
+type(tbudiachrometadata) :: tzbudiachro
+type(tfield_metadata_base), dimension(:), allocatable :: tzfields
!
!----------------------------------------------------------------------------
IF (TSTATION%X(II)==XUNDEF) RETURN
IF (TSTATION%Y(II)==XUNDEF) RETURN
!
-IPROC = 8 + SIZE(TSTATION%R,3) + SIZE(TSTATION%SV,3)
+IPROC = 8 + SIZE(TSTATION%R,3) + SIZE(TSTATION%SV,3)
+IF (TSTATION%X(II)==XUNDEF) IPROC = IPROC + 2
IF (SIZE(TSTATION%TKE )>0) IPROC = IPROC + 1
-IF (LDIAG_IN_RUN) IPROC = IPROC + 17
+IF (LDIAG_SURFRAD) THEN
+ IF(CSURF=="EXTE") IPROC = IPROC + 10
+ IF(CRAD/="NONE") IPROC = IPROC + 7
+END IF
IF (LORILAM) IPROC = IPROC + JPMODE*(3+NSOA+NCARB+NSP)
IF (LDUST) IPROC = IPROC + NMODE_DST*3
IF (LSALT) IPROC = IPROC + NMODE_SLT*3
-IF (SIZE(TSTATION%TSRAD)>0) IPROC = IPROC + 1
-IF (SIZE(TSTATION%SFCO2,1)>0) IPROC = IPROC +1
+IF (ANY(TSTATION%TSRAD(:,:)/=XUNDEF)) IPROC = IPROC + 1
+IF (ANY(TSTATION%SFCO2(:,:)/=XUNDEF)) IPROC = IPROC + 1
!
-ALLOCATE (ZTRAJT( SIZE(TSTATION%TIME),1))
-ALLOCATE (ZWORK6(1,1,1,SIZE(TSTATION%TIME),1,IPROC))
+ALLOCATE (ZWORK6(1,1,1,SIZE(tstation%tpdates),1,IPROC))
ALLOCATE (YCOMMENT(IPROC))
ALLOCATE (YTITLE (IPROC))
ALLOCATE (YUNIT (IPROC))
ALLOCATE (IGRID (IPROC))
!
-ZTRAJT (:,1) = TSTATION%TIME(:)
-!
-!
IGRID = 1
YGROUP = TSTATION%NAME(II)
JPROC = 0
@@ -184,101 +192,140 @@ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZS(II)
!
JPROC = JPROC + 1
YTITLE (JPROC) = 'P'
-YUNIT (JPROC) = 'Pascal'
+YUNIT (JPROC) = 'Pa'
YCOMMENT (JPROC) = 'Pressure'
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%P(:,II)
!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'LON'
-YUNIT (JPROC) = 'degree'
-YCOMMENT (JPROC) = 'Longitude'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LON(II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'LAT'
-YUNIT (JPROC) = 'degree'
-YCOMMENT (JPROC) = 'Latitude'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LAT(II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'ZON_WIND'
-YUNIT (JPROC) = 'm s-1'
-YCOMMENT (JPROC) = 'Zonal wind'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON(:,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'MER_WIND'
-YUNIT (JPROC) = 'm s-1'
-YCOMMENT (JPROC) = 'Meridional wind'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER(:,II)
-!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'W'
-YUNIT (JPROC) = 'm s-1'
-YCOMMENT (JPROC) = 'Air vertical speed'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%W(:,II)
+!JPROC = JPROC + 1
+!YTITLE (JPROC) = 'Z'
+!YUNIT (JPROC) = 'm'
+!YCOMMENT (JPROC) = 'Z Pos'
+!ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Z(II)
!
-JPROC = JPROC + 1
-YTITLE (JPROC) = 'Th'
-YUNIT (JPROC) = 'K'
-YCOMMENT (JPROC) = 'Potential temperature'
-ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%TH(:,II)
-!
-IF (LDIAG_IN_RUN) THEN
+IF (LCARTESIAN) THEN
JPROC = JPROC + 1
- YTITLE (JPROC) = 'T2m'
- YUNIT (JPROC) = 'K'
- YCOMMENT (JPROC) = '2-m temperature'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%T2M(:,II)
+ YTITLE (JPROC) = 'X'
+ YUNIT (JPROC) = 'm'
+ YCOMMENT (JPROC) = 'X Pos'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%X(II)
!
JPROC = JPROC + 1
- YTITLE (JPROC) = 'Q2m'
- YUNIT (JPROC) = 'kg kg-1'
- YCOMMENT (JPROC) = '2-m humidity'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Q2M(:,II)
+ YTITLE (JPROC) = 'Y'
+ YUNIT (JPROC) = 'm'
+ YCOMMENT (JPROC) = 'Y Pos'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Y(II)
!
JPROC = JPROC + 1
- YTITLE (JPROC) = 'HU2m'
- YUNIT (JPROC) = 'percent'
- YCOMMENT (JPROC) = '2-m relative humidity'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%HU2M(:,II)
+ YTITLE (JPROC) = 'U'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = 'Axial velocity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON(:,II)
!
JPROC = JPROC + 1
- YTITLE (JPROC) = 'zon10m'
+ YTITLE (JPROC) = 'V'
YUNIT (JPROC) = 'm s-1'
- YCOMMENT (JPROC) = '10-m zonal wind'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON10M(:,II)
- !
+ YCOMMENT (JPROC) = 'Transversal velocity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER(:,II)
+ELSE
JPROC = JPROC + 1
- YTITLE (JPROC) = 'mer10m'
- YUNIT (JPROC) = 'm s-1'
- YCOMMENT (JPROC) = '10-m meridian wind'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER10M(:,II)
+ YTITLE (JPROC) = 'LON'
+ YUNIT (JPROC) = 'degree'
+ YCOMMENT (JPROC) = 'Longitude'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LON(II)
!
JPROC = JPROC + 1
- YTITLE (JPROC) = 'RN'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Net radiation'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%RN(:,II)
+ YTITLE (JPROC) = 'LAT'
+ YUNIT (JPROC) = 'degree'
+ YCOMMENT (JPROC) = 'Latitude'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LAT(II)
!
JPROC = JPROC + 1
- YTITLE (JPROC) = 'H'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Sensible heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%H(:,II)
- !
+ YTITLE (JPROC) = 'ZON_WIND'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = 'Zonal wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON(:,II)
+ !
JPROC = JPROC + 1
- YTITLE (JPROC) = 'LE'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Total Latent heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LE(:,II)
+ YTITLE (JPROC) = 'MER_WIND'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = 'Meridional wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER(:,II)
+ENDIF
!
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'G'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Storage heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%GFLUX(:,II)
- !
+JPROC = JPROC + 1
+YTITLE (JPROC) = 'W'
+YUNIT (JPROC) = 'm s-1'
+YCOMMENT (JPROC) = 'Air vertical speed'
+ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%W(:,II)
+!
+JPROC = JPROC + 1
+YTITLE (JPROC) = 'Th'
+YUNIT (JPROC) = 'K'
+YCOMMENT (JPROC) = 'Potential temperature'
+ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%TH(:,II)
+!
+IF (LDIAG_SURFRAD) THEN
+ IF (CSURF=="EXTE") THEN
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'T2m'
+ YUNIT (JPROC) = 'K'
+ YCOMMENT (JPROC) = '2-m temperature'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%T2M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'Q2m'
+ YUNIT (JPROC) = 'kg kg-1'
+ YCOMMENT (JPROC) = '2-m humidity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%Q2M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'HU2m'
+ YUNIT (JPROC) = 'percent'
+ YCOMMENT (JPROC) = '2-m relative humidity'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%HU2M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'zon10m'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = '10-m zonal wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%ZON10M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'mer10m'
+ YUNIT (JPROC) = 'm s-1'
+ YCOMMENT (JPROC) = '10-m meridian wind'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%MER10M(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'RN'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Net radiation'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%RN(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'H'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Sensible heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%H(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'LE'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Total Latent heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LE(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'G'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Storage heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%GFLUX(:,II)
+ !
+ JPROC = JPROC + 1
+ YTITLE (JPROC) = 'LEI'
+ YUNIT (JPROC) = 'W m-2'
+ YCOMMENT (JPROC) = 'Solid Latent heat flux'
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LEI(:,II)
+ END IF
IF (CRAD /= 'NONE') THEN
JPROC = JPROC + 1
YTITLE (JPROC) = 'SWD'
@@ -323,11 +370,6 @@ IF (LDIAG_IN_RUN) THEN
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%DSTAOD(:,II)
!
END IF
- JPROC = JPROC + 1
- YTITLE (JPROC) = 'LEI'
- YUNIT (JPROC) = 'W m-2'
- YCOMMENT (JPROC) = 'Solid Latent heat flux'
- ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%LEI(:,II)
ENDIF
!
DO JRR=1,SIZE(TSTATION%R,3)
@@ -367,6 +409,15 @@ IF (SIZE(TSTATION%TKE,1)>0) THEN
END IF
!
!
+IF (LPASPOL) THEN
+ JSV=1
+ JPROC = JPROC+1
+ WRITE (YTITLE(JPROC),FMT='(A2,I3.3)') 'Sv',JSV
+ YUNIT (JPROC) = 'kg kg-1'
+ YCOMMENT (JPROC) = ' '
+ ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%SV(:,II,JSV)
+ENDIF
+!
IF (SIZE(TSTATION%SV,3)>=1) THEN
! User scalar variables
DO JSV = 1,NSV_USER
@@ -426,12 +477,12 @@ IF (SIZE(TSTATION%SV,3)>=1) THEN
END DO
IF ((LORILAM).AND. .NOT.(ANY(TSTATION%P(:,II) == 0.))) THEN
- ALLOCATE (ZSV(1,1,SIZE(TSTATION%TIME),NSV_AER))
- ALLOCATE (ZRHO(1,1,SIZE(TSTATION%TIME)))
- ALLOCATE (ZN0(1,1,SIZE(TSTATION%TIME),JPMODE))
- ALLOCATE (ZRG(1,1,SIZE(TSTATION%TIME),JPMODE))
- ALLOCATE (ZSIG(1,1,SIZE(TSTATION%TIME),JPMODE))
- ALLOCATE (ZPTOTA(1,1,SIZE(TSTATION%TIME),NSP+NCARB+NSOA,JPMODE))
+ ALLOCATE (ZSV(1,1,SIZE(tstation%tpdates),NSV_AER))
+ ALLOCATE (ZRHO(1,1,SIZE(tstation%tpdates)))
+ ALLOCATE (ZN0(1,1,SIZE(tstation%tpdates),JPMODE))
+ ALLOCATE (ZRG(1,1,SIZE(tstation%tpdates),JPMODE))
+ ALLOCATE (ZSIG(1,1,SIZE(tstation%tpdates),JPMODE))
+ ALLOCATE (ZPTOTA(1,1,SIZE(tstation%tpdates),NSP+NCARB+NSOA,JPMODE))
ZSV(1,1,:,1:NSV_AER) = TSTATION%SV(:,II,NSV_AERBEG:NSV_AEREND)
IF (SIZE(TSTATION%R,3) >0) THEN
ZRHO(1,1,:) = 0.
@@ -574,11 +625,11 @@ IF (SIZE(TSTATION%SV,3)>=1) THEN
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%SV(:,II,JSV) *1.E9
END DO
IF ((LDUST).AND. .NOT.(ANY(TSTATION%P(:,II) == 0.))) THEN
- ALLOCATE (ZSV(1,1,SIZE(TSTATION%TIME),NSV_DST))
- ALLOCATE (ZRHO(1,1,SIZE(TSTATION%TIME)))
- ALLOCATE (ZN0(1,1,SIZE(TSTATION%TIME),NMODE_DST))
- ALLOCATE (ZRG(1,1,SIZE(TSTATION%TIME),NMODE_DST))
- ALLOCATE (ZSIG(1,1,SIZE(TSTATION%TIME),NMODE_DST))
+ ALLOCATE (ZSV(1,1,SIZE(tstation%tpdates),NSV_DST))
+ ALLOCATE (ZRHO(1,1,SIZE(tstation%tpdates)))
+ ALLOCATE (ZN0(1,1,SIZE(tstation%tpdates),NMODE_DST))
+ ALLOCATE (ZRG(1,1,SIZE(tstation%tpdates),NMODE_DST))
+ ALLOCATE (ZSIG(1,1,SIZE(tstation%tpdates),NMODE_DST))
ZSV(1,1,:,1:NSV_DST) = TSTATION%SV(:,II,NSV_DSTBEG:NSV_DSTEND)
IF (SIZE(TSTATION%R,3) >0) THEN
ZRHO(1,1,:) = 0.
@@ -627,11 +678,11 @@ IF (SIZE(TSTATION%SV,3)>=1) THEN
ENDIF
!
IF ((LSALT).AND. .NOT.(ANY(TSTATION%P(:,II) == 0.))) THEN
- ALLOCATE (ZSV(1,1,SIZE(TSTATION%TIME),NSV_SLT))
- ALLOCATE (ZRHO(1,1,SIZE(TSTATION%TIME)))
- ALLOCATE (ZN0(1,1,SIZE(TSTATION%TIME),NMODE_SLT))
- ALLOCATE (ZRG(1,1,SIZE(TSTATION%TIME),NMODE_SLT))
- ALLOCATE (ZSIG(1,1,SIZE(TSTATION%TIME),NMODE_SLT))
+ ALLOCATE (ZSV(1,1,SIZE(tstation%tpdates),NSV_SLT))
+ ALLOCATE (ZRHO(1,1,SIZE(tstation%tpdates)))
+ ALLOCATE (ZN0(1,1,SIZE(tstation%tpdates),NMODE_SLT))
+ ALLOCATE (ZRG(1,1,SIZE(tstation%tpdates),NMODE_SLT))
+ ALLOCATE (ZSIG(1,1,SIZE(tstation%tpdates),NMODE_SLT))
ZSV(1,1,:,1:NSV_SLT) = TSTATION%SV(:,II,NSV_SLTBEG:NSV_SLTEND)
IF (SIZE(TSTATION%R,3) >0) THEN
ZRHO(1,1,:) = 0.
@@ -670,7 +721,7 @@ ENDIF
DEALLOCATE (ZN0,ZRG,ZSIG)
END IF
-IF (SIZE(TSTATION%TSRAD,1)>0) THEN
+IF (ANY(TSTATION%TSRAD(:,:)/=XUNDEF)) THEN
JPROC = JPROC+1
YTITLE (JPROC) = 'Tsrad'
YUNIT (JPROC) = 'K'
@@ -678,7 +729,7 @@ IF (SIZE(TSTATION%TSRAD,1)>0) THEN
ZWORK6 (1,1,1,:,1,JPROC) = TSTATION%TSRAD(:,II)
END IF
!
-IF (SIZE(TSTATION%SFCO2,1)>0) THEN
+IF (ANY(TSTATION%SFCO2(:,:)/=XUNDEF)) THEN
JPROC = JPROC+1
YTITLE (JPROC) = 'SFCO2'
YUNIT (JPROC) = 'mg m-2 s-1'
@@ -689,16 +740,77 @@ END IF
!----------------------------------------------------------------------------
!
!
-ALLOCATE (ZW6(1,1,1,SIZE(TSTATION%TIME),1,JPROC))
+ALLOCATE (ZW6(1,1,1,SIZE(tstation%tpdates),1,JPROC))
ZW6 = ZWORK6(:,:,:,:,:,:JPROC)
DEALLOCATE(ZWORK6)
!
- CALL WRITE_DIACHRO(TPDIAFILE,TLUOUT0,YGROUP,"CART",IGRID, TSTATION%DATIME,&
- ZW6,ZTRAJT,YTITLE,YUNIT,YCOMMENT,&
- .TRUE.,.TRUE.,.FALSE., &
- KIL=1,KIH=1,KJL=1,KJH=1,KKL=1,KKH=1 )
-!
-DEALLOCATE (ZTRAJT)
+allocate( tzfields( jproc ) )
+
+tzfields(:)%cmnhname = ytitle(1 : jproc)
+tzfields(:)%cstdname = ''
+tzfields(:)%clongname = ytitle(1 : jproc)
+tzfields(:)%cunits = yunit(1 : jproc)
+tzfields(:)%ccomment = ycomment(1 : jproc)
+tzfields(:)%ngrid = 0
+tzfields(:)%ntype = TYPEREAL
+tzfields(:)%ndims = 2
+tzfields(:)%ndimlist(1) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(2) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(3) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(4) = NMNHDIM_STATION_TIME
+tzfields(:)%ndimlist(5) = NMNHDIM_UNUSED
+tzfields(:)%ndimlist(6) = NMNHDIM_STATION_PROC
+
+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
+tzbudiachro%njh = 1
+tzbudiachro%nkl = 1
+tzbudiachro%nkh = 1
+
+call Write_diachro( tpdiafile, tzbudiachro, tzfields, tstation%tpdates, zw6 )
+
+deallocate( tzfields )
+
DEALLOCATE (ZW6)
DEALLOCATE (YCOMMENT)
DEALLOCATE (YTITLE )
diff --git a/src/MNH/write_surf_mnh.f90 b/src/MNH/write_surf_mnh.f90
index 2fb2021b5e149b35978a03228e44c19f23c3d528..58e08d8dc9a0d7189d1b0a6b53f3b0b5ae157b48 100644
--- a/src/MNH/write_surf_mnh.f90
+++ b/src/MNH/write_surf_mnh.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1997-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1997-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -11,7 +11,9 @@ CONTAINS
SUBROUTINE PREPARE_METADATA_WRITE_SURF(HREC,HDIR,HCOMMENT,KGRID,KTYPE,KDIMS,HSUBR,TPFIELD)
!
-USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME, TFIELDDATA, TFIELDLIST, TYPECHAR, TYPEDATE, TYPELOG
+use modd_field, only: tfielddata, tfieldlist, TYPECHAR, TYPEDATE, TYPELOG
+
+use mode_field, only: Find_field_id_from_mnhname
USE MODE_MSG
!
CHARACTER(LEN=LEN_HREC),INTENT(IN) :: HREC ! name of the article to write
@@ -171,16 +173,16 @@ END MODULE MODE_WRITE_SURF_MNH_TOOLS
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-use MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_MSG
-USE MODE_WRITE_SURF_MNH_TOOLS
-!
USE MODD_CONF, ONLY: CPROGRAM
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+use modd_field, only: tfielddata,TYPEREAL
USE MODD_GRID
USE MODD_IO, ONLY: TFILE_SURFEX
-!
+
+use MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+USE MODE_WRITE_SURF_MNH_TOOLS
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -282,13 +284,8 @@ END SUBROUTINE WRITE_SURFX0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: FIND_FIELD_ID_FROM_MNHNAME,TFIELDDATA,TFIELDLIST,TYPEREAL
-use MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_MSG
-USE MODE_TOOLS_ll
-USE MODE_WRITE_SURF_MNH_TOOLS
-!
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+use modd_field, only: tfielddata, tfieldlist, TYPEREAL
USE MODD_GRID_n, ONLY: XXHAT, XYHAT
USE MODD_IO, ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH, ONLY :NMASK, CMASK, &
@@ -296,10 +293,16 @@ USE MODD_IO_SURF_MNH, ONLY :NMASK, CMASK, &
NIU_ALL, NJU_ALL, NIB_ALL, NJB_ALL, &
NIE_ALL, NJE_ALL, NMASK_ALL, NHALO
USE MODD_PARAMETERS, ONLY: XUNDEF, JPHEXT
-!
+
+use mode_field, only: Find_field_id_from_mnhname
+use MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+USE MODE_TOOLS_ll
+USE MODE_WRITE_SURF_MNH_TOOLS
+
USE MODI_GET_SURF_UNDEF
USE MODI_UNPACK_1D_2D
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -545,13 +548,8 @@ END SUBROUTINE WRITE_SURFX1_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG,TYPEREAL
-use MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_MSG
-USE MODE_TOOLS_ll
-USE MODE_WRITE_SURF_MNH_TOOLS
-!
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+use modd_field, only: tfielddata, TYPELOG, TYPEREAL
USE MODD_DATA_COVER_PAR, ONLY: JPCOVER
USE MODD_IO, ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH, ONLY: NMASK, CMASK, &
@@ -559,10 +557,15 @@ USE MODD_IO_SURF_MNH, ONLY: NMASK, CMASK, &
NIU_ALL, NJU_ALL, NIB_ALL, NJB_ALL, &
NIE_ALL, NJE_ALL, NMASK_ALL, NHALO
USE MODD_PARAMETERS, ONLY: XUNDEF, JPHEXT
-!
+
+use MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+USE MODE_TOOLS_ll
+USE MODE_WRITE_SURF_MNH_TOOLS
+
USE MODI_GET_SURF_UNDEF
USE MODI_UNPACK_1D_2D
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -746,24 +749,24 @@ END SUBROUTINE WRITE_SURFX2COV_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEREAL
-use MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_MSG
-USE MODE_TOOLS_ll
-USE MODE_WRITE_SURF_MNH_TOOLS
-!
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
USE MODD_DATA_COVER_PAR, ONLY: JPCOVER
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH, ONLY: NMASK, CMASK, &
NIU, NJU, NIB, NJB, NIE, NJE, &
NIU_ALL, NJU_ALL, NIB_ALL, NJB_ALL, &
NIE_ALL, NJE_ALL, NMASK_ALL, NHALO
USE MODD_PARAMETERS, ONLY: XUNDEF
-!
+
+use MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+USE MODE_TOOLS_ll
+USE MODE_WRITE_SURF_MNH_TOOLS
+
USE MODI_GET_SURF_UNDEF
USE MODI_UNPACK_1D_2D
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -897,16 +900,16 @@ END SUBROUTINE WRITE_SURFX2_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
-use MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_MSG
-USE MODE_WRITE_SURF_MNH_TOOLS
-!
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+use modd_field, only: tfielddata, TYPEINT
USE MODD_IO, ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH, ONLY: NIU_ALL, NJU_ALL
USE MODD_PARAMETERS, ONLY: JPHEXT
-!
+
+use MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+USE MODE_WRITE_SURF_MNH_TOOLS
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -992,18 +995,18 @@ END SUBROUTINE WRITE_SURFN0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT
-use MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_MSG
-USE MODE_WRITE_SURF_MNH_TOOLS
-!
+use modd_field, only: tfielddata, TYPEINT
USE MODD_IO, ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH, ONLY: NMASK, CMASK, &
NIU, NJU, NIB, NJB, NIE, NJE
USE MODD_PARAMETERS, ONLY: NUNDEF
-!
+
+use MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+USE MODE_WRITE_SURF_MNH_TOOLS
+
USE MODI_UNPACK_1D_2D
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1095,15 +1098,15 @@ END SUBROUTINE WRITE_SURFN1_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPECHAR,TYPELOG
-use MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_MSG
-USE MODE_WRITE_SURF_MNH_TOOLS
-!
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+use modd_field, only: tfielddata, TYPECHAR, TYPELOG
USE MODD_IO, ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH, ONLY: NIU_ALL, NJU_ALL
-!
+
+use MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+USE MODE_WRITE_SURF_MNH_TOOLS
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1191,18 +1194,18 @@ END SUBROUTINE WRITE_SURFC0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPEINT,TYPELOG
-use MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_MSG
-USE MODE_WRITE_SURF_MNH_TOOLS
-!
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+use modd_field, only: tfielddata, TYPEINT, TYPELOG
USE MODD_IO, ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH, ONLY: NMASK, CMASK, &
NIU, NJU, NIB, NJB, NIE, NJE
-!
+
+use MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+USE MODE_WRITE_SURF_MNH_TOOLS
+
USE MODI_UNPACK_1D_2D
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1306,15 +1309,15 @@ END SUBROUTINE WRITE_SURFL1_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA,TYPELOG
-use MODE_IO_FIELD_WRITE, only: IO_Field_write
-USE MODE_MSG
-USE MODE_WRITE_SURF_MNH_TOOLS
-!
USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+use modd_field, only: tfielddata, TYPELOG
USE MODD_IO, ONLY: TFILE_SURFEX
USE MODD_IO_SURF_MNH, ONLY: CMASK
-!
+
+use MODE_IO_FIELD_WRITE, only: IO_Field_write
+USE MODE_MSG
+USE MODE_WRITE_SURF_MNH_TOOLS
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1389,17 +1392,16 @@ END SUBROUTINE WRITE_SURFL0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEDATE
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+use modd_field, only: tfielddata, TYPEDATE
+USE MODD_IO, ONLY: TFILE_SURFEX
+USE MODD_TYPE_DATE
+
use MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_IO_FILE
USE MODE_MSG
USE MODE_WRITE_SURF_MNH_TOOLS
-!
-USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
-USE MODD_IO, ONLY: TFILE_SURFEX
-USE MODD_TYPE_DATE
-!
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1428,8 +1430,10 @@ IF( HREC=='DTCUR' .AND. CSTORAGE_TYPE/='SU' ) THEN
CALL PRINT_MSG(NVERB_DEBUG,'IO','WRITE_SURFT0_MNH',TRIM(HREC)//' not written in file by externalized surface')
RETURN
ELSE
- TZDATA%TDATE = DATE(KYEAR,KMONTH,KDAY)
- TZDATA%TIME = PTIME
+ TZDATA%nyear = kyear
+ TZDATA%nmonth = kmonth
+ TZDATA%nday = kday
+ TZDATA%xtime = PTIME
!
CALL PREPARE_METADATA_WRITE_SURF(HREC,'--',HCOMMENT,0,TYPEDATE,0,'WRITE_SURFT0_MNH',TZFIELD)
CALL IO_Field_write(TFILE_SURFEX,TZFIELD,TZDATA,KRESP)
@@ -1483,15 +1487,14 @@ END SUBROUTINE WRITE_SURFT0_MNH
!* 0. DECLARATIONS
! ------------
!
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEINT, TYPEREAL
+use modd_field, only: tfielddata, TYPEINT, TYPEREAL
+USE MODD_IO, ONLY: TFILE_SURFEX
+USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
+
use MODE_IO_FIELD_WRITE, only: IO_Field_write
USE MODE_IO_FILE
USE MODE_MSG
-!
-USE MODD_IO, ONLY: TFILE_SURFEX
-USE MODD_CONF_n, ONLY: CSTORAGE_TYPE
-!
-!
+
IMPLICIT NONE
!
!* 0.1 Declarations of arguments
@@ -1542,7 +1545,7 @@ ELSE
CALL PRINT_MSG(NVERB_ERROR,'IO','WRITE_SURFT1_MNH','error when writing article '//TRIM(HREC)//' KRESP='//YMSG)
END IF
!
- TZFIELD%CMNHNAME = TRIM(HREC)//'%TIME'
+ TZFIELD%CMNHNAME = TRIM(HREC)//'%xtime'
TZFIELD%CSTDNAME = ''
TZFIELD%CLONGNAME = TRIM(TZFIELD%CMNHNAME)
TZFIELD%CUNITS = ''
diff --git a/src/MNH/write_ts1d.f90 b/src/MNH/write_ts1d.f90
index ab625577a45976fbea4f7be04915cdc4b4fc05e4..440d7303ff4f9f56889afa15d364373aa129129c 100644
--- a/src/MNH/write_ts1d.f90
+++ b/src/MNH/write_ts1d.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 1995-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1995-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -43,7 +43,7 @@
!! Original 12/10/95
!! Add U, V, W, all water variables and all tracers to timeseries (KS)
!! 27/10/95 KS: add air density
-!! 09/02/96 KS: change time to TDTSEG%TIME + ISCOUNT * XTSTEP
+!! 09/02/96 KS: change time to TDTSEG%xtime + ISCOUNT * XTSTEP
!! & grid identifier all set to 1 (mass levels)
!! 01/03/96 KS: remove air density
!! write variables every 900s to disk, regardless of XTSTEP
@@ -161,14 +161,14 @@ TZFILE => NULL()
NBPROF = 0
CALL DATETIME_DISTANCE(TDTEXP,TDTCUR,ZTIME)
-ZTIME = ZTIME + TDTEXP%TIME
+ZTIME = ZTIME + TDTEXP%xtime
CALL GET_DIM_EXT_ll ('B',IIU,IJU)
IF ((CPROGRAM =='DIAG ').AND.(LCHEMDIAG)) THEN
- WRITE(YCYEAR,'(I4.4)') TDTCUR%TDATE%YEAR
- WRITE(YCMONTH,'(I2.2)') TDTCUR%TDATE%MONTH
- WRITE(YCDAY,'(I2.2)') TDTCUR%TDATE%DAY
- IUTIME = INT(3600*MOD( 24.0+MOD((TDTCUR%TIME)/3600.,24.0),24.0 )) ! TU
+ WRITE(YCYEAR,'(I4.4)') TDTCUR%nyear
+ WRITE(YCMONTH,'(I2.2)') TDTCUR%nmonth
+ WRITE(YCDAY,'(I2.2)') TDTCUR%nday
+ IUTIME = INT(3600*MOD( 24.0+MOD((TDTCUR%xtime)/3600.,24.0),24.0 )) ! TU
WRITE(YCTIME,'(I5.5)') IUTIME
diff --git a/src/MNH/xy_to_latlon.f90 b/src/MNH/xy_to_latlon.f90
index 6d3087710bd30150c94a681090cebdd2b1269ceb..f8782a519e3cbe897bd676f5b72d5334b5559ee6 100644
--- a/src/MNH/xy_to_latlon.f90
+++ b/src/MNH/xy_to_latlon.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2006-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 1996-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -53,15 +53,17 @@
!!
!! no transfer of the file when closing Dec. 09, 1996 (V.Masson)
!! + changes call to READ_HGRID
-!! Philippe Wautelet: 05/2016-04/2018: new data structures and calls for I/O
+! P. 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 26/04/2019: replace non-standard FLOAT function by REAL function
+! P. Wautelet 14/04/2020: add missing initializations (XY_TO_LATLON was not working)
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
-!
+use MODD_CONF, only: CPROGRAM
+USE MODD_DIM_n
USE MODD_GRID
USE MODD_IO, ONLY: TFILEDATA
USE MODD_PGDDIM
@@ -69,10 +71,14 @@ USE MODD_PGDGRID
USE MODD_PARAMETERS
USE MODD_LUNIT
!
+USE MODE_FIELD, ONLY: INI_FIELD_LIST
USE MODE_GRIDPROJ
USE MODE_IO, only: IO_Config_set, IO_Init
+use MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
+USE MODE_MODELN_HANDLER, ONLY: GOTO_MODEL
+use MODE_SPLITTINGZ_ll
!
USE MODI_INI_CST
USE MODI_READ_HGRID
@@ -115,16 +121,26 @@ NAMELIST/NAM_INIFILE/ YINIFILE
!* 1. Initializations
! ---------------
!
-CALL INI_CST
+CALL GOTO_MODEL(1)
+!
+CALL VERSION()
+!
+CPROGRAM='LAT2XY'
+!
+CALL IO_Init()
+!
+CALL INI_CST()
+!
+CALL INI_FIELD_LIST(1)
!
!* 2. Reading of namelist file
! ------------------------
-CALL IO_Init()
!
CALL IO_File_add2list(TZNMLFILE,'XY2LATLON1.nam','NML','READ')
CALL IO_File_open(TZNMLFILE)
INAM=TZNMLFILE%NLU
READ(INAM,NAM_INIFILE)
+!
READ(INAM,NAM_CONFIO)
CALL IO_Config_set()
CALL IO_File_close(TZNMLFILE)
@@ -135,6 +151,15 @@ CALL IO_File_close(TZNMLFILE)
CALL IO_File_add2list(TZINIFILE,TRIM(YINIFILE),'MNH','READ',KLFITYPE=2,KLFIVERB=2)
CALL IO_File_open(TZINIFILE)
!
+CALL IO_Field_read(TZINIFILE,'IMAX', NIMAX)
+CALL IO_Field_read(TZINIFILE,'JMAX', NJMAX)
+NKMAX = 1
+CALL IO_Field_read(TZINIFILE,'JPHEXT',JPHEXT)
+!
+CALL SET_JP_ll(1,JPHEXT,JPVEXT,JPHEXT)
+CALL SET_DIM_ll(NIMAX, NJMAX, NKMAX)
+CALL INI_PARAZ_ll(IRESP)
+!
!* 2. Reading of MESONH file
! ----------------------
!
diff --git a/src/MNH/zoom_pgd.f90 b/src/MNH/zoom_pgd.f90
index 90103c5141e3712d2c40af6ca916c184b0856162..4f0961d8e48419a0a966933dcf1ac64215208bb7 100644
--- a/src/MNH/zoom_pgd.f90
+++ b/src/MNH/zoom_pgd.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2005-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-2021 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed 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.
@@ -42,14 +42,14 @@
!! 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
-!!
+! P. Wautelet 06/07/2021: use FINALIZE_MNH
!----------------------------------------------------------------------------
!
!* 0. DECLARATION
! -----------
!
USE MODD_CONF, ONLY : CPROGRAM, L1D, L2D, LPACK
-USE MODD_IO, ONLY: NIO_VERB,NVERB_DEBUG,TFILE_OUTPUTLISTING,TFILEDATA
+USE MODD_IO, only: TFILE_OUTPUTLISTING, TFILEDATA
USE MODD_LUNIT, ONLY : TLUOUT0, TOUTDATAFILE
USE MODD_PARAMETERS, ONLY : XUNDEF, NUNDEF, JPVEXT, JPHEXT, JPMODELMAX
USE MODD_PARAM_n, ONLY : CSURF
@@ -57,12 +57,13 @@ USE MODD_DIM_n, ONLY : NIMAX, NJMAX
USE MODD_CONF_n, ONLY : CSTORAGE_TYPE
use modd_precision, only: LFIINT
!
+USE MODE_FINALIZE_MNH, only: FINALIZE_MNH
USE MODE_POS
USE MODE_IO, only: IO_Config_set, IO_Init
USE MODE_IO_FIELD_READ, only: IO_Field_read
USE MODE_IO_FIELD_WRITE, only: IO_Field_write, IO_Header_write
USE MODE_IO_FILE, only: IO_File_close, IO_File_open
-USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list, IO_Filelist_print
+USE MODE_IO_MANAGE_STRUCT, only: IO_File_add2list
USE MODE_ll
USE MODE_MSG
USE MODE_MODELN_HANDLER
@@ -258,18 +259,12 @@ CPGDFILE = YZOOMFILE
!
CALL IO_File_close(TZPGDFILE)
!
-IF(NIO_VERB>=NVERB_DEBUG) CALL IO_Filelist_print()
-!
WRITE(ILUOUT0,*)
WRITE(ILUOUT0,*) '***************************'
WRITE(ILUOUT0,*) '* ZOOM_PGD ends correctly *'
WRITE(ILUOUT0,*) '***************************'
!
-CALL IO_File_close(TLUOUT0)
-!
-CALL END_PARA_ll(IINFO_ll)
-
-IF (CSURF=='EXTE') CALL SURFEX_DEALLO_LIST
+CALL FINALIZE_MNH()
!
!-------------------------------------------------------------------------------
!
diff --git a/src/MNH/zs_boundaryn.f90 b/src/MNH/zs_boundaryn.f90
deleted file mode 100644
index 4e2f7935a8910fe093c2241ea8c7ecde1023de7a..0000000000000000000000000000000000000000
--- a/src/MNH/zs_boundaryn.f90
+++ /dev/null
@@ -1,204 +0,0 @@
-!MNH_LIC Copyright 1999-2019 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-! #######################
- MODULE MODI_ZS_BOUNDARY_n
-! #######################
-!
-INTERFACE
-!
- SUBROUTINE ZS_BOUNDARY_n (KMI, &
- PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
- PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
- KDXRATIO,KDYRATIO, &
- HLBCX,HLBCY, &
- PZS )
-!
-INTEGER, INTENT(IN) :: KMI ! Model index
-REAL, DIMENSION(:), INTENT(IN) :: PBMX1,PBMX2,PBMX3,PBMX4 ! Mass points in X-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBMY1,PBMY2,PBMY3,PBMY4 ! Mass points in Y-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBFX1,PBFX2,PBFX3,PBFX4 ! Flux points in X-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBFY1,PBFY2,PBFY3,PBFY4 ! Flux points in Y-direc.
-INTEGER, INTENT(IN) :: KDXRATIO ! x and y-direction resolution RATIO
-INTEGER, INTENT(IN) :: KDYRATIO ! between inner model and outer model
-CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCX ! type of lateral
-CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCY ! boundary conditions
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZS ! orography of the fine mesh model
-!
-END SUBROUTINE ZS_BOUNDARY_n
-!
-END INTERFACE
-!
-END MODULE MODI_ZS_BOUNDARY_n
-!
-! #####################################################################
- SUBROUTINE ZS_BOUNDARY_n (KMI, &
- PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
- PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
- KDXRATIO,KDYRATIO, &
- HLBCX,HLBCY, &
- PZS )
-! #####################################################################
-!
-!!**** *ZS_BOUNDARY_n* - interpolate the orography of the DAD model to the
-!! CHILD model
-!!
-!! PURPOSE
-!! -------
-!! The purpose of ZS_BOUNDARY$n is to perform the Bikhardt interpolation
-!! from the DAD model orography toward the fine scale model KMI.
-!
-!
-!!** METHOD
-!! ------
-!!
-!! We use the Bikhardt interpolation scheme to compute the orography of
-!! the fine-mesh model from the value of its DAD orography. This intermediate
-!! smooth orography is only used to modify the orography of the fine-mesh
-!! model for the marginal points ( 1, IIU, 1, IJU). The fine-scale orography
-!! is imported in this subroutine by argument and the DAD orography by module
-!! MODD_GRID$n
-!!
-!! EXTERNAL
-!! --------
-!! BIKHARDT : horizontal interpolation scheme using 4 points in x and y
-!! directions
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! MODULE MODD_GRID$n: XZS
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! J. Stein *Meteo-France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 1/2/99
-! P. Wautelet 20/05/2019: add name argument to ADDnFIELD_ll + new ADD4DFIELD_ll subroutine
-!
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-!
-USE MODD_ARGSLIST_ll, ONLY : LIST_ll
-USE MODD_GRID_n ! contains the DAD model informations
-!
-use mode_bikhardt
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-!
-!
-INTEGER, INTENT(IN) :: KMI ! Model index
-REAL, DIMENSION(:), INTENT(IN) :: PBMX1,PBMX2,PBMX3,PBMX4 ! Mass points in X-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBMY1,PBMY2,PBMY3,PBMY4 ! Mass points in Y-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBFX1,PBFX2,PBFX3,PBFX4 ! Flux points in X-direc.
-REAL, DIMENSION(:), INTENT(IN) :: PBFY1,PBFY2,PBFY3,PBFY4 ! Flux points in Y-direc.
-INTEGER, INTENT(IN) :: KDXRATIO ! x and y-direction resolution RATIO
-INTEGER, INTENT(IN) :: KDYRATIO ! between inner model and outer model
-CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCX ! type of lateral
-CHARACTER (LEN=4), DIMENSION (2), INTENT(IN) :: HLBCY ! boundary conditions
-!
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PZS ! orography of the fine mesh model
-!
-!* 0.2 declarations of local variables
-!
-!REAL , DIMENSION(SIZE(PZS,1),SIZE(PZS,2)) :: ZZSLS ! interpolated orography
- ! at high resolution
-REAL , DIMENSION(SIZE(PZS,1),SIZE(PZS,2),1) :: ZZSLS
-INTEGER :: IIB,IJB,IIE,IJE
-INTEGER :: IIU,IJU ! array sizes in x and y directions of the CHILD model
-!
-! Variables used for LS communications
-TYPE(LIST_ll), POINTER :: TZLSFIELD_ll ! list of fields to exchange
-INTEGER :: IINFO_ll, IDIMX, IDIMY
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTZS,ZZS !!! provisoire
-!REAL, DIMENSION(:,:), ALLOCATABLE :: ZTZS
-INTEGER :: IMI !Current model index
-!-------------------------------------------------------------------------------
-!
-!* 0. INITIALISATION
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IIB=IIB-1
-IIE=IIE+1
-IJB=IJB-1
-IJE=IJE+1
-!
-!* 1 GATHER LS FIELD FOR THE CHILD MODEL KMI
-!
-! 1.1 Must be on the father model to call get_child_dim
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-CALL GO_TOMODEL_ll(IMI, IINFO_ll)
-CALL GET_CHILD_DIM_ll(KMI, IDIMX, IDIMY, IINFO_ll)
-!
-! 1.2 Allocate array which will receive coarse grid points
-!
-ALLOCATE(ZTZS(IDIMX,IDIMY,1))
-ALLOCATE(ZZS(SIZE(XZS,1),SIZE(XZS,2),1))
-ZZS(:,:,1)=XZS(:,:)
-!
-! 1.3 Specify the ls "source" fields and receiver fields
-!
-CALL SET_LSFIELD_1WAY_ll(ZZS, ZTZS, KMI)
-!
-!
-! 1.4 Communication
-!
-CALL LS_FORCING_ll(KMI, IINFO_ll)
-!
-! 1.5 Back to the (current) child model
-!
-CALL GO_TOMODEL_ll(KMI, IINFO_ll)
-!
-CALL UNSET_LSFIELD_1WAY_ll()
-!
-!
-!* 1. BIKARDT INTERPOLATION
-! ---------------------
-!
-CALL BIKHARDT (PBMX1,PBMX2,PBMX3,PBMX4,PBMY1,PBMY2,PBMY3,PBMY4, &
- PBFX1,PBFX2,PBFX3,PBFX4,PBFY1,PBFY2,PBFY3,PBFY4, &
- 2,2,IDIMX-1,IDIMY-1,KDXRATIO,KDYRATIO,1, &
- HLBCX,HLBCY,ZTZS,ZZSLS(IIB:IIE,IJB:IJE,:))
-!
-DEALLOCATE(ZTZS,ZZS)
-!-------------------------------------------------------------------------------
-!
-!* 2. SET THE OROGRAPHY AT THE MARGINAL POINTS
-! ----------------------------------------
-!
-!
-IIU=SIZE(PZS,1)
-IJU=SIZE(PZS,2)
-!
-IF(HLBCX(1)/='CYCL' .AND. LWEST_ll()) PZS(1,IJB:IJE) = ZZSLS(1,IJB:IJE,1)
-IF(HLBCX(2)/='CYCL' .AND. LEAST_ll()) PZS(IIU,IJB:IJE) = ZZSLS(IIU,IJB:IJE,1)
-IF(HLBCY(1)/='CYCL' .AND. LSOUTH_ll()) PZS(IIB:IIE,1) = ZZSLS(IIB:IIE,1,1)
-IF(HLBCY(2)/='CYCL' .AND. LNORTH_ll()) PZS(IIB:IIE,IJU) = ZZSLS(IIB:IIE,IJU,1)
-!
-NULLIFY(TZLSFIELD_ll)
-CALL ADD2DFIELD_ll( TZLSFIELD_ll, PZS, 'ZS_BOUNDARY_n::PZS' )
-CALL UPDATE_HALO_ll(TZLSFIELD_ll,IINFO_ll)
-CALL CLEANLIST_ll(TZLSFIELD_ll)
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE ZS_BOUNDARY_n
diff --git a/src/MNH/zsmt_pgd.f90 b/src/MNH/zsmt_pgd.f90
index 7731c2dcf7524bf48901c17ce96a42f87633a309..b7c97c10a8e1faffcd9225f65eb62b282cc8273e 100644
--- a/src/MNH/zsmt_pgd.f90
+++ b/src/MNH/zsmt_pgd.f90
@@ -1,4 +1,4 @@
-!MNH_LIC Copyright 2005-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC Copyright 2005-2020 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1.
@@ -67,6 +67,7 @@ END MODULE MODI_ZSMT_PGD
!
!* 0. DECLARATIONS
!
+use modd_field, only: tfielddata, TYPEREAL
USE MODD_IO, ONLY : TFILEDATA
USE MODD_PARAMETERS, ONLY : JPHEXT, XUNDEF
!
@@ -77,7 +78,6 @@ USE MODE_ll , ONLY : GET_DIM_EXT_ll , ADD2DFIELD_ll , CLEANLIST_ll , UPDA
USE MODD_ARGSLIST_ll, ONLY : LIST_ll
USE MODE_SUM_ll
use mode_tools_ll, only: GET_INDICE_ll
-USE MODE_FIELD, ONLY: TFIELDDATA, TYPEREAL
!
IMPLICIT NONE
!
diff --git a/src/Makefile b/src/Makefile
index 3d140df7dbd7a8f51c4368348d6cfc88219b8ee6..03c5d4492c4f7bc0cba2db78ed82a3ad46a152ae 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
@@ -177,7 +177,11 @@ DEP_ALL_USER = $(sort $(filter-out $(IGNORE_DEP_USER) ,$(DEP_USER)) )
.PHONY : all objdirmaster libmaster bibmaster objmaster progmaster
.PHONY : installmaster cleanlibmaster cleanmaster cleanobjmaster cleanprogmaster
+ifeq "$(MNH_GRIBAPI)" "yes"
all : gribapi progmaster
+else
+all : eccodes_lib progmaster
+endif
objdirmaster : $(OBJDIR_MASTER)/.dummy
@@ -196,7 +200,11 @@ ifeq "$(VER_OASIS)" "OASISAUTO"
depmaster : oasis
endif
+ifeq "$(MNH_GRIBAPI)" "yes"
depmaster : gribapi
+else
+depmaster : eccodes_lib
+endif
filedepallmaster : $(DEP_ALL_MASTER)
find $(OBJDIR_MASTER) -follow -name "*.D" > $(OBJDIR_MASTER)/filemaster
@@ -288,35 +296,6 @@ installuser :
cleanproguser :
test -d $(OBJDIR_USER) && cd $(OBJDIR_USER) && rm -f $(PROG_LIST)
-
-##########################################################
-# #
-# EXTRA LIB : GRIBEX #
-# #
-##########################################################
-ifneq "$(findstring 64,$(shell uname -m))" ""
-A64=A64
-endif
-#$(LIB_GRIBEX) : libmaster
-$(LIB_GRIBEX) :
-ifneq "$(ARCH)" "SX8"
- - [ ! -d $(DIR_GRIBEX)_$(ARCH) ] && cp -Rp $(DIR_GRIBEX) $(DIR_GRIBEX)_$(ARCH)
- cd $(DIR_GRIBEX)_$(ARCH) && $(MAKE) -j 1 ARCH=$(TARGET_GRIBEX) R64=$(R64_GRIBEX) CNAME=$(CNAME_GRIBEX) A64=$(A64)
-else
-ifneq "$(findstring brodie,$(shell uname -n))" ""
-#brodie
- - [ ! -d $(DIR_GRIBEX)_$(ARCH) ] && mkdir -p ${workdir}/$(DIR_GRIBEX)_$(ARCH) \
- && ln -s ${workdir}/$(DIR_GRIBEX)_$(ARCH) $(DIR_GRIBEX)_$(ARCH)
- cp /home/rech/mnh/rmnh007/aeronec/mesonh/binaries/libemosR64.a $(DIR_GRIBEX)_$(ARCH)/libgribexR64.a
-else
-#tori & yuki
- - [ ! -d $(DIR_GRIBEX)_$(ARCH) ] && mkdir -p $(DIR_GRIBEX)_$(ARCH)
- cp /usr/local/SX/lib/libgribex.a $(DIR_GRIBEX)_$(ARCH)/libgribexR64.a
-endif
-endif
-
-gribex_clean :
- - [ -d $(DIR_GRIBEX)_$(ARCH) ] && rm -fr $(DIR_GRIBEX)_$(ARCH)
##########################################################
# #
# EXTRA LIB : GRIBAPI #
@@ -326,13 +305,31 @@ ifneq "$(findstring 64,$(shell uname -m))" ""
A64=A64
endif
gribapi : $(GRIBAPI_INC)
-$(GRIBAPI_INC) :
+$(GRIBAPI_INC) :
cd ${DIR_GRIBAPI} && ./configure --disable-shared --disable-jpeg --prefix=${GRIBAPI_PATH} CC="$(CC)" \
FC="$(FC)" FCFLAGS="$(GRIB_FLAGS)" ${GRIBAPI_CONF} && $(MAKE) -j 1 clean && \
$(MAKE) -j 1 && $(MAKE) -j 1 install && $(MAKE) -j 1 clean
gribapi_clean :
- - [ -d ${GRIBAPI_PATH} ] && rm -fr ${GRIBAPI_PATH}
+ - [ -d ${GRIBAPI_PATH} ] && rm -fr ${GRIBAPI_PATH}
+##########################################################
+# #
+# EXTRA LIB : ecCodes #
+# #
+##########################################################
+eccodes_lib : $(ECCODES_MOD)
+$(ECCODES_MOD) :
+ - [ ! -d $(DIR_ECCODES_BUILD) ] && mkdir -p $(DIR_ECCODES_BUILD)
+ cd ${DIR_ECCODES_BUILD} && \
+ cmake ${DIR_ECCODES_SRC} -DCMAKE_INSTALL_PREFIX=${DIR_ECCODES_INSTALL} -DBUILD_SHARED_LIBS=OFF \
+ -DENABLE_NETCDF=OFF -DENABLE_JPG=OFF -DENABLE_PYTHON=OFF -DENABLE_EXAMPLES=OFF \
+ -DCMAKE_Fortran_COMPILER=$(FC) -DCMAKE_C_COMPILER=$(CC) \
+ -DCMAKE_Fortran_FLAGS=$(ECCODES_FFLAGS) -DCMAKE_C_FLAGS=$(ECCODES_CFLAGS) && \
+ $(MAKE) && $(MAKE) install && $(MAKE) clean
+
+eccodes_lib_clean :
+ - [ -d ${DIR_ECCODES_BUILD} ] && rm -fr ${DIR_ECCODES_BUILD}
+ - [ -d ${DIR_ECCODES_INSTALL} ] && rm -fr ${DIR_ECCODES_INSTALL}
##########################################################
# #
# EXTRA LIB : NETCDF #
@@ -347,8 +344,8 @@ cdf : $(CDF_MOD)
$(CDF_MOD) :
cd ${DIR_LIBAEC} && ./configure --disable-shared --prefix=${CDF_PATH} --libdir=${CDF_PATH}/lib64 CC="$(CC)" CFLAGS="$(HDF_OPT)" && \
$(MAKE) && $(MAKE) install && $(MAKE) clean
- cd ${DIR_HDF} && ./configure --disable-shared --prefix=${CDF_PATH} --libdir=${CDF_PATH}/lib64 --with-szlib=${CDF_PATH}/include,${CDF_PATH}/lib64 \
- CC="$(CC)" CFLAGS="$(HDF_OPT)" LDFLAGS="-L${CDF_PATH}/lib64" LIBS="-lsz -laec -lz" && \
+ cd ${DIR_HDF} && ./configure --enable-fortran --disable-shared --prefix=${CDF_PATH} --libdir=${CDF_PATH}/lib64 --with-szlib=${CDF_PATH}/include,${CDF_PATH}/lib64 \
+ CC="$(CC)" CFLAGS="$(HDF_OPT)" FC="$(FC)" FCFLAGS="$(NETCDF_OPT)" LDFLAGS="-L${CDF_PATH}/lib64" LIBS="-lsz -laec -lz" && \
$(MAKE) && $(MAKE) install && $(MAKE) clean
cd ${DIR_CDFC} && ./configure --disable-shared --prefix=${CDF_PATH} --libdir=${CDF_PATH}/lib64 --disable-dap \
CC="$(CC)" CFLAGS="$(NETCDF_OPT)" CPPFLAGS="${INC_NETCDF}" ${CDF_CONF} LDFLAGS="-L${CDF_PATH}/lib64" LIBS="-lhdf5_hl -lhdf5 -lsz -laec -lz" && \
@@ -417,7 +414,7 @@ endif
##########################################################
ifdef PROG_LIST
-prog : lib $(LIB_GRIBEX)
+prog : lib
@$(MAKE) -I$(B)$(OBJDIR) DEP=YES $(PROG_LIST)
install : $(patsubst %,%-${ARCH_XYZ},$(PROG_LIST))
@@ -427,7 +424,7 @@ $(PROG_LIST) : OBJ_PROG=$(shell find $(PROG_DIR) -follow -type f -name "spll_*.f
| xargs grep -l -E -i "^[[:space:]]*program *$@" | sed -e 's/\.f.*/.o/g' | head -1 \
| xargs basename | xargs -I{} find $(PROG_DIR) -follow -name {} -print | head -1 )
-$(PROG_LIST) : $(LIB_MNH) $(LIB_GRIBEX)
+$(PROG_LIST) : $(LIB_MNH)
# echo OBJ_PROG=$(OBJ_PROG)
$(F90) $(LDFLAGS) -o $(OBJDIR)/$@ $(OBJ_PROG) $(LIB_MNH) $(LIBS)
@@ -511,7 +508,7 @@ endif
cleanuser :
test -d $(OBJDIR_USER) && rm -fr $(OBJDIR_USER)
-clean : examplesclean gribex_clean
+clean : examplesclean eccodes_lib_clean
rm -fr $(OBJDIR_ROOT)
cleanprog :
cd $(OBJDIR_ROOT) ; rm -f $(PROG_LIST)
diff --git a/src/Makefile.MESONH.mk b/src/Makefile.MESONH.mk
index f7b5994ea41d7dcf9088fd8a535921006ca9b110..a185973cd2f031897d56f599330939e67ce20892 100644
--- a/src/Makefile.MESONH.mk
+++ b/src/Makefile.MESONH.mk
@@ -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.
@@ -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 !!!
@@ -126,11 +134,19 @@ DIR_RAD += LIB/RAD/ECMWF_RAD
INC_RAD = -I$(B)LIB/RAD/ECMWF_RAD
#
ifdef MNH_ECRAD
-DIR_RAD += LIB/RAD/ecrad-1.0.1_mnh
-DIR_RAD += LIB/RAD/ecrad-1.0.1
-CPPFLAGS_RAD = -DMNH_ECRAD
-INC_RAD += -I$(B)LIB/RAD/ecrad-1.0.1/include
-ARCH_XYZ := $(ARCH_XYZ)-ECRAD
+DIR_RAD += LIB/RAD/ecrad-$(VERSION_ECRAD)_mnh
+DIR_RAD += LIB/RAD/ecrad-$(VERSION_ECRAD)
+CPPFLAGS_RAD = -DMNH_ECRAD -DVER_ECRAD=$(VER_ECRAD)
+INC_RAD += -I$(B)LIB/RAD/ecrad-$(VERSION_ECRAD)/include
+ifeq "$(VER_ECRAD)" "140"
+INC_RAD += -I$(B)LIB/RAD/ecrad-$(VERSION_ECRAD)/drhook/include
+IGNORE_DEP_MASTER += yomhook.D
+endif
+ifneq "$(VER_ECRAD)" "140"
+IGNORE_DEP_MASTER += read_albedo_data.D read_emiss_data.D
+endif
+
+ARCH_XYZ := $(ARCH_XYZ)-ECRAD$(VER_ECRAD)
endif
#
#
@@ -140,7 +156,12 @@ CPPFLAGS += $(CPPFLAGS_RAD)
INC += $(INC_RAD)
IGNORE_DEP_MASTER += olwu.D olwv.D rad1Driv_MACLATMOSPH_60LEVELS_ICRCCM3.D tstrad.D tstrad_chansubset.D tstrad_rttov7.D \
- tstrad_sx6.D
+ tstrad_sx6.D
+
+ifndef MNH_ECRAD
+IGNORE_DEP_MASTER += read_albedo_data.D read_emiss_data.D
+endif
+
OBJS0 += spll_orrtm_kgb1.o spll_orrtm_kgb14.o spll_orrtm_kgb3_a.o spll_orrtm_kgb4_b.o \
spll_orrtm_kgb5_c.o spll_orrtm_kgb10.o spll_orrtm_kgb15.o spll_orrtm_kgb3_b.o \
@@ -199,6 +220,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 #
@@ -215,13 +248,16 @@ endif
##########################################################
# Source NEWLFI #
##########################################################
+ifdef MNH_IOLFI
+CPPFLAGS_MNH += -DMNH_IOLFI
DIR_NEWLFI += LIB/NEWLFI/src
#CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX
INC_NEWLFI = -I$(B)LIB/NEWLFI/src
+endif
#
ifdef DIR_NEWLFI
#
-# Management/parametrisation of size of INTEGER ofr file > 16 GO & RECL for LFI
+# Management/parametrisation of size of INTEGER for files > 16 GiB & RECL for LFI
#
LFI_INT?=4
ifneq "$(findstring 8,$(LFI_INT))" ""
@@ -411,31 +447,15 @@ INC += $(INC_MPI)
LIBS += $(LIB_MPI)
endif
-
ARCH_XYZ := $(ARCH_XYZ)-$(VER_MPI)
-##########################################################
-# Librairie GRIBEX #
-##########################################################
-#ifneq "$(ARCH)" "BG"
-# Gribex bypass on BG for the moment
-#DIR_GRIBEX += LIB/GRIBEX
-#endif
-#
-#ifdef DIR_GRIBEX
-#LIB_GRIBEX = $(DIR_GRIBEX)_$(ARCH)/libgribexR64.a
-#LIBS += $(LIB_GRIBEX)
-#R64_GRIBEX=R64
-#endif
+
##########################################################
# Librairie GRIBAPI #
##########################################################
-#ifneq "$(ARCH)" "BG"
-# Gribapi bypass on BG for the moment
+ifeq "$(MNH_GRIBAPI)" "yes"
DIR_GRIBAPI?=${SRC_MESONH}/src/LIB/grib_api-${VERSION_GRIBAPI}
GRIBAPI_PATH?=${OBJDIR_MASTER}/GRIBAPI-${VERSION_GRIBAPI}
-#GRIBAPI_PATH?=${DIR_GRIBAPI}-${ARCH}${MNH_INT}
GRIBAPI_INC?=${GRIBAPI_PATH}/include/grib_api.mod
-#endif
#
ifdef DIR_GRIBAPI
INC_GRIBAPI ?= -I${GRIBAPI_PATH}/include
@@ -445,6 +465,25 @@ LIBS += $(LIB_GRIBAPI)
VPATH += $(GRIBAPI_PATH)/include
R64_GRIBAPI=R64
endif
+endif
+
+##########################################################
+# ecCodes library #
+##########################################################
+ifneq "$(MNH_GRIBAPI)" "yes"
+DIR_ECCODES_SRC?=${SRC_MESONH}/src/LIB/eccodes-${VERSION_ECCODES}-Source
+DIR_ECCODES_BUILD?=${OBJDIR_MASTER}/build_eccodes-${VERSION_ECCODES}
+DIR_ECCODES_INSTALL?=${OBJDIR_MASTER}/ECCODES-${VERSION_ECCODES}
+ECCODES_MOD?=${DIR_ECCODES_INSTALL}/include/grib_api.mod
+#
+ifdef DIR_ECCODES_SRC
+INC_ECCODES ?= -I${DIR_ECCODES_INSTALL}/include
+LIB_ECCODES ?= -L${DIR_ECCODES_INSTALL}/lib -L${DIR_ECCODES_INSTALL}/lib64 -leccodes_f90 -leccodes
+INC += $(INC_ECCODES)
+LIBS += $(LIB_ECCODES)
+VPATH += $(DIR_ECCODES_INSTALL)/include
+endif
+endif
##########################################################
# Librairie OASIS #
@@ -480,21 +519,23 @@ endif
##########################################################
# NETCDF4 INPUT/OUTPUT in MesoNH
ifdef MNH_IOCDF4
-CPPFLAGS_MNH += -DMNH_IOCDF4=$(MNH_IOCDF4)
+CPPFLAGS_MNH += -DMNH_IOCDF4
+else
+VER_CDF="NONE"
endif
#
# NetCDF : AUTO install of netcdf-4.X.X on PC linux to avoid problem with compiler
#
#
ifeq "$(VER_CDF)" "CDFAUTO"
-DIR_CDFC?=${SRC_MESONH}/src/LIB/netcdf-${VERSION_CDFC}
-DIR_CDFCXX?=${SRC_MESONH}/src/LIB/netcdf-cxx-${VERSION_CDFCXX}
+DIR_CDFC?=${SRC_MESONH}/src/LIB/netcdf-c-${VERSION_CDFC}
+DIR_CDFCXX?=${SRC_MESONH}/src/LIB/netcdf-cxx4-${VERSION_CDFCXX}
DIR_CDFF?=${SRC_MESONH}/src/LIB/netcdf-fortran-${VERSION_CDFF}
-CDF_PATH?=${SRC_MESONH}/src/LIB/netcdf-${ARCH}-R${MNH_REAL}I${MNH_INT}
+CDF_PATH?=${OBJDIR_MASTER}/NETCDF-${VERSION_CDFF}
CDF_MOD?=${CDF_PATH}/include/netcdf.mod
#
INC_NETCDF ?= -I${CDF_PATH}/include
-LIB_NETCDF ?= -L${CDF_PATH}/lib -L${CDF_PATH}/lib64 -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lsz -laec -lz -ldl
+LIB_NETCDF ?= -L${CDF_PATH}/lib -L${CDF_PATH}/lib64 -lnetcdff -lnetcdf -lhdf5hl_fortran -lhdf5_hl -lhdf5_fortran -lhdf5 -lsz -laec -lz -ldl
#
INC += $(INC_NETCDF)
LIBS += $(LIB_NETCDF)
diff --git a/src/Rules.AIX64.mk b/src/Rules.AIX64.mk
index 2f125e2cef063ec5d03bb90cdd492d1e824289d5..5f750fdcd0834593bf318df7f3003f1c19a90732 100644
--- a/src/Rules.AIX64.mk
+++ b/src/Rules.AIX64.mk
@@ -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.
@@ -86,18 +86,16 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DAMAX1=MAX -DMNH -DSFX_MNH
#
-# Gribex flags
-#
-#TARGET_GRIBEX=rs6000
-TARGET_GRIBEX=ibm_power4
-CNAME_GRIBEX=""
-#A64=A64
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -108,6 +106,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.BG.mk b/src/Rules.BG.mk
index 068f99dea7da2ab34b6b4125f9ca99fd70b8306e..7f4261c7599a8580df10c866f1e855bba192675c 100644
--- a/src/Rules.BG.mk
+++ b/src/Rules.BG.mk
@@ -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.
@@ -97,18 +97,16 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DAMAX1=MAX -DMNH -DSFX_MNH
#
-# Gribex flags
-#
-#TARGET_GRIBEX=rs6000
-TARGET_GRIBEX=ibm_power4
-CNAME_GRIBEX=""
-#A64=A64
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
#MNH_TOOLS = no
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -119,6 +117,12 @@ CNAME_GRIBEX=""
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.BGQ.mk b/src/Rules.BGQ.mk
index 79f9363bd0dcb0e67e1fcf720242c3580f6b77d4..1fd0a07bd041649c96d941cd91a50b58d5063364 100644
--- a/src/Rules.BGQ.mk
+++ b/src/Rules.BGQ.mk
@@ -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.
@@ -121,7 +121,6 @@ F77FLAGS = $(OPT) -qfixed
FX90 = $(F90)
FX90FLAGS = $(OPT) -qfixed
#
-# compiler & flags for compilation of grib_api
# for reproductibility need : -qfloat=nomaf
#
FC = mpixlf95_r
@@ -154,20 +153,16 @@ INC += -I${GA_ROOT}/include
LIBS += -L${GA_ROOT}/lib -larmci -lga -lgfortran
endif
#
-# Gribex flags
-#
-#TARGET_GRIBEX=rs6000
-TARGET_GRIBEX=ibm_power4
-CNAME_GRIBEX=""
-#A64=A64
-# Gribapi flags
-GRIBAPI_CONF= --host=powerpc64-bgq-linux
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
#MNH_TOOLS = no
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -178,6 +173,12 @@ GRIBAPI_CONF= --host=powerpc64-bgq-linux
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXNAGfor.mk b/src/Rules.LXNAGfor.mk
index 318cb4ba34a70725def6ace645a075ffe1ba2494..f623af39cfc550ed248e92cb7a5085f10f3255c4 100644
--- a/src/Rules.LXNAGfor.mk
+++ b/src/Rules.LXNAGfor.mk
@@ -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.
@@ -73,12 +73,6 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DSFX_MNH
-#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=_nagfor
-GRIB_FLAGS = -dusty -kind=byte
#
# Netcdf/HDF5 flags
#
@@ -90,6 +84,11 @@ NETCDF_SUPPFLAGS = -dusty -kind=byte
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -100,6 +99,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXarm.mk b/src/Rules.LXarm.mk
index c9b81e0b274aaca96506cf445314a8873526a9c1..5ae81163a76f5575199c1553a04821c1ddd95abe 100644
--- a/src/Rules.LXarm.mk
+++ b/src/Rules.LXarm.mk
@@ -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.
@@ -94,11 +94,6 @@ INC += -I${GA_ROOT}/include
LIBS += -L${GA_ROOT}/lib -larmci -lga
endif
#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=_gfortran
-#
# Netcdf/HDF5 flags
#
HDF_CONF= CFLAGS=-std=c99
@@ -112,6 +107,11 @@ MNH_TOOLS=yes
endif
endif
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -122,6 +122,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXcray.mk b/src/Rules.LXcray.mk
index 4e4b34b870f3dc1def5c79d66e45cc772b4b1049..8b5a2ec2e28d06909c75cd99c88f3a866b9f7707 100644
--- a/src/Rules.LXcray.mk
+++ b/src/Rules.LXcray.mk
@@ -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.
@@ -90,22 +90,17 @@ CPPFLAGS_SURCOUCHE += -DMNH_GA
INC += -I${GA_ROOT}/include
LIBS += -L${GA_ROOT}/lib -larmci -lga -lgfortran
endif
-#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=_gfortran
-#
-# GRIB_API
-#
-GRIBAPI_CONF="FCFLAGS= -em -ef "
-
#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -116,6 +111,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXg95.mk b/src/Rules.LXg95.mk
index 7a1add9c315f623c9f06569b07761c4f92b1953a..305f9f56c94423a95e415dce2fb5939f4ee24470 100644
--- a/src/Rules.LXg95.mk
+++ b/src/Rules.LXg95.mk
@@ -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.
@@ -67,16 +67,16 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DAINT=INT -DAMOD=MOD -DMNH -DSFX_MNH
#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=g95
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -87,6 +87,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXgfortran.mk b/src/Rules.LXgfortran.mk
index 4e3af2c943bc5b92690ee01c2820f32fb8630506..f9ba987e6c59b96ec7070d54fe7c9a56683f7501 100644
--- a/src/Rules.LXgfortran.mk
+++ b/src/Rules.LXgfortran.mk
@@ -1,4 +1,4 @@
-#MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
@@ -98,11 +98,6 @@ INC += -I${GA_ROOT}/include
LIBS += -L${GA_ROOT}/lib -larmci -lga
endif
#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=_gfortran
-#
# Netcdf/HDF5 flags
#
HDF_CONF= CFLAGS=-std=c99
@@ -118,6 +113,11 @@ MNH_TOOLS=yes
endif
endif
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -128,6 +128,24 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
+#
+# Force -fallow-argument-mismatch option for gcc >= 10.1
+# Necessary because some subroutines may be called with different datatypes
+# Known list: MPI_Allgatherv,MPI_Allreduce,MPI_Bcast,MPI_Bsend,MPI_Gather,MPI_Gatherv,MPI_Recv,LEPOLY,EXTRACT_BBUFF,FILL_BBUFF
+# + ecCodes + netCDF-fortran < 4.5.3
+#
+ifeq ($(shell test $(GFV) -ge 1010 ; echo $$?),0)
+OPT_BASE += -fallow-argument-mismatch
+GRIB_FLAGS += -fallow-argument-mismatch
+NETCDF_SUPPFLAGS += -fallow-argument-mismatch
+ECCODES_FFLAGS += -fallow-argument-mismatch
+endif
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
@@ -161,4 +179,3 @@ OBJS_O0= spll_lima_phillips_integ.o
$(OBJS_O0) : OPT = $(OPT_BASE) $(OPT_PERF0)
endif
endif
-
diff --git a/src/Rules.LXifort.mk b/src/Rules.LXifort.mk
index e89ea60a34fab24e948a7040ae516eb254a807aa..b7f8e24bdb1236b64d9c9ed0346b2a463f8066b9 100644
--- a/src/Rules.LXifort.mk
+++ b/src/Rules.LXifort.mk
@@ -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.
@@ -137,13 +137,13 @@ CPPFLAGS_SURCOUCHE += -DMNH_USE_MPI_STATUSES_IGNORE
endif
else
ifeq "$(VER_MPI)" "MPIINTEL"
+CPPFLAGS_SURCOUCHE += -DMNH_USE_MPI_STATUSES_IGNORE -DMNH_NO_MPI_LOGICAL48
ifneq "$(findstring TAU,$(XYZ))" ""
F90 = tau_f90.sh
export TAU_MAKEFILE?=/home/escj/PATCH/TAU/TAU-2.21.1-IFORT10-OMPI152-THREAD/x86_64/lib/Makefile.tau-mpi
LIBS += -lz
else
F90 = mpiifort
-CPPFLAGS_SURCOUCHE += -DMNH_USE_MPI_STATUSES_IGNORE
endif
ifeq "$(MNH_INT)" "8"
OPT_BASE += -ilp64
@@ -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
#
@@ -180,14 +180,9 @@ CPPFLAGS_MNH = -DMNH -DSFX_MNH
ifdef VER_GA
CPPFLAGS_SURCOUCHE += -DMNH_GA
INC += -I${GA_ROOT}/include
-LIBS += -L${GA_ROOT}/lib -larmci -lga -lgfortran
+LIBS += -L${GA_ROOT}/lib -lga -larmci
endif
#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=ifort
-#
# Netcdf/HDF5 flags
#
HDF_CONF= CFLAGS=-std=c99
@@ -201,6 +196,11 @@ ifeq "$(MNH_INT)" "4"
MNH_TOOLS=yes
endif
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -211,6 +211,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXpathf95.mk b/src/Rules.LXpathf95.mk
index d116ac262a9690d95c1d54cbc1119b73d111737a..932b438aae162bf04a54b30433af09a957c17c3a 100644
--- a/src/Rules.LXpathf95.mk
+++ b/src/Rules.LXpathf95.mk
@@ -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.
@@ -47,16 +47,16 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX
CPPFLAGS_MNH = -DAINT=INT -DAMOD=MOD -DMNH -DSFX_MNH
#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=pathf95
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -67,6 +67,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.LXpgi.mk b/src/Rules.LXpgi.mk
index aed227b9da0c2bfef2d950d29aabe884ec825c24..92a545b508b6b374edacf931ea3f744c0f2ff4d6 100644
--- a/src/Rules.LXpgi.mk
+++ b/src/Rules.LXpgi.mk
@@ -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.
@@ -152,13 +152,6 @@ CPPFLAGS_NEWLFI = -DSWAPIO -DLINUX -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DMNH_PGI -DSFX_MNH
CPPFLAGS_MNH += -Uvector -Upixel
#
-# Gribex flags
-#
-TARGET_GRIBEX=linux
-CNAME_GRIBEX=_pgf77
-GRIBAPI_CONF="CPP=cpp"
-CDF_CONF="CPP=cpp"
-#
# BITREP flags
#
#if MNH_BITREP exists => compile with the BITREP library
@@ -172,6 +165,11 @@ endif
#if MNH_TOOLS exists => compile the tools
MNH_TOOLS = yes
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -182,6 +180,12 @@ MNH_COMPRESS=yes
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/Rules.SX8.mk b/src/Rules.SX8.mk
index 669582ee8fde48898ce5487f9c76a4ab90ee61dc..79e63f46c80122ec97fcb3072079381431c731b1 100644
--- a/src/Rules.SX8.mk
+++ b/src/Rules.SX8.mk
@@ -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.
@@ -89,17 +89,16 @@ CPPFLAGS_RAD =
CPPFLAGS_NEWLFI = -DMNH_SX5 -DLFI_INT=${LFI_INT}
CPPFLAGS_MNH = -DMNH -DSFX_MNH
#
-# Gribex flags
-#
-#ARCH_GRIBEX=NEC
-TARGET_GRIBEX=NEC
-CNAME_GRIBEX=sxmpif90
-#
# LIBTOOLS flags
#
#if MNH_TOOLS exists => compile the tools
#MNH_TOOLS = no
#
+## IOLFI flag
+#
+#if MNH_IOLFI exists => compile the NEWLFI library (for LFI files)
+MNH_IOLFI=yes
+#
## COMPRESS flag
#
#if MNH_COMPRESS exists => compile the COMPRESS library (for LFI files)
@@ -110,6 +109,12 @@ CNAME_GRIBEX=sxmpif90
#if MNH_S4PY exists => compile the libs4py library (for epygram)
#MNH_S4PY=no
#
+## ecCodes or grib_api selection
+#MNH_GRIBAPI: if set to no: use ecCodes
+# if set to yes: use grib_api (deprecated library)
+#
+MNH_GRIBAPI=no
+#
##########################################################
# #
# Source of MESONH PACKAGE Distribution #
diff --git a/src/SURFEX/allocate_physio.F90 b/src/SURFEX/allocate_physio.F90
index 1028fa2498a5949727561ed5e83c6b1bc3f45250..745a7d007573acc54b03ab9a38911feb85faedc7 100644
--- a/src/SURFEX/allocate_physio.F90
+++ b/src/SURFEX/allocate_physio.F90
@@ -33,6 +33,7 @@
!! -------------
!! Original xx/xxxx
!! Modified 10/2014 P. Samuelsson MEB
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
!
!
USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
@@ -99,11 +100,7 @@ ELSE
ENDIF
! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options)
!
-IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN
- ALLOCATE(PK%XH_TREE (ISIZE ))
-ELSE
- ALLOCATE(PK%XH_TREE (0 ))
-ENDIF
+ALLOCATE(PK%XH_TREE (ISIZE ))
!
IF (IO%CPHOTO/='NON') THEN
ALLOCATE(PK%XRE25 (ISIZE ))
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/ch_emission_fluxn.F90 b/src/SURFEX/ch_emission_fluxn.F90
index 25b6a7e646b86a910fcd2d6f54bc7569a41a46c6..f9eae54518a9396b0c73cce922894b0fad2493f7 100644
--- a/src/SURFEX/ch_emission_fluxn.F90
+++ b/src/SURFEX/ch_emission_fluxn.F90
@@ -1,4 +1,4 @@
-!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2000-2020 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
@@ -28,6 +28,7 @@
!! P.Tulet 01/01/05 add dust, orilam
!! M.Leriche 2015 suppress ZDEPOT
!! M.Moge 01/2016 using READ_SURF_FIELD2D for 2D surfex fields reads
+! P. Wautelet 11/02/2020: bugfix: set correct filein before call to INIT_IO_SURF_n
!!
!! EXTERNAL
!! --------
@@ -53,6 +54,7 @@ USE MODI_GET_LUOUT
USE MODD_CHS_AEROSOL, ONLY: LCH_AERO_FLUX
USE MODI_CH_AER_EMISSION
!UPG*AERO1
+USE MODI_SET_SURFEX_FILEIN
!!
!------------------------------------------------------------------------------
!
@@ -208,6 +210,7 @@ DO JI=1,SIZE(CHE%TSEMISS)
!
IF (.NOT. LIOINIT) THEN
! Must be done once before reading
+ CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ')
CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL ','SURF ','READ ')
IF (IVERB >= 6) WRITE(ILUOUT,*) 'INIT des I/O DONE.'
LIOINIT=.TRUE.
diff --git a/src/SURFEX/convert_patch_isba.F90 b/src/SURFEX/convert_patch_isba.F90
index cad66666339946c838b566938c50ad491b38e4f0..b04278c2088347b63e33deac72c1660e34f2c7ff 100644
--- a/src/SURFEX/convert_patch_isba.F90
+++ b/src/SURFEX/convert_patch_isba.F90
@@ -46,6 +46,7 @@
!! coupled to atmosphere)
!! P Samuelsson 10/2014 MEB
! P. Wautelet 15/02/2019: bugfix: allocate ZSTRESS only when its size has a meaning
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
!
!----------------------------------------------------------------------------
!
@@ -215,7 +216,6 @@ IF (OFIX) THEN
PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
!
- IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN
IF (GDATA .AND. ANY(DTV%LDATA_H_TREE)) THEN
CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
PK%XH_TREE,DTV%XPAR_VEGTYPE,DTV%XPAR_H_TREE,YTREE,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
@@ -223,7 +223,6 @@ IF (OFIX) THEN
CALL AV_PGD_1P(DTCO, PK%XH_TREE,PCOVER,XDATA_H_TREE(:,:),YTREE,'ARI',OCOVER,&
PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
ENDIF
- ENDIF
!
IF (IO%CPHOTO/='NON') THEN
!
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/get_surf_varn.F90 b/src/SURFEX/get_surf_varn.F90
index f732f03161620077971e172764a7af89d51acc92..de14d16e00dcc1c9b80ee0ee6ff3bc89e9816833 100644
--- a/src/SURFEX/get_surf_varn.F90
+++ b/src/SURFEX/get_surf_varn.F90
@@ -10,7 +10,8 @@
PZ0H_WATER, PZ0H_NATURE, PZ0H_TOWN, PQS_SEA, &
PQS_WATER, PQS_NATURE, PQS_TOWN, PPSNG, PPSNV, &
PZS, PSERIES, PTWSNOW, PSSO_STDEV, PLON, PLAT, &
- PBARE, PLAI_TREE, PH_TREE )
+ PBARE, PLAI_TREE, PH_TREE, &
+ PWALL_O_HOR, PBUILD_HEIGHT )
! #######################################################################
!
!!**** *GET_SURF_VAR_n* - gets some surface fields on atmospheric grid
@@ -47,6 +48,7 @@
! S. Riette 06/2010 PSSO_STDEV and PTWSNOW added
! B. Decharme 09/2012 Argument added in GET_FLUX_n
! B. Decharme 05/2013 Argument added in GET_FLUX_n for debug in ARP/AL/AR
+!! C. Lac 11/2019 correction in the drag formula and application to building in addition to tree
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -144,8 +146,11 @@ REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PLON ! longitude
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PLAT ! latitude
!
REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PBARE ! bare soil fraction on grid mesh (-)
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PLAI_TREE ! Leaf Area Index on grid mesh (-)
-REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PH_TREE ! Height of trees on grid mesh (-)
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PLAI_TREE ! Leaf Area Index on grid mesh (-)
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PH_TREE ! Height of trees on grid mesh (-)
+!
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PWALL_O_HOR ! Facade area density on grid mesh [m^2(fac.)/m^2(town)]
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PBUILD_HEIGHT ! Building height on grid mesh [m]
!
!-------------------------------------------------------------------------------
!
@@ -425,7 +430,8 @@ ENDIF
!
!-------------------------------------------------------------------------------
!
-IF ( PRESENT(PQS_TOWN) .OR. PRESENT(PZ0_TOWN) .OR. PRESENT(PZ0H_TOWN) ) THEN
+IF ( PRESENT(PQS_TOWN) .OR. PRESENT(PZ0_TOWN) .OR. PRESENT(PZ0H_TOWN) .OR. &
+ PRESENT(PWALL_O_HOR) .OR. PRESENT (PBUILD_HEIGHT) ) THEN
!
! Get parameters over town tile
!
@@ -440,8 +446,9 @@ IF ( PRESENT(PQS_TOWN) .OR. PRESENT(PZ0_TOWN) .OR. PRESENT(PZ0H_TOWN) ) THEN
IMASK(:)=0
CALL GET_1D_MASK(KI_TOWN, KI, PTOWN, IMASK(1:KI_TOWN))
!
- CALL GET_VAR_TOWN_n(TM%TD%O, TM%TD%D, HPROGRAM, KI_TOWN, &
- ZFIELD1(1:KI_TOWN), ZFIELD2(1:KI_TOWN), ZFIELD3(1:KI_TOWN))
+ CALL GET_VAR_TOWN_n(TM%TOP, TM%TD%O, TM%TD%D, TM%NT,HPROGRAM, KI_TOWN, &
+ ZFIELD1(1:KI_TOWN), ZFIELD2(1:KI_TOWN), ZFIELD3(1:KI_TOWN),&
+ ZFIELD4(1:KI_TOWN), ZFIELD5(1:KI_TOWN) )
!
IF(PRESENT(PQS_TOWN))THEN
PQS_TOWN (:) = XUNDEF
@@ -464,6 +471,20 @@ IF ( PRESENT(PQS_TOWN) .OR. PRESENT(PZ0_TOWN) .OR. PRESENT(PZ0H_TOWN) ) THEN
END DO
ENDIF
!
+ IF(PRESENT(PWALL_O_HOR))THEN
+ PWALL_O_HOR (:) = XUNDEF
+ DO JI = 1, KI_TOWN
+ PWALL_O_HOR(IMASK(JI)) = ZFIELD4(JI)
+ END DO
+ ENDIF
+ !
+ IF(PRESENT(PBUILD_HEIGHT))THEN
+ PBUILD_HEIGHT (:) = XUNDEF
+ DO JI = 1, KI_TOWN
+ PBUILD_HEIGHT(IMASK(JI)) = ZFIELD5(JI)
+ END DO
+ ENDIF
+ !
END IF
!
!* 5. Orography
diff --git a/src/SURFEX/get_var_townn.F90 b/src/SURFEX/get_var_townn.F90
index 0f2e9c9d7a8501a326655eb869dbe19ee0f69416..382f32216f17819a49f02764db3ef54b5a2889e6 100644
--- a/src/SURFEX/get_var_townn.F90
+++ b/src/SURFEX/get_var_townn.F90
@@ -3,7 +3,8 @@
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
! #########
- SUBROUTINE GET_VAR_TOWN_n (DGO, D, HPROGRAM,KI,PQS,PZ0,PZ0H)
+ SUBROUTINE GET_VAR_TOWN_n (TOP, DGO, D, NT, HPROGRAM,KI,PQS,PZ0,PZ0H, &
+ PWALL_O_HOR,PBUILD_HEIGHT )
! ###################################################
!
!!**** *GET_VAR_TOWN_n* - routine to get variables defined only over town
@@ -33,6 +34,7 @@
!! -------------
!! Original 02/2006
! M. Jidane 08/2008 Z0 and Z0H recovery from town tiles
+!! C.Lac 11/2019 correction in the drag formula and application to building in addition to tree
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -40,6 +42,8 @@
!
!
USE MODD_DIAG_n, ONLY : DIAG_t, DIAG_OPTIONS_t
+USE MODD_TEB_n, ONLY : TEB_NP_t
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
!
USE MODI_GET_LUOUT
USE MODD_SURF_PAR, ONLY : XUNDEF
@@ -54,19 +58,24 @@ IMPLICIT NONE
!* 0.1 Declarations of arguments
! -------------------------
!
+TYPE(TEB_OPTIONS_t), INTENT(IN) :: TOP
TYPE(DIAG_OPTIONS_t), INTENT(IN) :: DGO
-TYPE(DIAG_t), INTENT(IN) :: D
+TYPE(DIAG_t), INTENT(IN) :: D
+TYPE(TEB_NP_t), INTENT(IN) :: NT
!
CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM
INTEGER, INTENT(IN) :: KI ! Number of points
REAL, DIMENSION(KI), INTENT(OUT) :: PQS ! surface humidity
REAL, DIMENSION(KI), INTENT(OUT) :: PZ0 ! surface roughness length
REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H ! surface roughness length for heat
+REAL, DIMENSION(KI), INTENT(OUT) :: PWALL_O_HOR ! Facade surface density [m^2(fac.)/m^2(town)]
+REAL, DIMENSION(KI), INTENT(OUT) :: PBUILD_HEIGHT ! Building height [m]
!
!
!* 0.2 Declarations of local variables
! -------------------------------
!
+INTEGER :: JP ! loop counter on TEB patches
INTEGER :: ILUOUT
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -76,17 +85,28 @@ IF (LHOOK) CALL DR_HOOK('GET_VAR_TOWN_N',0,ZHOOK_HANDLE)
!-------------------------------------------------------------------------------
!
IF (DGO%LSURF_VARS) THEN
- PQS = D%XQS
- ELSE
- PQS = XUNDEF
+ PQS = D%XQS
+ELSE
+ PQS = XUNDEF
ENDIF
IF (DGO%LCOEF) THEN
- PZ0 = D%XZ0
- PZ0H = D%XZ0H
- ELSE
- PZ0 = XUNDEF
- PZ0H = XUNDEF
-ENDIF
+ PZ0 = D%XZ0
+ PZ0H = D%XZ0H
+ELSE
+ PZ0 = XUNDEF
+ PZ0H = XUNDEF
+ENDIF
+!
+!* building height and external wall coverage fraction
+!
+PWALL_O_HOR = 0.
+PBUILD_HEIGHT = 0.
+
+DO JP=1,TOP%NTEB_PATCH
+ PWALL_O_HOR (:) = PWALL_O_HOR (:) + TOP%XTEB_PATCH(:,JP) * NT%AL(JP)%XWALL_O_HOR(:)
+ PBUILD_HEIGHT(:) = PBUILD_HEIGHT(:) + TOP%XTEB_PATCH(:,JP) * NT%AL(JP)%XBLD_HEIGHT(:)
+END DO
+
IF (LHOOK) CALL DR_HOOK('GET_VAR_TOWN_N',1,ZHOOK_HANDLE)
!
!==============================================================================
diff --git a/src/SURFEX/get_vegn.F90 b/src/SURFEX/get_vegn.F90
index a41238194f6801df7bdcbfa3720681b65c25c90f..d1e9c583dea8d354a300c86d77501cd24ee6236b 100644
--- a/src/SURFEX/get_vegn.F90
+++ b/src/SURFEX/get_vegn.F90
@@ -29,6 +29,7 @@
!! MODIFICATIONS
!! -------------
!! Original 07/2009
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -100,16 +101,16 @@ IPATCH_BONE = VEGTYPE_TO_PATCH(NVT_BONE, IO%NPATCH)
IPATCH_BOND = VEGTYPE_TO_PATCH(NVT_BOND, IO%NPATCH)
-!ZWORK(:) = S%XVEGTYPE(:,NVT_TRBE) + S%XVEGTYPE(:,NVT_TRBD) + S%XVEGTYPE(:,NVT_TEBE) + &
-! S%XVEGTYPE(:,NVT_TEBD) + S%XVEGTYPE(:,NVT_TENE) + S%XVEGTYPE(:,NVT_BOBD) + &
-! S%XVEGTYPE(:,NVT_BONE) + S%XVEGTYPE(:,NVT_BOND)
-
ZH_TREE(:) = 0.
ZLAI(:) = 0.
ZWORK(:) = 0.
!
DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ PEK => NPE%AL(JP)
+END DO
!
+DO JP = 1,IO%NPATCH
IF (JP==IPATCH_TRBE .OR. JP==IPATCH_TRBD .OR. JP==IPATCH_TEBE .OR. JP==IPATCH_TEBD .OR. &
JP==IPATCH_TENE .OR. JP==IPATCH_BOBD .OR. JP==IPATCH_BONE .OR. JP==IPATCH_BOND) THEN
!
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_isban.F90 b/src/SURFEX/init_isban.F90
index 4bdbb57e1112e5df8c0cf986a6e72663295b7cbe..283b107f5744b132310c3f43feb9f084748da5b4 100644
--- a/src/SURFEX/init_isban.F90
+++ b/src/SURFEX/init_isban.F90
@@ -59,6 +59,7 @@ SUBROUTINE INIT_ISBA_n (DTCO, OREAD_BUDGETC, UG, U, USS, GCP, IM, DTZ,&
!! P.Tulet 06/16 : add MEGAN coupling
!! J.Pianezzej 02/2019 : correction for use of MEGAN
! P. Wautelet 21/11/2019: initialize YSNOW_SCHEME
+! S. Donnier 02/2020 : correction for ECOCLIMAP SG (20 vegtypes possible)
!!
!-------------------------------------------------------------------------------
!
@@ -371,7 +372,10 @@ ISIZE_LMEB_PATCH=COUNT(IM%O%LMEB_PATCH(:))
!* 2.2 Check:
! ------
!
-IF ( IM%O%CPHOTO/='NON' .AND. IM%O%NPATCH/=12 .AND. IM%O%NPATCH/=19 )THEN
+! modif ECOSG
+!IF ( IM%O%CPHOTO/='NON' .AND. IM%O%NPATCH/=12 .AND. IM%O%NPATCH/=19 )THEN
+IF ( IM%O%CPHOTO/='NON' .AND. IM%O%NPATCH/=12 .AND. IM%O%NPATCH/=19 .AND. IM%O%NPATCH/=20 )THEN
+! fin modif ECOSG
CALL ABOR1_SFX('INIT_ISBAN: INCONSISTENCY BETWEEN CPHOTO AND NPATCH')
ENDIF
!
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_aer_surf.F90 b/src/SURFEX/mode_aer_surf.F90
index e38f84a6480ea33bc163205106b8a4411443b125..a23ac0cdb8bb8f53f88d4f3148a08d0dead73d78 100644
--- a/src/SURFEX/mode_aer_surf.F90
+++ b/src/SURFEX/mode_aer_surf.F90
@@ -215,6 +215,7 @@ REAL,DIMENSION(JPMODE*3) :: ZMMIN
!
REAL,DIMENSION(NSP+NCARB+NSOA) :: ZFAC ! M3 / mass conversion factor
REAL, PARAMETER :: ZDEN2MOL = 1E-6 * 6.0221367E+23 / 28.9644E-3
+REAL :: ZEMISRADIUSI, ZEMISRADIUSJ
INTEGER :: JJ, JN ! [idx] loop counters
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -227,6 +228,23 @@ DO JJ=1, SIZE(PSVT,2)
ZSV(:,JJ) = PSVT(:,JJ) * ZDEN2MOL * PRHODREF(:)
ZSV(:,JJ) = MAX(ZSV(:,JJ),1E-40 * ZDEN2MOL * PRHODREF(:))
ENDDO
+!Get minimum values possible for aerosols moments
+IF (CRGUNIT=="MASS") THEN
+ ZEMISRADIUSI = XEMISRADIUSI * EXP(-3.*(LOG(XEMISSIGI))**2)
+ ZEMISRADIUSJ = XEMISRADIUSJ * EXP(-3.*(LOG(XEMISSIGJ))**2)
+ELSE
+ ZEMISRADIUSI = XEMISRADIUSI
+ ZEMISRADIUSJ = XEMISRADIUSJ
+END IF
+
+ZMMIN(1) = XSURF_TINY
+ZMMIN(2) = ZMMIN(1) * (ZEMISRADIUSI**3)*EXP(4.5 * LOG(XEMISSIGI)**2)
+ZMMIN(3) = ZMMIN(1) * (ZEMISRADIUSI**6)*EXP(18. * LOG(XEMISSIGI)**2)
+
+ZMMIN(4) = XSURF_TINY
+ZMMIN(5) = ZMMIN(4) * (ZEMISRADIUSJ**3)*EXP(4.5 * LOG(XEMISSIGJ)**2)
+ZMMIN(6) = ZMMIN(4) * (ZEMISRADIUSJ**6)*EXP(18. * LOG(XEMISSIGJ)**2)
+
!
CALL INIT_VAR(ZSV,ZFAC,ZCTOTA)
!
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/mode_read_grib.F90 b/src/SURFEX/mode_read_grib.F90
index ec71d31314156d270939ae14202ce729473420d3..f92149d19a20c6d00eeb29570069aecf84e819ce 100644
--- a/src/SURFEX/mode_read_grib.F90
+++ b/src/SURFEX/mode_read_grib.F90
@@ -1,10 +1,11 @@
-!SFX_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
!-------------------------------------------------------------------
! Modifications:
! P. Wautelet 19/09/2019: correct support of 64bit integers (MNH_INT=8)
+! Q. Rodier 27/01/2020: switch of GRIB number ID for Orography in ARPEGE in EPyGrAM v1.3.7
!-------------------------------------------------------------------
! #####################
MODULE MODE_READ_GRIB
@@ -62,11 +63,9 @@ IF (NGRIB_VERSION==1) THEN
CALL GRIB_INDEX_CREATE(NIDX,HGRIB,'indicatorOfParameter',IRET)
ELSEIF (NGRIB_VERSION==2) THEN
IF(HINMODEL=='ARPEGE') THEN
- print*,"CALL GRIB_INDEX_CREATE"
CALL GRIB_INDEX_CREATE(NIDX,HGRIB,'parameterNumber',IRET)
-print*,IRET
ELSE
- CALL GRIB_INDEX_CREATE(NIDX,HGRIB,'paramId',IRET)
+ CALL GRIB_INDEX_CREATE(NIDX,HGRIB,'paramId',IRET)
ENDIF
ENDIF
IF (IRET/=0) CALL ABOR1_SFX("MODE_READ_GRIB:MAKE_GRIB_INDEX: error while creating the grib index")
@@ -100,7 +99,7 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:CLEAR_GRIB_INDEX',1,ZHOOK_HANDLE)
END SUBROUTINE CLEAR_GRIB_INDEX
!-------------------------------------------------------------------
! ####################
- SUBROUTINE GET_GRIB_MESSAGE(KLUOUT,KLTYPE,KLEV1,KLEV2,KGRIB,KFOUND,HTYPELEVEL,PLEV1,PLEV2)
+ SUBROUTINE GET_GRIB_MESSAGE(KLUOUT,KLTYPE,KLEV1,KLEV2,KGRIB,KFOUND,HTYPELEVEL,PLEV1,PLEV2,HNAME)
! ####################
! MODIFICATIONS
! Gaelle Delautier (via Q.Rodier) 01/2019 : add GRIB 2
@@ -118,6 +117,7 @@ INTEGER, INTENT(OUT) :: KFOUND
CHARACTER(LEN=*), INTENT(INOUT), OPTIONAL :: HTYPELEVEL ! TypeOfLevel JPMODIF
REAL, INTENT(INOUT), OPTIONAL :: PLEV1 ! top level of soil
REAL, INTENT(INOUT), OPTIONAL :: PLEV2 ! Bottom level of soil
+CHARACTER(LEN=*), INTENT(INOUT), OPTIONAL :: HNAME ! name of the parameter
!
INTEGER :: ILTYPE
@@ -126,6 +126,7 @@ INTEGER :: ILEV2
CHARACTER(LEN=50) :: YTYPELEVEL ! TypeOfLevel JPMODIF
REAL :: ZLEV1,ZLEV2
INTEGER(KIND=kindOfInt) :: IRET
+CHARACTER(LEN=50) :: CNAME
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
@@ -134,21 +135,17 @@ IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:GET_GRIB_MESSAGE',0,ZHOOK_HANDLE)
IRET = 0
KFOUND=0
!
-DO WHILE (IRET /= GRIB_END_OF_INDEX .AND. KFOUND/=3)
-print*,"===============new message=============="
+DO WHILE (IRET /= GRIB_END_OF_INDEX .AND. KFOUND/=4)
!
IRET = 0
KFOUND=0
!
IF (KLTYPE/=-2) THEN
CALL GRIB_GET(KGRIB,'indicatorOfTypeOfLevel',ILTYPE,IRET)
-print*,IRET
IF(IRET/=0) THEN
CALL GRIB_GET(KGRIB,'typeOfFirstFixedSurface',ILTYPE,IRET)
ENDIF
-print*,IRET
CALL TEST_IRET(KLUOUT,ILTYPE,KLTYPE,IRET)
- print*,"ILTYPE,KLTYPE,IRET",ILTYPE,KLTYPE,IRET
ELSE
IF (PRESENT(HTYPELEVEL)) THEN
CALL GRIB_GET(KGRIB,'typeOfLevel',YTYPELEVEL,IRET)
@@ -156,6 +153,16 @@ print*,IRET
ENDIF
ENDIF
!
+ IF (IRET.EQ.0) THEN
+ !
+ KFOUND = KFOUND + 1
+ !
+ IF (PRESENT(HNAME)) THEN
+ CALL GRIB_GET(KGRIB,'name',CNAME,IRET)
+ CALL TEST_IRET_STR(KLUOUT,CNAME,HNAME,IRET)
+ END IF
+ END IF
+ !
IF (IRET.EQ.0) THEN
!
KFOUND = KFOUND + 1
@@ -169,7 +176,6 @@ print*,IRET
ENDIF
!
-print*,KFOUND
IF (IRET.EQ.0) THEN
!
KFOUND = KFOUND + 1
@@ -184,12 +190,11 @@ print*,KFOUND
!
IF (IRET.EQ.0) KFOUND = KFOUND + 1
!
-print*,KFOUND
ENDIF
!
ENDIF
!
- IF (KFOUND.NE.3) THEN
+ IF (KFOUND.NE.4) THEN
CALL GRIB_RELEASE(KGRIB)
CALL GRIB_NEW_FROM_INDEX(NIDX,KGRIB,IRET)
ENDIF
@@ -295,7 +300,7 @@ END SUBROUTINE GET_GRIB_MESSAGE
!-------------------------------------------------------------------
! ####################
SUBROUTINE READ_GRIB(HGRIB,HINMODEL,KLUOUT,KPARAM,KRET,PFIELD,KLTYPE,KLEV1,KLEV2,KPARAM2, &
- KLTYPE2,HTYPELEVEL,PLEV1,PLEV2)
+ KLTYPE2,HTYPELEVEL,PLEV1,PLEV2,HNAME)
! ####################
! MODIFICATIONS
! Gaelle Delautier (via Q.Rodier) 01/2019 : add GRIB 2
@@ -316,6 +321,7 @@ INTEGER,INTENT(INOUT), OPTIONAL :: KLEV2 ! Level parameter 2
INTEGER, INTENT(INOUT), OPTIONAL :: KPARAM2
INTEGER,INTENT(INOUT), OPTIONAL :: KLTYPE2 ! Level type
CHARACTER(LEN=*), INTENT(INOUT), OPTIONAL :: HTYPELEVEL
+CHARACTER(LEN=*), INTENT(INOUT), OPTIONAL :: HNAME
!
REAL, INTENT(INOUT), OPTIONAL :: PLEV1,PLEV2
!
@@ -324,6 +330,7 @@ INTEGER(KIND=kindOfInt) :: IGRIB
INTEGER :: ISIZE, IFOUND
REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL :: ZLEV1,ZLEV2
+CHARACTER(LEN=50) :: CNAME
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB',0,ZHOOK_HANDLE)
!
@@ -347,11 +354,9 @@ IF (NGRIB_VERSION == 1) THEN
CALL GRIB_INDEX_SELECT(NIDX,'indicatorOfParameter',KPARAM,KRET)
ELSEIF (NGRIB_VERSION == 2) THEN
IF (HINMODEL=='ARPEGE') THEN
- print*,"GRIB_INDEX_SELECT :",KPARAM
CALL GRIB_INDEX_SELECT(NIDX,'parameterNumber',KPARAM,KRET)
-print*,KRET
ELSE
- CALL GRIB_INDEX_SELECT(NIDX,'paramId',KPARAM,KRET)
+ CALL GRIB_INDEX_SELECT(NIDX,'paramId',KPARAM,KRET)
ENDIF
END IF
CALL GRIB_NEW_FROM_INDEX(NIDX,IGRIB,KRET)
@@ -359,10 +364,12 @@ END IF
WRITE (KLUOUT,*) 'READ_GRIB GRIB_NEW_FROM_INDEX ',KPARAM,IGRIB,KRET
IF (KRET.EQ.0) THEN
- IF (PRESENT(HTYPELEVEL)) THEN
+ IF (PRESENT(HNAME)) THEN
+ CNAME = HNAME
+ CALL GET_GRIB_MESSAGE(KLUOUT,ILTYPE,ILEV1,ILEV2,IGRIB,IFOUND,HNAME=CNAME)
+ ELSEIF (PRESENT(HTYPELEVEL)) THEN
CALL GET_GRIB_MESSAGE(KLUOUT,ILTYPE,ILEV1,ILEV2,IGRIB,IFOUND,HTYPELEVEL,ZLEV1,ZLEV2)
ELSE
-print*,"CALL GET_GRIB_MESSAGE"
CALL GET_GRIB_MESSAGE(KLUOUT,ILTYPE,ILEV1,ILEV2,IGRIB,IFOUND)
ENDIF
ENDIF
@@ -371,7 +378,7 @@ ENDIF
WRITE (KLUOUT,*) 'READ_GRIB GRIB_NEW_FROM_INDEX ',KPARAM,IGRIB,KRET,IFOUND
IF (PRESENT(KPARAM2)) THEN
- IF (IFOUND/=3) THEN
+ IF (IFOUND/=4) THEN
IF (HINMODEL=='ARPEGE' .AND.NGRIB_VERSION == 2) THEN
CALL GRIB_INDEX_SELECT(NIDX,'parameterNumber',KPARAM2,KRET)
ELSE
@@ -389,9 +396,7 @@ IF (PRESENT(KPARAM2)) THEN
ENDIF
ENDIF
!
-print*,"IFOUND=",IFOUND
-
-IF (IFOUND==3) THEN
+IF (IFOUND==4) THEN
!
IF (PRESENT(KLTYPE)) KLTYPE = ILTYPE
IF (PRESENT(KLEV1)) KLEV1 = ILEV1
@@ -442,8 +447,6 @@ INTEGER :: INUM_ZS,ISIZE,ICOUNT,JLOOP,IPARAM,IGRIB,IPARAM2
CHARACTER(LEN=24) :: YLTYPELU
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------
-print*,"HINMODEL=",HINMODEL
-print*,"NGRIB_VERSION=",NGRIB_VERSION
IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_LAND_MASK',0,ZHOOK_HANDLE)
WRITE (KLUOUT,'(A)') 'MODE_READ_GRIB:READ_GRIB_LAND_MASK: | Reading land mask from ',HINMODEL
!
@@ -453,14 +456,12 @@ SELECT CASE (HINMODEL)
CASE ('NCEP ')
CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,172,IRET,PMASK)
CASE ('ARPEGE','ALADIN','MOCAGE')
- print*,"NGRIB_VERSION=",NGRIB_VERSION
IF(HINMODEL=='ARPEGE' .AND. NGRIB_VERSION==2) THEN
ILTYPE=1
- CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,0,IRET,PMASK,KLTYPE=ILTYPE)
+ CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,0,IRET,PMASK,KLTYPE=ILTYPE)
ELSE
CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,81,IRET,PMASK)
ENDIF
-print*,"NGRIB_VERSION=",NGRIB_VERSION
CASE ('HIRLAM')
ILTYPE=105
ILEV =0
@@ -513,10 +514,14 @@ SELECT CASE (HINMODEL)
CASE ('ECMWF ')
CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,129,IRET,PZS)
CASE ('NCEP ')
- CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,228002,IRET,PZS)
+ CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,228002,IRET,PZS)
CASE ('ARPEGE','MOCAGE')
IF (HINMODEL=='ARPEGE' .AND. NGRIB_VERSION==2) THEN
- CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,5,IRET,PZS)
+ CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,4,IRET,PZS)
+ IF (IRET /= 0) THEN
+ ! Old version of EPyGraM (bug corrected since 01/2020)
+ CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,5,IRET,PZS)
+ END IF
ELSE
CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,8,IRET,PZS)
ENDIF
@@ -531,7 +536,9 @@ IF (IRET /= 0) THEN
END IF
!
! Datas given in archives are multiplied by the gravity acceleration
-PZS = PZS / XG
+IF(HINMODEL /= 'NCEP') THEN
+ PZS = PZS / XG
+END IF
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_ZS',1,ZHOOK_HANDLE)
END SUBROUTINE READ_GRIB_ZS
@@ -605,7 +612,7 @@ INTEGER :: ILEV ! level definition
INTEGER :: IPARAM ! number of ParamId or IndicatorOfParameter or ParameterNumber
REAL(KIND=JPRB) :: ZHOOK_HANDLE
CHARACTER(LEN=7) :: YTYPELEVEL ! Type of searched level
-
+CHARACTER(LEN=50) :: CNAME ! name of the parameter (for ARPEGE GRIB2 converted with Epygram 1.4.8)
!-------------------------------------------------------------------
!* Read surface temperature
IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_T',0,ZHOOK_HANDLE)
@@ -618,13 +625,15 @@ SELECT CASE (HINMODEL)
CASE ('ARPEGE','ALADIN','MOCAGE')
ILEV=0
IF (HINMODEL=='ARPEGE' .AND. NGRIB_VERSION==2) THEN
- IPARAM=18
+ IPARAM=0
ILTYPE=1
+ CNAME = 'Temperature'
+ CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,IPARAM,IRET,PT,KPARAM2=IPARAM,KLTYPE=ILTYPE,KLEV1=ILEV,HNAME=CNAME)
ELSE
IPARAM=11
ILTYPE=111
+ CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,IPARAM,IRET,PT,KLTYPE=ILTYPE,KLEV1=ILEV)
ENDIF
- CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,IPARAM,IRET,PT,KLTYPE=ILTYPE,KLEV1=ILEV)
IF (IRET /= 0) THEN
ILTYPE=1
CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,IPARAM,IRET,PT,KLTYPE=ILTYPE)
@@ -751,7 +760,7 @@ SELECT CASE (HINMODEL)
CALL ABOR1_SFX('MODE_READ_GRIB:READ_GRIB_TSWATER:OPTION NOT SUPPORTED '//HINMODEL)
END SELECT
!
-IF (SIZE(PMASK)==SIZE(PTS)) WHERE ((PMASK(:)/=1.) .OR. ((PMASK(:)==1.) .AND.(PTS(:)==9999.))) PTS = XUNDEF
+IF (SIZE(PMASK)==SIZE(PTS)) WHERE ((PMASK(:)/=0.) .OR. ((PMASK(:)==0.) .AND.(PTS(:)==9999.))) PTS = XUNDEF
!
IF (LHOOK) CALL DR_HOOK('MODE_READ_GRIB:READ_GRIB_TSWATER',1,ZHOOK_HANDLE)
@@ -1665,7 +1674,7 @@ PD(:,2) = 0.20
ILEV1 = 0
IF (HINMODEL == 'ARPEGE' .OR. HINMODEL=='MOCAGE') THEN
IF (HINMODEL=='ARPEGE' .AND. NGRIB_VERSION==2) THEN
- IPARAM=20
+ IPARAM=193
ILTYPE=1
CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,IPARAM,IRET,ZFIELD,KLTYPE=ILTYPE)
ELSE
@@ -1688,7 +1697,7 @@ PFIELD(:,1) = ZFIELD(:)
! ---------------------
IF (HINMODEL == 'ARPEGE' .OR. HINMODEL=='MOCAGE') THEN
IF (HINMODEL=='ARPEGE' .AND. NGRIB_VERSION==2) THEN
- IPARAM=20
+ IPARAM=193
ILTYPE=106
CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,IPARAM,IRET,ZFIELD,KLTYPE=ILTYPE)
ELSE
@@ -2183,7 +2192,7 @@ SELECT CASE(HINMODEL)
CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,141,IRET,ZFIELD)
CASE('ARPEGE','ALADIN','MOCAGE','HIRLAM')
IF (HINMODEL=='ARPEGE' .AND. NGRIB_VERSION==2) THEN
- CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,11,IRET,ZFIELD)
+ CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,60,IRET,ZFIELD)
ELSE
CALL READ_GRIB(HGRIB,HINMODEL,KLUOUT,66,IRET,ZFIELD)
ENDIF
diff --git a/src/SURFEX/pgd_fieldin.F90 b/src/SURFEX/pgd_fieldin.F90
index 683611a1c6db9abc6a56ac5ce4510edf25811734..990727e151a2f567c1181f2701d293f124f10186 100644
--- a/src/SURFEX/pgd_fieldin.F90
+++ b/src/SURFEX/pgd_fieldin.F90
@@ -57,7 +57,7 @@ USE MODD_PGDWORK, ONLY : XALL, NSIZE_ALL, CATYPE, NSIZE, XSUMVAL, &
USE MODD_SURF_PAR, ONLY : XUNDEF
USE MODD_PGD_GRID, ONLY : NL
!
-USE MODD_DATA_COVER_PAR, ONLY : NTYPE, LVEG_PRES, NVEGTYPE
+USE MODD_DATA_COVER_PAR, ONLY : NTYPE, LVEG_PRES, NVEGTYPE, NVEGTYPE_OLD
!
USE MODI_GET_LUOUT
USE MODI_TREAT_FIELD
@@ -293,8 +293,8 @@ IF (LEN_TRIM(HFILE)/=0) THEN
!
DO JT=1,SIZE(NSIZE,2)
- IF (.NOT.U%LECOSG.AND.JT>NVEGTYPE) EXIT
-
+ IF (.NOT.U%LECOSG.AND.JT>NVEGTYPE_OLD) EXIT
+
!multitype input file
IF (SIZE(ZFIELD,2)>1) THEN
diff --git a/src/SURFEX/prep_grib_grid.F90 b/src/SURFEX/prep_grib_grid.F90
index de1b379580cd645f181c31d7183c6667fa425616..b8c5b9c93775ec60da859ae7b66323e58d59b089 100644
--- a/src/SURFEX/prep_grib_grid.F90
+++ b/src/SURFEX/prep_grib_grid.F90
@@ -494,7 +494,6 @@ SELECT CASE (HGRIDTYPE)
IF (IRET == 0 .OR. IMISSING/=1) THEN ! quasi-regular
CALL GRIB_GET(IGRIB,'pl',ININLO_GRIB)
XILO2=360.-360./(MAXVAL(ININLO_GRIB))
- print*,"XILO2=",XILO2
ENDIF
DEALLOCATE(ININLO_GRIB)
ENDIF
diff --git a/src/SURFEX/prep_isba_ascllv.F90 b/src/SURFEX/prep_isba_ascllv.F90
index 3b9ba798d4992d3a46205ac5e198381b7d45d8bd..561e33e051493f3eb1f668839b92efdbeed09996 100644
--- a/src/SURFEX/prep_isba_ascllv.F90
+++ b/src/SURFEX/prep_isba_ascllv.F90
@@ -91,6 +91,11 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
IF (LHOOK) CALL DR_HOOK('PREP_ISBA_ASCLLV',0,ZHOOK_HANDLE)
!
+IF ((.NOT.ALLOCATED(NINDEX)).AND.(HPROGRAM=='MESONH')) THEN
+ ALLOCATE(NINDEX(U%NDIM_FULL))
+ NINDEX(:) = 0
+ENDIF
+!
IF (.NOT.ALLOCATED(NNUM)) THEN
ALLOCATE(NNUM(U%NDIM_FULL))
IF (NRANK/=NPIO) THEN
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_bld_descriptionn.F90 b/src/SURFEX/write_bld_descriptionn.F90
index 8f71b236d9df9051db6512036c9c86664006dae1..8ab77a32c78345b28b901477e2d50e32fe13e2a1 100644
--- a/src/SURFEX/write_bld_descriptionn.F90
+++ b/src/SURFEX/write_bld_descriptionn.F90
@@ -70,7 +70,6 @@ INTEGER :: IRESP
INTEGER :: I1, I2
INTEGER :: JL
INTEGER :: ITOT
- CHARACTER(LEN=LEN_HREC) :: YRECFM
CHARACTER(LEN=100) :: YCOMMENT
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
@@ -92,9 +91,8 @@ ZWORK(5) = FLOAT(BDD%NDESC_ROOF_LAYER)
ZWORK(6) = FLOAT(BDD%NDESC_ROAD_LAYER)
ZWORK(7) = FLOAT(BDD%NDESC_FLOOR_LAYER)
!
-YRECFM='Bld_dimensions '
YCOMMENT='Configuration numbers for descriptive building data'
- CALL WRITE_SURF(HSELECT, HPROGRAM,'BLD_DESC_CNF',ZWORK,IRESP,YCOMMENT,'-',YRECFM)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,'BLD_DESC_CNF',ZWORK,IRESP,YCOMMENT,'-','Bld_dimensions ')
DEALLOCATE(ZWORK)
!
!-------------------------------------------------------------------------------
@@ -183,9 +181,8 @@ END DO
CALL UP_DESC_IND_W(BDD%NDESC_AGE) ; ZWORK(I1:I2) = FLOAT(BDD%NDESC_AGE_DATE(:))
!
YCOMMENT='Descriptive building data'
-YRECFM='Bld_parameters '
CALL WRITE_SURF(HSELECT, &
- HPROGRAM,'BLD_DESC_DAT',ZWORK,IRESP,YCOMMENT,'-',YRECFM)
+ HPROGRAM,'BLD_DESC_DAT',ZWORK,IRESP,YCOMMENT,'-','Bld_parameters ')
DEALLOCATE(ZWORK)
!
IF (LHOOK) CALL DR_HOOK('WRITE_BLD_DESCRIPTION_n',1,ZHOOK_HANDLE)
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/writesurf_pgd_isba_parn.F90 b/src/SURFEX/writesurf_pgd_isba_parn.F90
index 5b9fa2248459c712aa784d36c00259ec1b9ff934..c3a0cf8e6191085474daa98ad18abe46abbc5032 100644
--- a/src/SURFEX/writesurf_pgd_isba_parn.F90
+++ b/src/SURFEX/writesurf_pgd_isba_parn.F90
@@ -1,4 +1,4 @@
-!SFX_LIC Copyright 2003-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC Copyright 2003-2020 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!SFX_LIC for details. version 1.
@@ -36,6 +36,7 @@
!! P. Le Moigne 12/2004 : add type of photosynthesis
!! P. Samuelsson 10/2014: MEB
!! P. Wautelet 01/2019: bug: write L_STRESS only if it exists
+!! P. Wautelet 12/06/2020: bugfix: moved condition on LPAR_STRESS (LDATA_STRESS was not written)
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
@@ -500,10 +501,10 @@ DO JV=1,DTV%NVEGTYPE
ENDIF
ENDDO
!
-IF (ASSOCIATED(DTV%LPAR_STRESS)) THEN
YRECFM='L_STRESS'
YCOMMENT=YRECFM
CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DTV%LDATA_STRESS,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+IF (ASSOCIATED(DTV%LPAR_STRESS)) THEN
ALLOCATE(ZWORK(SIZE(DTV%LPAR_STRESS,1)))
DO JV=1,DTV%NVEGTYPE
IF (DTV%LDATA_STRESS(JV)) 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 2e6f572cb49dcbfc706c4399c5c2fb064bdf1609..c0845c0d5f5e52acd0d7cca1d31c9316e03c1c79 100755
--- a/src/configure
+++ b/src/configure
@@ -1,23 +1,25 @@
#!/bin/bash
-#MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC Copyright 1994-2021 CNRS, Meteo-France and Universite Paul Sabatier
#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
#set -x
#set -e
if [ "x$XYZ" = "x" ]
then
#
-export VERSION_MASTER=${VERSION_MASTER:-MNH-V5-4}
-export VERSION_BUG=${VERSION_BUG:-2}
+export VERSION_MASTER=${VERSION_MASTER:-MNH-V5-5}
+export VERSION_BUG=${VERSION_BUG:-0}
export VERSION_XYZ=${VERSION_XYZ:-${VERSION_MASTER}-${VERSION_BUG}${VER_OASIS:+-${VER_OASIS}}}
-export VERSION_DATE=${VERSION_DATE:-"03/04/2019"}
-export VERSION_LIBAEC=${VERSION_LIBAEC:-"0.3.2"}
-export VERSION_HDF=${VERSION_HDF:-"1.8.20"}
-export VERSION_CDFC=${VERSION_CDFC:-"4.5.0"}
-export VERSION_CDFCXX=${VERSION_CDFCXX:-"4.2"}
-export VERSION_CDFF=${VERSION_CDFF:-"4.4.4"}
+export VERSION_DATE=${VERSION_DATE:-"19/03/2021"}
+export VERSION_LIBAEC=${VERSION_LIBAEC:-"0.3.4"}
+export VERSION_HDF=${VERSION_HDF:-"1.12.0"}
+export VERSION_CDFC=${VERSION_CDFC:-"4.7.4"}
+export VERSION_CDFCXX=${VERSION_CDFCXX:-"4.3.1"}
+export VERSION_CDFF=${VERSION_CDFF:-"4.5.3"}
export VERSION_GRIBAPI=${VERSION_GRIBAPI:-"1.26.0-Source"}
+export VERSION_ECCODES=${VERSION_ECCODES:-"2.18.0"}
+export ECCODES_DEFINITION_PATH=${ECCODES_DEFINITION_PATH:${SRC_MESONH}/src/LIB/eccodes-${VERSION_ECCODES}"/definitions/"}
export MNH_INT=${MNH_INT:-"4"}
export LFI_INT=${LFI_INT:-8}
export MNH_REAL=${MNH_REAL:-"8"}
@@ -27,9 +29,8 @@ export VERSION_OASIS=${VERSION_OASIS:-"mct_v3"}
export VERSION_TOY=${VERSION_TOY:-"v1-0"}
export VERSION_NCL=${VERSION_NCL:-"ncl-6.4.0"}
-
-export VERSION_ECRAD=${VERSION_ECRAD:-"1.0.1"}
-
+export VERSION_ECRAD=${VERSION_ECRAD:-"1.4.0"}
+export VER_ECRAD=${VERSION_ECRAD//./}
export LEN_HREC=${LEN_HREC:-16}
@@ -44,7 +45,7 @@ cd ${LOCAL}/conf
TARG=$(uname -s -n)
#
case "$TARG" in
-'Linux jean-zay'*)
+'Linux jean-zay'*|'Linux idrsrv'*)
export ARCH=${ARCH:-LXifort}
export VER_MPI=${VER_MPI:-MPIINTEL}
export OPTLEVEL=${OPTLEVEL:-O2}
@@ -52,11 +53,16 @@ case "$TARG" in
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
module purge
-module load intel-compilers-19/19.0.4.243
-module load intel-mpi-19/19.0.4.243
+module load cmake/3.18.0
+module load intel-compilers/19.1.3
+module load intel-mpi/2019.9
ulimit -s unlimited
export SLURM_CPU_BIND=none
export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
+module load imagemagick/7.0.8-7
+module load anaconda-py3/2020.11
+conda activate climate_science
+
"}
;;
'Linux'*'occigen'*)
@@ -67,7 +73,8 @@ export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
export MNHENV=${MNHENV:-"
ulimit -s unlimited
module purge
-module load intel/17.0 intelmpi/2017.2.174
+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
# force CC=gcc , for HDF5 divide by zero problem with icc !!!
@@ -118,21 +125,65 @@ module load ncl_ncarg/6.3.0
"}
;;
'Linux irene'*)
+ MODEL_NAME=`lscpu | grep 'Model name' `
+ case ${MODEL_NAME} in
+*Intel*) # Irene Intel core
export MNH_ARCH=`echo $ARCH | grep LX`
export ARCH=${MNH_ARCH:-LXifort}
- export VER_MPI=${VER_MPI:-MPIINTEL}
+ export VER_MPI=${VER_MPI:-MPIAUTO}
export OPTLEVEL=${OPTLEVEL:-O2}
export MVWORK=${MVWORK:-NO}
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
module purge
-module load intel/18.0.3.222
-module load mpi/intelmpi/2018.0.3.222
+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
-export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
+"}
+;;
+*AMD*) # Irene AMD core
+ export MNH_ARCH=`echo $ARCH | grep LX`
+ export ARCH=${MNH_ARCH:-LXifort}
+ export VER_MPI=${VER_MPI:-MPIAUTO}
+ export OPTLEVEL=${OPTLEVEL:-O2}
+ export MVWORK=${MVWORK:-NO}
+ export VER_CDF=${VER_CDF:-CDFAUTO}
+ 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
+# Set some openmpi variable for pb with nb of cores >> 1024
+export OMPI_MCA_coll_hcoll_enable=0
+export HCOLL_ENABLE_MCAST_ALL=0
+export OMPI_MCA_coll_tuned_barrier_algorithm=2
+# For GA version set GA/ARMCI variables
+export ARMCI_VERBOSE=1
+export ARMCI_STRIDED_METHOD=IOV ARMCI_IOV_METHOD=BATCHED
+export ARMCI_SHR_BUF_METHOD=COPY
+"}
+;;
+ esac
+ ;;
+'Linux belenos'*|'Linux taranis'*)
+ export ARCH=${ARCH:-LXifort}
+ export VER_MPI=${VER_MPI:-MPIAUTO}
+ export OPTLEVEL=${OPTLEVEL:-O3}
+ export MVWORK=${MVWORK:-NO}
+ export VER_CDF=${VER_CDF:-CDFAUTO}
+ export NEED_NCARG=${NEED_NCARG:-YES}
+ export NEED_TOOLS=YES
+ export MNHENV=${MNHENV:-"
+module purge
+module load intel/2019.5.281
+module load openmpi/intel/4.0.2.2
+module load cmake/3.15.4
+unset CC CXX
"}
;;
-
'Linux beaufix'*|'Linux prolix'*)
export ARCH=${ARCH:-LXifort}
export VER_MPI=${VER_MPI:-MPIINTEL}
@@ -307,11 +358,14 @@ export CC=gcc
export VER_CDF=${VER_CDF:-CDFAUTO}
export NEED_NCARG=${NEED_NCARG:-YES}
export MNHENV=${MNHENV:-"
-. /home/tools/intel/psxe2017/bin/ifortvars.sh intel64
-export MPI_ROOT=/usr/local/openmpi/1.6.5/ifort17.0.1.132
+. /home/tools/intel/psxe2018/bin/ifortvars.sh intel64
+export MPI_ROOT=/usr/local/openmpi/3.1.4/ifort18.0.2.199
export PATH=\$MPI_ROOT/bin:\$PATH
export LD_LIBRARY_PATH=\$MPI_ROOT/lib64:\$LD_LIBRARY_PATH
export MANPATH=\$MPI_ROOT/share/man:\$MANPATH
+# For python graphic
+source /home/sila/miniconda3/etc/profile.d/conda.sh
+conda activate mnh-env_nuwa
"}
;;
'Linux eos'*)
@@ -333,7 +387,8 @@ export I_MPI_PIN_PROCESSOR_LIST=all:map=spread
export VER_CDF=${VER_CDF:-CDFAUTO}
export MNHENV=${MNHENV:-"
module purge
-module load intel/18.2 intelmpi/18.2
+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
"}
@@ -449,7 +504,7 @@ fi
#
${LOCAL}/bin/eval_dollar profile_mesonh.ihm > profile_mesonh
chmod +x profile_mesonh
-XYZ=${ARCH}-R${MNH_REAL}I${MNH_INT}-${VERSION_XYZ}${MNH_ECRAD:+-ECRAD}${MNH_FOREFIRE:+-FF}${VER_USER:+-${VER_USER}}-${VER_MPI}-${OPTLEVEL}
+XYZ=${ARCH}-R${MNH_REAL}I${MNH_INT}-${VERSION_XYZ}${MNH_ECRAD:+-ECRAD${VER_ECRAD}}${MNH_FOREFIRE:+-FF}${VER_USER:+-${VER_USER}}-${VER_MPI}-${OPTLEVEL}
cp profile_mesonh profile_mesonh-${XYZ}
#
# Do some post-install stuff
@@ -485,8 +540,8 @@ fi
if [ "x${VER_CDF}" == "xCDFAUTO" ] ;then
( cd $LOCAL/src/LIB ; [ ! -d libaec-${VERSION_LIBAEC} ] && tar xvfz libaec-${VERSION_LIBAEC}.tar.gz )
( cd $LOCAL/src/LIB ; [ ! -d hdf5-${VERSION_HDF} ] && tar xvfz hdf5-${VERSION_HDF}.tar.gz )
-( cd $LOCAL/src/LIB ; [ ! -d netcdf-${VERSION_CDFC} ] && tar xvfz netcdf-${VERSION_CDFC}.tar.gz )
-( cd $LOCAL/src/LIB ; [ ! -d netcdf-cxx-${VERSION_CDFCXX} ] && tar xvfz netcdf-cxx-${VERSION_CDFCXX}.tar.gz )
+( cd $LOCAL/src/LIB ; [ ! -d netcdf-c-${VERSION_CDFC} ] && tar xvfz netcdf-c-${VERSION_CDFC}.tar.gz )
+( cd $LOCAL/src/LIB ; [ ! -d netcdf-cxx4-${VERSION_CDFCXX} ] && tar xvfz netcdf-cxx4-${VERSION_CDFCXX}.tar.gz )
( cd $LOCAL/src/LIB ; [ ! -d netcdf-fortran-${VERSION_CDFF} ] && tar xvfz netcdf-fortran-${VERSION_CDFF}.tar.gz )
fi
#
@@ -502,9 +557,19 @@ if [ "x${MNH_MEGAN}" == "x1" ] ; then
( cd $LOCAL/src/LIB ; [ ! -d MEGAN ] && tar xvfz megan.tar.gz )
fi
#
-# Install GRIBAPI
+# Install GRIBAPI or ecCodes
+#
+if [ "x${MNH_GRIBAPI}" == "xyes" ] ; then
+( cd $LOCAL/src/LIB ; [ ! -d grib_api-${VERSION_GRIBAPI} ] && [ -f grib_api-${VERSION_GRIBAPI}.tar.gz ] && gunzip -c grib_api-${VERSION_GRIBAPI}.tar.gz |tar -xvf - )
+else
+( cd $LOCAL/src/LIB ; [ ! -d eccodes-${VERSION_ECCODES}-Source ] && [ -f eccodes-${VERSION_ECCODES}-Source.tar.gz ] && gunzip -c eccodes-${VERSION_ECCODES}-Source.tar.gz |tar -xvf - )
+fi
+#
+# Install ECRAD 1.4.0 if MNH_ECRAD=1 & VERSION_ECRAD=1.4.0
#
-cd $LOCAL/src/LIB ; [ ! -d grib_api-${VERSION_GRIBAPI} ] && [ -f grib_api-${VERSION_GRIBAPI}.tar.gz ] && gunzip -c grib_api-${VERSION_GRIBAPI}.tar.gz |tar -xvf -
+if [ "x${MNH_ECRAD}" == "x1" ] && [ "x${VERSION_ECRAD}" == "x1.4.0" ] ; then
+( cd $LOCAL/src/LIB/RAD ; [ ! -d ecrad-1.4.0 ] && tar xvfz ecrad-1.4.0.tar.gz )
+fi
##########################################################
# #
# RESUME #
diff --git a/src/job_make_examples_BG b/src/job_make_examples_BG
index 3c126674242029a00049b6789ead6dce369308a0..8f18e061117c3a2ae65983ee927bb242926e7304 100755
--- a/src/job_make_examples_BG
+++ b/src/job_make_examples_BG
@@ -18,7 +18,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BG-R8I4-MNH-V5-4-2-MPIAUTO-O2
+. ../conf/profile_mesonh-BG-R8I4-MNH-V5-5-0-MPIAUTO-O2
#001_2Drelief 002_3Drelief 003_KW78 004_Reunion 007_16janvier
diff --git a/src/job_make_examples_BGQ b/src/job_make_examples_BGQ
index 5b0bf5246a5d019fffc5dfdb5fafca2b802d4768..a6785fd9ff187b157b4567db85f44ebd08e982f0 100755
--- a/src/job_make_examples_BGQ
+++ b/src/job_make_examples_BGQ
@@ -18,7 +18,7 @@
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-4-2-MPIAUTO-O2NAN
+. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-5-0-MPIAUTO-O2NAN
set -x
diff --git a/src/job_make_examples_BullX b/src/job_make_examples_BullX
index 6e53b1a9b2257a6da3a8043f3244934822154073..2a29d889ee1533ecd009169d6427f4c2dada3b18 100755
--- a/src/job_make_examples_BullX
+++ b/src/job_make_examples_BullX
@@ -19,7 +19,7 @@ set -e
hostname
# Echo des commandes
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIINTEL-O3
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
export POSTRUN="time "
diff --git a/src/job_make_examples_BullX_belenos b/src/job_make_examples_BullX_belenos
new file mode 100755
index 0000000000000000000000000000000000000000..4aa4f1129fdbcf671a4d475cc998234ddc22f0d1
--- /dev/null
+++ b/src/job_make_examples_BullX_belenos
@@ -0,0 +1,81 @@
+#!/bin/bash
+#MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+#MNH_LIC for details. version 1.
+#SBATCH -J Examples
+#SBATCH -N 1 # nodes number
+#SBATCH -n 2 # CPUs number (on all nodes)
+#SBATCH -o Examples.eo%j #
+#SBATCH -e Examples.eo%j #
+#SBATCH -t 01:00:00 # time limit
+
+ulimit -c 0
+ulimit -s unlimited
+# Arret du job des la premiere erreur
+set -e
+# Nom de la machine
+hostname
+# Echo des commandes
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIAUTO-O3
+export MONORUN="Mpirun -np 1 "
+export MPIRUN="Mpirun -np 2 "
+export POSTRUN="echo "
+export MNH_PYTHON="NO"
+
+cd $SRC_MESONH/MY_RUN/KTEST/003_KW78
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/001_2Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/002_3Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+
+cd $SRC_MESONH/MY_RUN/KTEST/004_Reunion
+make -k << EOF
+
+
+EOF
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/007_16janvier
+make -k << EOF
+
+
+EOF
+#
+# Sur Belenos, le module python est incompatible avec les autres modules chargés Pour MésoNH.
+# Les tracés sont réalisés après tous les runs
+module purge
+module load python/3.7.6
+
+cd $SRC_MESONH/MY_RUN/KTEST/003_KW78
+make python
+
+cd $SRC_MESONH/MY_RUN/KTEST/001_2Drelief
+make python
+
+cd $SRC_MESONH/MY_RUN/KTEST/002_3Drelief
+make python
+
+cd $SRC_MESONH/MY_RUN/KTEST/004_Reunion
+make python
+
+cd $SRC_MESONH/MY_RUN/KTEST/007_16janvier
+make python
+
+module purge
diff --git a/src/job_make_examples_BullX_irene b/src/job_make_examples_BullX_irene
index 6e0f0f1f59d713780ab529e523a4b2cdba1e6f87..b59dd5bf59e0a9365cab6f715c89903575d63ad1 100755
--- a/src/job_make_examples_BullX_irene
+++ b/src/job_make_examples_BullX_irene
@@ -1,8 +1,7 @@
#!/bin/bash
#MSUB -J Examples
#MSUB -N 2 # nodes number
-#MSUB -n 4 # CPUs number (on all nodes)
-#MSUB --exclusive
+#MSUB -n 4 # CPUs number (on all nodes)
#MSUB -o Examples.eo%j #
#MSUB -e Examples.eo%j #
#MSUB -T 3600 # time limit
@@ -11,6 +10,7 @@
#MSUB -x # exclusive usage of nodes
#MSUB -X # enable X forwarding -> force 'ccc_msub -i ' to get it work
#MSUB -q skylake
+##MSUB -q knl
# Echo des commandes
ulimit -c 0
@@ -21,15 +21,15 @@ set +x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIAUTO-O2
set -x
module list
-export MONORUN="Exec ccc_mprun -n 1 "
-export MPIRUN="Exec ccc_mprun -n 4 "
-export POSTRUN="time "
+export MONORUN="Mpirun -tag-output --report-bindings -np 1 "
+export MPIRUN="Mpirun -tag-output --report-bindings -np 4 "
+export POSTRUN="echo "
cd $SRC_MESONH/MY_RUN/KTEST/003_KW78
make -k
diff --git a/src/job_make_examples_BullX_irene_AMD b/src/job_make_examples_BullX_irene_AMD
new file mode 100755
index 0000000000000000000000000000000000000000..e2e9c6d7d98f1322c881ae0c0138fb4670e840e4
--- /dev/null
+++ b/src/job_make_examples_BullX_irene_AMD
@@ -0,0 +1,73 @@
+#!/bin/bash
+#MSUB -J Examples
+#MSUB -N 2 # nodes number
+#MSUB -n 4 # CPUs number (on all nodes)
+#MSUB -o Examples_AMD.eo%j #
+#MSUB -e Examples_AMD.eo%j #
+#MSUB -T 3600 # time limit
+#MSUB -I # do not propaget variable from interactif
+#MSUB -m work,scratch,store # use this files system
+#MSUB -x # exclusive usage of nodes
+##MSUB -X # enable X forwarding -> force 'ccc_msub -i ' to get it work
+#MSUB -q rome
+
+# Echo des commandes
+ulimit -c 0
+ulimit -s unlimited
+# Arrete du job des la premiere erreur
+#set -e
+set +x
+# Nom de la machine
+hostname
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-AMD-MPIAUTO-O2
+
+set -x
+
+module list
+
+export MONORUN="Exec srun -l -K --cpu_bind=none --export=ALL -N 1 -n 1 numabind_core_slurm"
+export MPIRUN="Exec srun -l -K --cpu_bind=none --export=ALL -n 4 numabind_core_slurm"
+export POSTRUN="echo "
+
+cd $SRC_MESONH/MY_RUN/KTEST/003_KW78
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/001_2Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/002_3Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+
+cd $SRC_MESONH/MY_RUN/KTEST/004_Reunion
+make -k << EOF
+
+
+EOF
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/007_16janvier
+make -k << EOF
+
+
+EOF
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/014_LIMA
+make -k
+
+
diff --git a/src/job_make_examples_BullX_occigen b/src/job_make_examples_BullX_occigen
index b5f60e5f497a312918e32ff519ac0f883eccdddf..1a1cd8bc9c58bdc8ed8584db9caa25f46d608018 100755
--- a/src/job_make_examples_BullX_occigen
+++ b/src/job_make_examples_BullX_occigen
@@ -18,10 +18,10 @@ set -x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIINTEL-O2
export MONORUN="Mpirun -prepend-rank -np 1 "
export MPIRUN="Mpirun -prepend-rank -np 4 "
-export POSTRUN="time "
+export POSTRUN="echo "
cd $SRC_MESONH/MY_RUN/KTEST/003_KW78
make -k
diff --git a/src/job_make_examples_BullX_olympe b/src/job_make_examples_BullX_olympe
index d0c38777382dcbab8a12396a468a46c1ab732dd0..27f0e8c970502733f890ecd81837aea4f68acb54 100755
--- a/src/job_make_examples_BullX_olympe
+++ b/src/job_make_examples_BullX_olympe
@@ -17,10 +17,10 @@ set -x
# Nom de la machine
hostname
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIINTEL-O2
export MONORUN="mpirun -prepend-rank -np 1 "
export MPIRUN="mpirun -prepend-rank -np 4 "
-export POSTRUN="time "
+export POSTRUN="echo "
cd $SRC_MESONH/MY_RUN/KTEST/003_KW78
make -k
diff --git a/src/job_make_examples_CRAY_cca b/src/job_make_examples_CRAY_cca
index f4c87e365bc013585f8f1f738e68128bf72762ac..786947f40e6fdbe4689be5aae55636b36e17ec61 100755
--- a/src/job_make_examples_CRAY_cca
+++ b/src/job_make_examples_CRAY_cca
@@ -28,7 +28,7 @@ cd ${PBS_O_WORKDIR}
ARCH=LXifort
#ARCH=LXcray
-. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-4-2-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-5-0-MPICRAY-O2
export MONORUN="aprun -n 1 "
diff --git a/src/job_make_examples_HPE_jeanzay b/src/job_make_examples_HPE_jeanzay
new file mode 100755
index 0000000000000000000000000000000000000000..bd03e566f6090cdf224e080e65c11f8bc549f233
--- /dev/null
+++ b/src/job_make_examples_HPE_jeanzay
@@ -0,0 +1,66 @@
+#!/bin/bash
+#SBATCH -J Examples
+#SBATCH -N 2 # nodes number
+#SBATCH -n 4 # CPUs number (on all nodes)
+#SBATCH -q qos_cpu-dev
+#SBATCH --exclusive
+#SBATCH -o Examples.eo%j #
+#SBATCH -e Examples.eo%j #
+#SBATCH -t 01:00:00 # time limit
+#SBATCH --export=NONE
+#SBATCH -A mnh@cpu # put here you account/projet name
+
+# Echo des commandes
+ulimit -c 0
+ulimit -s unlimited
+# Arrete du job des la premiere erreur
+#set -e
+set -x
+# Nom de la machine
+hostname
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIINTEL-O2
+export MONORUN="Exec srun -l -n 1 --export=ALL numabind_core_slurm"
+export MPIRUN="Exec srun -l -n 4 --export=ALL numabind_core_slurm"
+export POSTRUN="echo "
+
+cd $SRC_MESONH/MY_RUN/KTEST/003_KW78
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/001_2Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/002_3Drelief
+make -k
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+
+cd $SRC_MESONH/MY_RUN/KTEST/004_Reunion
+make -k << EOF
+
+
+EOF
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/007_16janvier
+make -k << EOF
+
+
+EOF
+#
+echo "#################################################################################"
+echo "##CAS SUIVANT####################################################################"
+echo "#################################################################################"
+cd $SRC_MESONH/MY_RUN/KTEST/014_LIMA
+make -k
+
diff --git a/src/job_make_examples_IBM_ada b/src/job_make_examples_IBM_ada
index 43e1d73e003014dfaec460bb66a9a7af339446de..a1b1b51f54543532d5eff7d9f115d950a6c83c80 100755
--- a/src/job_make_examples_IBM_ada
+++ b/src/job_make_examples_IBM_ada
@@ -19,7 +19,7 @@
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIINTEL-O2
# Pour avoir l'echo des commandes
set -x
diff --git a/src/job_make_examples_IBM_sp6_vargas b/src/job_make_examples_IBM_sp6_vargas
index 8305c3663166ae8de3a6d8c1a530a6212ca4eaca..c8d65b89b0dd0089e8822d27a3264a4cc6a877d9 100755
--- a/src/job_make_examples_IBM_sp6_vargas
+++ b/src/job_make_examples_IBM_sp6_vargas
@@ -24,7 +24,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-2-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-5-0-MPIAUTO-O2
#001_2Drelief 002_3Drelief 003_KW78 004_Reunion 007_16janvier
diff --git a/src/job_make_examples_NEC_SX8 b/src/job_make_examples_NEC_SX8
index fb3a805c0b146a3298f317bb36a053da853fe468..d33de70361b74d52899c0f8d9866686c76d1d115 100755
--- a/src/job_make_examples_NEC_SX8
+++ b/src/job_make_examples_NEC_SX8
@@ -18,7 +18,7 @@ hostname
[ -d $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
#
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-2-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-5-0-MPIAUTO-O4
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
diff --git a/src/job_make_examples_SX8 b/src/job_make_examples_SX8
index de30324180c9cfed2e7d48a28b12cd9304dc6c2c..fdd3553013dfc4ba5e40ff30945f81ebcf8a4acd 100755
--- a/src/job_make_examples_SX8
+++ b/src/job_make_examples_SX8
@@ -19,7 +19,7 @@ hostname
[ -d $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
#
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-2-MPIAUTO-O2
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-5-0-MPIAUTO-O2
export MONORUN="Mpirun -np 1 "
export MPIRUN="Mpirun -np 2 "
diff --git a/src/job_make_examples_cxa b/src/job_make_examples_cxa
index f27bea4fbabebbee2a9f2db0497c3428187da7bf..ef8507f6bb94d9d0ac2964f8b808c7dd99325022 100755
--- a/src/job_make_examples_cxa
+++ b/src/job_make_examples_cxa
@@ -34,7 +34,7 @@ echo SHELL=$SHELL
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-2-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-5-0-MPIAUTO-O2
ulimit -c 0 # pas de core
diff --git a/src/job_make_mesonh_BG b/src/job_make_mesonh_BG
index 5b7a12e9d58ea8d185774eece6ce8486e64066d3..ce08d470e8b49270a701f2b31ffd9461a2932efb 100755
--- a/src/job_make_mesonh_BG
+++ b/src/job_make_mesonh_BG
@@ -18,7 +18,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BG-R8I4-MNH-V5-4-2-MPIAUTO-O2
+. ../conf/profile_mesonh-BG-R8I4-MNH-V5-5-0-MPIAUTO-O2
#time gmake
time gmake -r -j8
diff --git a/src/job_make_mesonh_BGQ b/src/job_make_mesonh_BGQ
index 6a8dd4cd7866686189d88ce096466b5229767307..a8e332a69e6e87ee81f4b79577fe18034eb014b2 100755
--- a/src/job_make_mesonh_BGQ
+++ b/src/job_make_mesonh_BGQ
@@ -1,8 +1,8 @@
-#MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
-#=========== Global directives ===========
+
# @ shell = /bin/bash
# Nom du travail LoadLeveler
# @ job_name = Sortie_MakeMesonh
@@ -10,21 +10,7 @@
# @ output = $(job_name).$(step_name).$(jobid)
# Fichier de sortie d'erreur du travail
# @ error = $(job_name).$(step_name).$(jobid)
-
-#=========== Step 1 directives ===========
-# ======= CompIlation step of grib_api ========
-# @ step_name = make_gribapi
-# @ job_type = serial
-# Temps CPU max. en seconde (d'un processus)
-# @ wall_clock_limit = 3600
-# @ queue
-
-#=========== Step 2 directives ===========
-#============= CompIlation step of MESONH =============
-# @ step_name = make_mesonh
# @ job_type = serial
-# @ dependency = (make_gribapi == 0)
-# (submit only if previous step completed without error)
# @ wall_clock_limit = 9000
# @ queue
@@ -34,31 +20,8 @@ set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-4-2-MPIAUTO-O2NAN
-
-case $LOADL_STEP_NAME in
-
-#=========== Step 1 directives ===========
-#======= CompIlation step of grib_api ========
-make_gribapi )
-
-#time gmake gribapi_clean
-time gmake gribapi
-
-;;
-
-#=========== Step 2 directives ===========
-#============= CompIlation step of MESONH =============
-make_mesonh )
+. ../conf/profile_mesonh-BGQ-R8I4-MNH-V5-5-0-MPIAUTO-O2NAN
time gmake -j8
time gmake -j8
time gmake installmaster
-
-;;
-#=================================================
-esac
-
-
-
-
diff --git a/src/job_make_mesonh_BullX b/src/job_make_mesonh_BullX
index 0af2e224427ab5a5873e8a65c32e6d52186e746c..967c115e1dcee2800b1b01ed89733a9e924bf30b 100755
--- a/src/job_make_mesonh_BullX
+++ b/src/job_make_mesonh_BullX
@@ -19,7 +19,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
pwd
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIINTEL-O3
time gmake -j 4
time gmake -j 1 installmaster
diff --git a/src/job_make_mesonh_BullX_belenos b/src/job_make_mesonh_BullX_belenos
new file mode 100755
index 0000000000000000000000000000000000000000..5fe6d8a062e5c331d3e66c16aa044ee52ed5bbf6
--- /dev/null
+++ b/src/job_make_mesonh_BullX_belenos
@@ -0,0 +1,23 @@
+#!/bin/bash
+#MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+#MNH_LIC for details. version 1.
+#SBATCH --verbose
+#SBATCH --job-name=compile
+#SBATCH --time=01:00:00
+#SBATCH --nodes=1
+#SBATCH --ntasks-per-node=1
+#SBATCH --cpus-per-task=16
+#SBATCH -o MasterI_belenos.eo%j #
+#SBATCH -e MasterI_belenos.eo%j #
+
+set -x
+# On va lancer la compilation dans le répertoire de lancement du job
+pwd
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIAUTO-O3
+
+time make -j 16
+time make -j 1 installmaster
+
diff --git a/src/job_make_mesonh_CRAY_cca b/src/job_make_mesonh_CRAY_cca
index 1b4de21e1cb8b98a69e7e06b20a2d95590afef7a..56dba703cf90a3b45a985cc4b68bc64551331a92 100755
--- a/src/job_make_mesonh_CRAY_cca
+++ b/src/job_make_mesonh_CRAY_cca
@@ -21,7 +21,7 @@ pwd
ARCH=LXifort
#ARCH=LXcray
-. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-4-2-MPICRAY-O2
+. ../conf/profile_mesonh-${ARCH}-R8I4-MNH-V5-5-0-MPICRAY-O2
time gmake -j 4 2>&1 | tee sortie_compile_${ARCH}.$$
time gmake -j 4 2>&1 | tee sortie_compile_${ARCH}2.$$
diff --git a/src/job_make_mesonh_HPE_jeanzay b/src/job_make_mesonh_HPE_jeanzay
new file mode 100755
index 0000000000000000000000000000000000000000..0dfa8598dda30dfaef3ef7268e2e02d184cfc0d3
--- /dev/null
+++ b/src/job_make_mesonh_HPE_jeanzay
@@ -0,0 +1,21 @@
+#!/bin/bash
+#MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+#MNH_LIC for details. version 1.
+#SBATCH --job-name=compile_MNH
+#SBATCH -N 1 -n 1 -c 16
+#SBATCH -o Sortie_compile_MasterI.eo%j
+#SBATCH --export=NONE
+#SBATCH -p compil
+#SBATCH -A mnh@cpu # put here your account/projet name
+
+set -x
+# On va lancer la compilation dans le répertoire de lancement du job
+pwd
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIINTEL-O2
+
+time gmake -j 16
+time gmake -j 1 installmaster
+
diff --git a/src/job_make_mesonh_IBM_ada b/src/job_make_mesonh_IBM_ada
index 4d64ed118d6792c9582d6ae47500e5dc1d14af48..bcdfcf110cdeb34e78dfcb55c06801c7ab1b2cd5 100755
--- a/src/job_make_mesonh_IBM_ada
+++ b/src/job_make_mesonh_IBM_ada
@@ -16,7 +16,7 @@
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-MPIINTEL-O2
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-MPIINTEL-O2
# Pour avoir l'echo des commandes
set -x
diff --git a/src/job_make_mesonh_IBM_sp6_vargas b/src/job_make_mesonh_IBM_sp6_vargas
index e8f11ad2743ab1306334ca7dca7c86c934f88cae..b5f606d6381285d09b9b62a66944331ad329b758 100755
--- a/src/job_make_mesonh_IBM_sp6_vargas
+++ b/src/job_make_mesonh_IBM_sp6_vargas
@@ -1,6 +1,6 @@
-#MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC Copyright 1994-2020 CNRS, Meteo-France and Universite Paul Sabatier
#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
#MNH_LIC for details. version 1.
# Temps CPU max. en seconde (d'un processus)
# @ wall_clock_limit = 7200
@@ -24,9 +24,8 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-2-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-5-0-MPIAUTO-O2
-time gmake -j1 gribapi
time gmake -r -j8
time gmake installmaster
diff --git a/src/job_make_mesonh_MFSX8 b/src/job_make_mesonh_MFSX8
index c1e15619bbad5f99d0e9f9e531ebd76523d5f872..811e5aa92ab70293537a9d11cbf048c80f1d0089 100644
--- a/src/job_make_mesonh_MFSX8
+++ b/src/job_make_mesonh_MFSX8
@@ -12,7 +12,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
[ ${PBS_O_WORKDIR} ] && cd ${PBS_O_WORKDIR}
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-2-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-5-0-MPIAUTO-O4
time gmake -j 4 ########## compile on four processors to speedup the compilation
time gmake -j 1 installmaster
diff --git a/src/job_make_mesonh_NEC_SX8 b/src/job_make_mesonh_NEC_SX8
index d8664fc0532a4602f35a951005a2fe7e94ae3da4..75d68db4ade1024e25a21842fcad41eccb63f7e1 100755
--- a/src/job_make_mesonh_NEC_SX8
+++ b/src/job_make_mesonh_NEC_SX8
@@ -11,7 +11,7 @@ set -x
# On va lancer la compilation dans le répertoire de lancement du job
[ $PBS_O_WORKDIR ] && cd $PBS_O_WORKDIR
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-2-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-5-0-MPIAUTO-O4
time gmake -j 4
time gmake -j 4 # some time problem with first pass in parallel compilation
diff --git a/src/job_make_mesonh_cxa b/src/job_make_mesonh_cxa
index ad5b3a85872bff807991682be89249424f23f0b5..d531fb9a75484db4fa6dd5c88d509c2188454d9e 100755
--- a/src/job_make_mesonh_cxa
+++ b/src/job_make_mesonh_cxa
@@ -27,7 +27,7 @@
set -x
cd $LOADL_STEP_INITDIR
-. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-4-2-MPIAUTO-O2
+. ../conf/profile_mesonh-AIX64-R8I4-MNH-V5-5-0-MPIAUTO-O2
time gmake -r -j1
time gmake installmaster
diff --git a/src/job_make_mesonh_user_BullX b/src/job_make_mesonh_user_BullX
index 324daaf557e995b4e560308a52b1b820d30cad6e..0b982175890de1f9249f8f361a7b5e2492a5ce66 100755
--- a/src/job_make_mesonh_user_BullX
+++ b/src/job_make_mesonh_user_BullX
@@ -19,7 +19,7 @@ export VER_USER= ########## Your own USER Directory
set -x
# On va lancer la compilation dans le répertoire de lancement du job
-. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-4-2-${VER_USER}-MPIINTEL-O3
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-${VER_USER}-MPIINTEL-O3
time gmake user
time gmake -j 1 installuser
diff --git a/src/job_make_mesonh_user_BullX_belenos b/src/job_make_mesonh_user_BullX_belenos
new file mode 100755
index 0000000000000000000000000000000000000000..fddbb21e59d239bc8be88461fc41d3f3fba6d353
--- /dev/null
+++ b/src/job_make_mesonh_user_BullX_belenos
@@ -0,0 +1,24 @@
+#!/bin/bash
+#MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+#MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+#MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+#MNH_LIC for details. version 1.
+#SBATCH --verbose
+#SBATCH --job-name=compile
+#SBATCH --time=01:00:00
+#SBATCH --nodes=1
+#SBATCH --ntasks-per-node=1
+#SBATCH --cpus-per-task=2
+#SBATCH -o VuserII_belenos.eo%j #
+#SBATCH -e VUserII_belenos.eo%j #
+
+export VER_USER= ######## Your own USER Directory
+
+set -x
+# On va lancer la compilation dans le répertoire de lancement du job
+pwd
+
+. ../conf/profile_mesonh-LXifort-R8I4-MNH-V5-5-0-${VER_USER}-MPIAUTO-O3
+
+time make user -j 2
+time make -j 1 installuser
diff --git a/src/job_make_mesonh_user_MFSX8 b/src/job_make_mesonh_user_MFSX8
index 407073d7ec4a6023b5a6b2aab6df09d375e2cadc..e6a87c197a2c5157aa4a5cc82bf8a50189b1e157 100644
--- a/src/job_make_mesonh_user_MFSX8
+++ b/src/job_make_mesonh_user_MFSX8
@@ -14,7 +14,7 @@ set -x
[ ${PBS_O_WORKDIR} ] && cd ${PBS_O_WORKDIR}
-. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-4-2-${VER_USER}-MPIAUTO-O4
+. ../conf/profile_mesonh-SX8-R8I4-MNH-V5-5-0-${VER_USER}-MPIAUTO-O4
time gmake user
time gmake -j 1 installuser